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