diff options
| author | Lua Team <team@lua.org> | 2003-04-11 12:00:00 +0000 |
|---|---|---|
| committer | repogen <> | 2003-04-11 12:00:00 +0000 |
| commit | f0e4e22f5c119865eb5a8d3844a40df2d5980b3b (patch) | |
| tree | c4df063a747e9c99f8aba1678588a030993780a9 /src | |
| parent | 1981b7c90eb09e956e969cda5c473be4560af573 (diff) | |
| download | lua-github-5.0.tar.gz | |
Lua 5.05.0
Diffstat (limited to 'src')
| -rw-r--r-- | src/Makefile | 8 | ||||
| -rw-r--r-- | src/README | 5 | ||||
| -rw-r--r-- | src/lapi.c | 900 | ||||
| -rw-r--r-- | src/lapi.h | 3 | ||||
| -rw-r--r-- | src/lcode.c | 1047 | ||||
| -rw-r--r-- | src/lcode.h | 58 | ||||
| -rw-r--r-- | src/ldebug.c | 699 | ||||
| -rw-r--r-- | src/ldebug.h | 22 | ||||
| -rw-r--r-- | src/ldo.c | 624 | ||||
| -rw-r--r-- | src/ldo.h | 53 | ||||
| -rw-r--r-- | src/ldump.c | 170 | ||||
| -rw-r--r-- | src/lfunc.c | 130 | ||||
| -rw-r--r-- | src/lfunc.h | 9 | ||||
| -rw-r--r-- | src/lgc.c | 614 | ||||
| -rw-r--r-- | src/lgc.h | 12 | ||||
| -rw-r--r-- | src/lib/Makefile | 11 | ||||
| -rw-r--r-- | src/lib/README | 10 | ||||
| -rw-r--r-- | src/lib/lauxlib.c | 491 | ||||
| -rw-r--r-- | src/lib/lbaselib.c | 867 | ||||
| -rw-r--r-- | src/lib/ldblib.c | 241 | ||||
| -rw-r--r-- | src/lib/liolib.c | 986 | ||||
| -rw-r--r-- | src/lib/lmathlib.c | 152 | ||||
| -rw-r--r-- | src/lib/loadlib.c | 205 | ||||
| -rw-r--r-- | src/lib/lstrlib.c | 599 | ||||
| -rw-r--r-- | src/lib/ltablib.c | 250 | ||||
| -rw-r--r-- | src/llex.c | 365 | ||||
| -rw-r--r-- | src/llex.h | 31 | ||||
| -rw-r--r-- | src/llimits.h | 185 | ||||
| -rw-r--r-- | src/lmem.c | 163 | ||||
| -rw-r--r-- | src/lmem.h | 40 | ||||
| -rw-r--r-- | src/lobject.c | 180 | ||||
| -rw-r--r-- | src/lobject.h | 360 | ||||
| -rw-r--r-- | src/lopcodes.c | 102 | ||||
| -rw-r--r-- | src/lopcodes.h | 260 | ||||
| -rw-r--r-- | src/lparser.c | 1369 | ||||
| -rw-r--r-- | src/lparser.h | 55 | ||||
| -rw-r--r-- | src/lstate.c | 249 | ||||
| -rw-r--r-- | src/lstate.h | 198 | ||||
| -rw-r--r-- | src/lstring.c | 163 | ||||
| -rw-r--r-- | src/lstring.h | 26 | ||||
| -rw-r--r-- | src/ltable.c | 580 | ||||
| -rw-r--r-- | src/ltable.h | 31 | ||||
| -rw-r--r-- | src/ltests.c | 691 | ||||
| -rw-r--r-- | src/ltm.c | 169 | ||||
| -rw-r--r-- | src/ltm.h | 36 | ||||
| -rw-r--r-- | src/lua/Makefile | 9 | ||||
| -rw-r--r-- | src/lua/README | 50 | ||||
| -rw-r--r-- | src/lua/lua.c | 548 | ||||
| -rw-r--r-- | src/luac/Makefile | 19 | ||||
| -rw-r--r-- | src/luac/README | 12 | ||||
| -rw-r--r-- | src/luac/dump.c | 121 | ||||
| -rw-r--r-- | src/luac/luac.c | 224 | ||||
| -rw-r--r-- | src/luac/luac.h | 31 | ||||
| -rw-r--r-- | src/luac/opt.c | 127 | ||||
| -rw-r--r-- | src/luac/print.c | 224 | ||||
| -rw-r--r-- | src/luac/print.h | 55 | ||||
| -rw-r--r-- | src/luac/stubs.c | 127 | ||||
| -rw-r--r-- | src/lundump.c | 310 | ||||
| -rw-r--r-- | src/lundump.h | 33 | ||||
| -rw-r--r-- | src/lvm.c | 1080 | ||||
| -rw-r--r-- | src/lvm.h | 31 | ||||
| -rw-r--r-- | src/lzio.c | 89 | ||||
| -rw-r--r-- | src/lzio.h | 63 |
63 files changed, 9875 insertions, 6697 deletions
diff --git a/src/Makefile b/src/Makefile index 66e0ea8d..bf64c03f 100644 --- a/src/Makefile +++ b/src/Makefile @@ -9,11 +9,13 @@ OBJS= \ lcode.o \ ldebug.o \ ldo.o \ + ldump.o \ lfunc.o \ lgc.o \ llex.o \ lmem.o \ lobject.o \ + lopcodes.o \ lparser.o \ lstate.o \ lstring.o \ @@ -29,11 +31,13 @@ SRCS= \ lcode.c \ ldebug.c \ ldo.c \ + ldump.c \ lfunc.c \ lgc.c \ llex.c \ lmem.c \ lobject.c \ + lopcodes.c \ lparser.c \ lstate.c \ lstring.c \ @@ -65,9 +69,9 @@ SRCS= \ T= $(LIB)/liblua.a -all: $T +all: $T -$T: $(OBJS) +$T: $(OBJS) $(AR) $@ $(OBJS) $(RANLIB) $@ diff --git a/src/README b/src/README new file mode 100644 index 00000000..e5375981 --- /dev/null +++ b/src/README @@ -0,0 +1,5 @@ +This is the Lua core. + +The standard Lua library are in lib/. +A sample interpreter is in lua/. +A standalone compiler is in luac/. @@ -1,15 +1,19 @@ /* -** $Id: lapi.c,v 1.110a 2000/10/30 12:50:09 roberto Exp $ +** $Id: lapi.c,v 1.235 2003/04/07 14:36:08 roberto Exp $ ** Lua API ** See Copyright Notice in lua.h */ +#include <assert.h> #include <string.h> +#define lapi_c + #include "lua.h" #include "lapi.h" +#include "ldebug.h" #include "ldo.h" #include "lfunc.h" #include "lgc.h" @@ -19,43 +23,128 @@ #include "lstring.h" #include "ltable.h" #include "ltm.h" +#include "lundump.h" #include "lvm.h" -const char lua_ident[] = "$Lua: " LUA_VERSION " " LUA_COPYRIGHT " $\n" - "$Authors: " LUA_AUTHORS " $"; +const char lua_ident[] = + "$Lua: " LUA_VERSION " " LUA_COPYRIGHT " $\n" + "$Authors: " LUA_AUTHORS " $\n" + "$URL: www.lua.org $\n"; + +#ifndef api_check +#define api_check(L, o) /*{ assert(o); }*/ +#endif -#define Index(L,i) ((i) >= 0 ? (L->Cbase+((i)-1)) : (L->top+(i))) +#define api_checknelems(L, n) api_check(L, (n) <= (L->top - L->base)) -#define api_incr_top(L) incr_top +#define api_incr_top(L) {api_check(L, L->top < L->ci->top); L->top++;} -TObject *luaA_index (lua_State *L, int index) { - return Index(L, index); +static TObject *negindex (lua_State *L, int idx) { + if (idx > LUA_REGISTRYINDEX) { + api_check(L, idx != 0 && -idx <= L->top - L->base); + return L->top+idx; + } + else switch (idx) { /* pseudo-indices */ + case LUA_REGISTRYINDEX: return registry(L); + case LUA_GLOBALSINDEX: return gt(L); + default: { + TObject *func = (L->base - 1); + idx = LUA_GLOBALSINDEX - idx; + lua_assert(iscfunction(func)); + return (idx <= clvalue(func)->c.nupvalues) + ? &clvalue(func)->c.upvalue[idx-1] + : NULL; + } + } +} + + +static TObject *luaA_index (lua_State *L, int idx) { + if (idx > 0) { + api_check(L, idx <= L->top - L->base); + return L->base + idx - 1; + } + else { + TObject *o = negindex(L, idx); + api_check(L, o != NULL); + return o; + } } -static TObject *luaA_indexAcceptable (lua_State *L, int index) { - if (index >= 0) { - TObject *o = L->Cbase+(index-1); +static TObject *luaA_indexAcceptable (lua_State *L, int idx) { + if (idx > 0) { + TObject *o = L->base+(idx-1); + api_check(L, idx <= L->stack_last - L->base); if (o >= L->top) return NULL; else return o; } - else return L->top+index; + else + return negindex(L, idx); } void luaA_pushobject (lua_State *L, const TObject *o) { - *L->top = *o; - incr_top; + setobj2s(L->top, o); + incr_top(L); +} + + +LUA_API int lua_checkstack (lua_State *L, int size) { + int res; + lua_lock(L); + if ((L->top - L->base + size) > LUA_MAXCSTACK) + res = 0; /* stack overflow */ + else { + luaD_checkstack(L, size); + if (L->ci->top < L->top + size) + L->ci->top = L->top + size; + res = 1; + } + lua_unlock(L); + return res; } -LUA_API int lua_stackspace (lua_State *L) { - return (L->stack_last - L->top); + +LUA_API void lua_xmove (lua_State *from, lua_State *to, int n) { + int i; + lua_lock(to); + api_checknelems(from, n); + from->top -= n; + for (i = 0; i < n; i++) { + setobj2s(to->top, from->top + i); + api_incr_top(to); + } + lua_unlock(to); +} + + +LUA_API lua_CFunction lua_atpanic (lua_State *L, lua_CFunction panicf) { + lua_CFunction old; + lua_lock(L); + old = G(L)->panic; + G(L)->panic = panicf; + lua_unlock(L); + return old; +} + + +LUA_API lua_State *lua_newthread (lua_State *L) { + lua_State *L1; + lua_lock(L); + luaC_checkGC(L); + L1 = luaE_newthread(L); + setthvalue(L->top, L1); + api_incr_top(L); + lua_unlock(L); + lua_userstateopen(L1); + return L1; } @@ -66,37 +155,61 @@ LUA_API int lua_stackspace (lua_State *L) { LUA_API int lua_gettop (lua_State *L) { - return (L->top - L->Cbase); + return (L->top - L->base); } -LUA_API void lua_settop (lua_State *L, int index) { - if (index >= 0) - luaD_adjusttop(L, L->Cbase, index); - else - L->top = L->top+index+1; /* index is negative */ +LUA_API void lua_settop (lua_State *L, int idx) { + lua_lock(L); + if (idx >= 0) { + api_check(L, idx <= L->stack_last - L->base); + while (L->top < L->base + idx) + setnilvalue(L->top++); + L->top = L->base + idx; + } + else { + api_check(L, -(idx+1) <= (L->top - L->base)); + L->top += idx+1; /* `subtract' index (index is negative) */ + } + lua_unlock(L); } -LUA_API void lua_remove (lua_State *L, int index) { - StkId p = luaA_index(L, index); - while (++p < L->top) *(p-1) = *p; +LUA_API void lua_remove (lua_State *L, int idx) { + StkId p; + lua_lock(L); + p = luaA_index(L, idx); + while (++p < L->top) setobjs2s(p-1, p); L->top--; + lua_unlock(L); } -LUA_API void lua_insert (lua_State *L, int index) { - StkId p = luaA_index(L, index); +LUA_API void lua_insert (lua_State *L, int idx) { + StkId p; StkId q; - for (q = L->top; q>p; q--) - *q = *(q-1); - *p = *L->top; + lua_lock(L); + p = luaA_index(L, idx); + for (q = L->top; q>p; q--) setobjs2s(q, q-1); + setobjs2s(p, L->top); + lua_unlock(L); } -LUA_API void lua_pushvalue (lua_State *L, int index) { - *L->top = *luaA_index(L, index); +LUA_API void lua_replace (lua_State *L, int idx) { + lua_lock(L); + api_checknelems(L, 1); + setobj(luaA_index(L, idx), L->top - 1); /* write barrier */ + L->top--; + lua_unlock(L); +} + + +LUA_API void lua_pushvalue (lua_State *L, int idx) { + lua_lock(L); + setobj2s(L->top, luaA_index(L, idx)); api_incr_top(L); + lua_unlock(L); } @@ -106,93 +219,167 @@ LUA_API void lua_pushvalue (lua_State *L, int index) { */ -LUA_API int lua_type (lua_State *L, int index) { - StkId o = luaA_indexAcceptable(L, index); +LUA_API int lua_type (lua_State *L, int idx) { + StkId o = luaA_indexAcceptable(L, idx); return (o == NULL) ? LUA_TNONE : ttype(o); } + LUA_API const char *lua_typename (lua_State *L, int t) { UNUSED(L); - return (t == LUA_TNONE) ? "no value" : luaO_typenames[t]; + return (t == LUA_TNONE) ? "no value" : luaT_typenames[t]; } -LUA_API int lua_iscfunction (lua_State *L, int index) { - StkId o = luaA_indexAcceptable(L, index); +LUA_API int lua_iscfunction (lua_State *L, int idx) { + StkId o = luaA_indexAcceptable(L, idx); return (o == NULL) ? 0 : iscfunction(o); } -LUA_API int lua_isnumber (lua_State *L, int index) { - TObject *o = luaA_indexAcceptable(L, index); - return (o == NULL) ? 0 : (tonumber(o) == 0); + +LUA_API int lua_isnumber (lua_State *L, int idx) { + TObject n; + const TObject *o = luaA_indexAcceptable(L, idx); + return (o != NULL && tonumber(o, &n)); } -LUA_API int lua_isstring (lua_State *L, int index) { - int t = lua_type(L, index); + +LUA_API int lua_isstring (lua_State *L, int idx) { + int t = lua_type(L, idx); return (t == LUA_TSTRING || t == LUA_TNUMBER); } -LUA_API int lua_tag (lua_State *L, int index) { - StkId o = luaA_indexAcceptable(L, index); - return (o == NULL) ? LUA_NOTAG : luaT_tag(o); +LUA_API int lua_isuserdata (lua_State *L, int idx) { + const TObject *o = luaA_indexAcceptable(L, idx); + return (o != NULL && (ttisuserdata(o) || ttislightuserdata(o))); } -LUA_API int lua_equal (lua_State *L, int index1, int index2) { + +LUA_API int lua_rawequal (lua_State *L, int index1, int index2) { StkId o1 = luaA_indexAcceptable(L, index1); StkId o2 = luaA_indexAcceptable(L, index2); - if (o1 == NULL || o2 == NULL) return 0; /* index out-of-range */ - else return luaO_equalObj(o1, o2); + return (o1 == NULL || o2 == NULL) ? 0 /* index out of range */ + : luaO_rawequalObj(o1, o2); +} + + +LUA_API int lua_equal (lua_State *L, int index1, int index2) { + StkId o1, o2; + int i; + lua_lock(L); /* may call tag method */ + o1 = luaA_indexAcceptable(L, index1); + o2 = luaA_indexAcceptable(L, index2); + i = (o1 == NULL || o2 == NULL) ? 0 /* index out of range */ + : equalobj(L, o1, o2); + lua_unlock(L); + return i; } + LUA_API int lua_lessthan (lua_State *L, int index1, int index2) { - StkId o1 = luaA_indexAcceptable(L, index1); - StkId o2 = luaA_indexAcceptable(L, index2); - if (o1 == NULL || o2 == NULL) return 0; /* index out-of-range */ - else return luaV_lessthan(L, o1, o2, L->top); + StkId o1, o2; + int i; + lua_lock(L); /* may call tag method */ + o1 = luaA_indexAcceptable(L, index1); + o2 = luaA_indexAcceptable(L, index2); + i = (o1 == NULL || o2 == NULL) ? 0 /* index out-of-range */ + : luaV_lessthan(L, o1, o2); + lua_unlock(L); + return i; } -LUA_API double lua_tonumber (lua_State *L, int index) { - StkId o = luaA_indexAcceptable(L, index); - return (o == NULL || tonumber(o)) ? 0 : nvalue(o); +LUA_API lua_Number lua_tonumber (lua_State *L, int idx) { + TObject n; + const TObject *o = luaA_indexAcceptable(L, idx); + if (o != NULL && tonumber(o, &n)) + return nvalue(o); + else + return 0; } -LUA_API const char *lua_tostring (lua_State *L, int index) { - StkId o = luaA_indexAcceptable(L, index); - return (o == NULL || tostring(L, o)) ? NULL : svalue(o); + +LUA_API int lua_toboolean (lua_State *L, int idx) { + const TObject *o = luaA_indexAcceptable(L, idx); + return (o != NULL) && !l_isfalse(o); } -LUA_API size_t lua_strlen (lua_State *L, int index) { - StkId o = luaA_indexAcceptable(L, index); - return (o == NULL || tostring(L, o)) ? 0 : tsvalue(o)->len; + +LUA_API const char *lua_tostring (lua_State *L, int idx) { + StkId o = luaA_indexAcceptable(L, idx); + if (o == NULL) + return NULL; + else if (ttisstring(o)) + return svalue(o); + else { + const char *s; + lua_lock(L); /* `luaV_tostring' may create a new string */ + s = (luaV_tostring(L, o) ? svalue(o) : NULL); + luaC_checkGC(L); + lua_unlock(L); + return s; + } } -LUA_API lua_CFunction lua_tocfunction (lua_State *L, int index) { - StkId o = luaA_indexAcceptable(L, index); - return (o == NULL || !iscfunction(o)) ? NULL : clvalue(o)->f.c; + +LUA_API size_t lua_strlen (lua_State *L, int idx) { + StkId o = luaA_indexAcceptable(L, idx); + if (o == NULL) + return 0; + else if (ttisstring(o)) + return tsvalue(o)->tsv.len; + else { + size_t l; + lua_lock(L); /* `luaV_tostring' may create a new string */ + l = (luaV_tostring(L, o) ? tsvalue(o)->tsv.len : 0); + lua_unlock(L); + return l; + } } -LUA_API void *lua_touserdata (lua_State *L, int index) { - StkId o = luaA_indexAcceptable(L, index); - return (o == NULL || ttype(o) != LUA_TUSERDATA) ? NULL : - tsvalue(o)->u.d.value; + +LUA_API lua_CFunction lua_tocfunction (lua_State *L, int idx) { + StkId o = luaA_indexAcceptable(L, idx); + return (o == NULL || !iscfunction(o)) ? NULL : clvalue(o)->c.f; } -LUA_API const void *lua_topointer (lua_State *L, int index) { - StkId o = luaA_indexAcceptable(L, index); + +LUA_API void *lua_touserdata (lua_State *L, int idx) { + StkId o = luaA_indexAcceptable(L, idx); if (o == NULL) return NULL; switch (ttype(o)) { - case LUA_TTABLE: - return hvalue(o); - case LUA_TFUNCTION: - return clvalue(o); + case LUA_TUSERDATA: return (uvalue(o) + 1); + case LUA_TLIGHTUSERDATA: return pvalue(o); default: return NULL; } } +LUA_API lua_State *lua_tothread (lua_State *L, int idx) { + StkId o = luaA_indexAcceptable(L, idx); + return (o == NULL || !ttisthread(o)) ? NULL : thvalue(o); +} + + +LUA_API const void *lua_topointer (lua_State *L, int idx) { + StkId o = luaA_indexAcceptable(L, idx); + if (o == NULL) return NULL; + else { + switch (ttype(o)) { + case LUA_TTABLE: return hvalue(o); + case LUA_TFUNCTION: return clvalue(o); + case LUA_TTHREAD: return thvalue(o); + case LUA_TUSERDATA: + case LUA_TLIGHTUSERDATA: + return lua_touserdata(L, idx); + default: return NULL; + } + } +} + + /* ** push functions (C -> stack) @@ -200,22 +387,27 @@ LUA_API const void *lua_topointer (lua_State *L, int index) { LUA_API void lua_pushnil (lua_State *L) { - ttype(L->top) = LUA_TNIL; + lua_lock(L); + setnilvalue(L->top); api_incr_top(L); + lua_unlock(L); } -LUA_API void lua_pushnumber (lua_State *L, double n) { - nvalue(L->top) = n; - ttype(L->top) = LUA_TNUMBER; +LUA_API void lua_pushnumber (lua_State *L, lua_Number n) { + lua_lock(L); + setnvalue(L->top, n); api_incr_top(L); + lua_unlock(L); } LUA_API void lua_pushlstring (lua_State *L, const char *s, size_t len) { - tsvalue(L->top) = luaS_newlstr(L, s, len); - ttype(L->top) = LUA_TSTRING; + lua_lock(L); + luaC_checkGC(L); + setsvalue2s(L->top, luaS_newlstr(L, s, len)); api_incr_top(L); + lua_unlock(L); } @@ -227,159 +419,338 @@ LUA_API void lua_pushstring (lua_State *L, const char *s) { } -LUA_API void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n) { - luaV_Cclosure(L, fn, n); +LUA_API const char *lua_pushvfstring (lua_State *L, const char *fmt, + va_list argp) { + const char *ret; + lua_lock(L); + luaC_checkGC(L); + ret = luaO_pushvfstring(L, fmt, argp); + lua_unlock(L); + return ret; } -LUA_API void lua_pushusertag (lua_State *L, void *u, int tag) { - /* ORDER LUA_T */ - if (!(tag == LUA_ANYTAG || tag == LUA_TUSERDATA || validtag(tag))) - luaO_verror(L, "invalid tag for a userdata (%d)", tag); - tsvalue(L->top) = luaS_createudata(L, u, tag); - ttype(L->top) = LUA_TUSERDATA; - api_incr_top(L); +LUA_API const char *lua_pushfstring (lua_State *L, const char *fmt, ...) { + const char *ret; + va_list argp; + lua_lock(L); + luaC_checkGC(L); + va_start(argp, fmt); + ret = luaO_pushvfstring(L, fmt, argp); + va_end(argp); + lua_unlock(L); + return ret; } - -/* -** get functions (Lua -> stack) -*/ +LUA_API void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n) { + Closure *cl; + lua_lock(L); + luaC_checkGC(L); + api_checknelems(L, n); + cl = luaF_newCclosure(L, n); + cl->c.f = fn; + L->top -= n; + while (n--) + setobj2n(&cl->c.upvalue[n], L->top+n); + setclvalue(L->top, cl); + api_incr_top(L); + lua_unlock(L); +} -LUA_API void lua_getglobal (lua_State *L, const char *name) { - StkId top = L->top; - *top = *luaV_getglobal(L, luaS_new(L, name)); - L->top = top; +LUA_API void lua_pushboolean (lua_State *L, int b) { + lua_lock(L); + setbvalue(L->top, (b != 0)); /* ensure that true is 1 */ api_incr_top(L); + lua_unlock(L); } -LUA_API void lua_gettable (lua_State *L, int index) { - StkId t = Index(L, index); - StkId top = L->top; - *(top-1) = *luaV_gettable(L, t); - L->top = top; /* tag method may change top */ +LUA_API void lua_pushlightuserdata (lua_State *L, void *p) { + lua_lock(L); + setpvalue(L->top, p); + api_incr_top(L); + lua_unlock(L); } -LUA_API void lua_rawget (lua_State *L, int index) { - StkId t = Index(L, index); - LUA_ASSERT(ttype(t) == LUA_TTABLE, "table expected"); - *(L->top - 1) = *luaH_get(L, hvalue(t), L->top - 1); -} +/* +** get functions (Lua -> stack) +*/ -LUA_API void lua_rawgeti (lua_State *L, int index, int n) { - StkId o = Index(L, index); - LUA_ASSERT(ttype(o) == LUA_TTABLE, "table expected"); - *L->top = *luaH_getnum(hvalue(o), n); - api_incr_top(L); + +LUA_API void lua_gettable (lua_State *L, int idx) { + StkId t; + lua_lock(L); + t = luaA_index(L, idx); + setobj2s(L->top - 1, luaV_gettable(L, t, L->top - 1, 0)); + lua_unlock(L); } -LUA_API void lua_getglobals (lua_State *L) { - hvalue(L->top) = L->gt; - ttype(L->top) = LUA_TTABLE; - api_incr_top(L); +LUA_API void lua_rawget (lua_State *L, int idx) { + StkId t; + lua_lock(L); + t = luaA_index(L, idx); + api_check(L, ttistable(t)); + setobj2s(L->top - 1, luaH_get(hvalue(t), L->top - 1)); + lua_unlock(L); } -LUA_API int lua_getref (lua_State *L, int ref) { - if (ref == LUA_REFNIL) - ttype(L->top) = LUA_TNIL; - else if (0 <= ref && ref < L->refSize && - (L->refArray[ref].st == LOCK || L->refArray[ref].st == HOLD)) - *L->top = L->refArray[ref].o; - else - return 0; +LUA_API void lua_rawgeti (lua_State *L, int idx, int n) { + StkId o; + lua_lock(L); + o = luaA_index(L, idx); + api_check(L, ttistable(o)); + setobj2s(L->top, luaH_getnum(hvalue(o), n)); api_incr_top(L); - return 1; + lua_unlock(L); } LUA_API void lua_newtable (lua_State *L) { - hvalue(L->top) = luaH_new(L, 0); - ttype(L->top) = LUA_TTABLE; + lua_lock(L); + luaC_checkGC(L); + sethvalue(L->top, luaH_new(L, 0, 0)); api_incr_top(L); + lua_unlock(L); +} + + +LUA_API int lua_getmetatable (lua_State *L, int objindex) { + const TObject *obj; + Table *mt = NULL; + int res; + lua_lock(L); + obj = luaA_indexAcceptable(L, objindex); + if (obj != NULL) { + switch (ttype(obj)) { + case LUA_TTABLE: + mt = hvalue(obj)->metatable; + break; + case LUA_TUSERDATA: + mt = uvalue(obj)->uv.metatable; + break; + } + } + if (mt == NULL || mt == hvalue(defaultmeta(L))) + res = 0; + else { + sethvalue(L->top, mt); + api_incr_top(L); + res = 1; + } + lua_unlock(L); + return res; } +LUA_API void lua_getfenv (lua_State *L, int idx) { + StkId o; + lua_lock(L); + o = luaA_index(L, idx); + setobj2s(L->top, isLfunction(o) ? &clvalue(o)->l.g : gt(L)); + api_incr_top(L); + lua_unlock(L); +} + /* ** set functions (stack -> Lua) */ -LUA_API void lua_setglobal (lua_State *L, const char *name) { - StkId top = L->top; - luaV_setglobal(L, luaS_new(L, name)); - L->top = top-1; /* remove element from the top */ +LUA_API void lua_settable (lua_State *L, int idx) { + StkId t; + lua_lock(L); + api_checknelems(L, 2); + t = luaA_index(L, idx); + luaV_settable(L, t, L->top - 2, L->top - 1); + L->top -= 2; /* pop index and value */ + lua_unlock(L); } -LUA_API void lua_settable (lua_State *L, int index) { - StkId t = Index(L, index); - StkId top = L->top; - luaV_settable(L, t, top-2); - L->top = top-2; /* pop index and value */ +LUA_API void lua_rawset (lua_State *L, int idx) { + StkId t; + lua_lock(L); + api_checknelems(L, 2); + t = luaA_index(L, idx); + api_check(L, ttistable(t)); + setobj2t(luaH_set(L, hvalue(t), L->top-2), L->top-1); /* write barrier */ + L->top -= 2; + lua_unlock(L); } -LUA_API void lua_rawset (lua_State *L, int index) { - StkId t = Index(L, index); - LUA_ASSERT(ttype(t) == LUA_TTABLE, "table expected"); - *luaH_set(L, hvalue(t), L->top-2) = *(L->top-1); - L->top -= 2; +LUA_API void lua_rawseti (lua_State *L, int idx, int n) { + StkId o; + lua_lock(L); + api_checknelems(L, 1); + o = luaA_index(L, idx); + api_check(L, ttistable(o)); + setobj2t(luaH_setnum(L, hvalue(o), n), L->top-1); /* write barrier */ + L->top--; + lua_unlock(L); } -LUA_API void lua_rawseti (lua_State *L, int index, int n) { - StkId o = Index(L, index); - LUA_ASSERT(ttype(o) == LUA_TTABLE, "table expected"); - *luaH_setint(L, hvalue(o), n) = *(L->top-1); +LUA_API int lua_setmetatable (lua_State *L, int objindex) { + TObject *obj, *mt; + int res = 1; + lua_lock(L); + api_checknelems(L, 1); + obj = luaA_index(L, objindex); + mt = (!ttisnil(L->top - 1)) ? L->top - 1 : defaultmeta(L); + api_check(L, ttistable(mt)); + switch (ttype(obj)) { + case LUA_TTABLE: { + hvalue(obj)->metatable = hvalue(mt); /* write barrier */ + break; + } + case LUA_TUSERDATA: { + uvalue(obj)->uv.metatable = hvalue(mt); /* write barrier */ + break; + } + default: { + res = 0; /* cannot set */ + break; + } + } L->top--; + lua_unlock(L); + return res; } -LUA_API void lua_setglobals (lua_State *L) { - StkId newtable = --L->top; - LUA_ASSERT(ttype(newtable) == LUA_TTABLE, "table expected"); - L->gt = hvalue(newtable); +LUA_API int lua_setfenv (lua_State *L, int idx) { + StkId o; + int res = 0; + lua_lock(L); + api_checknelems(L, 1); + o = luaA_index(L, idx); + L->top--; + api_check(L, ttistable(L->top)); + if (isLfunction(o)) { + res = 1; + clvalue(o)->l.g = *(L->top); + } + lua_unlock(L); + return res; } -LUA_API int lua_ref (lua_State *L, int lock) { - int ref; - if (ttype(L->top-1) == LUA_TNIL) - ref = LUA_REFNIL; - else { - if (L->refFree != NONEXT) { /* is there a free place? */ - ref = L->refFree; - L->refFree = L->refArray[ref].st; - } - else { /* no more free places */ - luaM_growvector(L, L->refArray, L->refSize, 1, struct Ref, - "reference table overflow", MAX_INT); - L->nblocks += sizeof(struct Ref); - ref = L->refSize++; - } - L->refArray[ref].o = *(L->top-1); - L->refArray[ref].st = lock ? LOCK : HOLD; - } - L->top--; - return ref; +/* +** `load' and `call' functions (run Lua code) +*/ + +LUA_API void lua_call (lua_State *L, int nargs, int nresults) { + StkId func; + lua_lock(L); + api_checknelems(L, nargs+1); + func = L->top - (nargs+1); + luaD_call(L, func, nresults); + lua_unlock(L); } + /* -** "do" functions (run Lua code) -** (most of them are in ldo.c) +** Execute a protected call. */ +struct CallS { /* data to `f_call' */ + StkId func; + int nresults; +}; + -LUA_API void lua_rawcall (lua_State *L, int nargs, int nresults) { - luaD_call(L, L->top-(nargs+1), nresults); +static void f_call (lua_State *L, void *ud) { + struct CallS *c = cast(struct CallS *, ud); + luaD_call(L, c->func, c->nresults); +} + + + +LUA_API int lua_pcall (lua_State *L, int nargs, int nresults, int errfunc) { + struct CallS c; + int status; + ptrdiff_t func; + lua_lock(L); + func = (errfunc == 0) ? 0 : savestack(L, luaA_index(L, errfunc)); + c.func = L->top - (nargs+1); /* function to be called */ + c.nresults = nresults; + status = luaD_pcall(L, f_call, &c, savestack(L, c.func), func); + lua_unlock(L); + return status; +} + + +/* +** Execute a protected C call. +*/ +struct CCallS { /* data to `f_Ccall' */ + lua_CFunction func; + void *ud; +}; + + +static void f_Ccall (lua_State *L, void *ud) { + struct CCallS *c = cast(struct CCallS *, ud); + Closure *cl; + cl = luaF_newCclosure(L, 0); + cl->c.f = c->func; + setclvalue(L->top, cl); /* push function */ + incr_top(L); + setpvalue(L->top, c->ud); /* push only argument */ + incr_top(L); + luaD_call(L, L->top - 2, 0); +} + + +LUA_API int lua_cpcall (lua_State *L, lua_CFunction func, void *ud) { + struct CCallS c; + int status; + lua_lock(L); + c.func = func; + c.ud = ud; + status = luaD_pcall(L, f_Ccall, &c, savestack(L, L->top), 0); + lua_unlock(L); + return status; +} + + +LUA_API int lua_load (lua_State *L, lua_Chunkreader reader, void *data, + const char *chunkname) { + ZIO z; + int status; + int c; + lua_lock(L); + if (!chunkname) chunkname = "?"; + luaZ_init(&z, reader, data, chunkname); + c = luaZ_lookahead(&z); + status = luaD_protectedparser(L, &z, (c == LUA_SIGNATURE[0])); + lua_unlock(L); + return status; +} + + +LUA_API int lua_dump (lua_State *L, lua_Chunkwriter writer, void *data) { + int status; + TObject *o; + lua_lock(L); + api_checknelems(L, 1); + o = L->top - 1; + if (isLfunction(o) && clvalue(o)->l.nupvalues == 0) { + luaU_dump(L, clvalue(o)->l.p, writer, data); + status = 1; + } + else + status = 0; + lua_unlock(L); + return status; } @@ -388,23 +759,34 @@ LUA_API void lua_rawcall (lua_State *L, int nargs, int nresults) { */ /* GC values are expressed in Kbytes: #bytes/2^10 */ -#define GCscale(x) ((int)((x)>>10)) -#define GCunscale(x) ((unsigned long)(x)<<10) +#define GCscalel(x) ((x)>>10) +#define GCscale(x) (cast(int, GCscalel(x))) +#define GCunscale(x) (cast(lu_mem, x)<<10) LUA_API int lua_getgcthreshold (lua_State *L) { - return GCscale(L->GCthreshold); + int threshold; + lua_lock(L); + threshold = GCscale(G(L)->GCthreshold); + lua_unlock(L); + return threshold; } LUA_API int lua_getgccount (lua_State *L) { - return GCscale(L->nblocks); + int count; + lua_lock(L); + count = GCscale(G(L)->nblocks); + lua_unlock(L); + return count; } LUA_API void lua_setgcthreshold (lua_State *L, int newthreshold) { - if (newthreshold > GCscale(ULONG_MAX)) - L->GCthreshold = ULONG_MAX; + lua_lock(L); + if (cast(lu_mem, newthreshold) > GCscalel(MAX_LUMEM)) + G(L)->GCthreshold = MAX_LUMEM; else - L->GCthreshold = GCunscale(newthreshold); + G(L)->GCthreshold = GCunscale(newthreshold); luaC_checkGC(L); + lua_unlock(L); } @@ -412,83 +794,129 @@ LUA_API void lua_setgcthreshold (lua_State *L, int newthreshold) { ** miscellaneous functions */ -LUA_API void lua_settag (lua_State *L, int tag) { - luaT_realtag(L, tag); - switch (ttype(L->top-1)) { - case LUA_TTABLE: - hvalue(L->top-1)->htag = tag; - break; - case LUA_TUSERDATA: - tsvalue(L->top-1)->u.d.tag = tag; - break; - default: - luaO_verror(L, "cannot change the tag of a %.20s", - luaO_typename(L->top-1)); - } + +LUA_API const char *lua_version (void) { + return LUA_VERSION; } -LUA_API void lua_unref (lua_State *L, int ref) { - if (ref >= 0) { - LUA_ASSERT(ref < L->refSize && L->refArray[ref].st < 0, "invalid ref"); - L->refArray[ref].st = L->refFree; - L->refFree = ref; - } +LUA_API int lua_error (lua_State *L) { + lua_lock(L); + api_checknelems(L, 1); + luaG_errormsg(L); + lua_unlock(L); + return 0; /* to avoid warnings */ } -LUA_API int lua_next (lua_State *L, int index) { - StkId t = luaA_index(L, index); - Node *n; - LUA_ASSERT(ttype(t) == LUA_TTABLE, "table expected"); - n = luaH_next(L, hvalue(t), luaA_index(L, -1)); - if (n) { - *(L->top-1) = *key(n); - *L->top = *val(n); +LUA_API int lua_next (lua_State *L, int idx) { + StkId t; + int more; + lua_lock(L); + t = luaA_index(L, idx); + api_check(L, ttistable(t)); + more = luaH_next(L, hvalue(t), L->top - 1); + if (more) { api_incr_top(L); - return 1; } - else { /* no more elements */ + else /* no more elements */ L->top -= 1; /* remove key */ - return 0; + lua_unlock(L); + return more; +} + + +LUA_API void lua_concat (lua_State *L, int n) { + lua_lock(L); + luaC_checkGC(L); + api_checknelems(L, n); + if (n >= 2) { + luaV_concat(L, n, L->top - L->base - 1); + L->top -= (n-1); + } + else if (n == 0) { /* push empty string */ + setsvalue2s(L->top, luaS_newlstr(L, NULL, 0)); + api_incr_top(L); + } + /* else n == 1; nothing to do */ + lua_unlock(L); +} + + +LUA_API void *lua_newuserdata (lua_State *L, size_t size) { + Udata *u; + lua_lock(L); + luaC_checkGC(L); + u = luaS_newudata(L, size); + setuvalue(L->top, u); + api_incr_top(L); + lua_unlock(L); + return u + 1; +} + + +LUA_API int lua_pushupvalues (lua_State *L) { + Closure *func; + int n, i; + lua_lock(L); + api_check(L, iscfunction(L->base - 1)); + func = clvalue(L->base - 1); + n = func->c.nupvalues; + luaD_checkstack(L, n + LUA_MINSTACK); + for (i=0; i<n; i++) { + setobj2s(L->top, &func->c.upvalue[i]); + L->top++; } + lua_unlock(L); + return n; } -LUA_API int lua_getn (lua_State *L, int index) { - Hash *h = hvalue(luaA_index(L, index)); - const TObject *value = luaH_getstr(h, luaS_new(L, "n")); /* value = h.n */ - if (ttype(value) == LUA_TNUMBER) - return (int)nvalue(value); +static const char *aux_upvalue (lua_State *L, int funcindex, int n, + TObject **val) { + Closure *f; + StkId fi = luaA_index(L, funcindex); + if (!ttisfunction(fi)) return NULL; + f = clvalue(fi); + if (f->c.isC) { + if (n > f->c.nupvalues) return NULL; + *val = &f->c.upvalue[n-1]; + return ""; + } else { - Number max = 0; - int i = h->size; - Node *n = h->node; - while (i--) { - if (ttype(key(n)) == LUA_TNUMBER && - ttype(val(n)) != LUA_TNIL && - nvalue(key(n)) > max) - max = nvalue(key(n)); - n++; - } - return (int)max; + Proto *p = f->l.p; + if (n > p->sizeupvalues) return NULL; + *val = f->l.upvals[n-1]->v; + return getstr(p->upvalues[n-1]); } } -LUA_API void lua_concat (lua_State *L, int n) { - StkId top = L->top; - luaV_strconc(L, n, top); - L->top = top-(n-1); - luaC_checkGC(L); +LUA_API const char *lua_getupvalue (lua_State *L, int funcindex, int n) { + const char *name; + TObject *val; + lua_lock(L); + name = aux_upvalue(L, funcindex, n, &val); + if (name) { + setobj2s(L->top, val); + api_incr_top(L); + } + lua_unlock(L); + return name; } -LUA_API void *lua_newuserdata (lua_State *L, size_t size) { - TString *ts = luaS_newudata(L, (size==0) ? 1 : size, NULL); - tsvalue(L->top) = ts; - ttype(L->top) = LUA_TUSERDATA; - api_incr_top(L); - return ts->u.d.value; +LUA_API const char *lua_setupvalue (lua_State *L, int funcindex, int n) { + const char *name; + TObject *val; + lua_lock(L); + api_checknelems(L, 1); + name = aux_upvalue(L, funcindex, n, &val); + if (name) { + L->top--; + setobj(val, L->top); /* write barrier */ + } + lua_unlock(L); + return name; } @@ -1,5 +1,5 @@ /* -** $Id: lapi.h,v 1.20 2000/08/31 14:08:27 roberto Exp $ +** $Id: lapi.h,v 1.21 2002/03/04 21:29:41 roberto Exp $ ** Auxiliary functions from Lua API ** See Copyright Notice in lua.h */ @@ -11,7 +11,6 @@ #include "lobject.h" -TObject *luaA_index (lua_State *L, int index); void luaA_pushobject (lua_State *L, const TObject *o); #endif diff --git a/src/lcode.c b/src/lcode.c index 6882240d..d626ecd6 100644 --- a/src/lcode.c +++ b/src/lcode.c @@ -1,66 +1,84 @@ /* -** $Id: lcode.c,v 1.51 2000/09/29 12:42:13 roberto Exp $ +** $Id: lcode.c,v 1.117 2003/04/03 13:35:34 roberto Exp $ ** Code generator for Lua ** See Copyright Notice in lua.h */ -#include "stdlib.h" +#include <stdlib.h> + +#define lcode_c #include "lua.h" #include "lcode.h" +#include "ldebug.h" #include "ldo.h" #include "llex.h" #include "lmem.h" #include "lobject.h" #include "lopcodes.h" #include "lparser.h" +#include "ltable.h" -void luaK_error (LexState *ls, const char *msg) { - luaX_error(ls, msg, ls->t.token); -} +#define hasjumps(e) ((e)->t != (e)->f) -/* -** Returns the the previous instruction, for optimizations. -** If there is a jump target between this and the current instruction, -** returns a dummy instruction to avoid wrong optimizations. -*/ -static Instruction previous_instruction (FuncState *fs) { - if (fs->pc > fs->lasttarget) /* no jumps to current position? */ - return fs->f->code[fs->pc-1]; /* returns previous instruction */ - else - return CREATE_0(OP_END); /* no optimizations after an `END' */ +void luaK_nil (FuncState *fs, int from, int n) { + Instruction *previous; + if (fs->pc > fs->lasttarget && /* no jumps to current position? */ + GET_OPCODE(*(previous = &fs->f->code[fs->pc-1])) == OP_LOADNIL) { + int pfrom = GETARG_A(*previous); + int pto = GETARG_B(*previous); + if (pfrom <= from && from <= pto+1) { /* can connect both? */ + if (from+n-1 > pto) + SETARG_B(*previous, from+n-1); + return; + } + } + luaK_codeABC(fs, OP_LOADNIL, from, from+n-1, 0); /* else no optimization */ } int luaK_jump (FuncState *fs) { - int j = luaK_code1(fs, OP_JMP, NO_JUMP); - if (j == fs->lasttarget) { /* possible jumps to this jump? */ - luaK_concat(fs, &j, fs->jlt); /* keep them on hold */ - fs->jlt = NO_JUMP; - } + int jpc = fs->jpc; /* save list of jumps to here */ + int j; + fs->jpc = NO_JUMP; + j = luaK_codeAsBx(fs, OP_JMP, 0, NO_JUMP); + luaK_concat(fs, &j, jpc); /* keep them on hold */ return j; } +static int luaK_condjump (FuncState *fs, OpCode op, int A, int B, int C) { + luaK_codeABC(fs, op, A, B, C); + return luaK_jump(fs); +} + + static void luaK_fixjump (FuncState *fs, int pc, int dest) { Instruction *jmp = &fs->f->code[pc]; - if (dest == NO_JUMP) - SETARG_S(*jmp, NO_JUMP); /* point to itself to represent end of list */ - else { /* jump is relative to position following jump instruction */ - int offset = dest-(pc+1); - if (abs(offset) > MAXARG_S) - luaK_error(fs->ls, "control structure too long"); - SETARG_S(*jmp, offset); - } + int offset = dest-(pc+1); + lua_assert(dest != NO_JUMP); + if (abs(offset) > MAXARG_sBx) + luaX_syntaxerror(fs->ls, "control structure too long"); + SETARG_sBx(*jmp, offset); +} + + +/* +** returns current `pc' and marks it as a jump target (to avoid wrong +** optimizations with consecutive instructions not in the same basic block). +*/ +int luaK_getlabel (FuncState *fs) { + fs->lasttarget = fs->pc; + return fs->pc; } static int luaK_getjump (FuncState *fs, int pc) { - int offset = GETARG_S(fs->f->code[pc]); + int offset = GETARG_sBx(fs->f->code[pc]); if (offset == NO_JUMP) /* point to itself represents end of list */ return NO_JUMP; /* end of list */ else @@ -68,634 +86,629 @@ static int luaK_getjump (FuncState *fs, int pc) { } +static Instruction *getjumpcontrol (FuncState *fs, int pc) { + Instruction *pi = &fs->f->code[pc]; + if (pc >= 1 && testOpMode(GET_OPCODE(*(pi-1)), OpModeT)) + return pi-1; + else + return pi; +} + + /* -** returns current `pc' and marks it as a jump target (to avoid wrong -** optimizations with consecutive instructions not in the same basic block). -** discharge list of jumps to last target. +** check whether list has any jump that do not produce a value +** (or produce an inverted value) */ -int luaK_getlabel (FuncState *fs) { - if (fs->pc != fs->lasttarget) { - int lasttarget = fs->lasttarget; - fs->lasttarget = fs->pc; - luaK_patchlist(fs, fs->jlt, lasttarget); /* discharge old list `jlt' */ - fs->jlt = NO_JUMP; /* nobody jumps to this new label (yet) */ +static int need_value (FuncState *fs, int list, int cond) { + for (; list != NO_JUMP; list = luaK_getjump(fs, list)) { + Instruction i = *getjumpcontrol(fs, list); + if (GET_OPCODE(i) != OP_TEST || GETARG_C(i) != cond) return 1; } - return fs->pc; + return 0; /* not found */ } -void luaK_deltastack (FuncState *fs, int delta) { - fs->stacklevel += delta; - if (fs->stacklevel > fs->f->maxstacksize) { - if (fs->stacklevel > MAXSTACK) - luaK_error(fs->ls, "function or expression too complex"); - fs->f->maxstacksize = fs->stacklevel; - } +static void patchtestreg (Instruction *i, int reg) { + if (reg == NO_REG) reg = GETARG_B(*i); + SETARG_A(*i, reg); } -void luaK_kstr (LexState *ls, int c) { - luaK_code1(ls->fs, OP_PUSHSTRING, c); +static void luaK_patchlistaux (FuncState *fs, int list, + int ttarget, int treg, int ftarget, int freg, int dtarget) { + while (list != NO_JUMP) { + int next = luaK_getjump(fs, list); + Instruction *i = getjumpcontrol(fs, list); + if (GET_OPCODE(*i) != OP_TEST) { + lua_assert(dtarget != NO_JUMP); + luaK_fixjump(fs, list, dtarget); /* jump to default target */ + } + else { + if (GETARG_C(*i)) { + lua_assert(ttarget != NO_JUMP); + patchtestreg(i, treg); + luaK_fixjump(fs, list, ttarget); + } + else { + lua_assert(ftarget != NO_JUMP); + patchtestreg(i, freg); + luaK_fixjump(fs, list, ftarget); + } + } + list = next; + } } -static int number_constant (FuncState *fs, Number r) { - /* check whether `r' has appeared within the last LOOKBACKNUMS entries */ - Proto *f = fs->f; - int c = f->nknum; - int lim = c < LOOKBACKNUMS ? 0 : c-LOOKBACKNUMS; - while (--c >= lim) - if (f->knum[c] == r) return c; - /* not found; create a new entry */ - luaM_growvector(fs->L, f->knum, f->nknum, 1, Number, - "constant table overflow", MAXARG_U); - c = f->nknum++; - f->knum[c] = r; - return c; -} - - -void luaK_number (FuncState *fs, Number f) { - if (f <= (Number)MAXARG_S && (Number)(int)f == f) - luaK_code1(fs, OP_PUSHINT, (int)f); /* f has a short integer value */ - else - luaK_code1(fs, OP_PUSHNUM, number_constant(fs, f)); +static void luaK_dischargejpc (FuncState *fs) { + luaK_patchlistaux(fs, fs->jpc, fs->pc, NO_REG, fs->pc, NO_REG, fs->pc); + fs->jpc = NO_JUMP; } -void luaK_adjuststack (FuncState *fs, int n) { - if (n > 0) - luaK_code1(fs, OP_POP, n); - else - luaK_code1(fs, OP_PUSHNIL, -n); +void luaK_patchlist (FuncState *fs, int list, int target) { + if (target == fs->pc) + luaK_patchtohere(fs, list); + else { + lua_assert(target < fs->pc); + luaK_patchlistaux(fs, list, target, NO_REG, target, NO_REG, target); + } } -int luaK_lastisopen (FuncState *fs) { - /* check whether last instruction is an open function call */ - Instruction i = previous_instruction(fs); - if (GET_OPCODE(i) == OP_CALL && GETARG_B(i) == MULT_RET) - return 1; - else return 0; +void luaK_patchtohere (FuncState *fs, int list) { + luaK_getlabel(fs); + luaK_concat(fs, &fs->jpc, list); } -void luaK_setcallreturns (FuncState *fs, int nresults) { - if (luaK_lastisopen(fs)) { /* expression is an open function call? */ - SETARG_B(fs->f->code[fs->pc-1], nresults); /* set number of results */ - luaK_deltastack(fs, nresults); /* push results */ +void luaK_concat (FuncState *fs, int *l1, int l2) { + if (l2 == NO_JUMP) return; + else if (*l1 == NO_JUMP) + *l1 = l2; + else { + int list = *l1; + int next; + while ((next = luaK_getjump(fs, list)) != NO_JUMP) /* find last element */ + list = next; + luaK_fixjump(fs, list, l2); } } -static int discharge (FuncState *fs, expdesc *var) { - switch (var->k) { - case VLOCAL: - luaK_code1(fs, OP_GETLOCAL, var->u.index); - break; - case VGLOBAL: - luaK_code1(fs, OP_GETGLOBAL, var->u.index); - break; - case VINDEXED: - luaK_code0(fs, OP_GETTABLE); - break; - case VEXP: - return 0; /* nothing to do */ +void luaK_checkstack (FuncState *fs, int n) { + int newstack = fs->freereg + n; + if (newstack > fs->f->maxstacksize) { + if (newstack >= MAXSTACK) + luaX_syntaxerror(fs->ls, "function or expression too complex"); + fs->f->maxstacksize = cast(lu_byte, newstack); } - var->k = VEXP; - var->u.l.t = var->u.l.f = NO_JUMP; - return 1; } -static void discharge1 (FuncState *fs, expdesc *var) { - discharge(fs, var); - /* if it has jumps then it is already discharged */ - if (var->u.l.t == NO_JUMP && var->u.l.f == NO_JUMP) - luaK_setcallreturns(fs, 1); /* call must return 1 value */ +void luaK_reserveregs (FuncState *fs, int n) { + luaK_checkstack(fs, n); + fs->freereg += n; } -void luaK_storevar (LexState *ls, const expdesc *var) { - FuncState *fs = ls->fs; - switch (var->k) { - case VLOCAL: - luaK_code1(fs, OP_SETLOCAL, var->u.index); - break; - case VGLOBAL: - luaK_code1(fs, OP_SETGLOBAL, var->u.index); - break; - case VINDEXED: /* table is at top-3; pop 3 elements after operation */ - luaK_code2(fs, OP_SETTABLE, 3, 3); - break; - default: - LUA_INTERNALERROR("invalid var kind to store"); +static void freereg (FuncState *fs, int reg) { + if (reg >= fs->nactvar && reg < MAXSTACK) { + fs->freereg--; + lua_assert(reg == fs->freereg); } } -static OpCode invertjump (OpCode op) { - switch (op) { - case OP_JMPNE: return OP_JMPEQ; - case OP_JMPEQ: return OP_JMPNE; - case OP_JMPLT: return OP_JMPGE; - case OP_JMPLE: return OP_JMPGT; - case OP_JMPGT: return OP_JMPLE; - case OP_JMPGE: return OP_JMPLT; - case OP_JMPT: case OP_JMPONT: return OP_JMPF; - case OP_JMPF: case OP_JMPONF: return OP_JMPT; - default: - LUA_INTERNALERROR("invalid jump instruction"); - return OP_END; /* to avoid warnings */ - } +static void freeexp (FuncState *fs, expdesc *e) { + if (e->k == VNONRELOC) + freereg(fs, e->info); } -static void luaK_patchlistaux (FuncState *fs, int list, int target, - OpCode special, int special_target) { - Instruction *code = fs->f->code; - while (list != NO_JUMP) { - int next = luaK_getjump(fs, list); - Instruction *i = &code[list]; - OpCode op = GET_OPCODE(*i); - if (op == special) /* this `op' already has a value */ - luaK_fixjump(fs, list, special_target); - else { - luaK_fixjump(fs, list, target); /* do the patch */ - if (op == OP_JMPONT) /* remove eventual values */ - SET_OPCODE(*i, OP_JMPT); - else if (op == OP_JMPONF) - SET_OPCODE(*i, OP_JMPF); - } - list = next; +static int addk (FuncState *fs, TObject *k, TObject *v) { + const TObject *idx = luaH_get(fs->h, k); + if (ttisnumber(idx)) { + lua_assert(luaO_rawequalObj(&fs->f->k[cast(int, nvalue(idx))], v)); + return cast(int, nvalue(idx)); + } + else { /* constant not found; create a new entry */ + Proto *f = fs->f; + luaM_growvector(fs->L, f->k, fs->nk, f->sizek, TObject, + MAXARG_Bx, "constant table overflow"); + setobj2n(&f->k[fs->nk], v); + setnvalue(luaH_set(fs->L, fs->h, k), cast(lua_Number, fs->nk)); + return fs->nk++; } } -void luaK_patchlist (FuncState *fs, int list, int target) { - if (target == fs->lasttarget) /* same target that list `jlt'? */ - luaK_concat(fs, &fs->jlt, list); /* delay fixing */ - else - luaK_patchlistaux(fs, list, target, OP_END, 0); +int luaK_stringK (FuncState *fs, TString *s) { + TObject o; + setsvalue(&o, s); + return addk(fs, &o, &o); } -static int need_value (FuncState *fs, int list, OpCode hasvalue) { - /* check whether list has a jump without a value */ - for (; list != NO_JUMP; list = luaK_getjump(fs, list)) - if (GET_OPCODE(fs->f->code[list]) != hasvalue) return 1; - return 0; /* not found */ +int luaK_numberK (FuncState *fs, lua_Number r) { + TObject o; + setnvalue(&o, r); + return addk(fs, &o, &o); } -void luaK_concat (FuncState *fs, int *l1, int l2) { - if (*l1 == NO_JUMP) - *l1 = l2; - else { - int list = *l1; - for (;;) { /* traverse `l1' */ - int next = luaK_getjump(fs, list); - if (next == NO_JUMP) { /* end of list? */ - luaK_fixjump(fs, list, l2); - return; - } - list = next; - } - } +static int nil_constant (FuncState *fs) { + TObject k, v; + setnilvalue(&v); + sethvalue(&k, fs->h); /* cannot use nil as key; instead use table itself */ + return addk(fs, &k, &v); } -static void luaK_testgo (FuncState *fs, expdesc *v, int invert, OpCode jump) { - int prevpos; /* position of last instruction */ - Instruction *previous; - int *golist, *exitlist; - if (!invert) { - golist = &v->u.l.f; /* go if false */ - exitlist = &v->u.l.t; /* exit if true */ - } - else { - golist = &v->u.l.t; /* go if true */ - exitlist = &v->u.l.f; /* exit if false */ - } - discharge1(fs, v); - prevpos = fs->pc-1; - previous = &fs->f->code[prevpos]; - LUA_ASSERT(*previous==previous_instruction(fs), "no jump allowed here"); - if (!ISJUMP(GET_OPCODE(*previous))) - prevpos = luaK_code1(fs, jump, NO_JUMP); - else { /* last instruction is already a jump */ - if (invert) - SET_OPCODE(*previous, invertjump(GET_OPCODE(*previous))); +void luaK_setcallreturns (FuncState *fs, expdesc *e, int nresults) { + if (e->k == VCALL) { /* expression is an open function call? */ + SETARG_C(getcode(fs, e), nresults+1); + if (nresults == 1) { /* `regular' expression? */ + e->k = VNONRELOC; + e->info = GETARG_A(getcode(fs, e)); + } } - luaK_concat(fs, exitlist, prevpos); /* insert last jump in `exitlist' */ - luaK_patchlist(fs, *golist, luaK_getlabel(fs)); - *golist = NO_JUMP; } -void luaK_goiftrue (FuncState *fs, expdesc *v, int keepvalue) { - luaK_testgo(fs, v, 1, keepvalue ? OP_JMPONF : OP_JMPF); +void luaK_dischargevars (FuncState *fs, expdesc *e) { + switch (e->k) { + case VLOCAL: { + e->k = VNONRELOC; + break; + } + case VUPVAL: { + e->info = luaK_codeABC(fs, OP_GETUPVAL, 0, e->info, 0); + e->k = VRELOCABLE; + break; + } + case VGLOBAL: { + e->info = luaK_codeABx(fs, OP_GETGLOBAL, 0, e->info); + e->k = VRELOCABLE; + break; + } + case VINDEXED: { + freereg(fs, e->aux); + freereg(fs, e->info); + e->info = luaK_codeABC(fs, OP_GETTABLE, 0, e->info, e->aux); + e->k = VRELOCABLE; + break; + } + case VCALL: { + luaK_setcallreturns(fs, e, 1); + break; + } + default: break; /* there is one value available (somewhere) */ + } } -static void luaK_goiffalse (FuncState *fs, expdesc *v, int keepvalue) { - luaK_testgo(fs, v, 0, keepvalue ? OP_JMPONT : OP_JMPT); +static int code_label (FuncState *fs, int A, int b, int jump) { + luaK_getlabel(fs); /* those instructions may be jump targets */ + return luaK_codeABC(fs, OP_LOADBOOL, A, b, jump); } -static int code_label (FuncState *fs, OpCode op, int arg) { - luaK_getlabel(fs); /* those instructions may be jump targets */ - return luaK_code1(fs, op, arg); -} - - -void luaK_tostack (LexState *ls, expdesc *v, int onlyone) { - FuncState *fs = ls->fs; - if (!discharge(fs, v)) { /* `v' is an expression? */ - OpCode previous = GET_OPCODE(fs->f->code[fs->pc-1]); - if (!ISJUMP(previous) && v->u.l.f == NO_JUMP && v->u.l.t == NO_JUMP) { - /* expression has no jumps */ - if (onlyone) - luaK_setcallreturns(fs, 1); /* call must return 1 value */ - } - else { /* expression has jumps */ - int final; /* position after whole expression */ - int j = NO_JUMP; /* eventual jump over values */ - int p_nil = NO_JUMP; /* position of an eventual PUSHNIL */ - int p_1 = NO_JUMP; /* position of an eventual PUSHINT */ - if (ISJUMP(previous) || need_value(fs, v->u.l.f, OP_JMPONF) - || need_value(fs, v->u.l.t, OP_JMPONT)) { - /* expression needs values */ - if (ISJUMP(previous)) - luaK_concat(fs, &v->u.l.t, fs->pc-1); /* put `previous' in t. list */ - else { - j = code_label(fs, OP_JMP, NO_JUMP); /* to jump over both pushes */ - /* correct stack for compiler and symbolic execution */ - luaK_adjuststack(fs, 1); - } - p_nil = code_label(fs, OP_PUSHNILJMP, 0); - p_1 = code_label(fs, OP_PUSHINT, 1); - luaK_patchlist(fs, j, luaK_getlabel(fs)); - } - final = luaK_getlabel(fs); - luaK_patchlistaux(fs, v->u.l.f, p_nil, OP_JMPONF, final); - luaK_patchlistaux(fs, v->u.l.t, p_1, OP_JMPONT, final); - v->u.l.f = v->u.l.t = NO_JUMP; +static void discharge2reg (FuncState *fs, expdesc *e, int reg) { + luaK_dischargevars(fs, e); + switch (e->k) { + case VNIL: { + luaK_nil(fs, reg, 1); + break; + } + case VFALSE: case VTRUE: { + luaK_codeABC(fs, OP_LOADBOOL, reg, e->k == VTRUE, 0); + break; + } + case VK: { + luaK_codeABx(fs, OP_LOADK, reg, e->info); + break; + } + case VRELOCABLE: { + Instruction *pc = &getcode(fs, e); + SETARG_A(*pc, reg); + break; + } + case VNONRELOC: { + if (reg != e->info) + luaK_codeABC(fs, OP_MOVE, reg, e->info, 0); + break; + } + default: { + lua_assert(e->k == VVOID || e->k == VJMP); + return; /* nothing to do... */ } } + e->info = reg; + e->k = VNONRELOC; } -void luaK_prefix (LexState *ls, UnOpr op, expdesc *v) { - FuncState *fs = ls->fs; - if (op == OPR_MINUS) { - luaK_tostack(ls, v, 1); - luaK_code0(fs, OP_MINUS); +static void discharge2anyreg (FuncState *fs, expdesc *e) { + if (e->k != VNONRELOC) { + luaK_reserveregs(fs, 1); + discharge2reg(fs, e, fs->freereg-1); } - else { /* op == NOT */ - Instruction *previous; - discharge1(fs, v); - previous = &fs->f->code[fs->pc-1]; - if (ISJUMP(GET_OPCODE(*previous))) - SET_OPCODE(*previous, invertjump(GET_OPCODE(*previous))); - else - luaK_code0(fs, OP_NOT); - /* interchange true and false lists */ - { int temp = v->u.l.f; v->u.l.f = v->u.l.t; v->u.l.t = temp; } +} + + +static void luaK_exp2reg (FuncState *fs, expdesc *e, int reg) { + discharge2reg(fs, e, reg); + if (e->k == VJMP) + luaK_concat(fs, &e->t, e->info); /* put this jump in `t' list */ + if (hasjumps(e)) { + int final; /* position after whole expression */ + int p_f = NO_JUMP; /* position of an eventual LOAD false */ + int p_t = NO_JUMP; /* position of an eventual LOAD true */ + if (need_value(fs, e->t, 1) || need_value(fs, e->f, 0)) { + int fj = NO_JUMP; /* first jump (over LOAD ops.) */ + if (e->k != VJMP) + fj = luaK_jump(fs); + p_f = code_label(fs, reg, 0, 1); + p_t = code_label(fs, reg, 1, 0); + luaK_patchtohere(fs, fj); + } + final = luaK_getlabel(fs); + luaK_patchlistaux(fs, e->f, p_f, NO_REG, final, reg, p_f); + luaK_patchlistaux(fs, e->t, final, reg, p_t, NO_REG, p_t); } + e->f = e->t = NO_JUMP; + e->info = reg; + e->k = VNONRELOC; } -void luaK_infix (LexState *ls, BinOpr op, expdesc *v) { - FuncState *fs = ls->fs; - switch (op) { - case OPR_AND: - luaK_goiftrue(fs, v, 1); - break; - case OPR_OR: - luaK_goiffalse(fs, v, 1); - break; - default: - luaK_tostack(ls, v, 1); /* all other binary operators need a value */ +void luaK_exp2nextreg (FuncState *fs, expdesc *e) { + luaK_dischargevars(fs, e); + freeexp(fs, e); + luaK_reserveregs(fs, 1); + luaK_exp2reg(fs, e, fs->freereg - 1); +} + + +int luaK_exp2anyreg (FuncState *fs, expdesc *e) { + luaK_dischargevars(fs, e); + if (e->k == VNONRELOC) { + if (!hasjumps(e)) return e->info; /* exp is already in a register */ + if (e->info >= fs->nactvar) { /* reg. is not a local? */ + luaK_exp2reg(fs, e, e->info); /* put value on it */ + return e->info; + } } + luaK_exp2nextreg(fs, e); /* default */ + return e->info; } +void luaK_exp2val (FuncState *fs, expdesc *e) { + if (hasjumps(e)) + luaK_exp2anyreg(fs, e); + else + luaK_dischargevars(fs, e); +} -static const struct { - OpCode opcode; /* opcode for each binary operator */ - int arg; /* default argument for the opcode */ -} codes[] = { /* ORDER OPR */ - {OP_ADD, 0}, {OP_SUB, 0}, {OP_MULT, 0}, {OP_DIV, 0}, - {OP_POW, 0}, {OP_CONCAT, 2}, - {OP_JMPNE, NO_JUMP}, {OP_JMPEQ, NO_JUMP}, - {OP_JMPLT, NO_JUMP}, {OP_JMPLE, NO_JUMP}, - {OP_JMPGT, NO_JUMP}, {OP_JMPGE, NO_JUMP} -}; +int luaK_exp2RK (FuncState *fs, expdesc *e) { + luaK_exp2val(fs, e); + switch (e->k) { + case VNIL: { + if (fs->nk + MAXSTACK <= MAXARG_C) { /* constant fit in argC? */ + e->info = nil_constant(fs); + e->k = VK; + return e->info + MAXSTACK; + } + else break; + } + case VK: { + if (e->info + MAXSTACK <= MAXARG_C) /* constant fit in argC? */ + return e->info + MAXSTACK; + else break; + } + default: break; + } + /* not a constant in the right range: put it in a register */ + return luaK_exp2anyreg(fs, e); +} -void luaK_posfix (LexState *ls, BinOpr op, expdesc *v1, expdesc *v2) { - FuncState *fs = ls->fs; - switch (op) { - case OPR_AND: { - LUA_ASSERT(v1->u.l.t == NO_JUMP, "list must be closed"); - discharge1(fs, v2); - v1->u.l.t = v2->u.l.t; - luaK_concat(fs, &v1->u.l.f, v2->u.l.f); + +void luaK_storevar (FuncState *fs, expdesc *var, expdesc *exp) { + switch (var->k) { + case VLOCAL: { + freeexp(fs, exp); + luaK_exp2reg(fs, exp, var->info); + return; + } + case VUPVAL: { + int e = luaK_exp2anyreg(fs, exp); + luaK_codeABC(fs, OP_SETUPVAL, e, var->info, 0); break; } - case OPR_OR: { - LUA_ASSERT(v1->u.l.f == NO_JUMP, "list must be closed"); - discharge1(fs, v2); - v1->u.l.f = v2->u.l.f; - luaK_concat(fs, &v1->u.l.t, v2->u.l.t); + case VGLOBAL: { + int e = luaK_exp2anyreg(fs, exp); + luaK_codeABx(fs, OP_SETGLOBAL, e, var->info); + break; + } + case VINDEXED: { + int e = luaK_exp2RK(fs, exp); + luaK_codeABC(fs, OP_SETTABLE, var->info, var->aux, e); break; } default: { - luaK_tostack(ls, v2, 1); /* `v2' must be a value */ - luaK_code1(fs, codes[op].opcode, codes[op].arg); + lua_assert(0); /* invalid var kind to store */ + break; } } + freeexp(fs, exp); } -static void codelineinfo (FuncState *fs) { - Proto *f = fs->f; - LexState *ls = fs->ls; - if (ls->lastline > fs->lastline) { - luaM_growvector(fs->L, f->lineinfo, f->nlineinfo, 2, int, - "line info overflow", MAX_INT); - if (ls->lastline > fs->lastline+1) - f->lineinfo[f->nlineinfo++] = -(ls->lastline - (fs->lastline+1)); - f->lineinfo[f->nlineinfo++] = fs->pc; - fs->lastline = ls->lastline; - } +void luaK_self (FuncState *fs, expdesc *e, expdesc *key) { + int func; + luaK_exp2anyreg(fs, e); + freeexp(fs, e); + func = fs->freereg; + luaK_reserveregs(fs, 2); + luaK_codeABC(fs, OP_SELF, func, e->info, luaK_exp2RK(fs, key)); + freeexp(fs, key); + e->info = func; + e->k = VNONRELOC; } -int luaK_code0 (FuncState *fs, OpCode o) { - return luaK_code2(fs, o, 0, 0); +static void invertjump (FuncState *fs, expdesc *e) { + Instruction *pc = getjumpcontrol(fs, e->info); + lua_assert(testOpMode(GET_OPCODE(*pc), OpModeT) && + GET_OPCODE(*pc) != OP_TEST); + SETARG_A(*pc, !(GETARG_A(*pc))); } -int luaK_code1 (FuncState *fs, OpCode o, int arg1) { - return luaK_code2(fs, o, arg1, 0); +static int jumponcond (FuncState *fs, expdesc *e, int cond) { + if (e->k == VRELOCABLE) { + Instruction ie = getcode(fs, e); + if (GET_OPCODE(ie) == OP_NOT) { + fs->pc--; /* remove previous OP_NOT */ + return luaK_condjump(fs, OP_TEST, NO_REG, GETARG_B(ie), !cond); + } + /* else go through */ + } + discharge2anyreg(fs, e); + freeexp(fs, e); + return luaK_condjump(fs, OP_TEST, NO_REG, e->info, cond); } -int luaK_code2 (FuncState *fs, OpCode o, int arg1, int arg2) { - Instruction i = previous_instruction(fs); - int delta = luaK_opproperties[o].push - luaK_opproperties[o].pop; - int optm = 0; /* 1 when there is an optimization */ - switch (o) { - case OP_CLOSURE: { - delta = -arg2+1; +void luaK_goiftrue (FuncState *fs, expdesc *e) { + int pc; /* pc of last jump */ + luaK_dischargevars(fs, e); + switch (e->k) { + case VK: case VTRUE: { + pc = NO_JUMP; /* always true; do nothing */ break; } - case OP_SETTABLE: { - delta = -arg2; + case VFALSE: { + pc = luaK_jump(fs); /* always jump */ break; } - case OP_SETLIST: { - if (arg2 == 0) return NO_JUMP; /* nothing to do */ - delta = -arg2; + case VJMP: { + invertjump(fs, e); + pc = e->info; break; } - case OP_SETMAP: { - if (arg1 == 0) return NO_JUMP; /* nothing to do */ - delta = -2*arg1; + default: { + pc = jumponcond(fs, e, 0); break; } - case OP_RETURN: { - if (GET_OPCODE(i) == OP_CALL && GETARG_B(i) == MULT_RET) { - SET_OPCODE(i, OP_TAILCALL); - SETARG_B(i, arg1); - optm = 1; - } + } + luaK_concat(fs, &e->f, pc); /* insert last jump in `f' list */ +} + + +void luaK_goiffalse (FuncState *fs, expdesc *e) { + int pc; /* pc of last jump */ + luaK_dischargevars(fs, e); + switch (e->k) { + case VNIL: case VFALSE: { + pc = NO_JUMP; /* always false; do nothing */ break; } - case OP_PUSHNIL: { - if (arg1 == 0) return NO_JUMP; /* nothing to do */ - delta = arg1; - switch(GET_OPCODE(i)) { - case OP_PUSHNIL: SETARG_U(i, GETARG_U(i)+arg1); optm = 1; break; - default: break; - } + case VTRUE: { + pc = luaK_jump(fs); /* always jump */ break; } - case OP_POP: { - if (arg1 == 0) return NO_JUMP; /* nothing to do */ - delta = -arg1; - switch(GET_OPCODE(i)) { - case OP_SETTABLE: SETARG_B(i, GETARG_B(i)+arg1); optm = 1; break; - default: break; - } + case VJMP: { + pc = e->info; break; } - case OP_GETTABLE: { - switch(GET_OPCODE(i)) { - case OP_PUSHSTRING: /* `t.x' */ - SET_OPCODE(i, OP_GETDOTTED); - optm = 1; - break; - case OP_GETLOCAL: /* `t[i]' */ - SET_OPCODE(i, OP_GETINDEXED); - optm = 1; - break; - default: break; - } + default: { + pc = jumponcond(fs, e, 1); break; } - case OP_ADD: { - switch(GET_OPCODE(i)) { - case OP_PUSHINT: SET_OPCODE(i, OP_ADDI); optm = 1; break; /* `a+k' */ - default: break; - } + } + luaK_concat(fs, &e->t, pc); /* insert last jump in `t' list */ +} + + +static void codenot (FuncState *fs, expdesc *e) { + luaK_dischargevars(fs, e); + switch (e->k) { + case VNIL: case VFALSE: { + e->k = VTRUE; break; } - case OP_SUB: { - switch(GET_OPCODE(i)) { - case OP_PUSHINT: /* `a-k' */ - i = CREATE_S(OP_ADDI, -GETARG_S(i)); - optm = 1; - break; - default: break; - } + case VK: case VTRUE: { + e->k = VFALSE; break; } - case OP_CONCAT: { - delta = -arg1+1; - switch(GET_OPCODE(i)) { - case OP_CONCAT: /* `a..b..c' */ - SETARG_U(i, GETARG_U(i)+1); - optm = 1; - break; - default: break; - } + case VJMP: { + invertjump(fs, e); break; } - case OP_MINUS: { - switch(GET_OPCODE(i)) { - case OP_PUSHINT: /* `-k' */ - SETARG_S(i, -GETARG_S(i)); - optm = 1; - break; - case OP_PUSHNUM: /* `-k' */ - SET_OPCODE(i, OP_PUSHNEGNUM); - optm = 1; - break; - default: break; - } + case VRELOCABLE: + case VNONRELOC: { + discharge2anyreg(fs, e); + freeexp(fs, e); + e->info = luaK_codeABC(fs, OP_NOT, 0, e->info, 0); + e->k = VRELOCABLE; break; } - case OP_JMPNE: { - if (i == CREATE_U(OP_PUSHNIL, 1)) { /* `a~=nil' */ - i = CREATE_S(OP_JMPT, NO_JUMP); - optm = 1; - } + default: { + lua_assert(0); /* cannot happen */ break; } - case OP_JMPEQ: { - if (i == CREATE_U(OP_PUSHNIL, 1)) { /* `a==nil' */ - i = CREATE_0(OP_NOT); - delta = -1; /* just undo effect of previous PUSHNIL */ - optm = 1; - } - break; + } + /* interchange true and false lists */ + { int temp = e->f; e->f = e->t; e->t = temp; } +} + + +void luaK_indexed (FuncState *fs, expdesc *t, expdesc *k) { + t->aux = luaK_exp2RK(fs, k); + t->k = VINDEXED; +} + + +void luaK_prefix (FuncState *fs, UnOpr op, expdesc *e) { + if (op == OPR_MINUS) { + luaK_exp2val(fs, e); + if (e->k == VK && ttisnumber(&fs->f->k[e->info])) + e->info = luaK_numberK(fs, -nvalue(&fs->f->k[e->info])); + else { + luaK_exp2anyreg(fs, e); + freeexp(fs, e); + e->info = luaK_codeABC(fs, OP_UNM, 0, e->info, 0); + e->k = VRELOCABLE; } - case OP_JMPT: - case OP_JMPONT: { - switch (GET_OPCODE(i)) { - case OP_NOT: { - i = CREATE_S(OP_JMPF, NO_JUMP); - optm = 1; - break; - } - case OP_PUSHINT: { - if (o == OP_JMPT) { /* JMPONT must keep original integer value */ - i = CREATE_S(OP_JMP, NO_JUMP); - optm = 1; - } - break; - } - case OP_PUSHNIL: { - if (GETARG_U(i) == 1) { - fs->pc--; /* erase previous instruction */ - luaK_deltastack(fs, -1); /* correct stack */ - return NO_JUMP; - } - break; - } - default: break; - } + } + else /* op == NOT */ + codenot(fs, e); +} + + +void luaK_infix (FuncState *fs, BinOpr op, expdesc *v) { + switch (op) { + case OPR_AND: { + luaK_goiftrue(fs, v); + luaK_patchtohere(fs, v->t); + v->t = NO_JUMP; break; } - case OP_JMPF: - case OP_JMPONF: { - switch (GET_OPCODE(i)) { - case OP_NOT: { - i = CREATE_S(OP_JMPT, NO_JUMP); - optm = 1; - break; - } - case OP_PUSHINT: { /* `while 1 do ...' */ - fs->pc--; /* erase previous instruction */ - luaK_deltastack(fs, -1); /* correct stack */ - return NO_JUMP; - } - case OP_PUSHNIL: { /* `repeat ... until nil' */ - if (GETARG_U(i) == 1) { - i = CREATE_S(OP_JMP, NO_JUMP); - optm = 1; - } - break; - } - default: break; - } + case OPR_OR: { + luaK_goiffalse(fs, v); + luaK_patchtohere(fs, v->f); + v->f = NO_JUMP; break; } - case OP_GETDOTTED: - case OP_GETINDEXED: - case OP_TAILCALL: - case OP_ADDI: { - LUA_INTERNALERROR("instruction used only for optimizations"); + case OPR_CONCAT: { + luaK_exp2nextreg(fs, v); /* operand must be on the `stack' */ break; } default: { - LUA_ASSERT(delta != VD, "invalid delta"); + luaK_exp2RK(fs, v); break; } } - luaK_deltastack(fs, delta); - if (optm) { /* optimize: put instruction in place of last one */ - fs->f->code[fs->pc-1] = i; /* change previous instruction */ - return fs->pc-1; /* do not generate new instruction */ +} + + +static void codebinop (FuncState *fs, expdesc *res, BinOpr op, + int o1, int o2) { + if (op <= OPR_POW) { /* arithmetic operator? */ + OpCode opc = cast(OpCode, (op - OPR_ADD) + OP_ADD); /* ORDER OP */ + res->info = luaK_codeABC(fs, opc, 0, o1, o2); + res->k = VRELOCABLE; } - /* else build new instruction */ - switch ((enum Mode)luaK_opproperties[o].mode) { - case iO: i = CREATE_0(o); break; - case iU: i = CREATE_U(o, arg1); break; - case iS: i = CREATE_S(o, arg1); break; - case iAB: i = CREATE_AB(o, arg1, arg2); break; + else { /* test operator */ + static const OpCode ops[] = {OP_EQ, OP_EQ, OP_LT, OP_LE, OP_LT, OP_LE}; + int cond = 1; + if (op >= OPR_GT) { /* `>' or `>='? */ + int temp; /* exchange args and replace by `<' or `<=' */ + temp = o1; o1 = o2; o2 = temp; /* o1 <==> o2 */ + } + else if (op == OPR_NE) cond = 0; + res->info = luaK_condjump(fs, ops[op - OPR_NE], cond, o1, o2); + res->k = VJMP; } - codelineinfo(fs); +} + + +void luaK_posfix (FuncState *fs, BinOpr op, expdesc *e1, expdesc *e2) { + switch (op) { + case OPR_AND: { + lua_assert(e1->t == NO_JUMP); /* list must be closed */ + luaK_dischargevars(fs, e2); + luaK_concat(fs, &e1->f, e2->f); + e1->k = e2->k; e1->info = e2->info; e1->aux = e2->aux; e1->t = e2->t; + break; + } + case OPR_OR: { + lua_assert(e1->f == NO_JUMP); /* list must be closed */ + luaK_dischargevars(fs, e2); + luaK_concat(fs, &e1->t, e2->t); + e1->k = e2->k; e1->info = e2->info; e1->aux = e2->aux; e1->f = e2->f; + break; + } + case OPR_CONCAT: { + luaK_exp2val(fs, e2); + if (e2->k == VRELOCABLE && GET_OPCODE(getcode(fs, e2)) == OP_CONCAT) { + lua_assert(e1->info == GETARG_B(getcode(fs, e2))-1); + freeexp(fs, e1); + SETARG_B(getcode(fs, e2), e1->info); + e1->k = e2->k; e1->info = e2->info; + } + else { + luaK_exp2nextreg(fs, e2); + freeexp(fs, e2); + freeexp(fs, e1); + e1->info = luaK_codeABC(fs, OP_CONCAT, 0, e1->info, e2->info); + e1->k = VRELOCABLE; + } + break; + } + default: { + int o1 = luaK_exp2RK(fs, e1); + int o2 = luaK_exp2RK(fs, e2); + freeexp(fs, e2); + freeexp(fs, e1); + codebinop(fs, e1, op, o1, o2); + } + } +} + + +void luaK_fixline (FuncState *fs, int line) { + fs->f->lineinfo[fs->pc - 1] = line; +} + + +int luaK_code (FuncState *fs, Instruction i, int line) { + Proto *f = fs->f; + luaK_dischargejpc(fs); /* `pc' will change */ /* put new instruction in code array */ - luaM_growvector(fs->L, fs->f->code, fs->pc, 1, Instruction, - "code size overflow", MAX_INT); - fs->f->code[fs->pc] = i; + luaM_growvector(fs->L, f->code, fs->pc, f->sizecode, Instruction, + MAX_INT, "code size overflow"); + f->code[fs->pc] = i; + /* save corresponding line information */ + luaM_growvector(fs->L, f->lineinfo, fs->pc, f->sizelineinfo, int, + MAX_INT, "code size overflow"); + f->lineinfo[fs->pc] = line; return fs->pc++; } -const struct OpProperties luaK_opproperties[NUM_OPCODES] = { - {iO, 0, 0}, /* OP_END */ - {iU, 0, 0}, /* OP_RETURN */ - {iAB, 0, 0}, /* OP_CALL */ - {iAB, 0, 0}, /* OP_TAILCALL */ - {iU, VD, 0}, /* OP_PUSHNIL */ - {iU, VD, 0}, /* OP_POP */ - {iS, 1, 0}, /* OP_PUSHINT */ - {iU, 1, 0}, /* OP_PUSHSTRING */ - {iU, 1, 0}, /* OP_PUSHNUM */ - {iU, 1, 0}, /* OP_PUSHNEGNUM */ - {iU, 1, 0}, /* OP_PUSHUPVALUE */ - {iU, 1, 0}, /* OP_GETLOCAL */ - {iU, 1, 0}, /* OP_GETGLOBAL */ - {iO, 1, 2}, /* OP_GETTABLE */ - {iU, 1, 1}, /* OP_GETDOTTED */ - {iU, 1, 1}, /* OP_GETINDEXED */ - {iU, 2, 1}, /* OP_PUSHSELF */ - {iU, 1, 0}, /* OP_CREATETABLE */ - {iU, 0, 1}, /* OP_SETLOCAL */ - {iU, 0, 1}, /* OP_SETGLOBAL */ - {iAB, VD, 0}, /* OP_SETTABLE */ - {iAB, VD, 0}, /* OP_SETLIST */ - {iU, VD, 0}, /* OP_SETMAP */ - {iO, 1, 2}, /* OP_ADD */ - {iS, 1, 1}, /* OP_ADDI */ - {iO, 1, 2}, /* OP_SUB */ - {iO, 1, 2}, /* OP_MULT */ - {iO, 1, 2}, /* OP_DIV */ - {iO, 1, 2}, /* OP_POW */ - {iU, VD, 0}, /* OP_CONCAT */ - {iO, 1, 1}, /* OP_MINUS */ - {iO, 1, 1}, /* OP_NOT */ - {iS, 0, 2}, /* OP_JMPNE */ - {iS, 0, 2}, /* OP_JMPEQ */ - {iS, 0, 2}, /* OP_JMPLT */ - {iS, 0, 2}, /* OP_JMPLE */ - {iS, 0, 2}, /* OP_JMPGT */ - {iS, 0, 2}, /* OP_JMPGE */ - {iS, 0, 1}, /* OP_JMPT */ - {iS, 0, 1}, /* OP_JMPF */ - {iS, 0, 1}, /* OP_JMPONT */ - {iS, 0, 1}, /* OP_JMPONF */ - {iS, 0, 0}, /* OP_JMP */ - {iO, 0, 0}, /* OP_PUSHNILJMP */ - {iS, 0, 0}, /* OP_FORPREP */ - {iS, 0, 3}, /* OP_FORLOOP */ - {iS, 2, 0}, /* OP_LFORPREP */ - {iS, 0, 3}, /* OP_LFORLOOP */ - {iAB, VD, 0} /* OP_CLOSURE */ -}; +int luaK_codeABC (FuncState *fs, OpCode o, int a, int b, int c) { + lua_assert(getOpMode(o) == iABC); + return luaK_code(fs, CREATE_ABC(o, a, b, c), fs->ls->lastline); +} + + +int luaK_codeABx (FuncState *fs, OpCode o, int a, unsigned int bc) { + lua_assert(getOpMode(o) == iABx || getOpMode(o) == iAsBx); + return luaK_code(fs, CREATE_ABx(o, a, bc), fs->ls->lastline); +} diff --git a/src/lcode.h b/src/lcode.h index 3f0a209a..74908c65 100644 --- a/src/lcode.h +++ b/src/lcode.h @@ -1,5 +1,5 @@ /* -** $Id: lcode.h,v 1.16 2000/08/09 14:49:13 roberto Exp $ +** $Id: lcode.h,v 1.38 2002/12/11 12:34:22 roberto Exp $ ** Code generator for Lua ** See Copyright Notice in lua.h */ @@ -26,45 +26,49 @@ typedef enum BinOpr { OPR_ADD, OPR_SUB, OPR_MULT, OPR_DIV, OPR_POW, OPR_CONCAT, - OPR_NE, OPR_EQ, OPR_LT, OPR_LE, OPR_GT, OPR_GE, + OPR_NE, OPR_EQ, + OPR_LT, OPR_LE, OPR_GT, OPR_GE, OPR_AND, OPR_OR, OPR_NOBINOPR } BinOpr; -typedef enum UnOpr { OPR_MINUS, OPR_NOT, OPR_NOUNOPR } UnOpr; - +#define binopistest(op) ((op) >= OPR_NE) -enum Mode {iO, iU, iS, iAB}; /* instruction format */ +typedef enum UnOpr { OPR_MINUS, OPR_NOT, OPR_NOUNOPR } UnOpr; -#define VD 100 /* flag for variable delta */ -extern const struct OpProperties { - char mode; - unsigned char push; - unsigned char pop; -} luaK_opproperties[]; +#define getcode(fs,e) ((fs)->f->code[(e)->info]) +#define luaK_codeAsBx(fs,o,A,sBx) luaK_codeABx(fs,o,A,(sBx)+MAXARG_sBx) -void luaK_error (LexState *ls, const char *msg); -int luaK_code0 (FuncState *fs, OpCode o); -int luaK_code1 (FuncState *fs, OpCode o, int arg1); -int luaK_code2 (FuncState *fs, OpCode o, int arg1, int arg2); +int luaK_code (FuncState *fs, Instruction i, int line); +int luaK_codeABx (FuncState *fs, OpCode o, int A, unsigned int Bx); +int luaK_codeABC (FuncState *fs, OpCode o, int A, int B, int C); +void luaK_fixline (FuncState *fs, int line); +void luaK_nil (FuncState *fs, int from, int n); +void luaK_reserveregs (FuncState *fs, int n); +void luaK_checkstack (FuncState *fs, int n); +int luaK_stringK (FuncState *fs, TString *s); +int luaK_numberK (FuncState *fs, lua_Number r); +void luaK_dischargevars (FuncState *fs, expdesc *e); +int luaK_exp2anyreg (FuncState *fs, expdesc *e); +void luaK_exp2nextreg (FuncState *fs, expdesc *e); +void luaK_exp2val (FuncState *fs, expdesc *e); +int luaK_exp2RK (FuncState *fs, expdesc *e); +void luaK_self (FuncState *fs, expdesc *e, expdesc *key); +void luaK_indexed (FuncState *fs, expdesc *t, expdesc *k); +void luaK_goiftrue (FuncState *fs, expdesc *e); +void luaK_goiffalse (FuncState *fs, expdesc *e); +void luaK_storevar (FuncState *fs, expdesc *var, expdesc *e); +void luaK_setcallreturns (FuncState *fs, expdesc *var, int nresults); int luaK_jump (FuncState *fs); void luaK_patchlist (FuncState *fs, int list, int target); +void luaK_patchtohere (FuncState *fs, int list); void luaK_concat (FuncState *fs, int *l1, int l2); -void luaK_goiftrue (FuncState *fs, expdesc *v, int keepvalue); int luaK_getlabel (FuncState *fs); -void luaK_deltastack (FuncState *fs, int delta); -void luaK_kstr (LexState *ls, int c); -void luaK_number (FuncState *fs, Number f); -void luaK_adjuststack (FuncState *fs, int n); -int luaK_lastisopen (FuncState *fs); -void luaK_setcallreturns (FuncState *fs, int nresults); -void luaK_tostack (LexState *ls, expdesc *v, int onlyone); -void luaK_storevar (LexState *ls, const expdesc *var); -void luaK_prefix (LexState *ls, UnOpr op, expdesc *v); -void luaK_infix (LexState *ls, BinOpr op, expdesc *v); -void luaK_posfix (LexState *ls, BinOpr op, expdesc *v1, expdesc *v2); +void luaK_prefix (FuncState *fs, UnOpr op, expdesc *v); +void luaK_infix (FuncState *fs, BinOpr op, expdesc *v); +void luaK_posfix (FuncState *fs, BinOpr op, expdesc *v1, expdesc *v2); #endif diff --git a/src/ldebug.c b/src/ldebug.c index a5a2ab1d..8e511e3b 100644 --- a/src/ldebug.c +++ b/src/ldebug.c @@ -1,11 +1,14 @@ /* -** $Id: ldebug.c,v 1.50 2000/10/30 12:38:50 roberto Exp $ +** $Id: ldebug.c,v 1.150 2003/03/19 21:24:04 roberto Exp $ ** Debug Interface ** See Copyright Notice in lua.h */ #include <stdlib.h> +#include <string.h> + +#define ldebug_c #include "lua.h" @@ -20,447 +23,563 @@ #include "lstring.h" #include "ltable.h" #include "ltm.h" -#include "luadebug.h" +#include "lvm.h" -static const char *getfuncname (lua_State *L, StkId f, const char **name); +static const char *getfuncname (CallInfo *ci, const char **name); -static void setnormalized (TObject *d, const TObject *s) { - if (ttype(s) == LUA_TMARK) { - clvalue(d) = infovalue(s)->func; - ttype(d) = LUA_TFUNCTION; - } - else *d = *s; -} +#define isLua(ci) (!((ci)->state & CI_C)) -static int isLmark (StkId o) { - return (o && ttype(o) == LUA_TMARK && !infovalue(o)->func->isC); +static int currentpc (CallInfo *ci) { + if (!isLua(ci)) return -1; /* function is not a Lua function? */ + if (ci->state & CI_HASFRAME) /* function has a frame? */ + ci->u.l.savedpc = *ci->u.l.pc; /* use `pc' from there */ + /* function's pc is saved */ + return pcRel(ci->u.l.savedpc, ci_func(ci)->l.p); } -LUA_API lua_Hook lua_setcallhook (lua_State *L, lua_Hook func) { - lua_Hook oldhook = L->callhook; - L->callhook = func; - return oldhook; +static int currentline (CallInfo *ci) { + int pc = currentpc(ci); + if (pc < 0) + return -1; /* only active lua functions have current-line information */ + else + return getline(ci_func(ci)->l.p, pc); } -LUA_API lua_Hook lua_setlinehook (lua_State *L, lua_Hook func) { - lua_Hook oldhook = L->linehook; - L->linehook = func; - return oldhook; +void luaG_inithooks (lua_State *L) { + CallInfo *ci; + for (ci = L->ci; ci != L->base_ci; ci--) /* update all `savedpc's */ + currentpc(ci); + L->hookinit = 1; } -static StkId aux_stackedfunction (lua_State *L, int level, StkId top) { - int i; - for (i = (top-1) - L->stack; i>=0; i--) { - if (is_T_MARK(L->stack[i].ttype)) { - if (level == 0) - return L->stack+i; - level--; - } +/* +** this function can be called asynchronous (e.g. during a signal) +*/ +LUA_API int lua_sethook (lua_State *L, lua_Hook func, int mask, int count) { + if (func == NULL || mask == 0) { /* turn off hooks? */ + mask = 0; + func = NULL; } - return NULL; + L->hook = func; + L->basehookcount = count; + resethookcount(L); + L->hookmask = cast(lu_byte, mask); + L->hookinit = 0; + return 1; } -LUA_API int lua_getstack (lua_State *L, int level, lua_Debug *ar) { - StkId f = aux_stackedfunction(L, level, L->top); - if (f == NULL) return 0; /* there is no such level */ - else { - ar->_func = f; - return 1; - } +LUA_API lua_Hook lua_gethook (lua_State *L) { + return L->hook; } -static int nups (StkId f) { - switch (ttype(f)) { - case LUA_TFUNCTION: - return clvalue(f)->nupvalues; - case LUA_TMARK: - return infovalue(f)->func->nupvalues; - default: - return 0; - } +LUA_API int lua_gethookmask (lua_State *L) { + return L->hookmask; } -int luaG_getline (int *lineinfo, int pc, int refline, int *prefi) { - int refi; - if (lineinfo == NULL || pc == -1) - return -1; /* no line info or function is not active */ - refi = prefi ? *prefi : 0; - if (lineinfo[refi] < 0) - refline += -lineinfo[refi++]; - LUA_ASSERT(lineinfo[refi] >= 0, "invalid line info"); - while (lineinfo[refi] > pc) { - refline--; - refi--; - if (lineinfo[refi] < 0) - refline -= -lineinfo[refi--]; - LUA_ASSERT(lineinfo[refi] >= 0, "invalid line info"); - } - for (;;) { - int nextline = refline + 1; - int nextref = refi + 1; - if (lineinfo[nextref] < 0) - nextline += -lineinfo[nextref++]; - LUA_ASSERT(lineinfo[nextref] >= 0, "invalid line info"); - if (lineinfo[nextref] > pc) - break; - refline = nextline; - refi = nextref; - } - if (prefi) *prefi = refi; - return refline; +LUA_API int lua_gethookcount (lua_State *L) { + return L->basehookcount; } -static int currentpc (StkId f) { - CallInfo *ci = infovalue(f); - LUA_ASSERT(isLmark(f), "function has no pc"); - if (ci->pc) - return (*ci->pc - ci->func->f.l->code) - 1; - else - return -1; /* function is not active */ -} - - -static int currentline (StkId f) { - if (!isLmark(f)) - return -1; /* only active lua functions have current-line information */ +LUA_API int lua_getstack (lua_State *L, int level, lua_Debug *ar) { + int status; + CallInfo *ci; + lua_lock(L); + for (ci = L->ci; level > 0 && ci > L->base_ci; ci--) { + level--; + if (!(ci->state & CI_C)) /* Lua function? */ + level -= ci->u.l.tailcalls; /* skip lost tail calls */ + } + if (level > 0 || ci == L->base_ci) status = 0; /* there is no such level */ + else if (level < 0) { /* level is of a lost tail call */ + status = 1; + ar->i_ci = 0; + } else { - CallInfo *ci = infovalue(f); - int *lineinfo = ci->func->f.l->lineinfo; - return luaG_getline(lineinfo, currentpc(f), 1, NULL); + status = 1; + ar->i_ci = ci - L->base_ci; } + lua_unlock(L); + return status; } - -static Proto *getluaproto (StkId f) { - return (isLmark(f) ? infovalue(f)->func->f.l : NULL); +static Proto *getluaproto (CallInfo *ci) { + return (isLua(ci) ? ci_func(ci)->l.p : NULL); } LUA_API const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n) { const char *name; - StkId f = ar->_func; - Proto *fp = getluaproto(f); - if (!fp) return NULL; /* `f' is not a Lua function? */ - name = luaF_getlocalname(fp, n, currentpc(f)); - if (!name) return NULL; - luaA_pushobject(L, (f+1)+(n-1)); /* push value */ + CallInfo *ci; + Proto *fp; + lua_lock(L); + name = NULL; + ci = L->base_ci + ar->i_ci; + fp = getluaproto(ci); + if (fp) { /* is a Lua function? */ + name = luaF_getlocalname(fp, n, currentpc(ci)); + if (name) + luaA_pushobject(L, ci->base+(n-1)); /* push value */ + } + lua_unlock(L); return name; } LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n) { const char *name; - StkId f = ar->_func; - Proto *fp = getluaproto(f); + CallInfo *ci; + Proto *fp; + lua_lock(L); + name = NULL; + ci = L->base_ci + ar->i_ci; + fp = getluaproto(ci); L->top--; /* pop new value */ - if (!fp) return NULL; /* `f' is not a Lua function? */ - name = luaF_getlocalname(fp, n, currentpc(f)); - if (!name || name[0] == '(') return NULL; /* `(' starts private locals */ - *((f+1)+(n-1)) = *L->top; + if (fp) { /* is a Lua function? */ + name = luaF_getlocalname(fp, n, currentpc(ci)); + if (!name || name[0] == '(') /* `(' starts private locals */ + name = NULL; + else + setobjs2s(ci->base+(n-1), L->top); + } + lua_unlock(L); return name; } -static void infoLproto (lua_Debug *ar, Proto *f) { - ar->source = f->source->str; - ar->linedefined = f->lineDefined; - ar->what = "Lua"; -} - - -static void funcinfo (lua_State *L, lua_Debug *ar, StkId func) { - Closure *cl = NULL; - switch (ttype(func)) { - case LUA_TFUNCTION: - cl = clvalue(func); - break; - case LUA_TMARK: - cl = infovalue(func)->func; - break; - default: - lua_error(L, "value for `lua_getinfo' is not a function"); - } - if (cl->isC) { - ar->source = "=C"; +static void funcinfo (lua_Debug *ar, StkId func) { + Closure *cl = clvalue(func); + if (cl->c.isC) { + ar->source = "=[C]"; ar->linedefined = -1; ar->what = "C"; } - else - infoLproto(ar, cl->f.l); - luaO_chunkid(ar->short_src, ar->source, sizeof(ar->short_src)); - if (ar->linedefined == 0) - ar->what = "main"; -} - - -static const char *travtagmethods (lua_State *L, const TObject *o) { - if (ttype(o) == LUA_TFUNCTION) { - int e; - for (e=0; e<TM_N; e++) { - int t; - for (t=0; t<=L->last_tag; t++) - if (clvalue(o) == luaT_gettm(L, t, e)) - return luaT_eventname[e]; - } + else { + ar->source = getstr(cl->l.p->source); + ar->linedefined = cl->l.p->lineDefined; + ar->what = (ar->linedefined == 0) ? "main" : "Lua"; } - return NULL; + luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE); } static const char *travglobals (lua_State *L, const TObject *o) { - Hash *g = L->gt; - int i; - for (i=0; i<g->size; i++) { - if (luaO_equalObj(o, val(node(g, i))) && - ttype(key(node(g, i))) == LUA_TSTRING) - return tsvalue(key(node(g, i)))->str; + Table *g = hvalue(gt(L)); + int i = sizenode(g); + while (i--) { + Node *n = gnode(g, i); + if (luaO_rawequalObj(o, gval(n)) && ttisstring(gkey(n))) + return getstr(tsvalue(gkey(n))); } return NULL; } -static void getname (lua_State *L, StkId f, lua_Debug *ar) { - TObject o; - setnormalized(&o, f); - /* try to find a name for given function */ - if ((ar->name = travglobals(L, &o)) != NULL) - ar->namewhat = "global"; - /* not found: try tag methods */ - else if ((ar->name = travtagmethods(L, &o)) != NULL) - ar->namewhat = "tag-method"; - else ar->namewhat = ""; /* not found at all */ +static void info_tailcall (lua_State *L, lua_Debug *ar) { + ar->name = ar->namewhat = ""; + ar->what = "tail"; + ar->linedefined = ar->currentline = -1; + ar->source = "=(tail call)"; + luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE); + ar->nups = 0; + setnilvalue(L->top); } -LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) { - StkId func; - int isactive = (*what != '>'); - if (isactive) - func = ar->_func; - else { - what++; /* skip the '>' */ - func = L->top - 1; - } +static int auxgetinfo (lua_State *L, const char *what, lua_Debug *ar, + StkId f, CallInfo *ci) { + int status = 1; for (; *what; what++) { switch (*what) { case 'S': { - funcinfo(L, ar, func); + funcinfo(ar, f); break; } case 'l': { - ar->currentline = currentline(func); + ar->currentline = (ci) ? currentline(ci) : -1; break; } case 'u': { - ar->nups = nups(func); + ar->nups = clvalue(f)->c.nupvalues; break; } case 'n': { - ar->namewhat = (isactive) ? getfuncname(L, func, &ar->name) : NULL; - if (ar->namewhat == NULL) - getname(L, func, ar); + ar->namewhat = (ci) ? getfuncname(ci, &ar->name) : NULL; + if (ar->namewhat == NULL) { + /* try to find a global name */ + if ((ar->name = travglobals(L, f)) != NULL) + ar->namewhat = "global"; + else ar->namewhat = ""; /* not found */ + } break; } case 'f': { - setnormalized(L->top, func); - incr_top; /* push function */ + setobj2s(L->top, f); break; } - default: return 0; /* invalid option */ + default: status = 0; /* invalid option */ } } - if (!isactive) L->top--; /* pop function */ - return 1; + return status; +} + + +LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) { + int status = 1; + lua_lock(L); + if (*what == '>') { + StkId f = L->top - 1; + if (!ttisfunction(f)) + luaG_runerror(L, "value for `lua_getinfo' is not a function"); + status = auxgetinfo(L, what + 1, ar, f, NULL); + L->top--; /* pop function */ + } + else if (ar->i_ci != 0) { /* no tail call? */ + CallInfo *ci = L->base_ci + ar->i_ci; + lua_assert(ttisfunction(ci->base - 1)); + status = auxgetinfo(L, what, ar, ci->base - 1, ci); + } + else + info_tailcall(L, ar); + if (strchr(what, 'f')) incr_top(L); + lua_unlock(L); + return status; } /* ** {====================================================== -** Symbolic Execution +** Symbolic Execution and code checker ** ======================================================= */ +#define check(x) if (!(x)) return 0; + +#define checkjump(pt,pc) check(0 <= pc && pc < pt->sizecode) + +#define checkreg(pt,reg) check((reg) < (pt)->maxstacksize) + + -static int pushpc (int *stack, int pc, int top, int n) { - while (n--) - stack[top++] = pc-1; - return top; +static int precheck (const Proto *pt) { + check(pt->maxstacksize <= MAXSTACK); + check(pt->sizelineinfo == pt->sizecode || pt->sizelineinfo == 0); + lua_assert(pt->numparams+pt->is_vararg <= pt->maxstacksize); + check(GET_OPCODE(pt->code[pt->sizecode-1]) == OP_RETURN); + return 1; } -static Instruction luaG_symbexec (const Proto *pt, int lastpc, int stackpos) { - int stack[MAXSTACK]; /* stores last instruction that changed a stack entry */ - const Instruction *code = pt->code; - int top = pt->numparams; - int pc = 0; - if (pt->is_vararg) /* varargs? */ - top++; /* `arg' */ - while (pc < lastpc) { - const Instruction i = code[pc++]; - LUA_ASSERT(0 <= top && top <= pt->maxstacksize, "wrong stack"); - switch (GET_OPCODE(i)) { - case OP_RETURN: { - LUA_ASSERT(top >= GETARG_U(i), "wrong stack"); - top = GETARG_U(i); +static int checkopenop (const Proto *pt, int pc) { + Instruction i = pt->code[pc+1]; + switch (GET_OPCODE(i)) { + case OP_CALL: + case OP_TAILCALL: + case OP_RETURN: { + check(GETARG_B(i) == 0); + return 1; + } + case OP_SETLISTO: return 1; + default: return 0; /* invalid instruction after an open call */ + } +} + + +static int checkRK (const Proto *pt, int r) { + return (r < pt->maxstacksize || (r >= MAXSTACK && r-MAXSTACK < pt->sizek)); +} + + +static Instruction luaG_symbexec (const Proto *pt, int lastpc, int reg) { + int pc; + int last; /* stores position of last instruction that changed `reg' */ + last = pt->sizecode-1; /* points to final return (a `neutral' instruction) */ + check(precheck(pt)); + for (pc = 0; pc < lastpc; pc++) { + const Instruction i = pt->code[pc]; + OpCode op = GET_OPCODE(i); + int a = GETARG_A(i); + int b = 0; + int c = 0; + checkreg(pt, a); + switch (getOpMode(op)) { + case iABC: { + b = GETARG_B(i); + c = GETARG_C(i); + if (testOpMode(op, OpModeBreg)) { + checkreg(pt, b); + } + else if (testOpMode(op, OpModeBrk)) + check(checkRK(pt, b)); + if (testOpMode(op, OpModeCrk)) + check(checkRK(pt, c)); break; } - case OP_TAILCALL: { - LUA_ASSERT(top >= GETARG_A(i), "wrong stack"); - top = GETARG_B(i); + case iABx: { + b = GETARG_Bx(i); + if (testOpMode(op, OpModeK)) check(b < pt->sizek); + break; + } + case iAsBx: { + b = GETARG_sBx(i); break; } - case OP_CALL: { - int nresults = GETARG_B(i); - if (nresults == MULT_RET) nresults = 1; - LUA_ASSERT(top >= GETARG_A(i), "wrong stack"); - top = pushpc(stack, pc, GETARG_A(i), nresults); + } + if (testOpMode(op, OpModesetA)) { + if (a == reg) last = pc; /* change register `a' */ + } + if (testOpMode(op, OpModeT)) { + check(pc+2 < pt->sizecode); /* check skip */ + check(GET_OPCODE(pt->code[pc+1]) == OP_JMP); + } + switch (op) { + case OP_LOADBOOL: { + check(c == 0 || pc+2 < pt->sizecode); /* check its jump */ break; } - case OP_PUSHNIL: { - top = pushpc(stack, pc, top, GETARG_U(i)); + case OP_LOADNIL: { + if (a <= reg && reg <= b) + last = pc; /* set registers from `a' to `b' */ break; } - case OP_POP: { - top -= GETARG_U(i); + case OP_GETUPVAL: + case OP_SETUPVAL: { + check(b < pt->nups); break; } - case OP_SETTABLE: - case OP_SETLIST: { - top -= GETARG_B(i); + case OP_GETGLOBAL: + case OP_SETGLOBAL: { + check(ttisstring(&pt->k[b])); break; } - case OP_SETMAP: { - top -= 2*GETARG_U(i); + case OP_SELF: { + checkreg(pt, a+1); + if (reg == a+1) last = pc; break; } case OP_CONCAT: { - top -= GETARG_U(i); - stack[top++] = pc-1; + /* `c' is a register, and at least two operands */ + check(c < MAXSTACK && b < c); break; } - case OP_CLOSURE: { - top -= GETARG_B(i); - stack[top++] = pc-1; + case OP_TFORLOOP: + checkreg(pt, a+c+5); + if (reg >= a) last = pc; /* affect all registers above base */ + /* go through */ + case OP_FORLOOP: + checkreg(pt, a+2); + /* go through */ + case OP_JMP: { + int dest = pc+1+b; + check(0 <= dest && dest < pt->sizecode); + /* not full check and jump is forward and do not skip `lastpc'? */ + if (reg != NO_REG && pc < dest && dest <= lastpc) + pc += b; /* do the jump */ break; } - case OP_JMPONT: - case OP_JMPONF: { - int newpc = pc + GETARG_S(i); - /* jump is forward and do not skip `lastpc'? */ - if (pc < newpc && newpc <= lastpc) { - stack[top-1] = pc-1; /* value comes from `and'/`or' */ - pc = newpc; /* do the jump */ + case OP_CALL: + case OP_TAILCALL: { + if (b != 0) { + checkreg(pt, a+b-1); } - else - top--; /* do not jump; pop value */ + c--; /* c = num. returns */ + if (c == LUA_MULTRET) { + check(checkopenop(pt, pc)); + } + else if (c != 0) + checkreg(pt, a+c-1); + if (reg >= a) last = pc; /* affect all registers above base */ break; } - default: { - OpCode op = GET_OPCODE(i); - LUA_ASSERT(luaK_opproperties[op].push != VD, - "invalid opcode for default"); - top -= luaK_opproperties[op].pop; - LUA_ASSERT(top >= 0, "wrong stack"); - top = pushpc(stack, pc, top, luaK_opproperties[op].push); + case OP_RETURN: { + b--; /* b = num. returns */ + if (b > 0) checkreg(pt, a+b-1); + break; + } + case OP_SETLIST: { + checkreg(pt, a + (b&(LFIELDS_PER_FLUSH-1)) + 1); + break; + } + case OP_CLOSURE: { + int nup; + check(b < pt->sizep); + nup = pt->p[b]->nups; + check(pc + nup < pt->sizecode); + for (; nup>0; nup--) { + OpCode op1 = GET_OPCODE(pt->code[pc+nup]); + check(op1 == OP_GETUPVAL || op1 == OP_MOVE); + } + break; } + default: break; } } - return code[stack[stackpos]]; + return pt->code[last]; } +#undef check +#undef checkjump +#undef checkreg -static const char *getobjname (lua_State *L, StkId obj, const char **name) { - StkId func = aux_stackedfunction(L, 0, obj); - if (!isLmark(func)) - return NULL; /* not an active Lua function */ - else { - Proto *p = infovalue(func)->func->f.l; - int pc = currentpc(func); - int stackpos = obj - (func+1); /* func+1 == function base */ - Instruction i = luaG_symbexec(p, pc, stackpos); - LUA_ASSERT(pc != -1, "function must be active"); +/* }====================================================== */ + + +int luaG_checkcode (const Proto *pt) { + return luaG_symbexec(pt, pt->sizecode, NO_REG); +} + + +static const char *kname (Proto *p, int c) { + c = c - MAXSTACK; + if (c >= 0 && ttisstring(&p->k[c])) + return svalue(&p->k[c]); + else + return "?"; +} + + +static const char *getobjname (CallInfo *ci, int stackpos, const char **name) { + if (isLua(ci)) { /* a Lua function? */ + Proto *p = ci_func(ci)->l.p; + int pc = currentpc(ci); + Instruction i; + *name = luaF_getlocalname(p, stackpos+1, pc); + if (*name) /* is a local? */ + return "local"; + i = luaG_symbexec(p, pc, stackpos); /* try symbolic execution */ + lua_assert(pc != -1); switch (GET_OPCODE(i)) { case OP_GETGLOBAL: { - *name = p->kstr[GETARG_U(i)]->str; + int g = GETARG_Bx(i); /* global index */ + lua_assert(ttisstring(&p->k[g])); + *name = svalue(&p->k[g]); return "global"; } - case OP_GETLOCAL: { - *name = luaF_getlocalname(p, GETARG_U(i)+1, pc); - LUA_ASSERT(*name, "local must exist"); - return "local"; + case OP_MOVE: { + int a = GETARG_A(i); + int b = GETARG_B(i); /* move from `b' to `a' */ + if (b < a) + return getobjname(ci, b, name); /* get name for `b' */ + break; } - case OP_PUSHSELF: - case OP_GETDOTTED: { - *name = p->kstr[GETARG_U(i)]->str; + case OP_GETTABLE: { + int k = GETARG_C(i); /* key index */ + *name = kname(p, k); return "field"; } - default: - return NULL; /* no useful name found */ + case OP_SELF: { + int k = GETARG_C(i); /* key index */ + *name = kname(p, k); + return "method"; + } + default: break; } } + return NULL; /* no useful name found */ } -static const char *getfuncname (lua_State *L, StkId f, const char **name) { - StkId func = aux_stackedfunction(L, 0, f); /* calling function */ - if (!isLmark(func)) - return NULL; /* not an active Lua function */ - else { - Proto *p = infovalue(func)->func->f.l; - int pc = currentpc(func); - Instruction i; - if (pc == -1) return NULL; /* function is not activated */ - i = p->code[pc]; - switch (GET_OPCODE(i)) { - case OP_CALL: case OP_TAILCALL: - return getobjname(L, (func+1)+GETARG_A(i), name); - default: - return NULL; /* no useful name found */ - } - } +static const char *getfuncname (CallInfo *ci, const char **name) { + Instruction i; + if ((isLua(ci) && ci->u.l.tailcalls > 0) || !isLua(ci - 1)) + return NULL; /* calling function is not Lua (or is unknown) */ + ci--; /* calling function */ + i = ci_func(ci)->l.p->code[currentpc(ci)]; + if (GET_OPCODE(i) == OP_CALL || GET_OPCODE(i) == OP_TAILCALL) + return getobjname(ci, GETARG_A(i), name); + else + return NULL; /* no useful name can be found */ } -/* }====================================================== */ +/* only ANSI way to check whether a pointer points to an array */ +static int isinstack (CallInfo *ci, const TObject *o) { + StkId p; + for (p = ci->base; p < ci->top; p++) + if (o == p) return 1; + return 0; +} -void luaG_typeerror (lua_State *L, StkId o, const char *op) { - const char *name; - const char *kind = getobjname(L, o, &name); - const char *t = luaO_typename(o); +void luaG_typeerror (lua_State *L, const TObject *o, const char *op) { + const char *name = NULL; + const char *t = luaT_typenames[ttype(o)]; + const char *kind = (isinstack(L->ci, o)) ? + getobjname(L->ci, o - L->base, &name) : NULL; if (kind) - luaO_verror(L, "attempt to %.30s %.20s `%.40s' (a %.10s value)", + luaG_runerror(L, "attempt to %s %s `%s' (a %s value)", op, kind, name, t); else - luaO_verror(L, "attempt to %.30s a %.10s value", op, t); + luaG_runerror(L, "attempt to %s a %s value", op, t); +} + + +void luaG_concaterror (lua_State *L, StkId p1, StkId p2) { + if (ttisstring(p1)) p1 = p2; + lua_assert(!ttisstring(p1)); + luaG_typeerror(L, p1, "concatenate"); } -void luaG_binerror (lua_State *L, StkId p1, int t, const char *op) { - if (ttype(p1) == t) p1++; - LUA_ASSERT(ttype(p1) != t, "must be an error"); - luaG_typeerror(L, p1, op); +void luaG_aritherror (lua_State *L, const TObject *p1, const TObject *p2) { + TObject temp; + if (luaV_tonumber(p1, &temp) == NULL) + p2 = p1; /* first operand is wrong */ + luaG_typeerror(L, p2, "perform arithmetic on"); } -void luaG_ordererror (lua_State *L, StkId top) { - const char *t1 = luaO_typename(top-2); - const char *t2 = luaO_typename(top-1); +int luaG_ordererror (lua_State *L, const TObject *p1, const TObject *p2) { + const char *t1 = luaT_typenames[ttype(p1)]; + const char *t2 = luaT_typenames[ttype(p2)]; if (t1[2] == t2[2]) - luaO_verror(L, "attempt to compare two %.10s values", t1); + luaG_runerror(L, "attempt to compare two %s values", t1); else - luaO_verror(L, "attempt to compare %.10s with %.10s", t1, t2); + luaG_runerror(L, "attempt to compare %s with %s", t1, t2); + return 0; +} + + +static void addinfo (lua_State *L, const char *msg) { + CallInfo *ci = L->ci; + if (isLua(ci)) { /* is Lua code? */ + char buff[LUA_IDSIZE]; /* add file:line information */ + int line = currentline(ci); + luaO_chunkid(buff, getstr(getluaproto(ci)->source), LUA_IDSIZE); + luaO_pushfstring(L, "%s:%d: %s", buff, line, msg); + } +} + + +void luaG_errormsg (lua_State *L) { + if (L->errfunc != 0) { /* is there an error handling function? */ + StkId errfunc = restorestack(L, L->errfunc); + if (!ttisfunction(errfunc)) luaD_throw(L, LUA_ERRERR); + setobjs2s(L->top, L->top - 1); /* move argument */ + setobjs2s(L->top - 1, errfunc); /* push function */ + incr_top(L); + luaD_call(L, L->top - 2, 1); /* call it */ + } + luaD_throw(L, LUA_ERRRUN); +} + + +void luaG_runerror (lua_State *L, const char *fmt, ...) { + va_list argp; + va_start(argp, fmt); + addinfo(L, luaO_pushvfstring(L, fmt, argp)); + va_end(argp); + luaG_errormsg(L); } diff --git a/src/ldebug.h b/src/ldebug.h index d4b2d3b0..7ff39583 100644 --- a/src/ldebug.h +++ b/src/ldebug.h @@ -1,5 +1,5 @@ /* -** $Id: ldebug.h,v 1.7 2000/10/05 12:14:08 roberto Exp $ +** $Id: ldebug.h,v 1.32 2002/11/18 11:01:55 roberto Exp $ ** Auxiliary functions from Debug Interface module ** See Copyright Notice in lua.h */ @@ -9,13 +9,23 @@ #include "lstate.h" -#include "luadebug.h" -void luaG_typeerror (lua_State *L, StkId o, const char *op); -void luaG_binerror (lua_State *L, StkId p1, int t, const char *op); -int luaG_getline (int *lineinfo, int pc, int refline, int *refi); -void luaG_ordererror (lua_State *L, StkId top); +#define pcRel(pc, p) (cast(int, (pc) - (p)->code) - 1) + +#define getline(f,pc) (((f)->lineinfo) ? (f)->lineinfo[pc] : 0) + +#define resethookcount(L) (L->hookcount = L->basehookcount) + + +void luaG_inithooks (lua_State *L); +void luaG_typeerror (lua_State *L, const TObject *o, const char *opname); +void luaG_concaterror (lua_State *L, StkId p1, StkId p2); +void luaG_aritherror (lua_State *L, const TObject *p1, const TObject *p2); +int luaG_ordererror (lua_State *L, const TObject *p1, const TObject *p2); +void luaG_runerror (lua_State *L, const char *fmt, ...); +void luaG_errormsg (lua_State *L); +int luaG_checkcode (const Proto *pt); #endif @@ -1,22 +1,25 @@ /* -** $Id: ldo.c,v 1.109a 2000/10/30 12:38:50 roberto Exp $ +** $Id: ldo.c,v 1.217 2003/04/03 13:35:34 roberto Exp $ ** Stack and Call structure of Lua ** See Copyright Notice in lua.h */ #include <setjmp.h> -#include <stdio.h> #include <stdlib.h> #include <string.h> +#define ldo_c + #include "lua.h" #include "ldebug.h" #include "ldo.h" +#include "lfunc.h" #include "lgc.h" #include "lmem.h" #include "lobject.h" +#include "lopcodes.h" #include "lparser.h" #include "lstate.h" #include "lstring.h" @@ -27,362 +30,429 @@ #include "lzio.h" -/* space to handle stack overflow errors */ -#define EXTRA_STACK (2*LUA_MINSTACK) -void luaD_init (lua_State *L, int stacksize) { - L->stack = luaM_newvector(L, stacksize+EXTRA_STACK, TObject); - L->nblocks += stacksize*sizeof(TObject); - L->stack_last = L->stack+(stacksize-1); - L->stacksize = stacksize; - L->Cbase = L->top = L->stack; -} +/* +** {====================================================== +** Error-recovery functions (based on long jumps) +** ======================================================= +*/ -void luaD_checkstack (lua_State *L, int n) { - if (L->stack_last - L->top <= n) { /* stack overflow? */ - if (L->stack_last-L->stack > (L->stacksize-1)) { - /* overflow while handling overflow */ - luaD_breakrun(L, LUA_ERRERR); /* break run without error message */ +/* chain list of long jump buffers */ +struct lua_longjmp { + struct lua_longjmp *previous; + jmp_buf b; + volatile int status; /* error code */ +}; + + +static void seterrorobj (lua_State *L, int errcode, StkId oldtop) { + switch (errcode) { + case LUA_ERRMEM: { + setsvalue2s(oldtop, luaS_new(L, MEMERRMSG)); + break; + } + case LUA_ERRERR: { + setsvalue2s(oldtop, luaS_new(L, "error in error handling")); + break; } - else { - L->stack_last += EXTRA_STACK; /* to be used by error message */ - lua_error(L, "stack overflow"); + case LUA_ERRSYNTAX: + case LUA_ERRRUN: { + setobjs2s(oldtop, L->top - 1); /* error message on current top */ + break; } } + L->top = oldtop + 1; +} + + +void luaD_throw (lua_State *L, int errcode) { + if (L->errorJmp) { + L->errorJmp->status = errcode; + longjmp(L->errorJmp->b, 1); + } + else { + G(L)->panic(L); + exit(EXIT_FAILURE); + } +} + + +int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud) { + struct lua_longjmp lj; + lj.status = 0; + lj.previous = L->errorJmp; /* chain new error handler */ + L->errorJmp = &lj; + if (setjmp(lj.b) == 0) + (*f)(L, ud); + L->errorJmp = lj.previous; /* restore old error handler */ + return lj.status; } static void restore_stack_limit (lua_State *L) { - if (L->top - L->stack < L->stacksize - 1) - L->stack_last = L->stack + (L->stacksize-1); + L->stack_last = L->stack+L->stacksize-1; + if (L->size_ci > LUA_MAXCALLS) { /* there was an overflow? */ + int inuse = (L->ci - L->base_ci); + if (inuse + 1 < LUA_MAXCALLS) /* can `undo' overflow? */ + luaD_reallocCI(L, LUA_MAXCALLS); + } } +/* }====================================================== */ -/* -** Adjust stack. Set top to base+extra, pushing NILs if needed. -** (we cannot add base+extra unless we are sure it fits in the stack; -** otherwise the result of such operation on pointers is undefined) -*/ -void luaD_adjusttop (lua_State *L, StkId base, int extra) { - int diff = extra-(L->top-base); - if (diff <= 0) - L->top = base+extra; - else { - luaD_checkstack(L, diff); - while (diff--) - ttype(L->top++) = LUA_TNIL; + +static void correctstack (lua_State *L, TObject *oldstack) { + CallInfo *ci; + GCObject *up; + L->top = (L->top - oldstack) + L->stack; + for (up = L->openupval; up != NULL; up = up->gch.next) + gcotouv(up)->v = (gcotouv(up)->v - oldstack) + L->stack; + for (ci = L->base_ci; ci <= L->ci; ci++) { + ci->top = (ci->top - oldstack) + L->stack; + ci->base = (ci->base - oldstack) + L->stack; } + L->base = L->ci->base; } -/* -** Open a hole inside the stack at `pos' -*/ -static void luaD_openstack (lua_State *L, StkId pos) { - int i = L->top-pos; - while (i--) pos[i+1] = pos[i]; - incr_top; +void luaD_reallocstack (lua_State *L, int newsize) { + TObject *oldstack = L->stack; + luaM_reallocvector(L, L->stack, L->stacksize, newsize, TObject); + L->stacksize = newsize; + L->stack_last = L->stack+newsize-1-EXTRA_STACK; + correctstack(L, oldstack); } -static void dohook (lua_State *L, lua_Debug *ar, lua_Hook hook) { - StkId old_Cbase = L->Cbase; - StkId old_top = L->Cbase = L->top; - luaD_checkstack(L, LUA_MINSTACK); /* ensure minimum stack size */ - L->allowhooks = 0; /* cannot call hooks inside a hook */ - (*hook)(L, ar); - LUA_ASSERT(L->allowhooks == 0, "invalid allow"); - L->allowhooks = 1; - L->top = old_top; - L->Cbase = old_Cbase; +void luaD_reallocCI (lua_State *L, int newsize) { + CallInfo *oldci = L->base_ci; + luaM_reallocvector(L, L->base_ci, L->size_ci, newsize, CallInfo); + L->size_ci = cast(unsigned short, newsize); + L->ci = (L->ci - oldci) + L->base_ci; + L->end_ci = L->base_ci + L->size_ci; } -void luaD_lineHook (lua_State *L, StkId func, int line, lua_Hook linehook) { - if (L->allowhooks) { - lua_Debug ar; - ar._func = func; - ar.event = "line"; - ar.currentline = line; - dohook(L, &ar, linehook); +void luaD_growstack (lua_State *L, int n) { + if (n <= L->stacksize) /* double size is enough? */ + luaD_reallocstack(L, 2*L->stacksize); + else + luaD_reallocstack(L, L->stacksize + n + EXTRA_STACK); +} + + +static void luaD_growCI (lua_State *L) { + if (L->size_ci > LUA_MAXCALLS) /* overflow while handling overflow? */ + luaD_throw(L, LUA_ERRERR); + else { + luaD_reallocCI(L, 2*L->size_ci); + if (L->size_ci > LUA_MAXCALLS) + luaG_runerror(L, "stack overflow"); } } -static void luaD_callHook (lua_State *L, StkId func, lua_Hook callhook, - const char *event) { - if (L->allowhooks) { +void luaD_callhook (lua_State *L, int event, int line) { + lua_Hook hook = L->hook; + if (hook && L->allowhook) { + ptrdiff_t top = savestack(L, L->top); + ptrdiff_t ci_top = savestack(L, L->ci->top); lua_Debug ar; - ar._func = func; ar.event = event; - infovalue(func)->pc = NULL; /* function is not active */ - dohook(L, &ar, callhook); + ar.currentline = line; + if (event == LUA_HOOKTAILRET) + ar.i_ci = 0; /* tail call; no debug information about it */ + else + ar.i_ci = L->ci - L->base_ci; + luaD_checkstack(L, LUA_MINSTACK); /* ensure minimum stack size */ + L->ci->top = L->top + LUA_MINSTACK; + L->allowhook = 0; /* cannot call hooks inside a hook */ + lua_unlock(L); + (*hook)(L, &ar); + lua_lock(L); + lua_assert(!L->allowhook); + L->allowhook = 1; + L->ci->top = restorestack(L, ci_top); + L->top = restorestack(L, top); } } -static StkId callCclosure (lua_State *L, const struct Closure *cl, StkId base) { - int nup = cl->nupvalues; /* number of upvalues */ - StkId old_Cbase = L->Cbase; - int n; - L->Cbase = base; /* new base for C function */ - luaD_checkstack(L, nup+LUA_MINSTACK); /* ensure minimum stack size */ - for (n=0; n<nup; n++) /* copy upvalues as extra arguments */ - *(L->top++) = cl->upvalue[n]; - n = (*cl->f.c)(L); /* do the actual call */ - L->Cbase = old_Cbase; /* restore old C base */ - return L->top - n; /* return index of first result */ +static void adjust_varargs (lua_State *L, int nfixargs, StkId base) { + int i; + Table *htab; + TObject nname; + int actual = L->top - base; /* actual number of arguments */ + if (actual < nfixargs) { + luaD_checkstack(L, nfixargs - actual); + for (; actual < nfixargs; ++actual) + setnilvalue(L->top++); + } + actual -= nfixargs; /* number of extra arguments */ + htab = luaH_new(L, actual, 1); /* create `arg' table */ + for (i=0; i<actual; i++) /* put extra arguments into `arg' table */ + setobj2n(luaH_setnum(L, htab, i+1), L->top - actual + i); + /* store counter in field `n' */ + setsvalue(&nname, luaS_newliteral(L, "n")); + setnvalue(luaH_set(L, htab, &nname), cast(lua_Number, actual)); + L->top -= actual; /* remove extra elements from the stack */ + sethvalue(L->top, htab); + incr_top(L); } -void luaD_callTM (lua_State *L, Closure *f, int nParams, int nResults) { - StkId base = L->top - nParams; - luaD_openstack(L, base); - clvalue(base) = f; - ttype(base) = LUA_TFUNCTION; - luaD_call(L, base, nResults); +static StkId tryfuncTM (lua_State *L, StkId func) { + const TObject *tm = luaT_gettmbyobj(L, func, TM_CALL); + StkId p; + ptrdiff_t funcr = savestack(L, func); + if (!ttisfunction(tm)) + luaG_typeerror(L, func, "call"); + /* Open a hole inside the stack at `func' */ + for (p = L->top; p > func; p--) setobjs2s(p, p-1); + incr_top(L); + func = restorestack(L, funcr); /* previous call may change stack */ + setobj2s(func, tm); /* tag method is the new function to be called */ + return func; } -/* -** Call a function (C or Lua). The function to be called is at *func. -** The arguments are on the stack, right after the function. -** When returns, the results are on the stack, starting at the original -** function position. -** The number of results is nResults, unless nResults=LUA_MULTRET. -*/ -void luaD_call (lua_State *L, StkId func, int nResults) { - lua_Hook callhook; - StkId firstResult; - CallInfo ci; - Closure *cl; - if (ttype(func) != LUA_TFUNCTION) { - /* `func' is not a function; check the `function' tag method */ - Closure *tm = luaT_gettmbyObj(L, func, TM_FUNCTION); - if (tm == NULL) - luaG_typeerror(L, func, "call"); - luaD_openstack(L, func); - clvalue(func) = tm; /* tag method is the new function to be called */ - ttype(func) = LUA_TFUNCTION; +StkId luaD_precall (lua_State *L, StkId func) { + LClosure *cl; + ptrdiff_t funcr = savestack(L, func); + if (!ttisfunction(func)) /* `func' is not a function? */ + func = tryfuncTM(L, func); /* check the `function' tag method */ + if (L->ci + 1 == L->end_ci) luaD_growCI(L); + else condhardstacktests(luaD_reallocCI(L, L->size_ci)); + cl = &clvalue(func)->l; + if (!cl->isC) { /* Lua function? prepare its call */ + CallInfo *ci; + Proto *p = cl->p; + if (p->is_vararg) /* varargs? */ + adjust_varargs(L, p->numparams, func+1); + luaD_checkstack(L, p->maxstacksize); + ci = ++L->ci; /* now `enter' new function */ + L->base = L->ci->base = restorestack(L, funcr) + 1; + ci->top = L->base + p->maxstacksize; + ci->u.l.savedpc = p->code; /* starting point */ + ci->u.l.tailcalls = 0; + ci->state = CI_SAVEDPC; + while (L->top < ci->top) + setnilvalue(L->top++); + L->top = ci->top; + return NULL; } - cl = clvalue(func); - ci.func = cl; - infovalue(func) = &ci; - ttype(func) = LUA_TMARK; - callhook = L->callhook; - if (callhook) - luaD_callHook(L, func, callhook, "call"); - firstResult = (cl->isC ? callCclosure(L, cl, func+1) : - luaV_execute(L, cl, func+1)); - if (callhook) /* same hook that was active at entry */ - luaD_callHook(L, func, callhook, "return"); - LUA_ASSERT(ttype(func) == LUA_TMARK, "invalid tag"); - /* move results to `func' (to erase parameters and function) */ - if (nResults == LUA_MULTRET) { - while (firstResult < L->top) /* copy all results */ - *func++ = *firstResult++; - L->top = func; + else { /* if is a C function, call it */ + CallInfo *ci; + int n; + luaD_checkstack(L, LUA_MINSTACK); /* ensure minimum stack size */ + ci = ++L->ci; /* now `enter' new function */ + L->base = L->ci->base = restorestack(L, funcr) + 1; + ci->top = L->top + LUA_MINSTACK; + ci->state = CI_C; /* a C function */ + if (L->hookmask & LUA_MASKCALL) + luaD_callhook(L, LUA_HOOKCALL, -1); + lua_unlock(L); +#ifdef LUA_COMPATUPVALUES + lua_pushupvalues(L); +#endif + n = (*clvalue(L->base - 1)->c.f)(L); /* do the actual call */ + lua_lock(L); + return L->top - n; } - else { /* copy at most `nResults' */ - for (; nResults > 0 && firstResult < L->top; nResults--) - *func++ = *firstResult++; - L->top = func; - for (; nResults > 0; nResults--) { /* if there are not enough results */ - ttype(L->top) = LUA_TNIL; /* adjust the stack */ - incr_top; /* must check stack space */ - } - } - luaC_checkGC(L); } -/* -** Execute a protected call. -*/ -struct CallS { /* data to `f_call' */ - StkId func; - int nresults; -}; - -static void f_call (lua_State *L, void *ud) { - struct CallS *c = (struct CallS *)ud; - luaD_call(L, c->func, c->nresults); +static StkId callrethooks (lua_State *L, StkId firstResult) { + ptrdiff_t fr = savestack(L, firstResult); /* next call may change stack */ + luaD_callhook(L, LUA_HOOKRET, -1); + if (!(L->ci->state & CI_C)) { /* Lua function? */ + while (L->ci->u.l.tailcalls--) /* call hook for eventual tail calls */ + luaD_callhook(L, LUA_HOOKTAILRET, -1); + } + return restorestack(L, fr); } -LUA_API int lua_call (lua_State *L, int nargs, int nresults) { - StkId func = L->top - (nargs+1); /* function to be called */ - struct CallS c; - int status; - c.func = func; c.nresults = nresults; - status = luaD_runprotected(L, f_call, &c); - if (status != 0) /* an error occurred? */ - L->top = func; /* remove parameters from the stack */ - return status; +void luaD_poscall (lua_State *L, int wanted, StkId firstResult) { + StkId res; + if (L->hookmask & LUA_MASKRET) + firstResult = callrethooks(L, firstResult); + res = L->base - 1; /* res == final position of 1st result */ + L->ci--; + L->base = L->ci->base; /* restore base */ + /* move results to correct place */ + while (wanted != 0 && firstResult < L->top) { + setobjs2s(res++, firstResult++); + wanted--; + } + while (wanted-- > 0) + setnilvalue(res++); + L->top = res; } /* -** Execute a protected parser. -*/ -struct ParserS { /* data to `f_parser' */ - ZIO *z; - int bin; -}; - -static void f_parser (lua_State *L, void *ud) { - struct ParserS *p = (struct ParserS *)ud; - Proto *tf = p->bin ? luaU_undump(L, p->z) : luaY_parser(L, p->z); - luaV_Lclosure(L, tf, 0); +** Call a function (C or Lua). The function to be called is at *func. +** The arguments are on the stack, right after the function. +** When returns, all the results are on the stack, starting at the original +** function position. +*/ +void luaD_call (lua_State *L, StkId func, int nResults) { + StkId firstResult; + lua_assert(!(L->ci->state & CI_CALLING)); + if (++L->nCcalls >= LUA_MAXCCALLS) { + if (L->nCcalls == LUA_MAXCCALLS) + luaG_runerror(L, "C stack overflow"); + else if (L->nCcalls >= (LUA_MAXCCALLS + (LUA_MAXCCALLS>>3))) + luaD_throw(L, LUA_ERRERR); /* error while handing stack error */ + } + firstResult = luaD_precall(L, func); + if (firstResult == NULL) /* is a Lua function? */ + firstResult = luaV_execute(L); /* call it */ + luaD_poscall(L, nResults, firstResult); + L->nCcalls--; + luaC_checkGC(L); } -static int protectedparser (lua_State *L, ZIO *z, int bin) { - struct ParserS p; - unsigned long old_blocks; - int status; - p.z = z; p.bin = bin; - /* before parsing, give a (good) chance to GC */ - if (L->nblocks/8 >= L->GCthreshold/10) - luaC_collectgarbage(L); - old_blocks = L->nblocks; - status = luaD_runprotected(L, f_parser, &p); - if (status == 0) { - /* add new memory to threshold (as it probably will stay) */ - L->GCthreshold += (L->nblocks - old_blocks); +static void resume (lua_State *L, void *ud) { + StkId firstResult; + int nargs = *cast(int *, ud); + CallInfo *ci = L->ci; + if (ci == L->base_ci) { /* no activation record? */ + if (nargs >= L->top - L->base) + luaG_runerror(L, "cannot resume dead coroutine"); + luaD_precall(L, L->top - (nargs + 1)); /* start coroutine */ } - else if (status == LUA_ERRRUN) /* an error occurred: correct error code */ - status = LUA_ERRSYNTAX; - return status; + else if (ci->state & CI_YIELD) { /* inside a yield? */ + if (ci->state & CI_C) { /* `common' yield? */ + /* finish interrupted execution of `OP_CALL' */ + int nresults; + lua_assert((ci-1)->state & CI_SAVEDPC); + lua_assert(GET_OPCODE(*((ci-1)->u.l.savedpc - 1)) == OP_CALL || + GET_OPCODE(*((ci-1)->u.l.savedpc - 1)) == OP_TAILCALL); + nresults = GETARG_C(*((ci-1)->u.l.savedpc - 1)) - 1; + luaD_poscall(L, nresults, L->top - nargs); /* complete it */ + if (nresults >= 0) L->top = L->ci->top; + } + else { /* yielded inside a hook: just continue its execution */ + ci->state &= ~CI_YIELD; + } + } + else + luaG_runerror(L, "cannot resume non-suspended coroutine"); + firstResult = luaV_execute(L); + if (firstResult != NULL) /* return? */ + luaD_poscall(L, LUA_MULTRET, firstResult); /* finalize this coroutine */ } -static int parse_file (lua_State *L, const char *filename) { - ZIO z; +LUA_API int lua_resume (lua_State *L, int nargs) { int status; - int bin; /* flag for file mode */ - int c; /* look ahead char */ - FILE *f = (filename == NULL) ? stdin : fopen(filename, "r"); - if (f == NULL) return LUA_ERRFILE; /* unable to open file */ - c = fgetc(f); - ungetc(c, f); - bin = (c == ID_CHUNK); - if (bin && f != stdin) { - f = freopen(filename, "rb", f); /* set binary mode */ - if (f == NULL) return LUA_ERRFILE; /* unable to reopen file */ + lu_byte old_allowhooks; + lua_lock(L); + old_allowhooks = L->allowhook; + lua_assert(L->errfunc == 0 && L->nCcalls == 0); + status = luaD_rawrunprotected(L, resume, &nargs); + if (status != 0) { /* error? */ + L->ci = L->base_ci; /* go back to initial level */ + L->base = L->ci->base; + L->nCcalls = 0; + luaF_close(L, L->base); /* close eventual pending closures */ + seterrorobj(L, status, L->base); + L->allowhook = old_allowhooks; + restore_stack_limit(L); } - lua_pushstring(L, "@"); - lua_pushstring(L, (filename == NULL) ? "(stdin)" : filename); - lua_concat(L, 2); - c = lua_gettop(L); - filename = lua_tostring(L, c); /* filename = '@'..filename */ - luaZ_Fopen(&z, f, filename); - status = protectedparser(L, &z, bin); - lua_remove(L, c); /* remove `filename' from the stack */ - if (f != stdin) - fclose(f); - return status; -} - - -LUA_API int lua_dofile (lua_State *L, const char *filename) { - int status = parse_file(L, filename); - if (status == 0) /* parse OK? */ - status = lua_call(L, 0, LUA_MULTRET); /* call main */ + lua_unlock(L); return status; } -static int parse_buffer (lua_State *L, const char *buff, size_t size, - const char *name) { - ZIO z; - if (!name) name = "?"; - luaZ_mopen(&z, buff, size, name); - return protectedparser(L, &z, buff[0]==ID_CHUNK); +LUA_API int lua_yield (lua_State *L, int nresults) { + CallInfo *ci; + lua_lock(L); + ci = L->ci; + if (L->nCcalls > 0) + luaG_runerror(L, "attempt to yield across metamethod/C-call boundary"); + if (ci->state & CI_C) { /* usual yield */ + if ((ci-1)->state & CI_C) + luaG_runerror(L, "cannot yield a C function"); + if (L->top - nresults > L->base) { /* is there garbage in the stack? */ + int i; + for (i=0; i<nresults; i++) /* move down results */ + setobjs2s(L->base + i, L->top - nresults + i); + L->top = L->base + nresults; + } + } /* else it's an yield inside a hook: nothing to do */ + ci->state |= CI_YIELD; + lua_unlock(L); + return -1; } -LUA_API int lua_dobuffer (lua_State *L, const char *buff, size_t size, const char *name) { - int status = parse_buffer(L, buff, size, name); - if (status == 0) /* parse OK? */ - status = lua_call(L, 0, LUA_MULTRET); /* call main */ +int luaD_pcall (lua_State *L, Pfunc func, void *u, + ptrdiff_t old_top, ptrdiff_t ef) { + int status; + unsigned short oldnCcalls = L->nCcalls; + ptrdiff_t old_ci = saveci(L, L->ci); + lu_byte old_allowhooks = L->allowhook; + ptrdiff_t old_errfunc = L->errfunc; + L->errfunc = ef; + status = luaD_rawrunprotected(L, func, u); + if (status != 0) { /* an error occurred? */ + StkId oldtop = restorestack(L, old_top); + luaF_close(L, oldtop); /* close eventual pending closures */ + seterrorobj(L, status, oldtop); + L->nCcalls = oldnCcalls; + L->ci = restoreci(L, old_ci); + L->base = L->ci->base; + L->allowhook = old_allowhooks; + restore_stack_limit(L); + } + L->errfunc = old_errfunc; return status; } -LUA_API int lua_dostring (lua_State *L, const char *str) { - return lua_dobuffer(L, str, strlen(str), str); -} - /* -** {====================================================== -** Error-recover functions (based on long jumps) -** ======================================================= +** Execute a protected parser. */ - -/* chain list of long jump buffers */ -struct lua_longjmp { - jmp_buf b; - struct lua_longjmp *previous; - volatile int status; /* error code */ +struct SParser { /* data to `f_parser' */ + ZIO *z; + Mbuffer buff; /* buffer to be used by the scanner */ + int bin; }; - -static void message (lua_State *L, const char *s) { - const TObject *em = luaH_getglobal(L, LUA_ERRORMESSAGE); - if (ttype(em) == LUA_TFUNCTION) { - *L->top = *em; - incr_top; - lua_pushstring(L, s); - luaD_call(L, L->top-2, 0); - } -} - - -/* -** Reports an error, and jumps up to the available recovery label -*/ -LUA_API void lua_error (lua_State *L, const char *s) { - if (s) message(L, s); - luaD_breakrun(L, LUA_ERRRUN); -} - - -void luaD_breakrun (lua_State *L, int errcode) { - if (L->errorJmp) { - L->errorJmp->status = errcode; - longjmp(L->errorJmp->b, 1); - } - else { - if (errcode != LUA_ERRMEM) - message(L, "unable to recover; exiting\n"); - exit(EXIT_FAILURE); - } +static void f_parser (lua_State *L, void *ud) { + struct SParser *p; + Proto *tf; + Closure *cl; + luaC_checkGC(L); + p = cast(struct SParser *, ud); + tf = p->bin ? luaU_undump(L, p->z, &p->buff) : luaY_parser(L, p->z, &p->buff); + cl = luaF_newLclosure(L, 0, gt(L)); + cl->l.p = tf; + setclvalue(L->top, cl); + incr_top(L); } -int luaD_runprotected (lua_State *L, void (*f)(lua_State *, void *), void *ud) { - StkId oldCbase = L->Cbase; - StkId oldtop = L->top; - struct lua_longjmp lj; - int allowhooks = L->allowhooks; - lj.status = 0; - lj.previous = L->errorJmp; /* chain new error handler */ - L->errorJmp = &lj; - if (setjmp(lj.b) == 0) - (*f)(L, ud); - else { /* an error occurred: restore the state */ - L->allowhooks = allowhooks; - L->Cbase = oldCbase; - L->top = oldtop; - restore_stack_limit(L); +int luaD_protectedparser (lua_State *L, ZIO *z, int bin) { + struct SParser p; + int status; + ptrdiff_t oldtopr = savestack(L, L->top); /* save current top */ + p.z = z; p.bin = bin; + luaZ_initbuffer(L, &p.buff); + status = luaD_rawrunprotected(L, f_parser, &p); + luaZ_freebuffer(L, &p.buff); + if (status != 0) { /* error? */ + StkId oldtop = restorestack(L, oldtopr); + seterrorobj(L, status, oldtop); } - L->errorJmp = lj.previous; /* restore old error handler */ - return lj.status; + return status; } -/* }====================================================== */ @@ -1,5 +1,5 @@ /* -** $Id: ldo.h,v 1.28 2000/10/06 12:45:25 roberto Exp $ +** $Id: ldo.h,v 1.56 2002/12/04 17:29:32 roberto Exp $ ** Stack and Call structure of Lua ** See Copyright Notice in lua.h */ @@ -10,24 +10,51 @@ #include "lobject.h" #include "lstate.h" +#include "lzio.h" /* -** macro to increment stack top. -** There must be always an empty slot at the L->stack.top -*/ -#define incr_top {if (L->top == L->stack_last) luaD_checkstack(L, 1); L->top++;} +** macro to control inclusion of some hard tests on stack reallocation +*/ +#ifndef HARDSTACKTESTS +#define condhardstacktests(x) { /* empty */ } +#else +#define condhardstacktests(x) x +#endif -void luaD_init (lua_State *L, int stacksize); -void luaD_adjusttop (lua_State *L, StkId base, int extra); -void luaD_lineHook (lua_State *L, StkId func, int line, lua_Hook linehook); -void luaD_call (lua_State *L, StkId func, int nResults); -void luaD_callTM (lua_State *L, Closure *f, int nParams, int nResults); -void luaD_checkstack (lua_State *L, int n); +#define luaD_checkstack(L,n) \ + if ((char *)L->stack_last - (char *)L->top <= (n)*(int)sizeof(TObject)) \ + luaD_growstack(L, n); \ + else condhardstacktests(luaD_reallocstack(L, L->stacksize)); + + +#define incr_top(L) {luaD_checkstack(L,1); L->top++;} -void luaD_breakrun (lua_State *L, int errcode); -int luaD_runprotected (lua_State *L, void (*f)(lua_State *, void *), void *ud); +#define savestack(L,p) ((char *)(p) - (char *)L->stack) +#define restorestack(L,n) ((TObject *)((char *)L->stack + (n))) + +#define saveci(L,p) ((char *)(p) - (char *)L->base_ci) +#define restoreci(L,n) ((CallInfo *)((char *)L->base_ci + (n))) + + +/* type of protected functions, to be ran by `runprotected' */ +typedef void (*Pfunc) (lua_State *L, void *ud); + +void luaD_resetprotection (lua_State *L); +int luaD_protectedparser (lua_State *L, ZIO *z, int bin); +void luaD_callhook (lua_State *L, int event, int line); +StkId luaD_precall (lua_State *L, StkId func); +void luaD_call (lua_State *L, StkId func, int nResults); +int luaD_pcall (lua_State *L, Pfunc func, void *u, + ptrdiff_t oldtop, ptrdiff_t ef); +void luaD_poscall (lua_State *L, int wanted, StkId firstResult); +void luaD_reallocCI (lua_State *L, int newsize); +void luaD_reallocstack (lua_State *L, int newsize); +void luaD_growstack (lua_State *L, int n); + +void luaD_throw (lua_State *L, int errcode); +int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud); #endif diff --git a/src/ldump.c b/src/ldump.c new file mode 100644 index 00000000..234b011f --- /dev/null +++ b/src/ldump.c @@ -0,0 +1,170 @@ +/* +** $Id: ldump.c,v 1.4 2003/02/11 23:52:12 lhf Exp $ +** save bytecodes +** See Copyright Notice in lua.h +*/ + +#include <stddef.h> + +#define ldump_c + +#include "lua.h" + +#include "lobject.h" +#include "lopcodes.h" +#include "lstate.h" +#include "lundump.h" + +#define DumpVector(b,n,size,D) DumpBlock(b,(n)*(size),D) +#define DumpLiteral(s,D) DumpBlock("" s,(sizeof(s))-1,D) + +typedef struct { + lua_State* L; + lua_Chunkwriter write; + void* data; +} DumpState; + +static void DumpBlock(const void* b, size_t size, DumpState* D) +{ + lua_unlock(D->L); + (*D->write)(D->L,b,size,D->data); + lua_lock(D->L); +} + +static void DumpByte(int y, DumpState* D) +{ + char x=(char)y; + DumpBlock(&x,sizeof(x),D); +} + +static void DumpInt(int x, DumpState* D) +{ + DumpBlock(&x,sizeof(x),D); +} + +static void DumpSize(size_t x, DumpState* D) +{ + DumpBlock(&x,sizeof(x),D); +} + +static void DumpNumber(lua_Number x, DumpState* D) +{ + DumpBlock(&x,sizeof(x),D); +} + +static void DumpString(TString* s, DumpState* D) +{ + if (s==NULL || getstr(s)==NULL) + DumpSize(0,D); + else + { + size_t size=s->tsv.len+1; /* include trailing '\0' */ + DumpSize(size,D); + DumpBlock(getstr(s),size,D); + } +} + +static void DumpCode(const Proto* f, DumpState* D) +{ + DumpInt(f->sizecode,D); + DumpVector(f->code,f->sizecode,sizeof(*f->code),D); +} + +static void DumpLocals(const Proto* f, DumpState* D) +{ + int i,n=f->sizelocvars; + DumpInt(n,D); + for (i=0; i<n; i++) + { + DumpString(f->locvars[i].varname,D); + DumpInt(f->locvars[i].startpc,D); + DumpInt(f->locvars[i].endpc,D); + } +} + +static void DumpLines(const Proto* f, DumpState* D) +{ + DumpInt(f->sizelineinfo,D); + DumpVector(f->lineinfo,f->sizelineinfo,sizeof(*f->lineinfo),D); +} + +static void DumpUpvalues(const Proto* f, DumpState* D) +{ + int i,n=f->sizeupvalues; + DumpInt(n,D); + for (i=0; i<n; i++) DumpString(f->upvalues[i],D); +} + +static void DumpFunction(const Proto* f, const TString* p, DumpState* D); + +static void DumpConstants(const Proto* f, DumpState* D) +{ + int i,n; + DumpInt(n=f->sizek,D); + for (i=0; i<n; i++) + { + const TObject* o=&f->k[i]; + DumpByte(ttype(o),D); + switch (ttype(o)) + { + case LUA_TNUMBER: + DumpNumber(nvalue(o),D); + break; + case LUA_TSTRING: + DumpString(tsvalue(o),D); + break; + case LUA_TNIL: + break; + default: + lua_assert(0); /* cannot happen */ + break; + } + } + DumpInt(n=f->sizep,D); + for (i=0; i<n; i++) DumpFunction(f->p[i],f->source,D); +} + +static void DumpFunction(const Proto* f, const TString* p, DumpState* D) +{ + DumpString((f->source==p) ? NULL : f->source,D); + DumpInt(f->lineDefined,D); + DumpByte(f->nups,D); + DumpByte(f->numparams,D); + DumpByte(f->is_vararg,D); + DumpByte(f->maxstacksize,D); + DumpLines(f,D); + DumpLocals(f,D); + DumpUpvalues(f,D); + DumpConstants(f,D); + DumpCode(f,D); +} + +static void DumpHeader(DumpState* D) +{ + DumpLiteral(LUA_SIGNATURE,D); + DumpByte(VERSION,D); + DumpByte(luaU_endianness(),D); + DumpByte(sizeof(int),D); + DumpByte(sizeof(size_t),D); + DumpByte(sizeof(Instruction),D); + DumpByte(SIZE_OP,D); + DumpByte(SIZE_A,D); + DumpByte(SIZE_B,D); + DumpByte(SIZE_C,D); + DumpByte(sizeof(lua_Number),D); + DumpNumber(TEST_NUMBER,D); +} + +/* +** dump function as precompiled chunk +*/ +void luaU_dump (lua_State* L, const Proto* Main, lua_Chunkwriter w, void* data) +{ + DumpState D; + D.L=L; + D.write=w; + D.data=data; + DumpHeader(&D); + DumpFunction(Main,NULL,&D); +} + diff --git a/src/lfunc.c b/src/lfunc.c index 6841ef71..31044fa5 100644 --- a/src/lfunc.c +++ b/src/lfunc.c @@ -1,5 +1,5 @@ /* -** $Id: lfunc.c,v 1.34 2000/10/30 12:20:29 roberto Exp $ +** $Id: lfunc.c,v 1.67 2003/03/18 12:50:04 roberto Exp $ ** Auxiliary functions to manipulate prototypes and closures ** See Copyright Notice in lua.h */ @@ -7,87 +7,113 @@ #include <stdlib.h> +#define lfunc_c + #include "lua.h" #include "lfunc.h" +#include "lgc.h" #include "lmem.h" +#include "lobject.h" #include "lstate.h" -#define sizeclosure(n) ((int)sizeof(Closure) + (int)sizeof(TObject)*((n)-1)) +#define sizeCclosure(n) (cast(int, sizeof(CClosure)) + \ + cast(int, sizeof(TObject)*((n)-1))) + +#define sizeLclosure(n) (cast(int, sizeof(LClosure)) + \ + cast(int, sizeof(TObject *)*((n)-1))) + -Closure *luaF_newclosure (lua_State *L, int nelems) { - int size = sizeclosure(nelems); - Closure *c = (Closure *)luaM_malloc(L, size); - c->next = L->rootcl; - L->rootcl = c; - c->mark = c; - c->nupvalues = nelems; - L->nblocks += size; +Closure *luaF_newCclosure (lua_State *L, int nelems) { + Closure *c = cast(Closure *, luaM_malloc(L, sizeCclosure(nelems))); + luaC_link(L, valtogco(c), LUA_TFUNCTION); + c->c.isC = 1; + c->c.nupvalues = cast(lu_byte, nelems); return c; } +Closure *luaF_newLclosure (lua_State *L, int nelems, TObject *e) { + Closure *c = cast(Closure *, luaM_malloc(L, sizeLclosure(nelems))); + luaC_link(L, valtogco(c), LUA_TFUNCTION); + c->l.isC = 0; + c->l.g = *e; + c->l.nupvalues = cast(lu_byte, nelems); + return c; +} + + +UpVal *luaF_findupval (lua_State *L, StkId level) { + GCObject **pp = &L->openupval; + UpVal *p; + UpVal *v; + while ((p = ngcotouv(*pp)) != NULL && p->v >= level) { + if (p->v == level) return p; + pp = &p->next; + } + v = luaM_new(L, UpVal); /* not found: create a new one */ + v->tt = LUA_TUPVAL; + v->marked = 1; /* open upvalues should not be collected */ + v->v = level; /* current value lives in the stack */ + v->next = *pp; /* chain it in the proper position */ + *pp = valtogco(v); + return v; +} + + +void luaF_close (lua_State *L, StkId level) { + UpVal *p; + while ((p = ngcotouv(L->openupval)) != NULL && p->v >= level) { + setobj(&p->value, p->v); /* save current value (write barrier) */ + p->v = &p->value; /* now current value lives here */ + L->openupval = p->next; /* remove from `open' list */ + luaC_link(L, valtogco(p), LUA_TUPVAL); + } +} + + Proto *luaF_newproto (lua_State *L) { Proto *f = luaM_new(L, Proto); - f->knum = NULL; - f->nknum = 0; - f->kstr = NULL; - f->nkstr = 0; - f->kproto = NULL; - f->nkproto = 0; + luaC_link(L, valtogco(f), LUA_TPROTO); + f->k = NULL; + f->sizek = 0; + f->p = NULL; + f->sizep = 0; f->code = NULL; - f->ncode = 0; + f->sizecode = 0; + f->sizelineinfo = 0; + f->sizeupvalues = 0; + f->nups = 0; + f->upvalues = NULL; f->numparams = 0; f->is_vararg = 0; f->maxstacksize = 0; - f->marked = 0; f->lineinfo = NULL; - f->nlineinfo = 0; - f->nlocvars = 0; + f->sizelocvars = 0; f->locvars = NULL; f->lineDefined = 0; f->source = NULL; - f->next = L->rootproto; /* chain in list of protos */ - L->rootproto = f; return f; } -static size_t protosize (Proto *f) { - return sizeof(Proto) - + f->nknum*sizeof(Number) - + f->nkstr*sizeof(TString *) - + f->nkproto*sizeof(Proto *) - + f->ncode*sizeof(Instruction) - + f->nlocvars*sizeof(struct LocVar) - + f->nlineinfo*sizeof(int); -} - - -void luaF_protook (lua_State *L, Proto *f, int pc) { - f->ncode = pc; /* signal that proto was properly created */ - L->nblocks += protosize(f); -} - - void luaF_freeproto (lua_State *L, Proto *f) { - if (f->ncode > 0) /* function was properly created? */ - L->nblocks -= protosize(f); - luaM_free(L, f->code); - luaM_free(L, f->locvars); - luaM_free(L, f->kstr); - luaM_free(L, f->knum); - luaM_free(L, f->kproto); - luaM_free(L, f->lineinfo); - luaM_free(L, f); + luaM_freearray(L, f->code, f->sizecode, Instruction); + luaM_freearray(L, f->p, f->sizep, Proto *); + luaM_freearray(L, f->k, f->sizek, TObject); + luaM_freearray(L, f->lineinfo, f->sizelineinfo, int); + luaM_freearray(L, f->locvars, f->sizelocvars, struct LocVar); + luaM_freearray(L, f->upvalues, f->sizeupvalues, TString *); + luaM_freelem(L, f); } void luaF_freeclosure (lua_State *L, Closure *c) { - L->nblocks -= sizeclosure(c->nupvalues); - luaM_free(L, c); + int size = (c->c.isC) ? sizeCclosure(c->c.nupvalues) : + sizeLclosure(c->l.nupvalues); + luaM_free(L, c, size); } @@ -97,11 +123,11 @@ void luaF_freeclosure (lua_State *L, Closure *c) { */ const char *luaF_getlocalname (const Proto *f, int local_number, int pc) { int i; - for (i = 0; i<f->nlocvars && f->locvars[i].startpc <= pc; i++) { + for (i = 0; i<f->sizelocvars && f->locvars[i].startpc <= pc; i++) { if (pc < f->locvars[i].endpc) { /* is variable active? */ local_number--; if (local_number == 0) - return f->locvars[i].varname->str; + return getstr(f->locvars[i].varname); } } return NULL; /* not found */ diff --git a/src/lfunc.h b/src/lfunc.h index 32afbc5d..5d532507 100644 --- a/src/lfunc.h +++ b/src/lfunc.h @@ -1,5 +1,5 @@ /* -** $Id: lfunc.h,v 1.13 2000/09/29 12:42:13 roberto Exp $ +** $Id: lfunc.h,v 1.21 2003/03/18 12:50:04 roberto Exp $ ** Auxiliary functions to manipulate prototypes and closures ** See Copyright Notice in lua.h */ @@ -11,10 +11,11 @@ #include "lobject.h" - Proto *luaF_newproto (lua_State *L); -void luaF_protook (lua_State *L, Proto *f, int pc); -Closure *luaF_newclosure (lua_State *L, int nelems); +Closure *luaF_newCclosure (lua_State *L, int nelems); +Closure *luaF_newLclosure (lua_State *L, int nelems, TObject *e); +UpVal *luaF_findupval (lua_State *L, StkId level); +void luaF_close (lua_State *L, StkId level); void luaF_freeproto (lua_State *L, Proto *f); void luaF_freeclosure (lua_State *L, Closure *c); @@ -1,11 +1,16 @@ /* -** $Id: lgc.c,v 1.72+ 2000/10/26 12:47:05 roberto Exp $ +** $Id: lgc.c,v 1.171 2003/04/03 13:35:34 roberto Exp $ ** Garbage Collector ** See Copyright Notice in lua.h */ +#include <string.h> + +#define lgc_c + #include "lua.h" +#include "ldebug.h" #include "ldo.h" #include "lfunc.h" #include "lgc.h" @@ -18,336 +23,471 @@ typedef struct GCState { - Hash *tmark; /* list of marked tables to be visited */ - Closure *cmark; /* list of marked closures to be visited */ + GCObject *tmark; /* list of marked objects to be traversed */ + GCObject *wk; /* list of traversed key-weak tables (to be cleared) */ + GCObject *wv; /* list of traversed value-weak tables */ + GCObject *wkv; /* list of traversed key-value weak tables */ + global_State *g; } GCState; +/* +** some userful bit tricks +*/ +#define setbit(x,b) ((x) |= (1<<(b))) +#define resetbit(x,b) ((x) &= cast(lu_byte, ~(1<<(b)))) +#define testbit(x,b) ((x) & (1<<(b))) -static void markobject (GCState *st, TObject *o); +#define unmark(x) resetbit((x)->gch.marked, 0) +#define ismarked(x) ((x)->gch.marked & ((1<<4)|1)) +#define stringmark(s) setbit((s)->tsv.marked, 0) -/* mark a string; marks larger than 1 cannot be changed */ -#define strmark(s) {if ((s)->marked == 0) (s)->marked = 1;} +#define isfinalized(u) (!testbit((u)->uv.marked, 1)) +#define markfinalized(u) resetbit((u)->uv.marked, 1) -static void protomark (Proto *f) { - if (!f->marked) { - int i; - f->marked = 1; - strmark(f->source); - for (i=0; i<f->nkstr; i++) - strmark(f->kstr[i]); - for (i=0; i<f->nkproto; i++) - protomark(f->kproto[i]); - for (i=0; i<f->nlocvars; i++) /* mark local-variable names */ - strmark(f->locvars[i].varname); - } -} +#define KEYWEAKBIT 1 +#define VALUEWEAKBIT 2 +#define KEYWEAK (1<<KEYWEAKBIT) +#define VALUEWEAK (1<<VALUEWEAKBIT) -static void markstack (lua_State *L, GCState *st) { - StkId o; - for (o=L->stack; o<L->top; o++) - markobject(st, o); -} +#define markobject(st,o) { checkconsistency(o); \ + if (iscollectable(o) && !ismarked(gcvalue(o))) reallymarkobject(st,gcvalue(o)); } -static void marklock (lua_State *L, GCState *st) { - int i; - for (i=0; i<L->refSize; i++) { - if (L->refArray[i].st == LOCK) - markobject(st, &L->refArray[i].o); +#define condmarkobject(st,o,c) { checkconsistency(o); \ + if (iscollectable(o) && !ismarked(gcvalue(o)) && (c)) \ + reallymarkobject(st,gcvalue(o)); } + +#define markvalue(st,t) { if (!ismarked(valtogco(t))) \ + reallymarkobject(st, valtogco(t)); } + + + +static void reallymarkobject (GCState *st, GCObject *o) { + lua_assert(!ismarked(o)); + setbit(o->gch.marked, 0); /* mark object */ + switch (o->gch.tt) { + case LUA_TUSERDATA: { + markvalue(st, gcotou(o)->uv.metatable); + break; + } + case LUA_TFUNCTION: { + gcotocl(o)->c.gclist = st->tmark; + st->tmark = o; + break; + } + case LUA_TTABLE: { + gcotoh(o)->gclist = st->tmark; + st->tmark = o; + break; + } + case LUA_TTHREAD: { + gcototh(o)->gclist = st->tmark; + st->tmark = o; + break; + } + case LUA_TPROTO: { + gcotop(o)->gclist = st->tmark; + st->tmark = o; + break; + } + default: lua_assert(o->gch.tt == LUA_TSTRING); } } -static void markclosure (GCState *st, Closure *cl) { - if (!ismarked(cl)) { - if (!cl->isC) - protomark(cl->f.l); - cl->mark = st->cmark; /* chain it for later traversal */ - st->cmark = cl; +static void marktmu (GCState *st) { + GCObject *u; + for (u = st->g->tmudata; u; u = u->gch.next) { + unmark(u); /* may be marked, if left from previous GC */ + reallymarkobject(st, u); } } -static void marktagmethods (lua_State *L, GCState *st) { - int e; - for (e=0; e<TM_N; e++) { - int t; - for (t=0; t<=L->last_tag; t++) { - Closure *cl = luaT_gettm(L, t, e); - if (cl) markclosure(st, cl); +/* move `dead' udata that need finalization to list `tmudata' */ +void luaC_separateudata (lua_State *L) { + GCObject **p = &G(L)->rootudata; + GCObject *curr; + GCObject *collected = NULL; /* to collect udata with gc event */ + GCObject **lastcollected = &collected; + while ((curr = *p) != NULL) { + lua_assert(curr->gch.tt == LUA_TUSERDATA); + if (ismarked(curr) || isfinalized(gcotou(curr))) + p = &curr->gch.next; /* don't bother with them */ + + else if (fasttm(L, gcotou(curr)->uv.metatable, TM_GC) == NULL) { + markfinalized(gcotou(curr)); /* don't need finalization */ + p = &curr->gch.next; + } + else { /* must call its gc method */ + *p = curr->gch.next; + curr->gch.next = NULL; /* link `curr' at the end of `collected' list */ + *lastcollected = curr; + lastcollected = &curr->gch.next; } } + /* insert collected udata with gc event into `tmudata' list */ + *lastcollected = G(L)->tmudata; + G(L)->tmudata = collected; } -static void markobject (GCState *st, TObject *o) { - switch (ttype(o)) { - case LUA_TUSERDATA: case LUA_TSTRING: - strmark(tsvalue(o)); - break; - case LUA_TMARK: - markclosure(st, infovalue(o)->func); - break; - case LUA_TFUNCTION: - markclosure(st, clvalue(o)); - break; - case LUA_TTABLE: { - if (!ismarked(hvalue(o))) { - hvalue(o)->mark = st->tmark; /* chain it in list of marked */ - st->tmark = hvalue(o); - } - break; - } - default: break; /* numbers, etc */ - } +static void removekey (Node *n) { + setnilvalue(gval(n)); /* remove corresponding value ... */ + if (iscollectable(gkey(n))) + setttype(gkey(n), LUA_TNONE); /* dead key; remove it */ } -static void markall (lua_State *L) { - GCState st; - st.cmark = NULL; - st.tmark = L->gt; /* put table of globals in mark list */ - L->gt->mark = NULL; - marktagmethods(L, &st); /* mark tag methods */ - markstack(L, &st); /* mark stack objects */ - marklock(L, &st); /* mark locked objects */ - for (;;) { /* mark tables and closures */ - if (st.cmark) { - int i; - Closure *f = st.cmark; /* get first closure from list */ - st.cmark = f->mark; /* remove it from list */ - for (i=0; i<f->nupvalues; i++) /* mark its upvalues */ - markobject(&st, &f->upvalue[i]); +static void traversetable (GCState *st, Table *h) { + int i; + int weakkey = 0; + int weakvalue = 0; + const TObject *mode; + markvalue(st, h->metatable); + lua_assert(h->lsizenode || h->node == st->g->dummynode); + mode = gfasttm(st->g, h->metatable, TM_MODE); + if (mode && ttisstring(mode)) { /* is there a weak mode? */ + weakkey = (strchr(svalue(mode), 'k') != NULL); + weakvalue = (strchr(svalue(mode), 'v') != NULL); + if (weakkey || weakvalue) { /* is really weak? */ + GCObject **weaklist; + h->marked &= ~(KEYWEAK | VALUEWEAK); /* clear bits */ + h->marked |= cast(lu_byte, (weakkey << KEYWEAKBIT) | + (weakvalue << VALUEWEAKBIT)); + weaklist = (weakkey && weakvalue) ? &st->wkv : + (weakkey) ? &st->wk : + &st->wv; + h->gclist = *weaklist; /* must be cleared after GC, ... */ + *weaklist = valtogco(h); /* ... so put in the appropriate list */ } - else if (st.tmark) { - int i; - Hash *h = st.tmark; /* get first table from list */ - st.tmark = h->mark; /* remove it from list */ - for (i=0; i<h->size; i++) { - Node *n = node(h, i); - if (ttype(key(n)) != LUA_TNIL) { - if (ttype(val(n)) == LUA_TNIL) - luaH_remove(h, key(n)); /* dead element; try to remove it */ - markobject(&st, &n->key); - markobject(&st, &n->val); - } - } + } + if (!weakvalue) { + i = h->sizearray; + while (i--) + markobject(st, &h->array[i]); + } + i = sizenode(h); + while (i--) { + Node *n = gnode(h, i); + if (!ttisnil(gval(n))) { + lua_assert(!ttisnil(gkey(n))); + condmarkobject(st, gkey(n), !weakkey); + condmarkobject(st, gval(n), !weakvalue); } - else break; /* nothing else to mark */ } } -static int hasmark (const TObject *o) { - /* valid only for locked objects */ - switch (o->ttype) { - case LUA_TSTRING: case LUA_TUSERDATA: - return tsvalue(o)->marked; - case LUA_TTABLE: - return ismarked(hvalue(o)); - case LUA_TFUNCTION: - return ismarked(clvalue(o)); - default: /* number */ - return 1; +static void traverseproto (GCState *st, Proto *f) { + int i; + stringmark(f->source); + for (i=0; i<f->sizek; i++) { /* mark literal strings */ + if (ttisstring(f->k+i)) + stringmark(tsvalue(f->k+i)); } + for (i=0; i<f->sizeupvalues; i++) /* mark upvalue names */ + stringmark(f->upvalues[i]); + for (i=0; i<f->sizep; i++) /* mark nested protos */ + markvalue(st, f->p[i]); + for (i=0; i<f->sizelocvars; i++) /* mark local-variable names */ + stringmark(f->locvars[i].varname); + lua_assert(luaG_checkcode(f)); } -/* macro for internal debugging; check if a link of free refs is valid */ -#define VALIDLINK(L, st,n) (NONEXT <= (st) && (st) < (n)) -static void invalidaterefs (lua_State *L) { - int n = L->refSize; - int i; - for (i=0; i<n; i++) { - struct Ref *r = &L->refArray[i]; - if (r->st == HOLD && !hasmark(&r->o)) - r->st = COLLECTED; - LUA_ASSERT((r->st == LOCK && hasmark(&r->o)) || - (r->st == HOLD && hasmark(&r->o)) || - r->st == COLLECTED || - r->st == NONEXT || - (r->st < n && VALIDLINK(L, L->refArray[r->st].st, n)), - "inconsistent ref table"); +static void traverseclosure (GCState *st, Closure *cl) { + if (cl->c.isC) { + int i; + for (i=0; i<cl->c.nupvalues; i++) /* mark its upvalues */ + markobject(st, &cl->c.upvalue[i]); + } + else { + int i; + lua_assert(cl->l.nupvalues == cl->l.p->nups); + markvalue(st, hvalue(&cl->l.g)); + markvalue(st, cl->l.p); + for (i=0; i<cl->l.nupvalues; i++) { /* mark its upvalues */ + UpVal *u = cl->l.upvals[i]; + if (!u->marked) { + markobject(st, &u->value); + u->marked = 1; + } + } } - LUA_ASSERT(VALIDLINK(L, L->refFree, n), "inconsistent ref table"); } +static void checkstacksizes (lua_State *L, StkId max) { + int used = L->ci - L->base_ci; /* number of `ci' in use */ + if (4*used < L->size_ci && 2*BASIC_CI_SIZE < L->size_ci) + luaD_reallocCI(L, L->size_ci/2); /* still big enough... */ + else condhardstacktests(luaD_reallocCI(L, L->size_ci)); + used = max - L->stack; /* part of stack in use */ + if (4*used < L->stacksize && 2*(BASIC_STACK_SIZE+EXTRA_STACK) < L->stacksize) + luaD_reallocstack(L, L->stacksize/2); /* still big enough... */ + else condhardstacktests(luaD_reallocstack(L, L->stacksize)); +} -static void collectproto (lua_State *L) { - Proto **p = &L->rootproto; - Proto *next; - while ((next = *p) != NULL) { - if (next->marked) { - next->marked = 0; - p = &next->next; - } - else { - *p = next->next; - luaF_freeproto(L, next); - } + +static void traversestack (GCState *st, lua_State *L1) { + StkId o, lim; + CallInfo *ci; + markobject(st, gt(L1)); + lim = L1->top; + for (ci = L1->base_ci; ci <= L1->ci; ci++) { + lua_assert(ci->top <= L1->stack_last); + lua_assert(ci->state & (CI_C | CI_HASFRAME | CI_SAVEDPC)); + if (!(ci->state & CI_C) && lim < ci->top) + lim = ci->top; } + for (o = L1->stack; o < L1->top; o++) + markobject(st, o); + for (; o <= lim; o++) + setnilvalue(o); + checkstacksizes(L1, lim); } -static void collectclosure (lua_State *L) { - Closure **p = &L->rootcl; - Closure *next; - while ((next = *p) != NULL) { - if (ismarked(next)) { - next->mark = next; /* unmark */ - p = &next->next; +static void propagatemarks (GCState *st) { + while (st->tmark) { /* traverse marked objects */ + switch (st->tmark->gch.tt) { + case LUA_TTABLE: { + Table *h = gcotoh(st->tmark); + st->tmark = h->gclist; + traversetable(st, h); + break; + } + case LUA_TFUNCTION: { + Closure *cl = gcotocl(st->tmark); + st->tmark = cl->c.gclist; + traverseclosure(st, cl); + break; + } + case LUA_TTHREAD: { + lua_State *th = gcototh(st->tmark); + st->tmark = th->gclist; + traversestack(st, th); + break; + } + case LUA_TPROTO: { + Proto *p = gcotop(st->tmark); + st->tmark = p->gclist; + traverseproto(st, p); + break; + } + default: lua_assert(0); } - else { - *p = next->next; - luaF_freeclosure(L, next); + } +} + + +static int valismarked (const TObject *o) { + if (ttisstring(o)) + stringmark(tsvalue(o)); /* strings are `values', so are never weak */ + return !iscollectable(o) || testbit(o->value.gc->gch.marked, 0); +} + + +/* +** clear collected keys from weaktables +*/ +static void cleartablekeys (GCObject *l) { + while (l) { + Table *h = gcotoh(l); + int i = sizenode(h); + lua_assert(h->marked & KEYWEAK); + while (i--) { + Node *n = gnode(h, i); + if (!valismarked(gkey(n))) /* key was collected? */ + removekey(n); /* remove entry from table */ } + l = h->gclist; } } -static void collecttable (lua_State *L) { - Hash **p = &L->roottable; - Hash *next; - while ((next = *p) != NULL) { - if (ismarked(next)) { - next->mark = next; /* unmark */ - p = &next->next; +/* +** clear collected values from weaktables +*/ +static void cleartablevalues (GCObject *l) { + while (l) { + Table *h = gcotoh(l); + int i = h->sizearray; + lua_assert(h->marked & VALUEWEAK); + while (i--) { + TObject *o = &h->array[i]; + if (!valismarked(o)) /* value was collected? */ + setnilvalue(o); /* remove value */ } - else { - *p = next->next; - luaH_free(L, next); + i = sizenode(h); + while (i--) { + Node *n = gnode(h, i); + if (!valismarked(gval(n))) /* value was collected? */ + removekey(n); /* remove entry from table */ } + l = h->gclist; } } -static void checktab (lua_State *L, stringtable *tb) { - if (tb->nuse < (lint32)(tb->size/4) && tb->size > 10) - luaS_resize(L, tb, tb->size/2); /* table is too big */ +static void freeobj (lua_State *L, GCObject *o) { + switch (o->gch.tt) { + case LUA_TPROTO: luaF_freeproto(L, gcotop(o)); break; + case LUA_TFUNCTION: luaF_freeclosure(L, gcotocl(o)); break; + case LUA_TUPVAL: luaM_freelem(L, gcotouv(o)); break; + case LUA_TTABLE: luaH_free(L, gcotoh(o)); break; + case LUA_TTHREAD: { + lua_assert(gcototh(o) != L && gcototh(o) != G(L)->mainthread); + luaE_freethread(L, gcototh(o)); + break; + } + case LUA_TSTRING: { + luaM_free(L, o, sizestring(gcotots(o)->tsv.len)); + break; + } + case LUA_TUSERDATA: { + luaM_free(L, o, sizeudata(gcotou(o)->uv.len)); + break; + } + default: lua_assert(0); + } } -static void collectstrings (lua_State *L, int all) { - int i; - for (i=0; i<L->strt.size; i++) { /* for each list */ - TString **p = &L->strt.hash[i]; - TString *next; - while ((next = *p) != NULL) { - if (next->marked && !all) { /* preserve? */ - if (next->marked < FIXMARK) /* does not change FIXMARKs */ - next->marked = 0; - p = &next->nexthash; - } - else { /* collect */ - *p = next->nexthash; - L->strt.nuse--; - L->nblocks -= sizestring(next->len); - luaM_free(L, next); - } +static int sweeplist (lua_State *L, GCObject **p, int limit) { + GCObject *curr; + int count = 0; /* number of collected items */ + while ((curr = *p) != NULL) { + if (curr->gch.marked > limit) { + unmark(curr); + p = &curr->gch.next; + } + else { + count++; + *p = curr->gch.next; + freeobj(L, curr); } } - checktab(L, &L->strt); + return count; } -static void collectudata (lua_State *L, int all) { +static void sweepstrings (lua_State *L, int all) { int i; - for (i=0; i<L->udt.size; i++) { /* for each list */ - TString **p = &L->udt.hash[i]; - TString *next; - while ((next = *p) != NULL) { - LUA_ASSERT(next->marked <= 1, "udata cannot be fixed"); - if (next->marked && !all) { /* preserve? */ - next->marked = 0; - p = &next->nexthash; - } - else { /* collect */ - int tag = next->u.d.tag; - *p = next->nexthash; - next->nexthash = L->TMtable[tag].collected; /* chain udata */ - L->TMtable[tag].collected = next; - L->nblocks -= sizestring(next->len); - L->udt.nuse--; - } - } + for (i=0; i<G(L)->strt.size; i++) { /* for each list */ + G(L)->strt.nuse -= sweeplist(L, &G(L)->strt.hash[i], all); } - checktab(L, &L->udt); } -#define MINBUFFER 256 -static void checkMbuffer (lua_State *L) { - if (L->Mbuffsize > MINBUFFER*2) { /* is buffer too big? */ - size_t newsize = L->Mbuffsize/2; /* still larger than MINBUFFER */ - L->nblocks += (newsize - L->Mbuffsize)*sizeof(char); - L->Mbuffsize = newsize; - luaM_reallocvector(L, L->Mbuffer, newsize, char); +static void checkSizes (lua_State *L) { + /* check size of string hash */ + if (G(L)->strt.nuse < cast(ls_nstr, G(L)->strt.size/4) && + G(L)->strt.size > MINSTRTABSIZE*2) + luaS_resize(L, G(L)->strt.size/2); /* table is too big */ + /* check size of buffer */ + if (luaZ_sizebuffer(&G(L)->buff) > LUA_MINBUFFER*2) { /* buffer too big? */ + size_t newsize = luaZ_sizebuffer(&G(L)->buff) / 2; + luaZ_resizebuffer(L, &G(L)->buff, newsize); } + G(L)->GCthreshold = 2*G(L)->nblocks; /* new threshold */ } -static void callgcTM (lua_State *L, const TObject *o) { - Closure *tm = luaT_gettmbyObj(L, o, TM_GC); +static void do1gcTM (lua_State *L, Udata *udata) { + const TObject *tm = fasttm(L, udata->uv.metatable, TM_GC); if (tm != NULL) { - int oldah = L->allowhooks; - L->allowhooks = 0; /* stop debug hooks during GC tag methods */ - luaD_checkstack(L, 2); - clvalue(L->top) = tm; - ttype(L->top) = LUA_TFUNCTION; - *(L->top+1) = *o; + setobj2s(L->top, tm); + setuvalue(L->top+1, udata); L->top += 2; - luaD_call(L, L->top-2, 0); - L->allowhooks = oldah; /* restore hooks */ + luaD_call(L, L->top - 2, 0); } } -static void callgcTMudata (lua_State *L) { - int tag; - TObject o; - ttype(&o) = LUA_TUSERDATA; - L->GCthreshold = 2*L->nblocks; /* avoid GC during tag methods */ - for (tag=L->last_tag; tag>=0; tag--) { /* for each tag (in reverse order) */ - TString *udata; - while ((udata = L->TMtable[tag].collected) != NULL) { - L->TMtable[tag].collected = udata->nexthash; /* remove it from list */ - tsvalue(&o) = udata; - callgcTM(L, &o); - luaM_free(L, udata); - } +void luaC_callGCTM (lua_State *L) { + lu_byte oldah = L->allowhook; + L->allowhook = 0; /* stop debug hooks during GC tag methods */ + L->top++; /* reserve space to keep udata while runs its gc method */ + while (G(L)->tmudata != NULL) { + GCObject *o = G(L)->tmudata; + Udata *udata = gcotou(o); + G(L)->tmudata = udata->uv.next; /* remove udata from `tmudata' */ + udata->uv.next = G(L)->rootudata; /* return it to `root' list */ + G(L)->rootudata = o; + setuvalue(L->top - 1, udata); /* keep a reference to it */ + unmark(o); + markfinalized(udata); + do1gcTM(L, udata); } + L->top--; + L->allowhook = oldah; /* restore hooks */ } -void luaC_collect (lua_State *L, int all) { - collectudata(L, all); - callgcTMudata(L); - collectstrings(L, all); - collecttable(L); - collectproto(L); - collectclosure(L); +void luaC_sweep (lua_State *L, int all) { + if (all) all = 256; /* larger than any mark */ + sweeplist(L, &G(L)->rootudata, all); + sweepstrings(L, all); + sweeplist(L, &G(L)->rootgc, all); +} + + +/* mark root set */ +static void markroot (GCState *st, lua_State *L) { + global_State *g = st->g; + markobject(st, defaultmeta(L)); + markobject(st, registry(L)); + traversestack(st, g->mainthread); + if (L != g->mainthread) /* another thread is running? */ + markvalue(st, L); /* cannot collect it */ +} + + +static void mark (lua_State *L) { + GCState st; + GCObject *wkv; + st.g = G(L); + st.tmark = NULL; + st.wkv = st.wk = st.wv = NULL; + markroot(&st, L); + propagatemarks(&st); /* mark all reachable objects */ + cleartablevalues(st.wkv); + cleartablevalues(st.wv); + wkv = st.wkv; /* keys must be cleared after preserving udata */ + st.wkv = NULL; + st.wv = NULL; + luaC_separateudata(L); /* separate userdata to be preserved */ + marktmu(&st); /* mark `preserved' userdata */ + propagatemarks(&st); /* remark, to propagate `preserveness' */ + cleartablekeys(wkv); + /* `propagatemarks' may resuscitate some weak tables; clear them too */ + cleartablekeys(st.wk); + cleartablevalues(st.wv); + cleartablekeys(st.wkv); + cleartablevalues(st.wkv); } void luaC_collectgarbage (lua_State *L) { - markall(L); - invalidaterefs(L); /* check unlocked references */ - luaC_collect(L, 0); - checkMbuffer(L); - L->GCthreshold = 2*L->nblocks; /* set new threshold */ - callgcTM(L, &luaO_nilobject); + mark(L); + luaC_sweep(L, 0); + checkSizes(L); + luaC_callGCTM(L); } -void luaC_checkGC (lua_State *L) { - if (L->nblocks >= L->GCthreshold) - luaC_collectgarbage(L); +void luaC_link (lua_State *L, GCObject *o, lu_byte tt) { + o->gch.next = G(L)->rootgc; + G(L)->rootgc = o; + o->gch.marked = 0; + o->gch.tt = tt; } @@ -1,5 +1,5 @@ /* -** $Id: lgc.h,v 1.9 2001/02/02 16:23:20 roberto Exp $ +** $Id: lgc.h,v 1.19 2003/02/28 19:45:15 roberto Exp $ ** Garbage Collector ** See Copyright Notice in lua.h */ @@ -11,9 +11,15 @@ #include "lobject.h" -void luaC_collect (lua_State *L, int all); +#define luaC_checkGC(L) { lua_assert(!(L->ci->state & CI_CALLING)); \ + if (G(L)->nblocks >= G(L)->GCthreshold) luaC_collectgarbage(L); } + + +void luaC_separateudata (lua_State *L); +void luaC_callGCTM (lua_State *L); +void luaC_sweep (lua_State *L, int all); void luaC_collectgarbage (lua_State *L); -void luaC_checkGC (lua_State *L); +void luaC_link (lua_State *L, GCObject *o, lu_byte tt); #endif diff --git a/src/lib/Makefile b/src/lib/Makefile index 081b8867..3c6c07ab 100644 --- a/src/lib/Makefile +++ b/src/lib/Makefile @@ -4,17 +4,16 @@ LUA= ../.. include $(LUA)/config -# actually only used in liolib.c -EXTRA_DEFS= $(POPEN) +EXTRA_DEFS= $(POPEN) $(TMPNAM) $(DEGREES) $(LOADLIB) -OBJS= lauxlib.o lbaselib.o ldblib.o liolib.o lmathlib.o lstrlib.o -SRCS= lauxlib.c lbaselib.c ldblib.c liolib.c lmathlib.c lstrlib.c +OBJS= lauxlib.o lbaselib.o ldblib.o liolib.o lmathlib.o ltablib.o lstrlib.o loadlib.o +SRCS= lauxlib.c lbaselib.c ldblib.c liolib.c lmathlib.c ltablib.c lstrlib.c loadlib.c T= $(LIB)/liblualib.a -all: $T +all: $T -$T: $(OBJS) +$T: $(OBJS) $(AR) $@ $(OBJS) $(RANLIB) $@ diff --git a/src/lib/README b/src/lib/README index c04a12e2..c5600b8e 100644 --- a/src/lib/README +++ b/src/lib/README @@ -1,6 +1,8 @@ This is the standard Lua library. -It is implemented entirely on top of the official Lua API as declared in lua.h, -using lauxlib.c, which contains several useful functions for writing libraries. -We encourage developers to use lauxlib.c in their own libraries. + The code of the standard library can be read as an example of how to export -C functions to Lua. +C functions to Lua. The easiest library to read is lmathlib.c. + +The library is implemented entirely on top of the official Lua API as declared +in lua.h, using lauxlib.c, which contains several useful functions for writing +libraries. We encourage developers to use lauxlib.c in their own libraries. diff --git a/src/lib/lauxlib.c b/src/lib/lauxlib.c index 4bdaeeff..ee2d1339 100644 --- a/src/lib/lauxlib.c +++ b/src/lib/lauxlib.c @@ -1,25 +1,101 @@ /* -** $Id: lauxlib.c,v 1.43 2000/10/30 13:07:48 roberto Exp $ +** $Id: lauxlib.c,v 1.100 2003/04/07 14:35:00 roberto Exp $ ** Auxiliary functions for building Lua libraries ** See Copyright Notice in lua.h */ +#include <ctype.h> +#include <errno.h> #include <stdarg.h> #include <stdio.h> #include <string.h> + /* This file uses only the official API of Lua. ** Any function declared here could be written as an application function. -** With care, these functions can be used by other libraries. */ +#define lauxlib_c + #include "lua.h" #include "lauxlib.h" -#include "luadebug.h" +/* number of prereserved references (for internal use) */ +#define RESERVED_REFS 2 + +/* reserved references */ +#define FREELIST_REF 1 /* free list of references */ +#define ARRAYSIZE_REF 2 /* array sizes */ + + +/* convert a stack index to positive */ +#define abs_index(L, i) ((i) > 0 || (i) <= LUA_REGISTRYINDEX ? (i) : \ + lua_gettop(L) + (i) + 1) + + +/* +** {====================================================== +** Error-report functions +** ======================================================= +*/ + + +LUALIB_API int luaL_argerror (lua_State *L, int narg, const char *extramsg) { + lua_Debug ar; + lua_getstack(L, 0, &ar); + lua_getinfo(L, "n", &ar); + if (strcmp(ar.namewhat, "method") == 0) { + narg--; /* do not count `self' */ + if (narg == 0) /* error is in the self argument itself? */ + return luaL_error(L, "calling `%s' on bad self (%s)", ar.name, extramsg); + } + if (ar.name == NULL) + ar.name = "?"; + return luaL_error(L, "bad argument #%d to `%s' (%s)", + narg, ar.name, extramsg); +} + + +LUALIB_API int luaL_typerror (lua_State *L, int narg, const char *tname) { + const char *msg = lua_pushfstring(L, "%s expected, got %s", + tname, lua_typename(L, lua_type(L,narg))); + return luaL_argerror(L, narg, msg); +} + + +static void tag_error (lua_State *L, int narg, int tag) { + luaL_typerror(L, narg, lua_typename(L, tag)); +} + + +LUALIB_API void luaL_where (lua_State *L, int level) { + lua_Debug ar; + if (lua_getstack(L, level, &ar)) { /* check function at level */ + lua_getinfo(L, "Snl", &ar); /* get info about it */ + if (ar.currentline > 0) { /* is there info? */ + lua_pushfstring(L, "%s:%d: ", ar.short_src, ar.currentline); + return; + } + } + lua_pushliteral(L, ""); /* else, no information available... */ +} + + +LUALIB_API int luaL_error (lua_State *L, const char *fmt, ...) { + va_list argp; + va_start(argp, fmt); + luaL_where(L, 1); + lua_pushvfstring(L, fmt, argp); + va_end(argp); + lua_concat(L, 2); + return lua_error(L); +} + +/* }====================================================== */ + LUALIB_API int luaL_findstring (const char *name, const char *const list[]) { int i; @@ -29,34 +105,55 @@ LUALIB_API int luaL_findstring (const char *name, const char *const list[]) { return -1; /* name not found */ } -LUALIB_API void luaL_argerror (lua_State *L, int narg, const char *extramsg) { - lua_Debug ar; - lua_getstack(L, 0, &ar); - lua_getinfo(L, "n", &ar); - if (ar.name == NULL) - ar.name = "?"; - luaL_verror(L, "bad argument #%d to `%.50s' (%.100s)", - narg, ar.name, extramsg); + +LUALIB_API int luaL_newmetatable (lua_State *L, const char *tname) { + lua_pushstring(L, tname); + lua_rawget(L, LUA_REGISTRYINDEX); /* get registry.name */ + if (!lua_isnil(L, -1)) /* name already in use? */ + return 0; /* leave previous value on top, but return 0 */ + lua_pop(L, 1); + lua_newtable(L); /* create metatable */ + lua_pushstring(L, tname); + lua_pushvalue(L, -2); + lua_rawset(L, LUA_REGISTRYINDEX); /* registry.name = metatable */ + lua_pushvalue(L, -1); + lua_pushstring(L, tname); + lua_rawset(L, LUA_REGISTRYINDEX); /* registry[metatable] = name */ + return 1; } -static void type_error (lua_State *L, int narg, int t) { - char buff[50]; - sprintf(buff, "%.8s expected, got %.8s", lua_typename(L, t), - lua_typename(L, lua_type(L, narg))); - luaL_argerror(L, narg, buff); +LUALIB_API void luaL_getmetatable (lua_State *L, const char *tname) { + lua_pushstring(L, tname); + lua_rawget(L, LUA_REGISTRYINDEX); +} + + +LUALIB_API void *luaL_checkudata (lua_State *L, int ud, const char *tname) { + const char *tn; + if (!lua_getmetatable(L, ud)) return NULL; /* no metatable? */ + lua_rawget(L, LUA_REGISTRYINDEX); /* get registry[metatable] */ + tn = lua_tostring(L, -1); + if (tn && (strcmp(tn, tname) == 0)) { + lua_pop(L, 1); + return lua_touserdata(L, ud); + } + else { + lua_pop(L, 1); + return NULL; + } } LUALIB_API void luaL_checkstack (lua_State *L, int space, const char *mes) { - if (space > lua_stackspace(L)) - luaL_verror(L, "stack overflow (%.30s)", mes); + if (!lua_checkstack(L, space)) + luaL_error(L, "stack overflow (%s)", mes); } -LUALIB_API void luaL_checktype(lua_State *L, int narg, int t) { +LUALIB_API void luaL_checktype (lua_State *L, int narg, int t) { if (lua_type(L, narg) != t) - type_error(L, narg, t); + tag_error(L, narg, t); } @@ -66,55 +163,164 @@ LUALIB_API void luaL_checkany (lua_State *L, int narg) { } -LUALIB_API const char *luaL_check_lstr (lua_State *L, int narg, size_t *len) { +LUALIB_API const char *luaL_checklstring (lua_State *L, int narg, size_t *len) { const char *s = lua_tostring(L, narg); - if (!s) type_error(L, narg, LUA_TSTRING); + if (!s) tag_error(L, narg, LUA_TSTRING); if (len) *len = lua_strlen(L, narg); return s; } -LUALIB_API const char *luaL_opt_lstr (lua_State *L, int narg, const char *def, size_t *len) { - if (lua_isnull(L, narg)) { +LUALIB_API const char *luaL_optlstring (lua_State *L, int narg, + const char *def, size_t *len) { + if (lua_isnoneornil(L, narg)) { if (len) *len = (def ? strlen(def) : 0); return def; } - else return luaL_check_lstr(L, narg, len); + else return luaL_checklstring(L, narg, len); } -LUALIB_API double luaL_check_number (lua_State *L, int narg) { - double d = lua_tonumber(L, narg); +LUALIB_API lua_Number luaL_checknumber (lua_State *L, int narg) { + lua_Number d = lua_tonumber(L, narg); if (d == 0 && !lua_isnumber(L, narg)) /* avoid extra test when d is not 0 */ - type_error(L, narg, LUA_TNUMBER); + tag_error(L, narg, LUA_TNUMBER); return d; } -LUALIB_API double luaL_opt_number (lua_State *L, int narg, double def) { - if (lua_isnull(L, narg)) return def; - else return luaL_check_number(L, narg); +LUALIB_API lua_Number luaL_optnumber (lua_State *L, int narg, lua_Number def) { + if (lua_isnoneornil(L, narg)) return def; + else return luaL_checknumber(L, narg); } -LUALIB_API void luaL_openlib (lua_State *L, const struct luaL_reg *l, int n) { - int i; - for (i=0; i<n; i++) - lua_register(L, l[i].name, l[i].func); +LUALIB_API int luaL_getmetafield (lua_State *L, int obj, const char *event) { + if (!lua_getmetatable(L, obj)) /* no metatable? */ + return 0; + lua_pushstring(L, event); + lua_rawget(L, -2); + if (lua_isnil(L, -1)) { + lua_pop(L, 2); /* remove metatable and metafield */ + return 0; + } + else { + lua_remove(L, -2); /* remove only metatable */ + return 1; + } } -LUALIB_API void luaL_verror (lua_State *L, const char *fmt, ...) { - char buff[500]; - va_list argp; - va_start(argp, fmt); - vsprintf(buff, fmt, argp); - va_end(argp); - lua_error(L, buff); +LUALIB_API int luaL_callmeta (lua_State *L, int obj, const char *event) { + obj = abs_index(L, obj); + if (!luaL_getmetafield(L, obj, event)) /* no metafield? */ + return 0; + lua_pushvalue(L, obj); + lua_call(L, 1, 1); + return 1; } +LUALIB_API void luaL_openlib (lua_State *L, const char *libname, + const luaL_reg *l, int nup) { + if (libname) { + lua_pushstring(L, libname); + lua_gettable(L, LUA_GLOBALSINDEX); /* check whether lib already exists */ + if (lua_isnil(L, -1)) { /* no? */ + lua_pop(L, 1); + lua_newtable(L); /* create it */ + lua_pushstring(L, libname); + lua_pushvalue(L, -2); + lua_settable(L, LUA_GLOBALSINDEX); /* register it with given name */ + } + lua_insert(L, -(nup+1)); /* move library table to below upvalues */ + } + for (; l->name; l++) { + int i; + lua_pushstring(L, l->name); + for (i=0; i<nup; i++) /* copy upvalues to the top */ + lua_pushvalue(L, -(nup+1)); + lua_pushcclosure(L, l->func, nup); + lua_settable(L, -(nup+3)); + } + lua_pop(L, nup); /* remove upvalues */ +} + + + +/* +** {====================================================== +** getn-setn: size for arrays +** ======================================================= +*/ + +static int checkint (lua_State *L, int topop) { + int n = (int)lua_tonumber(L, -1); + if (n == 0 && !lua_isnumber(L, -1)) n = -1; + lua_pop(L, topop); + return n; +} + + +static void getsizes (lua_State *L) { + lua_rawgeti(L, LUA_REGISTRYINDEX, ARRAYSIZE_REF); + if (lua_isnil(L, -1)) { /* no `size' table? */ + lua_pop(L, 1); /* remove nil */ + lua_newtable(L); /* create it */ + lua_pushvalue(L, -1); /* `size' will be its own metatable */ + lua_setmetatable(L, -2); + lua_pushliteral(L, "__mode"); + lua_pushliteral(L, "k"); + lua_rawset(L, -3); /* metatable(N).__mode = "k" */ + lua_pushvalue(L, -1); + lua_rawseti(L, LUA_REGISTRYINDEX, ARRAYSIZE_REF); /* store in register */ + } +} + + +void luaL_setn (lua_State *L, int t, int n) { + t = abs_index(L, t); + lua_pushliteral(L, "n"); + lua_rawget(L, t); + if (checkint(L, 1) >= 0) { /* is there a numeric field `n'? */ + lua_pushliteral(L, "n"); /* use it */ + lua_pushnumber(L, (lua_Number)n); + lua_rawset(L, t); + } + else { /* use `sizes' */ + getsizes(L); + lua_pushvalue(L, t); + lua_pushnumber(L, (lua_Number)n); + lua_rawset(L, -3); /* sizes[t] = n */ + lua_pop(L, 1); /* remove `sizes' */ + } +} + + +int luaL_getn (lua_State *L, int t) { + int n; + t = abs_index(L, t); + lua_pushliteral(L, "n"); /* try t.n */ + lua_rawget(L, t); + if ((n = checkint(L, 1)) >= 0) return n; + getsizes(L); /* else try sizes[t] */ + lua_pushvalue(L, t); + lua_rawget(L, -2); + if ((n = checkint(L, 2)) >= 0) return n; + for (n = 1; ; n++) { /* else must count elements */ + lua_rawgeti(L, t, n); + if (lua_isnil(L, -1)) break; + lua_pop(L, 1); + } + lua_pop(L, 1); + return n - 1; +} + +/* }====================================================== */ + + + /* ** {====================================================== ** Generic Buffer manipulation @@ -122,7 +328,6 @@ LUALIB_API void luaL_verror (lua_State *L, const char *fmt, ...) { */ -#define buffempty(B) ((B)->p == (B)->buffer) #define bufflen(B) ((B)->p - (B)->buffer) #define bufffree(B) ((size_t)(LUAL_BUFFERSIZE - bufflen(B))) @@ -135,29 +340,27 @@ static int emptybuffer (luaL_Buffer *B) { else { lua_pushlstring(B->L, B->buffer, l); B->p = B->buffer; - B->level++; + B->lvl++; return 1; } } static void adjuststack (luaL_Buffer *B) { - if (B->level > 1) { + if (B->lvl > 1) { lua_State *L = B->L; int toget = 1; /* number of levels to concat */ size_t toplen = lua_strlen(L, -1); do { size_t l = lua_strlen(L, -(toget+1)); - if (B->level - toget + 1 >= LIMIT || toplen > l) { + if (B->lvl - toget + 1 >= LIMIT || toplen > l) { toplen += l; toget++; } else break; - } while (toget < B->level); - if (toget >= 2) { - lua_concat(L, toget); - B->level = B->level - toget + 1; - } + } while (toget < B->lvl); + lua_concat(L, toget); + B->lvl = B->lvl - toget + 1; } } @@ -182,11 +385,8 @@ LUALIB_API void luaL_addstring (luaL_Buffer *B, const char *s) { LUALIB_API void luaL_pushresult (luaL_Buffer *B) { emptybuffer(B); - if (B->level == 0) - lua_pushlstring(B->L, NULL, 0); - else if (B->level > 1) - lua_concat(B->L, B->level); - B->level = 1; + lua_concat(B->L, B->lvl); + B->lvl = 1; } @@ -201,7 +401,7 @@ LUALIB_API void luaL_addvalue (luaL_Buffer *B) { else { if (emptybuffer(B)) lua_insert(L, -2); /* put buffer before new value */ - B->level++; /* add new value into B stack */ + B->lvl++; /* add new value into B stack */ adjuststack(B); } } @@ -210,7 +410,182 @@ LUALIB_API void luaL_addvalue (luaL_Buffer *B) { LUALIB_API void luaL_buffinit (lua_State *L, luaL_Buffer *B) { B->L = L; B->p = B->buffer; - B->level = 0; + B->lvl = 0; +} + +/* }====================================================== */ + + +LUALIB_API int luaL_ref (lua_State *L, int t) { + int ref; + t = abs_index(L, t); + if (lua_isnil(L, -1)) { + lua_pop(L, 1); /* remove from stack */ + return LUA_REFNIL; /* `nil' has a unique fixed reference */ + } + lua_rawgeti(L, t, FREELIST_REF); /* get first free element */ + ref = (int)lua_tonumber(L, -1); /* ref = t[FREELIST_REF] */ + lua_pop(L, 1); /* remove it from stack */ + if (ref != 0) { /* any free element? */ + lua_rawgeti(L, t, ref); /* remove it from list */ + lua_rawseti(L, t, FREELIST_REF); /* (t[FREELIST_REF] = t[ref]) */ + } + else { /* no free elements */ + ref = luaL_getn(L, t); + if (ref < RESERVED_REFS) + ref = RESERVED_REFS; /* skip reserved references */ + ref++; /* create new reference */ + luaL_setn(L, t, ref); + } + lua_rawseti(L, t, ref); + return ref; +} + + +LUALIB_API void luaL_unref (lua_State *L, int t, int ref) { + if (ref >= 0) { + t = abs_index(L, t); + lua_rawgeti(L, t, FREELIST_REF); + lua_rawseti(L, t, ref); /* t[ref] = t[FREELIST_REF] */ + lua_pushnumber(L, (lua_Number)ref); + lua_rawseti(L, t, FREELIST_REF); /* t[FREELIST_REF] = ref */ + } +} + + + +/* +** {====================================================== +** Load functions +** ======================================================= +*/ + +typedef struct LoadF { + FILE *f; + char buff[LUAL_BUFFERSIZE]; +} LoadF; + + +static const char *getF (lua_State *L, void *ud, size_t *size) { + LoadF *lf = (LoadF *)ud; + (void)L; + if (feof(lf->f)) return NULL; + *size = fread(lf->buff, 1, LUAL_BUFFERSIZE, lf->f); + return (*size > 0) ? lf->buff : NULL; +} + + +static int errfile (lua_State *L, int fnameindex) { + const char *filename = lua_tostring(L, fnameindex) + 1; + lua_pushfstring(L, "cannot read %s: %s", filename, strerror(errno)); + lua_remove(L, fnameindex); + return LUA_ERRFILE; +} + + +LUALIB_API int luaL_loadfile (lua_State *L, const char *filename) { + LoadF lf; + int status, readstatus; + int c; + int fnameindex = lua_gettop(L) + 1; /* index of filename on the stack */ + if (filename == NULL) { + lua_pushliteral(L, "=stdin"); + lf.f = stdin; + } + else { + lua_pushfstring(L, "@%s", filename); + lf.f = fopen(filename, "r"); + } + if (lf.f == NULL) return errfile(L, fnameindex); /* unable to open file */ + c = ungetc(getc(lf.f), lf.f); + if (!(isspace(c) || isprint(c)) && lf.f != stdin) { /* binary file? */ + fclose(lf.f); + lf.f = fopen(filename, "rb"); /* reopen in binary mode */ + if (lf.f == NULL) return errfile(L, fnameindex); /* unable to reopen file */ + } + status = lua_load(L, getF, &lf, lua_tostring(L, -1)); + readstatus = ferror(lf.f); + if (lf.f != stdin) fclose(lf.f); /* close file (even in case of errors) */ + if (readstatus) { + lua_settop(L, fnameindex); /* ignore results from `lua_load' */ + return errfile(L, fnameindex); + } + lua_remove(L, fnameindex); + return status; +} + + +typedef struct LoadS { + const char *s; + size_t size; +} LoadS; + + +static const char *getS (lua_State *L, void *ud, size_t *size) { + LoadS *ls = (LoadS *)ud; + (void)L; + if (ls->size == 0) return NULL; + *size = ls->size; + ls->size = 0; + return ls->s; +} + + +LUALIB_API int luaL_loadbuffer (lua_State *L, const char *buff, size_t size, + const char *name) { + LoadS ls; + ls.s = buff; + ls.size = size; + return lua_load(L, getS, &ls, name); +} + +/* }====================================================== */ + + +/* +** {====================================================== +** compatibility code +** ======================================================= +*/ + + +static void callalert (lua_State *L, int status) { + if (status != 0) { + lua_getglobal(L, "_ALERT"); + if (lua_isfunction(L, -1)) { + lua_insert(L, -2); + lua_call(L, 1, 0); + } + else { /* no _ALERT function; print it on stderr */ + fprintf(stderr, "%s\n", lua_tostring(L, -2)); + lua_pop(L, 2); /* remove error message and _ALERT */ + } + } +} + + +static int aux_do (lua_State *L, int status) { + if (status == 0) { /* parse OK? */ + status = lua_pcall(L, 0, LUA_MULTRET, 0); /* call main */ + } + callalert(L, status); + return status; +} + + +LUALIB_API int lua_dofile (lua_State *L, const char *filename) { + return aux_do(L, luaL_loadfile(L, filename)); +} + + +LUALIB_API int lua_dobuffer (lua_State *L, const char *buff, size_t size, + const char *name) { + return aux_do(L, luaL_loadbuffer(L, buff, size, name)); +} + + +LUALIB_API int lua_dostring (lua_State *L, const char *str) { + return lua_dobuffer(L, str, strlen(str), str); } /* }====================================================== */ diff --git a/src/lib/lbaselib.c b/src/lib/lbaselib.c index 29bad6a8..7381cf33 100644 --- a/src/lib/lbaselib.c +++ b/src/lib/lbaselib.c @@ -1,5 +1,5 @@ /* -** $Id: lbaselib.c,v 1.17a 2000/11/06 13:45:18 roberto Exp $ +** $Id: lbaselib.c,v 1.130 2003/04/03 13:35:34 roberto Exp $ ** Basic library ** See Copyright Notice in lua.h */ @@ -11,51 +11,15 @@ #include <stdlib.h> #include <string.h> +#define lbaselib_c + #include "lua.h" #include "lauxlib.h" -#include "luadebug.h" #include "lualib.h" -/* -** If your system does not support `stderr', redefine this function, or -** redefine _ERRORMESSAGE so that it won't need _ALERT. -*/ -static int luaB__ALERT (lua_State *L) { - fputs(luaL_check_string(L, 1), stderr); - return 0; -} - - -/* -** Basic implementation of _ERRORMESSAGE. -** The library `liolib' redefines _ERRORMESSAGE for better error information. -*/ -static int luaB__ERRORMESSAGE (lua_State *L) { - luaL_checktype(L, 1, LUA_TSTRING); - lua_getglobal(L, LUA_ALERT); - if (lua_isfunction(L, -1)) { /* avoid error loop if _ALERT is not defined */ - lua_Debug ar; - lua_pushstring(L, "error: "); - lua_pushvalue(L, 1); - if (lua_getstack(L, 1, &ar)) { - lua_getinfo(L, "Sl", &ar); - if (ar.source && ar.currentline > 0) { - char buff[100]; - sprintf(buff, "\n <%.70s: line %d>", ar.short_src, ar.currentline); - lua_pushstring(L, buff); - lua_concat(L, 2); - } - } - lua_pushstring(L, "\n"); - lua_concat(L, 3); - lua_rawcall(L, 1, 0); - } - return 0; -} - /* ** If your system does not support `stdout', you can just remove this function. @@ -71,10 +35,10 @@ static int luaB_print (lua_State *L) { const char *s; lua_pushvalue(L, -1); /* function to be called */ lua_pushvalue(L, i); /* value to print */ - lua_rawcall(L, 1, 1); + lua_call(L, 1, 1); s = lua_tostring(L, -1); /* get result */ if (s == NULL) - lua_error(L, "`tostring' must return a string to `print'"); + return luaL_error(L, "`tostring' must return a string to `print'"); if (i>1) fputs("\t", stdout); fputs(s, stdout); lua_pop(L, 1); /* pop result */ @@ -85,7 +49,7 @@ static int luaB_print (lua_State *L) { static int luaB_tonumber (lua_State *L) { - int base = luaL_opt_int(L, 2, 10); + int base = luaL_optint(L, 2, 10); if (base == 10) { /* standard conversion */ luaL_checkany(L, 1); if (lua_isnumber(L, 1)) { @@ -94,15 +58,15 @@ static int luaB_tonumber (lua_State *L) { } } else { - const char *s1 = luaL_check_string(L, 1); + const char *s1 = luaL_checkstring(L, 1); char *s2; unsigned long n; - luaL_arg_check(L, 2 <= base && base <= 36, 2, "base out of range"); + luaL_argcheck(L, 2 <= base && base <= 36, 2, "base out of range"); n = strtoul(s1, &s2, base); if (s1 != s2) { /* at least one valid digit? */ - while (isspace((unsigned char)*s2)) s2++; /* skip trailing spaces */ + while (isspace((unsigned char)(*s2))) s2++; /* skip trailing spaces */ if (*s2 == '\0') { /* no invalid trailing characters? */ - lua_pushnumber(L, n); + lua_pushnumber(L, (lua_Number)n); return 1; } } @@ -113,55 +77,99 @@ static int luaB_tonumber (lua_State *L) { static int luaB_error (lua_State *L) { - lua_error(L, luaL_opt_string(L, 1, NULL)); - return 0; /* to avoid warnings */ + int level = luaL_optint(L, 2, 1); + luaL_checkany(L, 1); + if (!lua_isstring(L, 1) || level == 0) + lua_pushvalue(L, 1); /* propagate error message without changes */ + else { /* add extra information */ + luaL_where(L, level); + lua_pushvalue(L, 1); + lua_concat(L, 2); + } + return lua_error(L); } -static int luaB_setglobal (lua_State *L) { - luaL_checkany(L, 2); - lua_setglobal(L, luaL_check_string(L, 1)); - return 0; + +static int luaB_getmetatable (lua_State *L) { + luaL_checkany(L, 1); + if (!lua_getmetatable(L, 1)) { + lua_pushnil(L); + return 1; /* no metatable */ + } + luaL_getmetafield(L, 1, "__metatable"); + return 1; /* returns either __metatable field (if present) or metatable */ } -static int luaB_getglobal (lua_State *L) { - lua_getglobal(L, luaL_check_string(L, 1)); + +static int luaB_setmetatable (lua_State *L) { + int t = lua_type(L, 2); + luaL_checktype(L, 1, LUA_TTABLE); + luaL_argcheck(L, t == LUA_TNIL || t == LUA_TTABLE, 2, + "nil or table expected"); + if (luaL_getmetafield(L, 1, "__metatable")) + luaL_error(L, "cannot change a protected metatable"); + lua_settop(L, 2); + lua_setmetatable(L, 1); return 1; } -static int luaB_tag (lua_State *L) { - luaL_checkany(L, 1); - lua_pushnumber(L, lua_tag(L, 1)); - return 1; + +static void getfunc (lua_State *L) { + if (lua_isfunction(L, 1)) lua_pushvalue(L, 1); + else { + lua_Debug ar; + int level = luaL_optint(L, 1, 1); + luaL_argcheck(L, level >= 0, 1, "level must be non-negative"); + if (lua_getstack(L, level, &ar) == 0) + luaL_argerror(L, 1, "invalid level"); + lua_getinfo(L, "f", &ar); + if (lua_isnil(L, -1)) + luaL_error(L, "no function environment for tail call at level %d", + level); + } } -static int luaB_settag (lua_State *L) { - luaL_checktype(L, 1, LUA_TTABLE); - lua_pushvalue(L, 1); /* push table */ - lua_settag(L, luaL_check_int(L, 2)); - return 1; /* return table */ + +static int aux_getfenv (lua_State *L) { + lua_getfenv(L, -1); + lua_pushliteral(L, "__fenv"); + lua_rawget(L, -2); + return !lua_isnil(L, -1); } -static int luaB_newtag (lua_State *L) { - lua_pushnumber(L, lua_newtag(L)); + +static int luaB_getfenv (lua_State *L) { + getfunc(L); + if (!aux_getfenv(L)) /* __fenv not defined? */ + lua_pop(L, 1); /* remove it, to return real environment */ return 1; } -static int luaB_copytagmethods (lua_State *L) { - lua_pushnumber(L, lua_copytagmethods(L, luaL_check_int(L, 1), - luaL_check_int(L, 2))); - return 1; + +static int luaB_setfenv (lua_State *L) { + luaL_checktype(L, 2, LUA_TTABLE); + getfunc(L); + if (aux_getfenv(L)) /* __fenv defined? */ + luaL_error(L, "`setfenv' cannot change a protected environment"); + else + lua_pop(L, 2); /* remove __fenv and real environment table */ + lua_pushvalue(L, 2); + if (lua_isnumber(L, 1) && lua_tonumber(L, 1) == 0) + lua_replace(L, LUA_GLOBALSINDEX); + else if (lua_setfenv(L, -2) == 0) + luaL_error(L, "`setfenv' cannot change environment of given function"); + return 0; } -static int luaB_globals (lua_State *L) { - lua_getglobals(L); /* value to be returned */ - if (!lua_isnull(L, 1)) { - luaL_checktype(L, 1, LUA_TTABLE); - lua_pushvalue(L, 1); /* new table of globals */ - lua_setglobals(L); - } + +static int luaB_rawequal (lua_State *L) { + luaL_checkany(L, 1); + luaL_checkany(L, 2); + lua_pushboolean(L, lua_rawequal(L, 1, 2)); return 1; } + static int luaB_rawget (lua_State *L) { luaL_checktype(L, 1, LUA_TTABLE); luaL_checkany(L, 2); @@ -177,39 +185,16 @@ static int luaB_rawset (lua_State *L) { return 1; } -static int luaB_settagmethod (lua_State *L) { - int tag = luaL_check_int(L, 1); - const char *event = luaL_check_string(L, 2); - luaL_arg_check(L, lua_isfunction(L, 3) || lua_isnil(L, 3), 3, - "function or nil expected"); - if (strcmp(event, "gc") == 0) - lua_error(L, "deprecated use: cannot set the `gc' tag method from Lua"); - lua_gettagmethod(L, tag, event); - lua_pushvalue(L, 3); - lua_settagmethod(L, tag, event); - return 1; -} - - -static int luaB_gettagmethod (lua_State *L) { - int tag = luaL_check_int(L, 1); - const char *event = luaL_check_string(L, 2); - if (strcmp(event, "gc") == 0) - lua_error(L, "deprecated use: cannot get the `gc' tag method from Lua"); - lua_gettagmethod(L, tag, event); - return 1; -} - static int luaB_gcinfo (lua_State *L) { - lua_pushnumber(L, lua_getgccount(L)); - lua_pushnumber(L, lua_getgcthreshold(L)); + lua_pushnumber(L, (lua_Number)lua_getgccount(L)); + lua_pushnumber(L, (lua_Number)lua_getgcthreshold(L)); return 2; } static int luaB_collectgarbage (lua_State *L) { - lua_setgcthreshold(L, luaL_opt_int(L, 1, 0)); + lua_setgcthreshold(L, luaL_optint(L, 1, 0)); return 0; } @@ -233,83 +218,116 @@ static int luaB_next (lua_State *L) { } -static int passresults (lua_State *L, int status, int oldtop) { - static const char *const errornames[] = - {"ok", "run-time error", "file error", "syntax error", - "memory error", "error in error handling"}; - if (status == 0) { - int nresults = lua_gettop(L) - oldtop; - if (nresults > 0) - return nresults; /* results are already on the stack */ - else { - lua_pushuserdata(L, NULL); /* at least one result to signal no errors */ - return 1; - } +static int luaB_pairs (lua_State *L) { + luaL_checktype(L, 1, LUA_TTABLE); + lua_pushliteral(L, "next"); + lua_rawget(L, LUA_GLOBALSINDEX); /* return generator, */ + lua_pushvalue(L, 1); /* state, */ + lua_pushnil(L); /* and initial value */ + return 3; +} + + +static int luaB_ipairs (lua_State *L) { + lua_Number i = lua_tonumber(L, 2); + luaL_checktype(L, 1, LUA_TTABLE); + if (i == 0 && lua_isnone(L, 2)) { /* `for' start? */ + lua_pushliteral(L, "ipairs"); + lua_rawget(L, LUA_GLOBALSINDEX); /* return generator, */ + lua_pushvalue(L, 1); /* state, */ + lua_pushnumber(L, 0); /* and initial value */ + return 3; + } + else { /* `for' step */ + i++; /* next value */ + lua_pushnumber(L, i); + lua_rawgeti(L, 1, (int)i); + return (lua_isnil(L, -1)) ? 0 : 2; } - else { /* error */ +} + + +static int load_aux (lua_State *L, int status) { + if (status == 0) /* OK? */ + return 1; + else { lua_pushnil(L); - lua_pushstring(L, errornames[status]); /* error code */ - return 2; + lua_insert(L, -2); /* put before error message */ + return 2; /* return nil plus error message */ } } -static int luaB_dostring (lua_State *L) { - int oldtop = lua_gettop(L); + +static int luaB_loadstring (lua_State *L) { size_t l; - const char *s = luaL_check_lstr(L, 1, &l); - if (*s == '\33') /* binary files start with ESC... */ - lua_error(L, "`dostring' cannot run pre-compiled code"); - return passresults(L, lua_dobuffer(L, s, l, luaL_opt_string(L, 2, s)), oldtop); + const char *s = luaL_checklstring(L, 1, &l); + const char *chunkname = luaL_optstring(L, 2, s); + return load_aux(L, luaL_loadbuffer(L, s, l, chunkname)); +} + + +static int luaB_loadfile (lua_State *L) { + const char *fname = luaL_optstring(L, 1, NULL); + return load_aux(L, luaL_loadfile(L, fname)); } static int luaB_dofile (lua_State *L) { - int oldtop = lua_gettop(L); - const char *fname = luaL_opt_string(L, 1, NULL); - return passresults(L, lua_dofile(L, fname), oldtop); + const char *fname = luaL_optstring(L, 1, NULL); + int status = luaL_loadfile(L, fname); + if (status != 0) lua_error(L); + lua_call(L, 0, LUA_MULTRET); + return lua_gettop(L) - 1; } -static int luaB_call (lua_State *L) { - int oldtop; - const char *options = luaL_opt_string(L, 3, ""); - int err = 0; /* index of old error method */ - int i, status; - int n; - luaL_checktype(L, 2, LUA_TTABLE); - n = lua_getn(L, 2); - if (!lua_isnull(L, 4)) { /* set new error method */ - lua_getglobal(L, LUA_ERRORMESSAGE); - err = lua_gettop(L); /* get index */ - lua_pushvalue(L, 4); - lua_setglobal(L, LUA_ERRORMESSAGE); - } - oldtop = lua_gettop(L); /* top before function-call preparation */ - /* push function */ - lua_pushvalue(L, 1); - luaL_checkstack(L, n, "too many arguments"); - for (i=0; i<n; i++) /* push arg[1...n] */ - lua_rawgeti(L, 2, i+1); - status = lua_call(L, n, LUA_MULTRET); - if (err != 0) { /* restore old error method */ - lua_pushvalue(L, err); - lua_setglobal(L, LUA_ERRORMESSAGE); - } - if (status != 0) { /* error in call? */ - if (strchr(options, 'x')) - lua_pushnil(L); /* return nil to signal the error */ - else - lua_error(L, NULL); /* propagate error without additional messages */ - return 1; - } - if (strchr(options, 'p')) /* pack results? */ - lua_error(L, "deprecated option `p' in `call'"); - return lua_gettop(L) - oldtop; /* results are already on the stack */ +static int luaB_assert (lua_State *L) { + luaL_checkany(L, 1); + if (!lua_toboolean(L, 1)) + return luaL_error(L, "%s", luaL_optstring(L, 2, "assertion failed!")); + lua_settop(L, 1); + return 1; +} + + +static int luaB_unpack (lua_State *L) { + int n, i; + luaL_checktype(L, 1, LUA_TTABLE); + n = luaL_getn(L, 1); + luaL_checkstack(L, n, "table too big to unpack"); + for (i=1; i<=n; i++) /* push arg[1...n] */ + lua_rawgeti(L, 1, i); + return n; +} + + +static int luaB_pcall (lua_State *L) { + int status; + luaL_checkany(L, 1); + status = lua_pcall(L, lua_gettop(L) - 1, LUA_MULTRET, 0); + lua_pushboolean(L, (status == 0)); + lua_insert(L, 1); + return lua_gettop(L); /* return status + all results */ +} + + +static int luaB_xpcall (lua_State *L) { + int status; + luaL_checkany(L, 2); + lua_settop(L, 2); + lua_insert(L, 1); /* put error function under function to be called */ + status = lua_pcall(L, 0, LUA_MULTRET, 1); + lua_pushboolean(L, (status == 0)); + lua_replace(L, 1); + return lua_gettop(L); /* return status + all results */ } static int luaB_tostring (lua_State *L) { char buff[64]; + luaL_checkany(L, 1); + if (luaL_callmeta(L, 1, "__tostring")) /* is there a metafield? */ + return 1; /* use its value */ switch (lua_type(L, 1)) { case LUA_TNUMBER: lua_pushstring(L, lua_tostring(L, 1)); @@ -317,6 +335,9 @@ static int luaB_tostring (lua_State *L) { case LUA_TSTRING: lua_pushvalue(L, 1); return 1; + case LUA_TBOOLEAN: + lua_pushstring(L, (lua_toboolean(L, 1) ? "true" : "false")); + return 1; case LUA_TTABLE: sprintf(buff, "table: %p", lua_topointer(L, 1)); break; @@ -324,328 +345,330 @@ static int luaB_tostring (lua_State *L) { sprintf(buff, "function: %p", lua_topointer(L, 1)); break; case LUA_TUSERDATA: - sprintf(buff, "userdata(%d): %p", lua_tag(L, 1), lua_touserdata(L, 1)); + case LUA_TLIGHTUSERDATA: + sprintf(buff, "userdata: %p", lua_touserdata(L, 1)); + break; + case LUA_TTHREAD: + sprintf(buff, "thread: %p", (void *)lua_tothread(L, 1)); break; case LUA_TNIL: - lua_pushstring(L, "nil"); + lua_pushliteral(L, "nil"); return 1; - default: - luaL_argerror(L, 1, "value expected"); } lua_pushstring(L, buff); return 1; } -static int luaB_foreachi (lua_State *L) { - int n, i; - luaL_checktype(L, 1, LUA_TTABLE); - luaL_checktype(L, 2, LUA_TFUNCTION); - n = lua_getn(L, 1); - for (i=1; i<=n; i++) { - lua_pushvalue(L, 2); /* function */ - lua_pushnumber(L, i); /* 1st argument */ - lua_rawgeti(L, 1, i); /* 2nd argument */ - lua_rawcall(L, 2, 1); - if (!lua_isnil(L, -1)) - return 1; - lua_pop(L, 1); /* remove nil result */ +static int luaB_newproxy (lua_State *L) { + lua_settop(L, 1); + lua_newuserdata(L, 0); /* create proxy */ + if (lua_toboolean(L, 1) == 0) + return 1; /* no metatable */ + else if (lua_isboolean(L, 1)) { + lua_newtable(L); /* create a new metatable `m' ... */ + lua_pushvalue(L, -1); /* ... and mark `m' as a valid metatable */ + lua_pushboolean(L, 1); + lua_rawset(L, lua_upvalueindex(1)); /* weaktable[m] = true */ } - return 0; -} - - -static int luaB_foreach (lua_State *L) { - luaL_checktype(L, 1, LUA_TTABLE); - luaL_checktype(L, 2, LUA_TFUNCTION); - lua_pushnil(L); /* first index */ - for (;;) { - if (lua_next(L, 1) == 0) - return 0; - lua_pushvalue(L, 2); /* function */ - lua_pushvalue(L, -3); /* key */ - lua_pushvalue(L, -3); /* value */ - lua_rawcall(L, 2, 1); - if (!lua_isnil(L, -1)) - return 1; - lua_pop(L, 2); /* remove value and result */ + else { + int validproxy = 0; /* to check if weaktable[metatable(u)] == true */ + if (lua_getmetatable(L, 1)) { + lua_rawget(L, lua_upvalueindex(1)); + validproxy = lua_toboolean(L, -1); + lua_pop(L, 1); /* remove value */ + } + luaL_argcheck(L, validproxy, 1, "boolean or proxy expected"); + lua_getmetatable(L, 1); /* metatable is valid; get it */ } -} - - -static int luaB_assert (lua_State *L) { - luaL_checkany(L, 1); - if (lua_isnil(L, 1)) - luaL_verror(L, "assertion failed! %.90s", luaL_opt_string(L, 2, "")); - return 0; -} - - -static int luaB_getn (lua_State *L) { - luaL_checktype(L, 1, LUA_TTABLE); - lua_pushnumber(L, lua_getn(L, 1)); + lua_setmetatable(L, 2); return 1; } -static int luaB_tinsert (lua_State *L) { - int v = lua_gettop(L); /* last argument: to be inserted */ - int n, pos; - luaL_checktype(L, 1, LUA_TTABLE); - n = lua_getn(L, 1); - if (v == 2) /* called with only 2 arguments */ - pos = n+1; - else - pos = luaL_check_int(L, 2); /* 2nd argument is the position */ - lua_pushstring(L, "n"); - lua_pushnumber(L, n+1); - lua_rawset(L, 1); /* t.n = n+1 */ - for (; n>=pos; n--) { - lua_rawgeti(L, 1, n); - lua_rawseti(L, 1, n+1); /* t[n+1] = t[n] */ - } - lua_pushvalue(L, v); - lua_rawseti(L, 1, pos); /* t[pos] = v */ - return 0; -} - +/* +** {====================================================== +** `require' function +** ======================================================= +*/ -static int luaB_tremove (lua_State *L) { - int pos, n; - luaL_checktype(L, 1, LUA_TTABLE); - n = lua_getn(L, 1); - pos = luaL_opt_int(L, 2, n); - if (n <= 0) return 0; /* table is "empty" */ - lua_rawgeti(L, 1, pos); /* result = t[pos] */ - for ( ;pos<n; pos++) { - lua_rawgeti(L, 1, pos+1); - lua_rawseti(L, 1, pos); /* a[pos] = a[pos+1] */ - } - lua_pushstring(L, "n"); - lua_pushnumber(L, n-1); - lua_rawset(L, 1); /* t.n = n-1 */ - lua_pushnil(L); - lua_rawseti(L, 1, n); /* t[n] = nil */ - return 1; -} +/* name of global that holds table with loaded packages */ +#define REQTAB "_LOADED" +/* name of global that holds the search path for packages */ +#define LUA_PATH "LUA_PATH" +#ifndef LUA_PATH_SEP +#define LUA_PATH_SEP ';' +#endif -/* -** {====================================================== -** Quicksort -** (based on `Algorithms in MODULA-3', Robert Sedgewick; -** Addison-Wesley, 1993.) -*/ +#ifndef LUA_PATH_MARK +#define LUA_PATH_MARK '?' +#endif +#ifndef LUA_PATH_DEFAULT +#define LUA_PATH_DEFAULT "?;?.lua" +#endif -static void set2 (lua_State *L, int i, int j) { - lua_rawseti(L, 1, i); - lua_rawseti(L, 1, j); -} -static int sort_comp (lua_State *L, int a, int b) { - /* WARNING: the caller (auxsort) must ensure stack space */ - if (!lua_isnil(L, 2)) { /* function? */ - int res; - lua_pushvalue(L, 2); - lua_pushvalue(L, a-1); /* -1 to compensate function */ - lua_pushvalue(L, b-2); /* -2 to compensate function and `a' */ - lua_rawcall(L, 2, 1); - res = !lua_isnil(L, -1); - lua_pop(L, 1); - return res; +static const char *getpath (lua_State *L) { + const char *path; + lua_getglobal(L, LUA_PATH); /* try global variable */ + path = lua_tostring(L, -1); + lua_pop(L, 1); + if (path) return path; + path = getenv(LUA_PATH); /* else try environment variable */ + if (path) return path; + return LUA_PATH_DEFAULT; /* else use default */ +} + + +static const char *pushnextpath (lua_State *L, const char *path) { + const char *l; + if (*path == '\0') return NULL; /* no more paths */ + if (*path == LUA_PATH_SEP) path++; /* skip separator */ + l = strchr(path, LUA_PATH_SEP); /* find next separator */ + if (l == NULL) l = path+strlen(path); + lua_pushlstring(L, path, l - path); /* directory name */ + return l; +} + + +static void pushcomposename (lua_State *L) { + const char *path = lua_tostring(L, -1); + const char *wild; + int n = 1; + while ((wild = strchr(path, LUA_PATH_MARK)) != NULL) { + /* is there stack space for prefix, name, and eventual last sufix? */ + luaL_checkstack(L, 3, "too many marks in a path component"); + lua_pushlstring(L, path, wild - path); /* push prefix */ + lua_pushvalue(L, 1); /* push package name (in place of MARK) */ + path = wild + 1; /* continue after MARK */ + n += 2; } - else /* a < b? */ - return lua_lessthan(L, a, b); -} - -static void auxsort (lua_State *L, int l, int u) { - while (l < u) { /* for tail recursion */ - int i, j; - /* sort elements a[l], a[(l+u)/2] and a[u] */ - lua_rawgeti(L, 1, l); - lua_rawgeti(L, 1, u); - if (sort_comp(L, -1, -2)) /* a[u] < a[l]? */ - set2(L, l, u); /* swap a[l] - a[u] */ - else - lua_pop(L, 2); - if (u-l == 1) break; /* only 2 elements */ - i = (l+u)/2; - lua_rawgeti(L, 1, i); - lua_rawgeti(L, 1, l); - if (sort_comp(L, -2, -1)) /* a[i]<a[l]? */ - set2(L, i, l); - else { - lua_pop(L, 1); /* remove a[l] */ - lua_rawgeti(L, 1, u); - if (sort_comp(L, -1, -2)) /* a[u]<a[i]? */ - set2(L, i, u); - else - lua_pop(L, 2); + lua_pushstring(L, path); /* push last sufix (`n' already includes this) */ + lua_concat(L, n); +} + + +static int luaB_require (lua_State *L) { + const char *path; + int status = LUA_ERRFILE; /* not found (yet) */ + luaL_checkstring(L, 1); + lua_settop(L, 1); + lua_getglobal(L, REQTAB); + if (!lua_istable(L, 2)) return luaL_error(L, "`" REQTAB "' is not a table"); + path = getpath(L); + lua_pushvalue(L, 1); /* check package's name in book-keeping table */ + lua_rawget(L, 2); + if (lua_toboolean(L, -1)) /* is it there? */ + return 1; /* package is already loaded; return its result */ + else { /* must load it */ + while (status == LUA_ERRFILE) { + lua_settop(L, 3); /* reset stack position */ + if ((path = pushnextpath(L, path)) == NULL) break; + pushcomposename(L); + status = luaL_loadfile(L, lua_tostring(L, -1)); /* try to load it */ } - if (u-l == 2) break; /* only 3 elements */ - lua_rawgeti(L, 1, i); /* Pivot */ - lua_pushvalue(L, -1); - lua_rawgeti(L, 1, u-1); - set2(L, i, u-1); - /* a[l] <= P == a[u-1] <= a[u], only need to sort from l+1 to u-2 */ - i = l; j = u-1; - for (;;) { /* invariant: a[l..i] <= P <= a[j..u] */ - /* repeat ++i until a[i] >= P */ - while (lua_rawgeti(L, 1, ++i), sort_comp(L, -1, -2)) { - if (i>u) lua_error(L, "invalid order function for sorting"); - lua_pop(L, 1); /* remove a[i] */ - } - /* repeat --j until a[j] <= P */ - while (lua_rawgeti(L, 1, --j), sort_comp(L, -3, -1)) { - if (j<l) lua_error(L, "invalid order function for sorting"); - lua_pop(L, 1); /* remove a[j] */ - } - if (j<i) { - lua_pop(L, 3); /* pop pivot, a[i], a[j] */ - break; + } + switch (status) { + case 0: { + lua_getglobal(L, "_REQUIREDNAME"); /* save previous name */ + lua_insert(L, -2); /* put it below function */ + lua_pushvalue(L, 1); + lua_setglobal(L, "_REQUIREDNAME"); /* set new name */ + lua_call(L, 0, 1); /* run loaded module */ + lua_insert(L, -2); /* put result below previous name */ + lua_setglobal(L, "_REQUIREDNAME"); /* reset to previous name */ + if (lua_isnil(L, -1)) { /* no/nil return? */ + lua_pushboolean(L, 1); + lua_replace(L, -2); /* replace to true */ } - set2(L, i, j); + lua_pushvalue(L, 1); + lua_pushvalue(L, -2); + lua_rawset(L, 2); /* mark it as loaded */ + return 1; /* return value */ } - lua_rawgeti(L, 1, u-1); - lua_rawgeti(L, 1, i); - set2(L, u-1, i); /* swap pivot (a[u-1]) with a[i] */ - /* a[l..i-1] <= a[i] == P <= a[i+1..u] */ - /* adjust so that smaller "half" is in [j..i] and larger one in [l..u] */ - if (i-l < u-i) { - j=l; i=i-1; l=i+2; + case LUA_ERRFILE: { /* file not found */ + return luaL_error(L, "could not load package `%s' from path `%s'", + lua_tostring(L, 1), getpath(L)); } - else { - j=i+1; i=u; u=j-2; + default: { + return luaL_error(L, "error loading package `%s' (%s)", + lua_tostring(L, 1), lua_tostring(L, -1)); } - auxsort(L, j, i); /* call recursively the smaller one */ - } /* repeat the routine for the larger one */ -} - -static int luaB_sort (lua_State *L) { - int n; - luaL_checktype(L, 1, LUA_TTABLE); - n = lua_getn(L, 1); - if (!lua_isnull(L, 2)) /* is there a 2nd argument? */ - luaL_checktype(L, 2, LUA_TFUNCTION); - lua_settop(L, 2); /* make sure there is two arguments */ - auxsort(L, 1, n); - return 0; + } } /* }====================================================== */ +static const luaL_reg base_funcs[] = { + {"error", luaB_error}, + {"getmetatable", luaB_getmetatable}, + {"setmetatable", luaB_setmetatable}, + {"getfenv", luaB_getfenv}, + {"setfenv", luaB_setfenv}, + {"next", luaB_next}, + {"ipairs", luaB_ipairs}, + {"pairs", luaB_pairs}, + {"print", luaB_print}, + {"tonumber", luaB_tonumber}, + {"tostring", luaB_tostring}, + {"type", luaB_type}, + {"assert", luaB_assert}, + {"unpack", luaB_unpack}, + {"rawequal", luaB_rawequal}, + {"rawget", luaB_rawget}, + {"rawset", luaB_rawset}, + {"pcall", luaB_pcall}, + {"xpcall", luaB_xpcall}, + {"collectgarbage", luaB_collectgarbage}, + {"gcinfo", luaB_gcinfo}, + {"loadfile", luaB_loadfile}, + {"dofile", luaB_dofile}, + {"loadstring", luaB_loadstring}, + {"require", luaB_require}, + {NULL, NULL} +}; + /* ** {====================================================== -** Deprecated functions to manipulate global environment. +** Coroutine library ** ======================================================= */ +static int auxresume (lua_State *L, lua_State *co, int narg) { + int status; + if (!lua_checkstack(co, narg)) + luaL_error(L, "too many arguments to resume"); + lua_xmove(L, co, narg); + status = lua_resume(co, narg); + if (status == 0) { + int nres = lua_gettop(co); + if (!lua_checkstack(L, nres)) + luaL_error(L, "too many results to resume"); + lua_xmove(co, L, nres); /* move yielded values */ + return nres; + } + else { + lua_xmove(co, L, 1); /* move error message */ + return -1; /* error flag */ + } +} -#define num_deprecated 4 - -static const struct luaL_reg deprecated_names [num_deprecated] = { - {"foreachvar", luaB_foreach}, - {"nextvar", luaB_next}, - {"rawgetglobal", luaB_rawget}, - {"rawsetglobal", luaB_rawset} -}; +static int luaB_coresume (lua_State *L) { + lua_State *co = lua_tothread(L, 1); + int r; + luaL_argcheck(L, co, 1, "coroutine expected"); + r = auxresume(L, co, lua_gettop(L) - 1); + if (r < 0) { + lua_pushboolean(L, 0); + lua_insert(L, -2); + return 2; /* return false + error message */ + } + else { + lua_pushboolean(L, 1); + lua_insert(L, -(r + 1)); + return r + 1; /* return true + `resume' returns */ + } +} -#ifdef LUA_DEPRECATEDFUNCS -/* -** call corresponding function inserting `globals' as first argument -*/ -static int deprecated_func (lua_State *L) { - lua_insert(L, 1); /* upvalue is the function to be called */ - lua_getglobals(L); - lua_insert(L, 2); /* table of globals is 1o argument */ - lua_rawcall(L, lua_gettop(L)-1, LUA_MULTRET); - return lua_gettop(L); /* return all results */ +static int luaB_auxwrap (lua_State *L) { + lua_State *co = lua_tothread(L, lua_upvalueindex(1)); + int r = auxresume(L, co, lua_gettop(L)); + if (r < 0) { + if (lua_isstring(L, -1)) { /* error object is a string? */ + luaL_where(L, 1); /* add extra info */ + lua_insert(L, -2); + lua_concat(L, 2); + } + lua_error(L); /* propagate error */ + } + return r; } -static void deprecated_funcs (lua_State *L) { - int i; - for (i=0; i<num_deprecated; i++) { - lua_pushcfunction(L, deprecated_names[i].func); - lua_pushcclosure(L, deprecated_func, 1); - lua_setglobal(L, deprecated_names[i].name); - } +static int luaB_cocreate (lua_State *L) { + lua_State *NL = lua_newthread(L); + luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1), 1, + "Lua function expected"); + lua_pushvalue(L, 1); /* move function to top */ + lua_xmove(L, NL, 1); /* move function from L to NL */ + return 1; } -#else +static int luaB_cowrap (lua_State *L) { + luaB_cocreate(L); + lua_pushcclosure(L, luaB_auxwrap, 1); + return 1; +} -/* -** gives an explicit error in any attempt to call a deprecated function -*/ -static int deprecated_func (lua_State *L) { - luaL_verror(L, "function `%.20s' is deprecated", lua_tostring(L, -1)); - return 0; /* to avoid warnings */ + +static int luaB_yield (lua_State *L) { + return lua_yield(L, lua_gettop(L)); } -static void deprecated_funcs (lua_State *L) { - int i; - for (i=0; i<num_deprecated; i++) { - lua_pushstring(L, deprecated_names[i].name); - lua_pushcclosure(L, deprecated_func, 1); - lua_setglobal(L, deprecated_names[i].name); +static int luaB_costatus (lua_State *L) { + lua_State *co = lua_tothread(L, 1); + luaL_argcheck(L, co, 1, "coroutine expected"); + if (L == co) lua_pushliteral(L, "running"); + else { + lua_Debug ar; + if (lua_getstack(co, 0, &ar) == 0 && lua_gettop(co) == 0) + lua_pushliteral(L, "dead"); + else + lua_pushliteral(L, "suspended"); } + return 1; } -#endif - -/* }====================================================== */ -static const struct luaL_reg base_funcs[] = { - {LUA_ALERT, luaB__ALERT}, - {LUA_ERRORMESSAGE, luaB__ERRORMESSAGE}, - {"call", luaB_call}, - {"collectgarbage", luaB_collectgarbage}, - {"copytagmethods", luaB_copytagmethods}, - {"dofile", luaB_dofile}, - {"dostring", luaB_dostring}, - {"error", luaB_error}, - {"foreach", luaB_foreach}, - {"foreachi", luaB_foreachi}, - {"gcinfo", luaB_gcinfo}, - {"getglobal", luaB_getglobal}, - {"gettagmethod", luaB_gettagmethod}, - {"globals", luaB_globals}, - {"newtag", luaB_newtag}, - {"next", luaB_next}, - {"print", luaB_print}, - {"rawget", luaB_rawget}, - {"rawset", luaB_rawset}, - {"rawgettable", luaB_rawget}, /* for compatibility */ - {"rawsettable", luaB_rawset}, /* for compatibility */ - {"setglobal", luaB_setglobal}, - {"settag", luaB_settag}, - {"settagmethod", luaB_settagmethod}, - {"tag", luaB_tag}, - {"tonumber", luaB_tonumber}, - {"tostring", luaB_tostring}, - {"type", luaB_type}, - {"assert", luaB_assert}, - {"getn", luaB_getn}, - {"sort", luaB_sort}, - {"tinsert", luaB_tinsert}, - {"tremove", luaB_tremove} +static const luaL_reg co_funcs[] = { + {"create", luaB_cocreate}, + {"wrap", luaB_cowrap}, + {"resume", luaB_coresume}, + {"yield", luaB_yield}, + {"status", luaB_costatus}, + {NULL, NULL} }; +/* }====================================================== */ + -LUALIB_API void lua_baselibopen (lua_State *L) { - luaL_openl(L, base_funcs); - lua_pushstring(L, LUA_VERSION); - lua_setglobal(L, "_VERSION"); - deprecated_funcs(L); +static void base_open (lua_State *L) { + lua_pushliteral(L, "_G"); + lua_pushvalue(L, LUA_GLOBALSINDEX); + luaL_openlib(L, NULL, base_funcs, 0); /* open lib into global table */ + lua_pushliteral(L, "_VERSION"); + lua_pushliteral(L, LUA_VERSION); + lua_rawset(L, -3); /* set global _VERSION */ + /* `newproxy' needs a weaktable as upvalue */ + lua_pushliteral(L, "newproxy"); + lua_newtable(L); /* new table `w' */ + lua_pushvalue(L, -1); /* `w' will be its own metatable */ + lua_setmetatable(L, -2); + lua_pushliteral(L, "__mode"); + lua_pushliteral(L, "k"); + lua_rawset(L, -3); /* metatable(w).__mode = "k" */ + lua_pushcclosure(L, luaB_newproxy, 1); + lua_rawset(L, -3); /* set global `newproxy' */ + lua_rawset(L, -1); /* set global _G */ +} + + +LUALIB_API int luaopen_base (lua_State *L) { + base_open(L); + luaL_openlib(L, LUA_COLIBNAME, co_funcs, 0); + lua_newtable(L); + lua_setglobal(L, REQTAB); + return 0; } diff --git a/src/lib/ldblib.c b/src/lib/ldblib.c index 636dbe05..6dc9b64c 100644 --- a/src/lib/ldblib.c +++ b/src/lib/ldblib.c @@ -1,5 +1,5 @@ /* -** $Id: ldblib.c,v 1.29 2000/11/06 17:58:38 roberto Exp $ +** $Id: ldblib.c,v 1.80 2003/04/03 13:35:34 roberto Exp $ ** Interface from Lua to its debug API ** See Copyright Notice in lua.h */ @@ -9,10 +9,11 @@ #include <stdlib.h> #include <string.h> +#define ldblib_c + #include "lua.h" #include "lauxlib.h" -#include "luadebug.h" #include "lualib.h" @@ -20,43 +21,41 @@ static void settabss (lua_State *L, const char *i, const char *v) { lua_pushstring(L, i); lua_pushstring(L, v); - lua_settable(L, -3); + lua_rawset(L, -3); } static void settabsi (lua_State *L, const char *i, int v) { lua_pushstring(L, i); - lua_pushnumber(L, v); - lua_settable(L, -3); + lua_pushnumber(L, (lua_Number)v); + lua_rawset(L, -3); } static int getinfo (lua_State *L) { lua_Debug ar; - const char *options = luaL_opt_string(L, 2, "flnSu"); - char buff[20]; + const char *options = luaL_optstring(L, 2, "flnSu"); if (lua_isnumber(L, 1)) { - if (!lua_getstack(L, (int)lua_tonumber(L, 1), &ar)) { + if (!lua_getstack(L, (int)(lua_tonumber(L, 1)), &ar)) { lua_pushnil(L); /* level out of range */ return 1; } } else if (lua_isfunction(L, 1)) { + lua_pushfstring(L, ">%s", options); + options = lua_tostring(L, -1); lua_pushvalue(L, 1); - sprintf(buff, ">%.10s", options); - options = buff; } else - luaL_argerror(L, 1, "function or level expected"); + return luaL_argerror(L, 1, "function or level expected"); if (!lua_getinfo(L, options, &ar)) - luaL_argerror(L, 2, "invalid option"); + return luaL_argerror(L, 2, "invalid option"); lua_newtable(L); for (; *options; options++) { switch (*options) { case 'S': settabss(L, "source", ar.source); - if (ar.source) - settabss(L, "short_src", ar.short_src); + settabss(L, "short_src", ar.short_src); settabsi(L, "linedefined", ar.linedefined); settabss(L, "what", ar.what); break; @@ -71,9 +70,9 @@ static int getinfo (lua_State *L) { settabss(L, "namewhat", ar.namewhat); break; case 'f': - lua_pushstring(L, "func"); + lua_pushliteral(L, "func"); lua_pushvalue(L, -3); - lua_settable(L, -3); + lua_rawset(L, -3); break; } } @@ -84,9 +83,9 @@ static int getinfo (lua_State *L) { static int getlocal (lua_State *L) { lua_Debug ar; const char *name; - if (!lua_getstack(L, luaL_check_int(L, 1), &ar)) /* level out of range? */ - luaL_argerror(L, 1, "level out of range"); - name = lua_getlocal(L, &ar, luaL_check_int(L, 2)); + if (!lua_getstack(L, luaL_checkint(L, 1), &ar)) /* level out of range? */ + return luaL_argerror(L, 1, "level out of range"); + name = lua_getlocal(L, &ar, luaL_checkint(L, 2)); if (name) { lua_pushstring(L, name); lua_pushvalue(L, -2); @@ -101,88 +100,200 @@ static int getlocal (lua_State *L) { static int setlocal (lua_State *L) { lua_Debug ar; - if (!lua_getstack(L, luaL_check_int(L, 1), &ar)) /* level out of range? */ - luaL_argerror(L, 1, "level out of range"); + if (!lua_getstack(L, luaL_checkint(L, 1), &ar)) /* level out of range? */ + return luaL_argerror(L, 1, "level out of range"); luaL_checkany(L, 3); - lua_pushstring(L, lua_setlocal(L, &ar, luaL_check_int(L, 2))); + lua_pushstring(L, lua_setlocal(L, &ar, luaL_checkint(L, 2))); return 1; } +static int auxupvalue (lua_State *L, int get) { + const char *name; + int n = luaL_checkint(L, 2); + luaL_checktype(L, 1, LUA_TFUNCTION); + if (lua_iscfunction(L, 1)) return 0; /* cannot touch C upvalues from Lua */ + name = get ? lua_getupvalue(L, 1, n) : lua_setupvalue(L, 1, n); + if (name == NULL) return 0; + lua_pushstring(L, name); + lua_insert(L, -(get+1)); + return get + 1; +} + + +static int getupvalue (lua_State *L) { + return auxupvalue(L, 1); +} + + +static int setupvalue (lua_State *L) { + luaL_checkany(L, 3); + return auxupvalue(L, 0); +} + + -/* dummy variables (to define unique addresses) */ -static char key1, key2; -#define KEY_CALLHOOK (&key1) -#define KEY_LINEHOOK (&key2) +static const char KEY_HOOK = 'h'; -static void hookf (lua_State *L, void *key) { - lua_getregistry(L); - lua_pushuserdata(L, key); - lua_gettable(L, -2); +static void hookf (lua_State *L, lua_Debug *ar) { + static const char *const hooknames[] = + {"call", "return", "line", "count", "tail return"}; + lua_pushlightuserdata(L, (void *)&KEY_HOOK); + lua_rawget(L, LUA_REGISTRYINDEX); if (lua_isfunction(L, -1)) { - lua_pushvalue(L, 1); - lua_rawcall(L, 1, 0); + lua_pushstring(L, hooknames[(int)ar->event]); + if (ar->currentline >= 0) + lua_pushnumber(L, (lua_Number)ar->currentline); + else lua_pushnil(L); + lua_assert(lua_getinfo(L, "lS", ar)); + lua_call(L, 2, 0); } else lua_pop(L, 1); /* pop result from gettable */ - lua_pop(L, 1); /* pop table */ } -static void callf (lua_State *L, lua_Debug *ar) { - lua_pushstring(L, ar->event); - hookf(L, KEY_CALLHOOK); +static int makemask (const char *smask, int count) { + int mask = 0; + if (strchr(smask, 'c')) mask |= LUA_MASKCALL; + if (strchr(smask, 'r')) mask |= LUA_MASKRET; + if (strchr(smask, 'l')) mask |= LUA_MASKLINE; + if (count > 0) mask |= LUA_MASKCOUNT; + return mask; } -static void linef (lua_State *L, lua_Debug *ar) { - lua_pushnumber(L, ar->currentline); - hookf(L, KEY_LINEHOOK); +static char *unmakemask (int mask, char *smask) { + int i = 0; + if (mask & LUA_MASKCALL) smask[i++] = 'c'; + if (mask & LUA_MASKRET) smask[i++] = 'r'; + if (mask & LUA_MASKLINE) smask[i++] = 'l'; + smask[i] = '\0'; + return smask; } -static void sethook (lua_State *L, void *key, lua_Hook hook, - lua_Hook (*sethookf)(lua_State * L, lua_Hook h)) { - lua_settop(L, 1); - if (lua_isnil(L, 1)) - (*sethookf)(L, NULL); - else if (lua_isfunction(L, 1)) - (*sethookf)(L, hook); - else - luaL_argerror(L, 1, "function expected"); - lua_getregistry(L); - lua_pushuserdata(L, key); - lua_pushvalue(L, -1); /* dup key */ - lua_gettable(L, -3); /* get old value */ - lua_pushvalue(L, -2); /* key (again) */ +static int sethook (lua_State *L) { + if (lua_isnoneornil(L, 1)) { + lua_settop(L, 1); + lua_sethook(L, NULL, 0, 0); /* turn off hooks */ + } + else { + const char *smask = luaL_checkstring(L, 2); + int count = luaL_optint(L, 3, 0); + luaL_checktype(L, 1, LUA_TFUNCTION); + lua_sethook(L, hookf, makemask(smask, count), count); + } + lua_pushlightuserdata(L, (void *)&KEY_HOOK); lua_pushvalue(L, 1); - lua_settable(L, -5); /* set new value */ + lua_rawset(L, LUA_REGISTRYINDEX); /* set new hook */ + return 0; } -static int setcallhook (lua_State *L) { - sethook(L, KEY_CALLHOOK, callf, lua_setcallhook); - return 1; +static int gethook (lua_State *L) { + char buff[5]; + int mask = lua_gethookmask(L); + lua_Hook hook = lua_gethook(L); + if (hook != NULL && hook != hookf) /* external hook? */ + lua_pushliteral(L, "external hook"); + else { + lua_pushlightuserdata(L, (void *)&KEY_HOOK); + lua_rawget(L, LUA_REGISTRYINDEX); /* get hook */ + } + lua_pushstring(L, unmakemask(mask, buff)); + lua_pushnumber(L, (lua_Number)lua_gethookcount(L)); + return 3; +} + + +static int debug (lua_State *L) { + for (;;) { + char buffer[250]; + fputs("lua_debug> ", stderr); + if (fgets(buffer, sizeof(buffer), stdin) == 0 || + strcmp(buffer, "cont\n") == 0) + return 0; + lua_dostring(L, buffer); + lua_settop(L, 0); /* remove eventual returns */ + } } -static int setlinehook (lua_State *L) { - sethook(L, KEY_LINEHOOK, linef, lua_setlinehook); +#define LEVELS1 12 /* size of the first part of the stack */ +#define LEVELS2 10 /* size of the second part of the stack */ + +static int errorfb (lua_State *L) { + int level = 1; /* skip level 0 (it's this function) */ + int firstpart = 1; /* still before eventual `...' */ + lua_Debug ar; + if (lua_gettop(L) == 0) + lua_pushliteral(L, ""); + else if (!lua_isstring(L, 1)) return 1; /* no string message */ + else lua_pushliteral(L, "\n"); + lua_pushliteral(L, "stack traceback:"); + while (lua_getstack(L, level++, &ar)) { + if (level > LEVELS1 && firstpart) { + /* no more than `LEVELS2' more levels? */ + if (!lua_getstack(L, level+LEVELS2, &ar)) + level--; /* keep going */ + else { + lua_pushliteral(L, "\n\t..."); /* too many levels */ + while (lua_getstack(L, level+LEVELS2, &ar)) /* find last levels */ + level++; + } + firstpart = 0; + continue; + } + lua_pushliteral(L, "\n\t"); + lua_getinfo(L, "Snl", &ar); + lua_pushfstring(L, "%s:", ar.short_src); + if (ar.currentline > 0) + lua_pushfstring(L, "%d:", ar.currentline); + switch (*ar.namewhat) { + case 'g': /* global */ + case 'l': /* local */ + case 'f': /* field */ + case 'm': /* method */ + lua_pushfstring(L, " in function `%s'", ar.name); + break; + default: { + if (*ar.what == 'm') /* main? */ + lua_pushfstring(L, " in main chunk"); + else if (*ar.what == 'C' || *ar.what == 't') + lua_pushliteral(L, " ?"); /* C function or tail call */ + else + lua_pushfstring(L, " in function <%s:%d>", + ar.short_src, ar.linedefined); + } + } + lua_concat(L, lua_gettop(L)); + } + lua_concat(L, lua_gettop(L)); return 1; } -static const struct luaL_reg dblib[] = { +static const luaL_reg dblib[] = { {"getlocal", getlocal}, {"getinfo", getinfo}, - {"setcallhook", setcallhook}, - {"setlinehook", setlinehook}, - {"setlocal", setlocal} + {"gethook", gethook}, + {"getupvalue", getupvalue}, + {"sethook", sethook}, + {"setlocal", setlocal}, + {"setupvalue", setupvalue}, + {"debug", debug}, + {"traceback", errorfb}, + {NULL, NULL} }; -LUALIB_API void lua_dblibopen (lua_State *L) { - luaL_openl(L, dblib); +LUALIB_API int luaopen_debug (lua_State *L) { + luaL_openlib(L, LUA_DBLIBNAME, dblib, 0); + lua_pushliteral(L, "_TRACEBACK"); + lua_pushcfunction(L, errorfb); + lua_settable(L, LUA_GLOBALSINDEX); + return 1; } diff --git a/src/lib/liolib.c b/src/lib/liolib.c index 70f8057a..14bd7d99 100644 --- a/src/lib/liolib.c +++ b/src/lib/liolib.c @@ -1,302 +1,309 @@ /* -** $Id: liolib.c,v 1.91 2000/10/31 13:10:24 roberto Exp $ +** $Id: liolib.c,v 2.39 2003/03/19 21:16:12 roberto Exp $ ** Standard I/O (and system) library ** See Copyright Notice in lua.h */ -#include <ctype.h> +#include <errno.h> +#include <locale.h> #include <stdio.h> #include <stdlib.h> #include <string.h> #include <time.h> +#define liolib_c + #include "lua.h" #include "lauxlib.h" -#include "luadebug.h" #include "lualib.h" -#ifndef OLD_ANSI -#include <errno.h> -#include <locale.h> -#define realloc(b,s) ((b) == NULL ? malloc(s) : (realloc)(b, s)) -#define free(b) if (b) (free)(b) + +/* +** by default, gcc does not get `tmpname' +*/ +#ifndef USE_TMPNAME +#ifdef __GNUC__ +#define USE_TMPNAME 0 #else -/* no support for locale and for strerror: fake them */ -#define setlocale(a,b) ((void)a, strcmp((b),"C")==0?"C":NULL) -#define LC_ALL 0 -#define LC_COLLATE 0 -#define LC_CTYPE 0 -#define LC_MONETARY 0 -#define LC_NUMERIC 0 -#define LC_TIME 0 -#define strerror(e) "generic I/O error" -#define errno (-1) +#define USE_TMPNAME 1 +#endif #endif +/* +** by default, posix systems get `popen' +*/ +#ifndef USE_POPEN +#ifdef _POSIX_C_SOURCE +#if _POSIX_C_SOURCE >= 2 +#define USE_POPEN 1 +#endif +#endif +#endif -#ifdef POPEN -/* FILE *popen(); -int pclose(); */ -#define CLOSEFILE(L, f) ((pclose(f) == -1) ? fclose(f) : 0) -#else -/* no support for popen */ -#define popen(x,y) NULL /* that is, popen always fails */ -#define CLOSEFILE(L, f) (fclose(f)) +#ifndef USE_POPEN +#define USE_POPEN 0 #endif -#define INFILE 0 -#define OUTFILE 1 -typedef struct IOCtrl { - int ref[2]; /* ref for strings _INPUT/_OUTPUT */ - int iotag; /* tag for file handles */ - int closedtag; /* tag for closed handles */ -} IOCtrl; + +/* +** {====================================================== +** FILE Operations +** ======================================================= +*/ + + +#if !USE_POPEN +#define pclose(f) (-1) +#endif +#define FILEHANDLE "FILE*" -static const char *const filenames[] = {"_INPUT", "_OUTPUT"}; +#define IO_INPUT "_input" +#define IO_OUTPUT "_output" -static int pushresult (lua_State *L, int i) { +static int pushresult (lua_State *L, int i, const char *filename) { if (i) { - lua_pushuserdata(L, NULL); + lua_pushboolean(L, 1); return 1; } else { lua_pushnil(L); - lua_pushstring(L, strerror(errno)); + if (filename) + lua_pushfstring(L, "%s: %s", filename, strerror(errno)); + else + lua_pushfstring(L, "%s", strerror(errno)); lua_pushnumber(L, errno); - return 3;; - } -} - - -/* -** {====================================================== -** FILE Operations -** ======================================================= -*/ - - -static FILE *gethandle (lua_State *L, IOCtrl *ctrl, int f) { - void *p = lua_touserdata(L, f); - if (p != NULL) { /* is `f' a userdata ? */ - int ftag = lua_tag(L, f); - if (ftag == ctrl->iotag) /* does it have the correct tag? */ - return (FILE *)p; - else if (ftag == ctrl->closedtag) - lua_error(L, "cannot access a closed file"); - /* else go through */ + return 3; } - return NULL; } -static FILE *getnonullfile (lua_State *L, IOCtrl *ctrl, int arg) { - FILE *f = gethandle(L, ctrl, arg); - luaL_arg_check(L, f, arg, "invalid file handle"); +static FILE **topfile (lua_State *L, int findex) { + FILE **f = (FILE **)luaL_checkudata(L, findex, FILEHANDLE); + if (f == NULL) luaL_argerror(L, findex, "bad file"); return f; } -static FILE *getfilebyref (lua_State *L, IOCtrl *ctrl, int inout) { - FILE *f; - lua_getglobals(L); - lua_getref(L, ctrl->ref[inout]); - lua_rawget(L, -2); - f = gethandle(L, ctrl, -1); - if (f == NULL) - luaL_verror(L, "global variable `%.10s' is not a file handle", - filenames[inout]); - return f; +static int io_type (lua_State *L) { + FILE **f = (FILE **)luaL_checkudata(L, 1, FILEHANDLE); + if (f == NULL) lua_pushnil(L); + else if (*f == NULL) + lua_pushliteral(L, "closed file"); + else + lua_pushliteral(L, "file"); + return 1; } -static void setfilebyname (lua_State *L, IOCtrl *ctrl, FILE *f, - const char *name) { - lua_pushusertag(L, f, ctrl->iotag); - lua_setglobal(L, name); +static FILE *tofile (lua_State *L, int findex) { + FILE **f = topfile(L, findex); + if (*f == NULL) + luaL_error(L, "attempt to use a closed file"); + return *f; } -#define setfile(L,ctrl,f,inout) (setfilebyname(L,ctrl,f,filenames[inout])) +/* +** When creating file handles, always creates a `closed' file handle +** before opening the actual file; so, if there is a memory error, the +** file is not left opened. +*/ +static FILE **newfile (lua_State *L) { + FILE **pf = (FILE **)lua_newuserdata(L, sizeof(FILE *)); + *pf = NULL; /* file handle is currently `closed' */ + luaL_getmetatable(L, FILEHANDLE); + lua_setmetatable(L, -2); + return pf; +} -static int setreturn (lua_State *L, IOCtrl *ctrl, FILE *f, int inout) { - if (f == NULL) - return pushresult(L, 0); - else { - setfile(L, ctrl, f, inout); - lua_pushusertag(L, f, ctrl->iotag); - return 1; + +/* +** assumes that top of the stack is the `io' library, and next is +** the `io' metatable +*/ +static void registerfile (lua_State *L, FILE *f, const char *name, + const char *impname) { + lua_pushstring(L, name); + *newfile(L) = f; + if (impname) { + lua_pushstring(L, impname); + lua_pushvalue(L, -2); + lua_settable(L, -6); /* metatable[impname] = file */ } + lua_settable(L, -3); /* io[name] = file */ } -static int closefile (lua_State *L, IOCtrl *ctrl, FILE *f) { +static int aux_close (lua_State *L) { + FILE *f = tofile(L, 1); if (f == stdin || f == stdout || f == stderr) - return 1; + return 0; /* file cannot be closed */ else { - lua_pushusertag(L, f, ctrl->iotag); - lua_settag(L, ctrl->closedtag); - return (CLOSEFILE(L, f) == 0); + int ok = (pclose(f) != -1) || (fclose(f) == 0); + if (ok) + *(FILE **)lua_touserdata(L, 1) = NULL; /* mark file as closed */ + return ok; } } static int io_close (lua_State *L) { - IOCtrl *ctrl = (IOCtrl *)lua_touserdata(L, -1); - lua_pop(L, 1); /* remove upvalue */ - return pushresult(L, closefile(L, ctrl, getnonullfile(L, ctrl, 1))); + if (lua_isnone(L, 1)) { + lua_pushstring(L, IO_OUTPUT); + lua_rawget(L, lua_upvalueindex(1)); + } + return pushresult(L, aux_close(L), NULL); } -static int file_collect (lua_State *L) { - IOCtrl *ctrl = (IOCtrl *)lua_touserdata(L, -1); - FILE *f = getnonullfile(L, ctrl, 1); - if (f != stdin && f != stdout && f != stderr) - CLOSEFILE(L, f); +static int io_gc (lua_State *L) { + FILE **f = topfile(L, 1); + if (*f != NULL) /* ignore closed files */ + aux_close(L); return 0; } -static int io_open (lua_State *L) { - IOCtrl *ctrl = (IOCtrl *)lua_touserdata(L, -1); - FILE *f; - lua_pop(L, 1); /* remove upvalue */ - f = fopen(luaL_check_string(L, 1), luaL_check_string(L, 2)); - if (f) { - lua_pushusertag(L, f, ctrl->iotag); - return 1; - } +static int io_tostring (lua_State *L) { + char buff[32]; + FILE **f = topfile(L, 1); + if (*f == NULL) + strcpy(buff, "closed"); else - return pushresult(L, 0); + sprintf(buff, "%p", lua_touserdata(L, 1)); + lua_pushfstring(L, "file (%s)", buff); + return 1; } +static int io_open (lua_State *L) { + const char *filename = luaL_checkstring(L, 1); + const char *mode = luaL_optstring(L, 2, "r"); + FILE **pf = newfile(L); + *pf = fopen(filename, mode); + return (*pf == NULL) ? pushresult(L, 0, filename) : 1; +} -static int io_fromto (lua_State *L, int inout, const char *mode) { - IOCtrl *ctrl = (IOCtrl *)lua_touserdata(L, -1); - FILE *current; - lua_pop(L, 1); /* remove upvalue */ - if (lua_isnull(L, 1)) { - closefile(L, ctrl, getfilebyref(L, ctrl, inout)); - current = (inout == 0) ? stdin : stdout; - } - else if (lua_tag(L, 1) == ctrl->iotag) /* deprecated option */ - current = (FILE *)lua_touserdata(L, 1); - else { - const char *s = luaL_check_string(L, 1); - current = (*s == '|') ? popen(s+1, mode) : fopen(s, mode); - } - return setreturn(L, ctrl, current, inout); + +static int io_popen (lua_State *L) { +#if !USE_POPEN + luaL_error(L, "`popen' not supported"); + return 0; +#else + const char *filename = luaL_checkstring(L, 1); + const char *mode = luaL_optstring(L, 2, "r"); + FILE **pf = newfile(L); + *pf = popen(filename, mode); + return (*pf == NULL) ? pushresult(L, 0, filename) : 1; +#endif } -static int io_readfrom (lua_State *L) { - return io_fromto(L, INFILE, "r"); +static int io_tmpfile (lua_State *L) { + FILE **pf = newfile(L); + *pf = tmpfile(); + return (*pf == NULL) ? pushresult(L, 0, NULL) : 1; } -static int io_writeto (lua_State *L) { - return io_fromto(L, OUTFILE, "w"); +static FILE *getiofile (lua_State *L, const char *name) { + lua_pushstring(L, name); + lua_rawget(L, lua_upvalueindex(1)); + return tofile(L, -1); } -static int io_appendto (lua_State *L) { - IOCtrl *ctrl = (IOCtrl *)lua_touserdata(L, -1); - FILE *current; - lua_pop(L, 1); /* remove upvalue */ - current = fopen(luaL_check_string(L, 1), "a"); - return setreturn(L, ctrl, current, OUTFILE); +static int g_iofile (lua_State *L, const char *name, const char *mode) { + if (!lua_isnoneornil(L, 1)) { + const char *filename = lua_tostring(L, 1); + lua_pushstring(L, name); + if (filename) { + FILE **pf = newfile(L); + *pf = fopen(filename, mode); + if (*pf == NULL) { + lua_pushfstring(L, "%s: %s", filename, strerror(errno)); + luaL_argerror(L, 1, lua_tostring(L, -1)); + } + } + else { + tofile(L, 1); /* check that it's a valid file handle */ + lua_pushvalue(L, 1); + } + lua_rawset(L, lua_upvalueindex(1)); + } + /* return current value */ + lua_pushstring(L, name); + lua_rawget(L, lua_upvalueindex(1)); + return 1; } +static int io_input (lua_State *L) { + return g_iofile(L, IO_INPUT, "r"); +} -/* -** {====================================================== -** READ -** ======================================================= -*/ +static int io_output (lua_State *L) { + return g_iofile(L, IO_OUTPUT, "w"); +} -#ifdef LUA_COMPAT_READPATTERN +static int io_readline (lua_State *L); -/* -** We cannot lookahead without need, because this can lock stdin. -** This flag signals when we need to read a next char. -*/ -#define NEED_OTHER (EOF-1) /* just some flag different from EOF */ +static void aux_lines (lua_State *L, int idx, int close) { + lua_pushliteral(L, FILEHANDLE); + lua_rawget(L, LUA_REGISTRYINDEX); + lua_pushvalue(L, idx); + lua_pushboolean(L, close); /* close/not close file when finished */ + lua_pushcclosure(L, io_readline, 3); +} -static int read_pattern (lua_State *L, FILE *f, const char *p) { - int inskip = 0; /* {skip} level */ - int c = NEED_OTHER; - luaL_Buffer b; - luaL_buffinit(L, &b); - while (*p != '\0') { - switch (*p) { - case '{': - inskip++; - p++; - continue; - case '}': - if (!inskip) lua_error(L, "unbalanced braces in read pattern"); - inskip--; - p++; - continue; - default: { - const char *ep = luaI_classend(L, p); /* get what is next */ - int m; /* match result */ - if (c == NEED_OTHER) c = getc(f); - m = (c==EOF) ? 0 : luaI_singlematch(c, p, ep); - if (m) { - if (!inskip) luaL_putchar(&b, c); - c = NEED_OTHER; - } - switch (*ep) { - case '+': /* repetition (1 or more) */ - if (!m) goto break_while; /* pattern fails? */ - /* else go through */ - case '*': /* repetition (0 or more) */ - while (m) { /* reads the same item until it fails */ - c = getc(f); - m = (c==EOF) ? 0 : luaI_singlematch(c, p, ep); - if (m && !inskip) luaL_putchar(&b, c); - } - /* go through to continue reading the pattern */ - case '?': /* optional */ - p = ep+1; /* continues reading the pattern */ - continue; - default: - if (!m) goto break_while; /* pattern fails? */ - p = ep; /* else continues reading the pattern */ - } - } - } - } break_while: - if (c != NEED_OTHER) ungetc(c, f); - luaL_pushresult(&b); /* close buffer */ - return (*p == '\0'); + +static int f_lines (lua_State *L) { + tofile(L, 1); /* check that it's a valid file handle */ + aux_lines(L, 1, 0); + return 1; } -#else -#define read_pattern(L, f, p) (lua_error(L, "read patterns are deprecated"), 0) +static int io_lines (lua_State *L) { + if (lua_isnoneornil(L, 1)) { /* no arguments? */ + lua_pushstring(L, IO_INPUT); + lua_rawget(L, lua_upvalueindex(1)); /* will iterate over default input */ + return f_lines(L); + } + else { + const char *filename = luaL_checkstring(L, 1); + FILE **pf = newfile(L); + *pf = fopen(filename, "r"); + luaL_argcheck(L, *pf, 1, strerror(errno)); + aux_lines(L, lua_gettop(L), 1); + return 1; + } +} + -#endif +/* +** {====================================================== +** READ +** ======================================================= +*/ static int read_number (lua_State *L, FILE *f) { - double d; - if (fscanf(f, "%lf", &d) == 1) { + lua_Number d; + if (fscanf(f, LUA_NUMBER_SCAN, &d) == 1) { lua_pushnumber(L, d); return 1; } @@ -304,175 +311,167 @@ static int read_number (lua_State *L, FILE *f) { } -static int read_word (lua_State *L, FILE *f) { - int c; - luaL_Buffer b; - luaL_buffinit(L, &b); - do { c = fgetc(f); } while (isspace(c)); /* skip spaces */ - while (c != EOF && !isspace(c)) { - luaL_putchar(&b, c); - c = fgetc(f); - } +static int test_eof (lua_State *L, FILE *f) { + int c = getc(f); ungetc(c, f); - luaL_pushresult(&b); /* close buffer */ - return (lua_strlen(L, -1) > 0); + lua_pushlstring(L, NULL, 0); + return (c != EOF); } static int read_line (lua_State *L, FILE *f) { - int n = 0; luaL_Buffer b; luaL_buffinit(L, &b); for (;;) { + size_t l; char *p = luaL_prepbuffer(&b); - if (!fgets(p, LUAL_BUFFERSIZE, f)) /* read fails? */ - break; - n = strlen(p); - if (p[n-1] != '\n') - luaL_addsize(&b, n); - else { - luaL_addsize(&b, n-1); /* do not add the `\n' */ - break; + if (fgets(p, LUAL_BUFFERSIZE, f) == NULL) { /* eof? */ + luaL_pushresult(&b); /* close buffer */ + return (lua_strlen(L, -1) > 0); /* check whether read something */ } - } - luaL_pushresult(&b); /* close buffer */ - return (n > 0); /* read something? */ -} - - -static void read_file (lua_State *L, FILE *f) { - size_t len = 0; - size_t size = BUFSIZ; - char *buffer = NULL; - for (;;) { - char *newbuffer = (char *)realloc(buffer, size); - if (newbuffer == NULL) { - free(buffer); - lua_error(L, "not enough memory to read a file"); + l = strlen(p); + if (p[l-1] != '\n') + luaL_addsize(&b, l); + else { + luaL_addsize(&b, l - 1); /* do not include `eol' */ + luaL_pushresult(&b); /* close buffer */ + return 1; /* read at least an `eol' */ } - buffer = newbuffer; - len += fread(buffer+len, sizeof(char), size-len, f); - if (len < size) break; /* did not read all it could */ - size *= 2; } - lua_pushlstring(L, buffer, len); - free(buffer); } static int read_chars (lua_State *L, FILE *f, size_t n) { - char *buffer; - size_t n1; - char statbuff[BUFSIZ]; - if (n <= BUFSIZ) - buffer = statbuff; - else { - buffer = (char *)malloc(n); - if (buffer == NULL) - lua_error(L, "not enough memory to read a file"); - } - n1 = fread(buffer, sizeof(char), n, f); - lua_pushlstring(L, buffer, n1); - if (buffer != statbuff) free(buffer); - return (n1 > 0 || n == 0); + size_t rlen; /* how much to read */ + size_t nr; /* number of chars actually read */ + luaL_Buffer b; + luaL_buffinit(L, &b); + rlen = LUAL_BUFFERSIZE; /* try to read that much each time */ + do { + char *p = luaL_prepbuffer(&b); + if (rlen > n) rlen = n; /* cannot read more than asked */ + nr = fread(p, sizeof(char), rlen, f); + luaL_addsize(&b, nr); + n -= nr; /* still have to read `n' chars */ + } while (n > 0 && nr == rlen); /* until end of count or eof */ + luaL_pushresult(&b); /* close buffer */ + return (n == 0 || lua_strlen(L, -1) > 0); } -static int io_read (lua_State *L) { - IOCtrl *ctrl = (IOCtrl *)lua_touserdata(L, -1); - int lastarg = lua_gettop(L) - 1; - int firstarg = 1; - FILE *f = gethandle(L, ctrl, firstarg); +static int g_read (lua_State *L, FILE *f, int first) { + int nargs = lua_gettop(L) - 1; + int success; int n; - if (f) firstarg++; - else f = getfilebyref(L, ctrl, INFILE); /* get _INPUT */ - lua_pop(L, 1); - if (firstarg > lastarg) { /* no arguments? */ - lua_settop(L, 0); /* erase upvalue and other eventual garbage */ - firstarg = lastarg = 1; /* correct indices */ - lua_pushstring(L, "*l"); /* push default argument */ + if (nargs == 0) { /* no arguments? */ + success = read_line(L, f); + n = first+1; /* to return 1 result */ } - else /* ensure stack space for all results and for auxlib's buffer */ - luaL_checkstack(L, lastarg-firstarg+1+LUA_MINSTACK, "too many arguments"); - for (n = firstarg; n<=lastarg; n++) { - int success; - if (lua_isnumber(L, n)) - success = read_chars(L, f, (size_t)lua_tonumber(L, n)); - else { - const char *p = luaL_check_string(L, n); - if (p[0] != '*') - success = read_pattern(L, f, p); /* deprecated! */ + else { /* ensure stack space for all results and for auxlib's buffer */ + luaL_checkstack(L, nargs+LUA_MINSTACK, "too many arguments"); + success = 1; + for (n = first; nargs-- && success; n++) { + if (lua_type(L, n) == LUA_TNUMBER) { + size_t l = (size_t)lua_tonumber(L, n); + success = (l == 0) ? test_eof(L, f) : read_chars(L, f, l); + } else { + const char *p = lua_tostring(L, n); + luaL_argcheck(L, p && p[0] == '*', n, "invalid option"); switch (p[1]) { case 'n': /* number */ - if (!read_number(L, f)) goto endloop; /* read fails */ - continue; /* number is already pushed; avoid the "pushstring" */ + success = read_number(L, f); + break; case 'l': /* line */ success = read_line(L, f); break; case 'a': /* file */ - read_file(L, f); + read_chars(L, f, ~((size_t)0)); /* read MAX_SIZE_T chars */ success = 1; /* always success */ break; case 'w': /* word */ - success = read_word(L, f); - break; + return luaL_error(L, "obsolete option `*w' to `read'"); default: - luaL_argerror(L, n, "invalid format"); - success = 0; /* to avoid warnings */ + return luaL_argerror(L, n, "invalid format"); } } } - if (!success) { - lua_pop(L, 1); /* remove last result */ - break; /* read fails */ + } + if (!success) { + lua_pop(L, 1); /* remove last result */ + lua_pushnil(L); /* push nil instead */ + } + return n - first; +} + + +static int io_read (lua_State *L) { + return g_read(L, getiofile(L, IO_INPUT), 1); +} + + +static int f_read (lua_State *L) { + return g_read(L, tofile(L, 1), 2); +} + + +static int io_readline (lua_State *L) { + FILE *f = *(FILE **)lua_touserdata(L, lua_upvalueindex(2)); + if (f == NULL) /* file is already closed? */ + luaL_error(L, "file is already closed"); + if (read_line(L, f)) return 1; + else { /* EOF */ + if (lua_toboolean(L, lua_upvalueindex(3))) { /* generator created file? */ + lua_settop(L, 0); + lua_pushvalue(L, lua_upvalueindex(2)); + aux_close(L); /* close it */ } - } endloop: - return n - firstarg; + return 0; + } } /* }====================================================== */ -static int io_write (lua_State *L) { - int lastarg = lua_gettop(L) - 1; - IOCtrl *ctrl = (IOCtrl *)lua_touserdata(L, -1); - int arg = 1; +static int g_write (lua_State *L, FILE *f, int arg) { + int nargs = lua_gettop(L) - 1; int status = 1; - FILE *f = gethandle(L, ctrl, arg); - if (f) arg++; - else f = getfilebyref(L, ctrl, OUTFILE); /* get _OUTPUT */ - for (; arg <= lastarg; arg++) { - if (lua_type(L, arg) == LUA_TNUMBER) { /* LUA_NUMBER */ + for (; nargs--; arg++) { + if (lua_type(L, arg) == LUA_TNUMBER) { /* optimization: could be done exactly as for strings */ - status = status && fprintf(f, "%.16g", lua_tonumber(L, arg)) > 0; + status = status && + fprintf(f, LUA_NUMBER_FMT, lua_tonumber(L, arg)) > 0; } else { size_t l; - const char *s = luaL_check_lstr(L, arg, &l); + const char *s = luaL_checklstring(L, arg, &l); status = status && (fwrite(s, sizeof(char), l, f) == l); } } - pushresult(L, status); - return 1; + return pushresult(L, status, NULL); +} + + +static int io_write (lua_State *L) { + return g_write(L, getiofile(L, IO_OUTPUT), 1); } -static int io_seek (lua_State *L) { +static int f_write (lua_State *L) { + return g_write(L, tofile(L, 1), 2); +} + + +static int f_seek (lua_State *L) { static const int mode[] = {SEEK_SET, SEEK_CUR, SEEK_END}; static const char *const modenames[] = {"set", "cur", "end", NULL}; - IOCtrl *ctrl = (IOCtrl *)lua_touserdata(L, -1); - FILE *f; - int op; - long offset; - lua_pop(L, 1); /* remove upvalue */ - f = getnonullfile(L, ctrl, 1); - op = luaL_findstring(luaL_opt_string(L, 2, "cur"), modenames); - offset = luaL_opt_long(L, 3, 0); - luaL_arg_check(L, op != -1, 2, "invalid mode"); + FILE *f = tofile(L, 1); + int op = luaL_findstring(luaL_optstring(L, 2, "cur"), modenames); + long offset = luaL_optlong(L, 3, 0); + luaL_argcheck(L, op != -1, 2, "invalid mode"); op = fseek(f, offset, mode[op]); if (op) - return pushresult(L, 0); /* error */ + return pushresult(L, 0, NULL); /* error */ else { lua_pushnumber(L, ftell(f)); return 1; @@ -481,12 +480,51 @@ static int io_seek (lua_State *L) { static int io_flush (lua_State *L) { - IOCtrl *ctrl = (IOCtrl *)lua_touserdata(L, -1); - FILE *f; - lua_pop(L, 1); /* remove upvalue */ - f = gethandle(L, ctrl, 1); - luaL_arg_check(L, f || lua_isnull(L, 1), 1, "invalid file handle"); - return pushresult(L, fflush(f) == 0); + return pushresult(L, fflush(getiofile(L, IO_OUTPUT)) == 0, NULL); +} + + +static int f_flush (lua_State *L) { + return pushresult(L, fflush(tofile(L, 1)) == 0, NULL); +} + + +static const luaL_reg iolib[] = { + {"input", io_input}, + {"output", io_output}, + {"lines", io_lines}, + {"close", io_close}, + {"flush", io_flush}, + {"open", io_open}, + {"popen", io_popen}, + {"read", io_read}, + {"tmpfile", io_tmpfile}, + {"type", io_type}, + {"write", io_write}, + {NULL, NULL} +}; + + +static const luaL_reg flib[] = { + {"flush", f_flush}, + {"read", f_read}, + {"lines", f_lines}, + {"seek", f_seek}, + {"write", f_write}, + {"close", io_close}, + {"__gc", io_gc}, + {"__tostring", io_tostring}, + {NULL, NULL} +}; + + +static void createmeta (lua_State *L) { + luaL_newmetatable(L, FILEHANDLE); /* create new metatable for file handles */ + /* file methods */ + lua_pushliteral(L, "__index"); + lua_pushvalue(L, -2); /* push metatable */ + lua_rawset(L, -3); /* metatable.__index = metatable */ + luaL_openlib(L, NULL, flib, 0); } /* }====================================================== */ @@ -499,220 +537,214 @@ static int io_flush (lua_State *L) { */ static int io_execute (lua_State *L) { - lua_pushnumber(L, system(luaL_check_string(L, 1))); + lua_pushnumber(L, system(luaL_checkstring(L, 1))); return 1; } static int io_remove (lua_State *L) { - return pushresult(L, remove(luaL_check_string(L, 1)) == 0); + const char *filename = luaL_checkstring(L, 1); + return pushresult(L, remove(filename) == 0, filename); } static int io_rename (lua_State *L) { - return pushresult(L, rename(luaL_check_string(L, 1), - luaL_check_string(L, 2)) == 0); + const char *fromname = luaL_checkstring(L, 1); + const char *toname = luaL_checkstring(L, 2); + return pushresult(L, rename(fromname, toname) == 0, fromname); } static int io_tmpname (lua_State *L) { - lua_pushstring(L, tmpnam(NULL)); +#if !USE_TMPNAME + luaL_error(L, "`tmpname' not supported"); + return 0; +#else + char buff[L_tmpnam]; + if (tmpnam(buff) != buff) + return luaL_error(L, "unable to generate a unique filename in `tmpname'"); + lua_pushstring(L, buff); return 1; +#endif } - static int io_getenv (lua_State *L) { - lua_pushstring(L, getenv(luaL_check_string(L, 1))); /* if NULL push nil */ + lua_pushstring(L, getenv(luaL_checkstring(L, 1))); /* if NULL push nil */ return 1; } static int io_clock (lua_State *L) { - lua_pushnumber(L, ((double)clock())/CLOCKS_PER_SEC); + lua_pushnumber(L, ((lua_Number)clock())/(lua_Number)CLOCKS_PER_SEC); return 1; } +/* +** {====================================================== +** Time/Date operations +** { year=%Y, month=%m, day=%d, hour=%H, min=%M, sec=%S, +** wday=%w+1, yday=%j, isdst=? } +** ======================================================= +*/ + +static void setfield (lua_State *L, const char *key, int value) { + lua_pushstring(L, key); + lua_pushnumber(L, value); + lua_rawset(L, -3); +} + +static void setboolfield (lua_State *L, const char *key, int value) { + lua_pushstring(L, key); + lua_pushboolean(L, value); + lua_rawset(L, -3); +} + +static int getboolfield (lua_State *L, const char *key) { + int res; + lua_pushstring(L, key); + lua_gettable(L, -2); + res = lua_toboolean(L, -1); + lua_pop(L, 1); + return res; +} + + +static int getfield (lua_State *L, const char *key, int d) { + int res; + lua_pushstring(L, key); + lua_gettable(L, -2); + if (lua_isnumber(L, -1)) + res = (int)(lua_tonumber(L, -1)); + else { + if (d == -2) + return luaL_error(L, "field `%s' missing in date table", key); + res = d; + } + lua_pop(L, 1); + return res; +} + + static int io_date (lua_State *L) { - char b[256]; - const char *s = luaL_opt_string(L, 1, "%c"); + const char *s = luaL_optstring(L, 1, "%c"); + time_t t = (time_t)(luaL_optnumber(L, 2, -1)); struct tm *stm; - time_t t; - time(&t); stm = localtime(&t); - if (strftime(b, sizeof(b), s, stm)) - lua_pushstring(L, b); + if (t == (time_t)(-1)) /* no time given? */ + t = time(NULL); /* use current time */ + if (*s == '!') { /* UTC? */ + stm = gmtime(&t); + s++; /* skip `!' */ + } else - lua_error(L, "invalid `date' format"); + stm = localtime(&t); + if (stm == NULL) /* invalid date? */ + lua_pushnil(L); + else if (strcmp(s, "*t") == 0) { + lua_newtable(L); + setfield(L, "sec", stm->tm_sec); + setfield(L, "min", stm->tm_min); + setfield(L, "hour", stm->tm_hour); + setfield(L, "day", stm->tm_mday); + setfield(L, "month", stm->tm_mon+1); + setfield(L, "year", stm->tm_year+1900); + setfield(L, "wday", stm->tm_wday+1); + setfield(L, "yday", stm->tm_yday+1); + setboolfield(L, "isdst", stm->tm_isdst); + } + else { + char b[256]; + if (strftime(b, sizeof(b), s, stm)) + lua_pushstring(L, b); + else + return luaL_error(L, "`date' format too long"); + } return 1; } -static int setloc (lua_State *L) { - static const int cat[] = {LC_ALL, LC_COLLATE, LC_CTYPE, LC_MONETARY, - LC_NUMERIC, LC_TIME}; - static const char *const catnames[] = {"all", "collate", "ctype", "monetary", - "numeric", "time", NULL}; - int op = luaL_findstring(luaL_opt_string(L, 2, "all"), catnames); - luaL_arg_check(L, op != -1, 2, "invalid option"); - lua_pushstring(L, setlocale(cat[op], luaL_check_string(L, 1))); +static int io_time (lua_State *L) { + if (lua_isnoneornil(L, 1)) /* called without args? */ + lua_pushnumber(L, time(NULL)); /* return current time */ + else { + time_t t; + struct tm ts; + luaL_checktype(L, 1, LUA_TTABLE); + lua_settop(L, 1); /* make sure table is at the top */ + ts.tm_sec = getfield(L, "sec", 0); + ts.tm_min = getfield(L, "min", 0); + ts.tm_hour = getfield(L, "hour", 12); + ts.tm_mday = getfield(L, "day", -2); + ts.tm_mon = getfield(L, "month", -2) - 1; + ts.tm_year = getfield(L, "year", -2) - 1900; + ts.tm_isdst = getboolfield(L, "isdst"); + t = mktime(&ts); + if (t == (time_t)(-1)) + lua_pushnil(L); + else + lua_pushnumber(L, t); + } return 1; } -static int io_exit (lua_State *L) { - exit(luaL_opt_int(L, 1, EXIT_SUCCESS)); - return 0; /* to avoid warnings */ +static int io_difftime (lua_State *L) { + lua_pushnumber(L, difftime((time_t)(luaL_checknumber(L, 1)), + (time_t)(luaL_optnumber(L, 2, 0)))); + return 1; } /* }====================================================== */ - -static int io_debug (lua_State *L) { - for (;;) { - char buffer[250]; - fprintf(stderr, "lua_debug> "); - if (fgets(buffer, sizeof(buffer), stdin) == 0 || - strcmp(buffer, "cont\n") == 0) - return 0; - lua_dostring(L, buffer); - lua_settop(L, 0); /* remove eventual returns */ - } +static int io_setloc (lua_State *L) { + static const int cat[] = {LC_ALL, LC_COLLATE, LC_CTYPE, LC_MONETARY, + LC_NUMERIC, LC_TIME}; + static const char *const catnames[] = {"all", "collate", "ctype", "monetary", + "numeric", "time", NULL}; + const char *l = lua_tostring(L, 1); + int op = luaL_findstring(luaL_optstring(L, 2, "all"), catnames); + luaL_argcheck(L, l || lua_isnoneornil(L, 1), 1, "string expected"); + luaL_argcheck(L, op != -1, 2, "invalid option"); + lua_pushstring(L, setlocale(cat[op], l)); + return 1; } -#define LEVELS1 12 /* size of the first part of the stack */ -#define LEVELS2 10 /* size of the second part of the stack */ - -static int errorfb (lua_State *L) { - int level = 1; /* skip level 0 (it's this function) */ - int firstpart = 1; /* still before eventual `...' */ - lua_Debug ar; - luaL_Buffer b; - luaL_buffinit(L, &b); - luaL_addstring(&b, "error: "); - luaL_addstring(&b, luaL_check_string(L, 1)); - luaL_addstring(&b, "\n"); - while (lua_getstack(L, level++, &ar)) { - char buff[120]; /* enough to fit following `sprintf's */ - if (level == 2) - luaL_addstring(&b, "stack traceback:\n"); - else if (level > LEVELS1 && firstpart) { - /* no more than `LEVELS2' more levels? */ - if (!lua_getstack(L, level+LEVELS2, &ar)) - level--; /* keep going */ - else { - luaL_addstring(&b, " ...\n"); /* too many levels */ - while (lua_getstack(L, level+LEVELS2, &ar)) /* find last levels */ - level++; - } - firstpart = 0; - continue; - } - sprintf(buff, "%4d: ", level-1); - luaL_addstring(&b, buff); - lua_getinfo(L, "Snl", &ar); - switch (*ar.namewhat) { - case 'g': case 'l': /* global, local */ - sprintf(buff, "function `%.50s'", ar.name); - break; - case 'f': /* field */ - sprintf(buff, "method `%.50s'", ar.name); - break; - case 't': /* tag method */ - sprintf(buff, "`%.50s' tag method", ar.name); - break; - default: { - if (*ar.what == 'm') /* main? */ - sprintf(buff, "main of %.70s", ar.short_src); - else if (*ar.what == 'C') /* C function? */ - sprintf(buff, "%.70s", ar.short_src); - else - sprintf(buff, "function <%d:%.70s>", ar.linedefined, ar.short_src); - ar.source = NULL; /* do not print source again */ - } - } - luaL_addstring(&b, buff); - if (ar.currentline > 0) { - sprintf(buff, " at line %d", ar.currentline); - luaL_addstring(&b, buff); - } - if (ar.source) { - sprintf(buff, " [%.70s]", ar.short_src); - luaL_addstring(&b, buff); - } - luaL_addstring(&b, "\n"); - } - luaL_pushresult(&b); - lua_getglobal(L, LUA_ALERT); - if (lua_isfunction(L, -1)) { /* avoid loop if _ALERT is not defined */ - lua_pushvalue(L, -2); /* error message */ - lua_rawcall(L, 1, 0); - } - return 0; +static int io_exit (lua_State *L) { + exit(luaL_optint(L, 1, EXIT_SUCCESS)); + return 0; /* to avoid warnings */ } - - -static const struct luaL_reg iolib[] = { - {LUA_ERRORMESSAGE, errorfb}, +static const luaL_reg syslib[] = { {"clock", io_clock}, - {"date", io_date}, - {"debug", io_debug}, - {"execute", io_execute}, - {"exit", io_exit}, - {"getenv", io_getenv}, - {"remove", io_remove}, - {"rename", io_rename}, - {"setlocale", setloc}, - {"tmpname", io_tmpname} + {"date", io_date}, + {"difftime", io_difftime}, + {"execute", io_execute}, + {"exit", io_exit}, + {"getenv", io_getenv}, + {"remove", io_remove}, + {"rename", io_rename}, + {"setlocale", io_setloc}, + {"time", io_time}, + {"tmpname", io_tmpname}, + {NULL, NULL} }; +/* }====================================================== */ -static const struct luaL_reg iolibtag[] = { - {"appendto", io_appendto}, - {"closefile", io_close}, - {"flush", io_flush}, - {"openfile", io_open}, - {"read", io_read}, - {"readfrom", io_readfrom}, - {"seek", io_seek}, - {"write", io_write}, - {"writeto", io_writeto} -}; -static void openwithcontrol (lua_State *L) { - IOCtrl *ctrl = (IOCtrl *)lua_newuserdata(L, sizeof(IOCtrl)); - unsigned int i; - ctrl->iotag = lua_newtag(L); - ctrl->closedtag = lua_newtag(L); - for (i=0; i<sizeof(iolibtag)/sizeof(iolibtag[0]); i++) { - /* put `ctrl' as upvalue for these functions */ - lua_pushvalue(L, -1); - lua_pushcclosure(L, iolibtag[i].func, 1); - lua_setglobal(L, iolibtag[i].name); - } - /* create references to variable names */ - lua_pushstring(L, filenames[INFILE]); - ctrl->ref[INFILE] = lua_ref(L, 1); - lua_pushstring(L, filenames[OUTFILE]); - ctrl->ref[OUTFILE] = lua_ref(L, 1); - /* predefined file handles */ - setfile(L, ctrl, stdin, INFILE); - setfile(L, ctrl, stdout, OUTFILE); - setfilebyname(L, ctrl, stdin, "_STDIN"); - setfilebyname(L, ctrl, stdout, "_STDOUT"); - setfilebyname(L, ctrl, stderr, "_STDERR"); - /* close files when collected */ - lua_pushcclosure(L, file_collect, 1); /* pops `ctrl' from stack */ - lua_settagmethod(L, ctrl->iotag, "gc"); -} - - -LUALIB_API void lua_iolibopen (lua_State *L) { - luaL_openl(L, iolib); - openwithcontrol(L); +LUALIB_API int luaopen_io (lua_State *L) { + luaL_openlib(L, LUA_OSLIBNAME, syslib, 0); + createmeta(L); + lua_pushvalue(L, -1); + luaL_openlib(L, LUA_IOLIBNAME, iolib, 1); + /* put predefined file handles into `io' table */ + registerfile(L, stdin, "stdin", IO_INPUT); + registerfile(L, stdout, "stdout", IO_OUTPUT); + registerfile(L, stderr, "stderr", NULL); + return 1; } diff --git a/src/lib/lmathlib.c b/src/lib/lmathlib.c index c062cf49..f074a56e 100644 --- a/src/lib/lmathlib.c +++ b/src/lib/lmathlib.c @@ -1,5 +1,5 @@ /* -** $Id: lmathlib.c,v 1.32 2000/10/31 13:10:24 roberto Exp $ +** $Id: lmathlib.c,v 1.56 2003/03/11 12:30:37 roberto Exp $ ** Standard mathematical library ** See Copyright Notice in lua.h */ @@ -8,6 +8,8 @@ #include <stdlib.h> #include <math.h> +#define lmathlib_c + #include "lua.h" #include "lauxlib.h" @@ -21,117 +23,117 @@ /* -** If you want Lua to operate in radians (instead of degrees), -** define RADIANS +** If you want Lua to operate in degrees (instead of radians), +** define USE_DEGREES */ -#ifdef RADIANS -#define FROMRAD(a) (a) -#define TORAD(a) (a) -#else +#ifdef USE_DEGREES #define FROMRAD(a) ((a)/RADIANS_PER_DEGREE) #define TORAD(a) ((a)*RADIANS_PER_DEGREE) +#else +#define FROMRAD(a) (a) +#define TORAD(a) (a) #endif static int math_abs (lua_State *L) { - lua_pushnumber(L, fabs(luaL_check_number(L, 1))); + lua_pushnumber(L, fabs(luaL_checknumber(L, 1))); return 1; } static int math_sin (lua_State *L) { - lua_pushnumber(L, sin(TORAD(luaL_check_number(L, 1)))); + lua_pushnumber(L, sin(TORAD(luaL_checknumber(L, 1)))); return 1; } static int math_cos (lua_State *L) { - lua_pushnumber(L, cos(TORAD(luaL_check_number(L, 1)))); + lua_pushnumber(L, cos(TORAD(luaL_checknumber(L, 1)))); return 1; } static int math_tan (lua_State *L) { - lua_pushnumber(L, tan(TORAD(luaL_check_number(L, 1)))); + lua_pushnumber(L, tan(TORAD(luaL_checknumber(L, 1)))); return 1; } static int math_asin (lua_State *L) { - lua_pushnumber(L, FROMRAD(asin(luaL_check_number(L, 1)))); + lua_pushnumber(L, FROMRAD(asin(luaL_checknumber(L, 1)))); return 1; } static int math_acos (lua_State *L) { - lua_pushnumber(L, FROMRAD(acos(luaL_check_number(L, 1)))); + lua_pushnumber(L, FROMRAD(acos(luaL_checknumber(L, 1)))); return 1; } static int math_atan (lua_State *L) { - lua_pushnumber(L, FROMRAD(atan(luaL_check_number(L, 1)))); + lua_pushnumber(L, FROMRAD(atan(luaL_checknumber(L, 1)))); return 1; } static int math_atan2 (lua_State *L) { - lua_pushnumber(L, FROMRAD(atan2(luaL_check_number(L, 1), luaL_check_number(L, 2)))); + lua_pushnumber(L, FROMRAD(atan2(luaL_checknumber(L, 1), luaL_checknumber(L, 2)))); return 1; } static int math_ceil (lua_State *L) { - lua_pushnumber(L, ceil(luaL_check_number(L, 1))); + lua_pushnumber(L, ceil(luaL_checknumber(L, 1))); return 1; } static int math_floor (lua_State *L) { - lua_pushnumber(L, floor(luaL_check_number(L, 1))); + lua_pushnumber(L, floor(luaL_checknumber(L, 1))); return 1; } static int math_mod (lua_State *L) { - lua_pushnumber(L, fmod(luaL_check_number(L, 1), luaL_check_number(L, 2))); + lua_pushnumber(L, fmod(luaL_checknumber(L, 1), luaL_checknumber(L, 2))); return 1; } static int math_sqrt (lua_State *L) { - lua_pushnumber(L, sqrt(luaL_check_number(L, 1))); + lua_pushnumber(L, sqrt(luaL_checknumber(L, 1))); return 1; } static int math_pow (lua_State *L) { - lua_pushnumber(L, pow(luaL_check_number(L, 1), luaL_check_number(L, 2))); + lua_pushnumber(L, pow(luaL_checknumber(L, 1), luaL_checknumber(L, 2))); return 1; } static int math_log (lua_State *L) { - lua_pushnumber(L, log(luaL_check_number(L, 1))); + lua_pushnumber(L, log(luaL_checknumber(L, 1))); return 1; } static int math_log10 (lua_State *L) { - lua_pushnumber(L, log10(luaL_check_number(L, 1))); + lua_pushnumber(L, log10(luaL_checknumber(L, 1))); return 1; } static int math_exp (lua_State *L) { - lua_pushnumber(L, exp(luaL_check_number(L, 1))); + lua_pushnumber(L, exp(luaL_checknumber(L, 1))); return 1; } static int math_deg (lua_State *L) { - lua_pushnumber(L, luaL_check_number(L, 1)/RADIANS_PER_DEGREE); + lua_pushnumber(L, luaL_checknumber(L, 1)/RADIANS_PER_DEGREE); return 1; } static int math_rad (lua_State *L) { - lua_pushnumber(L, luaL_check_number(L, 1)*RADIANS_PER_DEGREE); + lua_pushnumber(L, luaL_checknumber(L, 1)*RADIANS_PER_DEGREE); return 1; } static int math_frexp (lua_State *L) { int e; - lua_pushnumber(L, frexp(luaL_check_number(L, 1), &e)); + lua_pushnumber(L, frexp(luaL_checknumber(L, 1), &e)); lua_pushnumber(L, e); return 2; } static int math_ldexp (lua_State *L) { - lua_pushnumber(L, ldexp(luaL_check_number(L, 1), luaL_check_int(L, 2))); + lua_pushnumber(L, ldexp(luaL_checknumber(L, 1), luaL_checkint(L, 2))); return 1; } @@ -139,10 +141,10 @@ static int math_ldexp (lua_State *L) { static int math_min (lua_State *L) { int n = lua_gettop(L); /* number of arguments */ - double dmin = luaL_check_number(L, 1); + lua_Number dmin = luaL_checknumber(L, 1); int i; for (i=2; i<=n; i++) { - double d = luaL_check_number(L, i); + lua_Number d = luaL_checknumber(L, i); if (d < dmin) dmin = d; } @@ -153,10 +155,10 @@ static int math_min (lua_State *L) { static int math_max (lua_State *L) { int n = lua_gettop(L); /* number of arguments */ - double dmax = luaL_check_number(L, 1); + lua_Number dmax = luaL_checknumber(L, 1); int i; for (i=2; i<=n; i++) { - double d = luaL_check_number(L, i); + lua_Number d = luaL_checknumber(L, i); if (d > dmax) dmax = d; } @@ -166,73 +168,79 @@ static int math_max (lua_State *L) { static int math_random (lua_State *L) { - /* the '%' avoids the (rare) case of r==1, and is needed also because on - some systems (SunOS!) "rand()" may return a value larger than RAND_MAX */ - double r = (double)(rand()%RAND_MAX) / (double)RAND_MAX; + /* the `%' avoids the (rare) case of r==1, and is needed also because on + some systems (SunOS!) `rand()' may return a value larger than RAND_MAX */ + lua_Number r = (lua_Number)(rand()%RAND_MAX) / (lua_Number)RAND_MAX; switch (lua_gettop(L)) { /* check number of arguments */ case 0: { /* no arguments */ lua_pushnumber(L, r); /* Number between 0 and 1 */ break; } case 1: { /* only upper limit */ - int u = luaL_check_int(L, 1); - luaL_arg_check(L, 1<=u, 1, "interval is empty"); - lua_pushnumber(L, (int)(r*u)+1); /* integer between 1 and `u' */ + int u = luaL_checkint(L, 1); + luaL_argcheck(L, 1<=u, 1, "interval is empty"); + lua_pushnumber(L, (int)floor(r*u)+1); /* int between 1 and `u' */ break; } case 2: { /* lower and upper limits */ - int l = luaL_check_int(L, 1); - int u = luaL_check_int(L, 2); - luaL_arg_check(L, l<=u, 2, "interval is empty"); - lua_pushnumber(L, (int)(r*(u-l+1))+l); /* integer between `l' and `u' */ + int l = luaL_checkint(L, 1); + int u = luaL_checkint(L, 2); + luaL_argcheck(L, l<=u, 2, "interval is empty"); + lua_pushnumber(L, (int)floor(r*(u-l+1))+l); /* int between `l' and `u' */ break; } - default: lua_error(L, "wrong number of arguments"); + default: return luaL_error(L, "wrong number of arguments"); } return 1; } static int math_randomseed (lua_State *L) { - srand(luaL_check_int(L, 1)); + srand(luaL_checkint(L, 1)); return 0; } -static const struct luaL_reg mathlib[] = { -{"abs", math_abs}, -{"sin", math_sin}, -{"cos", math_cos}, -{"tan", math_tan}, -{"asin", math_asin}, -{"acos", math_acos}, -{"atan", math_atan}, -{"atan2", math_atan2}, -{"ceil", math_ceil}, -{"floor", math_floor}, -{"mod", math_mod}, -{"frexp", math_frexp}, -{"ldexp", math_ldexp}, -{"sqrt", math_sqrt}, -{"min", math_min}, -{"max", math_max}, -{"log", math_log}, -{"log10", math_log10}, -{"exp", math_exp}, -{"deg", math_deg}, -{"rad", math_rad}, -{"random", math_random}, -{"randomseed", math_randomseed} +static const luaL_reg mathlib[] = { + {"abs", math_abs}, + {"sin", math_sin}, + {"cos", math_cos}, + {"tan", math_tan}, + {"asin", math_asin}, + {"acos", math_acos}, + {"atan", math_atan}, + {"atan2", math_atan2}, + {"ceil", math_ceil}, + {"floor", math_floor}, + {"mod", math_mod}, + {"frexp", math_frexp}, + {"ldexp", math_ldexp}, + {"sqrt", math_sqrt}, + {"min", math_min}, + {"max", math_max}, + {"log", math_log}, + {"log10", math_log10}, + {"exp", math_exp}, + {"deg", math_deg}, + {"pow", math_pow}, + {"rad", math_rad}, + {"random", math_random}, + {"randomseed", math_randomseed}, + {NULL, NULL} }; + /* ** Open math library */ -LUALIB_API void lua_mathlibopen (lua_State *L) { - luaL_openl(L, mathlib); - lua_pushcfunction(L, math_pow); - lua_settagmethod(L, LUA_TNUMBER, "pow"); +LUALIB_API int luaopen_math (lua_State *L) { + luaL_openlib(L, LUA_MATHLIBNAME, mathlib, 0); + lua_pushliteral(L, "pi"); lua_pushnumber(L, PI); - lua_setglobal(L, "PI"); + lua_settable(L, -3); + lua_pushliteral(L, "__pow"); + lua_pushcfunction(L, math_pow); + lua_settable(L, LUA_GLOBALSINDEX); + return 1; } diff --git a/src/lib/loadlib.c b/src/lib/loadlib.c new file mode 100644 index 00000000..ac4d697a --- /dev/null +++ b/src/lib/loadlib.c @@ -0,0 +1,205 @@ +/* +** $Id: loadlib.c,v 1.4 2003/04/07 20:11:53 roberto Exp $ +** Dynamic library loader for Lua +** See Copyright Notice in lua.h +* +* This Lua library exports a single function, called loadlib, which is +* called from Lua as loadlib(lib,init), where lib is the full name of the +* library to be loaded (including the complete path) and init is the name +* of a function to be called after the library is loaded. Typically, this +* function will register other functions, thus making the complete library +* available to Lua. The init function is *not* automatically called by +* loadlib. Instead, loadlib returns the init function as a Lua function +* that the client can call when it thinks is appropriate. In the case of +* errors, loadlib returns nil and two strings describing the error. +* The first string is supplied by the operating system; it should be +* informative and useful for error messages. The second string is "open", +* "init", or "absent" to identify the error and is meant to be used for +* making decisions without having to look into the first string (whose +* format is system-dependent). +* +* This module contains an implementation of loadlib for Unix systems that +* have dlfcn, an implementation for Windows, and a stub for other systems. +* See the list at the end of this file for some links to available +* implementations of dlfcn and interfaces to other native dynamic loaders +* on top of which loadlib could be implemented. +* +*/ + +#include "lua.h" +#include "lauxlib.h" +#include "lualib.h" + + +#undef LOADLIB + + +#ifdef USE_DLOPEN +#define LOADLIB +/* +* This is an implementation of loadlib based on the dlfcn interface. +* The dlfcn interface is available in Linux, SunOS, Solaris, IRIX, FreeBSD, +* NetBSD, AIX 4.2, HPUX 11, and probably most other Unix flavors, at least +* as an emulation layer on top of native functions. +*/ + +#include <dlfcn.h> + +static int loadlib(lua_State *L) +{ + const char *path=luaL_checkstring(L,1); + const char *init=luaL_checkstring(L,2); + void *lib=dlopen(path,RTLD_NOW); + if (lib!=NULL) + { + lua_CFunction f=(lua_CFunction) dlsym(lib,init); + if (f!=NULL) + { + lua_pushlightuserdata(L,lib); + lua_pushcclosure(L,f,1); + return 1; + } + } + /* else return appropriate error messages */ + lua_pushnil(L); + lua_pushstring(L,dlerror()); + lua_pushstring(L,(lib!=NULL) ? "init" : "open"); + if (lib!=NULL) dlclose(lib); + return 3; +} + +#endif + + + +/* +** In Windows, default is to use dll; otherwise, default is not to use dll +*/ +#ifndef USE_DLL +#ifdef _WIN32 +#define USE_DLL 1 +#else +#define USE_DLL 0 +#endif +#endif + + +#if USE_DLL +#define LOADLIB +/* +* This is an implementation of loadlib for Windows using native functions. +*/ + +#include <windows.h> + +static void pusherror(lua_State *L) +{ + int error=GetLastError(); + char buffer[128]; + if (FormatMessage(FORMAT_MESSAGE_IGNORE_INSERTS | FORMAT_MESSAGE_FROM_SYSTEM, + 0, error, 0, buffer, sizeof(buffer), 0)) + lua_pushstring(L,buffer); + else + lua_pushfstring(L,"system error %d\n",error); +} + +static int loadlib(lua_State *L) +{ + const char *path=luaL_checkstring(L,1); + const char *init=luaL_checkstring(L,2); + HINSTANCE lib=LoadLibrary(path); + if (lib!=NULL) + { + lua_CFunction f=(lua_CFunction) GetProcAddress(lib,init); + if (f!=NULL) + { + lua_pushlightuserdata(L,lib); + lua_pushcclosure(L,f,1); + return 1; + } + } + lua_pushnil(L); + pusherror(L); + lua_pushstring(L,(lib!=NULL) ? "init" : "open"); + if (lib!=NULL) FreeLibrary(lib); + return 3; +} + +#endif + + + +#ifndef LOADLIB +/* Fallback for other systems */ + +/* +** Those systems support dlopen, so they should have defined USE_DLOPEN. +** The default (no)implementation gives them a special error message. +*/ +#ifdef linux +#define LOADLIB +#endif + +#ifdef sun +#define LOADLIB +#endif + +#ifdef sgi +#define LOADLIB +#endif + +#ifdef BSD +#define LOADLIB +#endif + +#ifdef _WIN32 +#define LOADLIB +#endif + +#ifdef LOADLIB +#undef LOADLIB +#define LOADLIB "`loadlib' not installed (check your Lua configuration)" +#else +#define LOADLIB "`loadlib' not supported" +#endif + +static int loadlib(lua_State *L) +{ + lua_pushnil(L); + lua_pushliteral(L,LOADLIB); + lua_pushliteral(L,"absent"); + return 3; +} +#endif + +LUALIB_API int luaopen_loadlib (lua_State *L) +{ + lua_register(L,"loadlib",loadlib); + return 0; +} + +/* +* Here are some links to available implementations of dlfcn and +* interfaces to other native dynamic loaders on top of which loadlib +* could be implemented. Please send contributions and corrections to us. +* +* AIX +* Starting with AIX 4.2, dlfcn is included in the base OS. +* There is also an emulation package available. +* http://www.faqs.org/faqs/aix-faq/part4/section-21.html +* +* HPUX +* HPUX 11 has dlfcn. For HPUX 10 use shl_*. +* http://www.geda.seul.org/mailinglist/geda-dev37/msg00094.html +* http://www.stat.umn.edu/~luke/xls/projects/dlbasics/dlbasics.html +* +* Macintosh, Windows +* http://www.stat.umn.edu/~luke/xls/projects/dlbasics/dlbasics.html +* +* Mac OS X/Darwin +* http://www.opendarwin.org/projects/dlcompat/ +* +* GLIB has wrapper code for BeOS, OS2, Unix and Windows +* http://cvs.gnome.org/lxr/source/glib/gmodule/ +* +*/ diff --git a/src/lib/lstrlib.c b/src/lib/lstrlib.c index 8f286982..8752e3ab 100644 --- a/src/lib/lstrlib.c +++ b/src/lib/lstrlib.c @@ -1,5 +1,5 @@ /* -** $Id: lstrlib.c,v 1.56 2000/10/27 16:15:53 roberto Exp $ +** $Id: lstrlib.c,v 1.98 2003/04/03 13:35:34 roberto Exp $ ** Standard library for string operations and pattern-matching ** See Copyright Notice in lua.h */ @@ -11,37 +11,47 @@ #include <stdlib.h> #include <string.h> +#define lstrlib_c + #include "lua.h" #include "lauxlib.h" #include "lualib.h" +/* macro to `unsign' a character */ +#ifndef uchar +#define uchar(c) ((unsigned char)(c)) +#endif + + +typedef long sint32; /* a signed version for size_t */ + static int str_len (lua_State *L) { size_t l; - luaL_check_lstr(L, 1, &l); - lua_pushnumber(L, l); + luaL_checklstring(L, 1, &l); + lua_pushnumber(L, (lua_Number)l); return 1; } -static long posrelat (long pos, size_t len) { +static sint32 posrelat (sint32 pos, size_t len) { /* relative string position: negative means back from end */ - return (pos>=0) ? pos : (long)len+pos+1; + return (pos>=0) ? pos : (sint32)len+pos+1; } static int str_sub (lua_State *L) { size_t l; - const char *s = luaL_check_lstr(L, 1, &l); - long start = posrelat(luaL_check_long(L, 2), l); - long end = posrelat(luaL_opt_long(L, 3, -1), l); + const char *s = luaL_checklstring(L, 1, &l); + sint32 start = posrelat(luaL_checklong(L, 2), l); + sint32 end = posrelat(luaL_optlong(L, 3, -1), l); if (start < 1) start = 1; - if (end > (long)l) end = l; + if (end > (sint32)l) end = (sint32)l; if (start <= end) lua_pushlstring(L, s+start-1, end-start+1); - else lua_pushstring(L, ""); + else lua_pushliteral(L, ""); return 1; } @@ -50,10 +60,10 @@ static int str_lower (lua_State *L) { size_t l; size_t i; luaL_Buffer b; - const char *s = luaL_check_lstr(L, 1, &l); + const char *s = luaL_checklstring(L, 1, &l); luaL_buffinit(L, &b); for (i=0; i<l; i++) - luaL_putchar(&b, tolower((unsigned char)(s[i]))); + luaL_putchar(&b, tolower(uchar(s[i]))); luaL_pushresult(&b); return 1; } @@ -63,10 +73,10 @@ static int str_upper (lua_State *L) { size_t l; size_t i; luaL_Buffer b; - const char *s = luaL_check_lstr(L, 1, &l); + const char *s = luaL_checklstring(L, 1, &l); luaL_buffinit(L, &b); for (i=0; i<l; i++) - luaL_putchar(&b, toupper((unsigned char)(s[i]))); + luaL_putchar(&b, toupper(uchar(s[i]))); luaL_pushresult(&b); return 1; } @@ -74,8 +84,8 @@ static int str_upper (lua_State *L) { static int str_rep (lua_State *L) { size_t l; luaL_Buffer b; - const char *s = luaL_check_lstr(L, 1, &l); - int n = luaL_check_int(L, 2); + const char *s = luaL_checklstring(L, 1, &l); + int n = luaL_checkint(L, 2); luaL_buffinit(L, &b); while (n-- > 0) luaL_addlstring(&b, s, l); @@ -86,10 +96,11 @@ static int str_rep (lua_State *L) { static int str_byte (lua_State *L) { size_t l; - const char *s = luaL_check_lstr(L, 1, &l); - long pos = posrelat(luaL_opt_long(L, 2, 1), l); - luaL_arg_check(L, 0<pos && (size_t)pos<=l, 2, "out of range"); - lua_pushnumber(L, (unsigned char)s[pos-1]); + const char *s = luaL_checklstring(L, 1, &l); + sint32 pos = posrelat(luaL_optlong(L, 2, 1), l); + if (pos <= 0 || (size_t)(pos) > l) /* index out of range? */ + return 0; /* no answer */ + lua_pushnumber(L, uchar(s[pos-1])); return 1; } @@ -100,15 +111,33 @@ static int str_char (lua_State *L) { luaL_Buffer b; luaL_buffinit(L, &b); for (i=1; i<=n; i++) { - int c = luaL_check_int(L, i); - luaL_arg_check(L, (unsigned char)c == c, i, "invalid value"); - luaL_putchar(&b, (unsigned char)c); + int c = luaL_checkint(L, i); + luaL_argcheck(L, uchar(c) == c, i, "invalid value"); + luaL_putchar(&b, uchar(c)); } luaL_pushresult(&b); return 1; } +static int writer (lua_State *L, const void* b, size_t size, void* B) { + (void)L; + luaL_addlstring((luaL_Buffer*) B, (const char *)b, size); + return 1; +} + + +static int str_dump (lua_State *L) { + luaL_Buffer b; + luaL_checktype(L, 1, LUA_TFUNCTION); + luaL_buffinit(L,&b); + if (!lua_dump(L, writer, &b)) + luaL_error(L, "unable to dump given function"); + luaL_pushresult(&b); + return 1; +} + + /* ** {====================================================== @@ -121,51 +150,61 @@ static int str_char (lua_State *L) { #endif -struct Capture { - const char *src_end; /* end ('\0') of source string */ +#define CAP_UNFINISHED (-1) +#define CAP_POSITION (-2) + +typedef struct MatchState { + const char *src_init; /* init of source string */ + const char *src_end; /* end (`\0') of source string */ + lua_State *L; int level; /* total number of captures (finished or unfinished) */ struct { const char *init; - long len; /* -1 signals unfinished capture */ + sint32 len; } capture[MAX_CAPTURES]; -}; +} MatchState; #define ESC '%' #define SPECIALS "^$*+?.([%-" -static int check_capture (lua_State *L, int l, struct Capture *cap) { +static int check_capture (MatchState *ms, int l) { l -= '1'; - if (!(0 <= l && l < cap->level && cap->capture[l].len != -1)) - lua_error(L, "invalid capture index"); + if (l < 0 || l >= ms->level || ms->capture[l].len == CAP_UNFINISHED) + return luaL_error(ms->L, "invalid capture index"); return l; } -static int capture_to_close (lua_State *L, struct Capture *cap) { - int level = cap->level; +static int capture_to_close (MatchState *ms) { + int level = ms->level; for (level--; level>=0; level--) - if (cap->capture[level].len == -1) return level; - lua_error(L, "invalid pattern capture"); - return 0; /* to avoid warnings */ + if (ms->capture[level].len == CAP_UNFINISHED) return level; + return luaL_error(ms->L, "invalid pattern capture"); } -const char *luaI_classend (lua_State *L, const char *p) { +static const char *luaI_classend (MatchState *ms, const char *p) { switch (*p++) { - case ESC: - if (*p == '\0') lua_error(L, "malformed pattern (ends with `%')"); + case ESC: { + if (*p == '\0') + luaL_error(ms->L, "malformed pattern (ends with `%')"); return p+1; - case '[': + } + case '[': { if (*p == '^') p++; - do { /* look for a ']' */ - if (*p == '\0') lua_error(L, "malformed pattern (missing `]')"); - if (*(p++) == ESC && *p != '\0') p++; /* skip escapes (e.g. '%]') */ + do { /* look for a `]' */ + if (*p == '\0') + luaL_error(ms->L, "malformed pattern (missing `]')"); + if (*(p++) == ESC && *p != '\0') + p++; /* skip escapes (e.g. `%]') */ } while (*p != ']'); return p+1; - default: + } + default: { return p; + } } } @@ -182,66 +221,59 @@ static int match_class (int c, int cl) { case 'u' : res = isupper(c); break; case 'w' : res = isalnum(c); break; case 'x' : res = isxdigit(c); break; - case 'z' : res = (c == '\0'); break; + case 'z' : res = (c == 0); break; default: return (cl == c); } return (islower(cl) ? res : !res); } - -static int matchbracketclass (int c, const char *p, const char *endclass) { +static int matchbracketclass (int c, const char *p, const char *ec) { int sig = 1; if (*(p+1) == '^') { sig = 0; - p++; /* skip the '^' */ + p++; /* skip the `^' */ } - while (++p < endclass) { + while (++p < ec) { if (*p == ESC) { p++; - if (match_class(c, (unsigned char)*p)) + if (match_class(c, *p)) return sig; } - else if ((*(p+1) == '-') && (p+2 < endclass)) { + else if ((*(p+1) == '-') && (p+2 < ec)) { p+=2; - if ((int)(unsigned char)*(p-2) <= c && c <= (int)(unsigned char)*p) + if (uchar(*(p-2)) <= c && c <= uchar(*p)) return sig; } - else if ((int)(unsigned char)*p == c) return sig; + else if (uchar(*p) == c) return sig; } return !sig; } - -int luaI_singlematch (int c, const char *p, const char *ep) { +static int luaI_singlematch (int c, const char *p, const char *ep) { switch (*p) { - case '.': /* matches any char */ - return 1; - case ESC: - return match_class(c, (unsigned char)*(p+1)); - case '[': - return matchbracketclass(c, p, ep-1); - default: - return ((unsigned char)*p == c); + case '.': return 1; /* matches any char */ + case ESC: return match_class(c, *(p+1)); + case '[': return matchbracketclass(c, p, ep-1); + default: return (uchar(*p) == c); } } -static const char *match (lua_State *L, const char *s, const char *p, - struct Capture *cap); +static const char *match (MatchState *ms, const char *s, const char *p); -static const char *matchbalance (lua_State *L, const char *s, const char *p, - struct Capture *cap) { +static const char *matchbalance (MatchState *ms, const char *s, + const char *p) { if (*p == 0 || *(p+1) == 0) - lua_error(L, "unbalanced pattern"); + luaL_error(ms->L, "unbalanced pattern"); if (*s != *p) return NULL; else { int b = *p; int e = *(p+1); int cont = 1; - while (++s < cap->src_end) { + while (++s < ms->src_end) { if (*s == e) { if (--cont == 0) return s+1; } @@ -252,14 +284,14 @@ static const char *matchbalance (lua_State *L, const char *s, const char *p, } -static const char *max_expand (lua_State *L, const char *s, const char *p, - const char *ep, struct Capture *cap) { - long i = 0; /* counts maximum expand for item */ - while ((s+i)<cap->src_end && luaI_singlematch((unsigned char)*(s+i), p, ep)) +static const char *max_expand (MatchState *ms, const char *s, + const char *p, const char *ep) { + sint32 i = 0; /* counts maximum expand for item */ + while ((s+i)<ms->src_end && luaI_singlematch(uchar(*(s+i)), p, ep)) i++; /* keeps trying to match with the maximum repetitions */ while (i>=0) { - const char *res = match(L, (s+i), ep+1, cap); + const char *res = match(ms, (s+i), ep+1); if (res) return res; i--; /* else didn't match; reduce 1 repetition to try again */ } @@ -267,100 +299,126 @@ static const char *max_expand (lua_State *L, const char *s, const char *p, } -static const char *min_expand (lua_State *L, const char *s, const char *p, - const char *ep, struct Capture *cap) { +static const char *min_expand (MatchState *ms, const char *s, + const char *p, const char *ep) { for (;;) { - const char *res = match(L, s, ep+1, cap); + const char *res = match(ms, s, ep+1); if (res != NULL) return res; - else if (s<cap->src_end && luaI_singlematch((unsigned char)*s, p, ep)) + else if (s<ms->src_end && luaI_singlematch(uchar(*s), p, ep)) s++; /* try with one more repetition */ else return NULL; } } -static const char *start_capture (lua_State *L, const char *s, const char *p, - struct Capture *cap) { +static const char *start_capture (MatchState *ms, const char *s, + const char *p, int what) { const char *res; - int level = cap->level; - if (level >= MAX_CAPTURES) lua_error(L, "too many captures"); - cap->capture[level].init = s; - cap->capture[level].len = -1; - cap->level = level+1; - if ((res=match(L, s, p+1, cap)) == NULL) /* match failed? */ - cap->level--; /* undo capture */ + int level = ms->level; + if (level >= MAX_CAPTURES) luaL_error(ms->L, "too many captures"); + ms->capture[level].init = s; + ms->capture[level].len = what; + ms->level = level+1; + if ((res=match(ms, s, p)) == NULL) /* match failed? */ + ms->level--; /* undo capture */ return res; } -static const char *end_capture (lua_State *L, const char *s, const char *p, - struct Capture *cap) { - int l = capture_to_close(L, cap); +static const char *end_capture (MatchState *ms, const char *s, + const char *p) { + int l = capture_to_close(ms); const char *res; - cap->capture[l].len = s - cap->capture[l].init; /* close capture */ - if ((res = match(L, s, p+1, cap)) == NULL) /* match failed? */ - cap->capture[l].len = -1; /* undo capture */ + ms->capture[l].len = s - ms->capture[l].init; /* close capture */ + if ((res = match(ms, s, p)) == NULL) /* match failed? */ + ms->capture[l].len = CAP_UNFINISHED; /* undo capture */ return res; } -static const char *match_capture (lua_State *L, const char *s, int level, - struct Capture *cap) { - int l = check_capture(L, level, cap); - size_t len = cap->capture[l].len; - if ((size_t)(cap->src_end-s) >= len && - memcmp(cap->capture[l].init, s, len) == 0) +static const char *match_capture (MatchState *ms, const char *s, int l) { + size_t len; + l = check_capture(ms, l); + len = ms->capture[l].len; + if ((size_t)(ms->src_end-s) >= len && + memcmp(ms->capture[l].init, s, len) == 0) return s+len; else return NULL; } -static const char *match (lua_State *L, const char *s, const char *p, - struct Capture *cap) { +static const char *match (MatchState *ms, const char *s, const char *p) { init: /* using goto's to optimize tail recursion */ switch (*p) { - case '(': /* start capture */ - return start_capture(L, s, p, cap); - case ')': /* end capture */ - return end_capture(L, s, p, cap); - case ESC: /* may be %[0-9] or %b */ - if (isdigit((unsigned char)(*(p+1)))) { /* capture? */ - s = match_capture(L, s, *(p+1), cap); - if (s == NULL) return NULL; - p+=2; goto init; /* else return match(L, s, p+2, cap) */ - } - else if (*(p+1) == 'b') { /* balanced string? */ - s = matchbalance(L, s, p+2, cap); - if (s == NULL) return NULL; - p+=4; goto init; /* else return match(L, s, p+4, cap); */ + case '(': { /* start capture */ + if (*(p+1) == ')') /* position capture? */ + return start_capture(ms, s, p+2, CAP_POSITION); + else + return start_capture(ms, s, p+1, CAP_UNFINISHED); + } + case ')': { /* end capture */ + return end_capture(ms, s, p+1); + } + case ESC: { + switch (*(p+1)) { + case 'b': { /* balanced string? */ + s = matchbalance(ms, s, p+2); + if (s == NULL) return NULL; + p+=4; goto init; /* else return match(ms, s, p+4); */ + } + case 'f': { /* frontier? */ + const char *ep; char previous; + p += 2; + if (*p != '[') + luaL_error(ms->L, "missing `[' after `%%f' in pattern"); + ep = luaI_classend(ms, p); /* points to what is next */ + previous = (s == ms->src_init) ? '\0' : *(s-1); + if (matchbracketclass(uchar(previous), p, ep-1) || + !matchbracketclass(uchar(*s), p, ep-1)) return NULL; + p=ep; goto init; /* else return match(ms, s, ep); */ + } + default: { + if (isdigit(uchar(*(p+1)))) { /* capture results (%0-%9)? */ + s = match_capture(ms, s, *(p+1)); + if (s == NULL) return NULL; + p+=2; goto init; /* else return match(ms, s, p+2) */ + } + goto dflt; /* case default */ + } } - else goto dflt; /* case default */ - case '\0': /* end of pattern */ + } + case '\0': { /* end of pattern */ return s; /* match succeeded */ - case '$': - if (*(p+1) == '\0') /* is the '$' the last char in pattern? */ - return (s == cap->src_end) ? s : NULL; /* check end of string */ + } + case '$': { + if (*(p+1) == '\0') /* is the `$' the last char in pattern? */ + return (s == ms->src_end) ? s : NULL; /* check end of string */ else goto dflt; + } default: dflt: { /* it is a pattern item */ - const char *ep = luaI_classend(L, p); /* points to what is next */ - int m = s<cap->src_end && luaI_singlematch((unsigned char)*s, p, ep); + const char *ep = luaI_classend(ms, p); /* points to what is next */ + int m = s<ms->src_end && luaI_singlematch(uchar(*s), p, ep); switch (*ep) { case '?': { /* optional */ const char *res; - if (m && ((res=match(L, s+1, ep+1, cap)) != NULL)) + if (m && ((res=match(ms, s+1, ep+1)) != NULL)) return res; - p=ep+1; goto init; /* else return match(L, s, ep+1, cap); */ + p=ep+1; goto init; /* else return match(ms, s, ep+1); */ + } + case '*': { /* 0 or more repetitions */ + return max_expand(ms, s, p, ep); + } + case '+': { /* 1 or more repetitions */ + return (m ? max_expand(ms, s+1, p, ep) : NULL); + } + case '-': { /* 0 or more repetitions (minimum) */ + return min_expand(ms, s, p, ep); } - case '*': /* 0 or more repetitions */ - return max_expand(L, s, p, ep, cap); - case '+': /* 1 or more repetitions */ - return (m ? max_expand(L, s+1, p, ep, cap) : NULL); - case '-': /* 0 or more repetitions (minimum) */ - return min_expand(L, s, p, ep, cap); - default: + default: { if (!m) return NULL; - s++; p=ep; goto init; /* else return match(L, s+1, ep, cap); */ + s++; p=ep; goto init; /* else return match(ms, s+1, ep); */ + } } } } @@ -369,7 +427,7 @@ static const char *match (lua_State *L, const char *s, const char *p, static const char *lmemfind (const char *s1, size_t l1, - const char *s2, size_t l2) { + const char *s2, size_t l2) { if (l2 == 0) return s1; /* empty strings are everywhere */ else if (l2 > l1) return NULL; /* avoids a negative `l1' */ else { @@ -390,54 +448,109 @@ static const char *lmemfind (const char *s1, size_t l1, } -static int push_captures (lua_State *L, struct Capture *cap) { +static void push_onecapture (MatchState *ms, int i) { + int l = ms->capture[i].len; + if (l == CAP_UNFINISHED) luaL_error(ms->L, "unfinished capture"); + if (l == CAP_POSITION) + lua_pushnumber(ms->L, (lua_Number)(ms->capture[i].init - ms->src_init + 1)); + else + lua_pushlstring(ms->L, ms->capture[i].init, l); +} + + +static int push_captures (MatchState *ms, const char *s, const char *e) { int i; - luaL_checkstack(L, cap->level, "too many captures"); - for (i=0; i<cap->level; i++) { - int l = cap->capture[i].len; - if (l == -1) lua_error(L, "unfinished capture"); - lua_pushlstring(L, cap->capture[i].init, l); + luaL_checkstack(ms->L, ms->level, "too many captures"); + if (ms->level == 0 && s) { /* no explicit captures? */ + lua_pushlstring(ms->L, s, e-s); /* return whole match */ + return 1; + } + else { /* return all captures */ + for (i=0; i<ms->level; i++) + push_onecapture(ms, i); + return ms->level; /* number of strings pushed */ } - return cap->level; /* number of strings pushed */ } static int str_find (lua_State *L) { size_t l1, l2; - const char *s = luaL_check_lstr(L, 1, &l1); - const char *p = luaL_check_lstr(L, 2, &l2); - long init = posrelat(luaL_opt_long(L, 3, 1), l1) - 1; - struct Capture cap; - luaL_arg_check(L, 0 <= init && (size_t)init <= l1, 3, "out of range"); - if (lua_gettop(L) > 3 || /* extra argument? */ + const char *s = luaL_checklstring(L, 1, &l1); + const char *p = luaL_checklstring(L, 2, &l2); + sint32 init = posrelat(luaL_optlong(L, 3, 1), l1) - 1; + if (init < 0) init = 0; + else if ((size_t)(init) > l1) init = (sint32)l1; + if (lua_toboolean(L, 4) || /* explicit request? */ strpbrk(p, SPECIALS) == NULL) { /* or no special characters? */ + /* do a plain search */ const char *s2 = lmemfind(s+init, l1-init, p, l2); if (s2) { - lua_pushnumber(L, s2-s+1); - lua_pushnumber(L, s2-s+l2); + lua_pushnumber(L, (lua_Number)(s2-s+1)); + lua_pushnumber(L, (lua_Number)(s2-s+l2)); return 2; } } else { + MatchState ms; int anchor = (*p == '^') ? (p++, 1) : 0; const char *s1=s+init; - cap.src_end = s+l1; + ms.L = L; + ms.src_init = s; + ms.src_end = s+l1; do { const char *res; - cap.level = 0; - if ((res=match(L, s1, p, &cap)) != NULL) { - lua_pushnumber(L, s1-s+1); /* start */ - lua_pushnumber(L, res-s); /* end */ - return push_captures(L, &cap) + 2; + ms.level = 0; + if ((res=match(&ms, s1, p)) != NULL) { + lua_pushnumber(L, (lua_Number)(s1-s+1)); /* start */ + lua_pushnumber(L, (lua_Number)(res-s)); /* end */ + return push_captures(&ms, NULL, 0) + 2; } - } while (s1++<cap.src_end && !anchor); + } while (s1++<ms.src_end && !anchor); } lua_pushnil(L); /* not found */ return 1; } -static void add_s (lua_State *L, luaL_Buffer *b, struct Capture *cap) { +static int gfind_aux (lua_State *L) { + MatchState ms; + const char *s = lua_tostring(L, lua_upvalueindex(1)); + size_t ls = lua_strlen(L, lua_upvalueindex(1)); + const char *p = lua_tostring(L, lua_upvalueindex(2)); + const char *src; + ms.L = L; + ms.src_init = s; + ms.src_end = s+ls; + for (src = s + (size_t)lua_tonumber(L, lua_upvalueindex(3)); + src <= ms.src_end; + src++) { + const char *e; + ms.level = 0; + if ((e = match(&ms, src, p)) != NULL) { + int newstart = e-s; + if (e == src) newstart++; /* empty match? go at least one position */ + lua_pushnumber(L, (lua_Number)newstart); + lua_replace(L, lua_upvalueindex(3)); + return push_captures(&ms, src, e); + } + } + return 0; /* not found */ +} + + +static int gfind (lua_State *L) { + luaL_checkstring(L, 1); + luaL_checkstring(L, 2); + lua_settop(L, 2); + lua_pushnumber(L, 0); + lua_pushcclosure(L, gfind_aux, 3); + return 1; +} + + +static void add_s (MatchState *ms, luaL_Buffer *b, + const char *s, const char *e) { + lua_State *L = ms->L; if (lua_isstring(L, 3)) { const char *news = lua_tostring(L, 3); size_t l = lua_strlen(L, 3); @@ -447,11 +560,12 @@ static void add_s (lua_State *L, luaL_Buffer *b, struct Capture *cap) { luaL_putchar(b, news[i]); else { i++; /* skip ESC */ - if (!isdigit((unsigned char)news[i])) + if (!isdigit(uchar(news[i]))) luaL_putchar(b, news[i]); else { - int level = check_capture(L, news[i], cap); - luaL_addlstring(b, cap->capture[level].init, cap->capture[level].len); + int level = check_capture(ms, news[i]); + push_onecapture(ms, level); + luaL_addvalue(b); /* add capture to accumulated result */ } } } @@ -459,8 +573,8 @@ static void add_s (lua_State *L, luaL_Buffer *b, struct Capture *cap) { else { /* is a function */ int n; lua_pushvalue(L, 3); - n = push_captures(L, cap); - lua_rawcall(L, n, 1); + n = push_captures(ms, s, e); + lua_call(L, n, 1); if (lua_isstring(L, -1)) luaL_addvalue(b); /* add return to accumulated result */ else @@ -471,124 +585,155 @@ static void add_s (lua_State *L, luaL_Buffer *b, struct Capture *cap) { static int str_gsub (lua_State *L) { size_t srcl; - const char *src = luaL_check_lstr(L, 1, &srcl); - const char *p = luaL_check_string(L, 2); - int max_s = luaL_opt_int(L, 4, srcl+1); + const char *src = luaL_checklstring(L, 1, &srcl); + const char *p = luaL_checkstring(L, 2); + int max_s = luaL_optint(L, 4, srcl+1); int anchor = (*p == '^') ? (p++, 1) : 0; int n = 0; - struct Capture cap; + MatchState ms; luaL_Buffer b; - luaL_arg_check(L, + luaL_argcheck(L, lua_gettop(L) >= 3 && (lua_isstring(L, 3) || lua_isfunction(L, 3)), 3, "string or function expected"); luaL_buffinit(L, &b); - cap.src_end = src+srcl; + ms.L = L; + ms.src_init = src; + ms.src_end = src+srcl; while (n < max_s) { const char *e; - cap.level = 0; - e = match(L, src, p, &cap); + ms.level = 0; + e = match(&ms, src, p); if (e) { n++; - add_s(L, &b, &cap); + add_s(&ms, &b, src, e); } if (e && e>src) /* non empty match? */ src = e; /* skip it */ - else if (src < cap.src_end) + else if (src < ms.src_end) luaL_putchar(&b, *src++); else break; if (anchor) break; } - luaL_addlstring(&b, src, cap.src_end-src); + luaL_addlstring(&b, src, ms.src_end-src); luaL_pushresult(&b); - lua_pushnumber(L, n); /* number of substitutions */ + lua_pushnumber(L, (lua_Number)n); /* number of substitutions */ return 2; } /* }====================================================== */ +/* maximum size of each formatted item (> len(format('%99.99f', -1e308))) */ +#define MAX_ITEM 512 +/* maximum size of each format specification (such as '%-099.99d') */ +#define MAX_FORMAT 20 + + static void luaI_addquoted (lua_State *L, luaL_Buffer *b, int arg) { size_t l; - const char *s = luaL_check_lstr(L, arg, &l); + const char *s = luaL_checklstring(L, arg, &l); luaL_putchar(b, '"'); while (l--) { switch (*s) { - case '"': case '\\': case '\n': + case '"': case '\\': case '\n': { luaL_putchar(b, '\\'); luaL_putchar(b, *s); break; - case '\0': luaL_addlstring(b, "\\000", 4); break; - default: luaL_putchar(b, *s); + } + case '\0': { + luaL_addlstring(b, "\\000", 4); + break; + } + default: { + luaL_putchar(b, *s); + break; + } } s++; } luaL_putchar(b, '"'); } -/* maximum size of each formatted item (> len(format('%99.99f', -1e308))) */ -#define MAX_ITEM 512 -/* maximum size of each format specification (such as '%-099.99d') */ -#define MAX_FORMAT 20 + +static const char *scanformat (lua_State *L, const char *strfrmt, + char *form, int *hasprecision) { + const char *p = strfrmt; + while (strchr("-+ #0", *p)) p++; /* skip flags */ + if (isdigit(uchar(*p))) p++; /* skip width */ + if (isdigit(uchar(*p))) p++; /* (2 digits at most) */ + if (*p == '.') { + p++; + *hasprecision = 1; + if (isdigit(uchar(*p))) p++; /* skip precision */ + if (isdigit(uchar(*p))) p++; /* (2 digits at most) */ + } + if (isdigit(uchar(*p))) + luaL_error(L, "invalid format (width or precision too long)"); + if (p-strfrmt+2 > MAX_FORMAT) /* +2 to include `%' and the specifier */ + luaL_error(L, "invalid format (too long)"); + form[0] = '%'; + strncpy(form+1, strfrmt, p-strfrmt+1); + form[p-strfrmt+2] = 0; + return p; +} + static int str_format (lua_State *L) { int arg = 1; - const char *strfrmt = luaL_check_string(L, arg); + size_t sfl; + const char *strfrmt = luaL_checklstring(L, arg, &sfl); + const char *strfrmt_end = strfrmt+sfl; luaL_Buffer b; luaL_buffinit(L, &b); - while (*strfrmt) { + while (strfrmt < strfrmt_end) { if (*strfrmt != '%') luaL_putchar(&b, *strfrmt++); else if (*++strfrmt == '%') luaL_putchar(&b, *strfrmt++); /* %% */ else { /* format item */ - struct Capture cap; - char form[MAX_FORMAT]; /* to store the format ('%...') */ + char form[MAX_FORMAT]; /* to store the format (`%...') */ char buff[MAX_ITEM]; /* to store the formatted item */ - const char *initf = strfrmt; - form[0] = '%'; - if (isdigit((unsigned char)*initf) && *(initf+1) == '$') { - arg = *initf - '0'; - initf += 2; /* skip the 'n$' */ - } + int hasprecision = 0; + if (isdigit(uchar(*strfrmt)) && *(strfrmt+1) == '$') + return luaL_error(L, "obsolete option (d$) to `format'"); arg++; - cap.src_end = strfrmt+strlen(strfrmt)+1; - cap.level = 0; - strfrmt = match(L, initf, "[-+ #0]*(%d*)%.?(%d*)", &cap); - if (cap.capture[0].len > 2 || cap.capture[1].len > 2 || /* < 100? */ - strfrmt-initf > MAX_FORMAT-2) - lua_error(L, "invalid format (width or precision too long)"); - strncpy(form+1, initf, strfrmt-initf+1); /* +1 to include conversion */ - form[strfrmt-initf+2] = 0; + strfrmt = scanformat(L, strfrmt, form, &hasprecision); switch (*strfrmt++) { - case 'c': case 'd': case 'i': - sprintf(buff, form, luaL_check_int(L, arg)); + case 'c': case 'd': case 'i': { + sprintf(buff, form, luaL_checkint(L, arg)); break; - case 'o': case 'u': case 'x': case 'X': - sprintf(buff, form, (unsigned int)luaL_check_number(L, arg)); + } + case 'o': case 'u': case 'x': case 'X': { + sprintf(buff, form, (unsigned int)(luaL_checknumber(L, arg))); break; - case 'e': case 'E': case 'f': case 'g': case 'G': - sprintf(buff, form, luaL_check_number(L, arg)); + } + case 'e': case 'E': case 'f': + case 'g': case 'G': { + sprintf(buff, form, luaL_checknumber(L, arg)); break; - case 'q': + } + case 'q': { luaI_addquoted(L, &b, arg); - continue; /* skip the "addsize" at the end */ + continue; /* skip the `addsize' at the end */ + } case 's': { size_t l; - const char *s = luaL_check_lstr(L, arg, &l); - if (cap.capture[1].len == 0 && l >= 100) { + const char *s = luaL_checklstring(L, arg, &l); + if (!hasprecision && l >= 100) { /* no precision and string is too long to be formatted; keep original string */ lua_pushvalue(L, arg); luaL_addvalue(&b); - continue; /* skip the "addsize" at the end */ + continue; /* skip the `addsize' at the end */ } else { sprintf(buff, form, s); break; } } - default: /* also treat cases 'pnLlh' */ - lua_error(L, "invalid option in `format'"); + default: { /* also treat cases `pnLlh' */ + return luaL_error(L, "invalid option to `format'"); + } } luaL_addlstring(&b, buff, strlen(buff)); } @@ -598,24 +743,28 @@ static int str_format (lua_State *L) { } -static const struct luaL_reg strlib[] = { -{"strlen", str_len}, -{"strsub", str_sub}, -{"strlower", str_lower}, -{"strupper", str_upper}, -{"strchar", str_char}, -{"strrep", str_rep}, -{"ascii", str_byte}, /* for compatibility with 3.0 and earlier */ -{"strbyte", str_byte}, -{"format", str_format}, -{"strfind", str_find}, -{"gsub", str_gsub} +static const luaL_reg strlib[] = { + {"len", str_len}, + {"sub", str_sub}, + {"lower", str_lower}, + {"upper", str_upper}, + {"char", str_char}, + {"rep", str_rep}, + {"byte", str_byte}, + {"format", str_format}, + {"dump", str_dump}, + {"find", str_find}, + {"gfind", gfind}, + {"gsub", str_gsub}, + {NULL, NULL} }; /* ** Open string library */ -LUALIB_API void lua_strlibopen (lua_State *L) { - luaL_openl(L, strlib); +LUALIB_API int luaopen_string (lua_State *L) { + luaL_openlib(L, LUA_STRLIBNAME, strlib, 0); + return 1; } + diff --git a/src/lib/ltablib.c b/src/lib/ltablib.c new file mode 100644 index 00000000..c9bb2d1b --- /dev/null +++ b/src/lib/ltablib.c @@ -0,0 +1,250 @@ +/* +** $Id: ltablib.c,v 1.21 2003/04/03 13:35:34 roberto Exp $ +** Library for Table Manipulation +** See Copyright Notice in lua.h +*/ + + +#include <stddef.h> + +#define ltablib_c + +#include "lua.h" + +#include "lauxlib.h" +#include "lualib.h" + + +#define aux_getn(L,n) (luaL_checktype(L, n, LUA_TTABLE), luaL_getn(L, n)) + + +static int luaB_foreachi (lua_State *L) { + int i; + int n = aux_getn(L, 1); + luaL_checktype(L, 2, LUA_TFUNCTION); + for (i=1; i<=n; i++) { + lua_pushvalue(L, 2); /* function */ + lua_pushnumber(L, (lua_Number)i); /* 1st argument */ + lua_rawgeti(L, 1, i); /* 2nd argument */ + lua_call(L, 2, 1); + if (!lua_isnil(L, -1)) + return 1; + lua_pop(L, 1); /* remove nil result */ + } + return 0; +} + + +static int luaB_foreach (lua_State *L) { + luaL_checktype(L, 1, LUA_TTABLE); + luaL_checktype(L, 2, LUA_TFUNCTION); + lua_pushnil(L); /* first key */ + for (;;) { + if (lua_next(L, 1) == 0) + return 0; + lua_pushvalue(L, 2); /* function */ + lua_pushvalue(L, -3); /* key */ + lua_pushvalue(L, -3); /* value */ + lua_call(L, 2, 1); + if (!lua_isnil(L, -1)) + return 1; + lua_pop(L, 2); /* remove value and result */ + } +} + + +static int luaB_getn (lua_State *L) { + lua_pushnumber(L, (lua_Number)aux_getn(L, 1)); + return 1; +} + + +static int luaB_setn (lua_State *L) { + luaL_checktype(L, 1, LUA_TTABLE); + luaL_setn(L, 1, luaL_checkint(L, 2)); + return 0; +} + + +static int luaB_tinsert (lua_State *L) { + int v = lua_gettop(L); /* number of arguments */ + int n = aux_getn(L, 1) + 1; + int pos; /* where to insert new element */ + if (v == 2) /* called with only 2 arguments */ + pos = n; /* insert new element at the end */ + else { + pos = luaL_checkint(L, 2); /* 2nd argument is the position */ + if (pos > n) n = pos; /* `grow' array if necessary */ + v = 3; /* function may be called with more than 3 args */ + } + luaL_setn(L, 1, n); /* new size */ + while (--n >= pos) { /* move up elements */ + lua_rawgeti(L, 1, n); + lua_rawseti(L, 1, n+1); /* t[n+1] = t[n] */ + } + lua_pushvalue(L, v); + lua_rawseti(L, 1, pos); /* t[pos] = v */ + return 0; +} + + +static int luaB_tremove (lua_State *L) { + int n = aux_getn(L, 1); + int pos = luaL_optint(L, 2, n); + if (n <= 0) return 0; /* table is `empty' */ + luaL_setn(L, 1, n-1); /* t.n = n-1 */ + lua_rawgeti(L, 1, pos); /* result = t[pos] */ + for ( ;pos<n; pos++) { + lua_rawgeti(L, 1, pos+1); + lua_rawseti(L, 1, pos); /* t[pos] = t[pos+1] */ + } + lua_pushnil(L); + lua_rawseti(L, 1, n); /* t[n] = nil */ + return 1; +} + + +static int str_concat (lua_State *L) { + luaL_Buffer b; + size_t lsep; + const char *sep = luaL_optlstring(L, 2, "", &lsep); + int i = luaL_optint(L, 3, 1); + int n = luaL_optint(L, 4, 0); + luaL_checktype(L, 1, LUA_TTABLE); + if (n == 0) n = luaL_getn(L, 1); + luaL_buffinit(L, &b); + for (; i <= n; i++) { + lua_rawgeti(L, 1, i); + luaL_argcheck(L, lua_isstring(L, -1), 1, "table contains non-strings"); + luaL_addvalue(&b); + if (i != n) + luaL_addlstring(&b, sep, lsep); + } + luaL_pushresult(&b); + return 1; +} + + + +/* +** {====================================================== +** Quicksort +** (based on `Algorithms in MODULA-3', Robert Sedgewick; +** Addison-Wesley, 1993.) +*/ + + +static void set2 (lua_State *L, int i, int j) { + lua_rawseti(L, 1, i); + lua_rawseti(L, 1, j); +} + +static int sort_comp (lua_State *L, int a, int b) { + if (!lua_isnil(L, 2)) { /* function? */ + int res; + lua_pushvalue(L, 2); + lua_pushvalue(L, a-1); /* -1 to compensate function */ + lua_pushvalue(L, b-2); /* -2 to compensate function and `a' */ + lua_call(L, 2, 1); + res = lua_toboolean(L, -1); + lua_pop(L, 1); + return res; + } + else /* a < b? */ + return lua_lessthan(L, a, b); +} + +static void auxsort (lua_State *L, int l, int u) { + while (l < u) { /* for tail recursion */ + int i, j; + /* sort elements a[l], a[(l+u)/2] and a[u] */ + lua_rawgeti(L, 1, l); + lua_rawgeti(L, 1, u); + if (sort_comp(L, -1, -2)) /* a[u] < a[l]? */ + set2(L, l, u); /* swap a[l] - a[u] */ + else + lua_pop(L, 2); + if (u-l == 1) break; /* only 2 elements */ + i = (l+u)/2; + lua_rawgeti(L, 1, i); + lua_rawgeti(L, 1, l); + if (sort_comp(L, -2, -1)) /* a[i]<a[l]? */ + set2(L, i, l); + else { + lua_pop(L, 1); /* remove a[l] */ + lua_rawgeti(L, 1, u); + if (sort_comp(L, -1, -2)) /* a[u]<a[i]? */ + set2(L, i, u); + else + lua_pop(L, 2); + } + if (u-l == 2) break; /* only 3 elements */ + lua_rawgeti(L, 1, i); /* Pivot */ + lua_pushvalue(L, -1); + lua_rawgeti(L, 1, u-1); + set2(L, i, u-1); + /* a[l] <= P == a[u-1] <= a[u], only need to sort from l+1 to u-2 */ + i = l; j = u-1; + for (;;) { /* invariant: a[l..i] <= P <= a[j..u] */ + /* repeat ++i until a[i] >= P */ + while (lua_rawgeti(L, 1, ++i), sort_comp(L, -1, -2)) { + if (i>u) luaL_error(L, "invalid order function for sorting"); + lua_pop(L, 1); /* remove a[i] */ + } + /* repeat --j until a[j] <= P */ + while (lua_rawgeti(L, 1, --j), sort_comp(L, -3, -1)) { + if (j<l) luaL_error(L, "invalid order function for sorting"); + lua_pop(L, 1); /* remove a[j] */ + } + if (j<i) { + lua_pop(L, 3); /* pop pivot, a[i], a[j] */ + break; + } + set2(L, i, j); + } + lua_rawgeti(L, 1, u-1); + lua_rawgeti(L, 1, i); + set2(L, u-1, i); /* swap pivot (a[u-1]) with a[i] */ + /* a[l..i-1] <= a[i] == P <= a[i+1..u] */ + /* adjust so that smaller half is in [j..i] and larger one in [l..u] */ + if (i-l < u-i) { + j=l; i=i-1; l=i+2; + } + else { + j=i+1; i=u; u=j-2; + } + auxsort(L, j, i); /* call recursively the smaller one */ + } /* repeat the routine for the larger one */ +} + +static int luaB_sort (lua_State *L) { + int n = aux_getn(L, 1); + luaL_checkstack(L, 40, ""); /* assume array is smaller than 2^40 */ + if (!lua_isnoneornil(L, 2)) /* is there a 2nd argument? */ + luaL_checktype(L, 2, LUA_TFUNCTION); + lua_settop(L, 2); /* make sure there is two arguments */ + auxsort(L, 1, n); + return 0; +} + +/* }====================================================== */ + + +static const luaL_reg tab_funcs[] = { + {"concat", str_concat}, + {"foreach", luaB_foreach}, + {"foreachi", luaB_foreachi}, + {"getn", luaB_getn}, + {"setn", luaB_setn}, + {"sort", luaB_sort}, + {"insert", luaB_tinsert}, + {"remove", luaB_tremove}, + {NULL, NULL} +}; + + +LUALIB_API int luaopen_table (lua_State *L) { + luaL_openlib(L, LUA_TABLIBNAME, tab_funcs, 0); + return 1; +} + @@ -1,24 +1,23 @@ /* -** $Id: llex.c,v 1.72 2000/10/20 16:39:03 roberto Exp $ +** $Id: llex.c,v 1.119 2003/03/24 12:39:34 roberto Exp $ ** Lexical Analyzer ** See Copyright Notice in lua.h */ #include <ctype.h> -#include <stdio.h> #include <string.h> +#define llex_c + #include "lua.h" +#include "ldo.h" #include "llex.h" -#include "lmem.h" #include "lobject.h" #include "lparser.h" #include "lstate.h" #include "lstring.h" -#include "ltable.h" -#include "luadebug.h" #include "lzio.h" @@ -29,16 +28,22 @@ /* ORDER RESERVED */ static const char *const token2string [] = { - "and", "break", "do", "else", "elseif", "end", "for", - "function", "if", "local", "nil", "not", "or", "repeat", "return", "then", - "until", "while", "", "..", "...", "==", ">=", "<=", "~=", "", "", "<eof>"}; + "and", "break", "do", "else", "elseif", + "end", "false", "for", "function", "if", + "in", "local", "nil", "not", "or", "repeat", + "return", "then", "true", "until", "while", "*name", + "..", "...", "==", ">=", "<=", "~=", + "*number", "*string", "<eof>" +}; void luaX_init (lua_State *L) { int i; for (i=0; i<NUM_RESERVED; i++) { TString *ts = luaS_new(L, token2string[i]); - ts->marked = (unsigned char)(RESERVEDMARK+i); /* reserved word */ + luaS_fix(ts); /* reserved words are never collected */ + lua_assert(strlen(token2string[i])+1 <= TOKEN_LEN); + ts->tsv.reserved = cast(lu_byte, i+1); /* reserved word */ } } @@ -48,50 +53,64 @@ void luaX_init (lua_State *L) { void luaX_checklimit (LexState *ls, int val, int limit, const char *msg) { if (val > limit) { - char buff[100]; - sprintf(buff, "too many %.50s (limit=%d)", msg, limit); - luaX_error(ls, buff, ls->t.token); + msg = luaO_pushfstring(ls->L, "too many %s (limit=%d)", msg, limit); + luaX_syntaxerror(ls, msg); } } -void luaX_syntaxerror (LexState *ls, const char *s, const char *token) { +void luaX_errorline (LexState *ls, const char *s, const char *token, int line) { + lua_State *L = ls->L; char buff[MAXSRC]; - luaO_chunkid(buff, ls->source->str, sizeof(buff)); - luaO_verror(ls->L, "%.99s;\n last token read: `%.30s' at line %d in %.80s", - s, token, ls->linenumber, buff); + luaO_chunkid(buff, getstr(ls->source), MAXSRC); + luaO_pushfstring(L, "%s:%d: %s near `%s'", buff, line, s, token); + luaD_throw(L, LUA_ERRSYNTAX); } -void luaX_error (LexState *ls, const char *s, int token) { - char buff[TOKEN_LEN]; - luaX_token2str(token, buff); - if (buff[0] == '\0') - luaX_syntaxerror(ls, s, ls->L->Mbuffer); - else - luaX_syntaxerror(ls, s, buff); +static void luaX_error (LexState *ls, const char *s, const char *token) { + luaX_errorline(ls, s, token, ls->linenumber); +} + + +void luaX_syntaxerror (LexState *ls, const char *msg) { + const char *lasttoken; + switch (ls->t.token) { + case TK_NAME: + lasttoken = getstr(ls->t.seminfo.ts); + break; + case TK_STRING: + case TK_NUMBER: + lasttoken = luaZ_buffer(ls->buff); + break; + default: + lasttoken = luaX_token2str(ls, ls->t.token); + break; + } + luaX_error(ls, msg, lasttoken); } -void luaX_token2str (int token, char *s) { - if (token < 256) { - s[0] = (char)token; - s[1] = '\0'; +const char *luaX_token2str (LexState *ls, int token) { + if (token < FIRST_RESERVED) { + lua_assert(token == (unsigned char)token); + return luaO_pushfstring(ls->L, "%c", token); } else - strcpy(s, token2string[token-FIRST_RESERVED]); + return token2string[token-FIRST_RESERVED]; } -static void luaX_invalidchar (LexState *ls, int c) { - char buff[8]; - sprintf(buff, "0x%02X", c); - luaX_syntaxerror(ls, "invalid control char", buff); +static void luaX_lexerror (LexState *ls, const char *s, int token) { + if (token == TK_EOS) + luaX_error(ls, s, luaX_token2str(ls, token)); + else + luaX_error(ls, s, luaZ_buffer(ls->buff)); } static void inclinenumber (LexState *LS) { - next(LS); /* skip '\n' */ + next(LS); /* skip `\n' */ ++LS->linenumber; luaX_checklimit(LS, LS->linenumber, MAX_INT, "lines in a chunk"); } @@ -122,159 +141,173 @@ void luaX_setinput (lua_State *L, LexState *LS, ZIO *z, TString *source) { */ -/* use Mbuffer to store names, literal strings and numbers */ +/* use buffer to store names, literal strings and numbers */ + +/* extra space to allocate when growing buffer */ +#define EXTRABUFF 32 + +/* maximum number of chars that can be read without checking buffer size */ +#define MAXNOCHECK 5 -#define EXTRABUFF 128 -#define checkbuffer(L, n, len) if ((len)+(n) > L->Mbuffsize) \ - luaO_openspace(L, (len)+(n)+EXTRABUFF) +#define checkbuffer(LS, len) \ + if (((len)+MAXNOCHECK)*sizeof(char) > luaZ_sizebuffer((LS)->buff)) \ + luaZ_openspace((LS)->L, (LS)->buff, (len)+EXTRABUFF) -#define save(L, c, l) (L->Mbuffer[l++] = (char)c) -#define save_and_next(L, LS, l) (save(L, LS->current, l), next(LS)) +#define save(LS, c, l) \ + (luaZ_buffer((LS)->buff)[l++] = cast(char, c)) +#define save_and_next(LS, l) (save(LS, LS->current, l), next(LS)) -static const char *readname (LexState *LS) { - lua_State *L = LS->L; +static size_t readname (LexState *LS) { size_t l = 0; - checkbuffer(L, 10, l); + checkbuffer(LS, l); do { - checkbuffer(L, 10, l); - save_and_next(L, LS, l); + checkbuffer(LS, l); + save_and_next(LS, l); } while (isalnum(LS->current) || LS->current == '_'); - save(L, '\0', l); - return L->Mbuffer; + save(LS, '\0', l); + return l-1; } /* LUA_NUMBER */ -static void read_number (LexState *LS, int comma, SemInfo *seminfo) { - lua_State *L = LS->L; +static void read_numeral (LexState *LS, int comma, SemInfo *seminfo) { size_t l = 0; - checkbuffer(L, 10, l); - if (comma) save(L, '.', l); + checkbuffer(LS, l); + if (comma) save(LS, '.', l); while (isdigit(LS->current)) { - checkbuffer(L, 10, l); - save_and_next(L, LS, l); + checkbuffer(LS, l); + save_and_next(LS, l); } if (LS->current == '.') { - save_and_next(L, LS, l); + save_and_next(LS, l); if (LS->current == '.') { - save_and_next(L, LS, l); - save(L, '\0', l); - luaX_error(LS, "ambiguous syntax" - " (decimal point x string concatenation)", TK_NUMBER); + save_and_next(LS, l); + save(LS, '\0', l); + luaX_lexerror(LS, + "ambiguous syntax (decimal point x string concatenation)", + TK_NUMBER); } } while (isdigit(LS->current)) { - checkbuffer(L, 10, l); - save_and_next(L, LS, l); + checkbuffer(LS, l); + save_and_next(LS, l); } if (LS->current == 'e' || LS->current == 'E') { - save_and_next(L, LS, l); /* read 'E' */ + save_and_next(LS, l); /* read `E' */ if (LS->current == '+' || LS->current == '-') - save_and_next(L, LS, l); /* optional exponent sign */ + save_and_next(LS, l); /* optional exponent sign */ while (isdigit(LS->current)) { - checkbuffer(L, 10, l); - save_and_next(L, LS, l); + checkbuffer(LS, l); + save_and_next(LS, l); } } - save(L, '\0', l); - if (!luaO_str2d(L->Mbuffer, &seminfo->r)) - luaX_error(LS, "malformed number", TK_NUMBER); + save(LS, '\0', l); + if (!luaO_str2d(luaZ_buffer(LS->buff), &seminfo->r)) + luaX_lexerror(LS, "malformed number", TK_NUMBER); } static void read_long_string (LexState *LS, SemInfo *seminfo) { - lua_State *L = LS->L; int cont = 0; size_t l = 0; - checkbuffer(L, 10, l); - save(L, '[', l); /* save first '[' */ - save_and_next(L, LS, l); /* pass the second '[' */ + checkbuffer(LS, l); + save(LS, '[', l); /* save first `[' */ + save_and_next(LS, l); /* pass the second `[' */ + if (LS->current == '\n') /* string starts with a newline? */ + inclinenumber(LS); /* skip it */ for (;;) { - checkbuffer(L, 10, l); + checkbuffer(LS, l); switch (LS->current) { case EOZ: - save(L, '\0', l); - luaX_error(LS, "unfinished long string", TK_STRING); + save(LS, '\0', l); + luaX_lexerror(LS, (seminfo) ? "unfinished long string" : + "unfinished long comment", TK_EOS); break; /* to avoid warnings */ case '[': - save_and_next(L, LS, l); + save_and_next(LS, l); if (LS->current == '[') { cont++; - save_and_next(L, LS, l); + save_and_next(LS, l); } continue; case ']': - save_and_next(L, LS, l); + save_and_next(LS, l); if (LS->current == ']') { if (cont == 0) goto endloop; cont--; - save_and_next(L, LS, l); + save_and_next(LS, l); } continue; case '\n': - save(L, '\n', l); + save(LS, '\n', l); inclinenumber(LS); + if (!seminfo) l = 0; /* reset buffer to avoid wasting space */ continue; default: - save_and_next(L, LS, l); + save_and_next(LS, l); } } endloop: - save_and_next(L, LS, l); /* skip the second ']' */ - save(L, '\0', l); - seminfo->ts = luaS_newlstr(L, L->Mbuffer+2, l-5); + save_and_next(LS, l); /* skip the second `]' */ + save(LS, '\0', l); + if (seminfo) + seminfo->ts = luaS_newlstr(LS->L, luaZ_buffer(LS->buff) + 2, l - 5); } static void read_string (LexState *LS, int del, SemInfo *seminfo) { - lua_State *L = LS->L; size_t l = 0; - checkbuffer(L, 10, l); - save_and_next(L, LS, l); + checkbuffer(LS, l); + save_and_next(LS, l); while (LS->current != del) { - checkbuffer(L, 10, l); + checkbuffer(LS, l); switch (LS->current) { - case EOZ: case '\n': - save(L, '\0', l); - luaX_error(LS, "unfinished string", TK_STRING); + case EOZ: + save(LS, '\0', l); + luaX_lexerror(LS, "unfinished string", TK_EOS); + break; /* to avoid warnings */ + case '\n': + save(LS, '\0', l); + luaX_lexerror(LS, "unfinished string", TK_STRING); break; /* to avoid warnings */ case '\\': - next(LS); /* do not save the '\' */ + next(LS); /* do not save the `\' */ switch (LS->current) { - case 'a': save(L, '\a', l); next(LS); break; - case 'b': save(L, '\b', l); next(LS); break; - case 'f': save(L, '\f', l); next(LS); break; - case 'n': save(L, '\n', l); next(LS); break; - case 'r': save(L, '\r', l); next(LS); break; - case 't': save(L, '\t', l); next(LS); break; - case 'v': save(L, '\v', l); next(LS); break; - case '\n': save(L, '\n', l); inclinenumber(LS); break; - case '0': case '1': case '2': case '3': case '4': - case '5': case '6': case '7': case '8': case '9': { - int c = 0; - int i = 0; - do { - c = 10*c + (LS->current-'0'); - next(LS); - } while (++i<3 && isdigit(LS->current)); - if (c != (unsigned char)c) { - save(L, '\0', l); - luaX_error(LS, "escape sequence too large", TK_STRING); + case 'a': save(LS, '\a', l); next(LS); break; + case 'b': save(LS, '\b', l); next(LS); break; + case 'f': save(LS, '\f', l); next(LS); break; + case 'n': save(LS, '\n', l); next(LS); break; + case 'r': save(LS, '\r', l); next(LS); break; + case 't': save(LS, '\t', l); next(LS); break; + case 'v': save(LS, '\v', l); next(LS); break; + case '\n': save(LS, '\n', l); inclinenumber(LS); break; + case EOZ: break; /* will raise an error next loop */ + default: { + if (!isdigit(LS->current)) + save_and_next(LS, l); /* handles \\, \", \', and \? */ + else { /* \xxx */ + int c = 0; + int i = 0; + do { + c = 10*c + (LS->current-'0'); + next(LS); + } while (++i<3 && isdigit(LS->current)); + if (c > UCHAR_MAX) { + save(LS, '\0', l); + luaX_lexerror(LS, "escape sequence too large", TK_STRING); + } + save(LS, c, l); } - save(L, c, l); - break; } - default: /* handles \\, \", \', and \? */ - save_and_next(L, LS, l); } break; default: - save_and_next(L, LS, l); + save_and_next(LS, l); } } - save_and_next(L, LS, l); /* skip delimiter */ - save(L, '\0', l); - seminfo->ts = luaS_newlstr(L, L->Mbuffer+1, l-3); + save_and_next(LS, l); /* skip delimiter */ + save(LS, '\0', l); + seminfo->ts = luaS_newlstr(LS->L, luaZ_buffer(LS->buff) + 1, l - 3); } @@ -282,58 +315,56 @@ int luaX_lex (LexState *LS, SemInfo *seminfo) { for (;;) { switch (LS->current) { - case ' ': case '\t': case '\r': /* `\r' to avoid problems with DOS */ - next(LS); - continue; - - case '\n': + case '\n': { inclinenumber(LS); continue; - - case '$': - luaX_error(LS, "unexpected `$' (pragmas are no longer supported)", '$'); - break; - - case '-': + } + case '-': { next(LS); if (LS->current != '-') return '-'; - do { next(LS); } while (LS->current != '\n' && LS->current != EOZ); + /* else is a comment */ + next(LS); + if (LS->current == '[' && (next(LS), LS->current == '[')) + read_long_string(LS, NULL); /* long comment */ + else /* short comment */ + while (LS->current != '\n' && LS->current != EOZ) + next(LS); continue; - - case '[': + } + case '[': { next(LS); if (LS->current != '[') return '['; else { read_long_string(LS, seminfo); return TK_STRING; } - - case '=': + } + case '=': { next(LS); if (LS->current != '=') return '='; else { next(LS); return TK_EQ; } - - case '<': + } + case '<': { next(LS); if (LS->current != '=') return '<'; else { next(LS); return TK_LE; } - - case '>': + } + case '>': { next(LS); if (LS->current != '=') return '>'; else { next(LS); return TK_GE; } - - case '~': + } + case '~': { next(LS); if (LS->current != '=') return '~'; else { next(LS); return TK_NE; } - + } case '"': - case '\'': + case '\'': { read_string(LS, LS->current, seminfo); return TK_STRING; - - case '.': + } + case '.': { next(LS); if (LS->current == '.') { next(LS); @@ -345,36 +376,42 @@ int luaX_lex (LexState *LS, SemInfo *seminfo) { } else if (!isdigit(LS->current)) return '.'; else { - read_number(LS, 1, seminfo); + read_numeral(LS, 1, seminfo); return TK_NUMBER; } - - case '0': case '1': case '2': case '3': case '4': - case '5': case '6': case '7': case '8': case '9': - read_number(LS, 0, seminfo); - return TK_NUMBER; - - case EOZ: + } + case EOZ: { return TK_EOS; - - case '_': goto tname; - - default: - if (!isalpha(LS->current)) { - int c = LS->current; - if (iscntrl(c)) - luaX_invalidchar(LS, c); + } + default: { + if (isspace(LS->current)) { next(LS); - return c; + continue; + } + else if (isdigit(LS->current)) { + read_numeral(LS, 0, seminfo); + return TK_NUMBER; } - tname: { /* identifier or reserved word */ - TString *ts = luaS_new(LS->L, readname(LS)); - if (ts->marked >= RESERVEDMARK) /* reserved word? */ - return ts->marked-RESERVEDMARK+FIRST_RESERVED; + else if (isalpha(LS->current) || LS->current == '_') { + /* identifier or reserved word */ + size_t l = readname(LS); + TString *ts = luaS_newlstr(LS->L, luaZ_buffer(LS->buff), l); + if (ts->tsv.reserved > 0) /* reserved word? */ + return ts->tsv.reserved - 1 + FIRST_RESERVED; seminfo->ts = ts; return TK_NAME; } + else { + int c = LS->current; + if (iscntrl(c)) + luaX_error(LS, "invalid control char", + luaO_pushfstring(LS->L, "char(%d)", c)); + next(LS); + return c; /* single-char tokens (+ - / ...) */ + } + } } } } +#undef next @@ -1,5 +1,5 @@ /* -** $Id: llex.h,v 1.31 2000/09/27 17:41:58 roberto Exp $ +** $Id: llex.h,v 1.47 2003/02/28 17:19:47 roberto Exp $ ** Lexical Analyzer ** See Copyright Notice in lua.h */ @@ -13,8 +13,8 @@ #define FIRST_RESERVED 257 -/* maximum length of a reserved word (+1 for final 0) */ -#define TOKEN_LEN 15 +/* maximum length of a reserved word */ +#define TOKEN_LEN (sizeof("function")/sizeof(char)) /* @@ -24,19 +24,20 @@ enum RESERVED { /* terminal symbols denoted by reserved words */ TK_AND = FIRST_RESERVED, TK_BREAK, - TK_DO, TK_ELSE, TK_ELSEIF, TK_END, TK_FOR, TK_FUNCTION, TK_IF, TK_LOCAL, - TK_NIL, TK_NOT, TK_OR, TK_REPEAT, TK_RETURN, TK_THEN, TK_UNTIL, TK_WHILE, + TK_DO, TK_ELSE, TK_ELSEIF, TK_END, TK_FALSE, TK_FOR, TK_FUNCTION, + TK_IF, TK_IN, TK_LOCAL, TK_NIL, TK_NOT, TK_OR, TK_REPEAT, + TK_RETURN, TK_THEN, TK_TRUE, TK_UNTIL, TK_WHILE, /* other terminal symbols */ TK_NAME, TK_CONCAT, TK_DOTS, TK_EQ, TK_GE, TK_LE, TK_NE, TK_NUMBER, TK_STRING, TK_EOS }; /* number of reserved words */ -#define NUM_RESERVED ((int)(TK_WHILE-FIRST_RESERVED+1)) +#define NUM_RESERVED (cast(int, TK_WHILE-FIRST_RESERVED+1)) typedef union { - Number r; + lua_Number r; TString *ts; } SemInfo; /* semantics information */ @@ -48,15 +49,17 @@ typedef struct Token { typedef struct LexState { - int current; /* current character */ + int current; /* current character (charint) */ + int linenumber; /* input line counter */ + int lastline; /* line of last token `consumed' */ Token t; /* current token */ Token lookahead; /* look ahead token */ struct FuncState *fs; /* `FuncState' is private to the parser */ struct lua_State *L; - struct zio *z; /* input stream */ - int linenumber; /* input line counter */ - int lastline; /* line of last token `consumed' */ + ZIO *z; /* input stream */ + Mbuffer *buff; /* buffer for tokens */ TString *source; /* current source name */ + int nestlevel; /* level of nested non-terminals */ } LexState; @@ -64,9 +67,9 @@ void luaX_init (lua_State *L); void luaX_setinput (lua_State *L, LexState *LS, ZIO *z, TString *source); int luaX_lex (LexState *LS, SemInfo *seminfo); void luaX_checklimit (LexState *ls, int val, int limit, const char *msg); -void luaX_syntaxerror (LexState *ls, const char *s, const char *token); -void luaX_error (LexState *ls, const char *s, int token); -void luaX_token2str (int token, char *s); +void luaX_syntaxerror (LexState *ls, const char *s); +void luaX_errorline (LexState *ls, const char *s, const char *token, int line); +const char *luaX_token2str (LexState *ls, int token); #endif diff --git a/src/llimits.h b/src/llimits.h index b3f5de47..343c9226 100644 --- a/src/llimits.h +++ b/src/llimits.h @@ -1,6 +1,6 @@ /* -** $Id: llimits.h,v 1.19 2000/10/26 12:47:05 roberto Exp $ -** Limits, basic types, and some other "installation-dependent" definitions +** $Id: llimits.h,v 1.52 2003/02/20 19:33:23 roberto Exp $ +** Limits, basic types, and some other `installation-dependent' definitions ** See Copyright Notice in lua.h */ @@ -12,6 +12,8 @@ #include <stddef.h> +#include "lua.h" + /* ** try to find number of bits in an integer @@ -32,25 +34,29 @@ /* -** Define the type `number' of Lua -** GREP LUA_NUMBER to change that +** the following types define integer types for values that may not +** fit in a `small int' (16 bits), but may waste space in a +** `large long' (64 bits). The current definitions should work in +** any machine, but may not be optimal. */ -#ifndef LUA_NUM_TYPE -#define LUA_NUM_TYPE double -#endif -typedef LUA_NUM_TYPE Number; +/* an unsigned integer to hold hash values */ +typedef unsigned int lu_hash; +/* its signed equivalent */ +typedef int ls_hash; -/* function to convert a Number to a string */ -#define NUMBER_FMT "%.16g" /* LUA_NUMBER */ -#define lua_number2str(s,n) sprintf((s), NUMBER_FMT, (n)) +/* an unsigned integer big enough to count the total memory used by Lua; */ +/* it should be at least as large as size_t */ +typedef unsigned long lu_mem; -/* function to convert a string to a Number */ -#define lua_str2number(s,p) strtod((s), (p)) +#define MAX_LUMEM ULONG_MAX +/* an integer big enough to count the number of strings in use */ +typedef long ls_nstr; -typedef unsigned long lint32; /* unsigned int with at least 32 bits */ +/* chars used as small naturals (so that `char' is reserved for characters) */ +typedef unsigned char lu_byte; #define MAX_SIZET ((size_t)(~(size_t)0)-2) @@ -59,117 +65,93 @@ typedef unsigned long lint32; /* unsigned int with at least 32 bits */ #define MAX_INT (INT_MAX-2) /* maximum value of an int (-2 for safety) */ /* -** conversion of pointer to int (for hashing only) -** (the shift removes bits that are usually 0 because of alignment) +** conversion of pointer to integer +** this is for hashing only; there is no problem if the integer +** cannot hold the whole pointer value */ -#define IntPoint(p) (((unsigned long)(p)) >> 3) +#define IntPoint(p) ((lu_hash)(p)) + +/* type to ensure maximum alignment */ +#ifndef LUSER_ALIGNMENT_T +typedef union { double u; void *s; long l; } L_Umaxalign; +#else +typedef LUSER_ALIGNMENT_T L_Umaxalign; +#endif -#define MINPOWER2 4 /* minimum size for "growing" vectors */ +/* result of `usual argument conversion' over lua_Number */ +#ifndef LUA_UACNUMBER +typedef double l_uacNumber; +#else +typedef LUA_UACNUMBER l_uacNumber; +#endif -#ifndef DEFAULT_STACK_SIZE -#define DEFAULT_STACK_SIZE 1024 +#ifndef lua_assert +#define lua_assert(c) /* empty */ #endif +#ifndef check_exp +#define check_exp(c,e) (e) +#endif -/* type to ensure maximum alignment */ -union L_Umaxalign { double d; char *s; long l; }; + +#ifndef UNUSED +#define UNUSED(x) ((void)(x)) /* to avoid warnings */ +#endif + + +#ifndef cast +#define cast(t, exp) ((t)(exp)) +#endif /* ** type for virtual-machine instructions ** must be an unsigned with (at least) 4 bytes (see details in lopcodes.h) -** For a very small machine, you may change that to 2 bytes (and adjust -** the following limits accordingly) */ typedef unsigned long Instruction; -/* -** size and position of opcode arguments. -** For an instruction with 2 bytes, size is 16, and size_b can be 5 -** (accordingly, size_u will be 10, and size_a will be 5) -*/ -#define SIZE_INSTRUCTION 32 -#define SIZE_B 9 - -#define SIZE_OP 6 -#define SIZE_U (SIZE_INSTRUCTION-SIZE_OP) -#define POS_U SIZE_OP -#define POS_B SIZE_OP -#define SIZE_A (SIZE_INSTRUCTION-(SIZE_OP+SIZE_B)) -#define POS_A (SIZE_OP+SIZE_B) +/* maximum depth for calls (unsigned short) */ +#ifndef LUA_MAXCALLS +#define LUA_MAXCALLS 4096 +#endif /* -** limits for opcode arguments. -** we use (signed) int to manipulate most arguments, -** so they must fit in BITS_INT-1 bits (-1 for sign) +** maximum depth for C calls (unsigned short): Not too big, or may +** overflow the C stack... */ -#if SIZE_U < BITS_INT-1 -#define MAXARG_U ((1<<SIZE_U)-1) -#define MAXARG_S (MAXARG_U>>1) /* `S' is signed */ -#else -#define MAXARG_U MAX_INT -#define MAXARG_S MAX_INT -#endif -#if SIZE_A < BITS_INT-1 -#define MAXARG_A ((1<<SIZE_A)-1) -#else -#define MAXARG_A MAX_INT +#ifndef LUA_MAXCCALLS +#define LUA_MAXCCALLS 200 #endif -#if SIZE_B < BITS_INT-1 -#define MAXARG_B ((1<<SIZE_B)-1) -#else -#define MAXARG_B MAX_INT + +/* maximum size for the C stack */ +#ifndef LUA_MAXCSTACK +#define LUA_MAXCSTACK 2048 #endif -/* maximum stack size in a function */ -#ifndef MAXSTACK +/* maximum stack for a Lua function */ #define MAXSTACK 250 -#endif - -#if MAXSTACK > MAXARG_B -#undef MAXSTACK -#define MAXSTACK MAXARG_B -#endif -/* maximum number of local variables */ -#ifndef MAXLOCALS -#define MAXLOCALS 200 /* arbitrary limit (<MAXSTACK) */ -#endif -#if MAXLOCALS>=MAXSTACK -#undef MAXLOCALS -#define MAXLOCALS (MAXSTACK-1) +/* maximum number of variables declared in a function */ +#ifndef MAXVARS +#define MAXVARS 200 /* arbitrary limit (<MAXSTACK) */ #endif -/* maximum number of upvalues */ +/* maximum number of upvalues per function */ #ifndef MAXUPVALUES -#define MAXUPVALUES 32 /* arbitrary limit (<=MAXARG_B) */ -#endif -#if MAXUPVALUES>MAXARG_B -#undef MAXUPVALUES -#define MAXUPVALUES MAXARG_B -#endif - - -/* maximum number of variables in the left side of an assignment */ -#ifndef MAXVARSLH -#define MAXVARSLH 100 /* arbitrary limit (<MULT_RET) */ -#endif -#if MAXVARSLH>=MULT_RET -#undef MAXVARSLH -#define MAXVARSLH (MULT_RET-1) +#define MAXUPVALUES 32 #endif @@ -177,27 +159,26 @@ typedef unsigned long Instruction; #ifndef MAXPARAMS #define MAXPARAMS 100 /* arbitrary limit (<MAXLOCALS) */ #endif -#if MAXPARAMS>=MAXLOCALS -#undef MAXPARAMS -#define MAXPARAMS (MAXLOCALS-1) -#endif -/* number of list items to accumulate before a SETLIST instruction */ -#define LFIELDS_PER_FLUSH 64 -#if LFIELDS_PER_FLUSH>(MAXSTACK/4) -#undef LFIELDS_PER_FLUSH -#define LFIELDS_PER_FLUSH (MAXSTACK/4) +/* minimum size for the string table (must be power of 2) */ +#ifndef MINSTRTABSIZE +#define MINSTRTABSIZE 32 #endif -/* number of record items to accumulate before a SETMAP instruction */ -/* (each item counts 2 elements on the stack: an index and a value) */ -#define RFIELDS_PER_FLUSH (LFIELDS_PER_FLUSH/2) + +/* minimum size for string buffer */ +#ifndef LUA_MINBUFFER +#define LUA_MINBUFFER 32 +#endif -/* maximum lookback to find a real constant (for code generation) */ -#ifndef LOOKBACKNUMS -#define LOOKBACKNUMS 20 /* arbitrary constant */ +/* +** maximum number of syntactical nested non-terminals: Not too big, +** or may overflow the C stack... +*/ +#ifndef LUA_MAXPARSERLEVEL +#define LUA_MAXPARSERLEVEL 200 #endif @@ -1,5 +1,5 @@ /* -** $Id: lmem.c,v 1.39 2000/10/30 16:29:59 roberto Exp $ +** $Id: lmem.c,v 1.61 2002/12/04 17:38:31 roberto Exp $ ** Interface to Memory Manager ** See Copyright Notice in lua.h */ @@ -7,8 +7,11 @@ #include <stdlib.h> +#define lmem_c + #include "lua.h" +#include "ldebug.h" #include "ldo.h" #include "lmem.h" #include "lobject.h" @@ -16,135 +19,73 @@ - -#ifdef LUA_DEBUG /* -** {====================================================================== -** Controlled version for realloc. -** ======================================================================= +** definition for realloc function. It must assure that l_realloc(NULL, +** 0, x) allocates a new block (ANSI C assures that). (`os' is the old +** block size; some allocators may use that.) */ - - -#include <assert.h> -#include <limits.h> -#include <string.h> - -#define realloc(b, s) debug_realloc(b, s) -#define malloc(b) debug_realloc(NULL, b) -#define free(b) debug_realloc(b, 0) - - -/* ensures maximum alignment for HEADER */ -#define HEADER (sizeof(union L_Umaxalign)) - -#define MARKSIZE 16 -#define MARK 0x55 /* 01010101 (a nice pattern) */ - - -#define blocksize(b) ((unsigned long *)((char *)(b) - HEADER)) - -unsigned long memdebug_numblocks = 0; -unsigned long memdebug_total = 0; -unsigned long memdebug_maxmem = 0; -unsigned long memdebug_memlimit = LONG_MAX; - - -static void *checkblock (void *block) { - unsigned long *b = blocksize(block); - unsigned long size = *b; - int i; - for (i=0;i<MARKSIZE;i++) - assert(*(((char *)b)+HEADER+size+i) == MARK+i); /* corrupted block? */ - memdebug_numblocks--; - memdebug_total -= size; - return b; -} - - -static void freeblock (void *block) { - if (block) { - size_t size = *blocksize(block); - block = checkblock(block); - memset(block, -1, size+HEADER+MARKSIZE); /* erase block */ - (free)(block); /* free original block */ - } -} - - -static void *debug_realloc (void *block, size_t size) { - if (size == 0) { - freeblock(block); - return NULL; - } - else if (memdebug_total+size > memdebug_memlimit) - return NULL; /* to test memory allocation errors */ - else { - size_t realsize = HEADER+size+MARKSIZE; - char *newblock = (char *)(malloc)(realsize); /* alloc a new block */ - int i; - if (realsize < size) return NULL; /* overflow! */ - if (newblock == NULL) return NULL; - if (block) { - size_t oldsize = *blocksize(block); - if (oldsize > size) oldsize = size; - memcpy(newblock+HEADER, block, oldsize); - freeblock(block); /* erase (and check) old copy */ - } - memdebug_total += size; - if (memdebug_total > memdebug_maxmem) memdebug_maxmem = memdebug_total; - memdebug_numblocks++; - *(unsigned long *)newblock = size; - for (i=0;i<MARKSIZE;i++) - *(newblock+HEADER+size+i) = (char)(MARK+i); - return newblock+HEADER; - } -} - - -/* }====================================================================== */ +#ifndef l_realloc +#define l_realloc(b,os,s) realloc(b,s) #endif - - /* -** Real ISO (ANSI) systems do not need these tests; -** but some systems (Sun OS) are not that ISO... +** definition for free function. (`os' is the old block size; some +** allocators may use that.) */ -#ifdef OLD_ANSI -#define realloc(b,s) ((b) == NULL ? malloc(s) : (realloc)(b, s)) -#define free(b) if (b) (free)(b) +#ifndef l_free +#define l_free(b,os) free(b) #endif -void *luaM_growaux (lua_State *L, void *block, size_t nelems, - int inc, size_t size, const char *errormsg, size_t limit) { - size_t newn = nelems+inc; - if (nelems >= limit-inc) lua_error(L, errormsg); - if ((newn ^ nelems) <= nelems || /* still the same power-of-2 limit? */ - (nelems > 0 && newn < MINPOWER2)) /* or block already is MINPOWER2? */ - return block; /* do not need to reallocate */ - else /* it crossed a power-of-2 boundary; grow to next power */ - return luaM_realloc(L, block, luaO_power2(newn)*size); +#define MINSIZEARRAY 4 + + +void *luaM_growaux (lua_State *L, void *block, int *size, int size_elems, + int limit, const char *errormsg) { + void *newblock; + int newsize = (*size)*2; + if (newsize < MINSIZEARRAY) + newsize = MINSIZEARRAY; /* minimum size */ + else if (*size >= limit/2) { /* cannot double it? */ + if (*size < limit - MINSIZEARRAY) /* try something smaller... */ + newsize = limit; /* still have at least MINSIZEARRAY free places */ + else luaG_runerror(L, errormsg); + } + newblock = luaM_realloc(L, block, + cast(lu_mem, *size)*cast(lu_mem, size_elems), + cast(lu_mem, newsize)*cast(lu_mem, size_elems)); + *size = newsize; /* update only when everything else is OK */ + return newblock; } /* ** generic allocation routine. */ -void *luaM_realloc (lua_State *L, void *block, lint32 size) { +void *luaM_realloc (lua_State *L, void *block, lu_mem oldsize, lu_mem size) { + lua_assert((oldsize == 0) == (block == NULL)); if (size == 0) { - free(block); /* block may be NULL; that is OK for free */ - return NULL; + if (block != NULL) { + l_free(block, oldsize); + block = NULL; + } + else return NULL; /* avoid `nblocks' computations when oldsize==size==0 */ } else if (size >= MAX_SIZET) - lua_error(L, "memory allocation error: block too big"); - block = realloc(block, size); - if (block == NULL) { - if (L) - luaD_breakrun(L, LUA_ERRMEM); /* break run without error message */ - else return NULL; /* error before creating state! */ + luaG_runerror(L, "memory allocation error: block too big"); + else { + block = l_realloc(block, oldsize, size); + if (block == NULL) { + if (L) + luaD_throw(L, LUA_ERRMEM); + else return NULL; /* error before creating state! */ + } + } + if (L) { + lua_assert(G(L) != NULL && G(L)->nblocks > 0); + G(L)->nblocks -= oldsize; + G(L)->nblocks += size; } return block; } - @@ -1,5 +1,5 @@ /* -** $Id: lmem.h,v 1.16 2000/10/30 16:29:59 roberto Exp $ +** $Id: lmem.h,v 1.26 2002/05/01 20:40:42 roberto Exp $ ** Interface to Memory Manager ** See Copyright Notice in lua.h */ @@ -13,29 +13,31 @@ #include "llimits.h" #include "lua.h" -void *luaM_realloc (lua_State *L, void *oldblock, lint32 size); -void *luaM_growaux (lua_State *L, void *block, size_t nelems, - int inc, size_t size, const char *errormsg, - size_t limit); +#define MEMERRMSG "not enough memory" -#define luaM_free(L, b) luaM_realloc(L, (b), 0) -#define luaM_malloc(L, t) luaM_realloc(L, NULL, (t)) -#define luaM_new(L, t) ((t *)luaM_malloc(L, sizeof(t))) -#define luaM_newvector(L, n,t) ((t *)luaM_malloc(L, (n)*(lint32)sizeof(t))) -#define luaM_growvector(L, v,nelems,inc,t,e,l) \ - ((v)=(t *)luaM_growaux(L, v,nelems,inc,sizeof(t),e,l)) +void *luaM_realloc (lua_State *L, void *oldblock, lu_mem oldsize, lu_mem size); -#define luaM_reallocvector(L, v,n,t) \ - ((v)=(t *)luaM_realloc(L, v,(n)*(lint32)sizeof(t))) +void *luaM_growaux (lua_State *L, void *block, int *size, int size_elem, + int limit, const char *errormsg); +#define luaM_free(L, b, s) luaM_realloc(L, (b), (s), 0) +#define luaM_freelem(L, b) luaM_realloc(L, (b), sizeof(*(b)), 0) +#define luaM_freearray(L, b, n, t) luaM_realloc(L, (b), \ + cast(lu_mem, n)*cast(lu_mem, sizeof(t)), 0) -#ifdef LUA_DEBUG -extern unsigned long memdebug_numblocks; -extern unsigned long memdebug_total; -extern unsigned long memdebug_maxmem; -extern unsigned long memdebug_memlimit; -#endif +#define luaM_malloc(L, t) luaM_realloc(L, NULL, 0, (t)) +#define luaM_new(L, t) cast(t *, luaM_malloc(L, sizeof(t))) +#define luaM_newvector(L, n,t) cast(t *, luaM_malloc(L, \ + cast(lu_mem, n)*cast(lu_mem, sizeof(t)))) + +#define luaM_growvector(L,v,nelems,size,t,limit,e) \ + if (((nelems)+1) > (size)) \ + ((v)=cast(t *, luaM_growaux(L,v,&(size),sizeof(t),limit,e))) + +#define luaM_reallocvector(L, v,oldn,n,t) \ + ((v)=cast(t *, luaM_realloc(L, v,cast(lu_mem, oldn)*cast(lu_mem, sizeof(t)), \ + cast(lu_mem, n)*cast(lu_mem, sizeof(t))))) #endif diff --git a/src/lobject.c b/src/lobject.c index e787fbe8..9522b6e8 100644 --- a/src/lobject.c +++ b/src/lobject.c @@ -1,92 +1,162 @@ /* -** $Id: lobject.c,v 1.55 2000/10/20 16:36:32 roberto Exp $ +** $Id: lobject.c,v 1.97 2003/04/03 13:35:34 roberto Exp $ ** Some generic functions over Lua objects ** See Copyright Notice in lua.h */ #include <ctype.h> #include <stdarg.h> -#include <stdio.h> #include <stdlib.h> #include <string.h> +#define lobject_c + #include "lua.h" +#include "ldo.h" #include "lmem.h" #include "lobject.h" #include "lstate.h" +#include "lstring.h" +#include "lvm.h" +/* function to convert a string to a lua_Number */ +#ifndef lua_str2number +#define lua_str2number(s,p) strtod((s), (p)) +#endif -const TObject luaO_nilobject = {LUA_TNIL, {NULL}}; - - -const char *const luaO_typenames[] = { - "userdata", "nil", "number", "string", "table", "function" -}; +const TObject luaO_nilobject = {LUA_TNIL, {NULL}}; /* -** returns smaller power of 2 larger than `n' (minimum is MINPOWER2) +** converts an integer to a "floating point byte", represented as +** (mmmmmxxx), where the real value is (xxx) * 2^(mmmmm) */ -lint32 luaO_power2 (lint32 n) { - lint32 p = MINPOWER2; - while (p<=n) p<<=1; - return p; +int luaO_int2fb (unsigned int x) { + int m = 0; /* mantissa */ + while (x >= (1<<3)) { + x = (x+1) >> 1; + m++; + } + return (m << 3) | cast(int, x); } -int luaO_equalObj (const TObject *t1, const TObject *t2) { - if (ttype(t1) != ttype(t2)) return 0; - switch (ttype(t1)) { - case LUA_TNUMBER: - return nvalue(t1) == nvalue(t2); - case LUA_TSTRING: case LUA_TUSERDATA: - return tsvalue(t1) == tsvalue(t2); - case LUA_TTABLE: - return hvalue(t1) == hvalue(t2); - case LUA_TFUNCTION: - return clvalue(t1) == clvalue(t2); - default: - LUA_ASSERT(ttype(t1) == LUA_TNIL, "invalid type"); - return 1; /* LUA_TNIL */ +int luaO_log2 (unsigned int x) { + static const lu_byte log_8[255] = { + 0, + 1,1, + 2,2,2,2, + 3,3,3,3,3,3,3,3, + 4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4, + 5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5, + 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6, + 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6, + 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, + 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, + 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, + 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7 + }; + if (x >= 0x00010000) { + if (x >= 0x01000000) return log_8[((x>>24) & 0xff) - 1]+24; + else return log_8[((x>>16) & 0xff) - 1]+16; + } + else { + if (x >= 0x00000100) return log_8[((x>>8) & 0xff) - 1]+8; + else if (x) return log_8[(x & 0xff) - 1]; + return -1; /* special `log' for 0 */ } } -char *luaO_openspace (lua_State *L, size_t n) { - if (n > L->Mbuffsize) { - luaM_reallocvector(L, L->Mbuffer, n, char); - L->nblocks += (n - L->Mbuffsize)*sizeof(char); - L->Mbuffsize = n; +int luaO_rawequalObj (const TObject *t1, const TObject *t2) { + if (ttype(t1) != ttype(t2)) return 0; + else switch (ttype(t1)) { + case LUA_TNIL: + return 1; + case LUA_TNUMBER: + return nvalue(t1) == nvalue(t2); + case LUA_TBOOLEAN: + return bvalue(t1) == bvalue(t2); /* boolean true must be 1 !! */ + case LUA_TLIGHTUSERDATA: + return pvalue(t1) == pvalue(t2); + default: + lua_assert(iscollectable(t1)); + return gcvalue(t1) == gcvalue(t2); } - return L->Mbuffer; } -int luaO_str2d (const char *s, Number *result) { /* LUA_NUMBER */ +int luaO_str2d (const char *s, lua_Number *result) { char *endptr; - Number res = lua_str2number(s, &endptr); + lua_Number res = lua_str2number(s, &endptr); if (endptr == s) return 0; /* no conversion */ - while (isspace((unsigned char)*endptr)) endptr++; + while (isspace((unsigned char)(*endptr))) endptr++; if (*endptr != '\0') return 0; /* invalid trailing characters? */ *result = res; return 1; } -/* maximum length of a string format for `luaO_verror' */ -#define MAX_VERROR 280 -/* this function needs to handle only '%d' and '%.XXs' formats */ -void luaO_verror (lua_State *L, const char *fmt, ...) { +static void pushstr (lua_State *L, const char *str) { + setsvalue2s(L->top, luaS_new(L, str)); + incr_top(L); +} + + +/* this function handles only `%d', `%c', %f, and `%s' formats */ +const char *luaO_pushvfstring (lua_State *L, const char *fmt, va_list argp) { + int n = 1; + pushstr(L, ""); + for (;;) { + const char *e = strchr(fmt, '%'); + if (e == NULL) break; + setsvalue2s(L->top, luaS_newlstr(L, fmt, e-fmt)); + incr_top(L); + switch (*(e+1)) { + case 's': + pushstr(L, va_arg(argp, char *)); + break; + case 'c': { + char buff[2]; + buff[0] = cast(char, va_arg(argp, int)); + buff[1] = '\0'; + pushstr(L, buff); + break; + } + case 'd': + setnvalue(L->top, cast(lua_Number, va_arg(argp, int))); + incr_top(L); + break; + case 'f': + setnvalue(L->top, cast(lua_Number, va_arg(argp, l_uacNumber))); + incr_top(L); + break; + case '%': + pushstr(L, "%"); + break; + default: lua_assert(0); + } + n += 2; + fmt = e+2; + } + pushstr(L, fmt); + luaV_concat(L, n+1, L->top - L->base - 1); + L->top -= n; + return svalue(L->top - 1); +} + + +const char *luaO_pushfstring (lua_State *L, const char *fmt, ...) { + const char *msg; va_list argp; - char buff[MAX_VERROR]; /* to hold formatted message */ va_start(argp, fmt); - vsprintf(buff, fmt, argp); + msg = luaO_pushvfstring(L, fmt, argp); va_end(argp); - lua_error(L, buff); + return msg; } @@ -95,31 +165,31 @@ void luaO_chunkid (char *out, const char *source, int bufflen) { strncpy(out, source+1, bufflen); /* remove first char */ out[bufflen-1] = '\0'; /* ensures null termination */ } - else { + else { /* out = "source", or "...source" */ if (*source == '@') { int l; source++; /* skip the `@' */ - bufflen -= sizeof("file `...%s'"); + bufflen -= sizeof(" `...' "); l = strlen(source); + strcpy(out, ""); if (l>bufflen) { source += (l-bufflen); /* get last part of file name */ - sprintf(out, "file `...%.99s'", source); + strcat(out, "..."); } - else - sprintf(out, "file `%.99s'", source); + strcat(out, source); } - else { + else { /* out = [string "string"] */ int len = strcspn(source, "\n"); /* stop at first newline */ - bufflen -= sizeof("string \"%.*s...\""); + bufflen -= sizeof(" [string \"...\"] "); if (len > bufflen) len = bufflen; + strcpy(out, "[string \""); if (source[len] != '\0') { /* must truncate? */ - strcpy(out, "string \""); - out += strlen(out); - strncpy(out, source, len); - strcpy(out+len, "...\""); + strncat(out, source, len); + strcat(out, "..."); } else - sprintf(out, "string \"%.99s\"", source); + strcat(out, source); + strcat(out, "\"]"); } } } diff --git a/src/lobject.h b/src/lobject.h index cb232c77..321a7e06 100644 --- a/src/lobject.h +++ b/src/lobject.h @@ -1,5 +1,5 @@ /* -** $Id: lobject.h,v 1.82 2000/10/30 17:49:19 roberto Exp $ +** $Id: lobject.h,v 1.159 2003/03/18 12:50:04 roberto Exp $ ** Type definitions for Lua objects ** See Copyright Notice in lua.h */ @@ -12,115 +12,222 @@ #include "lua.h" -#ifdef LUA_DEBUG -#undef NDEBUG -#include <assert.h> -#define LUA_INTERNALERROR(s) assert(((void)s,0)) -#define LUA_ASSERT(c,s) assert(((void)s,(c))) -#else -#define LUA_INTERNALERROR(s) /* empty */ -#define LUA_ASSERT(c,s) /* empty */ -#endif +/* tags for values visible from Lua */ +#define NUM_TAGS LUA_TTHREAD -#ifdef LUA_DEBUG -/* to avoid warnings, and make sure value is really unused */ -#define UNUSED(x) (x=0, (void)(x)) -#else -#define UNUSED(x) ((void)(x)) /* to avoid warnings */ -#endif +/* +** Extra tags for non-values +*/ +#define LUA_TPROTO (NUM_TAGS+1) +#define LUA_TUPVAL (NUM_TAGS+2) + + +/* +** Union of all collectable objects +*/ +typedef union GCObject GCObject; -/* mark for closures active in the stack */ -#define LUA_TMARK 6 +/* +** Common Header for all collectable objects (in macro form, to be +** included in other objects) +*/ +#define CommonHeader GCObject *next; lu_byte tt; lu_byte marked -/* tags for values visible from Lua == first user-created tag */ -#define NUM_TAGS 6 +/* +** Common header in struct form +*/ +typedef struct GCheader { + CommonHeader; +} GCheader; -/* check whether `t' is a mark */ -#define is_T_MARK(t) ((t) == LUA_TMARK) +/* +** Union of all Lua values +*/ typedef union { - struct TString *ts; /* LUA_TSTRING, LUA_TUSERDATA */ - struct Closure *cl; /* LUA_TFUNCTION */ - struct Hash *a; /* LUA_TTABLE */ - struct CallInfo *i; /* LUA_TLMARK */ - Number n; /* LUA_TNUMBER */ + GCObject *gc; + void *p; + lua_Number n; + int b; } Value; -/* Macros to access values */ -#define ttype(o) ((o)->ttype) -#define nvalue(o) ((o)->value.n) -#define tsvalue(o) ((o)->value.ts) -#define clvalue(o) ((o)->value.cl) -#define hvalue(o) ((o)->value.a) -#define infovalue(o) ((o)->value.i) -#define svalue(o) (tsvalue(o)->str) - - +/* +** Lua values (or `tagged objects') +*/ typedef struct lua_TObject { - int ttype; + int tt; Value value; } TObject; +/* Macros to test type */ +#define ttisnil(o) (ttype(o) == LUA_TNIL) +#define ttisnumber(o) (ttype(o) == LUA_TNUMBER) +#define ttisstring(o) (ttype(o) == LUA_TSTRING) +#define ttistable(o) (ttype(o) == LUA_TTABLE) +#define ttisfunction(o) (ttype(o) == LUA_TFUNCTION) +#define ttisboolean(o) (ttype(o) == LUA_TBOOLEAN) +#define ttisuserdata(o) (ttype(o) == LUA_TUSERDATA) +#define ttisthread(o) (ttype(o) == LUA_TTHREAD) +#define ttislightuserdata(o) (ttype(o) == LUA_TLIGHTUSERDATA) + +/* Macros to access values */ +#define ttype(o) ((o)->tt) +#define gcvalue(o) check_exp(iscollectable(o), (o)->value.gc) +#define pvalue(o) check_exp(ttislightuserdata(o), (o)->value.p) +#define nvalue(o) check_exp(ttisnumber(o), (o)->value.n) +#define tsvalue(o) check_exp(ttisstring(o), &(o)->value.gc->ts) +#define uvalue(o) check_exp(ttisuserdata(o), &(o)->value.gc->u) +#define clvalue(o) check_exp(ttisfunction(o), &(o)->value.gc->cl) +#define hvalue(o) check_exp(ttistable(o), &(o)->value.gc->h) +#define bvalue(o) check_exp(ttisboolean(o), (o)->value.b) +#define thvalue(o) check_exp(ttisthread(o), &(o)->value.gc->th) + +#define l_isfalse(o) (ttisnil(o) || (ttisboolean(o) && bvalue(o) == 0)) + +/* Macros to set values */ +#define setnvalue(obj,x) \ + { TObject *i_o=(obj); i_o->tt=LUA_TNUMBER; i_o->value.n=(x); } + +#define chgnvalue(obj,x) \ + check_exp(ttype(obj)==LUA_TNUMBER, (obj)->value.n=(x)) + +#define setpvalue(obj,x) \ + { TObject *i_o=(obj); i_o->tt=LUA_TLIGHTUSERDATA; i_o->value.p=(x); } + +#define setbvalue(obj,x) \ + { TObject *i_o=(obj); i_o->tt=LUA_TBOOLEAN; i_o->value.b=(x); } + +#define setsvalue(obj,x) \ + { TObject *i_o=(obj); i_o->tt=LUA_TSTRING; \ + i_o->value.gc=cast(GCObject *, (x)); \ + lua_assert(i_o->value.gc->gch.tt == LUA_TSTRING); } + +#define setuvalue(obj,x) \ + { TObject *i_o=(obj); i_o->tt=LUA_TUSERDATA; \ + i_o->value.gc=cast(GCObject *, (x)); \ + lua_assert(i_o->value.gc->gch.tt == LUA_TUSERDATA); } + +#define setthvalue(obj,x) \ + { TObject *i_o=(obj); i_o->tt=LUA_TTHREAD; \ + i_o->value.gc=cast(GCObject *, (x)); \ + lua_assert(i_o->value.gc->gch.tt == LUA_TTHREAD); } + +#define setclvalue(obj,x) \ + { TObject *i_o=(obj); i_o->tt=LUA_TFUNCTION; \ + i_o->value.gc=cast(GCObject *, (x)); \ + lua_assert(i_o->value.gc->gch.tt == LUA_TFUNCTION); } + +#define sethvalue(obj,x) \ + { TObject *i_o=(obj); i_o->tt=LUA_TTABLE; \ + i_o->value.gc=cast(GCObject *, (x)); \ + lua_assert(i_o->value.gc->gch.tt == LUA_TTABLE); } + +#define setnilvalue(obj) ((obj)->tt=LUA_TNIL) + + + /* -** String headers for string table +** for internal debug only +*/ +#define checkconsistency(obj) \ + lua_assert(!iscollectable(obj) || (ttype(obj) == (obj)->value.gc->gch.tt)) + + +#define setobj(obj1,obj2) \ + { const TObject *o2=(obj2); TObject *o1=(obj1); \ + checkconsistency(o2); \ + o1->tt=o2->tt; o1->value = o2->value; } + + +/* +** different types of sets, according to destination */ +/* from stack to (same) stack */ +#define setobjs2s setobj +/* to stack (not from same stack) */ +#define setobj2s setobj +#define setsvalue2s setsvalue +/* from table to same table */ +#define setobjt2t setobj +/* to table */ +#define setobj2t setobj +/* to new object */ +#define setobj2n setobj +#define setsvalue2n setsvalue + +#define setttype(obj, tt) (ttype(obj) = (tt)) + + +#define iscollectable(o) (ttype(o) >= LUA_TSTRING) + + + +typedef TObject *StkId; /* index to stack elements */ + + /* -** most `malloc' libraries allocate memory in blocks of 8 bytes. TSPACK -** tries to make sizeof(TString) a multiple of this granularity, to reduce -** waste of space. +** String headers for string table */ -#define TSPACK ((int)sizeof(int)) - -typedef struct TString { - union { - struct { /* for strings */ - unsigned long hash; - int constindex; /* hint to reuse constants */ - } s; - struct { /* for userdata */ - int tag; - void *value; - } d; - } u; - size_t len; - struct TString *nexthash; /* chain for hash table */ - int marked; - char str[TSPACK]; /* variable length string!! must be the last field! */ +typedef union TString { + L_Umaxalign dummy; /* ensures maximum alignment for strings */ + struct { + CommonHeader; + lu_byte reserved; + lu_hash hash; + size_t len; + } tsv; } TString; +#define getstr(ts) cast(const char *, (ts) + 1) +#define svalue(o) getstr(tsvalue(o)) + + + +typedef union Udata { + L_Umaxalign dummy; /* ensures maximum alignment for `local' udata */ + struct { + CommonHeader; + struct Table *metatable; + size_t len; + } uv; +} Udata; + + + + /* ** Function Prototypes */ typedef struct Proto { - Number *knum; /* Number numbers used by the function */ - int nknum; /* size of `knum' */ - struct TString **kstr; /* strings used by the function */ - int nkstr; /* size of `kstr' */ - struct Proto **kproto; /* functions defined inside the function */ - int nkproto; /* size of `kproto' */ + CommonHeader; + TObject *k; /* constants used by the function */ Instruction *code; - int ncode; /* size of `code'; when 0 means an incomplete `Proto' */ - short numparams; - short is_vararg; - short maxstacksize; - short marked; - struct Proto *next; - /* debug information */ + struct Proto **p; /* functions defined inside the function */ int *lineinfo; /* map from opcodes to source lines */ - int nlineinfo; /* size of `lineinfo' */ - int nlocvars; struct LocVar *locvars; /* information about local variables */ - int lineDefined; + TString **upvalues; /* upvalue names */ TString *source; + int sizeupvalues; + int sizek; /* size of `k' */ + int sizecode; + int sizelineinfo; + int sizep; /* size of `p' */ + int sizelocvars; + int lineDefined; + GCObject *gclist; + lu_byte nups; /* number of upvalues */ + lu_byte numparams; + lu_byte is_vararg; + lu_byte maxstacksize; } Proto; @@ -131,73 +238,98 @@ typedef struct LocVar { } LocVar; + +/* +** Upvalues +*/ + +typedef struct UpVal { + CommonHeader; + TObject *v; /* points to stack or to its own value */ + TObject value; /* the value (when closed) */ +} UpVal; + + /* ** Closures */ -typedef struct Closure { - union { - lua_CFunction c; /* C functions */ - struct Proto *l; /* Lua functions */ - } f; - struct Closure *next; - struct Closure *mark; /* marked closures (point to itself when not marked) */ - short isC; /* 0 for Lua functions, 1 for C functions */ - short nupvalues; + +#define ClosureHeader \ + CommonHeader; lu_byte isC; lu_byte nupvalues; GCObject *gclist + +typedef struct CClosure { + ClosureHeader; + lua_CFunction f; TObject upvalue[1]; +} CClosure; + + +typedef struct LClosure { + ClosureHeader; + struct Proto *p; + TObject g; /* global table for this closure */ + UpVal *upvals[1]; +} LClosure; + + +typedef union Closure { + CClosure c; + LClosure l; } Closure; -#define iscfunction(o) (ttype(o) == LUA_TFUNCTION && clvalue(o)->isC) +#define iscfunction(o) (ttype(o) == LUA_TFUNCTION && clvalue(o)->c.isC) +#define isLfunction(o) (ttype(o) == LUA_TFUNCTION && !clvalue(o)->c.isC) + +/* +** Tables +*/ typedef struct Node { - TObject key; - TObject val; + TObject i_key; + TObject i_val; struct Node *next; /* for chaining */ } Node; -typedef struct Hash { + +typedef struct Table { + CommonHeader; + lu_byte flags; /* 1<<p means tagmethod(p) is not present */ + lu_byte lsizenode; /* log2 of size of `node' array */ + struct Table *metatable; + TObject *array; /* array part */ Node *node; - int htag; - int size; Node *firstfree; /* this position is free; all positions after it are full */ - struct Hash *next; - struct Hash *mark; /* marked tables (point to itself when not marked) */ -} Hash; - + GCObject *gclist; + int sizearray; /* size of `array' array */ +} Table; -/* unmarked tables and closures are represented by pointing `mark' to -** themselves -*/ -#define ismarked(x) ((x)->mark != (x)) /* -** informations about a call (for debugging) +** `module' operation for hashing (size is always a power of 2) */ -typedef struct CallInfo { - struct Closure *func; /* function being called */ - const Instruction **pc; /* current pc of called function */ - int lastpc; /* last pc traced */ - int line; /* current line */ - int refi; /* current index in `lineinfo' */ -} CallInfo; +#define lmod(s,size) \ + check_exp((size&(size-1))==0, (cast(int, (s) & ((size)-1)))) -extern const TObject luaO_nilobject; -extern const char *const luaO_typenames[]; +#define twoto(x) (1<<(x)) +#define sizenode(t) (twoto((t)->lsizenode)) -#define luaO_typename(o) (luaO_typenames[ttype(o)]) +extern const TObject luaO_nilobject; -lint32 luaO_power2 (lint32 n); -char *luaO_openspace (lua_State *L, size_t n); +int luaO_log2 (unsigned int x); +int luaO_int2fb (unsigned int x); +#define fb2int(x) (((x) & 7) << ((x) >> 3)) -int luaO_equalObj (const TObject *t1, const TObject *t2); -int luaO_str2d (const char *s, Number *result); +int luaO_rawequalObj (const TObject *t1, const TObject *t2); +int luaO_str2d (const char *s, lua_Number *result); -void luaO_verror (lua_State *L, const char *fmt, ...); +const char *luaO_pushvfstring (lua_State *L, const char *fmt, va_list argp); +const char *luaO_pushfstring (lua_State *L, const char *fmt, ...); void luaO_chunkid (char *out, const char *source, int len); diff --git a/src/lopcodes.c b/src/lopcodes.c new file mode 100644 index 00000000..993e426d --- /dev/null +++ b/src/lopcodes.c @@ -0,0 +1,102 @@ +/* +** $Id: lopcodes.c,v 1.22 2002/12/04 17:38:31 roberto Exp $ +** extracted automatically from lopcodes.h by mkprint.lua +** DO NOT EDIT +** See Copyright Notice in lua.h +*/ + + +#define lopcodes_c + +#include "lua.h" + +#include "lobject.h" +#include "lopcodes.h" + + +#ifdef LUA_OPNAMES + +const char *const luaP_opnames[] = { + "MOVE", + "LOADK", + "LOADBOOL", + "LOADNIL", + "GETUPVAL", + "GETGLOBAL", + "GETTABLE", + "SETGLOBAL", + "SETUPVAL", + "SETTABLE", + "NEWTABLE", + "SELF", + "ADD", + "SUB", + "MUL", + "DIV", + "POW", + "UNM", + "NOT", + "CONCAT", + "JMP", + "EQ", + "LT", + "LE", + "TEST", + "CALL", + "TAILCALL", + "RETURN", + "FORLOOP", + "TFORLOOP", + "TFORPREP", + "SETLIST", + "SETLISTO", + "CLOSE", + "CLOSURE" +}; + +#endif + +#define opmode(t,b,bk,ck,sa,k,m) (((t)<<OpModeT) | \ + ((b)<<OpModeBreg) | ((bk)<<OpModeBrk) | ((ck)<<OpModeCrk) | \ + ((sa)<<OpModesetA) | ((k)<<OpModeK) | (m)) + + +const lu_byte luaP_opmodes[NUM_OPCODES] = { +/* T B Bk Ck sA K mode opcode */ + opmode(0, 1, 0, 0, 1, 0, iABC) /* OP_MOVE */ + ,opmode(0, 0, 0, 0, 1, 1, iABx) /* OP_LOADK */ + ,opmode(0, 0, 0, 0, 1, 0, iABC) /* OP_LOADBOOL */ + ,opmode(0, 1, 0, 0, 1, 0, iABC) /* OP_LOADNIL */ + ,opmode(0, 0, 0, 0, 1, 0, iABC) /* OP_GETUPVAL */ + ,opmode(0, 0, 0, 0, 1, 1, iABx) /* OP_GETGLOBAL */ + ,opmode(0, 1, 0, 1, 1, 0, iABC) /* OP_GETTABLE */ + ,opmode(0, 0, 0, 0, 0, 1, iABx) /* OP_SETGLOBAL */ + ,opmode(0, 0, 0, 0, 0, 0, iABC) /* OP_SETUPVAL */ + ,opmode(0, 0, 1, 1, 0, 0, iABC) /* OP_SETTABLE */ + ,opmode(0, 0, 0, 0, 1, 0, iABC) /* OP_NEWTABLE */ + ,opmode(0, 1, 0, 1, 1, 0, iABC) /* OP_SELF */ + ,opmode(0, 0, 1, 1, 1, 0, iABC) /* OP_ADD */ + ,opmode(0, 0, 1, 1, 1, 0, iABC) /* OP_SUB */ + ,opmode(0, 0, 1, 1, 1, 0, iABC) /* OP_MUL */ + ,opmode(0, 0, 1, 1, 1, 0, iABC) /* OP_DIV */ + ,opmode(0, 0, 1, 1, 1, 0, iABC) /* OP_POW */ + ,opmode(0, 1, 0, 0, 1, 0, iABC) /* OP_UNM */ + ,opmode(0, 1, 0, 0, 1, 0, iABC) /* OP_NOT */ + ,opmode(0, 1, 0, 1, 1, 0, iABC) /* OP_CONCAT */ + ,opmode(0, 0, 0, 0, 0, 0, iAsBx) /* OP_JMP */ + ,opmode(1, 0, 1, 1, 0, 0, iABC) /* OP_EQ */ + ,opmode(1, 0, 1, 1, 0, 0, iABC) /* OP_LT */ + ,opmode(1, 0, 1, 1, 0, 0, iABC) /* OP_LE */ + ,opmode(1, 1, 0, 0, 1, 0, iABC) /* OP_TEST */ + ,opmode(0, 0, 0, 0, 0, 0, iABC) /* OP_CALL */ + ,opmode(0, 0, 0, 0, 0, 0, iABC) /* OP_TAILCALL */ + ,opmode(0, 0, 0, 0, 0, 0, iABC) /* OP_RETURN */ + ,opmode(0, 0, 0, 0, 0, 0, iAsBx) /* OP_FORLOOP */ + ,opmode(1, 0, 0, 0, 0, 0, iABC) /* OP_TFORLOOP */ + ,opmode(0, 0, 0, 0, 0, 0, iAsBx) /* OP_TFORPREP */ + ,opmode(0, 0, 0, 0, 0, 0, iABx) /* OP_SETLIST */ + ,opmode(0, 0, 0, 0, 0, 0, iABx) /* OP_SETLISTO */ + ,opmode(0, 0, 0, 0, 0, 0, iABC) /* OP_CLOSE */ + ,opmode(0, 0, 0, 0, 1, 0, iABx) /* OP_CLOSURE */ +}; + diff --git a/src/lopcodes.h b/src/lopcodes.h index 2df72ce7..0b6b58f3 100644 --- a/src/lopcodes.h +++ b/src/lopcodes.h @@ -1,5 +1,5 @@ /* -** $Id: lopcodes.h,v 1.68 2000/10/24 16:05:59 roberto Exp $ +** $Id: lopcodes.h,v 1.102 2002/08/21 18:56:09 roberto Exp $ ** Opcodes for Lua virtual machine ** See Copyright Notice in lua.h */ @@ -12,29 +12,58 @@ /*=========================================================================== We assume that instructions are unsigned numbers. - All instructions have an opcode in the first 6 bits. Moreover, - an instruction can have 0, 1, or 2 arguments. Instructions can - have the following types: - type 0: no arguments - type 1: 1 unsigned argument in the higher bits (called `U') - type 2: 1 signed argument in the higher bits (`S') - type 3: 1st unsigned argument in the higher bits (`A') - 2nd unsigned argument in the middle bits (`B') + All instructions have an opcode in the first 6 bits. + Instructions can have the following fields: + `A' : 8 bits + `B' : 9 bits + `C' : 9 bits + `Bx' : 18 bits (`B' and `C' together) + `sBx' : signed Bx A signed argument is represented in excess K; that is, the number value is the unsigned value minus K. K is exactly the maximum value for that argument (so that -max is represented by 0, and +max is represented by 2*max), which is half the maximum for the corresponding unsigned argument. - - The size of each argument is defined in `llimits.h'. The usual is an - instruction with 32 bits, U arguments with 26 bits (32-6), B arguments - with 9 bits, and A arguments with 17 bits (32-6-9). For small - installations, the instruction size can be 16, so U has 10 bits, - and A and B have 5 bits each. ===========================================================================*/ +enum OpMode {iABC, iABx, iAsBx}; /* basic instruction format */ + + +/* +** size and position of opcode arguments. +*/ +#define SIZE_C 9 +#define SIZE_B 9 +#define SIZE_Bx (SIZE_C + SIZE_B) +#define SIZE_A 8 + +#define SIZE_OP 6 + +#define POS_C SIZE_OP +#define POS_B (POS_C + SIZE_C) +#define POS_Bx POS_C +#define POS_A (POS_B + SIZE_B) + + +/* +** limits for opcode arguments. +** we use (signed) int to manipulate most arguments, +** so they must fit in BITS_INT-1 bits (-1 for sign) +*/ +#if SIZE_Bx < BITS_INT-1 +#define MAXARG_Bx ((1<<SIZE_Bx)-1) +#define MAXARG_sBx (MAXARG_Bx>>1) /* `sBx' is signed */ +#else +#define MAXARG_Bx MAX_INT +#define MAXARG_sBx MAX_INT +#endif + + +#define MAXARG_A ((1<<SIZE_A)-1) +#define MAXARG_B ((1<<SIZE_B)-1) +#define MAXARG_C ((1<<SIZE_C)-1) /* creates a mask with `n' 1 bits at position `p' */ @@ -47,122 +76,163 @@ ** the following macros help to manipulate instructions */ -#define CREATE_0(o) ((Instruction)(o)) -#define GET_OPCODE(i) ((OpCode)((i)&MASK1(SIZE_OP,0))) -#define SET_OPCODE(i,o) ((i) = (((i)&MASK0(SIZE_OP,0)) | (Instruction)(o))) +#define GET_OPCODE(i) (cast(OpCode, (i)&MASK1(SIZE_OP,0))) +#define SET_OPCODE(i,o) ((i) = (((i)&MASK0(SIZE_OP,0)) | cast(Instruction, o))) -#define CREATE_U(o,u) ((Instruction)(o) | ((Instruction)(u)<<POS_U)) -#define GETARG_U(i) ((int)((i)>>POS_U)) -#define SETARG_U(i,u) ((i) = (((i)&MASK0(SIZE_U,POS_U)) | \ - ((Instruction)(u)<<POS_U))) +#define GETARG_A(i) (cast(int, (i)>>POS_A)) +#define SETARG_A(i,u) ((i) = (((i)&MASK0(SIZE_A,POS_A)) | \ + ((cast(Instruction, u)<<POS_A)&MASK1(SIZE_A,POS_A)))) -#define CREATE_S(o,s) CREATE_U((o),(s)+MAXARG_S) -#define GETARG_S(i) (GETARG_U(i)-MAXARG_S) -#define SETARG_S(i,s) SETARG_U((i),(s)+MAXARG_S) +#define GETARG_B(i) (cast(int, ((i)>>POS_B) & MASK1(SIZE_B,0))) +#define SETARG_B(i,b) ((i) = (((i)&MASK0(SIZE_B,POS_B)) | \ + ((cast(Instruction, b)<<POS_B)&MASK1(SIZE_B,POS_B)))) + +#define GETARG_C(i) (cast(int, ((i)>>POS_C) & MASK1(SIZE_C,0))) +#define SETARG_C(i,b) ((i) = (((i)&MASK0(SIZE_C,POS_C)) | \ + ((cast(Instruction, b)<<POS_C)&MASK1(SIZE_C,POS_C)))) + +#define GETARG_Bx(i) (cast(int, ((i)>>POS_Bx) & MASK1(SIZE_Bx,0))) +#define SETARG_Bx(i,b) ((i) = (((i)&MASK0(SIZE_Bx,POS_Bx)) | \ + ((cast(Instruction, b)<<POS_Bx)&MASK1(SIZE_Bx,POS_Bx)))) + +#define GETARG_sBx(i) (GETARG_Bx(i)-MAXARG_sBx) +#define SETARG_sBx(i,b) SETARG_Bx((i),cast(unsigned int, (b)+MAXARG_sBx)) + + +#define CREATE_ABC(o,a,b,c) (cast(Instruction, o) \ + | (cast(Instruction, a)<<POS_A) \ + | (cast(Instruction, b)<<POS_B) \ + | (cast(Instruction, c)<<POS_C)) + +#define CREATE_ABx(o,a,bc) (cast(Instruction, o) \ + | (cast(Instruction, a)<<POS_A) \ + | (cast(Instruction, bc)<<POS_Bx)) -#define CREATE_AB(o,a,b) ((Instruction)(o) | ((Instruction)(a)<<POS_A) \ - | ((Instruction)(b)<<POS_B)) -#define GETARG_A(i) ((int)((i)>>POS_A)) -#define SETARG_A(i,a) ((i) = (((i)&MASK0(SIZE_A,POS_A)) | \ - ((Instruction)(a)<<POS_A))) -#define GETARG_B(i) ((int)(((i)>>POS_B) & MASK1(SIZE_B,0))) -#define SETARG_B(i,b) ((i) = (((i)&MASK0(SIZE_B,POS_B)) | \ - ((Instruction)(b)<<POS_B))) /* -** K = U argument used as index to `kstr' -** J = S argument used as jump offset (relative to pc of next instruction) -** L = unsigned argument used as index of local variable -** N = U argument used as index to `knum' +** invalid register that fits in 8 bits +*/ +#define NO_REG MAXARG_A + + +/* +** R(x) - register +** Kst(x) - constant (in constant table) +** RK(x) == if x < MAXSTACK then R(x) else Kst(x-MAXSTACK) +*/ + + +/* +** grep "ORDER OP" if you change these enums */ typedef enum { /*---------------------------------------------------------------------- -name args stack before stack after side effects +name args description ------------------------------------------------------------------------*/ -OP_END,/* - - (return) no results */ -OP_RETURN,/* U v_n-v_x(at u) (return) returns v_x-v_n */ +OP_MOVE,/* A B R(A) := R(B) */ +OP_LOADK,/* A Bx R(A) := Kst(Bx) */ +OP_LOADBOOL,/* A B C R(A) := (Bool)B; if (C) PC++ */ +OP_LOADNIL,/* A B R(A) := ... := R(B) := nil */ +OP_GETUPVAL,/* A B R(A) := UpValue[B] */ -OP_CALL,/* A B v_n-v_1 f(at a) r_b-r_1 f(v1,...,v_n) */ -OP_TAILCALL,/* A B v_n-v_1 f(at a) (return) f(v1,...,v_n) */ +OP_GETGLOBAL,/* A Bx R(A) := Gbl[Kst(Bx)] */ +OP_GETTABLE,/* A B C R(A) := R(B)[RK(C)] */ -OP_PUSHNIL,/* U - nil_1-nil_u */ -OP_POP,/* U a_u-a_1 - */ +OP_SETGLOBAL,/* A Bx Gbl[Kst(Bx)] := R(A) */ +OP_SETUPVAL,/* A B UpValue[B] := R(A) */ +OP_SETTABLE,/* A B C R(A)[RK(B)] := RK(C) */ -OP_PUSHINT,/* S - (Number)s */ -OP_PUSHSTRING,/* K - KSTR[k] */ -OP_PUSHNUM,/* N - KNUM[n] */ -OP_PUSHNEGNUM,/* N - -KNUM[n] */ +OP_NEWTABLE,/* A B C R(A) := {} (size = B,C) */ -OP_PUSHUPVALUE,/* U - Closure[u] */ +OP_SELF,/* A B C R(A+1) := R(B); R(A) := R(B)[RK(C)] */ -OP_GETLOCAL,/* L - LOC[l] */ -OP_GETGLOBAL,/* K - VAR[KSTR[k]] */ +OP_ADD,/* A B C R(A) := RK(B) + RK(C) */ +OP_SUB,/* A B C R(A) := RK(B) - RK(C) */ +OP_MUL,/* A B C R(A) := RK(B) * RK(C) */ +OP_DIV,/* A B C R(A) := RK(B) / RK(C) */ +OP_POW,/* A B C R(A) := RK(B) ^ RK(C) */ +OP_UNM,/* A B R(A) := -R(B) */ +OP_NOT,/* A B R(A) := not R(B) */ -OP_GETTABLE,/* - i t t[i] */ -OP_GETDOTTED,/* K t t[KSTR[k]] */ -OP_GETINDEXED,/* L t t[LOC[l]] */ -OP_PUSHSELF,/* K t t t[KSTR[k]] */ +OP_CONCAT,/* A B C R(A) := R(B).. ... ..R(C) */ -OP_CREATETABLE,/* U - newarray(size = u) */ +OP_JMP,/* sBx PC += sBx */ -OP_SETLOCAL,/* L x - LOC[l]=x */ -OP_SETGLOBAL,/* K x - VAR[KSTR[k]]=x */ -OP_SETTABLE,/* A B v a_a-a_1 i t (pops b values) t[i]=v */ +OP_EQ,/* A B C if ((RK(B) == RK(C)) ~= A) then pc++ */ +OP_LT,/* A B C if ((RK(B) < RK(C)) ~= A) then pc++ */ +OP_LE,/* A B C if ((RK(B) <= RK(C)) ~= A) then pc++ */ -OP_SETLIST,/* A B v_b-v_1 t t t[i+a*FPF]=v_i */ -OP_SETMAP,/* U v_u k_u - v_1 k_1 t t t[k_i]=v_i */ +OP_TEST,/* A B C if (R(B) <=> C) then R(A) := R(B) else pc++ */ -OP_ADD,/* - y x x+y */ -OP_ADDI,/* S x x+s */ -OP_SUB,/* - y x x-y */ -OP_MULT,/* - y x x*y */ -OP_DIV,/* - y x x/y */ -OP_POW,/* - y x x^y */ -OP_CONCAT,/* U v_u-v_1 v1..-..v_u */ -OP_MINUS,/* - x -x */ -OP_NOT,/* - x (x==nil)? 1 : nil */ +OP_CALL,/* A B C R(A), ... ,R(A+C-2) := R(A)(R(A+1), ... ,R(A+B-1)) */ +OP_TAILCALL,/* A B C return R(A)(R(A+1), ... ,R(A+B-1)) */ +OP_RETURN,/* A B return R(A), ... ,R(A+B-2) (see note) */ -OP_JMPNE,/* J y x - (x~=y)? PC+=s */ -OP_JMPEQ,/* J y x - (x==y)? PC+=s */ -OP_JMPLT,/* J y x - (x<y)? PC+=s */ -OP_JMPLE,/* J y x - (x<y)? PC+=s */ -OP_JMPGT,/* J y x - (x>y)? PC+=s */ -OP_JMPGE,/* J y x - (x>=y)? PC+=s */ +OP_FORLOOP,/* A sBx R(A)+=R(A+2); if R(A) <?= R(A+1) then PC+= sBx */ -OP_JMPT,/* J x - (x~=nil)? PC+=s */ -OP_JMPF,/* J x - (x==nil)? PC+=s */ -OP_JMPONT,/* J x (x~=nil)? x : - (x~=nil)? PC+=s */ -OP_JMPONF,/* J x (x==nil)? x : - (x==nil)? PC+=s */ -OP_JMP,/* J - - PC+=s */ +OP_TFORLOOP,/* A C R(A+2), ... ,R(A+2+C) := R(A)(R(A+1), R(A+2)); + if R(A+2) ~= nil then pc++ */ +OP_TFORPREP,/* A sBx if type(R(A)) == table then R(A+1):=R(A), R(A):=next; + PC += sBx */ -OP_PUSHNILJMP,/* - - nil PC++; */ +OP_SETLIST,/* A Bx R(A)[Bx-Bx%FPF+i] := R(A+i), 1 <= i <= Bx%FPF+1 */ +OP_SETLISTO,/* A Bx */ -OP_FORPREP,/* J */ -OP_FORLOOP,/* J */ +OP_CLOSE,/* A close all variables in the stack up to (>=) R(A)*/ +OP_CLOSURE/* A Bx R(A) := closure(KPROTO[Bx], R(A), ... ,R(A+n)) */ +} OpCode; -OP_LFORPREP,/* J */ -OP_LFORLOOP,/* J */ -OP_CLOSURE/* A B v_b-v_1 closure(KPROTO[a], v_1-v_b) */ +#define NUM_OPCODES (cast(int, OP_CLOSURE+1)) + -} OpCode; -#define NUM_OPCODES ((int)OP_CLOSURE+1) +/*=========================================================================== + Notes: + (1) In OP_CALL, if (B == 0) then B = top. C is the number of returns - 1, + and can be 0: OP_CALL then sets `top' to last_result+1, so + next open instruction (OP_CALL, OP_RETURN, OP_SETLIST) may use `top'. + + (2) In OP_RETURN, if (B == 0) then return up to `top' + + (3) For comparisons, B specifies what conditions the test should accept. + + (4) All `skips' (pc++) assume that next instruction is a jump +===========================================================================*/ -#define ISJUMP(o) (OP_JMPNE <= (o) && (o) <= OP_JMP) +/* +** masks for instruction properties +*/ +enum OpModeMask { + OpModeBreg = 2, /* B is a register */ + OpModeBrk, /* B is a register/constant */ + OpModeCrk, /* C is a register/constant */ + OpModesetA, /* instruction set register A */ + OpModeK, /* Bx is a constant */ + OpModeT /* operator is a test */ + +}; +extern const lu_byte luaP_opmodes[NUM_OPCODES]; -/* special code to fit a LUA_MULTRET inside an argB */ -#define MULT_RET 255 /* (<=MAXARG_B) */ -#if MULT_RET>MAXARG_B -#undef MULT_RET -#define MULT_RET MAXARG_B +#define getOpMode(m) (cast(enum OpMode, luaP_opmodes[m] & 3)) +#define testOpMode(m, b) (luaP_opmodes[m] & (1 << (b))) + + +#ifdef LUA_OPNAMES +extern const char *const luaP_opnames[]; /* opcode names */ #endif + +/* number of list items to accumulate before a SETLIST instruction */ +/* (must be a power of 2) */ +#define LFIELDS_PER_FLUSH 32 + + #endif diff --git a/src/lparser.c b/src/lparser.c index 67161c86..c1323ecd 100644 --- a/src/lparser.c +++ b/src/lparser.c @@ -1,16 +1,18 @@ /* -** $Id: lparser.c,v 1.117 2000/11/29 11:57:42 roberto Exp $ -** LL(1) Parser and code generator for Lua +** $Id: lparser.c,v 1.208 2003/04/03 13:35:34 roberto Exp $ +** Lua Parser ** See Copyright Notice in lua.h */ -#include <stdio.h> #include <string.h> +#define lparser_c + #include "lua.h" #include "lcode.h" +#include "ldebug.h" #include "lfunc.h" #include "llex.h" #include "lmem.h" @@ -21,35 +23,34 @@ #include "lstring.h" -/* -** Constructors descriptor: -** `n' indicates number of elements, and `k' signals whether -** it is a list constructor (k = 0) or a record constructor (k = 1) -** or empty (k = ';' or '}') -*/ -typedef struct Constdesc { - int n; - int k; -} Constdesc; -typedef struct Breaklabel { - struct Breaklabel *previous; /* chain */ - int breaklist; - int stacklevel; -} Breaklabel; +#define getlocvar(fs, i) ((fs)->f->locvars[(fs)->actvar[i]]) + + +#define enterlevel(ls) if (++(ls)->nestlevel > LUA_MAXPARSERLEVEL) \ + luaX_syntaxerror(ls, "too many syntax levels"); +#define leavelevel(ls) ((ls)->nestlevel--) +/* +** nodes for block list (list of active blocks) +*/ +typedef struct BlockCnt { + struct BlockCnt *previous; /* chain */ + int breaklist; /* list of jumps out of this loop */ + int nactvar; /* # active local variables outside the breakable structure */ + int upval; /* true if some variable in the block is an upvalue */ + int isbreakable; /* true if `block' is a loop */ +} BlockCnt; + /* ** prototypes for recursive non-terminal functions */ -static void body (LexState *ls, int needself, int line); static void chunk (LexState *ls); -static void constructor (LexState *ls); static void expr (LexState *ls, expdesc *v); -static void exp1 (LexState *ls); @@ -65,32 +66,18 @@ static void next (LexState *ls) { static void lookahead (LexState *ls) { - LUA_ASSERT(ls->lookahead.token == TK_EOS, "two look-aheads"); + lua_assert(ls->lookahead.token == TK_EOS); ls->lookahead.token = luaX_lex(ls, &ls->lookahead.seminfo); } static void error_expected (LexState *ls, int token) { - char buff[100], t[TOKEN_LEN]; - luaX_token2str(token, t); - sprintf(buff, "`%.20s' expected", t); - luaK_error(ls, buff); + luaX_syntaxerror(ls, + luaO_pushfstring(ls->L, "`%s' expected", luaX_token2str(ls, token))); } -static void check (LexState *ls, int c) { - if (ls->t.token != c) - error_expected(ls, c); - next(ls); -} - - -static void check_condition (LexState *ls, int c, const char *msg) { - if (!c) luaK_error(ls, msg); -} - - -static int optional (LexState *ls, int c) { +static int testnext (LexState *ls, int c) { if (ls->t.token == c) { next(ls); return 1; @@ -99,40 +86,26 @@ static int optional (LexState *ls, int c) { } +static void check (LexState *ls, int c) { + if (!testnext(ls, c)) + error_expected(ls, c); +} + + +#define check_condition(ls,c,msg) { if (!(c)) luaX_syntaxerror(ls, msg); } + + + static void check_match (LexState *ls, int what, int who, int where) { - if (ls->t.token != what) { + if (!testnext(ls, what)) { if (where == ls->linenumber) error_expected(ls, what); else { - char buff[100]; - char t_what[TOKEN_LEN], t_who[TOKEN_LEN]; - luaX_token2str(what, t_what); - luaX_token2str(who, t_who); - sprintf(buff, "`%.20s' expected (to close `%.20s' at line %d)", - t_what, t_who, where); - luaK_error(ls, buff); + luaX_syntaxerror(ls, luaO_pushfstring(ls->L, + "`%s' expected (to close `%s' at line %d)", + luaX_token2str(ls, what), luaX_token2str(ls, who), where)); } } - next(ls); -} - - -static int string_constant (FuncState *fs, TString *s) { - Proto *f = fs->f; - int c = s->u.s.constindex; - if (c >= f->nkstr || f->kstr[c] != s) { - luaM_growvector(fs->L, f->kstr, f->nkstr, 1, TString *, - "constant table overflow", MAXARG_U); - c = f->nkstr++; - f->kstr[c] = s; - s->u.s.constindex = c; /* hint for next time */ - } - return c; -} - - -static void code_string (LexState *ls, TString *s) { - luaK_kstr(ls, string_constant(ls->fs, s)); } @@ -145,182 +118,224 @@ static TString *str_checkname (LexState *ls) { } -static int checkname (LexState *ls) { - return string_constant(ls->fs, str_checkname(ls)); +static void init_exp (expdesc *e, expkind k, int i) { + e->f = e->t = NO_JUMP; + e->k = k; + e->info = i; +} + + +static void codestring (LexState *ls, expdesc *e, TString *s) { + init_exp(e, VK, luaK_stringK(ls->fs, s)); +} + + +static void checkname(LexState *ls, expdesc *e) { + codestring(ls, e, str_checkname(ls)); } static int luaI_registerlocalvar (LexState *ls, TString *varname) { - Proto *f = ls->fs->f; - luaM_growvector(ls->L, f->locvars, f->nlocvars, 1, LocVar, "", MAX_INT); - f->locvars[f->nlocvars].varname = varname; - return f->nlocvars++; + FuncState *fs = ls->fs; + Proto *f = fs->f; + luaM_growvector(ls->L, f->locvars, fs->nlocvars, f->sizelocvars, + LocVar, MAX_INT, ""); + f->locvars[fs->nlocvars].varname = varname; + return fs->nlocvars++; } static void new_localvar (LexState *ls, TString *name, int n) { FuncState *fs = ls->fs; - luaX_checklimit(ls, fs->nactloc+n+1, MAXLOCALS, "local variables"); - fs->actloc[fs->nactloc+n] = luaI_registerlocalvar(ls, name); + luaX_checklimit(ls, fs->nactvar+n+1, MAXVARS, "local variables"); + fs->actvar[fs->nactvar+n] = luaI_registerlocalvar(ls, name); } static void adjustlocalvars (LexState *ls, int nvars) { FuncState *fs = ls->fs; - while (nvars--) - fs->f->locvars[fs->actloc[fs->nactloc++]].startpc = fs->pc; + fs->nactvar += nvars; + for (; nvars; nvars--) { + getlocvar(fs, fs->nactvar - nvars).startpc = fs->pc; + } } -static void removelocalvars (LexState *ls, int nvars) { +static void removevars (LexState *ls, int tolevel) { FuncState *fs = ls->fs; - while (nvars--) - fs->f->locvars[fs->actloc[--fs->nactloc]].endpc = fs->pc; + while (fs->nactvar > tolevel) + getlocvar(fs, --fs->nactvar).endpc = fs->pc; } static void new_localvarstr (LexState *ls, const char *name, int n) { - new_localvar(ls, luaS_newfixed(ls->L, name), n); + new_localvar(ls, luaS_new(ls->L, name), n); } -static int search_local (LexState *ls, TString *n, expdesc *var) { - FuncState *fs; - int level = 0; - for (fs=ls->fs; fs; fs=fs->prev) { - int i; - for (i=fs->nactloc-1; i >= 0; i--) { - if (n == fs->f->locvars[fs->actloc[i]].varname) { - var->k = VLOCAL; - var->u.index = i; - return level; - } - } - level++; /* `var' not found; check outer level */ - } - var->k = VGLOBAL; /* not found in any level; must be global */ - return -1; +static void create_local (LexState *ls, const char *name) { + new_localvarstr(ls, name, 0); + adjustlocalvars(ls, 1); } -static void singlevar (LexState *ls, TString *n, expdesc *var) { - int level = search_local(ls, n, var); - if (level >= 1) /* neither local (0) nor global (-1)? */ - luaX_syntaxerror(ls, "cannot access a variable in outer scope", n->str); - else if (level == -1) /* global? */ - var->u.index = string_constant(ls->fs, n); +static int indexupvalue (FuncState *fs, TString *name, expdesc *v) { + int i; + Proto *f = fs->f; + for (i=0; i<f->nups; i++) { + if (fs->upvalues[i].k == v->k && fs->upvalues[i].info == v->info) { + lua_assert(fs->f->upvalues[i] == name); + return i; + } + } + /* new one */ + luaX_checklimit(fs->ls, f->nups + 1, MAXUPVALUES, "upvalues"); + luaM_growvector(fs->L, fs->f->upvalues, f->nups, fs->f->sizeupvalues, + TString *, MAX_INT, ""); + fs->f->upvalues[f->nups] = name; + fs->upvalues[f->nups] = *v; + return f->nups++; } -static int indexupvalue (LexState *ls, expdesc *v) { - FuncState *fs = ls->fs; +static int searchvar (FuncState *fs, TString *n) { int i; - for (i=0; i<fs->nupvalues; i++) { - if (fs->upvalues[i].k == v->k && fs->upvalues[i].u.index == v->u.index) + for (i=fs->nactvar-1; i >= 0; i--) { + if (n == getlocvar(fs, i).varname) return i; } - /* new one */ - luaX_checklimit(ls, fs->nupvalues+1, MAXUPVALUES, "upvalues"); - fs->upvalues[fs->nupvalues] = *v; - return fs->nupvalues++; + return -1; /* not found */ } -static void pushupvalue (LexState *ls, TString *n) { - FuncState *fs = ls->fs; - expdesc v; - int level = search_local(ls, n, &v); - if (level == -1) { /* global? */ - if (fs->prev == NULL) - luaX_syntaxerror(ls, "cannot access upvalue in main", n->str); - v.u.index = string_constant(fs->prev, n); +static void markupval (FuncState *fs, int level) { + BlockCnt *bl = fs->bl; + while (bl && bl->nactvar > level) bl = bl->previous; + if (bl) bl->upval = 1; +} + + +static void singlevaraux (FuncState *fs, TString *n, expdesc *var, int base) { + if (fs == NULL) /* no more levels? */ + init_exp(var, VGLOBAL, NO_REG); /* default is global variable */ + else { + int v = searchvar(fs, n); /* look up at current level */ + if (v >= 0) { + init_exp(var, VLOCAL, v); + if (!base) + markupval(fs, v); /* local will be used as an upval */ + } + else { /* not found at current level; try upper one */ + singlevaraux(fs->prev, n, var, 0); + if (var->k == VGLOBAL) { + if (base) + var->info = luaK_stringK(fs, n); /* info points to global name */ + } + else { /* LOCAL or UPVAL */ + var->info = indexupvalue(fs, n, var); + var->k = VUPVAL; /* upvalue in this level */ + } + } } - else if (level != 1) - luaX_syntaxerror(ls, - "upvalue must be global or local to immediately outer scope", n->str); - luaK_code1(fs, OP_PUSHUPVALUE, indexupvalue(ls, &v)); } -static void adjust_mult_assign (LexState *ls, int nvars, int nexps) { +static TString *singlevar (LexState *ls, expdesc *var, int base) { + TString *varname = str_checkname(ls); + singlevaraux(ls->fs, varname, var, base); + return varname; +} + + +static void adjust_assign (LexState *ls, int nvars, int nexps, expdesc *e) { FuncState *fs = ls->fs; - int diff = nexps - nvars; - if (nexps > 0 && luaK_lastisopen(fs)) { /* list ends in a function call */ - diff--; /* do not count function call itself */ - if (diff <= 0) { /* more variables than values? */ - luaK_setcallreturns(fs, -diff); /* function call provide extra values */ - diff = 0; /* no more difference */ + int extra = nvars - nexps; + if (e->k == VCALL) { + extra++; /* includes call itself */ + if (extra <= 0) extra = 0; + else luaK_reserveregs(fs, extra-1); + luaK_setcallreturns(fs, e, extra); /* call provides the difference */ + } + else { + if (e->k != VVOID) luaK_exp2nextreg(fs, e); /* close last expression */ + if (extra > 0) { + int reg = fs->freereg; + luaK_reserveregs(fs, extra); + luaK_nil(fs, reg, extra); } - else /* more values than variables */ - luaK_setcallreturns(fs, 0); /* call should provide no value */ } - /* push or pop eventual difference between list lengths */ - luaK_adjuststack(fs, diff); } static void code_params (LexState *ls, int nparams, int dots) { FuncState *fs = ls->fs; adjustlocalvars(ls, nparams); - luaX_checklimit(ls, fs->nactloc, MAXPARAMS, "parameters"); - fs->f->numparams = fs->nactloc; /* `self' could be there already */ - fs->f->is_vararg = dots; - if (dots) { - new_localvarstr(ls, "arg", 0); - adjustlocalvars(ls, 1); - } - luaK_deltastack(fs, fs->nactloc); /* count parameters in the stack */ + luaX_checklimit(ls, fs->nactvar, MAXPARAMS, "parameters"); + fs->f->numparams = cast(lu_byte, fs->nactvar); + fs->f->is_vararg = cast(lu_byte, dots); + if (dots) + create_local(ls, "arg"); + luaK_reserveregs(fs, fs->nactvar); /* reserve register for parameters */ } -static void enterbreak (FuncState *fs, Breaklabel *bl) { - bl->stacklevel = fs->stacklevel; +static void enterblock (FuncState *fs, BlockCnt *bl, int isbreakable) { bl->breaklist = NO_JUMP; + bl->isbreakable = isbreakable; + bl->nactvar = fs->nactvar; + bl->upval = 0; bl->previous = fs->bl; fs->bl = bl; + lua_assert(fs->freereg == fs->nactvar); } -static void leavebreak (FuncState *fs, Breaklabel *bl) { +static void leaveblock (FuncState *fs) { + BlockCnt *bl = fs->bl; fs->bl = bl->previous; - LUA_ASSERT(bl->stacklevel == fs->stacklevel, "wrong levels"); - luaK_patchlist(fs, bl->breaklist, luaK_getlabel(fs)); + removevars(fs->ls, bl->nactvar); + if (bl->upval) + luaK_codeABC(fs, OP_CLOSE, bl->nactvar, 0, 0); + lua_assert(bl->nactvar == fs->nactvar); + fs->freereg = fs->nactvar; /* free registers */ + luaK_patchtohere(fs, bl->breaklist); } -static void pushclosure (LexState *ls, FuncState *func) { +static void pushclosure (LexState *ls, FuncState *func, expdesc *v) { FuncState *fs = ls->fs; Proto *f = fs->f; int i; - for (i=0; i<func->nupvalues; i++) - luaK_tostack(ls, &func->upvalues[i], 1); - luaM_growvector(ls->L, f->kproto, f->nkproto, 1, Proto *, - "constant table overflow", MAXARG_A); - f->kproto[f->nkproto++] = func->f; - luaK_code2(fs, OP_CLOSURE, f->nkproto-1, func->nupvalues); + luaM_growvector(ls->L, f->p, fs->np, f->sizep, Proto *, + MAXARG_Bx, "constant table overflow"); + f->p[fs->np++] = func->f; + init_exp(v, VRELOCABLE, luaK_codeABx(fs, OP_CLOSURE, 0, fs->np-1)); + for (i=0; i<func->f->nups; i++) { + OpCode o = (func->upvalues[i].k == VLOCAL) ? OP_MOVE : OP_GETUPVAL; + luaK_codeABC(fs, o, 0, func->upvalues[i].info, 0); + } } static void open_func (LexState *ls, FuncState *fs) { Proto *f = luaF_newproto(ls->L); + fs->f = f; fs->prev = ls->fs; /* linked list of funcstates */ fs->ls = ls; fs->L = ls->L; ls->fs = fs; - fs->stacklevel = 0; - fs->nactloc = 0; - fs->nupvalues = 0; - fs->bl = NULL; - fs->f = f; - f->source = ls->source; fs->pc = 0; fs->lasttarget = 0; - fs->lastline = 0; - fs->jlt = NO_JUMP; - f->code = NULL; - f->maxstacksize = 0; - f->numparams = 0; /* default for main chunk */ - f->is_vararg = 0; /* default for main chunk */ + fs->jpc = NO_JUMP; + fs->freereg = 0; + fs->nk = 0; + fs->h = luaH_new(ls->L, 0, 0); + fs->np = 0; + fs->nlocvars = 0; + fs->nactvar = 0; + fs->bl = NULL; + f->source = ls->source; + f->maxstacksize = 2; /* registers 0/1 are always valid */ } @@ -328,33 +343,40 @@ static void close_func (LexState *ls) { lua_State *L = ls->L; FuncState *fs = ls->fs; Proto *f = fs->f; - luaK_code0(fs, OP_END); - luaK_getlabel(fs); /* close eventual list of pending jumps */ - luaM_reallocvector(L, f->code, fs->pc, Instruction); - luaM_reallocvector(L, f->kstr, f->nkstr, TString *); - luaM_reallocvector(L, f->knum, f->nknum, Number); - luaM_reallocvector(L, f->kproto, f->nkproto, Proto *); - removelocalvars(ls, fs->nactloc); - luaM_reallocvector(L, f->locvars, f->nlocvars, LocVar); - luaM_reallocvector(L, f->lineinfo, f->nlineinfo+1, int); - f->lineinfo[f->nlineinfo++] = MAX_INT; /* end flag */ - luaF_protook(L, f, fs->pc); /* proto is ok now */ + removevars(ls, 0); + luaK_codeABC(fs, OP_RETURN, 0, 1, 0); /* final return */ + luaM_reallocvector(L, f->code, f->sizecode, fs->pc, Instruction); + f->sizecode = fs->pc; + luaM_reallocvector(L, f->lineinfo, f->sizelineinfo, fs->pc, int); + f->sizelineinfo = fs->pc; + luaM_reallocvector(L, f->k, f->sizek, fs->nk, TObject); + f->sizek = fs->nk; + luaM_reallocvector(L, f->p, f->sizep, fs->np, Proto *); + f->sizep = fs->np; + luaM_reallocvector(L, f->locvars, f->sizelocvars, fs->nlocvars, LocVar); + f->sizelocvars = fs->nlocvars; + luaM_reallocvector(L, f->upvalues, f->sizeupvalues, f->nups, TString *); + f->sizeupvalues = f->nups; + lua_assert(luaG_checkcode(f)); + lua_assert(fs->bl == NULL); ls->fs = fs->prev; - LUA_ASSERT(fs->bl == NULL, "wrong list end"); } -Proto *luaY_parser (lua_State *L, ZIO *z) { +Proto *luaY_parser (lua_State *L, ZIO *z, Mbuffer *buff) { struct LexState lexstate; struct FuncState funcstate; + lexstate.buff = buff; + lexstate.nestlevel = 0; luaX_setinput(L, &lexstate, z, luaS_new(L, zname(z))); open_func(&lexstate, &funcstate); next(&lexstate); /* read first token */ chunk(&lexstate); check_condition(&lexstate, (lexstate.t.token == TK_EOS), "<eof> expected"); close_func(&lexstate); - LUA_ASSERT(funcstate.prev == NULL, "wrong list end"); - LUA_ASSERT(funcstate.nupvalues == 0, "no upvalues in main"); + lua_assert(funcstate.prev == NULL); + lua_assert(funcstate.f->nups == 0); + lua_assert(lexstate.nestlevel == 0); return funcstate.f; } @@ -365,235 +387,239 @@ Proto *luaY_parser (lua_State *L, ZIO *z) { /*============================================================*/ -static int explist1 (LexState *ls) { - /* explist1 -> expr { ',' expr } */ - int n = 1; /* at least one expression */ - expdesc v; - expr(ls, &v); - while (ls->t.token == ',') { - luaK_tostack(ls, &v, 1); /* gets only 1 value from previous expression */ - next(ls); /* skip comma */ - expr(ls, &v); - n++; - } - luaK_tostack(ls, &v, 0); /* keep open number of values of last expression */ - return n; +static void luaY_field (LexState *ls, expdesc *v) { + /* field -> ['.' | ':'] NAME */ + FuncState *fs = ls->fs; + expdesc key; + luaK_exp2anyreg(fs, v); + next(ls); /* skip the dot or colon */ + checkname(ls, &key); + luaK_indexed(fs, v, &key); } -static void funcargs (LexState *ls, int slf) { +static void luaY_index (LexState *ls, expdesc *v) { + /* index -> '[' expr ']' */ + next(ls); /* skip the '[' */ + expr(ls, v); + luaK_exp2val(ls->fs, v); + check(ls, ']'); +} + + +/* +** {====================================================================== +** Rules for Constructors +** ======================================================================= +*/ + + +struct ConsControl { + expdesc v; /* last list item read */ + expdesc *t; /* table descriptor */ + int nh; /* total number of `record' elements */ + int na; /* total number of array elements */ + int tostore; /* number of array elements pending to be stored */ +}; + + +static void recfield (LexState *ls, struct ConsControl *cc) { + /* recfield -> (NAME | `['exp1`]') = exp1 */ FuncState *fs = ls->fs; - int slevel = fs->stacklevel - slf - 1; /* where is func in the stack */ - switch (ls->t.token) { - case '(': { /* funcargs -> '(' [ explist1 ] ')' */ - int line = ls->linenumber; - int nargs = 0; - next(ls); - if (ls->t.token != ')') /* arg list not empty? */ - nargs = explist1(ls); - check_match(ls, ')', '(', line); -#ifdef LUA_COMPAT_ARGRET - if (nargs > 0) /* arg list is not empty? */ - luaK_setcallreturns(fs, 1); /* last call returns only 1 value */ -#else - UNUSED(nargs); /* to avoid warnings */ -#endif - break; - } - case '{': { /* funcargs -> constructor */ - constructor(ls); - break; - } - case TK_STRING: { /* funcargs -> STRING */ - code_string(ls, ls->t.seminfo.ts); /* must use `seminfo' before `next' */ - next(ls); - break; - } - default: { - luaK_error(ls, "function arguments expected"); - break; - } + int reg = ls->fs->freereg; + expdesc key, val; + if (ls->t.token == TK_NAME) { + luaX_checklimit(ls, cc->nh, MAX_INT, "items in a constructor"); + cc->nh++; + checkname(ls, &key); + } + else /* ls->t.token == '[' */ + luaY_index(ls, &key); + check(ls, '='); + luaK_exp2RK(fs, &key); + expr(ls, &val); + luaK_codeABC(fs, OP_SETTABLE, cc->t->info, luaK_exp2RK(fs, &key), + luaK_exp2RK(fs, &val)); + fs->freereg = reg; /* free registers */ +} + + +static void closelistfield (FuncState *fs, struct ConsControl *cc) { + if (cc->v.k == VVOID) return; /* there is no list item */ + luaK_exp2nextreg(fs, &cc->v); + cc->v.k = VVOID; + if (cc->tostore == LFIELDS_PER_FLUSH) { + luaK_codeABx(fs, OP_SETLIST, cc->t->info, cc->na-1); /* flush */ + cc->tostore = 0; /* no more items pending */ + fs->freereg = cc->t->info + 1; /* free registers */ } - fs->stacklevel = slevel; /* call will remove function and arguments */ - luaK_code2(fs, OP_CALL, slevel, MULT_RET); } -static void var_or_func_tail (LexState *ls, expdesc *v) { - for (;;) { - switch (ls->t.token) { - case '.': { /* var_or_func_tail -> '.' NAME */ - next(ls); - luaK_tostack(ls, v, 1); /* `v' must be on stack */ - luaK_kstr(ls, checkname(ls)); - v->k = VINDEXED; - break; - } - case '[': { /* var_or_func_tail -> '[' exp1 ']' */ - next(ls); - luaK_tostack(ls, v, 1); /* `v' must be on stack */ - v->k = VINDEXED; - exp1(ls); - check(ls, ']'); +static void lastlistfield (FuncState *fs, struct ConsControl *cc) { + if (cc->tostore == 0) return; + if (cc->v.k == VCALL) { + luaK_setcallreturns(fs, &cc->v, LUA_MULTRET); + luaK_codeABx(fs, OP_SETLISTO, cc->t->info, cc->na-1); + } + else { + if (cc->v.k != VVOID) + luaK_exp2nextreg(fs, &cc->v); + luaK_codeABx(fs, OP_SETLIST, cc->t->info, cc->na-1); + } + fs->freereg = cc->t->info + 1; /* free registers */ +} + + +static void listfield (LexState *ls, struct ConsControl *cc) { + expr(ls, &cc->v); + luaX_checklimit(ls, cc->na, MAXARG_Bx, "items in a constructor"); + cc->na++; + cc->tostore++; +} + + +static void constructor (LexState *ls, expdesc *t) { + /* constructor -> ?? */ + FuncState *fs = ls->fs; + int line = ls->linenumber; + int pc = luaK_codeABC(fs, OP_NEWTABLE, 0, 0, 0); + struct ConsControl cc; + cc.na = cc.nh = cc.tostore = 0; + cc.t = t; + init_exp(t, VRELOCABLE, pc); + init_exp(&cc.v, VVOID, 0); /* no value (yet) */ + luaK_exp2nextreg(ls->fs, t); /* fix it at stack top (for gc) */ + check(ls, '{'); + do { + lua_assert(cc.v.k == VVOID || cc.tostore > 0); + testnext(ls, ';'); /* compatibility only */ + if (ls->t.token == '}') break; + closelistfield(fs, &cc); + switch(ls->t.token) { + case TK_NAME: { /* may be listfields or recfields */ + lookahead(ls); + if (ls->lookahead.token != '=') /* expression? */ + listfield(ls, &cc); + else + recfield(ls, &cc); break; } - case ':': { /* var_or_func_tail -> ':' NAME funcargs */ - int name; - next(ls); - name = checkname(ls); - luaK_tostack(ls, v, 1); /* `v' must be on stack */ - luaK_code1(ls->fs, OP_PUSHSELF, name); - funcargs(ls, 1); - v->k = VEXP; - v->u.l.t = v->u.l.f = NO_JUMP; + case '[': { /* constructor_item -> recfield */ + recfield(ls, &cc); break; } - case '(': case TK_STRING: case '{': { /* var_or_func_tail -> funcargs */ - luaK_tostack(ls, v, 1); /* `v' must be on stack */ - funcargs(ls, 0); - v->k = VEXP; - v->u.l.t = v->u.l.f = NO_JUMP; + default: { /* constructor_part -> listfield */ + listfield(ls, &cc); break; } - default: return; /* should be follow... */ } - } -} - - -static void var_or_func (LexState *ls, expdesc *v) { - /* var_or_func -> ['%'] NAME var_or_func_tail */ - if (optional(ls, '%')) { /* upvalue? */ - pushupvalue(ls, str_checkname(ls)); - v->k = VEXP; - v->u.l.t = v->u.l.f = NO_JUMP; - } - else /* variable name */ - singlevar(ls, str_checkname(ls), v); - var_or_func_tail(ls, v); + } while (testnext(ls, ',') || testnext(ls, ';')); + check_match(ls, '}', '{', line); + lastlistfield(fs, &cc); + SETARG_B(fs->f->code[pc], luaO_int2fb(cc.na)); /* set initial array size */ + SETARG_C(fs->f->code[pc], luaO_log2(cc.nh)+1); /* set initial table size */ } +/* }====================================================================== */ -/* -** {====================================================================== -** Rules for Constructors -** ======================================================================= -*/ - -static void recfield (LexState *ls) { - /* recfield -> (NAME | '['exp1']') = exp1 */ - switch (ls->t.token) { - case TK_NAME: { - luaK_kstr(ls, checkname(ls)); - break; - } - case '[': { - next(ls); - exp1(ls); - check(ls, ']'); - break; - } - default: luaK_error(ls, "<name> or `[' expected"); +static void parlist (LexState *ls) { + /* parlist -> [ param { `,' param } ] */ + int nparams = 0; + int dots = 0; + if (ls->t.token != ')') { /* is `parlist' not empty? */ + do { + switch (ls->t.token) { + case TK_DOTS: dots = 1; next(ls); break; + case TK_NAME: new_localvar(ls, str_checkname(ls), nparams++); break; + default: luaX_syntaxerror(ls, "<name> or `...' expected"); + } + } while (!dots && testnext(ls, ',')); } - check(ls, '='); - exp1(ls); + code_params(ls, nparams, dots); } -static int recfields (LexState *ls) { - /* recfields -> recfield { ',' recfield } [','] */ - FuncState *fs = ls->fs; - int n = 1; /* at least one element */ - recfield(ls); - while (ls->t.token == ',') { - next(ls); - if (ls->t.token == ';' || ls->t.token == '}') - break; - recfield(ls); - n++; - if (n%RFIELDS_PER_FLUSH == 0) - luaK_code1(fs, OP_SETMAP, RFIELDS_PER_FLUSH); - } - luaK_code1(fs, OP_SETMAP, n%RFIELDS_PER_FLUSH); - return n; +static void body (LexState *ls, expdesc *e, int needself, int line) { + /* body -> `(' parlist `)' chunk END */ + FuncState new_fs; + open_func(ls, &new_fs); + new_fs.f->lineDefined = line; + check(ls, '('); + if (needself) + create_local(ls, "self"); + parlist(ls); + check(ls, ')'); + chunk(ls); + check_match(ls, TK_END, TK_FUNCTION, line); + close_func(ls); + pushclosure(ls, &new_fs, e); } -static int listfields (LexState *ls) { - /* listfields -> exp1 { ',' exp1 } [','] */ - FuncState *fs = ls->fs; - int n = 1; /* at least one element */ - exp1(ls); - while (ls->t.token == ',') { - next(ls); - if (ls->t.token == ';' || ls->t.token == '}') - break; - exp1(ls); +static int explist1 (LexState *ls, expdesc *v) { + /* explist1 -> expr { `,' expr } */ + int n = 1; /* at least one expression */ + expr(ls, v); + while (testnext(ls, ',')) { + luaK_exp2nextreg(ls->fs, v); + expr(ls, v); n++; - luaX_checklimit(ls, n/LFIELDS_PER_FLUSH, MAXARG_A, - "`item groups' in a list initializer"); - if (n%LFIELDS_PER_FLUSH == 0) - luaK_code2(fs, OP_SETLIST, n/LFIELDS_PER_FLUSH - 1, LFIELDS_PER_FLUSH); } - luaK_code2(fs, OP_SETLIST, n/LFIELDS_PER_FLUSH, n%LFIELDS_PER_FLUSH); return n; } - -static void constructor_part (LexState *ls, Constdesc *cd) { +static void funcargs (LexState *ls, expdesc *f) { + FuncState *fs = ls->fs; + expdesc args; + int base, nparams; + int line = ls->linenumber; switch (ls->t.token) { - case ';': case '}': { /* constructor_part -> empty */ - cd->n = 0; - cd->k = ls->t.token; + case '(': { /* funcargs -> `(' [ explist1 ] `)' */ + if (line != ls->lastline) + luaX_syntaxerror(ls,"ambiguous syntax (function call x new statement)"); + next(ls); + if (ls->t.token == ')') /* arg list is empty? */ + args.k = VVOID; + else { + explist1(ls, &args); + luaK_setcallreturns(fs, &args, LUA_MULTRET); + } + check_match(ls, ')', '(', line); break; } - case TK_NAME: { /* may be listfields or recfields */ - lookahead(ls); - if (ls->lookahead.token != '=') /* expression? */ - goto case_default; - /* else go through to recfields */ - } - case '[': { /* constructor_part -> recfields */ - cd->n = recfields(ls); - cd->k = 1; /* record */ + case '{': { /* funcargs -> constructor */ + constructor(ls, &args); break; } - default: { /* constructor_part -> listfields */ - case_default: - cd->n = listfields(ls); - cd->k = 0; /* list */ + case TK_STRING: { /* funcargs -> STRING */ + codestring(ls, &args, ls->t.seminfo.ts); + next(ls); /* must use `seminfo' before `next' */ break; } + default: { + luaX_syntaxerror(ls, "function arguments expected"); + return; + } } -} - - -static void constructor (LexState *ls) { - /* constructor -> '{' constructor_part [';' constructor_part] '}' */ - FuncState *fs = ls->fs; - int line = ls->linenumber; - int pc = luaK_code1(fs, OP_CREATETABLE, 0); - int nelems; - Constdesc cd; - check(ls, '{'); - constructor_part(ls, &cd); - nelems = cd.n; - if (optional(ls, ';')) { - Constdesc other_cd; - constructor_part(ls, &other_cd); - check_condition(ls, (cd.k != other_cd.k), "invalid constructor syntax"); - nelems += other_cd.n; + lua_assert(f->k == VNONRELOC); + base = f->info; /* base register for call */ + if (args.k == VCALL) + nparams = LUA_MULTRET; /* open call */ + else { + if (args.k != VVOID) + luaK_exp2nextreg(fs, &args); /* close last argument */ + nparams = fs->freereg - (base+1); } - check_match(ls, '}', '{', line); - luaX_checklimit(ls, nelems, MAXARG_U, "elements in a table constructor"); - SETARG_U(fs->f->code[pc], nelems); /* set initial table size */ + init_exp(f, VCALL, luaK_codeABC(fs, OP_CALL, base, nparams+1, 2)); + luaK_fixline(fs, line); + fs->freereg = base+1; /* call remove function and arguments and leaves + (unless changed) one result */ } -/* }====================================================================== */ - @@ -604,58 +630,121 @@ static void constructor (LexState *ls) { */ -static void simpleexp (LexState *ls, expdesc *v) { - FuncState *fs = ls->fs; +static void prefixexp (LexState *ls, expdesc *v) { + /* prefixexp -> NAME | '(' expr ')' */ switch (ls->t.token) { - case TK_NUMBER: { /* simpleexp -> NUMBER */ - Number r = ls->t.seminfo.r; + case '(': { + int line = ls->linenumber; next(ls); - luaK_number(fs, r); + expr(ls, v); + check_match(ls, ')', '(', line); + luaK_dischargevars(ls->fs, v); + return; + } + case TK_NAME: { + singlevar(ls, v, 1); + return; + } +#ifdef LUA_COMPATUPSYNTAX + case '%': { /* for compatibility only */ + TString *varname; + int line = ls->linenumber; + next(ls); /* skip `%' */ + varname = singlevar(ls, v, 1); + if (v->k != VUPVAL) + luaX_errorline(ls, "global upvalues are obsolete", + getstr(varname), line); + return; + } +#endif + default: { + luaX_syntaxerror(ls, "unexpected symbol"); + return; + } + } +} + + +static void primaryexp (LexState *ls, expdesc *v) { + /* primaryexp -> + prefixexp { `.' NAME | `[' exp `]' | `:' NAME funcargs | funcargs } */ + FuncState *fs = ls->fs; + prefixexp(ls, v); + for (;;) { + switch (ls->t.token) { + case '.': { /* field */ + luaY_field(ls, v); + break; + } + case '[': { /* `[' exp1 `]' */ + expdesc key; + luaK_exp2anyreg(fs, v); + luaY_index(ls, &key); + luaK_indexed(fs, v, &key); + break; + } + case ':': { /* `:' NAME funcargs */ + expdesc key; + next(ls); + checkname(ls, &key); + luaK_self(fs, v, &key); + funcargs(ls, v); + break; + } + case '(': case TK_STRING: case '{': { /* funcargs */ + luaK_exp2nextreg(fs, v); + funcargs(ls, v); + break; + } + default: return; + } + } +} + + +static void simpleexp (LexState *ls, expdesc *v) { + /* simpleexp -> NUMBER | STRING | NIL | constructor | FUNCTION body + | primaryexp */ + switch (ls->t.token) { + case TK_NUMBER: { + init_exp(v, VK, luaK_numberK(ls->fs, ls->t.seminfo.r)); + next(ls); /* must use `seminfo' before `next' */ break; } - case TK_STRING: { /* simpleexp -> STRING */ - code_string(ls, ls->t.seminfo.ts); /* must use `seminfo' before `next' */ - next(ls); + case TK_STRING: { + codestring(ls, v, ls->t.seminfo.ts); + next(ls); /* must use `seminfo' before `next' */ break; } - case TK_NIL: { /* simpleexp -> NIL */ - luaK_adjuststack(fs, -1); + case TK_NIL: { + init_exp(v, VNIL, 0); next(ls); break; } - case '{': { /* simpleexp -> constructor */ - constructor(ls); + case TK_TRUE: { + init_exp(v, VTRUE, 0); + next(ls); break; } - case TK_FUNCTION: { /* simpleexp -> FUNCTION body */ + case TK_FALSE: { + init_exp(v, VFALSE, 0); next(ls); - body(ls, 0, ls->linenumber); break; } - case '(': { /* simpleexp -> '(' expr ')' */ - next(ls); - expr(ls, v); - check(ls, ')'); - return; + case '{': { /* constructor */ + constructor(ls, v); + break; } - case TK_NAME: case '%': { - var_or_func(ls, v); - return; + case TK_FUNCTION: { + next(ls); + body(ls, v, 0, ls->linenumber); + break; } default: { - luaK_error(ls, "<expression> expected"); - return; + primaryexp(ls, v); + break; } } - v->k = VEXP; - v->u.l.t = v->u.l.f = NO_JUMP; -} - - -static void exp1 (LexState *ls) { - expdesc v; - expr(ls, &v); - luaK_tostack(ls, &v, 1); } @@ -690,17 +779,17 @@ static BinOpr getbinopr (int op) { static const struct { - char left; /* left priority for each binary operator */ - char right; /* right priority */ + lu_byte left; /* left priority for each binary operator */ + lu_byte right; /* right priority */ } priority[] = { /* ORDER OPR */ - {5, 5}, {5, 5}, {6, 6}, {6, 6}, /* arithmetic */ - {9, 8}, {4, 3}, /* power and concat (right associative) */ - {2, 2}, {2, 2}, /* equality */ - {2, 2}, {2, 2}, {2, 2}, {2, 2}, /* order */ - {1, 1}, {1, 1} /* logical */ + {6, 6}, {6, 6}, {7, 7}, {7, 7}, /* arithmetic */ + {10, 9}, {5, 4}, /* power and concat (right associative) */ + {3, 3}, {3, 3}, /* equality */ + {3, 3}, {3, 3}, {3, 3}, {3, 3}, /* order */ + {2, 2}, {1, 1} /* logical (and/or) */ }; -#define UNARY_PRIORITY 7 /* priority for unary operators */ +#define UNARY_PRIORITY 8 /* priority for unary operators */ /* @@ -709,25 +798,28 @@ static const struct { */ static BinOpr subexpr (LexState *ls, expdesc *v, int limit) { BinOpr op; - UnOpr uop = getunopr(ls->t.token); + UnOpr uop; + enterlevel(ls); + uop = getunopr(ls->t.token); if (uop != OPR_NOUNOPR) { next(ls); subexpr(ls, v, UNARY_PRIORITY); - luaK_prefix(ls, uop, v); + luaK_prefix(ls->fs, uop, v); } else simpleexp(ls, v); /* expand while operators have priorities higher than `limit' */ op = getbinopr(ls->t.token); - while (op != OPR_NOBINOPR && priority[op].left > limit) { + while (op != OPR_NOBINOPR && cast(int, priority[op].left) > limit) { expdesc v2; BinOpr nextop; next(ls); - luaK_infix(ls, op, v); + luaK_infix(ls->fs, op, v); /* read sub-expression with higher priority */ - nextop = subexpr(ls, &v2, priority[op].right); - luaK_posfix(ls, op, v, &v2); + nextop = subexpr(ls, &v2, cast(int, priority[op].right)); + luaK_posfix(ls->fs, op, v, &v2); op = nextop; } + leavelevel(ls); return op; /* return first untreated operator */ } @@ -739,6 +831,7 @@ static void expr (LexState *ls, expdesc *v) { /* }==================================================================== */ + /* ** {====================================================================== ** Rules for Statements @@ -759,61 +852,151 @@ static int block_follow (int token) { static void block (LexState *ls) { /* block -> chunk */ FuncState *fs = ls->fs; - int nactloc = fs->nactloc; + BlockCnt bl; + enterblock(fs, &bl, 0); chunk(ls); - luaK_adjuststack(fs, fs->nactloc - nactloc); /* remove local variables */ - removelocalvars(ls, fs->nactloc - nactloc); + lua_assert(bl.breaklist == NO_JUMP); + leaveblock(fs); } -static int assignment (LexState *ls, expdesc *v, int nvars) { - int left = 0; /* number of values left in the stack after assignment */ - luaX_checklimit(ls, nvars, MAXVARSLH, "variables in a multiple assignment"); - if (ls->t.token == ',') { /* assignment -> ',' NAME assignment */ - expdesc nv; - next(ls); - var_or_func(ls, &nv); - check_condition(ls, (nv.k != VEXP), "syntax error"); - left = assignment(ls, &nv, nvars+1); +/* +** structure to chain all variables in the left-hand side of an +** assignment +*/ +struct LHS_assign { + struct LHS_assign *prev; + expdesc v; /* variable (global, local, upvalue, or indexed) */ +}; + + +/* +** check whether, in an assignment to a local variable, the local variable +** is needed in a previous assignment (to a table). If so, save original +** local value in a safe place and use this safe copy in the previous +** assignment. +*/ +static void check_conflict (LexState *ls, struct LHS_assign *lh, expdesc *v) { + FuncState *fs = ls->fs; + int extra = fs->freereg; /* eventual position to save local variable */ + int conflict = 0; + for (; lh; lh = lh->prev) { + if (lh->v.k == VINDEXED) { + if (lh->v.info == v->info) { /* conflict? */ + conflict = 1; + lh->v.info = extra; /* previous assignment will use safe copy */ + } + if (lh->v.aux == v->info) { /* conflict? */ + conflict = 1; + lh->v.aux = extra; /* previous assignment will use safe copy */ + } + } + } + if (conflict) { + luaK_codeABC(fs, OP_MOVE, fs->freereg, v->info, 0); /* make copy */ + luaK_reserveregs(fs, 1); } - else { /* assignment -> '=' explist1 */ +} + + +static void assignment (LexState *ls, struct LHS_assign *lh, int nvars) { + expdesc e; + check_condition(ls, VLOCAL <= lh->v.k && lh->v.k <= VINDEXED, + "syntax error"); + if (testnext(ls, ',')) { /* assignment -> `,' primaryexp assignment */ + struct LHS_assign nv; + nv.prev = lh; + primaryexp(ls, &nv.v); + if (nv.v.k == VLOCAL) + check_conflict(ls, lh, &nv.v); + assignment(ls, &nv, nvars+1); + } + else { /* assignment -> `=' explist1 */ int nexps; check(ls, '='); - nexps = explist1(ls); - adjust_mult_assign(ls, nvars, nexps); - } - if (v->k != VINDEXED) - luaK_storevar(ls, v); - else { /* there may be garbage between table-index and value */ - luaK_code2(ls->fs, OP_SETTABLE, left+nvars+2, 1); - left += 2; + nexps = explist1(ls, &e); + if (nexps != nvars) { + adjust_assign(ls, nvars, nexps, &e); + if (nexps > nvars) + ls->fs->freereg -= nexps - nvars; /* remove extra values */ + } + else { + luaK_setcallreturns(ls->fs, &e, 1); /* close last expression */ + luaK_storevar(ls->fs, &lh->v, &e); + return; /* avoid default */ + } } - return left; + init_exp(&e, VNONRELOC, ls->fs->freereg-1); /* default assignment */ + luaK_storevar(ls->fs, &lh->v, &e); } static void cond (LexState *ls, expdesc *v) { /* cond -> exp */ expr(ls, v); /* read condition */ - luaK_goiftrue(ls->fs, v, 0); + if (v->k == VNIL) v->k = VFALSE; /* `falses' are all equal here */ + luaK_goiftrue(ls->fs, v); + luaK_patchtohere(ls->fs, v->t); } +/* +** The while statement optimizes its code by coding the condition +** after its body (and thus avoiding one jump in the loop). +*/ + +/* +** maximum size of expressions for optimizing `while' code +*/ +#ifndef MAXEXPWHILE +#define MAXEXPWHILE 100 +#endif + +/* +** the call `luaK_goiffalse' may grow the size of an expression by +** at most this: +*/ +#define EXTRAEXP 5 + static void whilestat (LexState *ls, int line) { /* whilestat -> WHILE cond DO block END */ + Instruction codeexp[MAXEXPWHILE + EXTRAEXP]; + int lineexp; + int i; + int sizeexp; FuncState *fs = ls->fs; - int while_init = luaK_getlabel(fs); + int whileinit, blockinit, expinit; expdesc v; - Breaklabel bl; - enterbreak(fs, &bl); - next(ls); - cond(ls, &v); + BlockCnt bl; + next(ls); /* skip WHILE */ + whileinit = luaK_jump(fs); /* jump to condition (which will be moved) */ + expinit = luaK_getlabel(fs); + expr(ls, &v); /* parse condition */ + if (v.k == VK) v.k = VTRUE; /* `trues' are all equal here */ + lineexp = ls->linenumber; + luaK_goiffalse(fs, &v); + luaK_concat(fs, &v.f, fs->jpc); + fs->jpc = NO_JUMP; + sizeexp = fs->pc - expinit; /* size of expression code */ + if (sizeexp > MAXEXPWHILE) + luaX_syntaxerror(ls, "`while' condition too complex"); + for (i = 0; i < sizeexp; i++) /* save `exp' code */ + codeexp[i] = fs->f->code[expinit + i]; + fs->pc = expinit; /* remove `exp' code */ + enterblock(fs, &bl, 1); check(ls, TK_DO); + blockinit = luaK_getlabel(fs); block(ls); - luaK_patchlist(fs, luaK_jump(fs), while_init); - luaK_patchlist(fs, v.u.l.f, luaK_getlabel(fs)); + luaK_patchtohere(fs, whileinit); /* initial jump jumps to here */ + /* move `exp' back to code */ + if (v.t != NO_JUMP) v.t += fs->pc - expinit; + if (v.f != NO_JUMP) v.f += fs->pc - expinit; + for (i=0; i<sizeexp; i++) + luaK_code(fs, codeexp[i], lineexp); check_match(ls, TK_END, TK_WHILE, line); - leavebreak(fs, &bl); + leaveblock(fs); + luaK_patchlist(fs, v.t, blockinit); /* true conditions go back to loop */ + luaK_patchtohere(fs, v.f); /* false conditions finish the loop */ } @@ -822,64 +1005,86 @@ static void repeatstat (LexState *ls, int line) { FuncState *fs = ls->fs; int repeat_init = luaK_getlabel(fs); expdesc v; - Breaklabel bl; - enterbreak(fs, &bl); + BlockCnt bl; + enterblock(fs, &bl, 1); next(ls); block(ls); check_match(ls, TK_UNTIL, TK_REPEAT, line); cond(ls, &v); - luaK_patchlist(fs, v.u.l.f, repeat_init); - leavebreak(fs, &bl); + luaK_patchlist(fs, v.f, repeat_init); + leaveblock(fs); } -static void forbody (LexState *ls, int nvar, OpCode prepfor, OpCode loopfor) { - /* forbody -> DO block END */ +static int exp1 (LexState *ls) { + expdesc e; + int k; + expr(ls, &e); + k = e.k; + luaK_exp2nextreg(ls->fs, &e); + return k; +} + + +static void forbody (LexState *ls, int base, int line, int nvars, int isnum) { + BlockCnt bl; FuncState *fs = ls->fs; - int prep = luaK_code1(fs, prepfor, NO_JUMP); - int blockinit = luaK_getlabel(fs); + int prep, endfor; + adjustlocalvars(ls, nvars); /* scope for all variables */ check(ls, TK_DO); - adjustlocalvars(ls, nvar); /* scope for control variables */ + enterblock(fs, &bl, 1); /* loop block */ + prep = luaK_getlabel(fs); block(ls); - luaK_patchlist(fs, luaK_code1(fs, loopfor, NO_JUMP), blockinit); - luaK_patchlist(fs, prep, luaK_getlabel(fs)); - removelocalvars(ls, nvar); + luaK_patchtohere(fs, prep-1); + endfor = (isnum) ? luaK_codeAsBx(fs, OP_FORLOOP, base, NO_JUMP) : + luaK_codeABC(fs, OP_TFORLOOP, base, 0, nvars - 3); + luaK_fixline(fs, line); /* pretend that `OP_FOR' starts the loop */ + luaK_patchlist(fs, (isnum) ? endfor : luaK_jump(fs), prep); + leaveblock(fs); } -static void fornum (LexState *ls, TString *varname) { - /* fornum -> NAME = exp1,exp1[,exp1] forbody */ +static void fornum (LexState *ls, TString *varname, int line) { + /* fornum -> NAME = exp1,exp1[,exp1] DO body */ FuncState *fs = ls->fs; + int base = fs->freereg; + new_localvar(ls, varname, 0); + new_localvarstr(ls, "(for limit)", 1); + new_localvarstr(ls, "(for step)", 2); check(ls, '='); exp1(ls); /* initial value */ check(ls, ','); exp1(ls); /* limit */ - if (optional(ls, ',')) + if (testnext(ls, ',')) exp1(ls); /* optional step */ - else - luaK_code1(fs, OP_PUSHINT, 1); /* default step */ - new_localvar(ls, varname, 0); - new_localvarstr(ls, "(limit)", 1); - new_localvarstr(ls, "(step)", 2); - forbody(ls, 3, OP_FORPREP, OP_FORLOOP); + else { /* default step = 1 */ + luaK_codeABx(fs, OP_LOADK, fs->freereg, luaK_numberK(fs, 1)); + luaK_reserveregs(fs, 1); + } + luaK_codeABC(fs, OP_SUB, fs->freereg - 3, fs->freereg - 3, fs->freereg - 1); + luaK_jump(fs); + forbody(ls, base, line, 3, 1); } static void forlist (LexState *ls, TString *indexname) { - /* forlist -> NAME,NAME IN exp1 forbody */ - TString *valname; - check(ls, ','); - valname = str_checkname(ls); - /* next test is dirty, but avoids `in' being a reserved word */ - check_condition(ls, - (ls->t.token == TK_NAME && ls->t.seminfo.ts == luaS_new(ls->L, "in")), - "`in' expected"); - next(ls); /* skip `in' */ - exp1(ls); /* table */ - new_localvarstr(ls, "(table)", 0); - new_localvar(ls, indexname, 1); - new_localvar(ls, valname, 2); - forbody(ls, 3, OP_LFORPREP, OP_LFORLOOP); + /* forlist -> NAME {,NAME} IN explist1 DO body */ + FuncState *fs = ls->fs; + expdesc e; + int nvars = 0; + int line; + int base = fs->freereg; + new_localvarstr(ls, "(for generator)", nvars++); + new_localvarstr(ls, "(for state)", nvars++); + new_localvar(ls, indexname, nvars++); + while (testnext(ls, ',')) + new_localvar(ls, str_checkname(ls), nvars++); + check(ls, TK_IN); + line = ls->linenumber; + adjust_assign(ls, nvars, explist1(ls, &e), &e); + luaK_checkstack(fs, 3); /* extra space to call generator */ + luaK_codeAsBx(fs, OP_TFORPREP, base, NO_JUMP); + forbody(ls, base, line, nvars, 0); } @@ -887,17 +1092,17 @@ static void forstat (LexState *ls, int line) { /* forstat -> fornum | forlist */ FuncState *fs = ls->fs; TString *varname; - Breaklabel bl; - enterbreak(fs, &bl); + BlockCnt bl; + enterblock(fs, &bl, 0); /* block to control variable scope */ next(ls); /* skip `for' */ varname = str_checkname(ls); /* first variable name */ switch (ls->t.token) { - case '=': fornum(ls, varname); break; - case ',': forlist(ls, varname); break; - default: luaK_error(ls, "`=' or `,' expected"); + case '=': fornum(ls, varname, line); break; + case ',': case TK_IN: forlist(ls, varname); break; + default: luaX_syntaxerror(ls, "`=' or `in' expected"); } check_match(ls, TK_END, TK_FOR, line); - leavebreak(fs, &bl); + leaveblock(fs); } @@ -918,49 +1123,60 @@ static void ifstat (LexState *ls, int line) { test_then_block(ls, &v); /* IF cond THEN block */ while (ls->t.token == TK_ELSEIF) { luaK_concat(fs, &escapelist, luaK_jump(fs)); - luaK_patchlist(fs, v.u.l.f, luaK_getlabel(fs)); + luaK_patchtohere(fs, v.f); test_then_block(ls, &v); /* ELSEIF cond THEN block */ } if (ls->t.token == TK_ELSE) { luaK_concat(fs, &escapelist, luaK_jump(fs)); - luaK_patchlist(fs, v.u.l.f, luaK_getlabel(fs)); - next(ls); /* skip ELSE */ + luaK_patchtohere(fs, v.f); + next(ls); /* skip ELSE (after patch, for correct line info) */ block(ls); /* `else' part */ } else - luaK_concat(fs, &escapelist, v.u.l.f); - luaK_patchlist(fs, escapelist, luaK_getlabel(fs)); + luaK_concat(fs, &escapelist, v.f); + luaK_patchtohere(fs, escapelist); check_match(ls, TK_END, TK_IF, line); } +static void localfunc (LexState *ls) { + expdesc v, b; + new_localvar(ls, str_checkname(ls), 0); + init_exp(&v, VLOCAL, ls->fs->freereg++); + adjustlocalvars(ls, 1); + body(ls, &b, 0, ls->linenumber); + luaK_storevar(ls->fs, &v, &b); +} + + static void localstat (LexState *ls) { - /* stat -> LOCAL NAME {',' NAME} ['=' explist1] */ + /* stat -> LOCAL NAME {`,' NAME} [`=' explist1] */ int nvars = 0; int nexps; + expdesc e; do { - next(ls); /* skip LOCAL or ',' */ new_localvar(ls, str_checkname(ls), nvars++); - } while (ls->t.token == ','); - if (optional(ls, '=')) - nexps = explist1(ls); - else + } while (testnext(ls, ',')); + if (testnext(ls, '=')) + nexps = explist1(ls, &e); + else { + e.k = VVOID; nexps = 0; - adjust_mult_assign(ls, nvars, nexps); + } + adjust_assign(ls, nvars, nexps, &e); adjustlocalvars(ls, nvars); } static int funcname (LexState *ls, expdesc *v) { - /* funcname -> NAME [':' NAME | '.' NAME] */ + /* funcname -> NAME {field} [`:' NAME] */ int needself = 0; - singlevar(ls, str_checkname(ls), v); - if (ls->t.token == ':' || ls->t.token == '.') { - needself = (ls->t.token == ':'); - next(ls); - luaK_tostack(ls, v, 1); - luaK_kstr(ls, checkname(ls)); - v->k = VINDEXED; + singlevar(ls, v, 1); + while (ls->t.token == '.') + luaY_field(ls, v); + if (ls->t.token == ':') { + needself = 1; + luaY_field(ls, v); } return needself; } @@ -969,26 +1185,26 @@ static int funcname (LexState *ls, expdesc *v) { static void funcstat (LexState *ls, int line) { /* funcstat -> FUNCTION funcname body */ int needself; - expdesc v; + expdesc v, b; next(ls); /* skip FUNCTION */ needself = funcname(ls, &v); - body(ls, needself, line); - luaK_storevar(ls, &v); + body(ls, &b, needself, line); + luaK_storevar(ls->fs, &v, &b); + luaK_fixline(ls->fs, line); /* definition `happens' in the first line */ } -static void namestat (LexState *ls) { - /* stat -> func | ['%'] NAME assignment */ +static void exprstat (LexState *ls) { + /* stat -> func | assignment */ FuncState *fs = ls->fs; - expdesc v; - var_or_func(ls, &v); - if (v.k == VEXP) { /* stat -> func */ - check_condition(ls, luaK_lastisopen(fs), "syntax error"); /* an upvalue? */ - luaK_setcallreturns(fs, 0); /* call statement uses no results */ + struct LHS_assign v; + primaryexp(ls, &v.v); + if (v.v.k == VCALL) { /* stat -> func */ + luaK_setcallreturns(fs, &v.v, 0); /* call statement uses no results */ } - else { /* stat -> ['%'] NAME assignment */ - int left = assignment(ls, &v, 1); - luaK_adjuststack(fs, left); /* remove eventual garbage left on stack */ + else { /* stat -> assignment */ + v.prev = NULL; + assignment(ls, &v, 1); } } @@ -996,30 +1212,55 @@ static void namestat (LexState *ls) { static void retstat (LexState *ls) { /* stat -> RETURN explist */ FuncState *fs = ls->fs; + expdesc e; + int first, nret; /* registers with returned values */ next(ls); /* skip RETURN */ - if (!block_follow(ls->t.token) && ls->t.token != ';') - explist1(ls); /* optional return values */ - luaK_code1(fs, OP_RETURN, ls->fs->nactloc); - fs->stacklevel = fs->nactloc; /* removes all temp values */ + if (block_follow(ls->t.token) || ls->t.token == ';') + first = nret = 0; /* return no values */ + else { + nret = explist1(ls, &e); /* optional return values */ + if (e.k == VCALL) { + luaK_setcallreturns(fs, &e, LUA_MULTRET); + if (nret == 1) { /* tail call? */ + SET_OPCODE(getcode(fs,&e), OP_TAILCALL); + lua_assert(GETARG_A(getcode(fs,&e)) == fs->nactvar); + } + first = fs->nactvar; + nret = LUA_MULTRET; /* return all values */ + } + else { + if (nret == 1) /* only one single value? */ + first = luaK_exp2anyreg(fs, &e); + else { + luaK_exp2nextreg(fs, &e); /* values must go to the `stack' */ + first = fs->nactvar; /* return all `active' values */ + lua_assert(nret == fs->freereg - first); + } + } + } + luaK_codeABC(fs, OP_RETURN, first, nret+1, 0); } static void breakstat (LexState *ls) { /* stat -> BREAK [NAME] */ FuncState *fs = ls->fs; - int currentlevel = fs->stacklevel; - Breaklabel *bl = fs->bl; - if (!bl) - luaK_error(ls, "no loop to break"); + BlockCnt *bl = fs->bl; + int upval = 0; next(ls); /* skip BREAK */ - luaK_adjuststack(fs, currentlevel - bl->stacklevel); + while (bl && !bl->isbreakable) { + upval |= bl->upval; + bl = bl->previous; + } + if (!bl) + luaX_syntaxerror(ls, "no loop to break"); + if (upval) + luaK_codeABC(fs, OP_CLOSE, bl->nactvar, 0, 0); luaK_concat(fs, &bl->breaklist, luaK_jump(fs)); - /* correct stack for compiler and symbolic execution */ - luaK_adjuststack(fs, bl->stacklevel - currentlevel); } -static int stat (LexState *ls) { +static int statement (LexState *ls) { int line = ls->linenumber; /* may be needed for error messages */ switch (ls->t.token) { case TK_IF: { /* stat -> ifstat */ @@ -1044,16 +1285,16 @@ static int stat (LexState *ls) { repeatstat(ls, line); return 0; } - case TK_FUNCTION: { /* stat -> funcstat */ - funcstat(ls, line); + case TK_FUNCTION: { + funcstat(ls, line); /* stat -> funcstat */ return 0; } case TK_LOCAL: { /* stat -> localstat */ - localstat(ls); - return 0; - } - case TK_NAME: case '%': { /* stat -> namestat */ - namestat(ls); + next(ls); /* skip LOCAL */ + if (testnext(ls, TK_FUNCTION)) /* local function? */ + localfunc(ls); + else + localstat(ls); return 0; } case TK_RETURN: { /* stat -> retstat */ @@ -1065,60 +1306,24 @@ static int stat (LexState *ls) { return 1; /* must be last statement */ } default: { - luaK_error(ls, "<statement> expected"); + exprstat(ls); return 0; /* to avoid warnings */ } } } -static void parlist (LexState *ls) { - /* parlist -> [ param { ',' param } ] */ - int nparams = 0; - int dots = 0; - if (ls->t.token != ')') { /* is `parlist' not empty? */ - do { - switch (ls->t.token) { - case TK_DOTS: next(ls); dots = 1; break; - case TK_NAME: new_localvar(ls, str_checkname(ls), nparams++); break; - default: luaK_error(ls, "<name> or `...' expected"); - } - } while (!dots && optional(ls, ',')); - } - code_params(ls, nparams, dots); -} - - -static void body (LexState *ls, int needself, int line) { - /* body -> '(' parlist ')' chunk END */ - FuncState new_fs; - open_func(ls, &new_fs); - new_fs.f->lineDefined = line; - check(ls, '('); - if (needself) { - new_localvarstr(ls, "self", 0); - adjustlocalvars(ls, 1); - } - parlist(ls); - check(ls, ')'); - chunk(ls); - check_match(ls, TK_END, TK_FUNCTION, line); - close_func(ls); - pushclosure(ls, &new_fs); -} - - -/* }====================================================================== */ - - static void chunk (LexState *ls) { - /* chunk -> { stat [';'] } */ + /* chunk -> { stat [`;'] } */ int islast = 0; + enterlevel(ls); while (!islast && !block_follow(ls->t.token)) { - islast = stat(ls); - optional(ls, ';'); - LUA_ASSERT(ls->fs->stacklevel == ls->fs->nactloc, - "stack size != # local vars"); + islast = statement(ls); + testnext(ls, ';'); + lua_assert(ls->fs->freereg >= ls->fs->nactvar); + ls->fs->freereg = ls->fs->nactvar; /* free registers */ } + leavelevel(ls); } +/* }====================================================================== */ diff --git a/src/lparser.h b/src/lparser.h index 445acea6..d6aaaf0e 100644 --- a/src/lparser.h +++ b/src/lparser.h @@ -1,13 +1,15 @@ /* -** $Id: lparser.h,v 1.26 2000/10/09 13:47:46 roberto Exp $ -** LL(1) Parser and code generator for Lua +** $Id: lparser.h,v 1.47 2003/02/11 10:46:24 roberto Exp $ +** Lua Parser ** See Copyright Notice in lua.h */ #ifndef lparser_h #define lparser_h +#include "llimits.h" #include "lobject.h" +#include "ltable.h" #include "lzio.h" @@ -16,45 +18,54 @@ */ typedef enum { - VGLOBAL, - VLOCAL, - VINDEXED, - VEXP + VVOID, /* no value */ + VNIL, + VTRUE, + VFALSE, + VK, /* info = index of constant in `k' */ + VLOCAL, /* info = local register */ + VUPVAL, /* info = index of upvalue in `upvalues' */ + VGLOBAL, /* info = index of table; aux = index of global name in `k' */ + VINDEXED, /* info = table register; aux = index register (or `k') */ + VJMP, /* info = instruction pc */ + VRELOCABLE, /* info = instruction pc */ + VNONRELOC, /* info = result register */ + VCALL /* info = result register */ } expkind; typedef struct expdesc { expkind k; - union { - int index; /* VGLOBAL: `kstr' index of global name; VLOCAL: stack index */ - struct { - int t; /* patch list of `exit when true' */ - int f; /* patch list of `exit when false' */ - } l; - } u; + int info, aux; + int t; /* patch list of `exit when true' */ + int f; /* patch list of `exit when false' */ } expdesc; +struct BlockCnt; /* defined in lparser.c */ + /* state needed to generate code for a given function */ typedef struct FuncState { Proto *f; /* current function header */ + Table *h; /* table to find (and reuse) elements in `k' */ struct FuncState *prev; /* enclosing function */ struct LexState *ls; /* lexical state */ struct lua_State *L; /* copy of the Lua state */ - int pc; /* next position to code */ + struct BlockCnt *bl; /* chain of current blocks */ + int pc; /* next position to code (equivalent to `ncode') */ int lasttarget; /* `pc' of last `jump target' */ - int jlt; /* list of jumps to `lasttarget' */ - short stacklevel; /* number of values on activation register */ - short nactloc; /* number of active local variables */ - short nupvalues; /* number of upvalues */ - int lastline; /* line where last `lineinfo' was generated */ - struct Breaklabel *bl; /* chain of breakable blocks */ + int jpc; /* list of pending jumps to `pc' */ + int freereg; /* first free register */ + int nk; /* number of elements in `k' */ + int np; /* number of elements in `p' */ + int nlocvars; /* number of elements in `locvars' */ + int nactvar; /* number of active local variables */ expdesc upvalues[MAXUPVALUES]; /* upvalues */ - int actloc[MAXLOCALS]; /* local-variable stack (indices to locvars) */ + int actvar[MAXVARS]; /* declared-variable stack */ } FuncState; -Proto *luaY_parser (lua_State *L, ZIO *z); +Proto *luaY_parser (lua_State *L, ZIO *z, Mbuffer *buff); #endif diff --git a/src/lstate.c b/src/lstate.c index 586c1085..b593658d 100644 --- a/src/lstate.c +++ b/src/lstate.c @@ -1,15 +1,19 @@ /* -** $Id: lstate.c,v 1.48 2000/10/30 16:29:59 roberto Exp $ +** $Id: lstate.c,v 1.123 2003/04/03 13:35:34 roberto Exp $ ** Global State ** See Copyright Notice in lua.h */ -#include <stdio.h> +#include <stdlib.h> + +#define lstate_c #include "lua.h" +#include "ldebug.h" #include "ldo.h" +#include "lfunc.h" #include "lgc.h" #include "llex.h" #include "lmem.h" @@ -19,103 +23,198 @@ #include "ltm.h" -#ifdef LUA_DEBUG -static lua_State *lua_state = NULL; -void luaB_opentests (lua_State *L); +/* +** macro to allow the inclusion of user information in Lua state +*/ +#ifndef LUA_USERSTATE +#define EXTRASPACE 0 +#else +union UEXTRASPACE {L_Umaxalign a; LUA_USERSTATE b;}; +#define EXTRASPACE (sizeof(union UEXTRASPACE)) #endif + /* -** built-in implementation for ERRORMESSAGE. In a "correct" environment -** ERRORMESSAGE should have an external definition, and so this function -** would not be used. +** you can change this function through the official API: +** call `lua_setpanicf' */ -static int errormessage (lua_State *L) { - const char *s = lua_tostring(L, 1); - if (s == NULL) s = "(no message)"; - fprintf(stderr, "error: %s\n", s); +static int default_panic (lua_State *L) { + UNUSED(L); return 0; } +static lua_State *mallocstate (lua_State *L) { + lu_byte *block = (lu_byte *)luaM_malloc(L, sizeof(lua_State) + EXTRASPACE); + if (block == NULL) return NULL; + else { + block += EXTRASPACE; + return cast(lua_State *, block); + } +} + + +static void freestate (lua_State *L, lua_State *L1) { + luaM_free(L, cast(lu_byte *, L1) - EXTRASPACE, + sizeof(lua_State) + EXTRASPACE); +} + + +static void stack_init (lua_State *L1, lua_State *L) { + L1->stack = luaM_newvector(L, BASIC_STACK_SIZE + EXTRA_STACK, TObject); + L1->stacksize = BASIC_STACK_SIZE + EXTRA_STACK; + L1->top = L1->stack; + L1->stack_last = L1->stack+(L1->stacksize - EXTRA_STACK)-1; + L1->base_ci = luaM_newvector(L, BASIC_CI_SIZE, CallInfo); + L1->ci = L1->base_ci; + L1->ci->state = CI_C; /* not a Lua function */ + setnilvalue(L1->top++); /* `function' entry for this `ci' */ + L1->base = L1->ci->base = L1->top; + L1->ci->top = L1->top + LUA_MINSTACK; + L1->size_ci = BASIC_CI_SIZE; + L1->end_ci = L1->base_ci + L1->size_ci; +} + + +static void freestack (lua_State *L, lua_State *L1) { + luaM_freearray(L, L1->base_ci, L1->size_ci, CallInfo); + luaM_freearray(L, L1->stack, L1->stacksize, TObject); +} + + /* ** open parts that may cause memory-allocation errors */ static void f_luaopen (lua_State *L, void *ud) { - int stacksize = *(int *)ud; - if (stacksize == 0) - stacksize = DEFAULT_STACK_SIZE; - else - stacksize += LUA_MINSTACK; - L->gt = luaH_new(L, 10); /* table of globals */ - luaD_init(L, stacksize); - luaS_init(L); - luaX_init(L); + /* create a new global state */ + global_State *g = luaM_new(NULL, global_State); + UNUSED(ud); + if (g == NULL) luaD_throw(L, LUA_ERRMEM); + L->l_G = g; + g->mainthread = L; + g->GCthreshold = 0; /* mark it as unfinished state */ + g->strt.size = 0; + g->strt.nuse = 0; + g->strt.hash = NULL; + setnilvalue(defaultmeta(L)); + setnilvalue(registry(L)); + luaZ_initbuffer(L, &g->buff); + g->panic = default_panic; + g->rootgc = NULL; + g->rootudata = NULL; + g->tmudata = NULL; + setnilvalue(gkey(g->dummynode)); + setnilvalue(gval(g->dummynode)); + g->dummynode->next = NULL; + g->nblocks = sizeof(lua_State) + sizeof(global_State); + stack_init(L, L); /* init stack */ + /* create default meta table with a dummy table, and then close the loop */ + defaultmeta(L)->tt = LUA_TTABLE; + sethvalue(defaultmeta(L), luaH_new(L, 0, 0)); + hvalue(defaultmeta(L))->metatable = hvalue(defaultmeta(L)); + sethvalue(gt(L), luaH_new(L, 0, 4)); /* table of globals */ + sethvalue(registry(L), luaH_new(L, 4, 4)); /* registry */ + luaS_resize(L, MINSTRTABSIZE); /* initial size of string table */ luaT_init(L); - lua_newtable(L); - lua_ref(L, 1); /* create registry */ - lua_register(L, LUA_ERRORMESSAGE, errormessage); -#ifdef LUA_DEBUG - luaB_opentests(L); - if (lua_state == NULL) lua_state = L; /* keep first state to be opened */ -#endif - LUA_ASSERT(lua_gettop(L) == 0, "wrong API stack"); + luaX_init(L); + luaS_fix(luaS_newliteral(L, MEMERRMSG)); + g->GCthreshold = 4*G(L)->nblocks; } -LUA_API lua_State *lua_open (int stacksize) { - lua_State *L = luaM_new(NULL, lua_State); - if (L == NULL) return NULL; /* memory allocation error */ +static void preinit_state (lua_State *L) { L->stack = NULL; - L->strt.size = L->udt.size = 0; - L->strt.nuse = L->udt.nuse = 0; - L->strt.hash = NULL; - L->udt.hash = NULL; - L->Mbuffer = NULL; - L->Mbuffsize = 0; - L->rootproto = NULL; - L->rootcl = NULL; - L->roottable = NULL; - L->TMtable = NULL; - L->last_tag = -1; - L->refArray = NULL; - L->refSize = 0; - L->refFree = NONEXT; - L->nblocks = sizeof(lua_State); - L->GCthreshold = MAX_INT; /* to avoid GC during pre-definitions */ - L->callhook = NULL; - L->linehook = NULL; - L->allowhooks = 1; + L->stacksize = 0; L->errorJmp = NULL; - if (luaD_runprotected(L, f_luaopen, &stacksize) != 0) { - /* memory allocation error: free partial state */ - lua_close(L); - return NULL; + L->hook = NULL; + L->hookmask = L->hookinit = 0; + L->basehookcount = 0; + L->allowhook = 1; + resethookcount(L); + L->openupval = NULL; + L->size_ci = 0; + L->nCcalls = 0; + L->base_ci = L->ci = NULL; + L->errfunc = 0; + setnilvalue(gt(L)); +} + + +static void close_state (lua_State *L) { + luaF_close(L, L->stack); /* close all upvalues for this thread */ + if (G(L)) { /* close global state */ + luaC_sweep(L, 1); /* collect all elements */ + lua_assert(G(L)->rootgc == NULL); + lua_assert(G(L)->rootudata == NULL); + luaS_freeall(L); + luaZ_freebuffer(L, &G(L)->buff); + } + freestack(L, L); + if (G(L)) { + lua_assert(G(L)->nblocks == sizeof(lua_State) + sizeof(global_State)); + luaM_freelem(NULL, G(L)); + } + freestate(NULL, L); +} + + +lua_State *luaE_newthread (lua_State *L) { + lua_State *L1 = mallocstate(L); + luaC_link(L, valtogco(L1), LUA_TTHREAD); + preinit_state(L1); + L1->l_G = L->l_G; + stack_init(L1, L); /* init stack */ + setobj2n(gt(L1), gt(L)); /* share table of globals */ + return L1; +} + + +void luaE_freethread (lua_State *L, lua_State *L1) { + luaF_close(L1, L1->stack); /* close all upvalues for this thread */ + lua_assert(L1->openupval == NULL); + freestack(L, L1); + freestate(L, L1); +} + + +LUA_API lua_State *lua_open (void) { + lua_State *L = mallocstate(NULL); + if (L) { /* allocation OK? */ + L->tt = LUA_TTHREAD; + L->marked = 0; + L->next = L->gclist = NULL; + preinit_state(L); + L->l_G = NULL; + if (luaD_rawrunprotected(L, f_luaopen, NULL) != 0) { + /* memory allocation error: free partial state */ + close_state(L); + L = NULL; + } } - L->GCthreshold = 2*L->nblocks; + lua_userstateopen(L); return L; } +static void callallgcTM (lua_State *L, void *ud) { + UNUSED(ud); + luaC_callGCTM(L); /* call GC metamethods for all udata */ +} + + LUA_API void lua_close (lua_State *L) { - LUA_ASSERT(L != lua_state || lua_gettop(L) == 0, "garbage in C stack"); - luaC_collect(L, 1); /* collect all elements */ - LUA_ASSERT(L->rootproto == NULL, "list should be empty"); - LUA_ASSERT(L->rootcl == NULL, "list should be empty"); - LUA_ASSERT(L->roottable == NULL, "list should be empty"); - luaS_freeall(L); - if (L->stack) - L->nblocks -= (L->stack_last - L->stack + 1)*sizeof(TObject); - luaM_free(L, L->stack); - L->nblocks -= (L->last_tag+1)*sizeof(struct TM); - luaM_free(L, L->TMtable); - L->nblocks -= (L->refSize)*sizeof(struct Ref); - luaM_free(L, L->refArray); - L->nblocks -= (L->Mbuffsize)*sizeof(char); - luaM_free(L, L->Mbuffer); - LUA_ASSERT(L->nblocks == sizeof(lua_State), "wrong count for nblocks"); - luaM_free(L, L); - LUA_ASSERT(L != lua_state || memdebug_numblocks == 0, "memory leak!"); - LUA_ASSERT(L != lua_state || memdebug_total == 0,"memory leak!"); + lua_lock(L); + L = G(L)->mainthread; /* only the main thread can be closed */ + luaF_close(L, L->stack); /* close all upvalues for this thread */ + luaC_separateudata(L); /* separate udata that have GC metamethods */ + L->errfunc = 0; /* no error function during GC metamethods */ + do { /* repeat until no more errors */ + L->ci = L->base_ci; + L->base = L->top = L->ci->base; + L->nCcalls = 0; + } while (luaD_rawrunprotected(L, callallgcTM, NULL) != 0); + lua_assert(G(L)->tmudata == NULL); + close_state(L); } diff --git a/src/lstate.h b/src/lstate.h index 0c8f5521..5422f1b1 100644 --- a/src/lstate.h +++ b/src/lstate.h @@ -1,5 +1,5 @@ /* -** $Id: lstate.h,v 1.41 2000/10/05 13:00:17 roberto Exp $ +** $Id: lstate.h,v 1.109 2003/02/27 11:52:30 roberto Exp $ ** Global State ** See Copyright Notice in lua.h */ @@ -7,71 +7,189 @@ #ifndef lstate_h #define lstate_h -#include "lobject.h" #include "lua.h" -#include "luadebug.h" - - -typedef TObject *StkId; /* index to stack elements */ +#include "lobject.h" +#include "ltm.h" +#include "lzio.h" /* -** marks for Reference array +** macros for thread synchronization inside Lua core machine: +** all accesses to the global state and to global objects are synchronized. +** Because threads can read the stack of other threads +** (when running garbage collection), +** a thread must also synchronize any write-access to its own stack. +** Unsynchronized accesses are allowed only when reading its own stack, +** or when reading immutable fields from global objects +** (such as string values and udata values). */ -#define NONEXT -1 /* to end the free list */ -#define HOLD -2 -#define COLLECTED -3 -#define LOCK -4 +#ifndef lua_lock +#define lua_lock(L) ((void) 0) +#endif +#ifndef lua_unlock +#define lua_unlock(L) ((void) 0) +#endif + + +#ifndef lua_userstateopen +#define lua_userstateopen(l) +#endif -struct Ref { - TObject o; - int st; /* can be LOCK, HOLD, COLLECTED, or next (for free list) */ -}; struct lua_longjmp; /* defined in ldo.c */ -struct TM; /* defined in ltm.h */ + + +/* default meta table (both for tables and udata) */ +#define defaultmeta(L) (&G(L)->_defaultmeta) + +/* table of globals */ +#define gt(L) (&L->_gt) + +/* registry */ +#define registry(L) (&G(L)->_registry) + + +/* extra stack space to handle TM calls and some other extras */ +#define EXTRA_STACK 5 + + +#define BASIC_CI_SIZE 8 + +#define BASIC_STACK_SIZE (2*LUA_MINSTACK) + typedef struct stringtable { + GCObject **hash; + ls_nstr nuse; /* number of elements */ int size; - lint32 nuse; /* number of elements */ - TString **hash; } stringtable; +/* +** informations about a call +*/ +typedef struct CallInfo { + StkId base; /* base for called function */ + StkId top; /* top for this function */ + int state; /* bit fields; see below */ + union { + struct { /* for Lua functions */ + const Instruction *savedpc; + const Instruction **pc; /* points to `pc' variable in `luaV_execute' */ + int tailcalls; /* number of tail calls lost under this entry */ + } l; + struct { /* for C functions */ + int dummy; /* just to avoid an empty struct */ + } c; + } u; +} CallInfo; + + +/* +** bit fields for `CallInfo.state' +*/ +#define CI_C (1<<0) /* 1 if function is a C function */ +/* 1 if (Lua) function has an active `luaV_execute' running it */ +#define CI_HASFRAME (1<<1) +/* 1 if Lua function is calling another Lua function (and therefore its + `pc' is being used by the other, and therefore CI_SAVEDPC is 1 too) */ +#define CI_CALLING (1<<2) +#define CI_SAVEDPC (1<<3) /* 1 if `savedpc' is updated */ +#define CI_YIELD (1<<4) /* 1 if thread is suspended */ + + +#define ci_func(ci) (clvalue((ci)->base - 1)) + +/* +** `global state', shared by all threads of this state +*/ +typedef struct global_State { + stringtable strt; /* hash table for strings */ + GCObject *rootgc; /* list of (almost) all collectable objects */ + GCObject *rootudata; /* (separated) list of all userdata */ + GCObject *tmudata; /* list of userdata to be GC */ + Mbuffer buff; /* temporary buffer for string concatentation */ + lu_mem GCthreshold; + lu_mem nblocks; /* number of `bytes' currently allocated */ + lua_CFunction panic; /* to be called in unprotected errors */ + TObject _registry; + TObject _defaultmeta; + struct lua_State *mainthread; + Node dummynode[1]; /* common node array for all empty tables */ + TString *tmname[TM_N]; /* array with tag-method names */ +} global_State; + + +/* +** `per thread' state +*/ struct lua_State { - /* thread-specific state */ + CommonHeader; StkId top; /* first free slot in the stack */ - StkId stack; /* stack base */ + StkId base; /* base of current function */ + global_State *l_G; + CallInfo *ci; /* call info for current function */ StkId stack_last; /* last free slot in the stack */ + StkId stack; /* stack base */ int stacksize; - StkId Cbase; /* base for current C function */ + CallInfo *end_ci; /* points after end of ci array*/ + CallInfo *base_ci; /* array of CallInfo's */ + unsigned short size_ci; /* size of array `base_ci' */ + unsigned short nCcalls; /* number of nested C calls */ + lu_byte hookmask; + lu_byte allowhook; + lu_byte hookinit; + int basehookcount; + int hookcount; + lua_Hook hook; + TObject _gt; /* table of globals */ + GCObject *openupval; /* list of open upvalues in this stack */ + GCObject *gclist; struct lua_longjmp *errorJmp; /* current error recover point */ - char *Mbuffer; /* global buffer */ - size_t Mbuffsize; /* size of Mbuffer */ - /* global state */ - Proto *rootproto; /* list of all prototypes */ - Closure *rootcl; /* list of all closures */ - Hash *roottable; /* list of all tables */ - stringtable strt; /* hash table for strings */ - stringtable udt; /* hash table for udata */ - Hash *gt; /* table for globals */ - struct TM *TMtable; /* table for tag methods */ - int last_tag; /* last used tag in TMtable */ - struct Ref *refArray; /* locked objects */ - int refSize; /* size of refArray */ - int refFree; /* list of free positions in refArray */ - unsigned long GCthreshold; - unsigned long nblocks; /* number of `bytes' currently allocated */ - lua_Hook callhook; - lua_Hook linehook; - int allowhooks; + ptrdiff_t errfunc; /* current error handling function (stack index) */ +}; + + +#define G(L) (L->l_G) + + +/* +** Union of all collectable objects +*/ +union GCObject { + GCheader gch; + union TString ts; + union Udata u; + union Closure cl; + struct Table h; + struct Proto p; + struct UpVal uv; + struct lua_State th; /* thread */ }; +/* macros to convert a GCObject into a specific value */ +#define gcotots(o) check_exp((o)->gch.tt == LUA_TSTRING, &((o)->ts)) +#define gcotou(o) check_exp((o)->gch.tt == LUA_TUSERDATA, &((o)->u)) +#define gcotocl(o) check_exp((o)->gch.tt == LUA_TFUNCTION, &((o)->cl)) +#define gcotoh(o) check_exp((o)->gch.tt == LUA_TTABLE, &((o)->h)) +#define gcotop(o) check_exp((o)->gch.tt == LUA_TPROTO, &((o)->p)) +#define gcotouv(o) check_exp((o)->gch.tt == LUA_TUPVAL, &((o)->uv)) +#define ngcotouv(o) \ + check_exp((o) == NULL || (o)->gch.tt == LUA_TUPVAL, &((o)->uv)) +#define gcototh(o) check_exp((o)->gch.tt == LUA_TTHREAD, &((o)->th)) + +/* macro to convert any value into a GCObject */ +#define valtogco(v) (cast(GCObject *, (v))) + + +lua_State *luaE_newthread (lua_State *L); +void luaE_freethread (lua_State *L, lua_State *L1); + #endif diff --git a/src/lstring.c b/src/lstring.c index a415a7d3..8cbddbd2 100644 --- a/src/lstring.c +++ b/src/lstring.c @@ -1,5 +1,5 @@ /* -** $Id: lstring.c,v 1.45a 2000/10/30 17:49:19 roberto Exp $ +** $Id: lstring.c,v 1.78 2002/12/04 17:38:31 roberto Exp $ ** String table (keeps all strings handled by Lua) ** See Copyright Notice in lua.h */ @@ -7,6 +7,8 @@ #include <string.h> +#define lstring_c + #include "lua.h" #include "lmem.h" @@ -15,141 +17,86 @@ #include "lstring.h" -/* -** type equivalent to TString, but with maximum alignment requirements -*/ -union L_UTString { - TString ts; - union L_Umaxalign dummy; /* ensures maximum alignment for `local' udata */ -}; - - - -void luaS_init (lua_State *L) { - L->strt.hash = luaM_newvector(L, 1, TString *); - L->udt.hash = luaM_newvector(L, 1, TString *); - L->nblocks += 2*sizeof(TString *); - L->strt.size = L->udt.size = 1; - L->strt.nuse = L->udt.nuse = 0; - L->strt.hash[0] = L->udt.hash[0] = NULL; -} - void luaS_freeall (lua_State *L) { - LUA_ASSERT(L->strt.nuse==0, "non-empty string table"); - L->nblocks -= (L->strt.size + L->udt.size)*sizeof(TString *); - luaM_free(L, L->strt.hash); - LUA_ASSERT(L->udt.nuse==0, "non-empty udata table"); - luaM_free(L, L->udt.hash); -} - - -static unsigned long hash_s (const char *s, size_t l) { - unsigned long h = l; /* seed */ - size_t step = (l>>5)|1; /* if string is too long, don't hash all its chars */ - for (; l>=step; l-=step) - h = h ^ ((h<<5)+(h>>2)+(unsigned char)*(s++)); - return h; + lua_assert(G(L)->strt.nuse==0); + luaM_freearray(L, G(L)->strt.hash, G(L)->strt.size, TString *); } -void luaS_resize (lua_State *L, stringtable *tb, int newsize) { - TString **newhash = luaM_newvector(L, newsize, TString *); +void luaS_resize (lua_State *L, int newsize) { + GCObject **newhash = luaM_newvector(L, newsize, GCObject *); + stringtable *tb = &G(L)->strt; int i; for (i=0; i<newsize; i++) newhash[i] = NULL; /* rehash */ for (i=0; i<tb->size; i++) { - TString *p = tb->hash[i]; + GCObject *p = tb->hash[i]; while (p) { /* for each node in the list */ - TString *next = p->nexthash; /* save next */ - unsigned long h = (tb == &L->strt) ? p->u.s.hash : IntPoint(p->u.d.value); - int h1 = h&(newsize-1); /* new position */ - LUA_ASSERT(h%newsize == (h&(newsize-1)), - "a&(x-1) == a%x, for x power of 2"); - p->nexthash = newhash[h1]; /* chain it in new position */ + GCObject *next = p->gch.next; /* save next */ + lu_hash h = gcotots(p)->tsv.hash; + int h1 = lmod(h, newsize); /* new position */ + lua_assert(cast(int, h%newsize) == lmod(h, newsize)); + p->gch.next = newhash[h1]; /* chain it */ newhash[h1] = p; p = next; } } - luaM_free(L, tb->hash); - L->nblocks += (newsize - tb->size)*sizeof(TString *); + luaM_freearray(L, tb->hash, tb->size, TString *); tb->size = newsize; tb->hash = newhash; } -static void newentry (lua_State *L, stringtable *tb, TString *ts, int h) { - ts->nexthash = tb->hash[h]; /* chain new entry */ - tb->hash[h] = ts; +static TString *newlstr (lua_State *L, const char *str, size_t l, lu_hash h) { + TString *ts = cast(TString *, luaM_malloc(L, sizestring(l))); + stringtable *tb; + ts->tsv.len = l; + ts->tsv.hash = h; + ts->tsv.marked = 0; + ts->tsv.tt = LUA_TSTRING; + ts->tsv.reserved = 0; + memcpy(ts+1, str, l*sizeof(char)); + ((char *)(ts+1))[l] = '\0'; /* ending 0 */ + tb = &G(L)->strt; + h = lmod(h, tb->size); + ts->tsv.next = tb->hash[h]; /* chain new entry */ + tb->hash[h] = valtogco(ts); tb->nuse++; - if (tb->nuse > (lint32)tb->size && tb->size < MAX_INT/2) /* too crowded? */ - luaS_resize(L, tb, tb->size*2); -} - - - -TString *luaS_newlstr (lua_State *L, const char *str, size_t l) { - unsigned long h = hash_s(str, l); - int h1 = h & (L->strt.size-1); - TString *ts; - for (ts = L->strt.hash[h1]; ts; ts = ts->nexthash) { - if (ts->len == l && (memcmp(str, ts->str, l) == 0)) - return ts; - } - /* not found */ - ts = (TString *)luaM_malloc(L, sizestring(l)); - ts->marked = 0; - ts->nexthash = NULL; - ts->len = l; - ts->u.s.hash = h; - ts->u.s.constindex = 0; - memcpy(ts->str, str, l); - ts->str[l] = 0; /* ending 0 */ - L->nblocks += sizestring(l); - newentry(L, &L->strt, ts, h1); /* insert it on table */ - return ts; -} - - -TString *luaS_newudata (lua_State *L, size_t s, void *udata) { - union L_UTString *uts = (union L_UTString *)luaM_malloc(L, - (lint32)sizeof(union L_UTString)+s); - TString *ts = &uts->ts; - ts->marked = 0; - ts->nexthash = NULL; - ts->len = s; - ts->u.d.tag = 0; - ts->u.d.value = (s > 0) ? uts+1 : udata; - L->nblocks += sizestring(s); - /* insert it on table */ - newentry(L, &L->udt, ts, IntPoint(ts->u.d.value) & (L->udt.size-1)); + if (tb->nuse > cast(ls_nstr, tb->size) && tb->size <= MAX_INT/2) + luaS_resize(L, tb->size*2); /* too crowded */ return ts; } -TString *luaS_createudata (lua_State *L, void *udata, int tag) { - int h1 = IntPoint(udata) & (L->udt.size-1); - TString *ts; - for (ts = L->udt.hash[h1]; ts; ts = ts->nexthash) { - if (udata == ts->u.d.value && (tag == ts->u.d.tag || tag == LUA_ANYTAG)) +TString *luaS_newlstr (lua_State *L, const char *str, size_t l) { + GCObject *o; + lu_hash h = (lu_hash)l; /* seed */ + size_t step = (l>>5)+1; /* if string is too long, don't hash all its chars */ + size_t l1; + for (l1=l; l1>=step; l1-=step) /* compute hash */ + h = h ^ ((h<<5)+(h>>2)+(unsigned char)(str[l1-1])); + for (o = G(L)->strt.hash[lmod(h, G(L)->strt.size)]; + o != NULL; + o = o->gch.next) { + TString *ts = gcotots(o); + if (ts->tsv.len == l && (memcmp(str, getstr(ts), l) == 0)) return ts; } - /* not found */ - ts = luaS_newudata(L, 0, udata); - if (tag != LUA_ANYTAG) - ts->u.d.tag = tag; - return ts; + return newlstr(L, str, l, h); /* not found */ } -TString *luaS_new (lua_State *L, const char *str) { - return luaS_newlstr(L, str, strlen(str)); -} - - -TString *luaS_newfixed (lua_State *L, const char *str) { - TString *ts = luaS_new(L, str); - if (ts->marked == 0) ts->marked = FIXMARK; /* avoid GC */ - return ts; +Udata *luaS_newudata (lua_State *L, size_t s) { + Udata *u; + u = cast(Udata *, luaM_malloc(L, sizeudata(s))); + u->uv.marked = (1<<1); /* is not finalized */ + u->uv.tt = LUA_TUSERDATA; + u->uv.len = s; + u->uv.metatable = hvalue(defaultmeta(L)); + /* chain it on udata list */ + u->uv.next = G(L)->rootudata; + G(L)->rootudata = valtogco(u); + return u; } diff --git a/src/lstring.h b/src/lstring.h index 67ede68d..be5a1e37 100644 --- a/src/lstring.h +++ b/src/lstring.h @@ -1,5 +1,5 @@ /* -** $Id: lstring.h,v 1.24 2000/10/30 17:49:19 roberto Exp $ +** $Id: lstring.h,v 1.37 2002/08/16 14:45:55 roberto Exp $ ** String table (keep all strings handled by Lua) ** See Copyright Notice in lua.h */ @@ -12,26 +12,22 @@ #include "lstate.h" -/* -** any TString with mark>=FIXMARK is never collected. -** Marks>=RESERVEDMARK are used to identify reserved words. -*/ -#define FIXMARK 2 -#define RESERVEDMARK 3 +#define sizestring(l) (cast(lu_mem, sizeof(union TString))+ \ + (cast(lu_mem, l)+1)*sizeof(char)) + +#define sizeudata(l) (cast(lu_mem, sizeof(union Udata))+(l)) -#define sizestring(l) ((long)sizeof(TString) + \ - ((long)(l+1)-TSPACK)*(long)sizeof(char)) +#define luaS_new(L, s) (luaS_newlstr(L, s, strlen(s))) +#define luaS_newliteral(L, s) (luaS_newlstr(L, "" s, \ + (sizeof(s)/sizeof(char))-1)) +#define luaS_fix(s) ((s)->tsv.marked |= (1<<4)) -void luaS_init (lua_State *L); -void luaS_resize (lua_State *L, stringtable *tb, int newsize); -TString *luaS_newudata (lua_State *L, size_t s, void *udata); -TString *luaS_createudata (lua_State *L, void *udata, int tag); +void luaS_resize (lua_State *L, int newsize); +Udata *luaS_newudata (lua_State *L, size_t s); void luaS_freeall (lua_State *L); TString *luaS_newlstr (lua_State *L, const char *str, size_t l); -TString *luaS_new (lua_State *L, const char *str); -TString *luaS_newfixed (lua_State *L, const char *str); #endif diff --git a/src/ltable.c b/src/ltable.c index b28712d9..0c64adb1 100644 --- a/src/ltable.c +++ b/src/ltable.c @@ -1,13 +1,17 @@ /* -** $Id: ltable.c,v 1.58 2000/10/26 12:47:05 roberto Exp $ +** $Id: ltable.c,v 1.132 2003/04/03 13:35:34 roberto Exp $ ** Lua tables (hash) ** See Copyright Notice in lua.h */ /* -** Implementation of tables (aka arrays, objects, or hash tables); -** uses a mix of chained scatter table with Brent's variation. +** Implementation of tables (aka arrays, objects, or hash tables). +** Tables keep its elements in two parts: an array part and a hash part. +** Non-negative integer keys are all candidates to be kept in the array +** part. The actual size of the array is the largest `n' such that at +** least half the slots between 0 and n are in use. +** Hash uses a mix of chained scatter table with Brent's variation. ** A main invariant of these tables is that, if an element is not ** in its main position (i.e. the `original' position that its hash gives ** to it), then the colliding element is in its own main position. @@ -17,21 +21,74 @@ ** performance penalties. */ +#include <string.h> + +#define ltable_c #include "lua.h" +#include "ldebug.h" +#include "ldo.h" +#include "lgc.h" #include "lmem.h" #include "lobject.h" #include "lstate.h" -#include "lstring.h" #include "ltable.h" -#define gcsize(L, n) (sizeof(Hash)+(n)*sizeof(Node)) +/* +** max size of array part is 2^MAXBITS +*/ +#if BITS_INT > 26 +#define MAXBITS 24 +#else +#define MAXBITS (BITS_INT-2) +#endif + +/* check whether `x' < 2^MAXBITS */ +#define toobig(x) ((((x)-1) >> MAXBITS) != 0) +/* function to convert a lua_Number to int (with any rounding method) */ +#ifndef lua_number2int +#define lua_number2int(i,n) ((i)=(int)(n)) +#endif -#define TagDefault LUA_TTABLE + +#define hashpow2(t,n) (gnode(t, lmod((n), sizenode(t)))) + +#define hashstr(t,str) hashpow2(t, (str)->tsv.hash) +#define hashboolean(t,p) hashpow2(t, p) + + +/* +** for some types, it is better to avoid modulus by power of 2, as +** they tend to have many 2 factors. +*/ +#define hashmod(t,n) (gnode(t, ((n) % ((sizenode(t)-1)|1)))) + + +#define hashpointer(t,p) hashmod(t, IntPoint(p)) + + +/* +** number of ints inside a lua_Number +*/ +#define numints cast(int, sizeof(lua_Number)/sizeof(int)) + + +/* +** hash for lua_Numbers +*/ +static Node *hashnum (const Table *t, lua_Number n) { + unsigned int a[numints]; + int i; + n += 1; /* normalize number (avoid -0) */ + lua_assert(sizeof(a) <= sizeof(n)); + memcpy(a, &n, sizeof(a)); + for (i = 1; i < numints; i++) a[0] += a[i]; + return hashmod(t, cast(lu_hash, a[0])); +} @@ -39,226 +96,299 @@ ** returns the `main' position of an element in a table (that is, the index ** of its hash value) */ -Node *luaH_mainposition (const Hash *t, const TObject *key) { - unsigned long h; +Node *luaH_mainposition (const Table *t, const TObject *key) { switch (ttype(key)) { case LUA_TNUMBER: - h = (unsigned long)(long)nvalue(key); - break; + return hashnum(t, nvalue(key)); case LUA_TSTRING: - h = tsvalue(key)->u.s.hash; - break; - case LUA_TUSERDATA: - h = IntPoint(tsvalue(key)); - break; - case LUA_TTABLE: - h = IntPoint(hvalue(key)); - break; - case LUA_TFUNCTION: - h = IntPoint(clvalue(key)); - break; + return hashstr(t, tsvalue(key)); + case LUA_TBOOLEAN: + return hashboolean(t, bvalue(key)); + case LUA_TLIGHTUSERDATA: + return hashpointer(t, pvalue(key)); default: - return NULL; /* invalid key */ + return hashpointer(t, gcvalue(key)); } - LUA_ASSERT(h%(unsigned int)t->size == (h&((unsigned int)t->size-1)), - "a&(x-1) == a%x, for x power of 2"); - return &t->node[h&(t->size-1)]; } -static const TObject *luaH_getany (lua_State *L, const Hash *t, - const TObject *key) { - Node *n = luaH_mainposition(t, key); - if (!n) - lua_error(L, "table index is nil"); - else do { - if (luaO_equalObj(key, &n->key)) - return &n->val; - n = n->next; - } while (n); - return &luaO_nilobject; /* key not found */ +/* +** returns the index for `key' if `key' is an appropriate key to live in +** the array part of the table, -1 otherwise. +*/ +static int arrayindex (const TObject *key) { + if (ttisnumber(key)) { + int k; + lua_number2int(k, (nvalue(key))); + if (cast(lua_Number, k) == nvalue(key) && k >= 1 && !toobig(k)) + return k; + } + return -1; /* `key' did not match some condition */ } -/* specialized version for numbers */ -const TObject *luaH_getnum (const Hash *t, Number key) { - Node *n = &t->node[(unsigned long)(long)key&(t->size-1)]; - do { - if (ttype(&n->key) == LUA_TNUMBER && nvalue(&n->key) == key) - return &n->val; - n = n->next; - } while (n); - return &luaO_nilobject; /* key not found */ +/* +** returns the index of a `key' for table traversals. First goes all +** elements in the array part, then elements in the hash part. The +** beginning and end of a traversal are signalled by -1. +*/ +static int luaH_index (lua_State *L, Table *t, StkId key) { + int i; + if (ttisnil(key)) return -1; /* first iteration */ + i = arrayindex(key); + if (0 <= i && i <= t->sizearray) { /* is `key' inside array part? */ + return i-1; /* yes; that's the index (corrected to C) */ + } + else { + const TObject *v = luaH_get(t, key); + if (v == &luaO_nilobject) + luaG_runerror(L, "invalid key for `next'"); + i = cast(int, (cast(const lu_byte *, v) - + cast(const lu_byte *, gval(gnode(t, 0)))) / sizeof(Node)); + return i + t->sizearray; /* hash elements are numbered after array ones */ + } } -/* specialized version for strings */ -const TObject *luaH_getstr (const Hash *t, TString *key) { - Node *n = &t->node[key->u.s.hash&(t->size-1)]; - do { - if (ttype(&n->key) == LUA_TSTRING && tsvalue(&n->key) == key) - return &n->val; - n = n->next; - } while (n); - return &luaO_nilobject; /* key not found */ +int luaH_next (lua_State *L, Table *t, StkId key) { + int i = luaH_index(L, t, key); /* find original element */ + for (i++; i < t->sizearray; i++) { /* try first array part */ + if (!ttisnil(&t->array[i])) { /* a non-nil value? */ + setnvalue(key, cast(lua_Number, i+1)); + setobj2s(key+1, &t->array[i]); + return 1; + } + } + for (i -= t->sizearray; i < sizenode(t); i++) { /* then hash part */ + if (!ttisnil(gval(gnode(t, i)))) { /* a non-nil value? */ + setobj2s(key, gkey(gnode(t, i))); + setobj2s(key+1, gval(gnode(t, i))); + return 1; + } + } + return 0; /* no more elements */ } -const TObject *luaH_get (lua_State *L, const Hash *t, const TObject *key) { - switch (ttype(key)) { - case LUA_TNUMBER: return luaH_getnum(t, nvalue(key)); - case LUA_TSTRING: return luaH_getstr(t, tsvalue(key)); - default: return luaH_getany(L, t, key); +/* +** {============================================================= +** Rehash +** ============================================================== +*/ + + +static void computesizes (int nums[], int ntotal, int *narray, int *nhash) { + int i; + int a = nums[0]; /* number of elements smaller than 2^i */ + int na = a; /* number of elements to go to array part */ + int n = (na == 0) ? -1 : 0; /* (log of) optimal size for array part */ + for (i = 1; a < *narray && *narray >= twoto(i-1); i++) { + if (nums[i] > 0) { + a += nums[i]; + if (a >= twoto(i-1)) { /* more than half elements in use? */ + n = i; + na = a; + } + } } + lua_assert(na <= *narray && *narray <= ntotal); + *nhash = ntotal - na; + *narray = (n == -1) ? 0 : twoto(n); + lua_assert(na <= *narray && na >= *narray/2); } -Node *luaH_next (lua_State *L, const Hash *t, const TObject *key) { - int i; - if (ttype(key) == LUA_TNIL) - i = 0; /* first iteration */ - else { - const TObject *v = luaH_get(L, t, key); - if (v == &luaO_nilobject) - lua_error(L, "invalid key for `next'"); - i = (int)(((const char *)v - - (const char *)(&t->node[0].val)) / sizeof(Node)) + 1; +static void numuse (const Table *t, int *narray, int *nhash) { + int nums[MAXBITS+1]; + int i, lg; + int totaluse = 0; + /* count elements in array part */ + for (i=0, lg=0; lg<=MAXBITS; lg++) { /* for each slice [2^(lg-1) to 2^lg) */ + int ttlg = twoto(lg); /* 2^lg */ + if (ttlg > t->sizearray) { + ttlg = t->sizearray; + if (i >= ttlg) break; + } + nums[lg] = 0; + for (; i<ttlg; i++) { + if (!ttisnil(&t->array[i])) { + nums[lg]++; + totaluse++; + } + } } - for (; i<t->size; i++) { - Node *n = node(t, i); - if (ttype(val(n)) != LUA_TNIL) - return n; + for (; lg<=MAXBITS; lg++) nums[lg] = 0; /* reset other counts */ + *narray = totaluse; /* all previous uses were in array part */ + /* count elements in hash part */ + i = sizenode(t); + while (i--) { + Node *n = &t->node[i]; + if (!ttisnil(gval(n))) { + int k = arrayindex(gkey(n)); + if (k >= 0) { /* is `key' an appropriate array index? */ + nums[luaO_log2(k-1)+1]++; /* count as such */ + (*narray)++; + } + totaluse++; + } } - return NULL; /* no more elements */ + computesizes(nums, totaluse, narray, nhash); } -/* -** try to remove a key without value from a table. To avoid problems with -** hash, change `key' for a number with the same hash. -*/ -void luaH_remove (Hash *t, TObject *key) { - if (ttype(key) == LUA_TNUMBER || - (ttype(key) == LUA_TSTRING && tsvalue(key)->len <= 30)) - return; /* do not remove numbers nor small strings */ +static void setarrayvector (lua_State *L, Table *t, int size) { + int i; + luaM_reallocvector(L, t->array, t->sizearray, size, TObject); + for (i=t->sizearray; i<size; i++) + setnilvalue(&t->array[i]); + t->sizearray = size; +} + + +static void setnodevector (lua_State *L, Table *t, int lsize) { + int i; + int size = twoto(lsize); + if (lsize > MAXBITS) + luaG_runerror(L, "table overflow"); + if (lsize == 0) { /* no elements to hash part? */ + t->node = G(L)->dummynode; /* use common `dummynode' */ + lua_assert(ttisnil(gkey(t->node))); /* assert invariants: */ + lua_assert(ttisnil(gval(t->node))); + lua_assert(t->node->next == NULL); /* (`dummynode' must be empty) */ + } else { - /* try to find a number `n' with the same hash as `key' */ - Node *mp = luaH_mainposition(t, key); - int n = mp - &t->node[0]; - /* make sure `n' is not in `t' */ - while (luaH_getnum(t, n) != &luaO_nilobject) { - if (n >= MAX_INT - t->size) - return; /* give up; (to avoid overflow) */ - n += t->size; + t->node = luaM_newvector(L, size, Node); + for (i=0; i<size; i++) { + t->node[i].next = NULL; + setnilvalue(gkey(gnode(t, i))); + setnilvalue(gval(gnode(t, i))); } - ttype(key) = LUA_TNUMBER; - nvalue(key) = n; - LUA_ASSERT(luaH_mainposition(t, key) == mp, "cannot change hash"); } + t->lsizenode = cast(lu_byte, lsize); + t->firstfree = gnode(t, size-1); /* first free position to be used */ } -static void setnodevector (lua_State *L, Hash *t, lint32 size) { +static void resize (lua_State *L, Table *t, int nasize, int nhsize) { int i; - if (size > MAX_INT) - lua_error(L, "table overflow"); - t->node = luaM_newvector(L, size, Node); - for (i=0; i<(int)size; i++) { - ttype(&t->node[i].key) = ttype(&t->node[i].val) = LUA_TNIL; - t->node[i].next = NULL; + int oldasize = t->sizearray; + int oldhsize = t->lsizenode; + Node *nold; + Node temp[1]; + if (oldhsize) + nold = t->node; /* save old hash ... */ + else { /* old hash is `dummynode' */ + lua_assert(t->node == G(L)->dummynode); + temp[0] = t->node[0]; /* copy it to `temp' */ + nold = temp; + setnilvalue(gkey(G(L)->dummynode)); /* restate invariant */ + setnilvalue(gval(G(L)->dummynode)); + lua_assert(G(L)->dummynode->next == NULL); + } + if (nasize > oldasize) /* array part must grow? */ + setarrayvector(L, t, nasize); + /* create new hash part with appropriate size */ + setnodevector(L, t, nhsize); + /* re-insert elements */ + if (nasize < oldasize) { /* array part must shrink? */ + t->sizearray = nasize; + /* re-insert elements from vanishing slice */ + for (i=nasize; i<oldasize; i++) { + if (!ttisnil(&t->array[i])) + setobjt2t(luaH_setnum(L, t, i+1), &t->array[i]); + } + /* shrink array */ + luaM_reallocvector(L, t->array, oldasize, nasize, TObject); } - L->nblocks += gcsize(L, size) - gcsize(L, t->size); - t->size = size; - t->firstfree = &t->node[size-1]; /* first free position to be used */ + /* re-insert elements in hash part */ + for (i = twoto(oldhsize) - 1; i >= 0; i--) { + Node *old = nold+i; + if (!ttisnil(gval(old))) + setobjt2t(luaH_set(L, t, gkey(old)), gval(old)); + } + if (oldhsize) + luaM_freearray(L, nold, twoto(oldhsize), Node); /* free old array */ } -Hash *luaH_new (lua_State *L, int size) { - Hash *t = luaM_new(L, Hash); - t->htag = TagDefault; - t->next = L->roottable; - L->roottable = t; - t->mark = t; - t->size = 0; - L->nblocks += gcsize(L, 0); - t->node = NULL; - setnodevector(L, t, luaO_power2(size)); - return t; +static void rehash (lua_State *L, Table *t) { + int nasize, nhsize; + numuse(t, &nasize, &nhsize); /* compute new sizes for array and hash parts */ + resize(L, t, nasize, luaO_log2(nhsize)+1); } -void luaH_free (lua_State *L, Hash *t) { - L->nblocks -= gcsize(L, t->size); - luaM_free(L, t->node); - luaM_free(L, t); + +/* +** }============================================================= +*/ + + +Table *luaH_new (lua_State *L, int narray, int lnhash) { + Table *t = luaM_new(L, Table); + luaC_link(L, valtogco(t), LUA_TTABLE); + t->metatable = hvalue(defaultmeta(L)); + t->flags = cast(lu_byte, ~0); + /* temporary values (kept only if some malloc fails) */ + t->array = NULL; + t->sizearray = 0; + t->lsizenode = 0; + t->node = NULL; + setarrayvector(L, t, narray); + setnodevector(L, t, lnhash); + return t; } -static int numuse (const Hash *t) { - Node *v = t->node; - int size = t->size; - int realuse = 0; - int i; - for (i=0; i<size; i++) { - if (ttype(&v[i].val) != LUA_TNIL) - realuse++; - } - return realuse; +void luaH_free (lua_State *L, Table *t) { + if (t->lsizenode) + luaM_freearray(L, t->node, sizenode(t), Node); + luaM_freearray(L, t->array, t->sizearray, TObject); + luaM_freelem(L, t); } -static void rehash (lua_State *L, Hash *t) { - int oldsize = t->size; - Node *nold = t->node; - int nelems = numuse(t); - int i; - LUA_ASSERT(nelems<=oldsize, "wrong count"); - if (nelems >= oldsize-oldsize/4) /* using more than 3/4? */ - setnodevector(L, t, (lint32)oldsize*2); - else if (nelems <= oldsize/4 && /* less than 1/4? */ - oldsize > MINPOWER2) - setnodevector(L, t, oldsize/2); - else - setnodevector(L, t, oldsize); - for (i=0; i<oldsize; i++) { - Node *old = nold+i; - if (ttype(&old->val) != LUA_TNIL) - *luaH_set(L, t, &old->key) = old->val; +#if 0 +/* +** try to remove an element from a hash table; cannot move any element +** (because gc can call `remove' during a table traversal) +*/ +void luaH_remove (Table *t, Node *e) { + Node *mp = luaH_mainposition(t, gkey(e)); + if (e != mp) { /* element not in its main position? */ + while (mp->next != e) mp = mp->next; /* find previous */ + mp->next = e->next; /* remove `e' from its list */ + } + else { + if (e->next != NULL) ?? } - luaM_free(L, nold); /* free old array */ + lua_assert(ttisnil(gval(node))); + setnilvalue(gkey(e)); /* clear node `e' */ + e->next = NULL; } +#endif /* -** inserts a key into a hash table; first, check whether key is -** already present; if not, check whether key's main position is free; -** if not, check whether colliding node is in its main position or not; -** if it is not, move colliding node to an empty place and put new key -** in its main position; otherwise (colliding node is in its main position), -** new key goes to an empty position. +** inserts a new key into a hash table; first, check whether key's main +** position is free. If not, check whether colliding node is in its main +** position or not: if it is not, move colliding node to an empty place and +** put new key in its main position; otherwise (colliding node is in its main +** position), new key goes to an empty position. */ -TObject *luaH_set (lua_State *L, Hash *t, const TObject *key) { +static TObject *newkey (lua_State *L, Table *t, const TObject *key) { + TObject *val; Node *mp = luaH_mainposition(t, key); - Node *n = mp; - if (!mp) - lua_error(L, "table index is nil"); - do { /* check whether `key' is somewhere in the chain */ - if (luaO_equalObj(key, &n->key)) - return &n->val; /* that's all */ - else n = n->next; - } while (n); - /* `key' not found; must insert it */ - if (ttype(&mp->key) != LUA_TNIL) { /* main position is not free? */ - Node *othern; /* main position of colliding node */ - n = t->firstfree; /* get a free place */ - /* is colliding node out of its main position? (can only happens if - its position is after "firstfree") */ - if (mp > n && (othern=luaH_mainposition(t, &mp->key)) != mp) { + if (!ttisnil(gval(mp))) { /* main position is not free? */ + Node *othern = luaH_mainposition(t, gkey(mp)); /* `mp' of colliding node */ + Node *n = t->firstfree; /* get a free place */ + if (othern != mp) { /* is colliding node out of its main position? */ /* yes; move colliding node into free position */ while (othern->next != mp) othern = othern->next; /* find previous */ othern->next = n; /* redo the chain with `n' in place of `mp' */ *n = *mp; /* copy colliding node into free pos. (mp->next also goes) */ mp->next = NULL; /* now `mp' is free */ + setnilvalue(gval(mp)); } else { /* colliding node is in its own main position */ /* new node will go into free position */ @@ -267,37 +397,113 @@ TObject *luaH_set (lua_State *L, Hash *t, const TObject *key) { mp = n; } } - mp->key = *key; + setobj2t(gkey(mp), key); /* write barrier */ + lua_assert(ttisnil(gval(mp))); for (;;) { /* correct `firstfree' */ - if (ttype(&t->firstfree->key) == LUA_TNIL) - return &mp->val; /* OK; table still has a free place */ + if (ttisnil(gkey(t->firstfree))) + return gval(mp); /* OK; table still has a free place */ else if (t->firstfree == t->node) break; /* cannot decrement from here */ else (t->firstfree)--; } - rehash(L, t); /* no more free places */ - return luaH_set(L, t, key); /* `rehash' invalidates this insertion */ + /* no more free places; must create one */ + setbvalue(gval(mp), 0); /* avoid new key being removed */ + rehash(L, t); /* grow table */ + val = cast(TObject *, luaH_get(t, key)); /* get new position */ + lua_assert(ttisboolean(val)); + setnilvalue(val); + return val; +} + + +/* +** generic search function +*/ +static const TObject *luaH_getany (Table *t, const TObject *key) { + if (ttisnil(key)) return &luaO_nilobject; + else { + Node *n = luaH_mainposition(t, key); + do { /* check whether `key' is somewhere in the chain */ + if (luaO_rawequalObj(gkey(n), key)) return gval(n); /* that's it */ + else n = n->next; + } while (n); + return &luaO_nilobject; + } } -TObject *luaH_setint (lua_State *L, Hash *t, int key) { - TObject index; - ttype(&index) = LUA_TNUMBER; - nvalue(&index) = key; - return luaH_set(L, t, &index); +/* +** search function for integers +*/ +const TObject *luaH_getnum (Table *t, int key) { + if (1 <= key && key <= t->sizearray) + return &t->array[key-1]; + else { + lua_Number nk = cast(lua_Number, key); + Node *n = hashnum(t, nk); + do { /* check whether `key' is somewhere in the chain */ + if (ttisnumber(gkey(n)) && nvalue(gkey(n)) == nk) + return gval(n); /* that's it */ + else n = n->next; + } while (n); + return &luaO_nilobject; + } } -void luaH_setstrnum (lua_State *L, Hash *t, TString *key, Number val) { - TObject *value, index; - ttype(&index) = LUA_TSTRING; - tsvalue(&index) = key; - value = luaH_set(L, t, &index); - ttype(value) = LUA_TNUMBER; - nvalue(value) = val; +/* +** search function for strings +*/ +const TObject *luaH_getstr (Table *t, TString *key) { + Node *n = hashstr(t, key); + do { /* check whether `key' is somewhere in the chain */ + if (ttisstring(gkey(n)) && tsvalue(gkey(n)) == key) + return gval(n); /* that's it */ + else n = n->next; + } while (n); + return &luaO_nilobject; } -const TObject *luaH_getglobal (lua_State *L, const char *name) { - return luaH_getstr(L->gt, luaS_new(L, name)); +/* +** main search function +*/ +const TObject *luaH_get (Table *t, const TObject *key) { + switch (ttype(key)) { + case LUA_TSTRING: return luaH_getstr(t, tsvalue(key)); + case LUA_TNUMBER: { + int k; + lua_number2int(k, (nvalue(key))); + if (cast(lua_Number, k) == nvalue(key)) /* is an integer index? */ + return luaH_getnum(t, k); /* use specialized version */ + /* else go through */ + } + default: return luaH_getany(t, key); + } +} + + +TObject *luaH_set (lua_State *L, Table *t, const TObject *key) { + const TObject *p = luaH_get(t, key); + t->flags = 0; + if (p != &luaO_nilobject) + return cast(TObject *, p); + else { + if (ttisnil(key)) luaG_runerror(L, "table index is nil"); + else if (ttisnumber(key) && nvalue(key) != nvalue(key)) + luaG_runerror(L, "table index is NaN"); + return newkey(L, t, key); + } +} + + +TObject *luaH_setnum (lua_State *L, Table *t, int key) { + const TObject *p = luaH_getnum(t, key); + if (p != &luaO_nilobject) + return cast(TObject *, p); + else { + TObject k; + setnvalue(&k, cast(lua_Number, key)); + return newkey(L, t, &k); + } } diff --git a/src/ltable.h b/src/ltable.h index 8ee41a81..3d4d753c 100644 --- a/src/ltable.h +++ b/src/ltable.h @@ -1,5 +1,5 @@ /* -** $Id: ltable.h,v 1.24 2000/08/31 14:08:27 roberto Exp $ +** $Id: ltable.h,v 1.44 2003/03/18 12:50:04 roberto Exp $ ** Lua tables (hash) ** See Copyright Notice in lua.h */ @@ -10,25 +10,22 @@ #include "lobject.h" -#define node(t,i) (&(t)->node[i]) -#define key(n) (&(n)->key) -#define val(n) (&(n)->val) +#define gnode(t,i) (&(t)->node[i]) +#define gkey(n) (&(n)->i_key) +#define gval(n) (&(n)->i_val) -Hash *luaH_new (lua_State *L, int nhash); -void luaH_free (lua_State *L, Hash *t); -const TObject *luaH_get (lua_State *L, const Hash *t, const TObject *key); -const TObject *luaH_getnum (const Hash *t, Number key); -const TObject *luaH_getstr (const Hash *t, TString *key); -void luaH_remove (Hash *t, TObject *key); -TObject *luaH_set (lua_State *L, Hash *t, const TObject *key); -Node * luaH_next (lua_State *L, const Hash *t, const TObject *r); -TObject *luaH_setint (lua_State *L, Hash *t, int key); -void luaH_setstrnum (lua_State *L, Hash *t, TString *key, Number val); -unsigned long luaH_hash (lua_State *L, const TObject *key); -const TObject *luaH_getglobal (lua_State *L, const char *name); + +const TObject *luaH_getnum (Table *t, int key); +TObject *luaH_setnum (lua_State *L, Table *t, int key); +const TObject *luaH_getstr (Table *t, TString *key); +const TObject *luaH_get (Table *t, const TObject *key); +TObject *luaH_set (lua_State *L, Table *t, const TObject *key); +Table *luaH_new (lua_State *L, int narray, int lnhash); +void luaH_free (lua_State *L, Table *t); +int luaH_next (lua_State *L, Table *t, StkId key); /* exported only for debugging */ -Node *luaH_mainposition (const Hash *t, const TObject *key); +Node *luaH_mainposition (const Table *t, const TObject *key); #endif diff --git a/src/ltests.c b/src/ltests.c index c27c7c81..649b14e0 100644 --- a/src/ltests.c +++ b/src/ltests.c @@ -1,15 +1,17 @@ /* -** $Id: ltests.c,v 1.54 2000/10/31 13:10:24 roberto Exp $ +** $Id: ltests.c,v 1.158 2003/04/07 14:35:00 roberto Exp $ ** Internal Module for Debugging of the Lua Implementation ** See Copyright Notice in lua.h */ #include <ctype.h> +#include <limits.h> #include <stdio.h> #include <stdlib.h> #include <string.h> +#define ltests_c #include "lua.h" @@ -24,12 +26,9 @@ #include "lstate.h" #include "lstring.h" #include "ltable.h" -#include "luadebug.h" #include "lualib.h" -void luaB_opentests (lua_State *L); - /* ** The whole module only makes sense with LUA_DEBUG on @@ -37,88 +36,187 @@ void luaB_opentests (lua_State *L); #ifdef LUA_DEBUG +#define lua_pushintegral(L,i) lua_pushnumber(L, cast(lua_Number, (i))) + + +static lua_State *lua_state = NULL; + +int islocked = 0; + + +#define func_at(L,k) (L->ci->base+(k) - 1) + static void setnameval (lua_State *L, const char *name, int val) { lua_pushstring(L, name); - lua_pushnumber(L, val); + lua_pushintegral(L, val); lua_settable(L, -3); } /* +** {====================================================================== +** Controlled version for realloc. +** ======================================================================= +*/ + +#define MARK 0x55 /* 01010101 (a nice pattern) */ + +#ifndef EXTERNMEMCHECK +/* full memory check */ +#define HEADER (sizeof(L_Umaxalign)) /* ensures maximum alignment for HEADER */ +#define MARKSIZE 16 /* size of marks after each block */ +#define blockhead(b) (cast(char *, b) - HEADER) +#define setsize(newblock, size) (*cast(size_t *, newblock) = size) +#define checkblocksize(b, size) (size == (*cast(size_t *, blockhead(b)))) +#define fillmem(mem,size) memset(mem, -MARK, size) +#else +/* external memory check: don't do it twice */ +#define HEADER 0 +#define MARKSIZE 0 +#define blockhead(b) (b) +#define setsize(newblock, size) /* empty */ +#define checkblocksize(b,size) (1) +#define fillmem(mem,size) /* empty */ +#endif + +unsigned long memdebug_numblocks = 0; +unsigned long memdebug_total = 0; +unsigned long memdebug_maxmem = 0; +unsigned long memdebug_memlimit = ULONG_MAX; + + +static void *checkblock (void *block, size_t size) { + void *b = blockhead(block); + int i; + for (i=0;i<MARKSIZE;i++) + lua_assert(*(cast(char *, b)+HEADER+size+i) == MARK+i); /* corrupted block? */ + return b; +} + + +static void freeblock (void *block, size_t size) { + if (block) { + lua_assert(checkblocksize(block, size)); + block = checkblock(block, size); + fillmem(block, size+HEADER+MARKSIZE); /* erase block */ + free(block); /* free original block */ + memdebug_numblocks--; + memdebug_total -= size; + } +} + + +void *debug_realloc (void *block, size_t oldsize, size_t size) { + lua_assert(oldsize == 0 || checkblocksize(block, oldsize)); + /* ISO does not specify what realloc(NULL, 0) does */ + lua_assert(block != NULL || size > 0); + if (size == 0) { + freeblock(block, oldsize); + return NULL; + } + else if (size > oldsize && memdebug_total+size-oldsize > memdebug_memlimit) + return NULL; /* to test memory allocation errors */ + else { + void *newblock; + int i; + size_t realsize = HEADER+size+MARKSIZE; + size_t commonsize = (oldsize < size) ? oldsize : size; + if (realsize < size) return NULL; /* overflow! */ + newblock = malloc(realsize); /* alloc a new block */ + if (newblock == NULL) return NULL; + if (block) { + memcpy(cast(char *, newblock)+HEADER, block, commonsize); + freeblock(block, oldsize); /* erase (and check) old copy */ + } + /* initialize new part of the block with something `weird' */ + fillmem(cast(char *, newblock)+HEADER+commonsize, size-commonsize); + memdebug_total += size; + if (memdebug_total > memdebug_maxmem) + memdebug_maxmem = memdebug_total; + memdebug_numblocks++; + setsize(newblock, size); + for (i=0;i<MARKSIZE;i++) + *(cast(char *, newblock)+HEADER+size+i) = cast(char, MARK+i); + return cast(char *, newblock)+HEADER; + } +} + + +/* }====================================================================== */ + + + +/* ** {====================================================== ** Disassembler ** ======================================================= */ -static const char *const instrname[NUM_OPCODES] = { - "END", "RETURN", "CALL", "TAILCALL", "PUSHNIL", "POP", "PUSHINT", - "PUSHSTRING", "PUSHNUM", "PUSHNEGNUM", "PUSHUPVALUE", "GETLOCAL", - "GETGLOBAL", "GETTABLE", "GETDOTTED", "GETINDEXED", "PUSHSELF", - "CREATETABLE", "SETLOCAL", "SETGLOBAL", "SETTABLE", "SETLIST", "SETMAP", - "ADD", "ADDI", "SUB", "MULT", "DIV", "POW", "CONCAT", "MINUS", "NOT", - "JMPNE", "JMPEQ", "JMPLT", "JMPLE", "JMPGT", "JMPGE", "JMPT", "JMPF", - "JMPONT", "JMPONF", "JMP", "PUSHNILJMP", "FORPREP", "FORLOOP", "LFORPREP", - "LFORLOOP", "CLOSURE" -}; - - -static int pushop (lua_State *L, Proto *p, int pc) { - char buff[100]; +static char *buildop (Proto *p, int pc, char *buff) { Instruction i = p->code[pc]; OpCode o = GET_OPCODE(i); - const char *name = instrname[o]; - sprintf(buff, "%5d - ", luaG_getline(p->lineinfo, pc, 1, NULL)); - switch ((enum Mode)luaK_opproperties[o].mode) { - case iO: - sprintf(buff+8, "%-12s", name); - break; - case iU: - sprintf(buff+8, "%-12s%4u", name, GETARG_U(i)); + const char *name = luaP_opnames[o]; + int line = getline(p, pc); + sprintf(buff, "(%4d) %4d - ", line, pc); + switch (getOpMode(o)) { + case iABC: + sprintf(buff+strlen(buff), "%-12s%4d %4d %4d", name, + GETARG_A(i), GETARG_B(i), GETARG_C(i)); break; - case iS: - sprintf(buff+8, "%-12s%4d", name, GETARG_S(i)); + case iABx: + sprintf(buff+strlen(buff), "%-12s%4d %4d", name, GETARG_A(i), GETARG_Bx(i)); break; - case iAB: - sprintf(buff+8, "%-12s%4d %4d", name, GETARG_A(i), GETARG_B(i)); + case iAsBx: + sprintf(buff+strlen(buff), "%-12s%4d %4d", name, GETARG_A(i), GETARG_sBx(i)); break; } - lua_pushstring(L, buff); - return (o != OP_END); + return buff; } +#if 0 +void luaI_printcode (Proto *pt, int size) { + int pc; + for (pc=0; pc<size; pc++) { + char buff[100]; + printf("%s\n", buildop(pt, pc, buff)); + } + printf("-------\n"); +} +#endif + + static int listcode (lua_State *L) { int pc; Proto *p; - int res; - luaL_arg_check(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1), + luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1), 1, "Lua function expected"); - p = clvalue(luaA_index(L, 1))->f.l; + p = clvalue(func_at(L, 1))->l.p; lua_newtable(L); setnameval(L, "maxstack", p->maxstacksize); setnameval(L, "numparams", p->numparams); - pc = 0; - do { - lua_pushnumber(L, pc+1); - res = pushop(L, p, pc++); + for (pc=0; pc<p->sizecode; pc++) { + char buff[100]; + lua_pushintegral(L, pc+1); + lua_pushstring(L, buildop(p, pc, buff)); lua_settable(L, -3); - } while (res); + } return 1; } -static int liststrings (lua_State *L) { +static int listk (lua_State *L) { Proto *p; int i; - luaL_arg_check(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1), + luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1), 1, "Lua function expected"); - p = clvalue(luaA_index(L, 1))->f.l; + p = clvalue(func_at(L, 1))->l.p; lua_newtable(L); - for (i=0; i<p->nkstr; i++) { - lua_pushnumber(L, i+1); - lua_pushstring(L, p->kstr[i]->str); + for (i=0; i<p->sizek; i++) { + lua_pushintegral(L, i+1); + luaA_pushobject(L, p->k+i); lua_settable(L, -3); } return 1; @@ -127,12 +225,12 @@ static int liststrings (lua_State *L) { static int listlocals (lua_State *L) { Proto *p; - int pc = luaL_check_int(L, 2) - 1; + int pc = luaL_checkint(L, 2) - 1; int i = 0; const char *name; - luaL_arg_check(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1), + luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1), 1, "Lua function expected"); - p = clvalue(luaA_index(L, 1))->f.l; + p = clvalue(func_at(L, 1))->l.p; while ((name = luaF_getlocalname(p, ++i, pc)) != NULL) lua_pushstring(L, name); return i-1; @@ -142,96 +240,107 @@ static int listlocals (lua_State *L) { + static int get_limits (lua_State *L) { lua_newtable(L); setnameval(L, "BITS_INT", BITS_INT); setnameval(L, "LFPF", LFIELDS_PER_FLUSH); - setnameval(L, "MAXARG_A", MAXARG_A); - setnameval(L, "MAXARG_B", MAXARG_B); - setnameval(L, "MAXARG_S", MAXARG_S); - setnameval(L, "MAXARG_U", MAXARG_U); - setnameval(L, "MAXLOCALS", MAXLOCALS); + setnameval(L, "MAXVARS", MAXVARS); setnameval(L, "MAXPARAMS", MAXPARAMS); setnameval(L, "MAXSTACK", MAXSTACK); setnameval(L, "MAXUPVALUES", MAXUPVALUES); - setnameval(L, "MAXVARSLH", MAXVARSLH); - setnameval(L, "RFPF", RFIELDS_PER_FLUSH); - setnameval(L, "SIZE_A", SIZE_A); - setnameval(L, "SIZE_B", SIZE_B); - setnameval(L, "SIZE_OP", SIZE_OP); - setnameval(L, "SIZE_U", SIZE_U); return 1; } static int mem_query (lua_State *L) { - if (lua_isnull(L, 1)) { - lua_pushnumber(L, memdebug_total); - lua_pushnumber(L, memdebug_numblocks); - lua_pushnumber(L, memdebug_maxmem); + if (lua_isnone(L, 1)) { + lua_pushintegral(L, memdebug_total); + lua_pushintegral(L, memdebug_numblocks); + lua_pushintegral(L, memdebug_maxmem); return 3; } else { - memdebug_memlimit = luaL_check_int(L, 1); + memdebug_memlimit = luaL_checkint(L, 1); return 0; } } static int hash_query (lua_State *L) { - if (lua_isnull(L, 2)) { - luaL_arg_check(L, lua_tag(L, 1) == LUA_TSTRING, 1, "string expected"); - lua_pushnumber(L, tsvalue(luaA_index(L, 1))->u.s.hash); + if (lua_isnone(L, 2)) { + luaL_argcheck(L, lua_type(L, 1) == LUA_TSTRING, 1, "string expected"); + lua_pushintegral(L, tsvalue(func_at(L, 1))->tsv.hash); } else { - Hash *t; + TObject *o = func_at(L, 1); + Table *t; luaL_checktype(L, 2, LUA_TTABLE); - t = hvalue(luaA_index(L, 2)); - lua_pushnumber(L, luaH_mainposition(t, luaA_index(L, 1)) - t->node); + t = hvalue(func_at(L, 2)); + lua_pushintegral(L, luaH_mainposition(t, o) - t->node); } return 1; } +static int stacklevel (lua_State *L) { + unsigned long a = 0; + lua_pushintegral(L, (int)(L->top - L->stack)); + lua_pushintegral(L, (int)(L->stack_last - L->stack)); + lua_pushintegral(L, (int)(L->ci - L->base_ci)); + lua_pushintegral(L, (int)(L->end_ci - L->base_ci)); + lua_pushintegral(L, (unsigned long)&a); + return 5; +} + + static int table_query (lua_State *L) { - const Hash *t; - int i = luaL_opt_int(L, 2, -1); + const Table *t; + int i = luaL_optint(L, 2, -1); luaL_checktype(L, 1, LUA_TTABLE); - t = hvalue(luaA_index(L, 1)); + t = hvalue(func_at(L, 1)); if (i == -1) { - lua_pushnumber(L, t->size); - lua_pushnumber(L, t->firstfree - t->node); - return 2; + lua_pushintegral(L, t->sizearray); + lua_pushintegral(L, sizenode(t)); + lua_pushintegral(L, t->firstfree - t->node); } - else if (i < t->size) { - luaA_pushobject(L, &t->node[i].key); - luaA_pushobject(L, &t->node[i].val); - if (t->node[i].next) { - lua_pushnumber(L, t->node[i].next - t->node); - return 3; + else if (i < t->sizearray) { + lua_pushintegral(L, i); + luaA_pushobject(L, &t->array[i]); + lua_pushnil(L); + } + else if ((i -= t->sizearray) < sizenode(t)) { + if (!ttisnil(gval(gnode(t, i))) || + ttisnil(gkey(gnode(t, i))) || + ttisnumber(gkey(gnode(t, i)))) { + luaA_pushobject(L, gkey(gnode(t, i))); } else - return 2; + lua_pushstring(L, "<undef>"); + luaA_pushobject(L, gval(gnode(t, i))); + if (t->node[i].next) + lua_pushintegral(L, t->node[i].next - t->node); + else + lua_pushnil(L); } - return 0; + return 3; } static int string_query (lua_State *L) { - stringtable *tb = (*luaL_check_string(L, 1) == 's') ? &L->strt : &L->udt; - int s = luaL_opt_int(L, 2, 0) - 1; + stringtable *tb = &G(L)->strt; + int s = luaL_optint(L, 2, 0) - 1; if (s==-1) { - lua_pushnumber(L ,tb->nuse); - lua_pushnumber(L ,tb->size); + lua_pushintegral(L ,tb->nuse); + lua_pushintegral(L ,tb->size); return 2; } else if (s < tb->size) { - TString *ts; + GCObject *ts; int n = 0; - for (ts = tb->hash[s]; ts; ts = ts->nexthash) { - ttype(L->top) = LUA_TSTRING; - tsvalue(L->top) = ts; - incr_top; + for (ts = tb->hash[s]; ts; ts = ts->gch.next) { + setsvalue2s(L->top, gcotots(ts)); + incr_top(L); n++; } return n; @@ -241,111 +350,193 @@ static int string_query (lua_State *L) { static int tref (lua_State *L) { + int level = lua_gettop(L); + int lock = luaL_optint(L, 2, 1); luaL_checkany(L, 1); lua_pushvalue(L, 1); - lua_pushnumber(L, lua_ref(L, luaL_opt_int(L, 2, 1))); + lua_pushintegral(L, lua_ref(L, lock)); + assert(lua_gettop(L) == level+1); /* +1 for result */ return 1; } static int getref (lua_State *L) { - if (lua_getref(L, luaL_check_int(L, 1))) - return 1; - else - return 0; + int level = lua_gettop(L); + lua_getref(L, luaL_checkint(L, 1)); + assert(lua_gettop(L) == level+1); + return 1; } static int unref (lua_State *L) { - lua_unref(L, luaL_check_int(L, 1)); + int level = lua_gettop(L); + lua_unref(L, luaL_checkint(L, 1)); + assert(lua_gettop(L) == level); return 0; } +static int metatable (lua_State *L) { + luaL_checkany(L, 1); + if (lua_isnone(L, 2)) { + if (lua_getmetatable(L, 1) == 0) + lua_pushnil(L); + } + else { + lua_settop(L, 2); + luaL_checktype(L, 2, LUA_TTABLE); + lua_setmetatable(L, 1); + } + return 1; +} + + +static int upvalue (lua_State *L) { + int n = luaL_checkint(L, 2); + luaL_checktype(L, 1, LUA_TFUNCTION); + if (lua_isnone(L, 3)) { + const char *name = lua_getupvalue(L, 1, n); + if (name == NULL) return 0; + lua_pushstring(L, name); + return 2; + } + else { + const char *name = lua_setupvalue(L, 1, n); + lua_pushstring(L, name); + return 1; + } +} + + static int newuserdata (lua_State *L) { - if (lua_isnumber(L, 2)) - lua_pushusertag(L, (void *)luaL_check_int(L, 1), luaL_check_int(L, 2)); - else - lua_newuserdata(L, luaL_check_int(L, 1)); + size_t size = luaL_checkint(L, 1); + char *p = cast(char *, lua_newuserdata(L, size)); + while (size--) *p++ = '\0'; + return 1; +} + + +static int pushuserdata (lua_State *L) { + lua_pushlightuserdata(L, cast(void *, luaL_checkint(L, 1))); return 1; } + static int udataval (lua_State *L) { - luaL_checktype(L, 1, LUA_TUSERDATA); - lua_pushnumber(L, (int)lua_touserdata(L, 1)); + lua_pushintegral(L, cast(int, lua_touserdata(L, 1))); + return 1; +} + + +static int doonnewstack (lua_State *L) { + lua_State *L1 = lua_newthread(L); + size_t l; + const char *s = luaL_checklstring(L, 1, &l); + int status = luaL_loadbuffer(L1, s, l, s); + if (status == 0) + status = lua_pcall(L1, 0, 0, 0); + lua_pushintegral(L, status); + return 1; +} + + +static int s2d (lua_State *L) { + lua_pushnumber(L, *cast(const double *, luaL_checkstring(L, 1))); + return 1; +} + +static int d2s (lua_State *L) { + double d = luaL_checknumber(L, 1); + lua_pushlstring(L, cast(char *, &d), sizeof(d)); return 1; } + static int newstate (lua_State *L) { - lua_State *L1 = lua_open(luaL_check_int(L, 1)); - if (L1) - lua_pushuserdata(L, L1); + lua_State *L1 = lua_open(); + if (L1) { + lua_userstateopen(L1); /* init lock */ + lua_pushintegral(L, (unsigned long)L1); + } else lua_pushnil(L); return 1; } + static int loadlib (lua_State *L) { - lua_State *L1 = (lua_State *)lua_touserdata(L, 1); - switch (*luaL_check_string(L, 2)) { - case 'm': lua_mathlibopen(L1); break; - case 's': lua_strlibopen(L1); break; - case 'i': lua_iolibopen(L1); break; - case 'd': lua_dblibopen(L1); break; - case 'b': lua_baselibopen(L1); break; - default: luaL_argerror(L, 2, "invalid option"); - } + static const luaL_reg libs[] = { + {"mathlibopen", luaopen_math}, + {"strlibopen", luaopen_string}, + {"iolibopen", luaopen_io}, + {"tablibopen", luaopen_table}, + {"dblibopen", luaopen_debug}, + {"baselibopen", luaopen_base}, + {NULL, NULL} + }; + lua_State *L1 = cast(lua_State *, + cast(unsigned long, luaL_checknumber(L, 1))); + lua_pushvalue(L1, LUA_GLOBALSINDEX); + luaL_openlib(L1, NULL, libs, 0); return 0; } static int closestate (lua_State *L) { - luaL_checktype(L, 1, LUA_TUSERDATA); - lua_close((lua_State *)lua_touserdata(L, 1)); + lua_State *L1 = cast(lua_State *, cast(unsigned long, luaL_checknumber(L, 1))); + lua_close(L1); + lua_unlock(L); /* close cannot unlock that */ return 0; } static int doremote (lua_State *L) { - lua_State *L1; - const char *code = luaL_check_string(L, 2); + lua_State *L1 = cast(lua_State *,cast(unsigned long,luaL_checknumber(L, 1))); + size_t lcode; + const char *code = luaL_checklstring(L, 2, &lcode); int status; - luaL_checktype(L, 1, LUA_TUSERDATA); - L1 = (lua_State *)lua_touserdata(L, 1); - status = lua_dostring(L1, code); + lua_settop(L1, 0); + status = luaL_loadbuffer(L1, code, lcode, code); + if (status == 0) + status = lua_pcall(L1, 0, LUA_MULTRET, 0); if (status != 0) { lua_pushnil(L); - lua_pushnumber(L, status); - return 2; + lua_pushintegral(L, status); + lua_pushstring(L, lua_tostring(L1, -1)); + return 3; } else { int i = 0; - while (!lua_isnull(L1, ++i)) + while (!lua_isnone(L1, ++i)) lua_pushstring(L, lua_tostring(L1, i)); + lua_pop(L1, i-1); return i-1; } } -static int settagmethod (lua_State *L) { - int tag = luaL_check_int(L, 1); - const char *event = luaL_check_string(L, 2); - luaL_checkany(L, 3); - lua_gettagmethod(L, tag, event); - lua_pushvalue(L, 3); - lua_settagmethod(L, tag, event); + +static int log2_aux (lua_State *L) { + lua_pushintegral(L, luaO_log2(luaL_checkint(L, 1))); return 1; } -static int pushbool (lua_State *L, int b) { - if (b) lua_pushnumber(L, 1); - else lua_pushnil(L); - return 1; +static int int2fb_aux (lua_State *L) { + int b = luaO_int2fb(luaL_checkint(L, 1)); + lua_pushintegral(L, b); + lua_pushintegral(L, fb2int(b)); + return 2; } -static int equal (lua_State *L) { - return pushbool(L, lua_equal(L, 1, 2)); + +static int test_do (lua_State *L) { + const char *p = luaL_checkstring(L, 1); + if (*p == '@') + lua_dofile(L, p+1); + else + lua_dostring(L, p); + return lua_gettop(L); } - + /* ** {====================================================== -** function to test the API with C. It interprets a kind of "assembler" +** function to test the API with C. It interprets a kind of assembler ** language with calls to the API, so the test can be driven by Lua code ** ======================================================= */ @@ -356,12 +547,12 @@ static void skip (const char **pc) { while (**pc != '\0' && strchr(delimits, **pc)) (*pc)++; } -static int getnum (lua_State *L, const char **pc) { +static int getnum_aux (lua_State *L, const char **pc) { int res = 0; int sig = 1; skip(pc); if (**pc == '.') { - res = (int)lua_tonumber(L, -1); + res = cast(int, lua_tonumber(L, -1)); lua_pop(L, 1); (*pc)++; return res; @@ -370,11 +561,11 @@ static int getnum (lua_State *L, const char **pc) { sig = -1; (*pc)++; } - while (isdigit(**pc)) res = res*10 + (*(*pc)++) - '0'; + while (isdigit(cast(int, **pc))) res = res*10 + (*(*pc)++) - '0'; return sig*res; } -static const char *getname (char *buff, const char **pc) { +static const char *getname_aux (char *buff, const char **pc) { int i = 0; skip(pc); while (**pc != '\0' && !strchr(delimits, **pc)) @@ -386,51 +577,52 @@ static const char *getname (char *buff, const char **pc) { #define EQ(s1) (strcmp(s1, inst) == 0) -#define getnum ((getnum)(L, &pc)) -#define getname ((getname)(buff, &pc)) +#define getnum (getnum_aux(L, &pc)) +#define getname (getname_aux(buff, &pc)) static int testC (lua_State *L) { char buff[30]; - const char *pc = luaL_check_string(L, 1); + const char *pc = luaL_checkstring(L, 1); for (;;) { const char *inst = getname; if EQ("") return 0; else if EQ("isnumber") { - lua_pushnumber(L, lua_isnumber(L, getnum)); + lua_pushintegral(L, lua_isnumber(L, getnum)); } else if EQ("isstring") { - lua_pushnumber(L, lua_isstring(L, getnum)); + lua_pushintegral(L, lua_isstring(L, getnum)); } else if EQ("istable") { - lua_pushnumber(L, lua_istable(L, getnum)); + lua_pushintegral(L, lua_istable(L, getnum)); } else if EQ("iscfunction") { - lua_pushnumber(L, lua_iscfunction(L, getnum)); + lua_pushintegral(L, lua_iscfunction(L, getnum)); } else if EQ("isfunction") { - lua_pushnumber(L, lua_isfunction(L, getnum)); + lua_pushintegral(L, lua_isfunction(L, getnum)); } else if EQ("isuserdata") { - lua_pushnumber(L, lua_isuserdata(L, getnum)); + lua_pushintegral(L, lua_isuserdata(L, getnum)); + } + else if EQ("isudataval") { + lua_pushintegral(L, lua_islightuserdata(L, getnum)); } else if EQ("isnil") { - lua_pushnumber(L, lua_isnil(L, getnum)); + lua_pushintegral(L, lua_isnil(L, getnum)); } else if EQ("isnull") { - lua_pushnumber(L, lua_isnull(L, getnum)); + lua_pushintegral(L, lua_isnone(L, getnum)); } else if EQ("tonumber") { lua_pushnumber(L, lua_tonumber(L, getnum)); } else if EQ("tostring") { - lua_pushstring(L, lua_tostring(L, getnum)); - } - else if EQ("tonumber") { - lua_pushnumber(L, lua_tonumber(L, getnum)); + const char *s = lua_tostring(L, getnum); + lua_pushstring(L, s); } else if EQ("strlen") { - lua_pushnumber(L, lua_strlen(L, getnum)); + lua_pushintegral(L, lua_strlen(L, getnum)); } else if EQ("tocfunction") { lua_pushcfunction(L, lua_tocfunction(L, getnum)); @@ -439,7 +631,7 @@ static int testC (lua_State *L) { return getnum; } else if EQ("gettop") { - lua_pushnumber(L, lua_gettop(L)); + lua_pushintegral(L, lua_gettop(L)); } else if EQ("settop") { lua_settop(L, getnum); @@ -448,17 +640,35 @@ static int testC (lua_State *L) { lua_pop(L, getnum); } else if EQ("pushnum") { - lua_pushnumber(L, getnum); + lua_pushintegral(L, getnum); + } + else if EQ("pushnil") { + lua_pushnil(L); + } + else if EQ("pushbool") { + lua_pushboolean(L, getnum); + } + else if EQ("tobool") { + lua_pushintegral(L, lua_toboolean(L, getnum)); } else if EQ("pushvalue") { lua_pushvalue(L, getnum); } + else if EQ("pushcclosure") { + lua_pushcclosure(L, testC, getnum); + } + else if EQ("pushupvalues") { + lua_pushupvalues(L); + } else if EQ("remove") { lua_remove(L, getnum); } else if EQ("insert") { lua_insert(L, getnum); } + else if EQ("replace") { + lua_replace(L, getnum); + } else if EQ("gettable") { lua_gettable(L, getnum); } @@ -471,33 +681,53 @@ static int testC (lua_State *L) { else if EQ("concat") { lua_concat(L, getnum); } + else if EQ("lessthan") { + int a = getnum; + lua_pushboolean(L, lua_lessthan(L, a, getnum)); + } + else if EQ("equal") { + int a = getnum; + lua_pushboolean(L, lua_equal(L, a, getnum)); + } else if EQ("rawcall") { int narg = getnum; int nres = getnum; - lua_rawcall(L, narg, nres); + lua_call(L, narg, nres); } else if EQ("call") { int narg = getnum; int nres = getnum; - lua_call(L, narg, nres); + lua_pcall(L, narg, nres, 0); + } + else if EQ("loadstring") { + size_t sl; + const char *s = luaL_checklstring(L, getnum, &sl); + luaL_loadbuffer(L, s, sl, s); } - else if EQ("dostring") { - lua_dostring(L, luaL_check_string(L, getnum)); + else if EQ("loadfile") { + luaL_loadfile(L, luaL_checkstring(L, getnum)); } - else if EQ("settagmethod") { - int tag = getnum; - const char *event = getname; - lua_settagmethod(L, tag, event); + else if EQ("setmetatable") { + lua_setmetatable(L, getnum); } - else if EQ("gettagmethod") { - int tag = getnum; - const char *event = getname; - lua_gettagmethod(L, tag, event); + else if EQ("getmetatable") { + if (lua_getmetatable(L, getnum) == 0) + lua_pushnil(L); } else if EQ("type") { lua_pushstring(L, lua_typename(L, lua_type(L, getnum))); } - else luaL_verror(L, "unknown instruction %.30s", buff); + else if EQ("getn") { + int i = getnum; + lua_pushintegral(L, luaL_getn(L, i)); + } + else if EQ("setn") { + int i = getnum; + int n = cast(int, lua_tonumber(L, -1)); + luaL_setn(L, i, n); + lua_pop(L, 1); + } + else luaL_error(L, "unknown instruction %s", buff); } return 0; } @@ -505,39 +735,118 @@ static int testC (lua_State *L) { /* }====================================================== */ +/* +** {====================================================== +** tests for yield inside hooks +** ======================================================= +*/ + +static void yieldf (lua_State *L, lua_Debug *ar) { + lua_yield(L, 0); +} + +static int setyhook (lua_State *L) { + if (lua_isnoneornil(L, 1)) + lua_sethook(L, NULL, 0, 0); /* turn off hooks */ + else { + const char *smask = luaL_checkstring(L, 1); + int count = luaL_optint(L, 2, 0); + int mask = 0; + if (strchr(smask, 'l')) mask |= LUA_MASKLINE; + if (count > 0) mask |= LUA_MASKCOUNT; + lua_sethook(L, yieldf, mask, count); + } + return 0; +} + + +static int coresume (lua_State *L) { + int status; + lua_State *co = lua_tothread(L, 1); + luaL_argcheck(L, co, 1, "coroutine expected"); + status = lua_resume(co, 0); + if (status != 0) { + lua_pushboolean(L, 0); + lua_insert(L, -2); + return 2; /* return false + error message */ + } + else { + lua_pushboolean(L, 1); + return 1; + } +} + +/* }====================================================== */ + + static const struct luaL_reg tests_funcs[] = { {"hash", hash_query}, {"limits", get_limits}, {"listcode", listcode}, - {"liststrings", liststrings}, + {"listk", listk}, {"listlocals", listlocals}, {"loadlib", loadlib}, + {"stacklevel", stacklevel}, {"querystr", string_query}, {"querytab", table_query}, + {"doit", test_do}, {"testC", testC}, {"ref", tref}, {"getref", getref}, {"unref", unref}, + {"d2s", d2s}, + {"s2d", s2d}, + {"metatable", metatable}, + {"upvalue", upvalue}, {"newuserdata", newuserdata}, + {"pushuserdata", pushuserdata}, {"udataval", udataval}, + {"doonnewstack", doonnewstack}, {"newstate", newstate}, {"closestate", closestate}, {"doremote", doremote}, - {"settagmethod", settagmethod}, - {"equal", equal}, - {"totalmem", mem_query} + {"log2", log2_aux}, + {"int2fb", int2fb_aux}, + {"totalmem", mem_query}, + {"resume", coresume}, + {"setyhook", setyhook}, + {NULL, NULL} }; -void luaB_opentests (lua_State *L) { - lua_newtable(L); - lua_getglobals(L); - lua_pushvalue(L, -2); - lua_setglobals(L); - luaL_openl(L, tests_funcs); /* open functions inside new table */ - lua_setglobals(L); /* restore old table of globals */ - lua_setglobal(L, "T"); /* set new table as global T */ +static void fim (void) { + if (!islocked) + lua_close(lua_state); + lua_assert(memdebug_numblocks == 0); + lua_assert(memdebug_total == 0); +} + + +static int l_panic (lua_State *L) { + UNUSED(L); + fprintf(stderr, "unable to recover; exiting\n"); + return 0; +} + + +int luaB_opentests (lua_State *L) { + lua_atpanic(L, l_panic); + lua_userstateopen(L); /* init lock */ + lua_state = L; /* keep first state to be opened */ + luaL_openlib(L, "T", tests_funcs, 0); + atexit(fim); + return 0; +} + + +#undef main +int main (int argc, char *argv[]) { + char *limit = getenv("MEMLIMIT"); + if (limit) + memdebug_memlimit = strtoul(limit, NULL, 10); + l_main(argc, argv); + return 0; } #endif @@ -1,163 +1,70 @@ /* -** $Id: ltm.c,v 1.56 2000/10/31 13:10:24 roberto Exp $ +** $Id: ltm.c,v 1.106 2003/04/03 13:35:34 roberto Exp $ ** Tag methods ** See Copyright Notice in lua.h */ -#include <stdio.h> #include <string.h> +#define ltm_c + #include "lua.h" -#include "ldo.h" -#include "lmem.h" #include "lobject.h" #include "lstate.h" +#include "lstring.h" +#include "ltable.h" #include "ltm.h" -const char *const luaT_eventname[] = { /* ORDER TM */ - "gettable", "settable", "index", "getglobal", "setglobal", "add", "sub", - "mul", "div", "pow", "unm", "lt", "concat", "gc", "function", - "le", "gt", "ge", /* deprecated options!! */ - NULL -}; - - -static int findevent (const char *name) { - int i; - for (i=0; luaT_eventname[i]; i++) - if (strcmp(luaT_eventname[i], name) == 0) - return i; - return -1; /* name not found */ -} - - -static int luaI_checkevent (lua_State *L, const char *name, int t) { - int e = findevent(name); - if (e >= TM_N) - luaO_verror(L, "event `%.50s' is deprecated", name); - if (e == TM_GC && t == LUA_TTABLE) - luaO_verror(L, "event `gc' for tables is deprecated"); - if (e < 0) - luaO_verror(L, "`%.50s' is not a valid event name", name); - return e; -} - - -/* events in LUA_TNIL are all allowed, since this is used as a -* 'placeholder' for "default" fallbacks -*/ -/* ORDER LUA_T, ORDER TM */ -static const char luaT_validevents[NUM_TAGS][TM_N] = { - {1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1}, /* LUA_TUSERDATA */ - {1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}, /* LUA_TNIL */ - {1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1}, /* LUA_TNUMBER */ - {1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, /* LUA_TSTRING */ - {0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1}, /* LUA_TTABLE */ - {1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0} /* LUA_TFUNCTION */ +const char *const luaT_typenames[] = { + "nil", "boolean", "userdata", "number", + "string", "table", "function", "userdata", "thread" }; -int luaT_validevent (int t, int e) { /* ORDER LUA_T */ - return (t >= NUM_TAGS) ? 1 : luaT_validevents[t][e]; -} - - -static void init_entry (lua_State *L, int tag) { - int i; - for (i=0; i<TM_N; i++) - luaT_gettm(L, tag, i) = NULL; - L->TMtable[tag].collected = NULL; -} - void luaT_init (lua_State *L) { - int t; - luaM_growvector(L, L->TMtable, 0, NUM_TAGS, struct TM, "", MAX_INT); - L->nblocks += NUM_TAGS*sizeof(struct TM); - L->last_tag = NUM_TAGS-1; - for (t=0; t<=L->last_tag; t++) - init_entry(L, t); -} - - -LUA_API int lua_newtag (lua_State *L) { - luaM_growvector(L, L->TMtable, L->last_tag, 1, struct TM, - "tag table overflow", MAX_INT); - L->nblocks += sizeof(struct TM); - L->last_tag++; - init_entry(L, L->last_tag); - return L->last_tag; -} - - -static void checktag (lua_State *L, int tag) { - if (!(0 <= tag && tag <= L->last_tag)) - luaO_verror(L, "%d is not a valid tag", tag); -} - -void luaT_realtag (lua_State *L, int tag) { - if (!validtag(tag)) - luaO_verror(L, "tag %d was not created by `newtag'", tag); -} - - -LUA_API int lua_copytagmethods (lua_State *L, int tagto, int tagfrom) { - int e; - checktag(L, tagto); - checktag(L, tagfrom); - for (e=0; e<TM_N; e++) { - if (luaT_validevent(tagto, e)) - luaT_gettm(L, tagto, e) = luaT_gettm(L, tagfrom, e); - } - return tagto; -} - - -int luaT_tag (const TObject *o) { - int t = ttype(o); - switch (t) { - case LUA_TUSERDATA: return tsvalue(o)->u.d.tag; - case LUA_TTABLE: return hvalue(o)->htag; - default: return t; + static const char *const luaT_eventname[] = { /* ORDER TM */ + "__index", "__newindex", + "__gc", "__mode", "__eq", + "__add", "__sub", "__mul", "__div", + "__pow", "__unm", "__lt", "__le", + "__concat", "__call" + }; + int i; + for (i=0; i<TM_N; i++) { + G(L)->tmname[i] = luaS_new(L, luaT_eventname[i]); + luaS_fix(G(L)->tmname[i]); /* never collect these names */ } } -LUA_API void lua_gettagmethod (lua_State *L, int t, const char *event) { - int e; - e = luaI_checkevent(L, event, t); - checktag(L, t); - if (luaT_validevent(t, e) && luaT_gettm(L, t, e)) { - clvalue(L->top) = luaT_gettm(L, t, e); - ttype(L->top) = LUA_TFUNCTION; +/* +** function to be used with macro "fasttm": optimized for absence of +** tag methods +*/ +const TObject *luaT_gettm (Table *events, TMS event, TString *ename) { + const TObject *tm = luaH_getstr(events, ename); + lua_assert(event <= TM_EQ); + if (ttisnil(tm)) { /* no tag method? */ + events->flags |= cast(lu_byte, 1u<<event); /* cache this fact */ + return NULL; } - else - ttype(L->top) = LUA_TNIL; - incr_top; + else return tm; } -LUA_API void lua_settagmethod (lua_State *L, int t, const char *event) { - int e = luaI_checkevent(L, event, t); - checktag(L, t); - if (!luaT_validevent(t, e)) - luaO_verror(L, "cannot change `%.20s' tag method for type `%.20s'%.20s", - luaT_eventname[e], luaO_typenames[t], - (t == LUA_TTABLE || t == LUA_TUSERDATA) ? - " with default tag" : ""); - switch (ttype(L->top - 1)) { - case LUA_TNIL: - luaT_gettm(L, t, e) = NULL; - break; - case LUA_TFUNCTION: - luaT_gettm(L, t, e) = clvalue(L->top - 1); - break; +const TObject *luaT_gettmbyobj (lua_State *L, const TObject *o, TMS event) { + TString *ename = G(L)->tmname[event]; + switch (ttype(o)) { + case LUA_TTABLE: + return luaH_getstr(hvalue(o)->metatable, ename); + case LUA_TUSERDATA: + return luaH_getstr(uvalue(o)->uv.metatable, ename); default: - lua_error(L, "tag method must be a function (or nil)"); + return &luaO_nilobject; } - L->top--; } @@ -1,5 +1,5 @@ /* -** $Id: ltm.h,v 1.18 2000/10/05 13:00:17 roberto Exp $ +** $Id: ltm.h,v 1.41 2002/11/14 11:51:50 roberto Exp $ ** Tag methods ** See Copyright Notice in lua.h */ @@ -9,18 +9,18 @@ #include "lobject.h" -#include "lstate.h" + /* * WARNING: if you change the order of this enumeration, * grep "ORDER TM" */ typedef enum { - TM_GETTABLE = 0, - TM_SETTABLE, TM_INDEX, - TM_GETGLOBAL, - TM_SETGLOBAL, + TM_NEWINDEX, + TM_GC, + TM_MODE, + TM_EQ, /* last tag method with `fast' access */ TM_ADD, TM_SUB, TM_MUL, @@ -28,32 +28,24 @@ typedef enum { TM_POW, TM_UNM, TM_LT, + TM_LE, TM_CONCAT, - TM_GC, - TM_FUNCTION, + TM_CALL, TM_N /* number of elements in the enum */ } TMS; -struct TM { - Closure *method[TM_N]; - TString *collected; /* list of garbage-collected udata with this tag */ -}; - - -#define luaT_gettm(L,tag,event) (L->TMtable[tag].method[event]) -#define luaT_gettmbyObj(L,o,e) (luaT_gettm((L),luaT_tag(o),(e))) - -#define validtag(t) (NUM_TAGS <= (t) && (t) <= L->last_tag) +#define gfasttm(g,et,e) \ + (((et)->flags & (1u<<(e))) ? NULL : luaT_gettm(et, e, (g)->tmname[e])) -extern const char *const luaT_eventname[]; +#define fasttm(l,et,e) gfasttm(G(l), et, e) +const TObject *luaT_gettm (Table *events, TMS event, TString *ename); +const TObject *luaT_gettmbyobj (lua_State *L, const TObject *o, TMS event); void luaT_init (lua_State *L); -void luaT_realtag (lua_State *L, int tag); -int luaT_tag (const TObject *o); -int luaT_validevent (int t, int e); /* used by compatibility module */ +extern const char *const luaT_typenames[]; #endif diff --git a/src/lua/Makefile b/src/lua/Makefile index 5b47161f..aa52832f 100644 --- a/src/lua/Makefile +++ b/src/lua/Makefile @@ -4,17 +4,16 @@ LUA= ../.. include $(LUA)/config -EXTRA_DEFS= $(POSIX) - +EXTRA_DEFS= $(USERCONF) OBJS= lua.o SRCS= lua.c T= $(BIN)/lua -all: $T +all: $T -$T: $(OBJS) $(LIB)/liblua.a $(LIB)/liblualib.a - $(CC) -o $@ $(OBJS) -L$(LIB) -llua -llualib $(EXTRA_LIBS) +$T: $(OBJS) $(LIB)/liblua.a $(LIB)/liblualib.a + $(CC) -o $@ $(MYLDFLAGS) $(OBJS) -L$(LIB) -llua -llualib $(EXTRA_LIBS) $(DLLIB) $(LIB)/liblua.a: cd ..; $(MAKE) diff --git a/src/lua/README b/src/lua/README index 832fb5bf..febd229a 100644 --- a/src/lua/README +++ b/src/lua/README @@ -2,39 +2,31 @@ This is lua, a sample Lua interpreter. It can be used as a batch interpreter and also interactively. There are man pages for it in both nroff and html in ../../doc. -Here are the options that it understands: +Usage: ./lua [options] [script [args]]. Available options are: - execute stdin as a file - -c close Lua when exiting -e stat execute string `stat' - -f name execute file `name' with remaining arguments in table `arg' - -i enter interactive mode with prompt - -q enter interactive mode without prompt - -sNUM set stack size to NUM (must be the first option) - -v print version information - a=b set global `a' to string `b' - name execute file `name' + -i enter interactive mode after executing `script' + -l name load and run library `name' + -v show version information + -- stop handling options -If no options are given, then it reads lines from stdin and executes them -as they are read -- so, each line must contain a complete statement. -To span a statement across several lines, end each line with a backslash '\'. +This interpreter is suitable for using Lua as a standalone language; it loads +all standard libraries. For a minimal interpreter, see ../../etc/min.c. -To change the prompt, set the global variable _PROMPT to whatever you want. -You can do this after calling the interpreter or on the command line with - lua _PROMPT="lua: " -i -for example. Note that you need "-i" in this case. +If your application simply exports new functions to Lua (which is common), +then you can use this interpreter (almost) unmodified, as follows: -You must be careful when using quotes on the command line because they are -usually handled by the shell. +* First, define a function + void myinit (lua_State *L) + in your own code. In this function, you should do whatever initializations + are needed by your application, typically exporting your functions to Lua. + (Of course, you can use any name instead of "myinit".) -This interpreter is good for using Lua as a standalone language. -For a minimal interpreter, see ../../etc/min.c. +* Then, #define lua_userinit(L) to be "openstdlibs(L)+myinit(L)". + Here, openstdlibs is a function in lua.c that opens all standard libraries. + If you don't need them, just don't call openstdlibs and open any standard + libraries that you do need in myinit. -If your application simply exports new functions to Lua (which is common), -then you can use this interpreter (almost) unmodified, as follows: -First, define a function - void myinit (lua_State *L) -in your own code. In this function, you should do whatever initializations -are needed by your application, typically exporting your functions to Lua. -Then, add a call "myinit(L)" in lua.c after the place marked - "add your libraries here" -Of course, you can use any name instead of "myinit". +* Finally, remember to link your C code when building lua. + +For other customizations, see ../../etc/config.c. diff --git a/src/lua/lua.c b/src/lua/lua.c index 2da857e1..28c84cb6 100644 --- a/src/lua/lua.c +++ b/src/lua/lua.c @@ -1,5 +1,5 @@ /* -** $Id: lua.c,v 1.55 2000/10/20 16:36:32 roberto Exp $ +** $Id: lua.c,v 1.122 2003/04/03 13:34:42 roberto Exp $ ** Lua stand-alone interpreter ** See Copyright Notice in lua.h */ @@ -10,313 +10,429 @@ #include <stdlib.h> #include <string.h> +#define lua_c + #include "lua.h" -#include "luadebug.h" +#include "lauxlib.h" #include "lualib.h" -static lua_State *L = NULL; +/* +** generic extra include file +*/ +#ifdef LUA_USERCONFIG +#include LUA_USERCONFIG +#endif + + +/* +** definition of `isatty' +*/ +#ifdef _POSIX_C_SOURCE +#include <unistd.h> +#define stdin_is_tty() isatty(0) +#else +#define stdin_is_tty() 1 /* assume stdin is a tty */ +#endif + #ifndef PROMPT #define PROMPT "> " #endif -#ifdef _POSIX_SOURCE -#include <unistd.h> -#else -static int isatty (int x) { return x==0; } /* assume stdin is a tty */ + +#ifndef PROMPT2 +#define PROMPT2 ">> " #endif +#ifndef PROGNAME +#define PROGNAME "lua" +#endif -/* -** global options -*/ -struct Options { - int toclose; - int stacksize; -}; +#ifndef lua_userinit +#define lua_userinit(L) openstdlibs(L) +#endif -typedef void (*handler)(int); /* type for signal actions */ +#ifndef LUA_EXTRALIBS +#define LUA_EXTRALIBS /* empty */ +#endif -static void laction (int i); +static lua_State *L = NULL; -static lua_Hook old_linehook = NULL; -static lua_Hook old_callhook = NULL; +static const char *progname = PROGNAME; -static void userinit (void) { - lua_baselibopen(L); - lua_iolibopen(L); - lua_strlibopen(L); - lua_mathlibopen(L); - lua_dblibopen(L); + +static const luaL_reg lualibs[] = { + {"base", luaopen_base}, + {"table", luaopen_table}, + {"io", luaopen_io}, + {"string", luaopen_string}, + {"math", luaopen_math}, + {"debug", luaopen_debug}, + {"loadlib", luaopen_loadlib}, /* add your libraries here */ -} + LUA_EXTRALIBS + {NULL, NULL} +}; -static handler lreset (void) { - return signal(SIGINT, laction); -} - -static void lstop (void) { - lua_setlinehook(L, old_linehook); - lua_setcallhook(L, old_callhook); - lreset(); - lua_error(L, "interrupted!"); +static void lstop (lua_State *l, lua_Debug *ar) { + (void)ar; /* unused arg. */ + lua_sethook(l, NULL, 0, 0); + luaL_error(l, "interrupted!"); } static void laction (int i) { - (void)i; /* to avoid warnings */ - signal(SIGINT, SIG_DFL); /* if another SIGINT happens before lstop, + signal(i, SIG_DFL); /* if another SIGINT happens before lstop, terminate process (default action) */ - old_linehook = lua_setlinehook(L, (lua_Hook)lstop); - old_callhook = lua_setcallhook(L, (lua_Hook)lstop); -} - - -static int ldo (int (*f)(lua_State *l, const char *), const char *name) { - int res; - handler h = lreset(); - int top = lua_gettop(L); - res = f(L, name); /* dostring | dofile */ - lua_settop(L, top); /* remove eventual results */ - signal(SIGINT, h); /* restore old action */ - /* Lua gives no message in such cases, so lua.c provides one */ - if (res == LUA_ERRMEM) { - fprintf(stderr, "lua: memory allocation error\n"); - } - else if (res == LUA_ERRERR) - fprintf(stderr, "lua: error in error message\n"); - return res; + lua_sethook(L, lstop, LUA_MASKCALL | LUA_MASKRET | LUA_MASKCOUNT, 1); } -static void print_message (void) { +static void print_usage (void) { fprintf(stderr, - "usage: lua [options]. Available options are:\n" + "usage: %s [options] [script [args]].\n" + "Available options are:\n" " - execute stdin as a file\n" - " -c close Lua when exiting\n" " -e stat execute string `stat'\n" - " -f name execute file `name' with remaining arguments in table `arg'\n" - " -i enter interactive mode with prompt\n" - " -q enter interactive mode without prompt\n" - " -sNUM set stack size to NUM (must be the first option)\n" - " -v print version information\n" - " a=b set global `a' to string `b'\n" - " name execute file `name'\n" -); + " -i enter interactive mode after executing `script'\n" + " -l name load and run library `name'\n" + " -v show version information\n" + " -- stop handling options\n" , + progname); } -static void print_version (void) { - printf("%.80s %.80s\n", LUA_VERSION, LUA_COPYRIGHT); +static void l_message (const char *pname, const char *msg) { + if (pname) fprintf(stderr, "%s: ", pname); + fprintf(stderr, "%s\n", msg); } -static void assign (char *arg) { - char *eq = strchr(arg, '='); - *eq = '\0'; /* spilt `arg' in two strings (name & value) */ - lua_pushstring(L, eq+1); - lua_setglobal(L, arg); +static int report (int status) { + const char *msg; + if (status) { + msg = lua_tostring(L, -1); + if (msg == NULL) msg = "(error with no message)"; + l_message(progname, msg); + lua_pop(L, 1); + } + return status; } -static void getargs (char *argv[]) { +static int lcall (int narg, int clear) { + int status; + int base = lua_gettop(L) - narg; /* function index */ + lua_pushliteral(L, "_TRACEBACK"); + lua_rawget(L, LUA_GLOBALSINDEX); /* get traceback function */ + lua_insert(L, base); /* put it under chunk and args */ + signal(SIGINT, laction); + status = lua_pcall(L, narg, (clear ? 0 : LUA_MULTRET), base); + signal(SIGINT, SIG_DFL); + lua_remove(L, base); /* remove traceback function */ + return status; +} + + +static void print_version (void) { + l_message(NULL, LUA_VERSION " " LUA_COPYRIGHT); +} + + +static void getargs (char *argv[], int n) { int i; lua_newtable(L); for (i=0; argv[i]; i++) { - /* arg[i] = argv[i] */ - lua_pushnumber(L, i); + lua_pushnumber(L, i - n); lua_pushstring(L, argv[i]); - lua_settable(L, -3); + lua_rawset(L, -3); } /* arg.n = maximum index in table `arg' */ - lua_pushstring(L, "n"); - lua_pushnumber(L, i-1); - lua_settable(L, -3); + lua_pushliteral(L, "n"); + lua_pushnumber(L, i-n-1); + lua_rawset(L, -3); } -static int l_getargs (lua_State *l) { - char **argv = (char **)lua_touserdata(l, -1); - getargs(argv); - return 1; +static int docall (int status) { + if (status == 0) status = lcall(0, 1); + return report(status); } -static int file_input (const char *argv) { - int result = ldo(lua_dofile, argv); - if (result) { - if (result == LUA_ERRFILE) { - fprintf(stderr, "lua: cannot execute file "); - perror(argv); - } - return EXIT_FAILURE; +static int file_input (const char *name) { + return docall(luaL_loadfile(L, name)); +} + + +static int dostring (const char *s, const char *name) { + return docall(luaL_loadbuffer(L, s, strlen(s), name)); +} + + +static int load_file (const char *name) { + lua_pushliteral(L, "require"); + lua_rawget(L, LUA_GLOBALSINDEX); + if (!lua_isfunction(L, -1)) { /* no `require' defined? */ + lua_pop(L, 1); + return file_input(name); + } + else { + lua_pushstring(L, name); + return report(lcall(1, 1)); } - else - return EXIT_SUCCESS; } -/* maximum length of an input string */ +/* +** this macro can be used by some `history' system to save lines +** read in manual input +*/ +#ifndef lua_saveline +#define lua_saveline(L,line) /* empty */ +#endif + + +/* +** this macro defines a function to show the prompt and reads the +** next line for manual input +*/ +#ifndef lua_readline +#define lua_readline(L,prompt) readline(L,prompt) + +/* maximum length of an input line */ #ifndef MAXINPUT -#define MAXINPUT BUFSIZ +#define MAXINPUT 512 #endif -static void manual_input (int version, int prompt) { - int cont = 1; - if (version) print_version(); - while (cont) { - char buffer[MAXINPUT]; - int i = 0; - if (prompt) { - const char *s; - lua_getglobal(L, "_PROMPT"); - s = lua_tostring(L, -1); - if (!s) s = PROMPT; - fputs(s, stdout); - lua_pop(L, 1); /* remove global */ - } - for(;;) { - int c = getchar(); - if (c == EOF) { - cont = 0; - break; - } - else if (c == '\n') { - if (i>0 && buffer[i-1] == '\\') - buffer[i-1] = '\n'; - else break; - } - else if (i >= MAXINPUT-1) { - fprintf(stderr, "lua: input line too long\n"); - break; - } - else buffer[i++] = (char)c; + +static int readline (lua_State *l, const char *prompt) { + static char buffer[MAXINPUT]; + if (prompt) { + fputs(prompt, stdout); + fflush(stdout); + } + if (fgets(buffer, sizeof(buffer), stdin) == NULL) + return 0; /* read fails */ + else { + lua_pushstring(l, buffer); + return 1; + } +} + +#endif + + +static const char *get_prompt (int firstline) { + const char *p = NULL; + lua_pushstring(L, firstline ? "_PROMPT" : "_PROMPT2"); + lua_rawget(L, LUA_GLOBALSINDEX); + p = lua_tostring(L, -1); + if (p == NULL) p = (firstline ? PROMPT : PROMPT2); + lua_pop(L, 1); /* remove global */ + return p; +} + + +static int incomplete (int status) { + if (status == LUA_ERRSYNTAX && + strstr(lua_tostring(L, -1), "near `<eof>'") != NULL) { + lua_pop(L, 1); + return 1; + } + else + return 0; +} + + +static int load_string (void) { + int status; + lua_settop(L, 0); + if (lua_readline(L, get_prompt(1)) == 0) /* no input? */ + return -1; + if (lua_tostring(L, -1)[0] == '=') { /* line starts with `=' ? */ + lua_pushfstring(L, "return %s", lua_tostring(L, -1)+1);/* `=' -> `return' */ + lua_remove(L, -2); /* remove original line */ + } + for (;;) { /* repeat until gets a complete line */ + status = luaL_loadbuffer(L, lua_tostring(L, 1), lua_strlen(L, 1), "=stdin"); + if (!incomplete(status)) break; /* cannot try to add lines? */ + if (lua_readline(L, get_prompt(0)) == 0) /* no more input? */ + return -1; + lua_concat(L, lua_gettop(L)); /* join lines */ + } + lua_saveline(L, lua_tostring(L, 1)); + lua_remove(L, 1); /* remove line */ + return status; +} + + +static void manual_input (void) { + int status; + const char *oldprogname = progname; + progname = NULL; + while ((status = load_string()) != -1) { + if (status == 0) status = lcall(0, 0); + report(status); + if (status == 0 && lua_gettop(L) > 0) { /* any result to print? */ + lua_getglobal(L, "print"); + lua_insert(L, 1); + if (lua_pcall(L, lua_gettop(L)-1, 0, 0) != 0) + l_message(progname, lua_pushfstring(L, "error calling `print' (%s)", + lua_tostring(L, -1))); } - buffer[i] = '\0'; - ldo(lua_dostring, buffer); - lua_settop(L, 0); /* remove eventual results */ } - printf("\n"); + lua_settop(L, 0); /* clear stack */ + fputs("\n", stdout); + progname = oldprogname; } -static int handle_argv (char *argv[], struct Options *opt) { - if (opt->stacksize > 0) argv++; /* skip option `-s' (if present) */ - if (*argv == NULL) { /* no more arguments? */ - if (isatty(0)) { - manual_input(1, 1); +static int handle_argv (char *argv[], int *interactive) { + if (argv[1] == NULL) { /* no more arguments? */ + if (stdin_is_tty()) { + print_version(); + manual_input(); } else - ldo(lua_dofile, NULL); /* executes stdin as a file */ + file_input(NULL); /* executes stdin as a file */ } else { /* other arguments; loop over them */ int i; - for (i = 0; argv[i] != NULL; i++) { - if (argv[i][0] != '-') { /* not an option? */ - if (strchr(argv[i], '=')) - assign(argv[i]); - else - if (file_input(argv[i]) != EXIT_SUCCESS) - return EXIT_FAILURE; /* stop if file fails */ - } - else switch (argv[i][1]) { /* option */ - case 0: { - ldo(lua_dofile, NULL); /* executes stdin as a file */ - break; - } - case 'i': { - manual_input(0, 1); - break; - } - case 'q': { - manual_input(0, 0); - break; - } - case 'c': { - opt->toclose = 1; - break; + for (i = 1; argv[i] != NULL; i++) { + if (argv[i][0] != '-') break; /* not an option? */ + switch (argv[i][1]) { /* option */ + case '-': { /* `--' */ + if (argv[i][2] != '\0') { + print_usage(); + return 1; } - case 'v': { - print_version(); - break; - } - case 'e': { - i++; - if (argv[i] == NULL) { - print_message(); - return EXIT_FAILURE; - } - if (ldo(lua_dostring, argv[i]) != 0) { - fprintf(stderr, "lua: error running argument `%.99s'\n", argv[i]); - return EXIT_FAILURE; - } - break; - } - case 'f': { - i++; - if (argv[i] == NULL) { - print_message(); - return EXIT_FAILURE; - } - getargs(argv+i); /* collect remaining arguments */ - lua_setglobal(L, "arg"); - return file_input(argv[i]); /* stop scanning arguments */ - } - case 's': { - fprintf(stderr, "lua: stack size (`-s') must be the first option\n"); - return EXIT_FAILURE; + i++; /* skip this argument */ + goto endloop; /* stop handling arguments */ + } + case '\0': { + file_input(NULL); /* executes stdin as a file */ + break; + } + case 'i': { + *interactive = 1; + break; + } + case 'v': { + print_version(); + break; + } + case 'e': { + const char *chunk = argv[i] + 2; + if (*chunk == '\0') chunk = argv[++i]; + if (chunk == NULL) { + print_usage(); + return 1; } - default: { - print_message(); - return EXIT_FAILURE; + if (dostring(chunk, "=<command line>") != 0) + return 1; + break; + } + case 'l': { + const char *filename = argv[i] + 2; + if (*filename == '\0') filename = argv[++i]; + if (filename == NULL) { + print_usage(); + return 1; } + if (load_file(filename)) + return 1; /* stop if file fails */ + break; + } + case 'c': { + l_message(progname, "option `-c' is deprecated"); + break; + } + case 's': { + l_message(progname, "option `-s' is deprecated"); + break; + } + default: { + print_usage(); + return 1; } + } + } endloop: + if (argv[i] != NULL) { + const char *filename = argv[i]; + getargs(argv, i); /* collect arguments */ + lua_setglobal(L, "arg"); + return file_input(filename); /* stop scanning arguments */ } } - return EXIT_SUCCESS; + return 0; } -static void getstacksize (int argc, char *argv[], struct Options *opt) { - if (argc >= 2 && argv[1][0] == '-' && argv[1][1] == 's') { - int stacksize = atoi(&argv[1][2]); - if (stacksize <= 0) { - fprintf(stderr, "lua: invalid stack size ('%.20s')\n", &argv[1][2]); - exit(EXIT_FAILURE); - } - opt->stacksize = stacksize; +static void openstdlibs (lua_State *l) { + const luaL_reg *lib = lualibs; + for (; lib->func; lib++) { + lib->func(l); /* open library */ + lua_settop(l, 0); /* discard any results */ } +} + + +static int handle_luainit (void) { + const char *init = getenv("LUA_INIT"); + if (init == NULL) return 0; /* status OK */ + else if (init[0] == '@') + return file_input(init+1); else - opt->stacksize = 0; /* no stack size */ + return dostring(init, "=LUA_INIT"); } -static void register_getargs (char *argv[]) { - lua_pushuserdata(L, argv); - lua_pushcclosure(L, l_getargs, 1); - lua_setglobal(L, "getargs"); +struct Smain { + int argc; + char **argv; + int status; +}; + + +static int pmain (lua_State *l) { + struct Smain *s = (struct Smain *)lua_touserdata(l, 1); + int status; + int interactive = 0; + if (s->argv[0] && s->argv[0][0]) progname = s->argv[0]; + L = l; + lua_userinit(l); /* open libraries */ + status = handle_luainit(); + if (status == 0) { + status = handle_argv(s->argv, &interactive); + if (status == 0 && interactive) manual_input(); + } + s->status = status; + return 0; } int main (int argc, char *argv[]) { - struct Options opt; int status; - opt.toclose = 0; - getstacksize(argc, argv, &opt); /* handle option `-s' */ - L = lua_open(opt.stacksize); /* create state */ - userinit(); /* open libraries */ - register_getargs(argv); /* create `getargs' function */ - status = handle_argv(argv+1, &opt); - if (opt.toclose) - lua_close(L); - return status; + struct Smain s; + lua_State *l = lua_open(); /* create state */ + if (l == NULL) { + l_message(argv[0], "cannot create state: not enough memory"); + return EXIT_FAILURE; + } + s.argc = argc; + s.argv = argv; + status = lua_cpcall(l, &pmain, &s); + report(status); + lua_close(l); + return (status || s.status) ? EXIT_FAILURE : EXIT_SUCCESS; } diff --git a/src/luac/Makefile b/src/luac/Makefile index 4517d82b..7a620826 100644 --- a/src/luac/Makefile +++ b/src/luac/Makefile @@ -4,20 +4,27 @@ LUA= ../.. include $(LUA)/config -INCS= -I$(INC) $(EXTRA_INCS) -I.. -OBJS= dump.o luac.o opt.o print.o stubs.o -SRCS= dump.c luac.c opt.c print.c stubs.c luac.h print.h +INCS= -I$(INC) -I.. $(EXTRA_INCS) +OBJS= luac.o print.o lopcodes.o +SRCS= luac.c print.c T= $(BIN)/luac -all: $T +all: $T -$T: $(OBJS) $(LIB)/liblua.a - $(CC) -o $@ $(OBJS) -L$(LIB) -llua +$T: $(OBJS) $(LIB)/liblua.a $(LIB)/liblualib.a + $(CC) -o $@ $(MYLDFLAGS) $(OBJS) -L$(LIB) -llua -llualib $(EXTRA_LIBS) + +# print.c needs opcode names from lopcodes.c +lopcodes.o: ../lopcodes.c ../lopcodes.h + $(CC) -o $@ -c $(CFLAGS) -DLUA_OPNAMES ../lopcodes.c $(LIB)/liblua.a: cd ..; $(MAKE) +$(LIB)/liblualib.a: + cd ../lib; $(MAKE) + clean: rm -f $(OBJS) $T diff --git a/src/luac/README b/src/luac/README index 8d8bb491..ada7bc4b 100644 --- a/src/luac/README +++ b/src/luac/README @@ -1,22 +1,18 @@ This is luac, the Lua compiler. There are man pages for it in both nroff and html in ../../doc. -luac translates Lua programs into binary files that can be loaded and executed -with lua_dofile in C or with dofile in Lua. +luac translates Lua programs into binary files that can be loaded latter. The main advantages of pre-compiling chunks are: faster loading, protecting source code from user changes, and off-line syntax error detection. luac can also be used to learn about the Lua virtual machine. -Here are the options that luac understands: - +Usage: /l/luac/luac [options] [filenames]. Available options are: - process stdin -l list - -o file output file (default is "luac.out") + -o name output to file `name' (default is "luac.out") -p parse only -s strip debug information - -t test code integrity -v show version information + -- stop handling options luac is also an example of how to use the internals of Lua (politely). -Finally, luac does not need the runtime code, and stubs.c makes sure it is not -linked into luac. This file also shows how to avoid linking the parser. diff --git a/src/luac/dump.c b/src/luac/dump.c deleted file mode 100644 index 149469ba..00000000 --- a/src/luac/dump.c +++ /dev/null @@ -1,121 +0,0 @@ -/* -** $Id: dump.c,v 1.30 2000/10/31 16:57:23 lhf Exp $ -** save bytecodes to file -** See Copyright Notice in lua.h -*/ - -#include <stdio.h> -#include <stdlib.h> -#include <string.h> - -#include "luac.h" - -#define DumpVector(b,n,size,D) fwrite(b,size,n,D) -#define DumpBlock(b,size,D) fwrite(b,size,1,D) -#define DumpByte fputc - -static void DumpInt(int x, FILE* D) -{ - DumpBlock(&x,sizeof(x),D); -} - -static void DumpSize(size_t x, FILE* D) -{ - DumpBlock(&x,sizeof(x),D); -} - -static void DumpNumber(Number x, FILE* D) -{ - DumpBlock(&x,sizeof(x),D); -} - -static void DumpString(const TString* s, FILE* D) -{ - if (s==NULL || s->str==NULL) - DumpSize(0,D); - else - { - size_t size=s->len+1; /* include trailing '\0' */ - DumpSize(size,D); - DumpBlock(s->str,size,D); - } -} - -static void DumpCode(const Proto* tf, FILE* D) -{ - DumpInt(tf->ncode,D); - DumpVector(tf->code,tf->ncode,sizeof(*tf->code),D); -} - -static void DumpLocals(const Proto* tf, FILE* D) -{ - int i,n=tf->nlocvars; - DumpInt(n,D); - for (i=0; i<n; i++) - { - DumpString(tf->locvars[i].varname,D); - DumpInt(tf->locvars[i].startpc,D); - DumpInt(tf->locvars[i].endpc,D); - } -} - -static void DumpLines(const Proto* tf, FILE* D) -{ - DumpInt(tf->nlineinfo,D); - DumpVector(tf->lineinfo,tf->nlineinfo,sizeof(*tf->lineinfo),D); -} - -static void DumpFunction(const Proto* tf, FILE* D); - -static void DumpConstants(const Proto* tf, FILE* D) -{ - int i,n; - DumpInt(n=tf->nkstr,D); - for (i=0; i<n; i++) - DumpString(tf->kstr[i],D); - DumpInt(tf->nknum,D); - DumpVector(tf->knum,tf->nknum,sizeof(*tf->knum),D); - DumpInt(n=tf->nkproto,D); - for (i=0; i<n; i++) - DumpFunction(tf->kproto[i],D); -} - -static void DumpFunction(const Proto* tf, FILE* D) -{ - DumpString(tf->source,D); - DumpInt(tf->lineDefined,D); - DumpInt(tf->numparams,D); - DumpByte(tf->is_vararg,D); - DumpInt(tf->maxstacksize,D); - DumpLocals(tf,D); - DumpLines(tf,D); - DumpConstants(tf,D); - DumpCode(tf,D); - if (ferror(D)) - { - perror("luac: write error"); - exit(1); - } -} - -static void DumpHeader(FILE* D) -{ - DumpByte(ID_CHUNK,D); - fputs(SIGNATURE,D); - DumpByte(VERSION,D); - DumpByte(luaU_endianess(),D); - DumpByte(sizeof(int),D); - DumpByte(sizeof(size_t),D); - DumpByte(sizeof(Instruction),D); - DumpByte(SIZE_INSTRUCTION,D); - DumpByte(SIZE_OP,D); - DumpByte(SIZE_B,D); - DumpByte(sizeof(Number),D); - DumpNumber(TEST_NUMBER,D); -} - -void luaU_dumpchunk(const Proto* Main, FILE* D) -{ - DumpHeader(D); - DumpFunction(Main,D); -} diff --git a/src/luac/luac.c b/src/luac/luac.c index 8832de62..9ea23342 100644 --- a/src/luac/luac.c +++ b/src/luac/luac.c @@ -1,6 +1,6 @@ /* -** $Id: luac.c,v 1.28 2000/11/06 20:06:27 lhf Exp $ -** lua compiler (saves bytecodes to files; also list binary files) +** $Id: luac.c,v 1.44 2003/04/07 20:34:20 lhf Exp $ +** Lua compiler (saves bytecodes to files; also list bytecodes) ** See Copyright Notice in lua.h */ @@ -8,78 +8,80 @@ #include <stdlib.h> #include <string.h> -#include "lparser.h" -#include "lstate.h" -#include "lzio.h" -#include "luac.h" +#include "lua.h" +#include "lauxlib.h" -#define OUTPUT "luac.out" /* default output file */ +#include "lfunc.h" +#include "lmem.h" +#include "lobject.h" +#include "lopcodes.h" +#include "lstring.h" +#include "lundump.h" -static void usage(const char* message, const char* arg); -static int doargs(int argc, const char* argv[]); -static Proto* load(const char* filename); -static FILE* efopen(const char* name, const char* mode); -static void strip(Proto* tf); -static Proto* combine(Proto** P, int n); +#ifndef LUA_DEBUG +#define luaB_opentests(L) +#endif -lua_State* lua_state=NULL; /* lazy! */ +#ifndef PROGNAME +#define PROGNAME "luac" /* program name */ +#endif + +#define OUTPUT "luac.out" /* default output file */ static int listing=0; /* list bytecodes? */ static int dumping=1; /* dump bytecodes? */ static int stripping=0; /* strip debug information? */ -static int testing=0; /* test integrity? */ -static const char* output=OUTPUT; /* output file name */ +static char Output[]={ OUTPUT }; /* default output file name */ +static const char* output=Output; /* output file name */ +static const char* progname=PROGNAME; /* actual program name */ -#define IS(s) (strcmp(argv[i],s)==0) +static void fatal(const char* message) +{ + fprintf(stderr,"%s: %s\n",progname,message); + exit(EXIT_FAILURE); +} -int main(int argc, const char* argv[]) +static void cannot(const char* name, const char* what, const char* mode) { - Proto** P,*tf; - int i=doargs(argc,argv); - argc-=i; argv+=i; - if (argc<=0) usage("no input files given",NULL); - L=lua_open(0); - P=luaM_newvector(L,argc,Proto*); - for (i=0; i<argc; i++) - P[i]=load(IS("-")? NULL : argv[i]); - tf=combine(P,argc); - if (dumping) luaU_optchunk(tf); - if (listing) luaU_printchunk(tf); - if (testing) luaU_testchunk(tf); - if (dumping) - { - if (stripping) strip(tf); - luaU_dumpchunk(tf,efopen(output,"wb")); - } - return 0; + fprintf(stderr,"%s: cannot %s %sput file ",progname,what,mode); + perror(name); + exit(EXIT_FAILURE); } static void usage(const char* message, const char* arg) { if (message!=NULL) { - fprintf(stderr,"luac: "); fprintf(stderr,message,arg); fprintf(stderr,"\n"); + fprintf(stderr,"%s: ",progname); fprintf(stderr,message,arg); fprintf(stderr,"\n"); } fprintf(stderr, - "usage: luac [options] [filenames]. Available options are:\n" + "usage: %s [options] [filenames]. Available options are:\n" " - process stdin\n" " -l list\n" - " -o file output file (default is \"" OUTPUT "\")\n" + " -o name output to file `name' (default is \"" OUTPUT "\")\n" " -p parse only\n" " -s strip debug information\n" - " -t test code integrity\n" " -v show version information\n" - ); - exit(1); + " -- stop handling options\n", + progname); + exit(EXIT_FAILURE); } -static int doargs(int argc, const char* argv[]) +#define IS(s) (strcmp(argv[i],s)==0) + +static int doargs(int argc, char* argv[]) { int i; + if (argv[0]!=NULL && *argv[0]!=0) progname=argv[0]; for (i=1; i<argc; i++) { - if (*argv[i]!='-') /* end of options */ + if (*argv[i]!='-') /* end of options; keep it */ + break; + else if (IS("--")) /* end of options; skip it */ + { + ++i; break; + } else if (IS("-")) /* end of options; use stdin */ return i; else if (IS("-l")) /* list */ @@ -87,117 +89,103 @@ static int doargs(int argc, const char* argv[]) else if (IS("-o")) /* output file */ { output=argv[++i]; - if (output==NULL) usage(NULL,NULL); + if (output==NULL || *output==0) usage("`-o' needs argument",NULL); } else if (IS("-p")) /* parse only */ dumping=0; else if (IS("-s")) /* strip debug information */ stripping=1; - else if (IS("-t")) /* test */ - { - testing=1; - dumping=0; - } else if (IS("-v")) /* show version */ { printf("%s %s\n",LUA_VERSION,LUA_COPYRIGHT); - if (argc==2) exit(0); + if (argc==2) exit(EXIT_SUCCESS); } else /* unknown option */ usage("unrecognized option `%s'",argv[i]); } - if (i==argc && (listing || testing)) + if (i==argc && (listing || !dumping)) { dumping=0; - argv[--i]=OUTPUT; + argv[--i]=Output; } return i; } -static Proto* load(const char* filename) +static Proto* toproto(lua_State* L, int i) { - Proto* tf; - ZIO z; - char source[512]; - FILE* f; - int c,undump; - if (filename==NULL) - { - f=stdin; - filename="(stdin)"; - } - else - f=efopen(filename,"r"); - c=ungetc(fgetc(f),f); - if (ferror(f)) - { - fprintf(stderr,"luac: cannot read from "); - perror(filename); - exit(1); - } - undump=(c==ID_CHUNK); - if (undump && f!=stdin) - { - fclose(f); - f=efopen(filename,"rb"); - } - sprintf(source,"@%.*s",Sizeof(source)-2,filename); - luaZ_Fopen(&z,f,source); - tf = undump ? luaU_undump(L,&z) : luaY_parser(L,&z); - if (f!=stdin) fclose(f); - return tf; + const Closure* c=(const Closure*)lua_topointer(L,i); + return c->l.p; } -static Proto* combine(Proto** P, int n) +static Proto* combine(lua_State* L, int n) { if (n==1) - return P[0]; + return toproto(L,-1); else { int i,pc=0; - Proto* tf=luaF_newproto(L); - tf->source=luaS_new(L,"=(luac)"); - tf->maxstacksize=1; - tf->kproto=P; - tf->nkproto=n; - tf->ncode=2*n+1; - tf->code=luaM_newvector(L,tf->ncode,Instruction); + Proto* f=luaF_newproto(L); + f->source=luaS_newliteral(L,"=(" PROGNAME ")"); + f->maxstacksize=1; + f->p=luaM_newvector(L,n,Proto*); + f->sizep=n; + f->sizecode=2*n+1; + f->code=luaM_newvector(L,f->sizecode,Instruction); for (i=0; i<n; i++) { - tf->code[pc++]=CREATE_AB(OP_CLOSURE,i,0); - tf->code[pc++]=CREATE_AB(OP_CALL,0,0); + f->p[i]=toproto(L,i-n); + f->code[pc++]=CREATE_ABx(OP_CLOSURE,0,i); + f->code[pc++]=CREATE_ABC(OP_CALL,0,1,1); } - tf->code[pc++]=OP_END; - return tf; + f->code[pc++]=CREATE_ABC(OP_RETURN,0,1,0); + return f; } } -static void strip(Proto* tf) +static void strip(lua_State* L, Proto* f) { - int i,n=tf->nkproto; - tf->lineinfo=NULL; - tf->nlineinfo=0; - tf->source=luaS_new(L,"=(none)"); - tf->locvars=NULL; - tf->nlocvars=0; - for (i=0; i<n; i++) strip(tf->kproto[i]); + int i,n=f->sizep; + luaM_freearray(L, f->lineinfo, f->sizelineinfo, int); + luaM_freearray(L, f->locvars, f->sizelocvars, struct LocVar); + luaM_freearray(L, f->upvalues, f->sizeupvalues, TString *); + f->lineinfo=NULL; f->sizelineinfo=0; + f->locvars=NULL; f->sizelocvars=0; + f->upvalues=NULL; f->sizeupvalues=0; + f->source=luaS_newliteral(L,"=(none)"); + for (i=0; i<n; i++) strip(L,f->p[i]); } -static FILE* efopen(const char* name, const char* mode) +static int writer(lua_State* L, const void* p, size_t size, void* u) { - FILE* f=fopen(name,mode); - if (f==NULL) - { - fprintf(stderr,"luac: cannot open %sput file ",*mode=='r' ? "in" : "out"); - perror(name); - exit(1); - } - return f; + UNUSED(L); + return fwrite(p,size,1,(FILE*)u)==1; } -void luaU_testchunk(const Proto* Main) +int main(int argc, char* argv[]) { - UNUSED(Main); - fprintf(stderr,"luac: -t not operational in this version\n"); - exit(1); + lua_State* L; + Proto* f; + int i=doargs(argc,argv); + argc-=i; argv+=i; + if (argc<=0) usage("no input files given",NULL); + L=lua_open(); + luaB_opentests(L); + for (i=0; i<argc; i++) + { + const char* filename=IS("-") ? NULL : argv[i]; + if (luaL_loadfile(L,filename)!=0) fatal(lua_tostring(L,-1)); + } + f=combine(L,argc); + if (listing) luaU_print(f); + if (dumping) + { + FILE* D=fopen(output,"wb"); + if (D==NULL) cannot(output,"open","out"); + if (stripping) strip(L,f); + luaU_dump(L,f,writer,D); + if (ferror(D)) cannot(output,"write","out"); + fclose(D); + } + lua_close(L); + return 0; } diff --git a/src/luac/luac.h b/src/luac/luac.h deleted file mode 100644 index f8987cf2..00000000 --- a/src/luac/luac.h +++ /dev/null @@ -1,31 +0,0 @@ -/* -** $Id: luac.h,v 1.18 2000/10/31 16:57:23 lhf Exp $ -** definitions for luac -** See Copyright Notice in lua.h -*/ - -#include "ldebug.h" -#include "lfunc.h" -#include "lmem.h" -#include "lobject.h" -#include "lopcodes.h" -#include "lstring.h" -#include "ltable.h" -#include "lundump.h" - -extern lua_State *lua_state; -#define L lua_state /* lazy! */ - -/* from dump.c */ -void luaU_dumpchunk(const Proto* Main, FILE* D); - -/* from opt.c */ -void luaU_optchunk(Proto* Main); - -/* from print.c */ -void luaU_printchunk(const Proto* Main); - -/* from test.c */ -void luaU_testchunk(const Proto* Main); - -#define Sizeof(x) ((int)sizeof(x)) diff --git a/src/luac/opt.c b/src/luac/opt.c deleted file mode 100644 index e51a0868..00000000 --- a/src/luac/opt.c +++ /dev/null @@ -1,127 +0,0 @@ -/* -** $Id: opt.c,v 1.22 2000/10/31 16:57:23 lhf Exp $ -** optimize bytecodes -** See Copyright Notice in lua.h -*/ - -#include <stdio.h> -#include <stdlib.h> -#include <string.h> - -#include "luac.h" - -static int MapConstant(Hash* t, int j, const TObject* key) -{ - const TObject* o=luaH_get(L,t,key); - if (ttype(o)==LUA_TNUMBER) - return (int) nvalue(o); - else - { - TObject val; - ttype(&val)=LUA_TNUMBER; - nvalue(&val)=j; - *luaH_set(L,t,key)=val; - LUA_ASSERT(j>=0,"MapConstant returns negative!"); - return j; - } -} - -static int MapConstants(Proto* tf, Hash* map) -{ - int i,j,k,n,m=0; - TObject o; - j=0; n=tf->nknum; ttype(&o)=LUA_TNUMBER; - for (i=0; i<n; i++) - { - nvalue(&o)=tf->knum[i]; - k=MapConstant(map,j,&o); - if (k==j) j++; - } - m=j; - j=0; n=tf->nkstr; ttype(&o)=LUA_TSTRING; - for (i=0; i<n; i++) - { - tsvalue(&o)=tf->kstr[i]; - k=MapConstant(map,j,&o); - if (k==j) j++; - } - return m+j; -} - -static void PackConstants(Proto* tf, Hash* map) -{ - int i,j,k,n; - TObject o; -#ifdef DEBUG - printf("%p before pack nknum=%d nkstr=%d\n",tf,tf->nknum,tf->nkstr); -#endif - j=0; n=tf->nknum; ttype(&o)=LUA_TNUMBER; - for (i=0; i<n; i++) - { - nvalue(&o)=tf->knum[i]; - k=MapConstant(map,-1,&o); - if (k==j) tf->knum[j++]=tf->knum[i]; - } - tf->nknum=j; - j=0; n=tf->nkstr; ttype(&o)=LUA_TSTRING; - for (i=0; i<n; i++) - { - tsvalue(&o)=tf->kstr[i]; - k=MapConstant(map,-1,&o); - if (k==j) tf->kstr[j++]=tf->kstr[i]; - } - tf->nkstr=j; -#ifdef DEBUG - printf("%p after pack nknum=%d nkstr=%d\n",tf,tf->nknum,tf->nkstr); -#endif -} - -static void OptConstants(Proto* tf) -{ - Instruction* p; - int n=tf->nknum+tf->nkstr; - Hash* map=luaH_new(L,n); - int m=MapConstants(tf,map); -#ifdef DEBUG - printf("%p n=%d m=%d %s\n",tf,n,m,(m==n)?"nothing to optimize":"yes!"); -#endif - if (m==n) return; - for (p=tf->code;; p++) - { - Instruction i=*p; - int op=GET_OPCODE(i); - switch (op) - { - TObject o; - int j,k; - case OP_PUSHNUM: case OP_PUSHNEGNUM: - j=GETARG_U(i); - ttype(&o)=LUA_TNUMBER; nvalue(&o)=tf->knum[j]; - k=MapConstant(map,-1,&o); - if (k!=j) *p=CREATE_U(op,k); - break; - case OP_PUSHSTRING: case OP_GETGLOBAL: case OP_GETDOTTED: - case OP_PUSHSELF: case OP_SETGLOBAL: - j=GETARG_U(i); - ttype(&o)=LUA_TSTRING; tsvalue(&o)=tf->kstr[j]; - k=MapConstant(map,-1,&o); - if (k!=j) *p=CREATE_U(op,k); - break; - case OP_END: - PackConstants(tf,map); - luaH_free(L,map); - return; - default: - break; - } - } -} - -#define OptFunction luaU_optchunk - -void OptFunction(Proto* tf) -{ - int i,n=tf->nkproto; - OptConstants(tf); - for (i=0; i<n; i++) OptFunction(tf->kproto[i]); -} diff --git a/src/luac/print.c b/src/luac/print.c index 4ffc8b3d..d0b5efb2 100644 --- a/src/luac/print.c +++ b/src/luac/print.c @@ -1,31 +1,30 @@ /* -** $Id: print.c,v 1.32 2000/11/06 20:04:36 lhf Exp $ +** $Id: print.c,v 1.44 2003/04/07 20:34:20 lhf Exp $ ** print bytecodes ** See Copyright Notice in lua.h */ #include <stdio.h> -#include <stdlib.h> - -#include "luac.h" - -/* macros used in print.h, included in PrintCode */ -#define P_OP(x) printf("%-11s\t",x) -#define P_NONE -#define P_AB printf("%d %d",GETARG_A(i),GETARG_B(i)) -#define P_F printf("%d %d\t; %p",GETARG_A(i),GETARG_B(i),tf->kproto[GETARG_A(i)]) -#define P_J printf("%d\t; to %d",GETARG_S(i),GETARG_S(i)+at+1) -#define P_Q PrintString(tf,GETARG_U(i)) -#define P_K printf("%d\t; %s",GETARG_U(i),tf->kstr[GETARG_U(i)]->str) -#define P_L PrintLocal(tf,GETARG_U(i),at-1) -#define P_N printf("%d\t; " NUMBER_FMT,GETARG_U(i),tf->knum[GETARG_U(i)]) -#define P_S printf("%d",GETARG_S(i)) -#define P_U printf("%u",GETARG_U(i)) - -static void PrintString(const Proto* tf, int n) + +#if 0 +#define DEBUG_PRINT +#endif + +#ifndef LUA_OPNAMES +#define LUA_OPNAMES +#endif + +#include "ldebug.h" +#include "lobject.h" +#include "lopcodes.h" +#include "lundump.h" + +#define Sizeof(x) ((int)sizeof(x)) +#define VOID(p) ((const void*)(p)) + +static void PrintString(const Proto* f, int n) { - const char* s=tf->kstr[n]->str; - printf("%d\t; ",n); + const char* s=svalue(&f->k[n]); putchar('"'); for (; *s; s++) { @@ -45,55 +44,174 @@ static void PrintString(const Proto* tf, int n) putchar('"'); } -static void PrintLocal(const Proto* tf, int n, int pc) +static void PrintConstant(const Proto* f, int i) { - const char* s=luaF_getlocalname(tf,n+1,pc); - printf("%u",n); - if (s!=NULL) printf("\t; %s",s); + const TObject* o=&f->k[i]; + switch (ttype(o)) + { + case LUA_TNUMBER: + printf(LUA_NUMBER_FMT,nvalue(o)); + break; + case LUA_TSTRING: + PrintString(f,i); + break; + case LUA_TNIL: + printf("nil"); + break; + default: /* cannot happen */ + printf("? type=%d",ttype(o)); + break; + } } -static void PrintCode(const Proto* tf) +static void PrintCode(const Proto* f) { - const Instruction* code=tf->code; - const Instruction* p=code; - for (;;) + const Instruction* code=f->code; + int pc,n=f->sizecode; + for (pc=0; pc<n; pc++) { - int at=p-code+1; - Instruction i=*p; - int line=luaG_getline(tf->lineinfo,at-1,1,NULL); - printf("%6d\t",at); - if (line>=0) printf("[%d]\t",line); else printf("[-]\t"); - switch (GET_OPCODE(i)) { -#include "print.h" + Instruction i=code[pc]; + OpCode o=GET_OPCODE(i); + int a=GETARG_A(i); + int b=GETARG_B(i); + int c=GETARG_C(i); + int bc=GETARG_Bx(i); + int sbc=GETARG_sBx(i); + int line=getline(f,pc); +#if 0 + printf("%0*lX",Sizeof(i)*2,i); +#endif + printf("\t%d\t",pc+1); + if (line>0) printf("[%d]\t",line); else printf("[-]\t"); + printf("%-9s\t",luaP_opnames[o]); + switch (getOpMode(o)) + { + case iABC: printf("%d %d %d",a,b,c); break; + case iABx: printf("%d %d",a,bc); break; + case iAsBx: printf("%d %d",a,sbc); break; + } + switch (o) + { + case OP_LOADK: + printf("\t; "); PrintConstant(f,bc); + break; + case OP_GETUPVAL: + case OP_SETUPVAL: + printf("\t; %s", (f->sizeupvalues>0) ? getstr(f->upvalues[b]) : "-"); + break; + case OP_GETGLOBAL: + case OP_SETGLOBAL: + printf("\t; %s",svalue(&f->k[bc])); + break; + case OP_GETTABLE: + case OP_SELF: + if (c>=MAXSTACK) { printf("\t; "); PrintConstant(f,c-MAXSTACK); } + break; + case OP_SETTABLE: + case OP_ADD: + case OP_SUB: + case OP_MUL: + case OP_DIV: + case OP_POW: + case OP_EQ: + case OP_LT: + case OP_LE: + if (b>=MAXSTACK || c>=MAXSTACK) + { + printf("\t; "); + if (b>=MAXSTACK) PrintConstant(f,b-MAXSTACK); else printf("-"); + printf(" "); + if (c>=MAXSTACK) PrintConstant(f,c-MAXSTACK); + } + break; + case OP_JMP: + case OP_FORLOOP: + case OP_TFORPREP: + printf("\t; to %d",sbc+pc+2); + break; + case OP_CLOSURE: + printf("\t; %p",VOID(f->p[bc])); + break; + default: + break; } printf("\n"); - if (i==OP_END) break; - p++; } } -#define IsMain(tf) (tf->lineDefined==0) +static const char* Source(const Proto* f) +{ + const char* s=getstr(f->source); + if (*s=='@' || *s=='=') + return s+1; + else if (*s==LUA_SIGNATURE[0]) + return "(bstring)"; + else + return "(string)"; +} + +#define IsMain(f) (f->lineDefined==0) #define SS(x) (x==1)?"":"s" #define S(x) x,SS(x) -static void PrintHeader(const Proto* tf) +static void PrintHeader(const Proto* f) +{ + printf("\n%s <%s:%d> (%d instruction%s, %d bytes at %p)\n", + IsMain(f)?"main":"function",Source(f),f->lineDefined, + S(f->sizecode),f->sizecode*Sizeof(Instruction),VOID(f)); + printf("%d%s param%s, %d stack%s, %d upvalue%s, ", + f->numparams,f->is_vararg?"+":"",SS(f->numparams),S(f->maxstacksize), + S(f->nups)); + printf("%d local%s, %d constant%s, %d function%s\n", + S(f->sizelocvars),S(f->sizek),S(f->sizep)); +} + +#ifdef DEBUG_PRINT +static void PrintConstants(const Proto* f) +{ + int i,n=f->sizek; + printf("constants (%d) for %p:\n",n,VOID(f)); + for (i=0; i<n; i++) + { + printf("\t%d\t",i); + PrintConstant(f,i); + printf("\n"); + } +} + +static void PrintLocals(const Proto* f) { - printf("\n%s " SOURCE_FMT " (%d instruction%s/%d bytes at %p)\n", - IsMain(tf)?"main":"function",SOURCE, - S(tf->ncode),tf->ncode*Sizeof(Instruction),tf); - printf("%d%s param%s, %d stack%s, ", - tf->numparams,tf->is_vararg?"+":"",SS(tf->numparams),S(tf->maxstacksize)); - printf("%d local%s, %d string%s, %d number%s, %d function%s, %d line%s\n", - S(tf->nlocvars),S(tf->nkstr),S(tf->nknum),S(tf->nkproto),S(tf->nlineinfo)); + int i,n=f->sizelocvars; + printf("locals (%d) for %p:\n",n,VOID(f)); + for (i=0; i<n; i++) + { + printf("\t%d\t%s\t%d\t%d\n", + i,getstr(f->locvars[i].varname),f->locvars[i].startpc,f->locvars[i].endpc); + } } -#define PrintFunction luaU_printchunk +static void PrintUpvalues(const Proto* f) +{ + int i,n=f->sizeupvalues; + printf("upvalues (%d) for %p:\n",n,VOID(f)); + if (f->upvalues==NULL) return; + for (i=0; i<n; i++) + { + printf("\t%d\t%s\n",i,getstr(f->upvalues[i])); + } +} +#endif -void PrintFunction(const Proto* tf) +void luaU_print(const Proto* f) { - int i,n=tf->nkproto; - PrintHeader(tf); - PrintCode(tf); - for (i=0; i<n; i++) PrintFunction(tf->kproto[i]); + int i,n=f->sizep; + PrintHeader(f); + PrintCode(f); +#ifdef DEBUG_PRINT + PrintConstants(f); + PrintLocals(f); + PrintUpvalues(f); +#endif + for (i=0; i<n; i++) luaU_print(f->p[i]); } diff --git a/src/luac/print.h b/src/luac/print.h deleted file mode 100644 index 5f74e149..00000000 --- a/src/luac/print.h +++ /dev/null @@ -1,55 +0,0 @@ -/* -** $Id: print.h,v 1.1 2000/11/06 20:03:12 lhf Exp $ -** extracted automatically from lopcodes.h by mkprint.lua -- DO NOT EDIT -** See Copyright Notice in lua.h -*/ - - case OP_END: P_OP("END"); P_NONE; break; - case OP_RETURN: P_OP("RETURN"); P_U; break; - case OP_CALL: P_OP("CALL"); P_AB; break; - case OP_TAILCALL: P_OP("TAILCALL"); P_AB; break; - case OP_PUSHNIL: P_OP("PUSHNIL"); P_U; break; - case OP_POP: P_OP("POP"); P_U; break; - case OP_PUSHINT: P_OP("PUSHINT"); P_S; break; - case OP_PUSHSTRING: P_OP("PUSHSTRING"); P_Q; break; - case OP_PUSHNUM: P_OP("PUSHNUM"); P_N; break; - case OP_PUSHNEGNUM: P_OP("PUSHNEGNUM"); P_N; break; - case OP_PUSHUPVALUE: P_OP("PUSHUPVALUE"); P_U; break; - case OP_GETLOCAL: P_OP("GETLOCAL"); P_L; break; - case OP_GETGLOBAL: P_OP("GETGLOBAL"); P_K; break; - case OP_GETTABLE: P_OP("GETTABLE"); P_NONE; break; - case OP_GETDOTTED: P_OP("GETDOTTED"); P_K; break; - case OP_GETINDEXED: P_OP("GETINDEXED"); P_L; break; - case OP_PUSHSELF: P_OP("PUSHSELF"); P_K; break; - case OP_CREATETABLE: P_OP("CREATETABLE"); P_U; break; - case OP_SETLOCAL: P_OP("SETLOCAL"); P_L; break; - case OP_SETGLOBAL: P_OP("SETGLOBAL"); P_K; break; - case OP_SETTABLE: P_OP("SETTABLE"); P_AB; break; - case OP_SETLIST: P_OP("SETLIST"); P_AB; break; - case OP_SETMAP: P_OP("SETMAP"); P_U; break; - case OP_ADD: P_OP("ADD"); P_NONE; break; - case OP_ADDI: P_OP("ADDI"); P_S; break; - case OP_SUB: P_OP("SUB"); P_NONE; break; - case OP_MULT: P_OP("MULT"); P_NONE; break; - case OP_DIV: P_OP("DIV"); P_NONE; break; - case OP_POW: P_OP("POW"); P_NONE; break; - case OP_CONCAT: P_OP("CONCAT"); P_U; break; - case OP_MINUS: P_OP("MINUS"); P_NONE; break; - case OP_NOT: P_OP("NOT"); P_NONE; break; - case OP_JMPNE: P_OP("JMPNE"); P_J; break; - case OP_JMPEQ: P_OP("JMPEQ"); P_J; break; - case OP_JMPLT: P_OP("JMPLT"); P_J; break; - case OP_JMPLE: P_OP("JMPLE"); P_J; break; - case OP_JMPGT: P_OP("JMPGT"); P_J; break; - case OP_JMPGE: P_OP("JMPGE"); P_J; break; - case OP_JMPT: P_OP("JMPT"); P_J; break; - case OP_JMPF: P_OP("JMPF"); P_J; break; - case OP_JMPONT: P_OP("JMPONT"); P_J; break; - case OP_JMPONF: P_OP("JMPONF"); P_J; break; - case OP_JMP: P_OP("JMP"); P_J; break; - case OP_PUSHNILJMP: P_OP("PUSHNILJMP"); P_NONE; break; - case OP_FORPREP: P_OP("FORPREP"); P_J; break; - case OP_FORLOOP: P_OP("FORLOOP"); P_J; break; - case OP_LFORPREP: P_OP("LFORPREP"); P_J; break; - case OP_LFORLOOP: P_OP("LFORLOOP"); P_J; break; - case OP_CLOSURE: P_OP("CLOSURE"); P_F; break; diff --git a/src/luac/stubs.c b/src/luac/stubs.c deleted file mode 100644 index 74f509eb..00000000 --- a/src/luac/stubs.c +++ /dev/null @@ -1,127 +0,0 @@ -/* -** $Id: stubs.c,v 1.20 2000/10/31 16:57:23 lhf Exp $ -** avoid runtime modules in luac -** See Copyright Notice in lua.h -*/ - -#include <stdio.h> -#include <stdlib.h> - -#include "ldo.h" -#include "llex.h" -#include "luac.h" -#undef L - -#ifndef NOSTUBS - -const char luac_ident[] = "$luac: " LUA_VERSION " " LUA_COPYRIGHT " $\n" - "$Authors: " LUA_AUTHORS " $"; - -/* -* avoid lapi ldebug ldo lgc lstate ltm lvm -* use only lcode lfunc llex lmem lobject lparser lstring ltable lzio -*/ - -/* simplified from ldo.c */ -void lua_error (lua_State* L, const char* s) { - UNUSED(L); - if (s) fprintf(stderr,"luac: %s\n",s); - exit(1); -} - -/* simplified from ldo.c */ -void luaD_breakrun (lua_State *L, int errcode) { - UNUSED(errcode); - lua_error(L,"memory allocation error"); -} - -/* simplified from lstate.c */ -lua_State *lua_open (int stacksize) { - lua_State *L = luaM_new(NULL, lua_State); - if (L == NULL) return NULL; /* memory allocation error */ - L->stack = NULL; - L->strt.size = L->udt.size = 0; - L->strt.nuse = L->udt.nuse = 0; - L->strt.hash = NULL; - L->udt.hash = NULL; - L->Mbuffer = NULL; - L->Mbuffsize = 0; - L->rootproto = NULL; - L->rootcl = NULL; - L->roottable = NULL; - L->TMtable = NULL; - L->last_tag = -1; - L->refArray = NULL; - L->refSize = 0; - L->refFree = NONEXT; - L->nblocks = sizeof(lua_State); - L->GCthreshold = MAX_INT; /* to avoid GC during pre-definitions */ - L->callhook = NULL; - L->linehook = NULL; - L->allowhooks = 1; - L->errorJmp = NULL; - if (stacksize == 0) - stacksize = DEFAULT_STACK_SIZE; - else - stacksize += LUA_MINSTACK; - L->gt = luaH_new(L, 10); /* table of globals */ - luaS_init(L); - luaX_init(L); - L->GCthreshold = 2*L->nblocks; - return L; -} - -/* copied from ldebug.c */ -int luaG_getline (int *lineinfo, int pc, int refline, int *prefi) { - int refi; - if (lineinfo == NULL || pc == -1) - return -1; /* no line info or function is not active */ - refi = prefi ? *prefi : 0; - if (lineinfo[refi] < 0) - refline += -lineinfo[refi++]; - LUA_ASSERT(lineinfo[refi] >= 0, "invalid line info"); - while (lineinfo[refi] > pc) { - refline--; - refi--; - if (lineinfo[refi] < 0) - refline -= -lineinfo[refi--]; - LUA_ASSERT(lineinfo[refi] >= 0, "invalid line info"); - } - for (;;) { - int nextline = refline + 1; - int nextref = refi + 1; - if (lineinfo[nextref] < 0) - nextline += -lineinfo[nextref++]; - LUA_ASSERT(lineinfo[nextref] >= 0, "invalid line info"); - if (lineinfo[nextref] > pc) - break; - refline = nextline; - refi = nextref; - } - if (prefi) *prefi = refi; - return refline; -} - -/* -* the code below avoids the lexer and the parser (llex lparser lcode). -* it is useful if you only want to load binary files. -* this works for interpreters like lua.c too. -*/ - -#ifdef NOPARSER - -#include "llex.h" -#include "lparser.h" - -void luaX_init(lua_State *L) { - UNUSED(L); -} - -Proto *luaY_parser(lua_State *L, ZIO *z) { - UNUSED(z); - lua_error(L,"parser not loaded"); - return NULL; -} - -#endif -#endif diff --git a/src/lundump.c b/src/lundump.c index a8d06106..151a8507 100644 --- a/src/lundump.c +++ b/src/lundump.c @@ -1,243 +1,285 @@ /* -** $Id: lundump.c,v 1.33 2000/10/31 16:57:23 lhf Exp $ -** load bytecodes from files +** $Id: lundump.c,v 1.49 2003/04/07 20:34:20 lhf Exp $ +** load pre-compiled Lua chunks ** See Copyright Notice in lua.h */ -#include <stdio.h> -#include <string.h> +#define lundump_c +#include "lua.h" + +#include "ldebug.h" #include "lfunc.h" #include "lmem.h" #include "lopcodes.h" #include "lstring.h" #include "lundump.h" +#include "lzio.h" -#define LoadByte ezgetc +#define LoadByte (lu_byte) ezgetc -static const char* ZNAME (ZIO* Z) -{ - const char* s=zname(Z); - return (*s=='@') ? s+1 : s; -} +typedef struct { + lua_State* L; + ZIO* Z; + Mbuffer* b; + int swap; + const char* name; +} LoadState; -static void unexpectedEOZ (lua_State* L, ZIO* Z) +static void unexpectedEOZ (LoadState* S) { - luaO_verror(L,"unexpected end of file in `%.99s'",ZNAME(Z)); + luaG_runerror(S->L,"unexpected end of file in %s",S->name); } -static int ezgetc (lua_State* L, ZIO* Z) +static int ezgetc (LoadState* S) { - int c=zgetc(Z); - if (c==EOZ) unexpectedEOZ(L,Z); + int c=zgetc(S->Z); + if (c==EOZ) unexpectedEOZ(S); return c; } -static void ezread (lua_State* L, ZIO* Z, void* b, int n) +static void ezread (LoadState* S, void* b, int n) { - int r=zread(Z,b,n); - if (r!=0) unexpectedEOZ(L,Z); + int r=luaZ_read(S->Z,b,n); + if (r!=0) unexpectedEOZ(S); } -static void LoadBlock (lua_State* L, void* b, size_t size, ZIO* Z, int swap) +static void LoadBlock (LoadState* S, void* b, size_t size) { - if (swap) + if (S->swap) { - char *p=(char *) b+size-1; + char* p=(char*) b+size-1; int n=size; - while (n--) *p--=(char)ezgetc(L,Z); + while (n--) *p--=(char)ezgetc(S); } else - ezread(L,Z,b,size); + ezread(S,b,size); } -static void LoadVector (lua_State* L, void* b, int m, size_t size, ZIO* Z, int swap) +static void LoadVector (LoadState* S, void* b, int m, size_t size) { - if (swap) + if (S->swap) { - char *q=(char *) b; + char* q=(char*) b; while (m--) { - char *p=q+size-1; + char* p=q+size-1; int n=size; - while (n--) *p--=(char)ezgetc(L,Z); + while (n--) *p--=(char)ezgetc(S); q+=size; } } else - ezread(L,Z,b,m*size); + ezread(S,b,m*size); } -static int LoadInt (lua_State* L, ZIO* Z, int swap) +static int LoadInt (LoadState* S) { int x; - LoadBlock(L,&x,sizeof(x),Z,swap); + LoadBlock(S,&x,sizeof(x)); + if (x<0) luaG_runerror(S->L,"bad integer in %s",S->name); return x; } -static size_t LoadSize (lua_State* L, ZIO* Z, int swap) +static size_t LoadSize (LoadState* S) { size_t x; - LoadBlock(L,&x,sizeof(x),Z,swap); + LoadBlock(S,&x,sizeof(x)); return x; } -static Number LoadNumber (lua_State* L, ZIO* Z, int swap) +static lua_Number LoadNumber (LoadState* S) { - Number x; - LoadBlock(L,&x,sizeof(x),Z,swap); + lua_Number x; + LoadBlock(S,&x,sizeof(x)); return x; } -static TString* LoadString (lua_State* L, ZIO* Z, int swap) +static TString* LoadString (LoadState* S) { - size_t size=LoadSize(L,Z,swap); + size_t size=LoadSize(S); if (size==0) return NULL; else { - char* s=luaO_openspace(L,size); - LoadBlock(L,s,size,Z,0); - return luaS_newlstr(L,s,size-1); /* remove trailing '\0' */ + char* s=luaZ_openspace(S->L,S->b,size); + ezread(S,s,size); + return luaS_newlstr(S->L,s,size-1); /* remove trailing '\0' */ } } -static void LoadCode (lua_State* L, Proto* tf, ZIO* Z, int swap) +static void LoadCode (LoadState* S, Proto* f) { - int size=LoadInt(L,Z,swap); - tf->code=luaM_newvector(L,size,Instruction); - LoadVector(L,tf->code,size,sizeof(*tf->code),Z,swap); - if (tf->code[size-1]!=OP_END) luaO_verror(L,"bad code in `%.99s'",ZNAME(Z)); - luaF_protook(L,tf,size); + int size=LoadInt(S); + f->code=luaM_newvector(S->L,size,Instruction); + f->sizecode=size; + LoadVector(S,f->code,size,sizeof(*f->code)); } -static void LoadLocals (lua_State* L, Proto* tf, ZIO* Z, int swap) +static void LoadLocals (LoadState* S, Proto* f) { int i,n; - tf->nlocvars=n=LoadInt(L,Z,swap); - tf->locvars=luaM_newvector(L,n,LocVar); + n=LoadInt(S); + f->locvars=luaM_newvector(S->L,n,LocVar); + f->sizelocvars=n; for (i=0; i<n; i++) { - tf->locvars[i].varname=LoadString(L,Z,swap); - tf->locvars[i].startpc=LoadInt(L,Z,swap); - tf->locvars[i].endpc=LoadInt(L,Z,swap); + f->locvars[i].varname=LoadString(S); + f->locvars[i].startpc=LoadInt(S); + f->locvars[i].endpc=LoadInt(S); } } -static void LoadLines (lua_State* L, Proto* tf, ZIO* Z, int swap) +static void LoadLines (LoadState* S, Proto* f) { - int n; - tf->nlineinfo=n=LoadInt(L,Z,swap); - tf->lineinfo=luaM_newvector(L,n,int); - LoadVector(L,tf->lineinfo,n,sizeof(*tf->lineinfo),Z,swap); + int size=LoadInt(S); + f->lineinfo=luaM_newvector(S->L,size,int); + f->sizelineinfo=size; + LoadVector(S,f->lineinfo,size,sizeof(*f->lineinfo)); } -static Proto* LoadFunction (lua_State* L, ZIO* Z, int swap); +static void LoadUpvalues (LoadState* S, Proto* f) +{ + int i,n; + n=LoadInt(S); + if (n!=0 && n!=f->nups) + luaG_runerror(S->L,"bad nupvalues in %s: read %d; expected %d", + S->name,n,f->nups); + f->upvalues=luaM_newvector(S->L,n,TString*); + f->sizeupvalues=n; + for (i=0; i<n; i++) f->upvalues[i]=LoadString(S); +} -static void LoadConstants (lua_State* L, Proto* tf, ZIO* Z, int swap) +static Proto* LoadFunction (LoadState* S, TString* p); + +static void LoadConstants (LoadState* S, Proto* f) { int i,n; - tf->nkstr=n=LoadInt(L,Z,swap); - tf->kstr=luaM_newvector(L,n,TString*); - for (i=0; i<n; i++) - tf->kstr[i]=LoadString(L,Z,swap); - tf->nknum=n=LoadInt(L,Z,swap); - tf->knum=luaM_newvector(L,n,Number); - LoadVector(L,tf->knum,n,sizeof(*tf->knum),Z,swap); - tf->nkproto=n=LoadInt(L,Z,swap); - tf->kproto=luaM_newvector(L,n,Proto*); + n=LoadInt(S); + f->k=luaM_newvector(S->L,n,TObject); + f->sizek=n; for (i=0; i<n; i++) - tf->kproto[i]=LoadFunction(L,Z,swap); + { + TObject* o=&f->k[i]; + int t=LoadByte(S); + switch (t) + { + case LUA_TNUMBER: + setnvalue(o,LoadNumber(S)); + break; + case LUA_TSTRING: + setsvalue2n(o,LoadString(S)); + break; + case LUA_TNIL: + setnilvalue(o); + break; + default: + luaG_runerror(S->L,"bad constant type (%d) in %s",t,S->name); + break; + } + } + n=LoadInt(S); + f->p=luaM_newvector(S->L,n,Proto*); + f->sizep=n; + for (i=0; i<n; i++) f->p[i]=LoadFunction(S,f->source); } -static Proto* LoadFunction (lua_State* L, ZIO* Z, int swap) +static Proto* LoadFunction (LoadState* S, TString* p) { - Proto* tf=luaF_newproto(L); - tf->source=LoadString(L,Z,swap); - tf->lineDefined=LoadInt(L,Z,swap); - tf->numparams=LoadInt(L,Z,swap); - tf->is_vararg=LoadByte(L,Z); - tf->maxstacksize=LoadInt(L,Z,swap); - LoadLocals(L,tf,Z,swap); - LoadLines(L,tf,Z,swap); - LoadConstants(L,tf,Z,swap); - LoadCode(L,tf,Z,swap); - return tf; + Proto* f=luaF_newproto(S->L); + f->source=LoadString(S); if (f->source==NULL) f->source=p; + f->lineDefined=LoadInt(S); + f->nups=LoadByte(S); + f->numparams=LoadByte(S); + f->is_vararg=LoadByte(S); + f->maxstacksize=LoadByte(S); + LoadLines(S,f); + LoadLocals(S,f); + LoadUpvalues(S,f); + LoadConstants(S,f); + LoadCode(S,f); +#ifndef TRUST_BINARIES + if (!luaG_checkcode(f)) luaG_runerror(S->L,"bad code in %s",S->name); +#endif + return f; } -static void LoadSignature (lua_State* L, ZIO* Z) +static void LoadSignature (LoadState* S) { - const char* s=SIGNATURE; - while (*s!=0 && ezgetc(L,Z)==*s) + const char* s=LUA_SIGNATURE; + while (*s!=0 && ezgetc(S)==*s) ++s; - if (*s!=0) luaO_verror(L,"bad signature in `%.99s'",ZNAME(Z)); + if (*s!=0) luaG_runerror(S->L,"bad signature in %s",S->name); } -static void TestSize (lua_State* L, int s, const char* what, ZIO* Z) +static void TestSize (LoadState* S, int s, const char* what) { - int r=ezgetc(L,Z); + int r=LoadByte(S); if (r!=s) - luaO_verror(L,"virtual machine mismatch in `%.99s':\n" - " %.20s is %d but read %d",ZNAME(Z),what,s,r); + luaG_runerror(S->L,"virtual machine mismatch in %s: " + "size of %s is %d but read %d",S->name,what,s,r); } -#define TESTSIZE(s) TestSize(L,s,#s,Z) -#define V(v) v/16,v%16 +#define TESTSIZE(s,w) TestSize(S,s,w) +#define V(v) v/16,v%16 -static int LoadHeader (lua_State* L, ZIO* Z) +static void LoadHeader (LoadState* S) { - int version,swap; - Number f=0,tf=TEST_NUMBER; - LoadSignature(L,Z); - version=ezgetc(L,Z); + int version; + lua_Number x,tx=TEST_NUMBER; + LoadSignature(S); + version=LoadByte(S); if (version>VERSION) - luaO_verror(L,"`%.99s' too new:\n" - " read version %d.%d; expected at most %d.%d", - ZNAME(Z),V(version),V(VERSION)); - if (version<VERSION0) /* check last major change */ - luaO_verror(L,"`%.99s' too old:\n" - " read version %d.%d; expected at least %d.%d", - ZNAME(Z),V(version),V(VERSION)); - swap=(luaU_endianess()!=ezgetc(L,Z)); /* need to swap bytes? */ - TESTSIZE(sizeof(int)); - TESTSIZE(sizeof(size_t)); - TESTSIZE(sizeof(Instruction)); - TESTSIZE(SIZE_INSTRUCTION); - TESTSIZE(SIZE_OP); - TESTSIZE(SIZE_B); - TESTSIZE(sizeof(Number)); - f=LoadNumber(L,Z,swap); - if ((long)f!=(long)tf) /* disregard errors in last bit of fraction */ - luaO_verror(L,"unknown number format in `%.99s':\n" - " read " NUMBER_FMT "; expected " NUMBER_FMT, ZNAME(Z),f,tf); - return swap; -} - -static Proto* LoadChunk (lua_State* L, ZIO* Z) -{ - return LoadFunction(L,Z,LoadHeader(L,Z)); + luaG_runerror(S->L,"%s too new: " + "read version %d.%d; expected at most %d.%d", + S->name,V(version),V(VERSION)); + if (version<VERSION0) /* check last major change */ + luaG_runerror(S->L,"%s too old: " + "read version %d.%d; expected at least %d.%d", + S->name,V(version),V(VERSION0)); + S->swap=(luaU_endianness()!=LoadByte(S)); /* need to swap bytes? */ + TESTSIZE(sizeof(int),"int"); + TESTSIZE(sizeof(size_t), "size_t"); + TESTSIZE(sizeof(Instruction), "Instruction"); + TESTSIZE(SIZE_OP, "OP"); + TESTSIZE(SIZE_A, "A"); + TESTSIZE(SIZE_B, "B"); + TESTSIZE(SIZE_C, "C"); + TESTSIZE(sizeof(lua_Number), "number"); + x=LoadNumber(S); + if ((long)x!=(long)tx) /* disregard errors in last bits of fraction */ + luaG_runerror(S->L,"unknown number format in %s",S->name); +} + +static Proto* LoadChunk (LoadState* S) +{ + LoadHeader(S); + return LoadFunction(S,NULL); } /* -** load one chunk from a file or buffer -** return main if ok and NULL at EOF +** load precompiled chunk */ -Proto* luaU_undump (lua_State* L, ZIO* Z) +Proto* luaU_undump (lua_State* L, ZIO* Z, Mbuffer* buff) { - Proto* tf=NULL; - int c=zgetc(Z); - if (c==ID_CHUNK) - tf=LoadChunk(L,Z); - c=zgetc(Z); - if (c!=EOZ) - luaO_verror(L,"`%.99s' apparently contains more than one chunk",ZNAME(Z)); - return tf; + LoadState S; + const char* s=zname(Z); + if (*s=='@' || *s=='=') + S.name=s+1; + else if (*s==LUA_SIGNATURE[0]) + S.name="binary string"; + else + S.name=s; + S.L=L; + S.Z=Z; + S.b=buff; + return LoadChunk(&S); } /* ** find byte order */ -int luaU_endianess (void) +int luaU_endianness (void) { int x=1; return *(char*)&x; diff --git a/src/lundump.h b/src/lundump.h index 446d2de9..c7e6959b 100644 --- a/src/lundump.h +++ b/src/lundump.h @@ -1,5 +1,5 @@ /* -** $Id: lundump.h,v 1.21 2000/10/31 16:57:23 lhf Exp $ +** $Id: lundump.h,v 1.30 2003/04/07 20:34:20 lhf Exp $ ** load pre-compiled Lua chunks ** See Copyright Notice in lua.h */ @@ -10,26 +10,25 @@ #include "lobject.h" #include "lzio.h" -/* load one chunk */ -Proto* luaU_undump (lua_State* L, ZIO* Z); +/* load one chunk; from lundump.c */ +Proto* luaU_undump (lua_State* L, ZIO* Z, Mbuffer* buff); -/* find byte order */ -int luaU_endianess (void); +/* find byte order; from lundump.c */ +int luaU_endianness (void); -/* definitions for headers of binary files */ -#define VERSION 0x40 /* last format change was in 4.0 */ -#define VERSION0 0x40 /* last major change was in 4.0 */ -#define ID_CHUNK 27 /* binary files start with ESC... */ -#define SIGNATURE "Lua" /* ...followed by this signature */ +/* dump one chunk; from ldump.c */ +void luaU_dump (lua_State* L, const Proto* Main, lua_Chunkwriter w, void* data); + +/* print one chunk; from print.c */ +void luaU_print (const Proto* Main); -/* formats for error messages */ -#define SOURCE_FMT "<%d:%.99s>" -#define SOURCE tf->lineDefined,tf->source->str -#define IN_FMT " in %p " SOURCE_FMT -#define IN tf,SOURCE +/* definitions for headers of binary files */ +#define LUA_SIGNATURE "\033Lua" /* binary files start with "<esc>Lua" */ +#define VERSION 0x50 /* last format change was in 5.0 */ +#define VERSION0 0x50 /* last major change was in 5.0 */ /* a multiple of PI for testing native format */ -/* multiplying by 1E8 gives non-trivial integer values */ -#define TEST_NUMBER 3.14159265358979323846E8 +/* multiplying by 1E7 gives non-trivial integer values */ +#define TEST_NUMBER ((lua_Number)3.14159265358979323846E7) #endif @@ -1,17 +1,21 @@ /* -** $Id: lvm.c,v 1.146a 2000/10/26 12:47:05 roberto Exp $ +** $Id: lvm.c,v 1.284 2003/04/03 13:35:34 roberto Exp $ ** Lua virtual machine ** See Copyright Notice in lua.h */ -#include <stdio.h> +#include <stdarg.h> #include <stdlib.h> #include <string.h> +/* needed only when `lua_number2str' uses `sprintf' */ +#include <stdio.h> + +#define lvm_c + #include "lua.h" -#include "lapi.h" #include "ldebug.h" #include "ldo.h" #include "lfunc.h" @@ -25,243 +29,225 @@ #include "lvm.h" -#ifdef OLD_ANSI -#define strcoll(a,b) strcmp(a,b) -#endif - +/* function to convert a lua_Number to a string */ +#ifndef lua_number2str +#define lua_number2str(s,n) sprintf((s), LUA_NUMBER_FMT, (n)) +#endif -/* -** Extra stack size to run a function: -** TAG_LINE(1), NAME(1), TM calls(3) (plus some extra...) -*/ -#define EXTRA_STACK 8 +/* limit for table tag-method chains (to avoid loops) */ +#define MAXTAGLOOP 100 -int luaV_tonumber (TObject *obj) { - if (ttype(obj) != LUA_TSTRING) - return 1; - else { - if (!luaO_str2d(svalue(obj), &nvalue(obj))) - return 2; - ttype(obj) = LUA_TNUMBER; - return 0; +const TObject *luaV_tonumber (const TObject *obj, TObject *n) { + lua_Number num; + if (ttisnumber(obj)) return obj; + if (ttisstring(obj) && luaO_str2d(svalue(obj), &num)) { + setnvalue(n, num); + return n; } + else + return NULL; } -int luaV_tostring (lua_State *L, TObject *obj) { /* LUA_NUMBER */ - if (ttype(obj) != LUA_TNUMBER) - return 1; +int luaV_tostring (lua_State *L, StkId obj) { + if (!ttisnumber(obj)) + return 0; else { char s[32]; /* 16 digits, sign, point and \0 (+ some extra...) */ - lua_number2str(s, nvalue(obj)); /* convert `s' to number */ - tsvalue(obj) = luaS_new(L, s); - ttype(obj) = LUA_TSTRING; - return 0; + lua_number2str(s, nvalue(obj)); + setsvalue2s(obj, luaS_new(L, s)); + return 1; } } -static void traceexec (lua_State *L, StkId base, StkId top, lua_Hook linehook) { - CallInfo *ci = infovalue(base-1); - int *lineinfo = ci->func->f.l->lineinfo; - int pc = (*ci->pc - ci->func->f.l->code) - 1; - int newline; - if (pc == 0) { /* may be first time? */ - ci->line = 1; - ci->refi = 0; - ci->lastpc = pc+1; /* make sure it will call linehook */ +static void traceexec (lua_State *L) { + lu_byte mask = L->hookmask; + if (mask > LUA_MASKLINE) { /* instruction-hook set? */ + if (L->hookcount == 0) { + resethookcount(L); + luaD_callhook(L, LUA_HOOKCOUNT, -1); + return; + } } - newline = luaG_getline(lineinfo, pc, ci->line, &ci->refi); - /* calls linehook when enters a new line or jumps back (loop) */ - if (newline != ci->line || pc <= ci->lastpc) { - ci->line = newline; - L->top = top; - luaD_lineHook(L, base-1, newline, linehook); + if (mask & LUA_MASKLINE) { + CallInfo *ci = L->ci; + Proto *p = ci_func(ci)->l.p; + int newline = getline(p, pcRel(*ci->u.l.pc, p)); + if (!L->hookinit) { + luaG_inithooks(L); + return; + } + lua_assert(ci->state & CI_HASFRAME); + if (pcRel(*ci->u.l.pc, p) == 0) /* tracing may be starting now? */ + ci->u.l.savedpc = *ci->u.l.pc; /* initialize `savedpc' */ + /* calls linehook when enters a new line or jumps back (loop) */ + if (*ci->u.l.pc <= ci->u.l.savedpc || + newline != getline(p, pcRel(ci->u.l.savedpc, p))) { + luaD_callhook(L, LUA_HOOKLINE, newline); + ci = L->ci; /* previous call may reallocate `ci' */ + } + ci->u.l.savedpc = *ci->u.l.pc; } - ci->lastpc = pc; } -static Closure *luaV_closure (lua_State *L, int nelems) { - Closure *c = luaF_newclosure(L, nelems); - L->top -= nelems; - while (nelems--) - c->upvalue[nelems] = *(L->top+nelems); - clvalue(L->top) = c; - ttype(L->top) = LUA_TFUNCTION; - incr_top; - return c; +static void callTMres (lua_State *L, const TObject *f, + const TObject *p1, const TObject *p2) { + setobj2s(L->top, f); /* push function */ + setobj2s(L->top+1, p1); /* 1st argument */ + setobj2s(L->top+2, p2); /* 2nd argument */ + luaD_checkstack(L, 3); /* cannot check before (could invalidate p1, p2) */ + L->top += 3; + luaD_call(L, L->top - 3, 1); + L->top--; /* result will be in L->top */ } -void luaV_Cclosure (lua_State *L, lua_CFunction c, int nelems) { - Closure *cl = luaV_closure(L, nelems); - cl->f.c = c; - cl->isC = 1; + +static void callTM (lua_State *L, const TObject *f, + const TObject *p1, const TObject *p2, const TObject *p3) { + setobj2s(L->top, f); /* push function */ + setobj2s(L->top+1, p1); /* 1st argument */ + setobj2s(L->top+2, p2); /* 2nd argument */ + setobj2s(L->top+3, p3); /* 3th argument */ + luaD_checkstack(L, 4); /* cannot check before (could invalidate p1...p3) */ + L->top += 4; + luaD_call(L, L->top - 4, 0); } -void luaV_Lclosure (lua_State *L, Proto *l, int nelems) { - Closure *cl = luaV_closure(L, nelems); - cl->f.l = l; - cl->isC = 0; +static const TObject *luaV_index (lua_State *L, const TObject *t, + TObject *key, int loop) { + const TObject *tm = fasttm(L, hvalue(t)->metatable, TM_INDEX); + if (tm == NULL) return &luaO_nilobject; /* no TM */ + if (ttisfunction(tm)) { + callTMres(L, tm, t, key); + return L->top; + } + else return luaV_gettable(L, tm, key, loop); +} + +static const TObject *luaV_getnotable (lua_State *L, const TObject *t, + TObject *key, int loop) { + const TObject *tm = luaT_gettmbyobj(L, t, TM_INDEX); + if (ttisnil(tm)) + luaG_typeerror(L, t, "index"); + if (ttisfunction(tm)) { + callTMres(L, tm, t, key); + return L->top; + } + else return luaV_gettable(L, tm, key, loop); } /* ** Function to index a table. -** Receives the table at `t' and the key at top. +** Receives the table at `t' and the key at `key'. +** leaves the result at `res'. */ -const TObject *luaV_gettable (lua_State *L, StkId t) { - Closure *tm; - int tg; - if (ttype(t) == LUA_TTABLE && /* `t' is a table? */ - ((tg = hvalue(t)->htag) == LUA_TTABLE || /* with default tag? */ - luaT_gettm(L, tg, TM_GETTABLE) == NULL)) { /* or no TM? */ - /* do a primitive get */ - const TObject *h = luaH_get(L, hvalue(t), L->top-1); - /* result is no nil or there is no `index' tag method? */ - if (ttype(h) != LUA_TNIL || ((tm=luaT_gettm(L, tg, TM_INDEX)) == NULL)) - return h; /* return result */ - /* else call `index' tag method */ - } - else { /* try a `gettable' tag method */ - tm = luaT_gettmbyObj(L, t, TM_GETTABLE); - } - if (tm != NULL) { /* is there a tag method? */ - luaD_checkstack(L, 2); - *(L->top+1) = *(L->top-1); /* key */ - *L->top = *t; /* table */ - clvalue(L->top-1) = tm; /* tag method */ - ttype(L->top-1) = LUA_TFUNCTION; - L->top += 2; - luaD_call(L, L->top - 3, 1); - return L->top - 1; /* call result */ - } - else { /* no tag method */ - luaG_typeerror(L, t, "index"); - return NULL; /* to avoid warnings */ +const TObject *luaV_gettable (lua_State *L, const TObject *t, TObject *key, + int loop) { + if (loop > MAXTAGLOOP) + luaG_runerror(L, "loop in gettable"); + if (ttistable(t)) { /* `t' is a table? */ + Table *h = hvalue(t); + const TObject *v = luaH_get(h, key); /* do a primitive get */ + if (!ttisnil(v)) return v; + else return luaV_index(L, t, key, loop+1); } + else return luaV_getnotable(L, t, key, loop+1); } /* -** Receives table at `t', key at `key' and value at top. +** Receives table at `t', key at `key' and value at `val'. */ -void luaV_settable (lua_State *L, StkId t, StkId key) { - int tg; - if (ttype(t) == LUA_TTABLE && /* `t' is a table? */ - ((tg = hvalue(t)->htag) == LUA_TTABLE || /* with default tag? */ - luaT_gettm(L, tg, TM_SETTABLE) == NULL)) /* or no TM? */ - *luaH_set(L, hvalue(t), key) = *(L->top-1); /* do a primitive set */ - else { /* try a `settable' tag method */ - Closure *tm = luaT_gettmbyObj(L, t, TM_SETTABLE); - if (tm != NULL) { - luaD_checkstack(L, 3); - *(L->top+2) = *(L->top-1); - *(L->top+1) = *key; - *(L->top) = *t; - clvalue(L->top-1) = tm; - ttype(L->top-1) = LUA_TFUNCTION; - L->top += 3; - luaD_call(L, L->top - 4, 0); /* call `settable' tag method */ +void luaV_settable (lua_State *L, const TObject *t, TObject *key, StkId val) { + const TObject *tm; + int loop = 0; + do { + if (ttistable(t)) { /* `t' is a table? */ + Table *h = hvalue(t); + TObject *oldval = luaH_set(L, h, key); /* do a primitive set */ + if (!ttisnil(oldval) || /* result is no nil? */ + (tm = fasttm(L, h->metatable, TM_NEWINDEX)) == NULL) { /* or no TM? */ + setobj2t(oldval, val); /* write barrier */ + return; + } + /* else will try the tag method */ } - else /* no tag method... */ + else if (ttisnil(tm = luaT_gettmbyobj(L, t, TM_NEWINDEX))) luaG_typeerror(L, t, "index"); - } -} - - -const TObject *luaV_getglobal (lua_State *L, TString *s) { - const TObject *value = luaH_getstr(L->gt, s); - Closure *tm = luaT_gettmbyObj(L, value, TM_GETGLOBAL); - if (tm == NULL) /* is there a tag method? */ - return value; /* default behavior */ - else { /* tag method */ - luaD_checkstack(L, 3); - clvalue(L->top) = tm; - ttype(L->top) = LUA_TFUNCTION; - tsvalue(L->top+1) = s; /* global name */ - ttype(L->top+1) = LUA_TSTRING; - *(L->top+2) = *value; - L->top += 3; - luaD_call(L, L->top - 3, 1); - return L->top - 1; - } + if (ttisfunction(tm)) { + callTM(L, tm, t, key, val); + return; + } + t = tm; /* else repeat with `tm' */ + } while (++loop <= MAXTAGLOOP); + luaG_runerror(L, "loop in settable"); } -void luaV_setglobal (lua_State *L, TString *s) { - const TObject *oldvalue = luaH_getstr(L->gt, s); - Closure *tm = luaT_gettmbyObj(L, oldvalue, TM_SETGLOBAL); - if (tm == NULL) { /* is there a tag method? */ - if (oldvalue != &luaO_nilobject) { - /* cast to remove `const' is OK, because `oldvalue' != luaO_nilobject */ - *(TObject *)oldvalue = *(L->top - 1); - } - else { - TObject key; - ttype(&key) = LUA_TSTRING; - tsvalue(&key) = s; - *luaH_set(L, L->gt, &key) = *(L->top - 1); - } - } - else { - luaD_checkstack(L, 3); - *(L->top+2) = *(L->top-1); /* new value */ - *(L->top+1) = *oldvalue; - ttype(L->top) = LUA_TSTRING; - tsvalue(L->top) = s; - clvalue(L->top-1) = tm; - ttype(L->top-1) = LUA_TFUNCTION; - L->top += 3; - luaD_call(L, L->top - 4, 0); - } +static int call_binTM (lua_State *L, const TObject *p1, const TObject *p2, + StkId res, TMS event) { + ptrdiff_t result = savestack(L, res); + const TObject *tm = luaT_gettmbyobj(L, p1, event); /* try first operand */ + if (ttisnil(tm)) + tm = luaT_gettmbyobj(L, p2, event); /* try second operand */ + if (!ttisfunction(tm)) return 0; + callTMres(L, tm, p1, p2); + res = restorestack(L, result); /* previous call may change stack */ + setobjs2s(res, L->top); + return 1; } -static int call_binTM (lua_State *L, StkId top, TMS event) { - /* try first operand */ - Closure *tm = luaT_gettmbyObj(L, top-2, event); - L->top = top; - if (tm == NULL) { - tm = luaT_gettmbyObj(L, top-1, event); /* try second operand */ - if (tm == NULL) { - tm = luaT_gettm(L, 0, event); /* try a `global' method */ - if (tm == NULL) - return 0; /* error */ - } - } - lua_pushstring(L, luaT_eventname[event]); - luaD_callTM(L, tm, 3, 1); - return 1; +static const TObject *get_compTM (lua_State *L, Table *mt1, Table *mt2, + TMS event) { + const TObject *tm1 = fasttm(L, mt1, event); + const TObject *tm2; + if (tm1 == NULL) return NULL; /* no metamethod */ + if (mt1 == mt2) return tm1; /* same metatables => same metamethods */ + tm2 = fasttm(L, mt2, event); + if (tm2 == NULL) return NULL; /* no metamethod */ + if (luaO_rawequalObj(tm1, tm2)) /* same metamethods? */ + return tm1; + return NULL; } -static void call_arith (lua_State *L, StkId top, TMS event) { - if (!call_binTM(L, top, event)) - luaG_binerror(L, top-2, LUA_TNUMBER, "perform arithmetic on"); +static int call_orderTM (lua_State *L, const TObject *p1, const TObject *p2, + TMS event) { + const TObject *tm1 = luaT_gettmbyobj(L, p1, event); + const TObject *tm2; + if (ttisnil(tm1)) return -1; /* no metamethod? */ + tm2 = luaT_gettmbyobj(L, p2, event); + if (!luaO_rawequalObj(tm1, tm2)) /* different metamethods? */ + return -1; + callTMres(L, tm1, p1, p2); + return !l_isfalse(L->top); } -static int luaV_strcomp (const TString *ls, const TString *rs) { - const char *l = ls->str; - size_t ll = ls->len; - const char *r = rs->str; - size_t lr = rs->len; +static int luaV_strcmp (const TString *ls, const TString *rs) { + const char *l = getstr(ls); + size_t ll = ls->tsv.len; + const char *r = getstr(rs); + size_t lr = rs->tsv.len; for (;;) { int temp = strcoll(l, r); if (temp != 0) return temp; - else { /* strings are equal up to a '\0' */ - size_t len = strlen(l); /* index of first '\0' in both strings */ - if (len == ll) /* l is finished? */ - return (len == lr) ? 0 : -1; /* l is equal or smaller than r */ - else if (len == lr) /* r is finished? */ - return 1; /* l is greater than r (because l is not finished) */ - /* both strings longer than `len'; go on comparing (after the '\0') */ + else { /* strings are equal up to a `\0' */ + size_t len = strlen(l); /* index of first `\0' in both strings */ + if (len == lr) /* r is finished? */ + return (len == ll) ? 0 : 1; + else if (len == ll) /* l is finished? */ + return -1; /* l is smaller than r (because r is not finished) */ + /* both strings longer than `len'; go on comparing (after the `\0') */ len++; l += len; ll -= len; r += len; lr -= len; } @@ -269,442 +255,526 @@ static int luaV_strcomp (const TString *ls, const TString *rs) { } -int luaV_lessthan (lua_State *L, const TObject *l, const TObject *r, StkId top) { - if (ttype(l) == LUA_TNUMBER && ttype(r) == LUA_TNUMBER) - return (nvalue(l) < nvalue(r)); - else if (ttype(l) == LUA_TSTRING && ttype(r) == LUA_TSTRING) - return (luaV_strcomp(tsvalue(l), tsvalue(r)) < 0); - else { /* call TM */ - luaD_checkstack(L, 2); - *top++ = *l; - *top++ = *r; - if (!call_binTM(L, top, TM_LT)) - luaG_ordererror(L, top-2); - L->top--; - return (ttype(L->top) != LUA_TNIL); +int luaV_lessthan (lua_State *L, const TObject *l, const TObject *r) { + int res; + if (ttype(l) != ttype(r)) + return luaG_ordererror(L, l, r); + else if (ttisnumber(l)) + return nvalue(l) < nvalue(r); + else if (ttisstring(l)) + return luaV_strcmp(tsvalue(l), tsvalue(r)) < 0; + else if ((res = call_orderTM(L, l, r, TM_LT)) != -1) + return res; + return luaG_ordererror(L, l, r); +} + + +static int luaV_lessequal (lua_State *L, const TObject *l, const TObject *r) { + int res; + if (ttype(l) != ttype(r)) + return luaG_ordererror(L, l, r); + else if (ttisnumber(l)) + return nvalue(l) <= nvalue(r); + else if (ttisstring(l)) + return luaV_strcmp(tsvalue(l), tsvalue(r)) <= 0; + else if ((res = call_orderTM(L, l, r, TM_LE)) != -1) /* first try `le' */ + return res; + else if ((res = call_orderTM(L, r, l, TM_LT)) != -1) /* else try `lt' */ + return !res; + return luaG_ordererror(L, l, r); +} + + +int luaV_equalval (lua_State *L, const TObject *t1, const TObject *t2) { + const TObject *tm; + lua_assert(ttype(t1) == ttype(t2)); + switch (ttype(t1)) { + case LUA_TNIL: return 1; + case LUA_TNUMBER: return nvalue(t1) == nvalue(t2); + case LUA_TBOOLEAN: return bvalue(t1) == bvalue(t2); /* true must be 1 !! */ + case LUA_TLIGHTUSERDATA: return pvalue(t1) == pvalue(t2); + case LUA_TUSERDATA: { + if (uvalue(t1) == uvalue(t2)) return 1; + tm = get_compTM(L, uvalue(t1)->uv.metatable, uvalue(t2)->uv.metatable, + TM_EQ); + break; /* will try TM */ + } + case LUA_TTABLE: { + if (hvalue(t1) == hvalue(t2)) return 1; + tm = get_compTM(L, hvalue(t1)->metatable, hvalue(t2)->metatable, TM_EQ); + break; /* will try TM */ + } + default: return gcvalue(t1) == gcvalue(t2); } + if (tm == NULL) return 0; /* no TM? */ + callTMres(L, tm, t1, t2); /* call TM */ + return !l_isfalse(L->top); } -void luaV_strconc (lua_State *L, int total, StkId top) { +void luaV_concat (lua_State *L, int total, int last) { do { + StkId top = L->base + last + 1; int n = 2; /* number of elements handled in this pass (at least 2) */ - if (tostring(L, top-2) || tostring(L, top-1)) { - if (!call_binTM(L, top, TM_CONCAT)) - luaG_binerror(L, top-2, LUA_TSTRING, "concat"); - } - else if (tsvalue(top-1)->len > 0) { /* if len=0, do nothing */ + if (!tostring(L, top-2) || !tostring(L, top-1)) { + if (!call_binTM(L, top-2, top-1, top-2, TM_CONCAT)) + luaG_concaterror(L, top-2, top-1); + } else if (tsvalue(top-1)->tsv.len > 0) { /* if len=0, do nothing */ /* at least two string values; get as many as possible */ - lint32 tl = (lint32)tsvalue(top-1)->len + - (lint32)tsvalue(top-2)->len; + lu_mem tl = cast(lu_mem, tsvalue(top-1)->tsv.len) + + cast(lu_mem, tsvalue(top-2)->tsv.len); char *buffer; int i; - while (n < total && !tostring(L, top-n-1)) { /* collect total length */ - tl += tsvalue(top-n-1)->len; + while (n < total && tostring(L, top-n-1)) { /* collect total length */ + tl += tsvalue(top-n-1)->tsv.len; n++; } - if (tl > MAX_SIZET) lua_error(L, "string size overflow"); - buffer = luaO_openspace(L, tl); + if (tl > MAX_SIZET) luaG_runerror(L, "string size overflow"); + buffer = luaZ_openspace(L, &G(L)->buff, tl); tl = 0; for (i=n; i>0; i--) { /* concat all strings */ - size_t l = tsvalue(top-i)->len; - memcpy(buffer+tl, tsvalue(top-i)->str, l); + size_t l = tsvalue(top-i)->tsv.len; + memcpy(buffer+tl, svalue(top-i), l); tl += l; } - tsvalue(top-n) = luaS_newlstr(L, buffer, tl); + setsvalue2s(top-n, luaS_newlstr(L, buffer, tl)); } total -= n-1; /* got `n' strings to create 1 new */ - top -= n-1; + last -= n-1; } while (total > 1); /* repeat until only 1 result left */ } -static void luaV_pack (lua_State *L, StkId firstelem) { - int i; - Hash *htab = luaH_new(L, 0); - for (i=0; firstelem+i<L->top; i++) - *luaH_setint(L, htab, i+1) = *(firstelem+i); - /* store counter in field `n' */ - luaH_setstrnum(L, htab, luaS_new(L, "n"), i); - L->top = firstelem; /* remove elements from the stack */ - ttype(L->top) = LUA_TTABLE; - hvalue(L->top) = htab; - incr_top; -} - - -static void adjust_varargs (lua_State *L, StkId base, int nfixargs) { - int nvararg = (L->top-base) - nfixargs; - if (nvararg < 0) - luaD_adjusttop(L, base, nfixargs); - luaV_pack(L, base+nfixargs); +static void Arith (lua_State *L, StkId ra, + const TObject *rb, const TObject *rc, TMS op) { + TObject tempb, tempc; + const TObject *b, *c; + if ((b = luaV_tonumber(rb, &tempb)) != NULL && + (c = luaV_tonumber(rc, &tempc)) != NULL) { + switch (op) { + case TM_ADD: setnvalue(ra, nvalue(b) + nvalue(c)); break; + case TM_SUB: setnvalue(ra, nvalue(b) - nvalue(c)); break; + case TM_MUL: setnvalue(ra, nvalue(b) * nvalue(c)); break; + case TM_DIV: setnvalue(ra, nvalue(b) / nvalue(c)); break; + case TM_POW: { + const TObject *f = luaH_getstr(hvalue(gt(L)), G(L)->tmname[TM_POW]); + ptrdiff_t res = savestack(L, ra); + if (!ttisfunction(f)) + luaG_runerror(L, "`__pow' (`^' operator) is not a function"); + callTMres(L, f, b, c); + ra = restorestack(L, res); /* previous call may change stack */ + setobjs2s(ra, L->top); + break; + } + default: lua_assert(0); break; + } + } + else if (!call_binTM(L, rb, rc, ra, op)) + luaG_aritherror(L, rb, rc); } -#define dojump(pc, i) { int d = GETARG_S(i); pc += d; } - /* -** Executes the given Lua function. Parameters are between [base,top). -** Returns n such that the the results are between [n,top). +** some macros for common tasks in `luaV_execute' */ -StkId luaV_execute (lua_State *L, const Closure *cl, StkId base) { - const Proto *const tf = cl->f.l; - StkId top; /* keep top local, for performance */ - const Instruction *pc = tf->code; - TString **const kstr = tf->kstr; - const lua_Hook linehook = L->linehook; - infovalue(base-1)->pc = &pc; - luaD_checkstack(L, tf->maxstacksize+EXTRA_STACK); - if (tf->is_vararg) /* varargs? */ - adjust_varargs(L, base, tf->numparams); - else - luaD_adjusttop(L, base, tf->numparams); - top = L->top; + +#define runtime_check(L, c) { if (!(c)) return 0; } + +#define RA(i) (base+GETARG_A(i)) +/* to be used after possible stack reallocation */ +#define XRA(i) (L->base+GETARG_A(i)) +#define RB(i) (base+GETARG_B(i)) +#define RKB(i) ((GETARG_B(i) < MAXSTACK) ? RB(i) : k+GETARG_B(i)-MAXSTACK) +#define RC(i) (base+GETARG_C(i)) +#define RKC(i) ((GETARG_C(i) < MAXSTACK) ? RC(i) : k+GETARG_C(i)-MAXSTACK) +#define KBx(i) (k+GETARG_Bx(i)) + + +#define dojump(pc, i) ((pc) += (i)) + + +StkId luaV_execute (lua_State *L) { + LClosure *cl; + TObject *k; + const Instruction *pc; + callentry: /* entry point when calling new functions */ + L->ci->u.l.pc = &pc; + if (L->hookmask & LUA_MASKCALL) + luaD_callhook(L, LUA_HOOKCALL, -1); + retentry: /* entry point when returning to old functions */ + lua_assert(L->ci->state == CI_SAVEDPC || + L->ci->state == (CI_SAVEDPC | CI_CALLING)); + L->ci->state = CI_HASFRAME; /* activate frame */ + pc = L->ci->u.l.savedpc; + cl = &clvalue(L->base - 1)->l; + k = cl->p->k; /* main loop of interpreter */ for (;;) { const Instruction i = *pc++; - if (linehook) - traceexec(L, base, top, linehook); - switch (GET_OPCODE(i)) { - case OP_END: { - L->top = top; - return top; + StkId base, ra; + if ((L->hookmask & (LUA_MASKLINE | LUA_MASKCOUNT)) && + (--L->hookcount == 0 || L->hookmask & LUA_MASKLINE)) { + traceexec(L); + if (L->ci->state & CI_YIELD) { /* did hook yield? */ + L->ci->u.l.savedpc = pc - 1; + L->ci->state = CI_YIELD | CI_SAVEDPC; + return NULL; } - case OP_RETURN: { - L->top = top; - return base+GETARG_U(i); - } - case OP_CALL: { - int nres = GETARG_B(i); - if (nres == MULT_RET) nres = LUA_MULTRET; - L->top = top; - luaD_call(L, base+GETARG_A(i), nres); - top = L->top; - break; - } - case OP_TAILCALL: { - L->top = top; - luaD_call(L, base+GETARG_A(i), LUA_MULTRET); - return base+GETARG_B(i); - } - case OP_PUSHNIL: { - int n = GETARG_U(i); - LUA_ASSERT(n>0, "invalid argument"); - do { - ttype(top++) = LUA_TNIL; - } while (--n > 0); - break; - } - case OP_POP: { - top -= GETARG_U(i); - break; - } - case OP_PUSHINT: { - ttype(top) = LUA_TNUMBER; - nvalue(top) = (Number)GETARG_S(i); - top++; - break; - } - case OP_PUSHSTRING: { - ttype(top) = LUA_TSTRING; - tsvalue(top) = kstr[GETARG_U(i)]; - top++; + } + /* warning!! several calls may realloc the stack and invalidate `ra' */ + base = L->base; + ra = RA(i); + lua_assert(L->ci->state & CI_HASFRAME); + lua_assert(base == L->ci->base); + lua_assert(L->top <= L->stack + L->stacksize && L->top >= base); + lua_assert(L->top == L->ci->top || + GET_OPCODE(i) == OP_CALL || GET_OPCODE(i) == OP_TAILCALL || + GET_OPCODE(i) == OP_RETURN || GET_OPCODE(i) == OP_SETLISTO); + switch (GET_OPCODE(i)) { + case OP_MOVE: { + setobjs2s(ra, RB(i)); break; } - case OP_PUSHNUM: { - ttype(top) = LUA_TNUMBER; - nvalue(top) = tf->knum[GETARG_U(i)]; - top++; + case OP_LOADK: { + setobj2s(ra, KBx(i)); break; } - case OP_PUSHNEGNUM: { - ttype(top) = LUA_TNUMBER; - nvalue(top) = -tf->knum[GETARG_U(i)]; - top++; + case OP_LOADBOOL: { + setbvalue(ra, GETARG_B(i)); + if (GETARG_C(i)) pc++; /* skip next instruction (if C) */ break; } - case OP_PUSHUPVALUE: { - *top++ = cl->upvalue[GETARG_U(i)]; + case OP_LOADNIL: { + TObject *rb = RB(i); + do { + setnilvalue(rb--); + } while (rb >= ra); break; } - case OP_GETLOCAL: { - *top++ = *(base+GETARG_U(i)); + case OP_GETUPVAL: { + int b = GETARG_B(i); + setobj2s(ra, cl->upvals[b]->v); break; } case OP_GETGLOBAL: { - L->top = top; - *top = *luaV_getglobal(L, kstr[GETARG_U(i)]); - top++; + TObject *rb = KBx(i); + const TObject *v; + lua_assert(ttisstring(rb) && ttistable(&cl->g)); + v = luaH_getstr(hvalue(&cl->g), tsvalue(rb)); + if (!ttisnil(v)) { setobj2s(ra, v); } + else + setobj2s(XRA(i), luaV_index(L, &cl->g, rb, 0)); break; } case OP_GETTABLE: { - L->top = top; - top--; - *(top-1) = *luaV_gettable(L, top-1); + StkId rb = RB(i); + TObject *rc = RKC(i); + if (ttistable(rb)) { + const TObject *v = luaH_get(hvalue(rb), rc); + if (!ttisnil(v)) { setobj2s(ra, v); } + else + setobj2s(XRA(i), luaV_index(L, rb, rc, 0)); + } + else + setobj2s(XRA(i), luaV_getnotable(L, rb, rc, 0)); break; } - case OP_GETDOTTED: { - ttype(top) = LUA_TSTRING; - tsvalue(top) = kstr[GETARG_U(i)]; - L->top = top+1; - *(top-1) = *luaV_gettable(L, top-1); + case OP_SETGLOBAL: { + lua_assert(ttisstring(KBx(i)) && ttistable(&cl->g)); + luaV_settable(L, &cl->g, KBx(i), ra); break; } - case OP_GETINDEXED: { - *top = *(base+GETARG_U(i)); - L->top = top+1; - *(top-1) = *luaV_gettable(L, top-1); + case OP_SETUPVAL: { + int b = GETARG_B(i); + setobj(cl->upvals[b]->v, ra); /* write barrier */ break; } - case OP_PUSHSELF: { - TObject receiver; - receiver = *(top-1); - ttype(top) = LUA_TSTRING; - tsvalue(top++) = kstr[GETARG_U(i)]; - L->top = top; - *(top-2) = *luaV_gettable(L, top-2); - *(top-1) = receiver; + case OP_SETTABLE: { + luaV_settable(L, ra, RKB(i), RKC(i)); break; } - case OP_CREATETABLE: { - L->top = top; + case OP_NEWTABLE: { + int b = GETARG_B(i); + b = fb2int(b); + sethvalue(ra, luaH_new(L, b, GETARG_C(i))); luaC_checkGC(L); - hvalue(top) = luaH_new(L, GETARG_U(i)); - ttype(top) = LUA_TTABLE; - top++; - break; - } - case OP_SETLOCAL: { - *(base+GETARG_U(i)) = *(--top); - break; - } - case OP_SETGLOBAL: { - L->top = top; - luaV_setglobal(L, kstr[GETARG_U(i)]); - top--; break; } - case OP_SETTABLE: { - StkId t = top-GETARG_A(i); - L->top = top; - luaV_settable(L, t, t+1); - top -= GETARG_B(i); /* pop values */ - break; - } - case OP_SETLIST: { - int aux = GETARG_A(i) * LFIELDS_PER_FLUSH; - int n = GETARG_B(i); - Hash *arr = hvalue(top-n-1); - L->top = top-n; /* final value of `top' (in case of errors) */ - for (; n; n--) - *luaH_setint(L, arr, n+aux) = *(--top); - break; - } - case OP_SETMAP: { - int n = GETARG_U(i); - StkId finaltop = top-2*n; - Hash *arr = hvalue(finaltop-1); - L->top = finaltop; /* final value of `top' (in case of errors) */ - for (; n; n--) { - top-=2; - *luaH_set(L, arr, top) = *(top+1); + case OP_SELF: { + StkId rb = RB(i); + TObject *rc = RKC(i); + runtime_check(L, ttisstring(rc)); + setobjs2s(ra+1, rb); + if (ttistable(rb)) { + const TObject *v = luaH_getstr(hvalue(rb), tsvalue(rc)); + if (!ttisnil(v)) { setobj2s(ra, v); } + else + setobj2s(XRA(i), luaV_index(L, rb, rc, 0)); } - break; - } - case OP_ADD: { - if (tonumber(top-2) || tonumber(top-1)) - call_arith(L, top, TM_ADD); else - nvalue(top-2) += nvalue(top-1); - top--; + setobj2s(XRA(i), luaV_getnotable(L, rb, rc, 0)); break; } - case OP_ADDI: { - if (tonumber(top-1)) { - ttype(top) = LUA_TNUMBER; - nvalue(top) = (Number)GETARG_S(i); - call_arith(L, top+1, TM_ADD); + case OP_ADD: { + TObject *rb = RKB(i); + TObject *rc = RKC(i); + if (ttisnumber(rb) && ttisnumber(rc)) { + setnvalue(ra, nvalue(rb) + nvalue(rc)); } else - nvalue(top-1) += (Number)GETARG_S(i); + Arith(L, ra, rb, rc, TM_ADD); break; } case OP_SUB: { - if (tonumber(top-2) || tonumber(top-1)) - call_arith(L, top, TM_SUB); + TObject *rb = RKB(i); + TObject *rc = RKC(i); + if (ttisnumber(rb) && ttisnumber(rc)) { + setnvalue(ra, nvalue(rb) - nvalue(rc)); + } else - nvalue(top-2) -= nvalue(top-1); - top--; + Arith(L, ra, rb, rc, TM_SUB); break; } - case OP_MULT: { - if (tonumber(top-2) || tonumber(top-1)) - call_arith(L, top, TM_MUL); + case OP_MUL: { + TObject *rb = RKB(i); + TObject *rc = RKC(i); + if (ttisnumber(rb) && ttisnumber(rc)) { + setnvalue(ra, nvalue(rb) * nvalue(rc)); + } else - nvalue(top-2) *= nvalue(top-1); - top--; + Arith(L, ra, rb, rc, TM_MUL); break; } case OP_DIV: { - if (tonumber(top-2) || tonumber(top-1)) - call_arith(L, top, TM_DIV); + TObject *rb = RKB(i); + TObject *rc = RKC(i); + if (ttisnumber(rb) && ttisnumber(rc)) { + setnvalue(ra, nvalue(rb) / nvalue(rc)); + } else - nvalue(top-2) /= nvalue(top-1); - top--; + Arith(L, ra, rb, rc, TM_DIV); break; } case OP_POW: { - if (!call_binTM(L, top, TM_POW)) - lua_error(L, "undefined operation"); - top--; - break; - } - case OP_CONCAT: { - int n = GETARG_U(i); - luaV_strconc(L, n, top); - top -= n-1; - L->top = top; - luaC_checkGC(L); + Arith(L, ra, RKB(i), RKC(i), TM_POW); break; } - case OP_MINUS: { - if (tonumber(top-1)) { - ttype(top) = LUA_TNIL; - call_arith(L, top+1, TM_UNM); + case OP_UNM: { + const TObject *rb = RB(i); + TObject temp; + if (tonumber(rb, &temp)) { + setnvalue(ra, -nvalue(rb)); + } + else { + setnilvalue(&temp); + if (!call_binTM(L, RB(i), &temp, ra, TM_UNM)) + luaG_aritherror(L, RB(i), &temp); } - else - nvalue(top-1) = -nvalue(top-1); break; } case OP_NOT: { - ttype(top-1) = - (ttype(top-1) == LUA_TNIL) ? LUA_TNUMBER : LUA_TNIL; - nvalue(top-1) = 1; - break; - } - case OP_JMPNE: { - top -= 2; - if (!luaO_equalObj(top, top+1)) dojump(pc, i); - break; - } - case OP_JMPEQ: { - top -= 2; - if (luaO_equalObj(top, top+1)) dojump(pc, i); + int res = l_isfalse(RB(i)); /* next assignment may change this value */ + setbvalue(ra, res); break; } - case OP_JMPLT: { - top -= 2; - if (luaV_lessthan(L, top, top+1, top+2)) dojump(pc, i); + case OP_CONCAT: { + int b = GETARG_B(i); + int c = GETARG_C(i); + luaV_concat(L, c-b+1, c); /* may change `base' (and `ra') */ + base = L->base; + setobjs2s(RA(i), base+b); + luaC_checkGC(L); break; } - case OP_JMPLE: { /* a <= b === !(b<a) */ - top -= 2; - if (!luaV_lessthan(L, top+1, top, top+2)) dojump(pc, i); + case OP_JMP: { + dojump(pc, GETARG_sBx(i)); break; } - case OP_JMPGT: { /* a > b === (b<a) */ - top -= 2; - if (luaV_lessthan(L, top+1, top, top+2)) dojump(pc, i); + case OP_EQ: { + if (equalobj(L, RKB(i), RKC(i)) != GETARG_A(i)) pc++; + else dojump(pc, GETARG_sBx(*pc) + 1); break; } - case OP_JMPGE: { /* a >= b === !(a<b) */ - top -= 2; - if (!luaV_lessthan(L, top, top+1, top+2)) dojump(pc, i); + case OP_LT: { + if (luaV_lessthan(L, RKB(i), RKC(i)) != GETARG_A(i)) pc++; + else dojump(pc, GETARG_sBx(*pc) + 1); break; } - case OP_JMPT: { - if (ttype(--top) != LUA_TNIL) dojump(pc, i); + case OP_LE: { + if (luaV_lessequal(L, RKB(i), RKC(i)) != GETARG_A(i)) pc++; + else dojump(pc, GETARG_sBx(*pc) + 1); break; } - case OP_JMPF: { - if (ttype(--top) == LUA_TNIL) dojump(pc, i); + case OP_TEST: { + TObject *rb = RB(i); + if (l_isfalse(rb) == GETARG_C(i)) pc++; + else { + setobjs2s(ra, rb); + dojump(pc, GETARG_sBx(*pc) + 1); + } break; } - case OP_JMPONT: { - if (ttype(top-1) == LUA_TNIL) top--; - else dojump(pc, i); + case OP_CALL: + case OP_TAILCALL: { + StkId firstResult; + int b = GETARG_B(i); + int nresults; + if (b != 0) L->top = ra+b; /* else previous instruction set top */ + nresults = GETARG_C(i) - 1; + firstResult = luaD_precall(L, ra); + if (firstResult) { + if (firstResult > L->top) { /* yield? */ + lua_assert(L->ci->state == (CI_C | CI_YIELD)); + (L->ci - 1)->u.l.savedpc = pc; + (L->ci - 1)->state = CI_SAVEDPC; + return NULL; + } + /* it was a C function (`precall' called it); adjust results */ + luaD_poscall(L, nresults, firstResult); + if (nresults >= 0) L->top = L->ci->top; + } + else { /* it is a Lua function */ + if (GET_OPCODE(i) == OP_CALL) { /* regular call? */ + (L->ci-1)->u.l.savedpc = pc; /* save `pc' to return later */ + (L->ci-1)->state = (CI_SAVEDPC | CI_CALLING); + } + else { /* tail call: put new frame in place of previous one */ + int aux; + base = (L->ci - 1)->base; /* `luaD_precall' may change the stack */ + ra = RA(i); + if (L->openupval) luaF_close(L, base); + for (aux = 0; ra+aux < L->top; aux++) /* move frame down */ + setobjs2s(base+aux-1, ra+aux); + (L->ci - 1)->top = L->top = base+aux; /* correct top */ + lua_assert(L->ci->state & CI_SAVEDPC); + (L->ci - 1)->u.l.savedpc = L->ci->u.l.savedpc; + (L->ci - 1)->u.l.tailcalls++; /* one more call lost */ + (L->ci - 1)->state = CI_SAVEDPC; + L->ci--; /* remove new frame */ + L->base = L->ci->base; + } + goto callentry; + } break; } - case OP_JMPONF: { - if (ttype(top-1) != LUA_TNIL) top--; - else dojump(pc, i); - break; + case OP_RETURN: { + CallInfo *ci = L->ci - 1; /* previous function frame */ + int b = GETARG_B(i); + if (b != 0) L->top = ra+b-1; + lua_assert(L->ci->state & CI_HASFRAME); + if (L->openupval) luaF_close(L, base); + L->ci->state = CI_SAVEDPC; /* deactivate current function */ + L->ci->u.l.savedpc = pc; + /* previous function was running `here'? */ + if (!(ci->state & CI_CALLING)) { + lua_assert((ci->state & CI_C) || ci->u.l.pc != &pc); + return ra; /* no: return */ + } + else { /* yes: continue its execution */ + int nresults; + lua_assert(ci->u.l.pc == &pc && + ttisfunction(ci->base - 1) && + (ci->state & CI_SAVEDPC)); + lua_assert(GET_OPCODE(*(ci->u.l.savedpc - 1)) == OP_CALL); + nresults = GETARG_C(*(ci->u.l.savedpc - 1)) - 1; + luaD_poscall(L, nresults, ra); + if (nresults >= 0) L->top = L->ci->top; + goto retentry; + } } - case OP_JMP: { - dojump(pc, i); - break; - } - case OP_PUSHNILJMP: { - ttype(top++) = LUA_TNIL; - pc++; - break; - } - case OP_FORPREP: { - if (tonumber(top-1)) - lua_error(L, "`for' step must be a number"); - if (tonumber(top-2)) - lua_error(L, "`for' limit must be a number"); - if (tonumber(top-3)) - lua_error(L, "`for' initial value must be a number"); - if (nvalue(top-1) > 0 ? - nvalue(top-3) > nvalue(top-2) : - nvalue(top-3) < nvalue(top-2)) { /* `empty' loop? */ - top -= 3; /* remove control variables */ - dojump(pc, i); /* jump to loop end */ + case OP_FORLOOP: { + lua_Number step, idx, limit; + const TObject *plimit = ra+1; + const TObject *pstep = ra+2; + if (!ttisnumber(ra)) + luaG_runerror(L, "`for' initial value must be a number"); + if (!tonumber(plimit, ra+1)) + luaG_runerror(L, "`for' limit must be a number"); + if (!tonumber(pstep, ra+2)) + luaG_runerror(L, "`for' step must be a number"); + step = nvalue(pstep); + idx = nvalue(ra) + step; /* increment index */ + limit = nvalue(plimit); + if (step > 0 ? idx <= limit : idx >= limit) { + dojump(pc, GETARG_sBx(i)); /* jump back */ + chgnvalue(ra, idx); /* update index */ } break; } - case OP_FORLOOP: { - LUA_ASSERT(ttype(top-1) == LUA_TNUMBER, "invalid step"); - LUA_ASSERT(ttype(top-2) == LUA_TNUMBER, "invalid limit"); - if (ttype(top-3) != LUA_TNUMBER) - lua_error(L, "`for' index must be a number"); - nvalue(top-3) += nvalue(top-1); /* increment index */ - if (nvalue(top-1) > 0 ? - nvalue(top-3) > nvalue(top-2) : - nvalue(top-3) < nvalue(top-2)) - top -= 3; /* end loop: remove control variables */ + case OP_TFORLOOP: { + int nvar = GETARG_C(i) + 1; + StkId cb = ra + nvar + 2; /* call base */ + setobjs2s(cb, ra); + setobjs2s(cb+1, ra+1); + setobjs2s(cb+2, ra+2); + L->top = cb+3; /* func. + 2 args (state and index) */ + luaD_call(L, cb, nvar); + L->top = L->ci->top; + ra = XRA(i) + 2; /* final position of first result */ + cb = ra + nvar; + do { /* move results to proper positions */ + nvar--; + setobjs2s(ra+nvar, cb+nvar); + } while (nvar > 0); + if (ttisnil(ra)) /* break loop? */ + pc++; /* skip jump (break loop) */ else - dojump(pc, i); /* repeat loop */ + dojump(pc, GETARG_sBx(*pc) + 1); /* jump back */ break; } - case OP_LFORPREP: { - Node *node; - if (ttype(top-1) != LUA_TTABLE) - lua_error(L, "`for' table must be a table"); - node = luaH_next(L, hvalue(top-1), &luaO_nilobject); - if (node == NULL) { /* `empty' loop? */ - top--; /* remove table */ - dojump(pc, i); /* jump to loop end */ + case OP_TFORPREP: { /* for compatibility only */ + if (ttistable(ra)) { + setobjs2s(ra+1, ra); + setobj2s(ra, luaH_getstr(hvalue(gt(L)), luaS_new(L, "next"))); } + dojump(pc, GETARG_sBx(i)); + break; + } + case OP_SETLIST: + case OP_SETLISTO: { + int bc; + int n; + Table *h; + runtime_check(L, ttistable(ra)); + h = hvalue(ra); + bc = GETARG_Bx(i); + if (GET_OPCODE(i) == OP_SETLIST) + n = (bc&(LFIELDS_PER_FLUSH-1)) + 1; else { - top += 2; /* index,value */ - *(top-2) = *key(node); - *(top-1) = *val(node); + n = L->top - ra - 1; + L->top = L->ci->top; } + bc &= ~(LFIELDS_PER_FLUSH-1); /* bc = bc - bc%FPF */ + for (; n > 0; n--) + setobj2t(luaH_setnum(L, h, bc+n), ra+n); /* write barrier */ break; } - case OP_LFORLOOP: { - Node *node; - LUA_ASSERT(ttype(top-3) == LUA_TTABLE, "invalid table"); - node = luaH_next(L, hvalue(top-3), top-2); - if (node == NULL) /* end loop? */ - top -= 3; /* remove table, key, and value */ - else { - *(top-2) = *key(node); - *(top-1) = *val(node); - dojump(pc, i); /* repeat loop */ - } + case OP_CLOSE: { + luaF_close(L, ra); break; } case OP_CLOSURE: { - L->top = top; - luaV_Lclosure(L, tf->kproto[GETARG_A(i)], GETARG_B(i)); - top = L->top; + Proto *p; + Closure *ncl; + int nup, j; + p = cl->p->p[GETARG_Bx(i)]; + nup = p->nups; + ncl = luaF_newLclosure(L, nup, &cl->g); + ncl->l.p = p; + for (j=0; j<nup; j++, pc++) { + if (GET_OPCODE(*pc) == OP_GETUPVAL) + ncl->l.upvals[j] = cl->upvals[GETARG_B(*pc)]; + else { + lua_assert(GET_OPCODE(*pc) == OP_MOVE); + ncl->l.upvals[j] = luaF_findupval(L, base + GETARG_B(*pc)); + } + } + setclvalue(ra, ncl); luaC_checkGC(L); break; } } } } + @@ -1,5 +1,5 @@ /* -** $Id: lvm.h,v 1.27 2000/10/05 12:14:08 roberto Exp $ +** $Id: lvm.h,v 1.47 2002/11/14 16:16:21 roberto Exp $ ** Lua virtual machine ** See Copyright Notice in lua.h */ @@ -13,20 +13,23 @@ #include "ltm.h" -#define tonumber(o) ((ttype(o) != LUA_TNUMBER) && (luaV_tonumber(o) != 0)) -#define tostring(L,o) ((ttype(o) != LUA_TSTRING) && (luaV_tostring(L, o) != 0)) +#define tostring(L,o) ((ttype(o) == LUA_TSTRING) || (luaV_tostring(L, o))) +#define tonumber(o,n) (ttype(o) == LUA_TNUMBER || \ + (((o) = luaV_tonumber(o,n)) != NULL)) -int luaV_tonumber (TObject *obj); -int luaV_tostring (lua_State *L, TObject *obj); -const TObject *luaV_gettable (lua_State *L, StkId t); -void luaV_settable (lua_State *L, StkId t, StkId key); -const TObject *luaV_getglobal (lua_State *L, TString *s); -void luaV_setglobal (lua_State *L, TString *s); -StkId luaV_execute (lua_State *L, const Closure *cl, StkId base); -void luaV_Cclosure (lua_State *L, lua_CFunction c, int nelems); -void luaV_Lclosure (lua_State *L, Proto *l, int nelems); -int luaV_lessthan (lua_State *L, const TObject *l, const TObject *r, StkId top); -void luaV_strconc (lua_State *L, int total, StkId top); +#define equalobj(L,o1,o2) \ + (ttype(o1) == ttype(o2) && luaV_equalval(L, o1, o2)) + + +int luaV_lessthan (lua_State *L, const TObject *l, const TObject *r); +int luaV_equalval (lua_State *L, const TObject *t1, const TObject *t2); +const TObject *luaV_tonumber (const TObject *obj, TObject *n); +int luaV_tostring (lua_State *L, StkId obj); +const TObject *luaV_gettable (lua_State *L, const TObject *t, TObject *key, + int loop); +void luaV_settable (lua_State *L, const TObject *t, TObject *key, StkId val); +StkId luaV_execute (lua_State *L); +void luaV_concat (lua_State *L, int total, int last); #endif @@ -1,77 +1,62 @@ /* -** $Id: lzio.c,v 1.13 2000/06/12 13:52:05 roberto Exp $ +** $Id: lzio.c,v 1.24 2003/03/20 16:00:56 roberto Exp $ ** a generic input stream interface ** See Copyright Notice in lua.h */ - -#include <stdio.h> #include <string.h> +#define lzio_c + #include "lua.h" +#include "llimits.h" +#include "lmem.h" #include "lzio.h" - -/* ----------------------------------------------------- memory buffers --- */ - -static int zmfilbuf (ZIO* z) { - (void)z; /* to avoid warnings */ - return EOZ; -} - - -ZIO* zmopen (ZIO* z, const char* b, size_t size, const char *name) { - if (b==NULL) return NULL; - z->n = size; - z->p = (const unsigned char *)b; - z->filbuf = zmfilbuf; - z->u = NULL; - z->name = name; - return z; +int luaZ_fill (ZIO *z) { + size_t size; + const char *buff = z->reader(NULL, z->data, &size); + if (buff == NULL || size == 0) return EOZ; + z->n = size - 1; + z->p = buff; + return char2int(*(z->p++)); } -/* ------------------------------------------------------------ strings --- */ - -ZIO* zsopen (ZIO* z, const char* s, const char *name) { - if (s==NULL) return NULL; - return zmopen(z, s, strlen(s), name); -} -/* -------------------------------------------------------------- FILEs --- */ - -static int zffilbuf (ZIO* z) { - size_t n; - if (feof((FILE *)z->u)) return EOZ; - n = fread(z->buffer, 1, ZBSIZE, (FILE *)z->u); - if (n==0) return EOZ; - z->n = n-1; - z->p = z->buffer; - return *(z->p++); +int luaZ_lookahead (ZIO *z) { + if (z->n == 0) { + int c = luaZ_fill(z); + if (c == EOZ) return c; + z->n++; + z->p--; + } + return char2int(*z->p); } -ZIO* zFopen (ZIO* z, FILE* f, const char *name) { - if (f==NULL) return NULL; - z->n = 0; - z->p = z->buffer; - z->filbuf = zffilbuf; - z->u = f; +void luaZ_init (ZIO *z, lua_Chunkreader reader, void *data, const char *name) { + z->reader = reader; + z->data = data; z->name = name; - return z; + z->n = 0; + z->p = NULL; } /* --------------------------------------------------------------- read --- */ -size_t zread (ZIO *z, void *b, size_t n) { +size_t luaZ_read (ZIO *z, void *b, size_t n) { while (n) { size_t m; if (z->n == 0) { - if (z->filbuf(z) == EOZ) + if (luaZ_fill(z) == EOZ) return n; /* return number of missing bytes */ - zungetc(z); /* put result from `filbuf' in the buffer */ + else { + ++z->n; /* filbuf removed first byte; put back it */ + --z->p; + } } m = (n <= z->n) ? n : z->n; /* min. between n and z->n */ memcpy(b, z->p, m); @@ -82,3 +67,15 @@ size_t zread (ZIO *z, void *b, size_t n) { } return 0; } + +/* ------------------------------------------------------------------------ */ +char *luaZ_openspace (lua_State *L, Mbuffer *buff, size_t n) { + if (n > buff->buffsize) { + if (n < LUA_MINBUFFER) n = LUA_MINBUFFER; + luaM_reallocvector(L, buff->buffer, buff->buffsize, n, char); + buff->buffsize = n; + } + return buff->buffer; +} + + @@ -1,5 +1,5 @@ /* -** $Id: lzio.h,v 1.7 2000/10/20 16:36:32 roberto Exp $ +** $Id: lzio.h,v 1.15 2003/03/20 16:00:56 roberto Exp $ ** Buffered streams ** See Copyright Notice in lua.h */ @@ -8,46 +8,57 @@ #ifndef lzio_h #define lzio_h -#include <stdio.h> +#include "lua.h" - -/* For Lua only */ -#define zFopen luaZ_Fopen -#define zsopen luaZ_sopen -#define zmopen luaZ_mopen -#define zread luaZ_read - #define EOZ (-1) /* end of stream */ -typedef struct zio ZIO; +typedef struct Zio ZIO; -ZIO* zFopen (ZIO* z, FILE* f, const char *name); /* open FILEs */ -ZIO* zsopen (ZIO* z, const char* s, const char *name); /* string */ -ZIO* zmopen (ZIO* z, const char* b, size_t size, const char *name); /* memory */ -size_t zread (ZIO* z, void* b, size_t n); /* read next n bytes */ +#define char2int(c) cast(int, cast(unsigned char, (c))) + +#define zgetc(z) (((z)->n--)>0 ? char2int(*(z)->p++) : luaZ_fill(z)) -#define zgetc(z) (((z)->n--)>0 ? ((int)*(z)->p++): (z)->filbuf(z)) -#define zungetc(z) (++(z)->n,--(z)->p) #define zname(z) ((z)->name) +void luaZ_init (ZIO *z, lua_Chunkreader reader, void *data, const char *name); +size_t luaZ_read (ZIO* z, void* b, size_t n); /* read next n bytes */ +int luaZ_lookahead (ZIO *z); -/* --------- Private Part ------------------ */ -#ifndef ZBSIZE -#define ZBSIZE 256 /* buffer size */ -#endif +typedef struct Mbuffer { + char *buffer; + size_t buffsize; +} Mbuffer; + + +char *luaZ_openspace (lua_State *L, Mbuffer *buff, size_t n); + +#define luaZ_initbuffer(L, buff) ((buff)->buffer = NULL, (buff)->buffsize = 0) -struct zio { - size_t n; /* bytes still unread */ - const unsigned char* p; /* current position in buffer */ - int (*filbuf)(ZIO* z); - void* u; /* additional data */ +#define luaZ_sizebuffer(buff) ((buff)->buffsize) +#define luaZ_buffer(buff) ((buff)->buffer) + +#define luaZ_resizebuffer(L, buff, size) \ + (luaM_reallocvector(L, (buff)->buffer, (buff)->buffsize, size, char), \ + (buff)->buffsize = size) + +#define luaZ_freebuffer(L, buff) luaZ_resizebuffer(L, buff, 0) + + +/* --------- Private Part ------------------ */ + +struct Zio { + size_t n; /* bytes still unread */ + const char *p; /* current position in buffer */ + lua_Chunkreader reader; + void* data; /* additional data */ const char *name; - unsigned char buffer[ZBSIZE]; /* buffer */ }; +int luaZ_fill (ZIO *z); + #endif |
