Mercurial > vba-clojure

annotate src/lua/ldblib.c @ 127:901ee6b648da

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
preliminary memory bootstrapping program complete.
author Robert McIntyre <rlm@mit.edu>
date Sat, 17 Mar 2012 03:43:42 -0500
parents 27763b933818
children
rev   line source
rlm@1 1 /*
rlm@1 2 ** $Id: ldblib.c,v 1.104.1.3 2008/01/21 13:11:21 roberto Exp $
rlm@1 3 ** Interface from Lua to its debug API
rlm@1 4 ** See Copyright Notice in lua.h
rlm@1 5 */
rlm@1 6
rlm@1 7
rlm@1 8 #include <stdio.h>
rlm@1 9 #include <stdlib.h>
rlm@1 10 #include <string.h>
rlm@1 11
rlm@1 12 #define ldblib_c
rlm@1 13 #define LUA_LIB
rlm@1 14
rlm@1 15 #include "lua.h"
rlm@1 16
rlm@1 17 #include "lauxlib.h"
rlm@1 18 #include "lualib.h"
rlm@1 19
rlm@1 20
rlm@1 21
rlm@1 22 static int db_getregistry (lua_State *L) {
rlm@1 23 lua_pushvalue(L, LUA_REGISTRYINDEX);
rlm@1 24 return 1;
rlm@1 25 }
rlm@1 26
rlm@1 27
rlm@1 28 static int db_getmetatable (lua_State *L) {
rlm@1 29 luaL_checkany(L, 1);
rlm@1 30 if (!lua_getmetatable(L, 1)) {
rlm@1 31 lua_pushnil(L); /* no metatable */
rlm@1 32 }
rlm@1 33 return 1;
rlm@1 34 }
rlm@1 35
rlm@1 36
rlm@1 37 static int db_setmetatable (lua_State *L) {
rlm@1 38 int t = lua_type(L, 2);
rlm@1 39 luaL_argcheck(L, t == LUA_TNIL || t == LUA_TTABLE, 2,
rlm@1 40 "nil or table expected");
rlm@1 41 lua_settop(L, 2);
rlm@1 42 lua_pushboolean(L, lua_setmetatable(L, 1));
rlm@1 43 return 1;
rlm@1 44 }
rlm@1 45
rlm@1 46
rlm@1 47 static int db_getfenv (lua_State *L) {
rlm@1 48 lua_getfenv(L, 1);
rlm@1 49 return 1;
rlm@1 50 }
rlm@1 51
rlm@1 52
rlm@1 53 static int db_setfenv (lua_State *L) {
rlm@1 54 luaL_checktype(L, 2, LUA_TTABLE);
rlm@1 55 lua_settop(L, 2);
rlm@1 56 if (lua_setfenv(L, 1) == 0)
rlm@1 57 luaL_error(L, LUA_QL("setfenv")
rlm@1 58 " cannot change environment of given object");
rlm@1 59 return 1;
rlm@1 60 }
rlm@1 61
rlm@1 62
rlm@1 63 static void settabss (lua_State *L, const char *i, const char *v) {
rlm@1 64 lua_pushstring(L, v);
rlm@1 65 lua_setfield(L, -2, i);
rlm@1 66 }
rlm@1 67
rlm@1 68
rlm@1 69 static void settabsi (lua_State *L, const char *i, int v) {
rlm@1 70 lua_pushinteger(L, v);
rlm@1 71 lua_setfield(L, -2, i);
rlm@1 72 }
rlm@1 73
rlm@1 74
rlm@1 75 static lua_State *getthread (lua_State *L, int *arg) {
rlm@1 76 if (lua_isthread(L, 1)) {
rlm@1 77 *arg = 1;
rlm@1 78 return lua_tothread(L, 1);
rlm@1 79 }
rlm@1 80 else {
rlm@1 81 *arg = 0;
rlm@1 82 return L;
rlm@1 83 }
rlm@1 84 }
rlm@1 85
rlm@1 86
rlm@1 87 static void treatstackoption (lua_State *L, lua_State *L1, const char *fname) {
rlm@1 88 if (L == L1) {
rlm@1 89 lua_pushvalue(L, -2);
rlm@1 90 lua_remove(L, -3);
rlm@1 91 }
rlm@1 92 else
rlm@1 93 lua_xmove(L1, L, 1);
rlm@1 94 lua_setfield(L, -2, fname);
rlm@1 95 }
rlm@1 96
rlm@1 97
rlm@1 98 static int db_getinfo (lua_State *L) {
rlm@1 99 lua_Debug ar;
rlm@1 100 int arg;
rlm@1 101 lua_State *L1 = getthread(L, &arg);
rlm@1 102 const char *options = luaL_optstring(L, arg+2, "flnSu");
rlm@1 103 if (lua_isnumber(L, arg+1)) {
rlm@1 104 if (!lua_getstack(L1, (int)lua_tointeger(L, arg+1), &ar)) {
rlm@1 105 lua_pushnil(L); /* level out of range */
rlm@1 106 return 1;
rlm@1 107 }
rlm@1 108 }
rlm@1 109 else if (lua_isfunction(L, arg+1)) {
rlm@1 110 lua_pushfstring(L, ">%s", options);
rlm@1 111 options = lua_tostring(L, -1);
rlm@1 112 lua_pushvalue(L, arg+1);
rlm@1 113 lua_xmove(L, L1, 1);
rlm@1 114 }
rlm@1 115 else
rlm@1 116 return luaL_argerror(L, arg+1, "function or level expected");
rlm@1 117 if (!lua_getinfo(L1, options, &ar))
rlm@1 118 return luaL_argerror(L, arg+2, "invalid option");
rlm@1 119 lua_createtable(L, 0, 2);
rlm@1 120 if (strchr(options, 'S')) {
rlm@1 121 settabss(L, "source", ar.source);
rlm@1 122 settabss(L, "short_src", ar.short_src);
rlm@1 123 settabsi(L, "linedefined", ar.linedefined);
rlm@1 124 settabsi(L, "lastlinedefined", ar.lastlinedefined);
rlm@1 125 settabss(L, "what", ar.what);
rlm@1 126 }
rlm@1 127 if (strchr(options, 'l'))
rlm@1 128 settabsi(L, "currentline", ar.currentline);
rlm@1 129 if (strchr(options, 'u'))
rlm@1 130 settabsi(L, "nups", ar.nups);
rlm@1 131 if (strchr(options, 'n')) {
rlm@1 132 settabss(L, "name", ar.name);
rlm@1 133 settabss(L, "namewhat", ar.namewhat);
rlm@1 134 }
rlm@1 135 if (strchr(options, 'L'))
rlm@1 136 treatstackoption(L, L1, "activelines");
rlm@1 137 if (strchr(options, 'f'))
rlm@1 138 treatstackoption(L, L1, "func");
rlm@1 139 return 1; /* return table */
rlm@1 140 }
rlm@1 141
rlm@1 142
rlm@1 143 static int db_getlocal (lua_State *L) {
rlm@1 144 int arg;
rlm@1 145 lua_State *L1 = getthread(L, &arg);
rlm@1 146 lua_Debug ar;
rlm@1 147 const char *name;
rlm@1 148 if (!lua_getstack(L1, luaL_checkint(L, arg+1), &ar)) /* out of range? */
rlm@1 149 return luaL_argerror(L, arg+1, "level out of range");
rlm@1 150 name = lua_getlocal(L1, &ar, luaL_checkint(L, arg+2));
rlm@1 151 if (name) {
rlm@1 152 lua_xmove(L1, L, 1);
rlm@1 153 lua_pushstring(L, name);
rlm@1 154 lua_pushvalue(L, -2);
rlm@1 155 return 2;
rlm@1 156 }
rlm@1 157 else {
rlm@1 158 lua_pushnil(L);
rlm@1 159 return 1;
rlm@1 160 }
rlm@1 161 }
rlm@1 162
rlm@1 163
rlm@1 164 static int db_setlocal (lua_State *L) {
rlm@1 165 int arg;
rlm@1 166 lua_State *L1 = getthread(L, &arg);
rlm@1 167 lua_Debug ar;
rlm@1 168 if (!lua_getstack(L1, luaL_checkint(L, arg+1), &ar)) /* out of range? */
rlm@1 169 return luaL_argerror(L, arg+1, "level out of range");
rlm@1 170 luaL_checkany(L, arg+3);
rlm@1 171 lua_settop(L, arg+3);
rlm@1 172 lua_xmove(L, L1, 1);
rlm@1 173 lua_pushstring(L, lua_setlocal(L1, &ar, luaL_checkint(L, arg+2)));
rlm@1 174 return 1;
rlm@1 175 }
rlm@1 176
rlm@1 177
rlm@1 178 static int auxupvalue (lua_State *L, int get) {
rlm@1 179 const char *name;
rlm@1 180 int n = luaL_checkint(L, 2);
rlm@1 181 luaL_checktype(L, 1, LUA_TFUNCTION);
rlm@1 182 if (lua_iscfunction(L, 1)) return 0; /* cannot touch C upvalues from Lua */
rlm@1 183 name = get ? lua_getupvalue(L, 1, n) : lua_setupvalue(L, 1, n);
rlm@1 184 if (name == NULL) return 0;
rlm@1 185 lua_pushstring(L, name);
rlm@1 186 lua_insert(L, -(get+1));
rlm@1 187 return get + 1;
rlm@1 188 }
rlm@1 189
rlm@1 190
rlm@1 191 static int db_getupvalue (lua_State *L) {
rlm@1 192 return auxupvalue(L, 1);
rlm@1 193 }
rlm@1 194
rlm@1 195
rlm@1 196 static int db_setupvalue (lua_State *L) {
rlm@1 197 luaL_checkany(L, 3);
rlm@1 198 return auxupvalue(L, 0);
rlm@1 199 }
rlm@1 200
rlm@1 201
rlm@1 202
rlm@1 203 static const char KEY_HOOK = 'h';
rlm@1 204
rlm@1 205
rlm@1 206 static void hookf (lua_State *L, lua_Debug *ar) {
rlm@1 207 static const char *const hooknames[] =
rlm@1 208 {"call", "return", "line", "count", "tail return"};
rlm@1 209 lua_pushlightuserdata(L, (void *)&KEY_HOOK);
rlm@1 210 lua_rawget(L, LUA_REGISTRYINDEX);
rlm@1 211 lua_pushlightuserdata(L, L);
rlm@1 212 lua_rawget(L, -2);
rlm@1 213 if (lua_isfunction(L, -1)) {
rlm@1 214 lua_pushstring(L, hooknames[(int)ar->event]);
rlm@1 215 if (ar->currentline >= 0)
rlm@1 216 lua_pushinteger(L, ar->currentline);
rlm@1 217 else lua_pushnil(L);
rlm@1 218 lua_assert(lua_getinfo(L, "lS", ar));
rlm@1 219 lua_call(L, 2, 0);
rlm@1 220 }
rlm@1 221 }
rlm@1 222
rlm@1 223
rlm@1 224 static int makemask (const char *smask, int count) {
rlm@1 225 int mask = 0;
rlm@1 226 if (strchr(smask, 'c')) mask |= LUA_MASKCALL;
rlm@1 227 if (strchr(smask, 'r')) mask |= LUA_MASKRET;
rlm@1 228 if (strchr(smask, 'l')) mask |= LUA_MASKLINE;
rlm@1 229 if (count > 0) mask |= LUA_MASKCOUNT;
rlm@1 230 return mask;
rlm@1 231 }
rlm@1 232
rlm@1 233
rlm@1 234 static char *unmakemask (int mask, char *smask) {
rlm@1 235 int i = 0;
rlm@1 236 if (mask & LUA_MASKCALL) smask[i++] = 'c';
rlm@1 237 if (mask & LUA_MASKRET) smask[i++] = 'r';
rlm@1 238 if (mask & LUA_MASKLINE) smask[i++] = 'l';
rlm@1 239 smask[i] = '\0';
rlm@1 240 return smask;
rlm@1 241 }
rlm@1 242
rlm@1 243
rlm@1 244 static void gethooktable (lua_State *L) {
rlm@1 245 lua_pushlightuserdata(L, (void *)&KEY_HOOK);
rlm@1 246 lua_rawget(L, LUA_REGISTRYINDEX);
rlm@1 247 if (!lua_istable(L, -1)) {
rlm@1 248 lua_pop(L, 1);
rlm@1 249 lua_createtable(L, 0, 1);
rlm@1 250 lua_pushlightuserdata(L, (void *)&KEY_HOOK);
rlm@1 251 lua_pushvalue(L, -2);
rlm@1 252 lua_rawset(L, LUA_REGISTRYINDEX);
rlm@1 253 }
rlm@1 254 }
rlm@1 255
rlm@1 256
rlm@1 257 static int db_sethook (lua_State *L) {
rlm@1 258 int arg, mask, count;
rlm@1 259 lua_Hook func;
rlm@1 260 lua_State *L1 = getthread(L, &arg);
rlm@1 261 if (lua_isnoneornil(L, arg+1)) {
rlm@1 262 lua_settop(L, arg+1);
rlm@1 263 func = NULL; mask = 0; count = 0; /* turn off hooks */
rlm@1 264 }
rlm@1 265 else {
rlm@1 266 const char *smask = luaL_checkstring(L, arg+2);
rlm@1 267 luaL_checktype(L, arg+1, LUA_TFUNCTION);
rlm@1 268 count = luaL_optint(L, arg+3, 0);
rlm@1 269 func = hookf; mask = makemask(smask, count);
rlm@1 270 }
rlm@1 271 gethooktable(L);
rlm@1 272 lua_pushlightuserdata(L, L1);
rlm@1 273 lua_pushvalue(L, arg+1);
rlm@1 274 lua_rawset(L, -3); /* set new hook */
rlm@1 275 lua_pop(L, 1); /* remove hook table */
rlm@1 276 lua_sethook(L1, func, mask, count); /* set hooks */
rlm@1 277 return 0;
rlm@1 278 }
rlm@1 279
rlm@1 280
rlm@1 281 static int db_gethook (lua_State *L) {
rlm@1 282 int arg;
rlm@1 283 lua_State *L1 = getthread(L, &arg);
rlm@1 284 char buff[5];
rlm@1 285 int mask = lua_gethookmask(L1);
rlm@1 286 lua_Hook hook = lua_gethook(L1);
rlm@1 287 if (hook != NULL && hook != hookf) /* external hook? */
rlm@1 288 lua_pushliteral(L, "external hook");
rlm@1 289 else {
rlm@1 290 gethooktable(L);
rlm@1 291 lua_pushlightuserdata(L, L1);
rlm@1 292 lua_rawget(L, -2); /* get hook */
rlm@1 293 lua_remove(L, -2); /* remove hook table */
rlm@1 294 }
rlm@1 295 lua_pushstring(L, unmakemask(mask, buff));
rlm@1 296 lua_pushinteger(L, lua_gethookcount(L1));
rlm@1 297 return 3;
rlm@1 298 }
rlm@1 299
rlm@1 300
rlm@1 301 static int db_debug (lua_State *L) {
rlm@1 302 for (;;) {
rlm@1 303 char buffer[250];
rlm@1 304 fputs("lua_debug> ", stderr);
rlm@1 305 if (fgets(buffer, sizeof(buffer), stdin) == 0 ||
rlm@1 306 strcmp(buffer, "cont\n") == 0)
rlm@1 307 return 0;
rlm@1 308 if (luaL_loadbuffer(L, buffer, strlen(buffer), "=(debug command)") ||
rlm@1 309 lua_pcall(L, 0, 0, 0)) {
rlm@1 310 fputs(lua_tostring(L, -1), stderr);
rlm@1 311 fputs("\n", stderr);
rlm@1 312 }
rlm@1 313 lua_settop(L, 0); /* remove eventual returns */
rlm@1 314 }
rlm@1 315 }
rlm@1 316
rlm@1 317
rlm@1 318 #define LEVELS1 12 /* size of the first part of the stack */
rlm@1 319 #define LEVELS2 10 /* size of the second part of the stack */
rlm@1 320
rlm@1 321 static int db_errorfb (lua_State *L) {
rlm@1 322 int level;
rlm@1 323 int firstpart = 1; /* still before eventual `...' */
rlm@1 324 int arg;
rlm@1 325 lua_State *L1 = getthread(L, &arg);
rlm@1 326 lua_Debug ar;
rlm@1 327 if (lua_isnumber(L, arg+2)) {
rlm@1 328 level = (int)lua_tointeger(L, arg+2);
rlm@1 329 lua_pop(L, 1);
rlm@1 330 }
rlm@1 331 else
rlm@1 332 level = (L == L1) ? 1 : 0; /* level 0 may be this own function */
rlm@1 333 if (lua_gettop(L) == arg)
rlm@1 334 lua_pushliteral(L, "");
rlm@1 335 else if (!lua_isstring(L, arg+1)) return 1; /* message is not a string */
rlm@1 336 else lua_pushliteral(L, "\n");
rlm@1 337 lua_pushliteral(L, "stack traceback:");
rlm@1 338 while (lua_getstack(L1, level++, &ar)) {
rlm@1 339 if (level > LEVELS1 && firstpart) {
rlm@1 340 /* no more than `LEVELS2' more levels? */
rlm@1 341 if (!lua_getstack(L1, level+LEVELS2, &ar))
rlm@1 342 level--; /* keep going */
rlm@1 343 else {
rlm@1 344 lua_pushliteral(L, "\n\t..."); /* too many levels */
rlm@1 345 while (lua_getstack(L1, level+LEVELS2, &ar)) /* find last levels */
rlm@1 346 level++;
rlm@1 347 }
rlm@1 348 firstpart = 0;
rlm@1 349 continue;
rlm@1 350 }
rlm@1 351 lua_pushliteral(L, "\n\t");
rlm@1 352 lua_getinfo(L1, "Snl", &ar);
rlm@1 353 lua_pushfstring(L, "%s:", ar.short_src);
rlm@1 354 if (ar.currentline > 0)
rlm@1 355 lua_pushfstring(L, "%d:", ar.currentline);
rlm@1 356 if (*ar.namewhat != '\0') /* is there a name? */
rlm@1 357 lua_pushfstring(L, " in function " LUA_QS, ar.name);
rlm@1 358 else {
rlm@1 359 if (*ar.what == 'm') /* main? */
rlm@1 360 lua_pushfstring(L, " in main chunk");
rlm@1 361 else if (*ar.what == 'C' || *ar.what == 't')
rlm@1 362 lua_pushliteral(L, " ?"); /* C function or tail call */
rlm@1 363 else
rlm@1 364 lua_pushfstring(L, " in function <%s:%d>",
rlm@1 365 ar.short_src, ar.linedefined);
rlm@1 366 }
rlm@1 367 lua_concat(L, lua_gettop(L) - arg);
rlm@1 368 }
rlm@1 369 lua_concat(L, lua_gettop(L) - arg);
rlm@1 370 return 1;
rlm@1 371 }
rlm@1 372
rlm@1 373
rlm@1 374 static const luaL_Reg dblib[] = {
rlm@1 375 {"debug", db_debug},
rlm@1 376 {"getfenv", db_getfenv},
rlm@1 377 {"gethook", db_gethook},
rlm@1 378 {"getinfo", db_getinfo},
rlm@1 379 {"getlocal", db_getlocal},
rlm@1 380 {"getregistry", db_getregistry},
rlm@1 381 {"getmetatable", db_getmetatable},
rlm@1 382 {"getupvalue", db_getupvalue},
rlm@1 383 {"setfenv", db_setfenv},
rlm@1 384 {"sethook", db_sethook},
rlm@1 385 {"setlocal", db_setlocal},
rlm@1 386 {"setmetatable", db_setmetatable},
rlm@1 387 {"setupvalue", db_setupvalue},
rlm@1 388 {"traceback", db_errorfb},
rlm@1 389 {NULL, NULL}
rlm@1 390 };
rlm@1 391
rlm@1 392
rlm@1 393 LUALIB_API int luaopen_debug (lua_State *L) {
rlm@1 394 luaL_register(L, LUA_DBLIBNAME, dblib);
rlm@1 395 return 1;
rlm@1 396 }
rlm@1 397