diff options
author | Lua Team <team@lua.org> | 1998-07-11 12:00:00 +0000 |
---|---|---|
committer | repogen <> | 1998-07-11 12:00:00 +0000 |
commit | 377347776f1f3d820f92151f70bec667f96d5e6b (patch) | |
tree | cdb3ba26158df33547dfe765547177afcee119d1 /src | |
parent | 4f8c5d0f284e1f4da717aea5008915f185cd2e05 (diff) | |
download | lua-github-377347776f1f3d820f92151f70bec667f96d5e6b.tar.gz |
Lua 3.13.1
Diffstat (limited to 'src')
-rw-r--r-- | src/Makefile | 117 | ||||
-rw-r--r-- | src/auxlib.c | 81 | ||||
-rw-r--r-- | src/auxlib.h | 30 | ||||
-rw-r--r-- | src/fallback.c | 368 | ||||
-rw-r--r-- | src/fallback.h | 65 | ||||
-rw-r--r-- | src/func.c | 166 | ||||
-rw-r--r-- | src/func.h | 45 | ||||
-rw-r--r-- | src/hash.c | 332 | ||||
-rw-r--r-- | src/hash.h | 39 | ||||
-rw-r--r-- | src/inout.c | 408 | ||||
-rw-r--r-- | src/inout.h | 25 | ||||
-rw-r--r-- | src/lapi.c | 631 | ||||
-rw-r--r-- | src/lapi.h | 20 | ||||
-rw-r--r-- | src/lauxlib.c | 111 | ||||
-rw-r--r-- | src/lbuffer.c | 85 | ||||
-rw-r--r-- | src/lbuiltin.c | 526 | ||||
-rw-r--r-- | src/lbuiltin.h | 14 | ||||
-rw-r--r-- | src/ldo.c | 427 | ||||
-rw-r--r-- | src/ldo.h | 46 | ||||
-rw-r--r-- | src/lex.c | 470 | ||||
-rw-r--r-- | src/lex.h | 18 | ||||
-rw-r--r-- | src/lfunc.c | 98 | ||||
-rw-r--r-- | src/lfunc.h | 23 | ||||
-rw-r--r-- | src/lgc.c | 288 | ||||
-rw-r--r-- | src/lgc.h | 21 | ||||
-rw-r--r-- | src/lib/Makefile | 28 | ||||
-rw-r--r-- | src/lib/README | 4 | ||||
-rw-r--r-- | src/lib/liolib.c | 448 | ||||
-rw-r--r-- | src/lib/lmathlib.c | 213 | ||||
-rw-r--r-- | src/lib/lstrlib.c | 541 | ||||
-rw-r--r-- | src/llex.c | 463 | ||||
-rw-r--r-- | src/llex.h | 62 | ||||
-rw-r--r-- | src/lmem.c | 113 | ||||
-rw-r--r-- | src/lmem.h | 43 | ||||
-rw-r--r-- | src/lobject.c | 83 | ||||
-rw-r--r-- | src/lobject.h | 210 | ||||
-rw-r--r-- | src/lopcodes.h | 181 | ||||
-rw-r--r-- | src/lparser.c | 1333 | ||||
-rw-r--r-- | src/lparser.h | 20 | ||||
-rw-r--r-- | src/lstate.c | 86 | ||||
-rw-r--r-- | src/lstate.h | 86 | ||||
-rw-r--r-- | src/lstring.c | 313 | ||||
-rw-r--r-- | src/lstring.h | 28 | ||||
-rw-r--r-- | src/ltable.c | 216 | ||||
-rw-r--r-- | src/ltable.h | 24 | ||||
-rw-r--r-- | src/ltm.c | 263 | ||||
-rw-r--r-- | src/ltm.h | 62 | ||||
-rw-r--r-- | src/lua.stx | 791 | ||||
-rw-r--r-- | src/lua/Makefile | 32 | ||||
-rw-r--r-- | src/lua/README | 20 | ||||
-rw-r--r-- | src/lua/lua.c | 194 | ||||
-rw-r--r-- | src/luac/Makefile | 16 | ||||
-rw-r--r-- | src/luac/README | 25 | ||||
-rw-r--r-- | src/luac/dump.c | 302 | ||||
-rw-r--r-- | src/luac/luac.c | 176 | ||||
-rw-r--r-- | src/luac/luac.h | 46 | ||||
-rw-r--r-- | src/luac/opcode.c | 87 | ||||
-rw-r--r-- | src/luac/opcode.h | 134 | ||||
-rw-r--r-- | src/luac/opt.c | 228 | ||||
-rw-r--r-- | src/luac/print.c | 492 | ||||
-rw-r--r-- | src/luac/print.h | 79 | ||||
-rw-r--r-- | src/luac/stubs.c | 68 | ||||
-rw-r--r-- | src/luamem.c | 159 | ||||
-rw-r--r-- | src/luamem.h | 39 | ||||
-rw-r--r-- | src/lundump.c | 228 | ||||
-rw-r--r-- | src/lundump.h | 78 | ||||
-rw-r--r-- | src/lvm.c | 737 | ||||
-rw-r--r-- | src/lvm.h | 29 | ||||
-rw-r--r-- | src/lzio.c (renamed from src/zio.c) | 29 | ||||
-rw-r--r-- | src/lzio.h (renamed from src/zio.h) | 22 | ||||
-rw-r--r-- | src/opcode.c | 1478 | ||||
-rw-r--r-- | src/opcode.h | 171 | ||||
-rw-r--r-- | src/parser.c | 1696 | ||||
-rw-r--r-- | src/parser.h | 38 | ||||
-rw-r--r-- | src/table.c | 266 | ||||
-rw-r--r-- | src/table.h | 39 | ||||
-rw-r--r-- | src/tree.c | 211 | ||||
-rw-r--r-- | src/tree.h | 38 | ||||
-rw-r--r-- | src/types.h | 29 | ||||
-rw-r--r-- | src/undump.c | 330 | ||||
-rw-r--r-- | src/undump.h | 30 |
81 files changed, 9464 insertions, 8147 deletions
diff --git a/src/Makefile b/src/Makefile index 9fe13c83..7d01a924 100644 --- a/src/Makefile +++ b/src/Makefile @@ -1,72 +1,79 @@ -# makefile for lua distribution (main library) +# makefile for lua basic library LUA= .. include $(LUA)/config -OBJS= auxlib.o\ - fallback.o\ - func.o\ - hash.o\ - inout.o\ - lex.o\ - luamem.o\ - opcode.o\ - parser.o\ - table.o\ - tree.o\ - undump.o\ - zio.o +OBJS= \ + lapi.o \ + lauxlib.o \ + lbuffer.o \ + lbuiltin.o \ + ldo.o \ + lfunc.o \ + lgc.o \ + llex.o \ + lmem.o \ + lobject.o \ + lparser.o \ + lstate.o \ + lstring.o \ + ltable.o \ + ltm.o \ + lundump.o \ + lvm.o \ + lzio.o -SRCS= auxlib.c\ - auxlib.h\ - fallback.c\ - fallback.h\ - func.c\ - func.h\ - hash.c\ - hash.h\ - inout.c\ - inout.h\ - lex.c\ - lex.h\ - luamem.c\ - luamem.h\ - opcode.c\ - opcode.h\ - parser.c\ - parser.h\ - table.c\ - table.h\ - tree.c\ - tree.h\ - types.h\ - undump.c\ - undump.h\ - zio.c\ - zio.h\ - lua.stx +SRCS= \ + lapi.c \ + lauxlib.c \ + lbuffer.c \ + lbuiltin.c \ + ldo.c \ + lfunc.c \ + lgc.c \ + llex.c \ + lmem.c \ + lobject.c \ + lparser.c \ + lstate.c \ + lstring.c \ + ltable.c \ + ltm.c \ + lundump.c \ + lvm.c \ + lzio.c \ + lapi.h \ + lbuiltin.h \ + ldo.h \ + lfunc.h \ + lgc.h \ + llex.h \ + lmem.h \ + lobject.h \ + lopcodes.h \ + lparser.h \ + lstate.h \ + lstring.h \ + ltable.h \ + ltm.h \ + lundump.h \ + lvm.h \ + lzio.h -SLIB= $(LIB)/liblua.a +T= $(LIB)/liblua.a -all: $(SLIB) +all: $T -$(SLIB): $(OBJS) - ar rcu $@ $(OBJS) +$T: $(OBJS) + $(AR) $@ $(OBJS) $(RANLIB) $@ clean: - rm -f $(OBJS) $(SLIB) + rm -f $(OBJS) $T co: - co -f -M $(SRCS) - -parser: - yacc -d lua.stx - rm -f parser.c parser.h - sed -e 's/yy/luaY_/g' y.tab.c > parser.c - sed -e 's/yy/luaY_/g' y.tab.h > parser.h - rm y.tab.c y.tab.h + co -q -f -M $(SRCS) klean: clean rm -f $(SRCS) diff --git a/src/auxlib.c b/src/auxlib.c deleted file mode 100644 index e6f71f29..00000000 --- a/src/auxlib.c +++ /dev/null @@ -1,81 +0,0 @@ -char *rcs_auxlib="$Id: auxlib.c,v 1.5 1997/04/14 15:30:03 roberto Exp $"; - -#include <stdio.h> -#include <stdarg.h> -#include <string.h> - -#include "lua.h" -#include "auxlib.h" -#include "luadebug.h" - - - -int luaI_findstring (char *name, char *list[]) -{ - int i; - for (i=0; list[i]; i++) - if (strcmp(list[i], name) == 0) - return i; - return -1; /* name not found */ -} - - -void luaL_arg_check(int cond, int numarg, char *extramsg) -{ - if (!cond) { - char *funcname; - lua_getobjname(lua_stackedfunction(0), &funcname); - if (funcname == NULL) - funcname = "???"; - if (extramsg == NULL) - luaL_verror("bad argument #%d to function `%s'", numarg, funcname); - else - luaL_verror("bad argument #%d to function `%s' (%s)", - numarg, funcname, extramsg); - } -} - -char *luaL_check_string (int numArg) -{ - lua_Object o = lua_getparam(numArg); - luaL_arg_check(lua_isstring(o), numArg, "string expected"); - return lua_getstring(o); -} - -char *luaL_opt_string (int numArg, char *def) -{ - return (lua_getparam(numArg) == LUA_NOOBJECT) ? def : - luaL_check_string(numArg); -} - -double luaL_check_number (int numArg) -{ - lua_Object o = lua_getparam(numArg); - luaL_arg_check(lua_isnumber(o), numArg, "number expected"); - return lua_getnumber(o); -} - - -double luaL_opt_number (int numArg, double def) -{ - return (lua_getparam(numArg) == LUA_NOOBJECT) ? def : - luaL_check_number(numArg); -} - -void luaL_openlib (struct luaL_reg *l, int n) -{ - int i; - for (i=0; i<n; i++) - lua_register(l[i].name, l[i].func); -} - - -void luaL_verror (char *fmt, ...) -{ - char buff[1000]; - va_list argp; - va_start(argp, fmt); - vsprintf(buff, fmt, argp); - va_end(argp); - lua_error(buff); -} diff --git a/src/auxlib.h b/src/auxlib.h deleted file mode 100644 index 09020b46..00000000 --- a/src/auxlib.h +++ /dev/null @@ -1,30 +0,0 @@ -/* -** $Id: auxlib.h,v 1.3 1997/04/07 14:48:53 roberto Exp $ -*/ - -#ifndef auxlib_h -#define auxlib_h - -#include "lua.h" - -struct luaL_reg { - char *name; - lua_CFunction func; -}; - -void luaL_openlib (struct luaL_reg *l, int n); -void luaL_arg_check(int cond, int numarg, char *extramsg); -char *luaL_check_string (int numArg); -char *luaL_opt_string (int numArg, char *def); -double luaL_check_number (int numArg); -double luaL_opt_number (int numArg, double def); -void luaL_verror (char *fmt, ...); - - - -/* -- private part (only for Lua modules */ - -int luaI_findstring (char *name, char *list[]); - - -#endif diff --git a/src/fallback.c b/src/fallback.c deleted file mode 100644 index 5a0b5a5b..00000000 --- a/src/fallback.c +++ /dev/null @@ -1,368 +0,0 @@ -/* -** fallback.c -** TecCGraf - PUC-Rio -*/ - -char *rcs_fallback="$Id: fallback.c,v 2.9 1997/06/23 18:27:53 roberto Exp $"; - -#include <stdio.h> -#include <string.h> - -#include "auxlib.h" -#include "luamem.h" -#include "fallback.h" -#include "opcode.h" -#include "lua.h" -#include "table.h" -#include "tree.h" -#include "hash.h" - - - -/* ------------------------------------------- -** Reference routines -*/ - -static struct ref { - TObject o; - enum {LOCK, HOLD, FREE, COLLECTED} status; -} *refArray = NULL; -static int refSize = 0; - -int luaI_ref (TObject *object, int lock) -{ - int i; - int oldSize; - if (ttype(object) == LUA_T_NIL) - return -1; /* special ref for nil */ - for (i=0; i<refSize; i++) - if (refArray[i].status == FREE) - goto found; - /* no more empty spaces */ - oldSize = refSize; - refSize = growvector(&refArray, refSize, struct ref, refEM, MAX_WORD); - for (i=oldSize; i<refSize; i++) - refArray[i].status = FREE; - i = oldSize; - found: - refArray[i].o = *object; - refArray[i].status = lock ? LOCK : HOLD; - return i; -} - - -void lua_unref (int ref) -{ - if (ref >= 0 && ref < refSize) - refArray[ref].status = FREE; -} - - -TObject *luaI_getref (int ref) -{ - static TObject nul = {LUA_T_NIL, {0}}; - if (ref == -1) - return &nul; - if (ref >= 0 && ref < refSize && - (refArray[ref].status == LOCK || refArray[ref].status == HOLD)) - return &refArray[ref].o; - else - return NULL; -} - - -void luaI_travlock (int (*fn)(TObject *)) -{ - int i; - for (i=0; i<refSize; i++) - if (refArray[i].status == LOCK) - fn(&refArray[i].o); -} - - -void luaI_invalidaterefs (void) -{ - int i; - for (i=0; i<refSize; i++) - if (refArray[i].status == HOLD && !luaI_ismarked(&refArray[i].o)) - refArray[i].status = COLLECTED; -} - - -/* ------------------------------------------- -* Internal Methods -*/ - -char *luaI_eventname[] = { /* ORDER IM */ - "gettable", "settable", "index", "getglobal", "setglobal", "add", - "sub", "mul", "div", "pow", "unm", "lt", "le", "gt", "ge", - "concat", "gc", "function", - NULL -}; - - - -static int luaI_checkevent (char *name, char *list[]) -{ - int e = luaI_findstring(name, list); - if (e < 0) - luaL_verror("`%s' is not a valid event name", name); - return e; -} - - -struct IM *luaI_IMtable = NULL; - -static int IMtable_size = 0; -static int last_tag = LUA_T_NIL; /* ORDER LUA_T */ - - -/* events in LUA_T_LINE are all allowed, since this is used as a -* 'placeholder' for "default" fallbacks -*/ -static char validevents[NUM_TYPES][IM_N] = { /* ORDER LUA_T, ORDER IM */ -{1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1}, /* LUA_T_USERDATA */ -{1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}, /* LUA_T_LINE */ -{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, /* LUA_T_CMARK */ -{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, /* LUA_T_MARK */ -{1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0}, /* LUA_T_CFUNCTION */ -{1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0}, /* LUA_T_FUNCTION */ -{0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}, /* LUA_T_ARRAY */ -{1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, /* LUA_T_STRING */ -{1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1}, /* LUA_T_NUMBER */ -{1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1} /* LUA_T_NIL */ -}; - -static int validevent (lua_Type t, int e) -{ /* ORDER LUA_T */ - return (t < LUA_T_NIL) ? 1 : validevents[-t][e]; -} - - -static void init_entry (int tag) -{ - int i; - for (i=0; i<IM_N; i++) - ttype(luaI_getim(tag, i)) = LUA_T_NIL; -} - -void luaI_initfallbacks (void) -{ - if (luaI_IMtable == NULL) { - int i; - IMtable_size = NUM_TYPES+10; - luaI_IMtable = newvector(IMtable_size, struct IM); - for (i=LUA_T_NIL; i<=LUA_T_USERDATA; i++) - init_entry(i); - } -} - -int lua_newtag (void) -{ - --last_tag; - if ((-last_tag) >= IMtable_size) { - luaI_initfallbacks(); - IMtable_size = growvector(&luaI_IMtable, IMtable_size, - struct IM, memEM, MAX_INT); - } - init_entry(last_tag); - return last_tag; -} - - -static void checktag (int tag) -{ - if (!(last_tag <= tag && tag <= 0)) - luaL_verror("%d is not a valid tag", tag); -} - -void luaI_realtag (int tag) -{ - if (!(last_tag <= tag && tag < LUA_T_NIL)) - luaL_verror("tag %d is not result of `newtag'", tag); -} - - -void luaI_settag (int tag, TObject *o) -{ - luaI_realtag(tag); - switch (ttype(o)) { - case LUA_T_ARRAY: - o->value.a->htag = tag; - break; - case LUA_T_USERDATA: - o->value.ts->tag = tag; - break; - default: - luaL_verror("cannot change the tag of a %s", luaI_typenames[-ttype(o)]); - } -} - - -int luaI_efectivetag (TObject *o) -{ - lua_Type t = ttype(o); - if (t == LUA_T_USERDATA) { - int tag = o->value.ts->tag; - return (tag >= 0) ? LUA_T_USERDATA : tag; - } - else if (t == LUA_T_ARRAY) - return o->value.a->htag; - else return t; -} - - -void luaI_gettagmethod (void) -{ - int t = (int)luaL_check_number(1); - int e = luaI_checkevent(luaL_check_string(2), luaI_eventname); - checktag(t); - if (validevent(t, e)) - luaI_pushobject(luaI_getim(t,e)); -} - - -void luaI_settagmethod (void) -{ - int t = (int)luaL_check_number(1); - int e = luaI_checkevent(luaL_check_string(2), luaI_eventname); - lua_Object func = lua_getparam(3); - checktag(t); - if (!validevent(t, e)) - luaL_verror("cannot change internal method `%s' for tag %d", - luaI_eventname[e], t); - luaL_arg_check(lua_isnil(func) || lua_isfunction(func), - 3, "function expected"); - luaI_pushobject(luaI_getim(t,e)); - *luaI_getim(t, e) = *luaI_Address(func); -} - - -static void stderrorim (void) -{ - lua_Object s = lua_getparam(1); - if (lua_isstring(s)) - fprintf(stderr, "lua: %s\n", lua_getstring(s)); -} - -static TObject errorim = {LUA_T_CFUNCTION, {stderrorim}}; - - -TObject *luaI_geterrorim (void) -{ - return &errorim; -} - -void luaI_seterrormethod (void) -{ - lua_Object func = lua_getparam(1); - luaL_arg_check(lua_isnil(func) || lua_isfunction(func), - 1, "function expected"); - luaI_pushobject(&errorim); - errorim = *luaI_Address(func); -} - -char *luaI_travfallbacks (int (*fn)(TObject *)) -{ - int e; - if (fn(&errorim)) - return "error"; - for (e=IM_GETTABLE; e<=IM_FUNCTION; e++) { /* ORDER IM */ - int t; - for (t=0; t>=last_tag; t--) - if (fn(luaI_getim(t,e))) - return luaI_eventname[e]; - } - return NULL; -} - - -/* -* =================================================================== -* compatibility with old fallback system -*/ -#if LUA_COMPAT2_5 - -static void errorFB (void) -{ - lua_Object o = lua_getparam(1); - if (lua_isstring(o)) - fprintf (stderr, "lua: %s\n", lua_getstring(o)); - else - fprintf(stderr, "lua: unknown error\n"); -} - - -static void nilFB (void) { } - - -static void typeFB (void) -{ - lua_error("unexpected type"); -} - - -static void fillvalids (IMS e, TObject *func) -{ - int t; - for (t=LUA_T_NIL; t<=LUA_T_USERDATA; t++) - if (validevent(t, e)) - *luaI_getim(t, e) = *func; -} - - -void luaI_setfallback (void) -{ - static char *oldnames [] = {"error", "getglobal", "arith", "order", NULL}; - TObject oldfunc; - lua_CFunction replace; - char *name = luaL_check_string(1); - lua_Object func = lua_getparam(2); - luaI_initfallbacks(); - luaL_arg_check(lua_isfunction(func), 2, "function expected"); - switch (luaI_findstring(name, oldnames)) { - case 0: /* old error fallback */ - oldfunc = errorim; - errorim = *luaI_Address(func); - replace = errorFB; - break; - case 1: /* old getglobal fallback */ - oldfunc = *luaI_getim(LUA_T_NIL, IM_GETGLOBAL); - *luaI_getim(LUA_T_NIL, IM_GETGLOBAL) = *luaI_Address(func); - replace = nilFB; - break; - case 2: { /* old arith fallback */ - int i; - oldfunc = *luaI_getim(LUA_T_NUMBER, IM_POW); - for (i=IM_ADD; i<=IM_UNM; i++) /* ORDER IM */ - fillvalids(i, luaI_Address(func)); - replace = typeFB; - break; - } - case 3: { /* old order fallback */ - int i; - oldfunc = *luaI_getim(LUA_T_LINE, IM_LT); - for (i=IM_LT; i<=IM_GE; i++) /* ORDER IM */ - fillvalids(i, luaI_Address(func)); - replace = typeFB; - break; - } - default: { - int e; - if ((e = luaI_findstring(name, luaI_eventname)) >= 0) { - oldfunc = *luaI_getim(LUA_T_LINE, e); - fillvalids(e, luaI_Address(func)); - replace = (e == IM_GC || e == IM_INDEX) ? nilFB : typeFB; - } - else { - luaL_verror("`%s' is not a valid fallback name", name); - replace = NULL; /* to avoid warnings */ - } - } - } - if (oldfunc.ttype != LUA_T_NIL) - luaI_pushobject(&oldfunc); - else - lua_pushcfunction(replace); -} -#endif diff --git a/src/fallback.h b/src/fallback.h deleted file mode 100644 index 7e314c9f..00000000 --- a/src/fallback.h +++ /dev/null @@ -1,65 +0,0 @@ -/* -** $Id: fallback.h,v 1.23 1997/04/24 22:59:57 roberto Exp $ -*/ - -#ifndef fallback_h -#define fallback_h - -#include "lua.h" -#include "opcode.h" - -/* -* WARNING: if you change the order of this enumeration, -* grep "ORDER IM" -*/ -typedef enum { - IM_GETTABLE = 0, - IM_SETTABLE, - IM_INDEX, - IM_GETGLOBAL, - IM_SETGLOBAL, - IM_ADD, - IM_SUB, - IM_MUL, - IM_DIV, - IM_POW, - IM_UNM, - IM_LT, - IM_LE, - IM_GT, - IM_GE, - IM_CONCAT, - IM_GC, - IM_FUNCTION -} IMS; - -#define IM_N 18 - - -extern struct IM { - TObject int_method[IM_N]; -} *luaI_IMtable; - -extern char *luaI_eventname[]; - -#define luaI_getim(tag,event) (&luaI_IMtable[-(tag)].int_method[event]) -#define luaI_getimbyObj(o,e) (luaI_getim(luaI_efectivetag(o),(e))) - -void luaI_setfallback (void); -int luaI_ref (TObject *object, int lock); -TObject *luaI_getref (int ref); -void luaI_travlock (int (*fn)(TObject *)); -void luaI_invalidaterefs (void); -char *luaI_travfallbacks (int (*fn)(TObject *)); - -void luaI_settag (int tag, TObject *o); -void luaI_realtag (int tag); -TObject *luaI_geterrorim (void); -int luaI_efectivetag (TObject *o); -void luaI_settagmethod (void); -void luaI_gettagmethod (void); -void luaI_seterrormethod (void); -void luaI_initfallbacks (void); - -#endif - diff --git a/src/func.c b/src/func.c deleted file mode 100644 index 36f7e19f..00000000 --- a/src/func.c +++ /dev/null @@ -1,166 +0,0 @@ -#include <string.h> - -#include "luadebug.h" -#include "table.h" -#include "luamem.h" -#include "func.h" -#include "opcode.h" -#include "inout.h" - - -static TFunc *function_root = NULL; -static LocVar *currvars = NULL; -static int numcurrvars = 0; -static int maxcurrvars = 0; - - -/* -** Initialize TFunc struct -*/ -void luaI_initTFunc (TFunc *f) -{ - f->next = NULL; - f->marked = 0; - f->size = 0; - f->code = NULL; - f->lineDefined = 0; - f->fileName = lua_parsedfile; - f->locvars = NULL; -} - -/* -** Insert function in list for GC -*/ -void luaI_insertfunction (TFunc *f) -{ - lua_pack(); - f->next = function_root; - function_root = f; - f->marked = 0; -} - - -/* -** Free function -*/ -void luaI_freefunc (TFunc *f) -{ - luaI_free (f->code); - luaI_free (f->locvars); - luaI_free (f); -} - - -void luaI_funcfree (TFunc *l) -{ - while (l) { - TFunc *next = l->next; - luaI_freefunc(l); - l = next; - } -} - -/* -** Garbage collection function. -*/ -TFunc *luaI_funccollector (long *acum) -{ - TFunc *curr = function_root; - TFunc *prev = NULL; - TFunc *frees = NULL; - long counter = 0; - while (curr) { - TFunc *next = curr->next; - if (!curr->marked) { - if (prev == NULL) - function_root = next; - else - prev->next = next; - curr->next = frees; - frees = curr; - ++counter; - } - else { - curr->marked = 0; - prev = curr; - } - curr = next; - } - *acum += counter; - return frees; -} - - -void lua_funcinfo (lua_Object func, char **filename, int *linedefined) -{ - TObject *f = luaI_Address(func); - if (f->ttype == LUA_T_MARK || f->ttype == LUA_T_FUNCTION) - { - *filename = f->value.tf->fileName; - *linedefined = f->value.tf->lineDefined; - } - else if (f->ttype == LUA_T_CMARK || f->ttype == LUA_T_CFUNCTION) - { - *filename = "(C)"; - *linedefined = -1; - } -} - -/* -** Stores information to know that variable has been declared in given line -*/ -void luaI_registerlocalvar (TaggedString *varname, int line) -{ - if (numcurrvars >= maxcurrvars) - maxcurrvars = growvector(&currvars, maxcurrvars, LocVar, "", MAX_WORD); - currvars[numcurrvars].varname = varname; - currvars[numcurrvars].line = line; - numcurrvars++; -} - -/* -** Stores information to know that variable has been out of scope in given line -*/ -void luaI_unregisterlocalvar (int line) -{ - luaI_registerlocalvar(NULL, line); -} - -/* -** Copies "currvars" into a new area and store it in function header. -** The values (varname = NULL, line = -1) signal the end of vector. -*/ -void luaI_closelocalvars (TFunc *func) -{ - func->locvars = newvector (numcurrvars+1, LocVar); - memcpy (func->locvars, currvars, numcurrvars*sizeof(LocVar)); - func->locvars[numcurrvars].varname = NULL; - func->locvars[numcurrvars].line = -1; - numcurrvars = 0; /* prepares for next function */ -} - -/* -** Look for n-esim local variable at line "line" in function "func". -** Returns NULL if not found. -*/ -char *luaI_getlocalname (TFunc *func, int local_number, int line) -{ - int count = 0; - char *varname = NULL; - LocVar *lv = func->locvars; - if (lv == NULL) - return NULL; - for (; lv->line != -1 && lv->line < line; lv++) - { - if (lv->varname) /* register */ - { - if (++count == local_number) - varname = lv->varname->str; - } - else /* unregister */ - if (--count < local_number) - varname = NULL; - } - return varname; -} - diff --git a/src/func.h b/src/func.h deleted file mode 100644 index c79bbb72..00000000 --- a/src/func.h +++ /dev/null @@ -1,45 +0,0 @@ -/* -** $Id: func.h,v 1.9 1997/05/14 18:38:29 roberto Exp $ -*/ - -#ifndef func_h -#define func_h - -#include "types.h" -#include "lua.h" -#include "tree.h" - -typedef struct LocVar -{ - TaggedString *varname; /* NULL signals end of scope */ - int line; -} LocVar; - - -/* -** Function Headers -*/ -typedef struct TFunc -{ - struct TFunc *next; - int marked; - int size; - Byte *code; - int lineDefined; - char *fileName; - LocVar *locvars; -} TFunc; - -TFunc *luaI_funccollector (long *cont); -void luaI_funcfree (TFunc *l); -void luaI_insertfunction (TFunc *f); - -void luaI_initTFunc (TFunc *f); -void luaI_freefunc (TFunc *f); - -void luaI_registerlocalvar (TaggedString *varname, int line); -void luaI_unregisterlocalvar (int line); -void luaI_closelocalvars (TFunc *func); -char *luaI_getlocalname (TFunc *func, int local_number, int line); - -#endif diff --git a/src/hash.c b/src/hash.c deleted file mode 100644 index b9276024..00000000 --- a/src/hash.c +++ /dev/null @@ -1,332 +0,0 @@ -/* -** hash.c -** hash manager for lua -*/ - -char *rcs_hash="$Id: hash.c,v 2.43 1997/05/14 18:38:29 roberto Exp $"; - - -#include "luamem.h" -#include "opcode.h" -#include "hash.h" -#include "table.h" -#include "lua.h" -#include "auxlib.h" - - -#define nhash(t) ((t)->nhash) -#define nuse(t) ((t)->nuse) -#define markarray(t) ((t)->mark) -#define nodevector(t) ((t)->node) -#define node(t,i) (&(t)->node[i]) -#define ref(n) (&(n)->ref) -#define val(n) (&(n)->val) - - -#define REHASH_LIMIT 0.70 /* avoid more than this % full */ - -#define TagDefault LUA_T_ARRAY; - - -static Hash *listhead = NULL; - - -/* hash dimensions values */ -static Long dimensions[] = - {5L, 11L, 23L, 47L, 97L, 197L, 397L, 797L, 1597L, 3203L, 6421L, - 12853L, 25717L, 51437L, 102811L, 205619L, 411233L, 822433L, - 1644817L, 3289613L, 6579211L, 13158023L, MAX_INT}; - -int luaI_redimension (int nhash) -{ - int i; - for (i=0; dimensions[i]<MAX_INT; i++) - { - if (dimensions[i] > nhash) - return dimensions[i]; - } - lua_error("table overflow"); - return 0; /* to avoid warnings */ -} - - -int lua_equalObj (TObject *t1, TObject *t2) -{ - if (ttype(t1) != ttype(t2)) return 0; - switch (ttype(t1)) - { - case LUA_T_NIL: return 1; - case LUA_T_NUMBER: return nvalue(t1) == nvalue(t2); - case LUA_T_STRING: case LUA_T_USERDATA: return svalue(t1) == svalue(t2); - case LUA_T_ARRAY: return avalue(t1) == avalue(t2); - case LUA_T_FUNCTION: return t1->value.tf == t2->value.tf; - case LUA_T_CFUNCTION: return fvalue(t1) == fvalue(t2); - default: - lua_error("internal error in `lua_equalObj'"); - return 0; /* UNREACHEABLE */ - } -} - - -static long int hashindex (TObject *ref) -{ - long int h; - switch (ttype(ref)) { - case LUA_T_NUMBER: - h = (long int)nvalue(ref); break; - case LUA_T_STRING: case LUA_T_USERDATA: - h = tsvalue(ref)->hash; break; - case LUA_T_FUNCTION: - h = (IntPoint)ref->value.tf; break; - case LUA_T_CFUNCTION: - h = (IntPoint)fvalue(ref); break; - case LUA_T_ARRAY: - h = (IntPoint)avalue(ref); break; - default: - lua_error ("unexpected type to index table"); - h = 0; /* UNREACHEABLE */ - } - if (h < 0) h = -h; - return h; -} - - -static int present (Hash *t, TObject *key) -{ - long int h = hashindex(key); - int tsize = nhash(t); - int h1 = h%tsize; - TObject *rf = ref(node(t, h1)); - if (ttype(rf) != LUA_T_NIL && !lua_equalObj(key, rf)) { - int h2 = h%(tsize-2) + 1; - do { - h1 = (h1+h2)%tsize; - rf = ref(node(t, h1)); - } while (ttype(rf) != LUA_T_NIL && !lua_equalObj(key, rf)); - } - return h1; -} - - -/* -** Alloc a vector node -*/ -static Node *hashnodecreate (int nhash) -{ - int i; - Node *v = newvector (nhash, Node); - for (i=0; i<nhash; i++) - ttype(ref(&v[i])) = LUA_T_NIL; - return v; -} - -/* -** Create a new hash. Return the hash pointer or NULL on error. -*/ -static Hash *hashcreate (int nhash) -{ - Hash *t = new(Hash); - nhash = luaI_redimension((int)((float)nhash/REHASH_LIMIT)); - nodevector(t) = hashnodecreate(nhash); - nhash(t) = nhash; - nuse(t) = 0; - markarray(t) = 0; - t->htag = TagDefault; - return t; -} - -/* -** Delete a hash -*/ -static void hashdelete (Hash *t) -{ - luaI_free (nodevector(t)); - luaI_free(t); -} - - -/* -** Mark a hash and check its elements -*/ -void lua_hashmark (Hash *h) -{ - if (markarray(h) == 0) - { - int i; - markarray(h) = 1; - for (i=0; i<nhash(h); i++) - { - Node *n = node(h,i); - if (ttype(ref(n)) != LUA_T_NIL) - { - lua_markobject(&n->ref); - lua_markobject(&n->val); - } - } - } -} - - -void luaI_hashcallIM (Hash *l) -{ - TObject t; - ttype(&t) = LUA_T_ARRAY; - for (; l; l=l->next) { - avalue(&t) = l; - luaI_gcIM(&t); - } -} - - -void luaI_hashfree (Hash *frees) -{ - while (frees) { - Hash *next = frees->next; - hashdelete(frees); - frees = next; - } -} - - -Hash *luaI_hashcollector (long *acum) -{ - Hash *curr_array = listhead, *prev = NULL, *frees = NULL; - long counter = 0; - while (curr_array != NULL) { - Hash *next = curr_array->next; - if (markarray(curr_array) != 1) { - if (prev == NULL) - listhead = next; - else - prev->next = next; - curr_array->next = frees; - frees = curr_array; - ++counter; - } - else { - markarray(curr_array) = 0; - prev = curr_array; - } - curr_array = next; - } - *acum += counter; - return frees; -} - - -/* -** Create a new array -** This function inserts the new array in the array list. It also -** executes garbage collection if the number of arrays created -** exceed a pre-defined range. -*/ -Hash *lua_createarray (int nhash) -{ - Hash *array; - lua_pack(); - array = hashcreate(nhash); - array->next = listhead; - listhead = array; - return array; -} - - -/* -** Rehash: -** Check if table has deleted slots. It it has, it does not need to -** grow, since rehash will reuse them. -*/ -static int emptyslots (Hash *t) -{ - int i; - for (i=nhash(t)-1; i>=0; i--) { - Node *n = node(t, i); - if (ttype(ref(n)) != LUA_T_NIL && ttype(val(n)) == LUA_T_NIL) - return 1; - } - return 0; -} - -static void rehash (Hash *t) -{ - int nold = nhash(t); - Node *vold = nodevector(t); - int i; - if (!emptyslots(t)) - nhash(t) = luaI_redimension(nhash(t)); - nodevector(t) = hashnodecreate(nhash(t)); - for (i=0; i<nold; i++) { - Node *n = vold+i; - if (ttype(ref(n)) != LUA_T_NIL && ttype(val(n)) != LUA_T_NIL) - *node(t, present(t, ref(n))) = *n; /* copy old node to new hash */ - } - luaI_free(vold); -} - -/* -** If the hash node is present, return its pointer, otherwise return -** null. -*/ -TObject *lua_hashget (Hash *t, TObject *ref) -{ - int h = present(t, ref); - if (ttype(ref(node(t, h))) != LUA_T_NIL) return val(node(t, h)); - else return NULL; -} - - -/* -** If the hash node is present, return its pointer, otherwise create a new -** node for the given reference and also return its pointer. -*/ -TObject *lua_hashdefine (Hash *t, TObject *ref) -{ - Node *n = node(t, present(t, ref)); - if (ttype(ref(n)) == LUA_T_NIL) { - nuse(t)++; - if ((float)nuse(t) > (float)nhash(t)*REHASH_LIMIT) { - rehash(t); - n = node(t, present(t, ref)); - } - *ref(n) = *ref; - ttype(val(n)) = LUA_T_NIL; - } - return (val(n)); -} - - -/* -** Internal function to manipulate arrays. -** Given an array object and a reference value, return the next element -** in the hash. -** This function pushs the element value and its reference to the stack. -*/ -static void hashnext (Hash *t, int i) -{ - Node *n; - int tsize = nhash(t); - if (i >= tsize) - return; - n = node(t, i); - while (ttype(ref(n)) == LUA_T_NIL || ttype(val(n)) == LUA_T_NIL) { - if (++i >= tsize) - return; - n = node(t, i); - } - luaI_pushobject(ref(node(t,i))); - luaI_pushobject(val(node(t,i))); -} - -void lua_next (void) -{ - Hash *t; - lua_Object o = lua_getparam(1); - lua_Object r = lua_getparam(2); - luaL_arg_check(lua_istable(o), 1, "table expected"); - luaL_arg_check(r != LUA_NOOBJECT, 2, "value expected"); - t = avalue(luaI_Address(o)); - if (lua_isnil(r)) - hashnext(t, 0); - else - hashnext(t, present(t, luaI_Address(r))+1); -} diff --git a/src/hash.h b/src/hash.h deleted file mode 100644 index 1bc758b7..00000000 --- a/src/hash.h +++ /dev/null @@ -1,39 +0,0 @@ -/* -** hash.h -** hash manager for lua -** $Id: hash.h,v 2.16 1997/05/14 18:38:29 roberto Exp $ -*/ - -#ifndef hash_h -#define hash_h - -#include "types.h" -#include "opcode.h" - -typedef struct node { - TObject ref; - TObject val; -} Node; - -typedef struct Hash { - struct Hash *next; - Node *node; - int nhash; - int nuse; - int htag; - char mark; -} Hash; - - -int lua_equalObj (TObject *t1, TObject *t2); -int luaI_redimension (int nhash); -Hash *lua_createarray (int nhash); -void lua_hashmark (Hash *h); -Hash *luaI_hashcollector (long *count); -void luaI_hashcallIM (Hash *l); -void luaI_hashfree (Hash *frees); -TObject *lua_hashget (Hash *t, TObject *ref); -TObject *lua_hashdefine (Hash *t, TObject *ref); -void lua_next (void); - -#endif diff --git a/src/inout.c b/src/inout.c deleted file mode 100644 index 5d710610..00000000 --- a/src/inout.c +++ /dev/null @@ -1,408 +0,0 @@ -/* -** inout.c -** Provide function to realise the input/output function and debugger -** facilities. -** Also provides some predefined lua functions. -*/ - -char *rcs_inout="$Id: inout.c,v 2.69 1997/06/27 22:38:49 roberto Exp $"; - -#include <stdio.h> -#include <string.h> - -#include "auxlib.h" -#include "fallback.h" -#include "hash.h" -#include "inout.h" -#include "lex.h" -#include "lua.h" -#include "luamem.h" -#include "luamem.h" -#include "opcode.h" -#include "table.h" -#include "tree.h" -#include "undump.h" -#include "zio.h" - - -/* Exported variables */ -Word lua_linenumber; -char *lua_parsedfile; - - -char *luaI_typenames[] = { /* ORDER LUA_T */ - "userdata", "line", "cmark", "mark", "function", - "function", "table", "string", "number", "nil", - NULL -}; - - - -void luaI_setparsedfile (char *name) -{ - lua_parsedfile = luaI_createfixedstring(name)->str; -} - - -int lua_doFILE (FILE *f, int bin) -{ - ZIO z; - luaZ_Fopen(&z, f); - if (bin) - return luaI_undump(&z); - else { - lua_setinput(&z); - return lua_domain(); - } -} - - -int lua_dofile (char *filename) -{ - int status; - int c; - FILE *f = (filename == NULL) ? stdin : fopen(filename, "r"); - if (f == NULL) - return 2; - luaI_setparsedfile(filename?filename:"(stdin)"); - c = fgetc(f); - ungetc(c, f); - if (c == ID_CHUNK) { - f = freopen(filename, "rb", f); /* set binary mode */ - status = lua_doFILE(f, 1); - } - else { - if (c == '#') - while ((c=fgetc(f)) != '\n') /* skip first line */; - status = lua_doFILE(f, 0); - } - if (f != stdin) - fclose(f); - return status; -} - - - -#define SIZE_PREF 20 /* size of string prefix to appear in error messages */ - - -int lua_dobuffer (char *buff, int size) -{ - int status; - ZIO z; - luaI_setparsedfile("(buffer)"); - luaZ_mopen(&z, buff, size); - status = luaI_undump(&z); - return status; -} - - -int lua_dostring (char *str) -{ - int status; - char buff[SIZE_PREF+25]; - char *temp; - ZIO z; - if (str == NULL) return 1; - sprintf(buff, "(dostring) >> %.20s", str); - temp = strchr(buff, '\n'); - if (temp) *temp = 0; /* end string after first line */ - luaI_setparsedfile(buff); - luaZ_sopen(&z, str); - lua_setinput(&z); - status = lua_domain(); - return status; -} - - - - -static int passresults (void) -{ - int arg = 0; - lua_Object obj; - while ((obj = lua_getresult(++arg)) != LUA_NOOBJECT) - lua_pushobject(obj); - return arg-1; -} - - -static void packresults (void) -{ - int arg = 0; - lua_Object obj; - lua_Object table = lua_createtable(); - while ((obj = lua_getresult(++arg)) != LUA_NOOBJECT) { - lua_pushobject(table); - lua_pushnumber(arg); - lua_pushobject(obj); - lua_rawsettable(); - } - lua_pushobject(table); - lua_pushstring("n"); - lua_pushnumber(arg-1); - lua_rawsettable(); - lua_pushobject(table); /* final result */ -} - -/* -** Internal function: do a string -*/ -static void lua_internaldostring (void) -{ - lua_Object err = lua_getparam(2); - if (err != LUA_NOOBJECT) { /* set new error method */ - luaL_arg_check(lua_isnil(err) || lua_isfunction(err), 2, - "must be a valid error handler"); - lua_pushobject(err); - err = lua_seterrormethod(); - } - if (lua_dostring(luaL_check_string(1)) == 0) - if (passresults() == 0) - lua_pushuserdata(NULL); /* at least one result to signal no errors */ - if (err != LUA_NOOBJECT) { /* restore old error method */ - lua_pushobject(err); - lua_seterrormethod(); - } -} - -/* -** Internal function: do a file -*/ -static void lua_internaldofile (void) -{ - char *fname = luaL_opt_string(1, NULL); - if (lua_dofile(fname) == 0) - if (passresults() == 0) - lua_pushuserdata(NULL); /* at least one result to signal no errors */ -} - - -static char *tostring (lua_Object obj) -{ - TObject *o = luaI_Address(obj); - switch (ttype(o)) { - case LUA_T_NUMBER: case LUA_T_STRING: - return lua_getstring(obj); - case LUA_T_ARRAY: case LUA_T_FUNCTION: - case LUA_T_CFUNCTION: case LUA_T_NIL: - return luaI_typenames[-ttype(o)]; - case LUA_T_USERDATA: { - char *buff = luaI_buffer(30); - sprintf(buff, "userdata: %p", o->value.ts->u.v); - return buff; - } - default: return "<unknown object>"; - } -} - -static void luaI_tostring (void) -{ - lua_pushstring(tostring(lua_getparam(1))); -} - -static void luaI_print (void) -{ - int i = 1; - lua_Object obj; - while ((obj = lua_getparam(i++)) != LUA_NOOBJECT) - printf("%s\n", tostring(obj)); -} - -static void luaI_type (void) -{ - lua_Object o = lua_getparam(1); - luaL_arg_check(o != LUA_NOOBJECT, 1, "no argument"); - lua_pushstring(luaI_typenames[-ttype(luaI_Address(o))]); - lua_pushnumber(lua_tag(o)); -} - -/* -** Internal function: convert an object to a number -*/ -static void lua_obj2number (void) -{ - lua_Object o = lua_getparam(1); - if (lua_isnumber(o)) - lua_pushnumber(lua_getnumber(o)); -} - - -static void luaI_error (void) -{ - char *s = lua_getstring(lua_getparam(1)); - if (s == NULL) s = "(no message)"; - lua_error(s); -} - -static void luaI_assert (void) -{ - lua_Object p = lua_getparam(1); - if (p == LUA_NOOBJECT || lua_isnil(p)) - lua_error("assertion failed!"); -} - -static void luaI_setglobal (void) -{ - lua_Object value = lua_getparam(2); - luaL_arg_check(value != LUA_NOOBJECT, 2, NULL); - lua_pushobject(value); - lua_setglobal(luaL_check_string(1)); - lua_pushobject(value); /* return given value */ -} - -static void luaI_rawsetglobal (void) -{ - lua_Object value = lua_getparam(2); - luaL_arg_check(value != LUA_NOOBJECT, 2, NULL); - lua_pushobject(value); - lua_rawsetglobal(luaL_check_string(1)); - lua_pushobject(value); /* return given value */ -} - -static void luaI_getglobal (void) -{ - lua_pushobject(lua_getglobal(luaL_check_string(1))); -} - -static void luaI_rawgetglobal (void) -{ - lua_pushobject(lua_rawgetglobal(luaL_check_string(1))); -} - -static void luatag (void) -{ - lua_pushnumber(lua_tag(lua_getparam(1))); -} - - -static int getnarg (lua_Object table) -{ - lua_Object temp; - /* temp = table.n */ - lua_pushobject(table); lua_pushstring("n"); temp = lua_gettable(); - return (lua_isnumber(temp) ? lua_getnumber(temp) : MAX_WORD); -} - -static void luaI_call (void) -{ - lua_Object f = lua_getparam(1); - lua_Object arg = lua_getparam(2); - int withtable = (strcmp(luaL_opt_string(3, ""), "pack") == 0); - int narg, i; - luaL_arg_check(lua_isfunction(f), 1, "function expected"); - luaL_arg_check(lua_istable(arg), 2, "table expected"); - narg = getnarg(arg); - /* push arg[1...n] */ - for (i=0; i<narg; i++) { - lua_Object temp; - /* temp = arg[i+1] */ - lua_pushobject(arg); lua_pushnumber(i+1); temp = lua_gettable(); - if (narg == MAX_WORD && lua_isnil(temp)) - break; - lua_pushobject(temp); - } - if (lua_callfunction(f)) - lua_error(NULL); - else if (withtable) - packresults(); - else - passresults(); -} - -static void luaIl_settag (void) -{ - lua_Object o = lua_getparam(1); - luaL_arg_check(lua_istable(o), 1, "table expected"); - lua_pushobject(o); - lua_settag(luaL_check_number(2)); -} - -static void luaIl_newtag (void) -{ - lua_pushnumber(lua_newtag()); -} - -static void rawgettable (void) -{ - lua_Object t = lua_getparam(1); - lua_Object i = lua_getparam(2); - luaL_arg_check(t != LUA_NOOBJECT, 1, NULL); - luaL_arg_check(i != LUA_NOOBJECT, 2, NULL); - lua_pushobject(t); - lua_pushobject(i); - lua_pushobject(lua_rawgettable()); -} - -static void rawsettable (void) -{ - lua_Object t = lua_getparam(1); - lua_Object i = lua_getparam(2); - lua_Object v = lua_getparam(3); - luaL_arg_check(t != LUA_NOOBJECT && i != LUA_NOOBJECT && v != LUA_NOOBJECT, - 0, NULL); - lua_pushobject(t); - lua_pushobject(i); - lua_pushobject(v); - lua_rawsettable(); -} - - -static void luaI_collectgarbage (void) -{ - lua_pushnumber(lua_collectgarbage(luaL_opt_number(1, 0))); -} - - -/* -** Internal functions -*/ -static struct { - char *name; - lua_CFunction func; -} int_funcs[] = { - {"assert", luaI_assert}, - {"call", luaI_call}, - {"collectgarbage", luaI_collectgarbage}, - {"dofile", lua_internaldofile}, - {"dostring", lua_internaldostring}, - {"error", luaI_error}, - {"getglobal", luaI_getglobal}, - {"newtag", luaIl_newtag}, - {"next", lua_next}, - {"nextvar", luaI_nextvar}, - {"print", luaI_print}, - {"rawgetglobal", luaI_rawgetglobal}, - {"rawgettable", rawgettable}, - {"rawsetglobal", luaI_rawsetglobal}, - {"rawsettable", rawsettable}, - {"seterrormethod", luaI_seterrormethod}, -#if LUA_COMPAT2_5 - {"setfallback", luaI_setfallback}, -#endif - {"setglobal", luaI_setglobal}, - {"settagmethod", luaI_settagmethod}, - {"gettagmethod", luaI_gettagmethod}, - {"settag", luaIl_settag}, - {"tonumber", lua_obj2number}, - {"tostring", luaI_tostring}, - {"tag", luatag}, - {"type", luaI_type} -}; - -#define INTFUNCSIZE (sizeof(int_funcs)/sizeof(int_funcs[0])) - - -void luaI_predefine (void) -{ - int i; - Word n; - for (i=0; i<INTFUNCSIZE; i++) { - n = luaI_findsymbolbyname(int_funcs[i].name); - s_ttype(n) = LUA_T_CFUNCTION; s_fvalue(n) = int_funcs[i].func; - } - n = luaI_findsymbolbyname("_VERSION"); - s_ttype(n) = LUA_T_STRING; s_tsvalue(n) = lua_createstring(LUA_VERSION); -} - - diff --git a/src/inout.h b/src/inout.h deleted file mode 100644 index b2fb2cd2..00000000 --- a/src/inout.h +++ /dev/null @@ -1,25 +0,0 @@ -/* -** $Id: inout.h,v 1.20 1997/06/19 18:04:34 roberto Exp $ -*/ - - -#ifndef inout_h -#define inout_h - -#include "types.h" -#include <stdio.h> - - -extern Word lua_linenumber; -extern Word lua_debugline; -extern char *lua_parsedfile; - -void luaI_setparsedfile (char *name); - -void luaI_predefine (void); - -int lua_dobuffer (char *buff, int size); -int lua_doFILE (FILE *f, int bin); - - -#endif diff --git a/src/lapi.c b/src/lapi.c new file mode 100644 index 00000000..9db0278c --- /dev/null +++ b/src/lapi.c @@ -0,0 +1,631 @@ +/* +** $Id: lapi.c,v 1.25 1998/06/05 22:17:44 roberto Exp $ +** Lua API +** See Copyright Notice in lua.h +*/ + + +#include <stdlib.h> +#include <string.h> + +#include "lapi.h" +#include "lauxlib.h" +#include "ldo.h" +#include "lfunc.h" +#include "lgc.h" +#include "lmem.h" +#include "lobject.h" +#include "lstate.h" +#include "lstring.h" +#include "ltable.h" +#include "ltm.h" +#include "lua.h" +#include "luadebug.h" +#include "lvm.h" + + +char lua_ident[] = "$Lua: " LUA_VERSION " " LUA_COPYRIGHT " $\n" + "$Autores: " LUA_AUTHORS " $"; + + + +TObject *luaA_Address (lua_Object o) +{ + return Address(o); +} + + +static int normalized_type (TObject *o) +{ + int t = ttype(o); + switch (t) { + case LUA_T_PMARK: + return LUA_T_PROTO; + case LUA_T_CMARK: + return LUA_T_CPROTO; + case LUA_T_CLMARK: + return LUA_T_CLOSURE; + default: + return t; + } +} + + +static void set_normalized (TObject *d, TObject *s) +{ + d->value = s->value; + d->ttype = normalized_type(s); +} + + +static TObject *luaA_protovalue (TObject *o) +{ + return (normalized_type(o) == LUA_T_CLOSURE) ? protovalue(o) : o; +} + + +void luaA_packresults (void) +{ + luaV_pack(L->Cstack.lua2C, L->Cstack.num, L->stack.top); + incr_top; +} + + +int luaA_passresults (void) +{ + luaD_checkstack(L->Cstack.num); + memcpy(L->stack.top, L->Cstack.lua2C+L->stack.stack, + L->Cstack.num*sizeof(TObject)); + L->stack.top += L->Cstack.num; + return L->Cstack.num; +} + + +static void checkCparams (int nParams) +{ + if (L->stack.top-L->stack.stack < L->Cstack.base+nParams) + lua_error("API error - wrong number of arguments in C2lua stack"); +} + + +static lua_Object put_luaObject (TObject *o) +{ + luaD_openstack((L->stack.top-L->stack.stack)-L->Cstack.base); + L->stack.stack[L->Cstack.base++] = *o; + return L->Cstack.base; /* this is +1 real position (see Ref) */ +} + + +static lua_Object put_luaObjectonTop (void) +{ + luaD_openstack((L->stack.top-L->stack.stack)-L->Cstack.base); + L->stack.stack[L->Cstack.base++] = *(--L->stack.top); + return L->Cstack.base; /* this is +1 real position (see Ref) */ +} + + +lua_Object lua_pop (void) +{ + checkCparams(1); + return put_luaObjectonTop(); +} + + +/* +** Get a parameter, returning the object handle or LUA_NOOBJECT on error. +** 'number' must be 1 to get the first parameter. +*/ +lua_Object lua_lua2C (int number) +{ + if (number <= 0 || number > L->Cstack.num) return LUA_NOOBJECT; + /* Ref(L->stack.stack+(L->Cstack.lua2C+number-1)) == + L->stack.stack+(L->Cstack.lua2C+number-1)-L->stack.stack+1 == */ + return L->Cstack.lua2C+number; +} + + +int lua_callfunction (lua_Object function) +{ + if (function == LUA_NOOBJECT) + return 1; + else { + luaD_openstack((L->stack.top-L->stack.stack)-L->Cstack.base); + set_normalized(L->stack.stack+L->Cstack.base, Address(function)); + return luaD_protectedrun(MULT_RET); + } +} + + +lua_Object lua_gettagmethod (int tag, char *event) +{ + return put_luaObject(luaT_gettagmethod(tag, event)); +} + + +lua_Object lua_settagmethod (int tag, char *event) +{ + checkCparams(1); + luaT_settagmethod(tag, event, L->stack.top-1); + return put_luaObjectonTop(); +} + + +lua_Object lua_seterrormethod (void) +{ + TObject temp = L->errorim; + checkCparams(1); + L->errorim = *(--L->stack.top); + return put_luaObject(&temp); +} + + +lua_Object lua_gettable (void) +{ + checkCparams(2); + luaV_gettable(); + return put_luaObjectonTop(); +} + + +lua_Object lua_rawgettable (void) +{ + checkCparams(2); + if (ttype(L->stack.top-2) != LUA_T_ARRAY) + lua_error("indexed expression not a table in rawgettable"); + else { + TObject *h = luaH_get(avalue(L->stack.top-2), L->stack.top-1); + --L->stack.top; + if (h != NULL) + *(L->stack.top-1) = *h; + else + ttype(L->stack.top-1) = LUA_T_NIL; + } + return put_luaObjectonTop(); +} + + +void lua_settable (void) +{ + checkCparams(3); + luaV_settable(L->stack.top-3, 1); +} + + +void lua_rawsettable (void) +{ + checkCparams(3); + luaV_settable(L->stack.top-3, 0); +} + + +lua_Object lua_createtable (void) +{ + TObject o; + luaC_checkGC(); + avalue(&o) = luaH_new(0); + ttype(&o) = LUA_T_ARRAY; + return put_luaObject(&o); +} + + +lua_Object lua_getglobal (char *name) +{ + luaD_checkstack(2); /* may need that to call T.M. */ + luaV_getglobal(luaS_new(name)); + return put_luaObjectonTop(); +} + + +lua_Object lua_rawgetglobal (char *name) +{ + TaggedString *ts = luaS_new(name); + return put_luaObject(&ts->u.s.globalval); +} + + +void lua_setglobal (char *name) +{ + checkCparams(1); + luaD_checkstack(2); /* may need that to call T.M. */ + luaV_setglobal(luaS_new(name)); +} + + +void lua_rawsetglobal (char *name) +{ + TaggedString *ts = luaS_new(name); + checkCparams(1); + luaS_rawsetglobal(ts, --L->stack.top); +} + + + +int lua_isnil (lua_Object o) +{ + return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_NIL); +} + +int lua_istable (lua_Object o) +{ + return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_ARRAY); +} + +int lua_isuserdata (lua_Object o) +{ + return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_USERDATA); +} + +int lua_iscfunction (lua_Object o) +{ + return (lua_tag(o) == LUA_T_CPROTO); +} + +int lua_isnumber (lua_Object o) +{ + return (o!= LUA_NOOBJECT) && (tonumber(Address(o)) == 0); +} + +int lua_isstring (lua_Object o) +{ + int t = lua_tag(o); + return (t == LUA_T_STRING) || (t == LUA_T_NUMBER); +} + +int lua_isfunction (lua_Object o) +{ + int t = lua_tag(o); + return (t == LUA_T_PROTO) || (t == LUA_T_CPROTO); +} + + +double lua_getnumber (lua_Object object) +{ + if (object == LUA_NOOBJECT) return 0.0; + if (tonumber(Address(object))) return 0.0; + else return (nvalue(Address(object))); +} + +char *lua_getstring (lua_Object object) +{ + luaC_checkGC(); /* "tostring" may create a new string */ + if (object == LUA_NOOBJECT || tostring(Address(object))) + return NULL; + else return (svalue(Address(object))); +} + +long lua_strlen (lua_Object object) +{ + luaC_checkGC(); /* "tostring" may create a new string */ + if (object == LUA_NOOBJECT || tostring(Address(object))) + return 0L; + else return (tsvalue(Address(object))->u.s.len); +} + +void *lua_getuserdata (lua_Object object) +{ + if (object == LUA_NOOBJECT || ttype(Address(object)) != LUA_T_USERDATA) + return NULL; + else return tsvalue(Address(object))->u.d.v; +} + +lua_CFunction lua_getcfunction (lua_Object object) +{ + if (!lua_iscfunction(object)) + return NULL; + else return fvalue(luaA_protovalue(Address(object))); +} + + +void lua_pushnil (void) +{ + ttype(L->stack.top) = LUA_T_NIL; + incr_top; +} + +void lua_pushnumber (double n) +{ + ttype(L->stack.top) = LUA_T_NUMBER; + nvalue(L->stack.top) = n; + incr_top; +} + +void lua_pushlstring (char *s, long len) +{ + tsvalue(L->stack.top) = luaS_newlstr(s, len); + ttype(L->stack.top) = LUA_T_STRING; + incr_top; + luaC_checkGC(); +} + +void lua_pushstring (char *s) +{ + if (s == NULL) + lua_pushnil(); + else + lua_pushlstring(s, strlen(s)); +} + +void lua_pushcclosure (lua_CFunction fn, int n) +{ + if (fn == NULL) + lua_error("API error - attempt to push a NULL Cfunction"); + checkCparams(n); + ttype(L->stack.top) = LUA_T_CPROTO; + fvalue(L->stack.top) = fn; + incr_top; + luaV_closure(n); + luaC_checkGC(); +} + +void lua_pushusertag (void *u, int tag) +{ + if (tag < 0 && tag != LUA_ANYTAG) + luaT_realtag(tag); /* error if tag is not valid */ + tsvalue(L->stack.top) = luaS_createudata(u, tag); + ttype(L->stack.top) = LUA_T_USERDATA; + incr_top; + luaC_checkGC(); +} + +void luaA_pushobject (TObject *o) +{ + *L->stack.top = *o; + incr_top; +} + +void lua_pushobject (lua_Object o) +{ + if (o == LUA_NOOBJECT) + lua_error("API error - attempt to push a NOOBJECT"); + else { + set_normalized(L->stack.top, Address(o)); + incr_top; + } +} + + +int lua_tag (lua_Object lo) +{ + if (lo == LUA_NOOBJECT) + return LUA_T_NIL; + else { + TObject *o = Address(lo); + int t; + switch (t = ttype(o)) { + case LUA_T_USERDATA: + return o->value.ts->u.d.tag; + case LUA_T_ARRAY: + return o->value.a->htag; + case LUA_T_PMARK: + return LUA_T_PROTO; + case LUA_T_CMARK: + return LUA_T_CPROTO; + case LUA_T_CLOSURE: case LUA_T_CLMARK: + return o->value.cl->consts[0].ttype; +#ifdef DEBUG + case LUA_T_LINE: + LUA_INTERNALERROR("invalid type"); +#endif + default: + return t; + } + } +} + + +void lua_settag (int tag) +{ + checkCparams(1); + luaT_realtag(tag); + switch (ttype(L->stack.top-1)) { + case LUA_T_ARRAY: + (L->stack.top-1)->value.a->htag = tag; + break; + case LUA_T_USERDATA: + (L->stack.top-1)->value.ts->u.d.tag = tag; + break; + default: + luaL_verror("cannot change the tag of a %.20s", + luaO_typenames[-ttype((L->stack.top-1))]); + } + L->stack.top--; +} + + +/* +** ======================================================= +** Debug interface +** ======================================================= +*/ + + +/* Hooks */ +lua_CHFunction lua_callhook = NULL; +lua_LHFunction lua_linehook = NULL; + + +lua_Function lua_stackedfunction (int level) +{ + StkId i; + for (i = (L->stack.top-1)-L->stack.stack; i>=0; i--) { + int t = L->stack.stack[i].ttype; + if (t == LUA_T_CLMARK || t == LUA_T_PMARK || t == LUA_T_CMARK) + if (level-- == 0) + return Ref(L->stack.stack+i); + } + return LUA_NOOBJECT; +} + + +int lua_currentline (lua_Function func) +{ + TObject *f = Address(func); + return (f+1 < L->stack.top && (f+1)->ttype == LUA_T_LINE) ? + (f+1)->value.i : -1; +} + + +lua_Object lua_getlocal (lua_Function func, int local_number, char **name) +{ + /* check whether func is a Lua function */ + if (lua_tag(func) != LUA_T_PROTO) + return LUA_NOOBJECT; + else { + TObject *f = Address(func); + TProtoFunc *fp = luaA_protovalue(f)->value.tf; + *name = luaF_getlocalname(fp, local_number, lua_currentline(func)); + if (*name) { + /* if "*name", there must be a LUA_T_LINE */ + /* therefore, f+2 points to function base */ + return Ref((f+2)+(local_number-1)); + } + else + return LUA_NOOBJECT; + } +} + + +int lua_setlocal (lua_Function func, int local_number) +{ + /* check whether func is a Lua function */ + if (lua_tag(func) != LUA_T_PROTO) + return 0; + else { + TObject *f = Address(func); + TProtoFunc *fp = luaA_protovalue(f)->value.tf; + char *name = luaF_getlocalname(fp, local_number, lua_currentline(func)); + checkCparams(1); + --L->stack.top; + if (name) { + /* if "name", there must be a LUA_T_LINE */ + /* therefore, f+2 points to function base */ + *((f+2)+(local_number-1)) = *L->stack.top; + return 1; + } + else + return 0; + } +} + + +void lua_funcinfo (lua_Object func, char **filename, int *linedefined) +{ + if (!lua_isfunction(func)) + lua_error("API - `funcinfo' called with a non-function value"); + else { + TObject *f = luaA_protovalue(Address(func)); + if (normalized_type(f) == LUA_T_PROTO) { + *filename = tfvalue(f)->fileName->str; + *linedefined = tfvalue(f)->lineDefined; + } + else { + *filename = "(C)"; + *linedefined = -1; + } + } +} + + +static int checkfunc (TObject *o) +{ + return luaO_equalObj(o, L->stack.top); +} + + +char *lua_getobjname (lua_Object o, char **name) +{ /* try to find a name for given function */ + set_normalized(L->stack.top, Address(o)); /* to be accessed by "checkfunc */ + if ((*name = luaT_travtagmethods(checkfunc)) != NULL) + return "tag-method"; + else if ((*name = luaS_travsymbol(checkfunc)) != NULL) + return "global"; + else return ""; +} + +/* +** ======================================================= +** BLOCK mechanism +** ======================================================= +*/ + + +void lua_beginblock (void) +{ + if (L->numCblocks >= MAX_C_BLOCKS) + lua_error("too many nested blocks"); + L->Cblocks[L->numCblocks] = L->Cstack; + L->numCblocks++; +} + +void lua_endblock (void) +{ + --L->numCblocks; + L->Cstack = L->Cblocks[L->numCblocks]; + luaD_adjusttop(L->Cstack.base); +} + + + +int lua_ref (int lock) +{ + int ref; + checkCparams(1); + ref = luaC_ref(L->stack.top-1, lock); + L->stack.top--; + return ref; +} + + + +lua_Object lua_getref (int ref) +{ + TObject *o = luaC_getref(ref); + return (o ? put_luaObject(o) : LUA_NOOBJECT); +} + + +/* +** ======================================================= +** Derived functions +** ======================================================= +*/ +int (lua_call) (char *name) { return lua_call(name); } + +void (lua_pushref) (int ref) { lua_pushref(ref); } + +int (lua_refobject) (lua_Object o, int l) { return lua_refobject(o, l); } + +void (lua_register) (char *n, lua_CFunction f) { lua_register(n, f); } + +void (lua_pushuserdata) (void *u) { lua_pushuserdata(u); } + +void (lua_pushcfunction) (lua_CFunction f) { lua_pushcfunction(f); } + +int (lua_clonetag) (int t) { return lua_clonetag(t); } + + + + +#ifdef LUA_COMPAT2_5 +/* +** API: set a function as a fallback +*/ + +static void do_unprotectedrun (lua_CFunction f, int nParams, int nResults) +{ + StkId base = (L->stack.top-L->stack.stack)-nParams; + luaD_openstack(nParams); + L->stack.stack[base].ttype = LUA_T_CPROTO; + L->stack.stack[base].value.f = f; + luaD_call(base+1, nResults); +} + +lua_Object lua_setfallback (char *name, lua_CFunction fallback) +{ + lua_pushstring(name); + lua_pushcfunction(fallback); + do_unprotectedrun(luaT_setfallback, 2, 1); + return put_luaObjectonTop(); +} +#endif + diff --git a/src/lapi.h b/src/lapi.h new file mode 100644 index 00000000..ca9a1173 --- /dev/null +++ b/src/lapi.h @@ -0,0 +1,20 @@ +/* +** $Id: lapi.h,v 1.2 1998/06/19 16:14:09 roberto Exp $ +** Auxiliary functions from Lua API +** See Copyright Notice in lua.h +*/ + +#ifndef lapi_h +#define lapi_h + + +#include "lua.h" +#include "lobject.h" + + +TObject *luaA_Address (lua_Object o); +void luaA_pushobject (TObject *o); +void luaA_packresults (void); +int luaA_passresults (void); + +#endif diff --git a/src/lauxlib.c b/src/lauxlib.c new file mode 100644 index 00000000..0a972af0 --- /dev/null +++ b/src/lauxlib.c @@ -0,0 +1,111 @@ +/* +** $Id: lauxlib.c,v 1.12 1998/06/19 16:14:09 roberto Exp $ +** Auxiliary functions for building Lua libraries +** See Copyright Notice in lua.h +*/ + + +#include <stdarg.h> +#include <stdio.h> +#include <string.h> + +/* Please Notice: 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. +*/ +#include "lauxlib.h" +#include "lua.h" +#include "luadebug.h" + + + +int luaL_findstring (char *name, char *list[]) { + int i; + for (i=0; list[i]; i++) + if (strcmp(list[i], name) == 0) + return i; + return -1; /* name not found */ +} + +void luaL_argerror (int numarg, char *extramsg) +{ + char *funcname; + lua_getobjname(lua_stackedfunction(0), &funcname); + if (funcname == NULL) + funcname = "???"; + if (extramsg == NULL) + luaL_verror("bad argument #%d to function `%.50s'", numarg, funcname); + else + luaL_verror("bad argument #%d to function `%.50s' (%.100s)", + numarg, funcname, extramsg); +} + +char *luaL_check_lstr (int numArg, long *len) +{ + lua_Object o = lua_getparam(numArg); + luaL_arg_check(lua_isstring(o), numArg, "string expected"); + if (len) *len = lua_strlen(o); + return lua_getstring(o); +} + +char *luaL_opt_lstr (int numArg, char *def, long *len) +{ + return (lua_getparam(numArg) == LUA_NOOBJECT) ? def : + luaL_check_lstr(numArg, len); +} + +double luaL_check_number (int numArg) +{ + lua_Object o = lua_getparam(numArg); + luaL_arg_check(lua_isnumber(o), numArg, "number expected"); + return lua_getnumber(o); +} + + +double luaL_opt_number (int numArg, double def) +{ + return (lua_getparam(numArg) == LUA_NOOBJECT) ? def : + luaL_check_number(numArg); +} + + +lua_Object luaL_tablearg (int arg) +{ + lua_Object o = lua_getparam(arg); + luaL_arg_check(lua_istable(o), arg, "table expected"); + return o; +} + +lua_Object luaL_functionarg (int arg) +{ + lua_Object o = lua_getparam(arg); + luaL_arg_check(lua_isfunction(o), arg, "function expected"); + return o; +} + +lua_Object luaL_nonnullarg (int numArg) +{ + lua_Object o = lua_getparam(numArg); + luaL_arg_check(o != LUA_NOOBJECT, numArg, "value expected"); + return o; +} + +void luaL_openlib (struct luaL_reg *l, int n) +{ + int i; + lua_open(); /* make sure lua is already open */ + for (i=0; i<n; i++) + lua_register(l[i].name, l[i].func); +} + + +void luaL_verror (char *fmt, ...) +{ + char buff[500]; + va_list argp; + va_start(argp, fmt); + vsprintf(buff, fmt, argp); + va_end(argp); + lua_error(buff); +} + diff --git a/src/lbuffer.c b/src/lbuffer.c new file mode 100644 index 00000000..d298b13a --- /dev/null +++ b/src/lbuffer.c @@ -0,0 +1,85 @@ +/* +** $Id: lbuffer.c,v 1.4 1998/06/19 16:14:09 roberto Exp $ +** Auxiliary functions for building Lua libraries +** See Copyright Notice in lua.h +*/ + + +#include <stdio.h> + +#include "lauxlib.h" +#include "lmem.h" +#include "lstate.h" + + +/*------------------------------------------------------- +** Auxiliary buffer +-------------------------------------------------------*/ + +#define BUFF_STEP 32 + +#define openspace(size) if (L->Mbuffnext+(size) > L->Mbuffsize) Openspace(size) + +static void Openspace (int size) +{ + lua_State *l = L; /* to optimize */ + int base = l->Mbuffbase-l->Mbuffer; + l->Mbuffsize *= 2; + if (l->Mbuffnext+size > l->Mbuffsize) /* still not big enough? */ + l->Mbuffsize = l->Mbuffnext+size; + l->Mbuffer = luaM_realloc(l->Mbuffer, l->Mbuffsize); + l->Mbuffbase = l->Mbuffer+base; +} + + +char *luaL_openspace (int size) +{ + openspace(size); + return L->Mbuffer+L->Mbuffnext; +} + + +void luaL_addchar (int c) +{ + openspace(BUFF_STEP); + L->Mbuffer[L->Mbuffnext++] = c; +} + + +void luaL_resetbuffer (void) +{ + L->Mbuffnext = L->Mbuffbase-L->Mbuffer; +} + + +void luaL_addsize (int n) +{ + L->Mbuffnext += n; +} + +int luaL_getsize (void) +{ + return L->Mbuffnext-(L->Mbuffbase-L->Mbuffer); +} + +int luaL_newbuffer (int size) +{ + int old = L->Mbuffbase-L->Mbuffer; + openspace(size); + L->Mbuffbase = L->Mbuffer+L->Mbuffnext; + return old; +} + + +void luaL_oldbuffer (int old) +{ + L->Mbuffnext = L->Mbuffbase-L->Mbuffer; + L->Mbuffbase = L->Mbuffer+old; +} + + +char *luaL_buffer (void) +{ + return L->Mbuffbase; +} + diff --git a/src/lbuiltin.c b/src/lbuiltin.c new file mode 100644 index 00000000..0fd39f70 --- /dev/null +++ b/src/lbuiltin.c @@ -0,0 +1,526 @@ +/* +** $Id: lbuiltin.c,v 1.32 1998/06/29 18:24:06 roberto Exp $ +** Built-in functions +** See Copyright Notice in lua.h +*/ + + +#include <ctype.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> + +#include "lapi.h" +#include "lauxlib.h" +#include "lbuiltin.h" +#include "ldo.h" +#include "lfunc.h" +#include "lmem.h" +#include "lobject.h" +#include "lstate.h" +#include "lstring.h" +#include "ltable.h" +#include "ltm.h" +#include "lua.h" +#include "lundump.h" + + + +static void pushstring (TaggedString *s) +{ + TObject o; + o.ttype = LUA_T_STRING; + o.value.ts = s; + luaA_pushobject(&o); +} + + +static void nextvar (void) +{ + TObject *o = luaA_Address(luaL_nonnullarg(1)); + TaggedString *g; + if (ttype(o) == LUA_T_NIL) + g = (TaggedString *)L->rootglobal.next; + else { + luaL_arg_check(ttype(o) == LUA_T_STRING, 1, "variable name expected"); + g = tsvalue(o); + /* check whether name is in global var list */ + luaL_arg_check((GCnode *)g != g->head.next, 1, "variable name expected"); + g = (TaggedString *)g->head.next; + } + while (g && g->u.s.globalval.ttype == LUA_T_NIL) /* skip globals with nil */ + g = (TaggedString *)g->head.next; + if (g) { + pushstring(g); + luaA_pushobject(&g->u.s.globalval); + } + else lua_pushnil(); +} + + +static void foreachvar (void) +{ + TObject f = *luaA_Address(luaL_functionarg(1)); + GCnode *g; + StkId name = L->Cstack.base++; /* place to keep var name (to avoid GC) */ + ttype(L->stack.stack+name) = LUA_T_NIL; + L->stack.top++; + for (g = L->rootglobal.next; g; g = g->next) { + TaggedString *s = (TaggedString *)g; + if (s->u.s.globalval.ttype != LUA_T_NIL) { + ttype(L->stack.stack+name) = LUA_T_STRING; + tsvalue(L->stack.stack+name) = s; /* keep s on stack to avoid GC */ + luaA_pushobject(&f); + pushstring(s); + luaA_pushobject(&s->u.s.globalval); + luaD_call((L->stack.top-L->stack.stack)-2, 1); + if (ttype(L->stack.top-1) != LUA_T_NIL) + return; + L->stack.top--; + } + } +} + + +static void next (void) +{ + lua_Object o = luaL_tablearg(1); + lua_Object r = luaL_nonnullarg(2); + Node *n = luaH_next(luaA_Address(o), luaA_Address(r)); + if (n) { + luaA_pushobject(&n->ref); + luaA_pushobject(&n->val); + } + else lua_pushnil(); +} + + +static void foreach (void) +{ + TObject t = *luaA_Address(luaL_tablearg(1)); + TObject f = *luaA_Address(luaL_functionarg(2)); + int i; + for (i=0; i<avalue(&t)->nhash; i++) { + Node *nd = &(avalue(&t)->node[i]); + if (ttype(ref(nd)) != LUA_T_NIL && ttype(val(nd)) != LUA_T_NIL) { + luaA_pushobject(&f); + luaA_pushobject(ref(nd)); + luaA_pushobject(val(nd)); + luaD_call((L->stack.top-L->stack.stack)-2, 1); + if (ttype(L->stack.top-1) != LUA_T_NIL) + return; + L->stack.top--; + } + } +} + + +static void internaldostring (void) +{ + long l; + char *s = luaL_check_lstr(1, &l); + if (*s == ID_CHUNK) + lua_error("`dostring' cannot run pre-compiled code"); + if (lua_dobuffer(s, l, luaL_opt_string(2, NULL)) == 0) + if (luaA_passresults() == 0) + lua_pushuserdata(NULL); /* at least one result to signal no errors */ +} + + +static void internaldofile (void) +{ + char *fname = luaL_opt_string(1, NULL); + if (lua_dofile(fname) == 0) + if (luaA_passresults() == 0) + lua_pushuserdata(NULL); /* at least one result to signal no errors */ +} + + +static void to_string (void) { + lua_Object obj = lua_getparam(1); + char *buff = luaL_openspace(30); + TObject *o = luaA_Address(obj); + switch (ttype(o)) { + case LUA_T_NUMBER: + lua_pushstring(lua_getstring(obj)); + return; + case LUA_T_STRING: + lua_pushobject(obj); + return; + case LUA_T_ARRAY: { + sprintf(buff, "table: %p", (void *)o->value.a); + break; + } + case LUA_T_CLOSURE: { + sprintf(buff, "function: %p", (void *)o->value.cl); + break; + } + case LUA_T_PROTO: { + sprintf(buff, "function: %p", (void *)o->value.tf); + break; + } + case LUA_T_CPROTO: { + sprintf(buff, "function: %p", (void *)o->value.f); + break; + } + case LUA_T_USERDATA: { + sprintf(buff, "userdata: %p", o->value.ts->u.d.v); + break; + } + case LUA_T_NIL: + lua_pushstring("nil"); + return; + default: + LUA_INTERNALERROR("invalid type"); + } + lua_pushstring(buff); +} + + +static void luaI_print (void) { + TaggedString *ts = luaS_new("tostring"); + lua_Object obj; + int i = 1; + while ((obj = lua_getparam(i++)) != LUA_NOOBJECT) { + luaA_pushobject(&ts->u.s.globalval); + lua_pushobject(obj); + luaD_call((L->stack.top-L->stack.stack)-1, 1); + if (ttype(L->stack.top-1) != LUA_T_STRING) + lua_error("`tostring' must return a string to `print'"); + printf("%s\t", svalue(L->stack.top-1)); + L->stack.top--; + } + printf("\n"); +} + + +static void luaI_type (void) +{ + lua_Object o = luaL_nonnullarg(1); + lua_pushstring(luaO_typenames[-ttype(luaA_Address(o))]); + lua_pushnumber(lua_tag(o)); +} + + +static void tonumber (void) +{ + int base = luaL_opt_number(2, 10); + if (base == 10) { /* standard conversion */ + lua_Object o = lua_getparam(1); + if (lua_isnumber(o)) + lua_pushnumber(lua_getnumber(o)); + } + else { + char *s = luaL_check_string(1); + unsigned long n; + luaL_arg_check(0 <= base && base <= 36, 2, "base out of range"); + n = strtol(s, &s, base); + while (isspace(*s)) s++; /* skip trailing spaces */ + if (*s) lua_pushnil(); /* invalid format: return nil */ + else lua_pushnumber(n); + } +} + + +static void luaI_error (void) +{ + lua_error(lua_getstring(lua_getparam(1))); +} + + +static void luaI_assert (void) +{ + lua_Object p = lua_getparam(1); + if (p == LUA_NOOBJECT || lua_isnil(p)) + luaL_verror("assertion failed! %.100s", luaL_opt_string(2, "")); +} + + +static void setglobal (void) +{ + char *n = luaL_check_string(1); + lua_Object value = luaL_nonnullarg(2); + lua_pushobject(value); + lua_setglobal(n); + lua_pushobject(value); /* return given value */ +} + +static void rawsetglobal (void) +{ + char *n = luaL_check_string(1); + lua_Object value = luaL_nonnullarg(2); + lua_pushobject(value); + lua_rawsetglobal(n); + lua_pushobject(value); /* return given value */ +} + +static void getglobal (void) +{ + lua_pushobject(lua_getglobal(luaL_check_string(1))); +} + +static void rawgetglobal (void) +{ + lua_pushobject(lua_rawgetglobal(luaL_check_string(1))); +} + +static void luatag (void) +{ + lua_pushnumber(lua_tag(lua_getparam(1))); +} + + +static int getnarg (lua_Object table) +{ + lua_Object temp; + /* temp = table.n */ + lua_pushobject(table); lua_pushstring("n"); temp = lua_rawgettable(); + return (lua_isnumber(temp) ? lua_getnumber(temp) : MAX_INT); +} + +static void luaI_call (void) +{ + lua_Object f = luaL_nonnullarg(1); + lua_Object arg = luaL_tablearg(2); + char *options = luaL_opt_string(3, ""); + lua_Object err = lua_getparam(4); + int narg = getnarg(arg); + int i, status; + if (err != LUA_NOOBJECT) { /* set new error method */ + lua_pushobject(err); + err = lua_seterrormethod(); + } + /* push arg[1...n] */ + for (i=0; i<narg; i++) { + lua_Object temp; + /* temp = arg[i+1] */ + lua_pushobject(arg); lua_pushnumber(i+1); temp = lua_rawgettable(); + if (narg == MAX_INT && lua_isnil(temp)) + break; + lua_pushobject(temp); + } + status = lua_callfunction(f); + if (err != LUA_NOOBJECT) { /* restore old error method */ + lua_pushobject(err); + lua_seterrormethod(); + } + if (status != 0) { /* error in call? */ + if (strchr(options, 'x')) { + lua_pushnil(); + return; /* return nil to signal the error */ + } + else + lua_error(NULL); + } + else { /* no errors */ + if (strchr(options, 'p')) + luaA_packresults(); + else + luaA_passresults(); + } +} + + +static void settag (void) +{ + lua_Object o = luaL_tablearg(1); + lua_pushobject(o); + lua_settag(luaL_check_number(2)); + lua_pushobject(o); /* returns first argument */ +} + + +static void newtag (void) +{ + lua_pushnumber(lua_newtag()); +} + + +static void copytagmethods (void) +{ + lua_pushnumber(lua_copytagmethods(luaL_check_number(1), + luaL_check_number(2))); +} + + +static void rawgettable (void) +{ + lua_pushobject(luaL_nonnullarg(1)); + lua_pushobject(luaL_nonnullarg(2)); + lua_pushobject(lua_rawgettable()); +} + + +static void rawsettable (void) +{ + lua_pushobject(luaL_nonnullarg(1)); + lua_pushobject(luaL_nonnullarg(2)); + lua_pushobject(luaL_nonnullarg(3)); + lua_rawsettable(); +} + + +static void settagmethod (void) +{ + lua_Object nf = luaL_nonnullarg(3); + lua_pushobject(nf); + lua_pushobject(lua_settagmethod((int)luaL_check_number(1), + luaL_check_string(2))); +} + + +static void gettagmethod (void) +{ + lua_pushobject(lua_gettagmethod((int)luaL_check_number(1), + luaL_check_string(2))); +} + + +static void seterrormethod (void) +{ + lua_Object nf = luaL_functionarg(1); + lua_pushobject(nf); + lua_pushobject(lua_seterrormethod()); +} + + +static void luaI_collectgarbage (void) +{ + lua_pushnumber(lua_collectgarbage(luaL_opt_number(1, 0))); +} + + +/* +** ======================================================= +** some DEBUG functions +** ======================================================= +*/ +#ifdef DEBUG + +static void mem_query (void) +{ + lua_pushnumber(totalmem); + lua_pushnumber(numblocks); +} + + +static void countlist (void) +{ + char *s = luaL_check_string(1); + GCnode *l = (s[0]=='t') ? L->roottable.next : (s[0]=='c') ? L->rootcl.next : + (s[0]=='p') ? L->rootproto.next : L->rootglobal.next; + int i=0; + while (l) { + i++; + l = l->next; + } + lua_pushnumber(i); +} + + +static void testC (void) +{ +#define getnum(s) ((*s++) - '0') +#define getname(s) (nome[0] = *s++, nome) + + static int locks[10]; + lua_Object reg[10]; + char nome[2]; + char *s = luaL_check_string(1); + nome[1] = 0; + while (1) { + switch (*s++) { + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + lua_pushnumber(*(s-1) - '0'); + break; + + case 'c': reg[getnum(s)] = lua_createtable(); break; + case 'C': { lua_CFunction f = lua_getcfunction(lua_getglobal(getname(s))); + lua_pushcclosure(f, getnum(s)); + break; + } + case 'P': reg[getnum(s)] = lua_pop(); break; + case 'g': { int n=getnum(s); reg[n]=lua_getglobal(getname(s)); break; } + case 'G': { int n = getnum(s); + reg[n] = lua_rawgetglobal(getname(s)); + break; + } + case 'l': locks[getnum(s)] = lua_ref(1); break; + case 'L': locks[getnum(s)] = lua_ref(0); break; + case 'r': { int n=getnum(s); reg[n]=lua_getref(locks[getnum(s)]); break; } + case 'u': lua_unref(locks[getnum(s)]); break; + case 'p': { int n = getnum(s); reg[n] = lua_getparam(getnum(s)); break; } + case '=': lua_setglobal(getname(s)); break; + case 's': lua_pushstring(getname(s)); break; + case 'o': lua_pushobject(reg[getnum(s)]); break; + case 'f': (lua_call)(getname(s)); break; + case 'i': reg[getnum(s)] = lua_gettable(); break; + case 'I': reg[getnum(s)] = lua_rawgettable(); break; + case 't': lua_settable(); break; + case 'T': lua_rawsettable(); break; + default: luaL_verror("unknown command in `testC': %c", *(s-1)); + } + if (*s == 0) return; + if (*s++ != ' ') lua_error("missing ` ' between commands in `testC'"); + } +} + +#endif + + +/* +** Internal functions +*/ +static struct luaL_reg int_funcs[] = { +#ifdef LUA_COMPAT2_5 + {"setfallback", luaT_setfallback}, +#endif +#ifdef DEBUG + {"testC", testC}, + {"totalmem", mem_query}, + {"count", countlist}, +#endif + {"assert", luaI_assert}, + {"call", luaI_call}, + {"collectgarbage", luaI_collectgarbage}, + {"dofile", internaldofile}, + {"copytagmethods", copytagmethods}, + {"dostring", internaldostring}, + {"error", luaI_error}, + {"foreach", foreach}, + {"foreachvar", foreachvar}, + {"getglobal", getglobal}, + {"newtag", newtag}, + {"next", next}, + {"nextvar", nextvar}, + {"print", luaI_print}, + {"rawgetglobal", rawgetglobal}, + {"rawgettable", rawgettable}, + {"rawsetglobal", rawsetglobal}, + {"rawsettable", rawsettable}, + {"seterrormethod", seterrormethod}, + {"setglobal", setglobal}, + {"settagmethod", settagmethod}, + {"gettagmethod", gettagmethod}, + {"settag", settag}, + {"tonumber", tonumber}, + {"tostring", to_string}, + {"tag", luatag}, + {"type", luaI_type} +}; + + +#define INTFUNCSIZE (sizeof(int_funcs)/sizeof(int_funcs[0])) + + +void luaB_predefine (void) +{ + /* pre-register mem error messages, to avoid loop when error arises */ + luaS_newfixedstring(tableEM); + luaS_newfixedstring(memEM); + luaL_openlib(int_funcs, (sizeof(int_funcs)/sizeof(int_funcs[0]))); + lua_pushstring(LUA_VERSION); + lua_setglobal("_VERSION"); +} + diff --git a/src/lbuiltin.h b/src/lbuiltin.h new file mode 100644 index 00000000..bcb11fc0 --- /dev/null +++ b/src/lbuiltin.h @@ -0,0 +1,14 @@ +/* +** $Id: lbuiltin.h,v 1.1 1997/09/16 19:25:59 roberto Exp $ +** Built-in functions +** See Copyright Notice in lua.h +*/ + +#ifndef lbuiltin_h +#define lbuiltin_h + + +void luaB_predefine (void); + + +#endif diff --git a/src/ldo.c b/src/ldo.c new file mode 100644 index 00000000..f7a9f27d --- /dev/null +++ b/src/ldo.c @@ -0,0 +1,427 @@ +/* +** $Id: ldo.c,v 1.27 1998/06/19 18:47:06 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> + +#include "ldo.h" +#include "lfunc.h" +#include "lgc.h" +#include "lmem.h" +#include "lobject.h" +#include "lparser.h" +#include "lstate.h" +#include "ltm.h" +#include "lua.h" +#include "luadebug.h" +#include "lundump.h" +#include "lvm.h" +#include "lzio.h" + + + +#ifndef STACK_LIMIT +#define STACK_LIMIT 6000 +#endif + + + +/* +** Error messages +*/ + +static void stderrorim (void) +{ + fprintf(stderr, "lua error: %s\n", lua_getstring(lua_getparam(1))); +} + + + +#define STACK_UNIT 128 + + +void luaD_init (void) +{ + L->stack.stack = luaM_newvector(STACK_UNIT, TObject); + L->stack.top = L->stack.stack; + L->stack.last = L->stack.stack+(STACK_UNIT-1); + ttype(&L->errorim) = LUA_T_CPROTO; + fvalue(&L->errorim) = stderrorim; +} + + +void luaD_checkstack (int n) +{ + struct Stack *S = &L->stack; + if (S->last-S->top <= n) { + StkId top = S->top-S->stack; + int stacksize = (S->last-S->stack)+1+STACK_UNIT+n; + S->stack = luaM_reallocvector(S->stack, stacksize, TObject); + S->last = S->stack+(stacksize-1); + S->top = S->stack + top; + if (stacksize >= STACK_LIMIT) { /* stack overflow? */ + if (lua_stackedfunction(100) == LUA_NOOBJECT) /* 100 funcs on stack? */ + lua_error("Lua2C - C2Lua overflow"); /* doesn't look like a rec. loop */ + else + lua_error("stack size overflow"); + } + } +} + + +/* +** Adjust stack. Set top to the given value, pushing NILs if needed. +*/ +void luaD_adjusttop (StkId newtop) +{ + int diff = newtop-(L->stack.top-L->stack.stack); + if (diff <= 0) + L->stack.top += diff; + else { + luaD_checkstack(diff); + while (diff--) + ttype(L->stack.top++) = LUA_T_NIL; + } +} + + +/* +** Open a hole below "nelems" from the L->stack.top. +*/ +void luaD_openstack (int nelems) +{ + luaO_memup(L->stack.top-nelems+1, L->stack.top-nelems, + nelems*sizeof(TObject)); + incr_top; +} + + +void luaD_lineHook (int line) +{ + struct C_Lua_Stack oldCLS = L->Cstack; + StkId old_top = L->Cstack.lua2C = L->Cstack.base = L->stack.top-L->stack.stack; + L->Cstack.num = 0; + (*lua_linehook)(line); + L->stack.top = L->stack.stack+old_top; + L->Cstack = oldCLS; +} + + +void luaD_callHook (StkId base, TProtoFunc *tf, int isreturn) +{ + struct C_Lua_Stack oldCLS = L->Cstack; + StkId old_top = L->Cstack.lua2C = L->Cstack.base = L->stack.top-L->stack.stack; + L->Cstack.num = 0; + if (isreturn) + (*lua_callhook)(LUA_NOOBJECT, "(return)", 0); + else { + TObject *f = L->stack.stack+base-1; + if (tf) + (*lua_callhook)(Ref(f), tf->fileName->str, tf->lineDefined); + else + (*lua_callhook)(Ref(f), "(C)", -1); + } + L->stack.top = L->stack.stack+old_top; + L->Cstack = oldCLS; +} + + +/* +** Call a C function. +** Cstack.num is the number of arguments; Cstack.lua2C points to the +** first argument. Returns an index to the first result from C. +*/ +static StkId callC (lua_CFunction f, StkId base) +{ + struct C_Lua_Stack *CS = &L->Cstack; + struct C_Lua_Stack oldCLS = *CS; + StkId firstResult; + int numarg = (L->stack.top-L->stack.stack) - base; + CS->num = numarg; + CS->lua2C = base; + CS->base = base+numarg; /* == top-stack */ + if (lua_callhook) + luaD_callHook(base, NULL, 0); + (*f)(); /* do the actual call */ + if (lua_callhook) /* func may have changed lua_callhook */ + luaD_callHook(base, NULL, 1); + firstResult = CS->base; + *CS = oldCLS; + return firstResult; +} + + +static StkId callCclosure (struct Closure *cl, lua_CFunction f, StkId base) +{ + TObject *pbase; + int nup = cl->nelems; /* number of upvalues */ + luaD_checkstack(nup); + pbase = L->stack.stack+base; /* care: previous call may change this */ + /* open space for upvalues as extra arguments */ + luaO_memup(pbase+nup, pbase, (L->stack.top-pbase)*sizeof(TObject)); + /* copy upvalues into stack */ + memcpy(pbase, cl->consts+1, nup*sizeof(TObject)); + L->stack.top += nup; + return callC(f, base); +} + + +void luaD_callTM (TObject *f, int nParams, int nResults) +{ + luaD_openstack(nParams); + *(L->stack.top-nParams-1) = *f; + luaD_call((L->stack.top-L->stack.stack)-nParams, nResults); +} + + +/* +** Call a function (C or Lua). The parameters must be on the L->stack.stack, +** between [L->stack.stack+base,L->stack.top). The function to be called is at L->stack.stack+base-1. +** When returns, the results are on the L->stack.stack, between [L->stack.stack+base-1,L->stack.top). +** The number of results is nResults, unless nResults=MULT_RET. +*/ +void luaD_call (StkId base, int nResults) +{ + StkId firstResult; + TObject *func = L->stack.stack+base-1; + int i; + switch (ttype(func)) { + case LUA_T_CPROTO: + ttype(func) = LUA_T_CMARK; + firstResult = callC(fvalue(func), base); + break; + case LUA_T_PROTO: + ttype(func) = LUA_T_PMARK; + firstResult = luaV_execute(NULL, tfvalue(func), base); + break; + case LUA_T_CLOSURE: { + Closure *c = clvalue(func); + TObject *proto = &(c->consts[0]); + ttype(func) = LUA_T_CLMARK; + firstResult = (ttype(proto) == LUA_T_CPROTO) ? + callCclosure(c, fvalue(proto), base) : + luaV_execute(c, tfvalue(proto), base); + break; + } + default: { /* func is not a function */ + /* Check the tag method for invalid functions */ + TObject *im = luaT_getimbyObj(func, IM_FUNCTION); + if (ttype(im) == LUA_T_NIL) + lua_error("call expression not a function"); + luaD_callTM(im, (L->stack.top-L->stack.stack)-(base-1), nResults); + return; + } + } + /* adjust the number of results */ + if (nResults != MULT_RET) + luaD_adjusttop(firstResult+nResults); + /* move results to base-1 (to erase parameters and function) */ + base--; + nResults = L->stack.top - (L->stack.stack+firstResult); /* actual number of results */ + for (i=0; i<nResults; i++) + *(L->stack.stack+base+i) = *(L->stack.stack+firstResult+i); + L->stack.top -= firstResult-base; +} + + + +/* +** Traverse all objects on L->stack.stack +*/ +void luaD_travstack (int (*fn)(TObject *)) +{ + StkId i; + for (i = (L->stack.top-1)-L->stack.stack; i>=0; i--) + fn(L->stack.stack+i); +} + + + +static void message (char *s) +{ + TObject im = L->errorim; + if (ttype(&im) != LUA_T_NIL) { + lua_pushstring(s); + luaD_callTM(&im, 1, 0); + } +} + +/* +** Reports an error, and jumps up to the available recover label +*/ +void lua_error (char *s) +{ + if (s) message(s); + if (L->errorJmp) + longjmp(*((jmp_buf *)L->errorJmp), 1); + else { + fprintf (stderr, "lua: exit(1). Unable to recover\n"); + exit(1); + } +} + +/* +** Call the function at L->Cstack.base, and incorporate results on +** the Lua2C structure. +*/ +static void do_callinc (int nResults) +{ + StkId base = L->Cstack.base; + luaD_call(base+1, nResults); + L->Cstack.lua2C = base; /* position of the luaM_new results */ + L->Cstack.num = (L->stack.top-L->stack.stack) - base; /* number of results */ + L->Cstack.base = base + L->Cstack.num; /* incorporate results on L->stack.stack */ +} + + +/* +** Execute a protected call. Assumes that function is at L->Cstack.base and +** parameters are on top of it. Leave nResults on the stack. +*/ +int luaD_protectedrun (int nResults) +{ + jmp_buf myErrorJmp; + int status; + volatile struct C_Lua_Stack oldCLS = L->Cstack; + jmp_buf *volatile oldErr = L->errorJmp; + L->errorJmp = &myErrorJmp; + if (setjmp(myErrorJmp) == 0) { + do_callinc(nResults); + status = 0; + } + else { /* an error occurred: restore L->Cstack and L->stack.top */ + L->Cstack = oldCLS; + L->stack.top = L->stack.stack+L->Cstack.base; + status = 1; + } + L->errorJmp = oldErr; + return status; +} + + +/* +** returns 0 = chunk loaded; 1 = error; 2 = no more chunks to load +*/ +static int protectedparser (ZIO *z, int bin) +{ + volatile int status; + TProtoFunc *volatile tf; + jmp_buf myErrorJmp; + jmp_buf *volatile oldErr = L->errorJmp; + L->errorJmp = &myErrorJmp; + if (setjmp(myErrorJmp) == 0) { + tf = bin ? luaU_undump1(z) : luaY_parser(z); + status = 0; + } + else { + tf = NULL; + status = 1; + } + L->errorJmp = oldErr; + if (status) return 1; /* error code */ + if (tf == NULL) return 2; /* 'natural' end */ + luaD_adjusttop(L->Cstack.base+1); /* one slot for the pseudo-function */ + L->stack.stack[L->Cstack.base].ttype = LUA_T_PROTO; + L->stack.stack[L->Cstack.base].value.tf = tf; + luaV_closure(0); + return 0; +} + + +static int do_main (ZIO *z, int bin) +{ + int status; + do { + long old_blocks = (luaC_checkGC(), L->nblocks); + status = protectedparser(z, bin); + if (status == 1) return 1; /* error */ + else if (status == 2) return 0; /* 'natural' end */ + else { + unsigned long newelems2 = 2*(L->nblocks-old_blocks); + L->GCthreshold += newelems2; + status = luaD_protectedrun(MULT_RET); + L->GCthreshold -= newelems2; + } + } while (bin && status == 0); + return status; +} + + +void luaD_gcIM (TObject *o) +{ + TObject *im = luaT_getimbyObj(o, IM_GC); + if (ttype(im) != LUA_T_NIL) { + *L->stack.top = *o; + incr_top; + luaD_callTM(im, 1, 0); + } +} + + +int lua_dofile (char *filename) +{ + ZIO z; + int status; + int c; + int bin; + FILE *f = (filename == NULL) ? stdin : fopen(filename, "r"); + if (f == NULL) + return 2; + if (filename == NULL) + filename = "(stdin)"; + c = fgetc(f); + ungetc(c, f); + bin = (c == ID_CHUNK); + if (bin) + f = freopen(filename, "rb", f); /* set binary mode */ + luaZ_Fopen(&z, f, filename); + status = do_main(&z, bin); + if (f != stdin) + fclose(f); + return status; +} + + +#define SIZE_PREF 20 /* size of string prefix to appear in error messages */ +#define SSIZE_PREF "20" + + +static void build_name (char *str, char *name) { + if (str == NULL || *str == ID_CHUNK) + strcpy(name, "(buffer)"); + else { + char *temp; + sprintf(name, "(dostring) >> \"%." SSIZE_PREF "s\"", str); + temp = strchr(name, '\n'); + if (temp) { /* end string after first line */ + *temp = '"'; + *(temp+1) = 0; + } + } +} + + +int lua_dostring (char *str) { + return lua_dobuffer(str, strlen(str), NULL); +} + + +int lua_dobuffer (char *buff, int size, char *name) { + char newname[SIZE_PREF+25]; + ZIO z; + int status; + if (name==NULL) { + build_name(buff, newname); + name = newname; + } + luaZ_mopen(&z, buff, size, name); + status = do_main(&z, buff[0]==ID_CHUNK); + return status; +} + diff --git a/src/ldo.h b/src/ldo.h new file mode 100644 index 00000000..0e981fbc --- /dev/null +++ b/src/ldo.h @@ -0,0 +1,46 @@ +/* +** $Id: ldo.h,v 1.4 1997/12/15 16:17:20 roberto Exp $ +** Stack and Call structure of Lua +** See Copyright Notice in lua.h +*/ + +#ifndef ldo_h +#define ldo_h + + +#include "lobject.h" +#include "lstate.h" + + +#define MULT_RET 255 + + + +/* +** macro to increment stack top. +** There must be always an empty slot at the L->stack.top +*/ +#define incr_top { if (L->stack.top >= L->stack.last) luaD_checkstack(1); \ + L->stack.top++; } + + +/* macros to convert from lua_Object to (TObject *) and back */ + +#define Address(lo) ((lo)+L->stack.stack-1) +#define Ref(st) ((st)-L->stack.stack+1) + + +void luaD_init (void); +void luaD_adjusttop (StkId newtop); +void luaD_openstack (int nelems); +void luaD_lineHook (int line); +void luaD_callHook (StkId base, TProtoFunc *tf, int isreturn); +void luaD_call (StkId base, int nResults); +void luaD_callTM (TObject *f, int nParams, int nResults); +int luaD_protectedrun (int nResults); +void luaD_gcIM (TObject *o); +void luaD_travstack (int (*fn)(TObject *)); +void luaD_checkstack (int n); + + +#endif diff --git a/src/lex.c b/src/lex.c deleted file mode 100644 index 5f19dd06..00000000 --- a/src/lex.c +++ /dev/null @@ -1,470 +0,0 @@ -char *rcs_lex = "$Id: lex.c,v 3.5 1997/06/16 16:50:22 roberto Exp $"; - - -#include <ctype.h> -#include <string.h> - -#include "auxlib.h" -#include "luamem.h" -#include "tree.h" -#include "table.h" -#include "lex.h" -#include "inout.h" -#include "luadebug.h" -#include "parser.h" - -#define MINBUFF 250 - -static int current; /* look ahead character */ -static ZIO *lex_z; - - -#define next() (current = zgetc(lex_z)) -#define save(x) (yytext[tokensize++] = (x)) -#define save_and_next() (save(current), next()) - - -#define MAX_IFS 5 - -/* "ifstate" keeps the state of each nested $if the lexical is dealing with. */ - -static struct { - int elsepart; /* true if its in the $else part */ - int condition; /* true if $if condition is true */ - int skip; /* true if part must be skiped */ -} ifstate[MAX_IFS]; - -static int iflevel; /* level of nested $if's */ - - -void lua_setinput (ZIO *z) -{ - current = '\n'; - lua_linenumber = 0; - iflevel = 0; - ifstate[0].skip = 0; - ifstate[0].elsepart = 1; /* to avoid a free $else */ - lex_z = z; -} - - -static void luaI_auxsyntaxerror (char *s) -{ - luaL_verror("%s;\n> at line %d in file %s", - s, lua_linenumber, lua_parsedfile); -} - -static void luaI_auxsynterrbf (char *s, char *token) -{ - if (token[0] == 0) - token = "<eof>"; - luaL_verror("%s;\n> last token read: \"%s\" at line %d in file %s", - s, token, lua_linenumber, lua_parsedfile); -} - -void luaI_syntaxerror (char *s) -{ - luaI_auxsynterrbf(s, luaI_buffer(1)); -} - - -static struct - { - char *name; - int token; - } reserved [] = { - {"and", AND}, - {"do", DO}, - {"else", ELSE}, - {"elseif", ELSEIF}, - {"end", END}, - {"function", FUNCTION}, - {"if", IF}, - {"local", LOCAL}, - {"nil", NIL}, - {"not", NOT}, - {"or", OR}, - {"repeat", REPEAT}, - {"return", RETURN}, - {"then", THEN}, - {"until", UNTIL}, - {"while", WHILE} }; - - -#define RESERVEDSIZE (sizeof(reserved)/sizeof(reserved[0])) - - -void luaI_addReserved (void) -{ - int i; - for (i=0; i<RESERVEDSIZE; i++) - { - TaggedString *ts = lua_createstring(reserved[i].name); - ts->marked = reserved[i].token; /* reserved word (always > 255) */ - } -} - - -/* -** Pragma handling -*/ - -#define PRAGMASIZE 20 - -static void skipspace (void) -{ - while (current == ' ' || current == '\t') next(); -} - - -static int checkcond (char *buff) -{ - static char *opts[] = {"nil", "1"}; - int i = luaI_findstring(buff, opts); - if (i >= 0) return i; - else if (isalpha((unsigned char)buff[0]) || buff[0] == '_') - return luaI_globaldefined(buff); - else { - luaI_auxsynterrbf("invalid $if condition", buff); - return 0; /* to avoid warnings */ - } -} - - -static void readname (char *buff) -{ - int i = 0; - skipspace(); - while (isalnum((unsigned char)current) || current == '_') { - if (i >= PRAGMASIZE) { - buff[PRAGMASIZE] = 0; - luaI_auxsynterrbf("pragma too long", buff); - } - buff[i++] = current; - next(); - } - buff[i] = 0; -} - - -static void inclinenumber (void); - - -static void ifskip (void) -{ - while (ifstate[iflevel].skip) { - if (current == '\n') - inclinenumber(); - else if (current == EOZ) - luaI_auxsyntaxerror("input ends inside a $if"); - else next(); - } -} - - -static void inclinenumber (void) -{ - static char *pragmas [] = - {"debug", "nodebug", "endinput", "end", "ifnot", "if", "else", NULL}; - next(); /* skip '\n' */ - ++lua_linenumber; - if (current == '$') { /* is a pragma? */ - char buff[PRAGMASIZE+1]; - int ifnot = 0; - int skip = ifstate[iflevel].skip; - next(); /* skip $ */ - readname(buff); - switch (luaI_findstring(buff, pragmas)) { - case 0: /* debug */ - if (!skip) lua_debug = 1; - break; - case 1: /* nodebug */ - if (!skip) lua_debug = 0; - break; - case 2: /* endinput */ - if (!skip) { - current = EOZ; - iflevel = 0; /* to allow $endinput inside a $if */ - } - break; - case 3: /* end */ - if (iflevel-- == 0) - luaI_auxsyntaxerror("unmatched $endif"); - break; - case 4: /* ifnot */ - ifnot = 1; - /* go through */ - case 5: /* if */ - if (iflevel == MAX_IFS-1) - luaI_auxsyntaxerror("too many nested `$ifs'"); - readname(buff); - iflevel++; - ifstate[iflevel].elsepart = 0; - ifstate[iflevel].condition = checkcond(buff) ? !ifnot : ifnot; - ifstate[iflevel].skip = skip || !ifstate[iflevel].condition; - break; - case 6: /* else */ - if (ifstate[iflevel].elsepart) - luaI_auxsyntaxerror("unmatched $else"); - ifstate[iflevel].elsepart = 1; - ifstate[iflevel].skip = - ifstate[iflevel-1].skip || ifstate[iflevel].condition; - break; - default: - luaI_auxsynterrbf("invalid pragma", buff); - } - skipspace(); - if (current == '\n') /* pragma must end with a '\n' ... */ - inclinenumber(); - else if (current != EOZ) /* or eof */ - luaI_auxsyntaxerror("invalid pragma format"); - ifskip(); - } -} - -static int read_long_string (char *yytext, int buffsize) -{ - int cont = 0; - int tokensize = 2; /* '[[' already stored */ - while (1) - { - if (buffsize-tokensize <= 2) /* may read more than 1 char in one cicle */ - yytext = luaI_buffer(buffsize *= 2); - switch (current) - { - case EOZ: - save(0); - return WRONGTOKEN; - case '[': - save_and_next(); - if (current == '[') - { - cont++; - save_and_next(); - } - continue; - case ']': - save_and_next(); - if (current == ']') - { - if (cont == 0) goto endloop; - cont--; - save_and_next(); - } - continue; - case '\n': - save('\n'); - inclinenumber(); - continue; - default: - save_and_next(); - } - } endloop: - save_and_next(); /* pass the second ']' */ - yytext[tokensize-2] = 0; /* erases ']]' */ - luaY_lval.vWord = luaI_findconstantbyname(yytext+2); - yytext[tokensize-2] = ']'; /* restores ']]' */ - save(0); - return STRING; -} - -int luaY_lex (void) -{ - static int linelasttoken = 0; - double a; - int buffsize = MINBUFF; - char *yytext = luaI_buffer(buffsize); - yytext[1] = yytext[2] = yytext[3] = 0; - if (lua_debug) - luaI_codedebugline(linelasttoken); - linelasttoken = lua_linenumber; - while (1) - { - int tokensize = 0; - switch (current) - { - case '\n': - inclinenumber(); - linelasttoken = lua_linenumber; - continue; - - case ' ': case '\t': case '\r': /* CR: to avoid problems with DOS */ - next(); - continue; - - case '-': - save_and_next(); - if (current != '-') return '-'; - do { next(); } while (current != '\n' && current != EOZ); - continue; - - case '[': - save_and_next(); - if (current != '[') return '['; - else - { - save_and_next(); /* pass the second '[' */ - return read_long_string(yytext, buffsize); - } - - case '=': - save_and_next(); - if (current != '=') return '='; - else { save_and_next(); return EQ; } - - case '<': - save_and_next(); - if (current != '=') return '<'; - else { save_and_next(); return LE; } - - case '>': - save_and_next(); - if (current != '=') return '>'; - else { save_and_next(); return GE; } - - case '~': - save_and_next(); - if (current != '=') return '~'; - else { save_and_next(); return NE; } - - case '"': - case '\'': - { - int del = current; - save_and_next(); - while (current != del) - { - if (buffsize-tokensize <= 2) /* may read more than 1 char in one cicle */ - yytext = luaI_buffer(buffsize *= 2); - switch (current) - { - case EOZ: - case '\n': - save(0); - return WRONGTOKEN; - case '\\': - next(); /* do not save the '\' */ - switch (current) - { - case 'n': save('\n'); next(); break; - case 't': save('\t'); next(); break; - case 'r': save('\r'); next(); break; - case '\n': save('\n'); inclinenumber(); break; - default : save_and_next(); break; - } - break; - default: - save_and_next(); - } - } - next(); /* skip delimiter */ - save(0); - luaY_lval.vWord = luaI_findconstantbyname(yytext+1); - tokensize--; - save(del); save(0); /* restore delimiter */ - return STRING; - } - - case 'a': case 'b': case 'c': case 'd': case 'e': - case 'f': case 'g': case 'h': case 'i': case 'j': - case 'k': case 'l': case 'm': case 'n': case 'o': - case 'p': case 'q': case 'r': case 's': case 't': - case 'u': case 'v': case 'w': case 'x': case 'y': - case 'z': - case 'A': case 'B': case 'C': case 'D': case 'E': - case 'F': case 'G': case 'H': case 'I': case 'J': - case 'K': case 'L': case 'M': case 'N': case 'O': - case 'P': case 'Q': case 'R': case 'S': case 'T': - case 'U': case 'V': case 'W': case 'X': case 'Y': - case 'Z': - case '_': - { - TaggedString *ts; - do { - save_and_next(); - } while (isalnum((unsigned char)current) || current == '_'); - save(0); - ts = lua_createstring(yytext); - if (ts->marked > 2) - return ts->marked; /* reserved word */ - luaY_lval.pTStr = ts; - ts->marked = 2; /* avoid GC */ - return NAME; - } - - case '.': - save_and_next(); - if (current == '.') - { - save_and_next(); - if (current == '.') - { - save_and_next(); - return DOTS; /* ... */ - } - else return CONC; /* .. */ - } - else if (!isdigit((unsigned char)current)) return '.'; - /* current is a digit: goes through to number */ - a=0.0; - goto fraction; - - case '0': case '1': case '2': case '3': case '4': - case '5': case '6': case '7': case '8': case '9': - a=0.0; - do { - a=10.0*a+(current-'0'); - save_and_next(); - } while (isdigit((unsigned char)current)); - if (current == '.') { - save_and_next(); - if (current == '.') - luaI_syntaxerror( - "ambiguous syntax (decimal point x string concatenation)"); - } - fraction: - { double da=0.1; - while (isdigit((unsigned char)current)) - { - a+=(current-'0')*da; - da/=10.0; - save_and_next(); - } - if (current == 'e' || current == 'E') - { - int e=0; - int neg; - double ea; - save_and_next(); - neg=(current=='-'); - if (current == '+' || current == '-') save_and_next(); - if (!isdigit((unsigned char)current)) { - save(0); return WRONGTOKEN; } - do { - e=10.0*e+(current-'0'); - save_and_next(); - } while (isdigit((unsigned char)current)); - for (ea=neg?0.1:10.0; e>0; e>>=1) - { - if (e & 1) a*=ea; - ea*=ea; - } - } - luaY_lval.vFloat = a; - save(0); - return NUMBER; - } - - case EOZ: - save(0); - if (iflevel > 0) - luaI_syntaxerror("missing $endif"); - return 0; - - default: - save_and_next(); - return yytext[0]; - } - } -} - diff --git a/src/lex.h b/src/lex.h deleted file mode 100644 index a942cf6d..00000000 --- a/src/lex.h +++ /dev/null @@ -1,18 +0,0 @@ -/* -** lex.h -** TecCGraf - PUC-Rio -** $Id: lex.h,v 1.4 1997/06/16 16:50:22 roberto Exp $ -*/ - -#ifndef lex_h -#define lex_h - -#include "zio.h" - -void lua_setinput (ZIO *z); -void luaI_syntaxerror (char *s); -int luaY_lex (void); -void luaI_addReserved (void); - - -#endif diff --git a/src/lfunc.c b/src/lfunc.c new file mode 100644 index 00000000..fae59667 --- /dev/null +++ b/src/lfunc.c @@ -0,0 +1,98 @@ +/* +** $Id: lfunc.c,v 1.9 1998/06/19 16:14:09 roberto Exp $ +** Auxiliary functions to manipulate prototypes and closures +** See Copyright Notice in lua.h +*/ + + +#include <stdlib.h> + +#include "lfunc.h" +#include "lmem.h" +#include "lstate.h" + +#define gcsizeproto(p) 5 /* approximate "weight" for a prototype */ +#define gcsizeclosure(c) 1 /* approximate "weight" for a closure */ + + + +Closure *luaF_newclosure (int nelems) +{ + Closure *c = (Closure *)luaM_malloc(sizeof(Closure)+nelems*sizeof(TObject)); + luaO_insertlist(&(L->rootcl), (GCnode *)c); + L->nblocks += gcsizeclosure(c); + c->nelems = nelems; + return c; +} + + +TProtoFunc *luaF_newproto (void) +{ + TProtoFunc *f = luaM_new(TProtoFunc); + f->code = NULL; + f->lineDefined = 0; + f->fileName = NULL; + f->consts = NULL; + f->nconsts = 0; + f->locvars = NULL; + luaO_insertlist(&(L->rootproto), (GCnode *)f); + L->nblocks += gcsizeproto(f); + return f; +} + + + +static void freefunc (TProtoFunc *f) +{ + luaM_free(f->code); + luaM_free(f->locvars); + luaM_free(f->consts); + luaM_free(f); +} + + +void luaF_freeproto (TProtoFunc *l) +{ + while (l) { + TProtoFunc *next = (TProtoFunc *)l->head.next; + L->nblocks -= gcsizeproto(l); + freefunc(l); + l = next; + } +} + + +void luaF_freeclosure (Closure *l) +{ + while (l) { + Closure *next = (Closure *)l->head.next; + L->nblocks -= gcsizeclosure(l); + luaM_free(l); + l = next; + } +} + + +/* +** Look for n-th local variable at line "line" in function "func". +** Returns NULL if not found. +*/ +char *luaF_getlocalname (TProtoFunc *func, int local_number, int line) +{ + int count = 0; + char *varname = NULL; + LocVar *lv = func->locvars; + if (lv == NULL) + return NULL; + for (; lv->line != -1 && lv->line < line; lv++) { + if (lv->varname) { /* register */ + if (++count == local_number) + varname = lv->varname->str; + } + else /* unregister */ + if (--count < local_number) + varname = NULL; + } + return varname; +} + diff --git a/src/lfunc.h b/src/lfunc.h new file mode 100644 index 00000000..cade80a2 --- /dev/null +++ b/src/lfunc.h @@ -0,0 +1,23 @@ +/* +** $Id: lfunc.h,v 1.5 1997/12/15 16:17:20 roberto Exp $ +** Lua Function structures +** See Copyright Notice in lua.h +*/ + +#ifndef lfunc_h +#define lfunc_h + + +#include "lobject.h" + + + +TProtoFunc *luaF_newproto (void); +Closure *luaF_newclosure (int nelems); +void luaF_freeproto (TProtoFunc *l); +void luaF_freeclosure (Closure *l); + +char *luaF_getlocalname (TProtoFunc *func, int local_number, int line); + + +#endif diff --git a/src/lgc.c b/src/lgc.c new file mode 100644 index 00000000..f982a829 --- /dev/null +++ b/src/lgc.c @@ -0,0 +1,288 @@ +/* +** $Id: lgc.c,v 1.18 1998/03/09 21:49:52 roberto Exp $ +** Garbage Collector +** See Copyright Notice in lua.h +*/ + + +#include "ldo.h" +#include "lfunc.h" +#include "lgc.h" +#include "lmem.h" +#include "lobject.h" +#include "lstate.h" +#include "lstring.h" +#include "ltable.h" +#include "ltm.h" +#include "lua.h" + + + +static int markobject (TObject *o); + + + +/* +** ======================================================= +** REF mechanism +** ======================================================= +*/ + + +int luaC_ref (TObject *o, int lock) +{ + int ref; + if (ttype(o) == LUA_T_NIL) + ref = -1; /* special ref for nil */ + else { + for (ref=0; ref<L->refSize; ref++) + if (L->refArray[ref].status == FREE) + goto found; + /* no more empty spaces */ { + int oldSize = L->refSize; + L->refSize = luaM_growvector(&L->refArray, L->refSize, struct ref, + refEM, MAX_INT); + for (ref=oldSize; ref<L->refSize; ref++) + L->refArray[ref].status = FREE; + ref = oldSize; + } found: + L->refArray[ref].o = *o; + L->refArray[ref].status = lock ? LOCK : HOLD; + } + return ref; +} + + +void lua_unref (int ref) +{ + if (ref >= 0 && ref < L->refSize) + L->refArray[ref].status = FREE; +} + + +TObject* luaC_getref (int ref) +{ + if (ref == -1) + return &luaO_nilobject; + if (ref >= 0 && ref < L->refSize && + (L->refArray[ref].status == LOCK || L->refArray[ref].status == HOLD)) + return &L->refArray[ref].o; + else + return NULL; +} + + +static void travlock (void) +{ + int i; + for (i=0; i<L->refSize; i++) + if (L->refArray[i].status == LOCK) + markobject(&L->refArray[i].o); +} + + +static int ismarked (TObject *o) +{ + /* valid only for locked objects */ + switch (o->ttype) { + case LUA_T_STRING: case LUA_T_USERDATA: + return o->value.ts->head.marked; + case LUA_T_ARRAY: + return o->value.a->head.marked; + case LUA_T_CLOSURE: + return o->value.cl->head.marked; + case LUA_T_PROTO: + return o->value.tf->head.marked; +#ifdef DEBUG + case LUA_T_LINE: case LUA_T_CLMARK: + case LUA_T_CMARK: case LUA_T_PMARK: + LUA_INTERNALERROR("invalid type"); +#endif + default: /* nil, number or cproto */ + return 1; + } +} + + +static void invalidaterefs (void) +{ + int i; + for (i=0; i<L->refSize; i++) + if (L->refArray[i].status == HOLD && !ismarked(&L->refArray[i].o)) + L->refArray[i].status = COLLECTED; +} + + + +void luaC_hashcallIM (Hash *l) +{ + TObject t; + ttype(&t) = LUA_T_ARRAY; + for (; l; l=(Hash *)l->head.next) { + avalue(&t) = l; + luaD_gcIM(&t); + } +} + + +void luaC_strcallIM (TaggedString *l) +{ + TObject o; + ttype(&o) = LUA_T_USERDATA; + for (; l; l=(TaggedString *)l->head.next) + if (l->constindex == -1) { /* is userdata? */ + tsvalue(&o) = l; + luaD_gcIM(&o); + } +} + + + +static GCnode *listcollect (GCnode *l) +{ + GCnode *frees = NULL; + while (l) { + GCnode *next = l->next; + l->marked = 0; + while (next && !next->marked) { + l->next = next->next; + next->next = frees; + frees = next; + next = l->next; + } + l = next; + } + return frees; +} + + +static void strmark (TaggedString *s) +{ + if (!s->head.marked) + s->head.marked = 1; +} + + +static void protomark (TProtoFunc *f) +{ + if (!f->head.marked) { + LocVar *v = f->locvars; + int i; + f->head.marked = 1; + if (f->fileName) + strmark(f->fileName); + for (i=0; i<f->nconsts; i++) + markobject(&f->consts[i]); + if (v) { + for (; v->line != -1; v++) + if (v->varname) + strmark(v->varname); + } + } +} + + +static void closuremark (Closure *f) +{ + if (!f->head.marked) { + int i; + f->head.marked = 1; + for (i=f->nelems; i>=0; i--) + markobject(&f->consts[i]); + } +} + + +static void hashmark (Hash *h) +{ + if (!h->head.marked) { + int i; + h->head.marked = 1; + for (i=0; i<nhash(h); i++) { + Node *n = node(h,i); + if (ttype(ref(n)) != LUA_T_NIL) { + markobject(&n->ref); + markobject(&n->val); + } + } + } +} + + +static void globalmark (void) +{ + TaggedString *g; + for (g=(TaggedString *)L->rootglobal.next; g; g=(TaggedString *)g->head.next){ + LUA_ASSERT(g->constindex >= 0, "userdata in global list"); + if (g->u.s.globalval.ttype != LUA_T_NIL) { + markobject(&g->u.s.globalval); + strmark(g); /* cannot collect non nil global variables */ + } + } +} + + +static int markobject (TObject *o) +{ + switch (ttype(o)) { + case LUA_T_USERDATA: case LUA_T_STRING: + strmark(tsvalue(o)); + break; + case LUA_T_ARRAY: + hashmark(avalue(o)); + break; + case LUA_T_CLOSURE: case LUA_T_CLMARK: + closuremark(o->value.cl); + break; + case LUA_T_PROTO: case LUA_T_PMARK: + protomark(o->value.tf); + break; + default: break; /* numbers, cprotos, etc */ + } + return 0; +} + + + +static void markall (void) +{ + luaD_travstack(markobject); /* mark stack objects */ + globalmark(); /* mark global variable values and names */ + travlock(); /* mark locked objects */ + luaT_travtagmethods(markobject); /* mark fallbacks */ +} + + +long lua_collectgarbage (long limit) +{ + unsigned long recovered = L->nblocks; /* to subtract nblocks after gc */ + Hash *freetable; + TaggedString *freestr; + TProtoFunc *freefunc; + Closure *freeclos; + markall(); + invalidaterefs(); + freestr = luaS_collector(); + freetable = (Hash *)listcollect(&(L->roottable)); + freefunc = (TProtoFunc *)listcollect(&(L->rootproto)); + freeclos = (Closure *)listcollect(&(L->rootcl)); + L->GCthreshold *= 4; /* to avoid GC during GC */ + luaC_hashcallIM(freetable); /* GC tag methods for tables */ + luaC_strcallIM(freestr); /* GC tag methods for userdata */ + luaD_gcIM(&luaO_nilobject); /* GC tag method for nil (signal end of GC) */ + luaH_free(freetable); + luaS_free(freestr); + luaF_freeproto(freefunc); + luaF_freeclosure(freeclos); + recovered = recovered-L->nblocks; + L->GCthreshold = (limit == 0) ? 2*L->nblocks : L->nblocks+limit; + return recovered; +} + + +void luaC_checkGC (void) +{ + if (L->nblocks >= L->GCthreshold) + lua_collectgarbage(0); +} + diff --git a/src/lgc.h b/src/lgc.h new file mode 100644 index 00000000..38b09553 --- /dev/null +++ b/src/lgc.h @@ -0,0 +1,21 @@ +/* +** $Id: lgc.h,v 1.4 1997/12/01 20:31:25 roberto Exp $ +** Garbage Collector +** See Copyright Notice in lua.h +*/ + +#ifndef lgc_h +#define lgc_h + + +#include "lobject.h" + + +void luaC_checkGC (void); +TObject* luaC_getref (int ref); +int luaC_ref (TObject *o, int lock); +void luaC_hashcallIM (Hash *l); +void luaC_strcallIM (TaggedString *l); + + +#endif diff --git a/src/lib/Makefile b/src/lib/Makefile new file mode 100644 index 00000000..70db660f --- /dev/null +++ b/src/lib/Makefile @@ -0,0 +1,28 @@ +# makefile for lua standard library + +LUA= ../.. + +include $(LUA)/config + +# actually only used in liolib.c +EXTRA_DEFS= $(POPEN) + +OBJS= liolib.o lmathlib.o lstrlib.o +SRCS= liolib.c lmathlib.c lstrlib.c + +T= $(LIB)/liblualib.a + +all: $T + +$T: $(OBJS) + $(AR) $@ $(OBJS) + $(RANLIB) $@ + +clean: + rm -f $(OBJS) $T + +co: + co -q -f -M $(SRCS) + +klean: clean + rm -f $(SRCS) diff --git a/src/lib/README b/src/lib/README new file mode 100644 index 00000000..e8e599c8 --- /dev/null +++ b/src/lib/README @@ -0,0 +1,4 @@ +This is the standard Lua library. +It is implemented entirely on top of the official Lua API as declared in lua.h, +using src/lauxlib.c, which contains several useful functions. +The code can be read as an example of how to export C functions to Lua. diff --git a/src/lib/liolib.c b/src/lib/liolib.c new file mode 100644 index 00000000..15ea6587 --- /dev/null +++ b/src/lib/liolib.c @@ -0,0 +1,448 @@ +/* +** $Id: liolib.c,v 1.21 1998/06/18 17:04:28 roberto Exp $ +** Standard I/O (and system) library +** See Copyright Notice in lua.h +*/ + + +#include <errno.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <time.h> + +#include "lauxlib.h" +#include "lua.h" +#include "luadebug.h" +#include "lualib.h" + + +#ifndef OLD_ANSI +#include <locale.h> +#else +#define setlocale(a,b) 0 +#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) "(no error message provided by operating system)" +#endif + + +#define CLOSEDTAG 2 +#define IOTAG 1 + +#define FIRSTARG 3 /* 1st and 2nd are upvalues */ + +#define FINPUT "_INPUT" +#define FOUTPUT "_OUTPUT" + + +#ifdef POPEN +FILE *popen(); +int pclose(); +#else +#define popen(x,y) NULL /* that is, popen always fails */ +#define pclose(x) (-1) +#endif + + +static int gettag (int i) +{ + return lua_getnumber(lua_getparam(i)); +} + + +static void pushresult (int i) +{ + if (i) + lua_pushuserdata(NULL); + else { + lua_pushnil(); + lua_pushstring(strerror(errno)); + } +} + + +static int ishandler (lua_Object f) +{ + if (lua_isuserdata(f)) { + if (lua_tag(f) == gettag(CLOSEDTAG)) + lua_error("cannot access a closed file"); + return lua_tag(f) == gettag(IOTAG); + } + else return 0; +} + +static FILE *getfile (char *name) +{ + lua_Object f = lua_getglobal(name); + if (!ishandler(f)) + luaL_verror("global variable `%.50s' is not a file handle", name); + return lua_getuserdata(f); +} + + +static FILE *getfileparam (char *name, int *arg) +{ + lua_Object f = lua_getparam(*arg); + if (ishandler(f)) { + (*arg)++; + return lua_getuserdata(f); + } + else + return getfile(name); +} + + +static void closefile (char *name) +{ + FILE *f = getfile(name); + if (f == stdin || f == stdout) return; + if (pclose(f) == -1) + fclose(f); + lua_pushobject(lua_getglobal(name)); + lua_settag(gettag(CLOSEDTAG)); +} + + +static void setfile (FILE *f, char *name, int tag) +{ + lua_pushusertag(f, tag); + lua_setglobal(name); +} + + +static void setreturn (FILE *f, char *name) +{ + int tag = gettag(IOTAG); + setfile(f, name, tag); + lua_pushusertag(f, tag); +} + + +static void io_readfrom (void) +{ + FILE *current; + lua_Object f = lua_getparam(FIRSTARG); + if (f == LUA_NOOBJECT) { + closefile(FINPUT); + current = stdin; + } + else if (lua_tag(f) == gettag(IOTAG)) + current = lua_getuserdata(f); + else { + char *s = luaL_check_string(FIRSTARG); + current = (*s == '|') ? popen(s+1, "r") : fopen(s, "r"); + if (current == NULL) { + pushresult(0); + return; + } + } + setreturn(current, FINPUT); +} + + +static void io_writeto (void) +{ + FILE *current; + lua_Object f = lua_getparam(FIRSTARG); + if (f == LUA_NOOBJECT) { + closefile(FOUTPUT); + current = stdout; + } + else if (lua_tag(f) == gettag(IOTAG)) + current = lua_getuserdata(f); + else { + char *s = luaL_check_string(FIRSTARG); + current = (*s == '|') ? popen(s+1,"w") : fopen(s,"w"); + if (current == NULL) { + pushresult(0); + return; + } + } + setreturn(current, FOUTPUT); +} + + +static void io_appendto (void) +{ + char *s = luaL_check_string(FIRSTARG); + FILE *fp = fopen (s, "a"); + if (fp != NULL) + setreturn(fp, FOUTPUT); + else + pushresult(0); +} + + +#define NEED_OTHER (EOF-1) /* just some flag different from EOF */ + + +static void read_until (FILE *f, int lim) { + int l = 0; + int c; + for (c = getc(f); c != EOF && c != lim; c = getc(f)) { + luaL_addchar(c); + l++; + } + if (l > 0 || c == lim) /* read anything? */ + lua_pushlstring(luaL_buffer(), l); +} + +static void io_read (void) { + int arg = FIRSTARG; + FILE *f = getfileparam(FINPUT, &arg); + char *p = luaL_opt_string(arg, NULL); + luaL_resetbuffer(); + if (p == NULL) /* default: read a line */ + read_until(f, '\n'); + else if (p[0] == '.' && p[1] == '*' && p[2] == 0) /* p = ".*" */ + read_until(f, EOF); + else { + int l = 0; /* number of chars read in buffer */ + int inskip = 0; /* to control {skips} */ + int c = NEED_OTHER; + while (*p) { + switch (*p) { + case '{': + inskip++; + p++; + continue; + case '}': + if (inskip == 0) + lua_error("unbalanced braces in read pattern"); + inskip--; + p++; + continue; + default: { + char *ep; /* get what is next */ + int m; /* match result */ + if (c == NEED_OTHER) c = getc(f); + if (c == EOF) { + luaI_singlematch(0, p, &ep); /* to set "ep" */ + m = 0; + } + else { + m = luaI_singlematch(c, p, &ep); + if (m) { + if (inskip == 0) { + luaL_addchar(c); + l++; + } + c = NEED_OTHER; + } + } + switch (*ep) { + case '*': /* repetition */ + if (!m) p = ep+1; /* else stay in (repeat) the same item */ + continue; + case '?': /* optional */ + p = ep+1; /* continues reading the pattern */ + continue; + default: + if (m) p = ep; /* continues reading the pattern */ + else + goto break_while; /* pattern fails */ + } + } + } + } break_while: + if (c >= 0) /* not EOF nor NEED_OTHER? */ + ungetc(c, f); + if (l > 0 || *p == 0) /* read something or did not fail? */ + lua_pushlstring(luaL_buffer(), l); + } +} + + +static void io_write (void) +{ + int arg = FIRSTARG; + FILE *f = getfileparam(FOUTPUT, &arg); + int status = 1; + char *s; + long l; + while ((s = luaL_opt_lstr(arg++, NULL, &l)) != NULL) + status = status && (fwrite(s, 1, l, f) == l); + pushresult(status); +} + + +static void io_execute (void) +{ + lua_pushnumber(system(luaL_check_string(1))); +} + + +static void io_remove (void) +{ + pushresult(remove(luaL_check_string(1)) == 0); +} + + +static void io_rename (void) +{ + pushresult(rename(luaL_check_string(1), + luaL_check_string(2)) == 0); +} + + +static void io_tmpname (void) +{ + lua_pushstring(tmpnam(NULL)); +} + + + +static void io_getenv (void) +{ + lua_pushstring(getenv(luaL_check_string(1))); /* if NULL push nil */ +} + + +static void io_clock (void) { + lua_pushnumber(((double)clock())/CLOCKS_PER_SEC); +} + + +static void io_date (void) +{ + time_t t; + struct tm *tm; + char *s = luaL_opt_string(1, "%c"); + char b[BUFSIZ]; + time(&t); tm = localtime(&t); + if (strftime(b,sizeof(b),s,tm)) + lua_pushstring(b); + else + lua_error("invalid `date' format"); +} + + +static void setloc (void) +{ + static int cat[] = {LC_ALL, LC_COLLATE, LC_CTYPE, LC_MONETARY, LC_NUMERIC, + LC_TIME}; + static char *catnames[] = {"all", "collate", "ctype", "monetary", + "numeric", "time", NULL}; + int op = luaL_findstring(luaL_opt_string(2, "all"), catnames); + luaL_arg_check(op != -1, 2, "invalid option"); + lua_pushstring(setlocale(cat[op], luaL_check_string(1))); +} + + +static void io_exit (void) +{ + lua_Object o = lua_getparam(1); + exit(lua_isnumber(o) ? (int)lua_getnumber(o) : 1); +} + + +static void io_debug (void) +{ + while (1) { + char buffer[250]; + fprintf(stderr, "lua_debug> "); + if (fgets(buffer, sizeof(buffer), stdin) == 0) return; + if (strcmp(buffer, "cont\n") == 0) return; + lua_dostring(buffer); + } +} + + +static void lua_printstack (FILE *f) +{ + int level = 1; /* skip level 0 (it's this function) */ + lua_Object func; + while ((func = lua_stackedfunction(level++)) != LUA_NOOBJECT) { + char *name; + int currentline; + char *filename; + int linedefined; + lua_funcinfo(func, &filename, &linedefined); + fprintf(f, (level==2) ? "Active Stack:\n\t" : "\t"); + switch (*lua_getobjname(func, &name)) { + case 'g': + fprintf(f, "function %s", name); + break; + case 't': + fprintf(f, "`%s' tag method", name); + break; + default: { + if (linedefined == 0) + fprintf(f, "main of %s", filename); + else if (linedefined < 0) + fprintf(f, "%s", filename); + else + fprintf(f, "function (%s:%d)", filename, linedefined); + filename = NULL; + } + } + if ((currentline = lua_currentline(func)) > 0) + fprintf(f, " at line %d", currentline); + if (filename) + fprintf(f, " [in file %s]", filename); + fprintf(f, "\n"); + } +} + + +static void errorfb (void) +{ + fprintf(stderr, "lua: %s\n", lua_getstring(lua_getparam(1))); + lua_printstack(stderr); +} + + + +static struct luaL_reg iolib[] = { +{"setlocale", setloc}, +{"execute", io_execute}, +{"remove", io_remove}, +{"rename", io_rename}, +{"tmpname", io_tmpname}, +{"getenv", io_getenv}, +{"date", io_date}, +{"clock", io_clock}, +{"exit", io_exit}, +{"debug", io_debug}, +{"print_stack", errorfb} +}; + +static struct luaL_reg iolibtag[] = { +{"readfrom", io_readfrom}, +{"writeto", io_writeto}, +{"appendto", io_appendto}, +{"read", io_read}, +{"write", io_write} +}; + +static void openwithtags (void) +{ + int iotag = lua_newtag(); + int closedtag = lua_newtag(); + int i; + for (i=0; i<sizeof(iolibtag)/sizeof(iolibtag[0]); i++) { + /* put both tags as upvalues for these functions */ + lua_pushnumber(iotag); + lua_pushnumber(closedtag); + lua_pushcclosure(iolibtag[i].func, 2); + lua_setglobal(iolibtag[i].name); + } + setfile(stdin, FINPUT, iotag); + setfile(stdout, FOUTPUT, iotag); + setfile(stdin, "_STDIN", iotag); + setfile(stdout, "_STDOUT", iotag); + setfile(stderr, "_STDERR", iotag); +} + +void lua_iolibopen (void) +{ + luaL_openlib(iolib, (sizeof(iolib)/sizeof(iolib[0]))); + openwithtags(); + lua_pushcfunction(errorfb); + lua_seterrormethod(); +} diff --git a/src/lib/lmathlib.c b/src/lib/lmathlib.c new file mode 100644 index 00000000..bdc534f5 --- /dev/null +++ b/src/lib/lmathlib.c @@ -0,0 +1,213 @@ +/* +** $Id: lmathlib.c,v 1.10 1998/06/19 16:14:09 roberto Exp $ +** Lua standard mathematical library +** See Copyright Notice in lua.h +*/ + + +#include <stdlib.h> +#include <math.h> + +#include "lauxlib.h" +#include "lua.h" +#include "lualib.h" + +#ifdef M_PI +#define PI M_PI +#else +#define PI ((double)3.14159265358979323846) +#endif + + +#define FROMRAD(a) ((a)*(180.0/PI)) +#define TORAD(a) ((a)*(PI/180.0)) + + +static void math_abs (void) +{ + double d = luaL_check_number(1); + if (d < 0) d = -d; + lua_pushnumber(d); +} + +static void math_sin (void) +{ + lua_pushnumber(sin(TORAD(luaL_check_number(1)))); +} + +static void math_cos (void) +{ + lua_pushnumber(cos(TORAD(luaL_check_number(1)))); +} + +static void math_tan (void) +{ + lua_pushnumber(tan(TORAD(luaL_check_number(1)))); +} + +static void math_asin (void) +{ + lua_pushnumber(FROMRAD(asin(luaL_check_number(1)))); +} + +static void math_acos (void) +{ + lua_pushnumber(FROMRAD(acos(luaL_check_number(1)))); +} + +static void math_atan (void) +{ + lua_pushnumber(FROMRAD(atan(luaL_check_number(1)))); +} + +static void math_atan2 (void) +{ + lua_pushnumber(FROMRAD(atan2(luaL_check_number(1), luaL_check_number(2)))); +} + +static void math_ceil (void) +{ + lua_pushnumber(ceil(luaL_check_number(1))); +} + +static void math_floor (void) +{ + lua_pushnumber(floor(luaL_check_number(1))); +} + +static void math_mod (void) +{ + lua_pushnumber(fmod(luaL_check_number(1), luaL_check_number(2))); +} + +static void math_sqrt (void) +{ + lua_pushnumber(sqrt(luaL_check_number(1))); +} + +static void math_pow (void) +{ + lua_pushnumber(pow(luaL_check_number(1), luaL_check_number(2))); +} + +static void math_log (void) +{ + lua_pushnumber(log(luaL_check_number(1))); +} + +static void math_log10 (void) +{ + lua_pushnumber(log10(luaL_check_number(1))); +} + +static void math_exp (void) +{ + lua_pushnumber(exp(luaL_check_number(1))); +} + +static void math_deg (void) +{ + lua_pushnumber(luaL_check_number(1)*(180.0/PI)); +} + +static void math_rad (void) +{ + lua_pushnumber(luaL_check_number(1)*(PI/180.0)); +} + +static void math_frexp (void) { + int e; + lua_pushnumber(frexp(luaL_check_number(1), &e)); + lua_pushnumber(e); +} + +static void math_ldexp (void) { + lua_pushnumber(ldexp(luaL_check_number(1), luaL_check_number(2))); +} + + + +static void math_min (void) +{ + int i = 1; + double dmin = luaL_check_number(i); + while (lua_getparam(++i) != LUA_NOOBJECT) { + double d = luaL_check_number(i); + if (d < dmin) + dmin = d; + } + lua_pushnumber(dmin); +} + + +static void math_max (void) +{ + int i = 1; + double dmax = luaL_check_number(i); + while (lua_getparam(++i) != LUA_NOOBJECT) { + double d = luaL_check_number(i); + if (d > dmax) + dmax = d; + } + lua_pushnumber(dmax); +} + + +static void math_random (void) +{ + /* the '%' is needed because on some systems (SunOS!) "rand()" may */ + /* return a value bigger than RAND_MAX... */ + double r = (double)(rand()%RAND_MAX) / (double)RAND_MAX; + double l = luaL_opt_number(1, 0); + if (l == 0) + lua_pushnumber(r); + else + lua_pushnumber((int)(r*l)+1); +} + + +static void math_randomseed (void) +{ + srand(luaL_check_number(1)); +} + + +static 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} +}; + +/* +** Open math library +*/ +void lua_mathlibopen (void) +{ + luaL_openlib(mathlib, (sizeof(mathlib)/sizeof(mathlib[0]))); + lua_pushstring("deg"); lua_setglobal("_TRIGMODE"); + lua_pushcfunction(math_pow); + lua_pushnumber(0); /* to get its tag */ + lua_settagmethod(lua_tag(lua_pop()), "pow"); + lua_pushnumber(PI); lua_setglobal("PI"); +} + diff --git a/src/lib/lstrlib.c b/src/lib/lstrlib.c new file mode 100644 index 00000000..dc79cc7e --- /dev/null +++ b/src/lib/lstrlib.c @@ -0,0 +1,541 @@ +/* +** $Id: lstrlib.c,v 1.18 1998/07/01 14:21:57 roberto Exp $ +** Standard library for strings and pattern-matching +** See Copyright Notice in lua.h +*/ + + +#include <ctype.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> + +#include "lauxlib.h" +#include "lua.h" +#include "lualib.h" + + + +static void addnchar (char *s, int n) +{ + char *b = luaL_openspace(n); + memcpy(b, s, n); + luaL_addsize(n); +} + + +static void str_len (void) +{ + long l; + luaL_check_lstr(1, &l); + lua_pushnumber(l); +} + + +static void closeandpush (void) +{ + lua_pushlstring(luaL_buffer(), luaL_getsize()); +} + + +static long posrelat (long pos, long len) +{ + /* relative string position: negative means back from end */ + return (pos>=0) ? pos : len+pos+1; +} + + +static void str_sub (void) +{ + long l; + char *s = luaL_check_lstr(1, &l); + long start = posrelat(luaL_check_number(2), l); + long end = posrelat(luaL_opt_number(3, -1), l); + if (1 <= start && start <= end && end <= l) + lua_pushlstring(s+start-1, end-start+1); + else lua_pushstring(""); +} + + +static void str_lower (void) +{ + long l; + int i; + char *s = luaL_check_lstr(1, &l); + luaL_resetbuffer(); + for (i=0; i<l; i++) + luaL_addchar(tolower((unsigned char)(s[i]))); + closeandpush(); +} + + +static void str_upper (void) +{ + long l; + int i; + char *s = luaL_check_lstr(1, &l); + luaL_resetbuffer(); + for (i=0; i<l; i++) + luaL_addchar(toupper((unsigned char)(s[i]))); + closeandpush(); +} + +static void str_rep (void) +{ + long l; + char *s = luaL_check_lstr(1, &l); + int n = (int)luaL_check_number(2); + luaL_resetbuffer(); + while (n-- > 0) + addnchar(s, l); + closeandpush(); +} + + +static void str_byte (void) +{ + long l; + char *s = luaL_check_lstr(1, &l); + long pos = posrelat(luaL_opt_number(2, 1), l); + luaL_arg_check(0<pos && pos<=l, 2, "out of range"); + lua_pushnumber((unsigned char)s[pos-1]); +} + +static void str_char (void) { + int i = 0; + luaL_resetbuffer(); + while (lua_getparam(++i) != LUA_NOOBJECT) { + double c = luaL_check_number(i); + luaL_arg_check((unsigned char)c == c, i, "invalid value"); + luaL_addchar((int)c); + } + closeandpush(); +} + + +/* +** ======================================================= +** PATTERN MATCHING +** ======================================================= +*/ + +#define MAX_CAPT 9 + +struct Capture { + int level; /* total number of captures (finished or unfinished) */ + char *src_end; /* end ('\0') of source string */ + struct { + char *init; + int len; /* -1 signals unfinished capture */ + } capture[MAX_CAPT]; +}; + + +#define ESC '%' +#define SPECIALS "^$*?.([%-" + + +static void push_captures (struct Capture *cap) +{ + int i; + for (i=0; i<cap->level; i++) + lua_pushlstring(cap->capture[i].init, cap->capture[i].len); +} + + +static int check_cap (int l, struct Capture *cap) +{ + l -= '1'; + if (!(0 <= l && l < cap->level && cap->capture[l].len != -1)) + lua_error("invalid capture index"); + return l; +} + + +static int capture_to_close (struct Capture *cap) +{ + int level = cap->level; + for (level--; level>=0; level--) + if (cap->capture[level].len == -1) return level; + lua_error("invalid pattern capture"); + return 0; /* to avoid warnings */ +} + + +static char *bracket_end (char *p) +{ + return (*p == 0) ? NULL : strchr((*p=='^') ? p+2 : p+1, ']'); +} + + +static int matchclass (int c, int cl) +{ + int res; + switch (tolower(cl)) { + case 'a' : res = isalpha(c); break; + case 'c' : res = iscntrl(c); break; + case 'd' : res = isdigit(c); break; + case 'l' : res = islower(c); break; + case 'p' : res = ispunct(c); break; + case 's' : res = isspace(c); break; + case 'u' : res = isupper(c); break; + case 'w' : res = isalnum(c); break; + case 'z' : res = (c == '\0'); break; + default: return (cl == c); + } + return (islower((unsigned char)cl) ? res : !res); +} + + +int luaI_singlematch (int c, char *p, char **ep) +{ + switch (*p) { + case '.': /* matches any char */ + *ep = p+1; + return 1; + case '\0': /* end of pattern; matches nothing */ + *ep = p; + return 0; + case ESC: + if (*(++p) == '\0') + luaL_verror("incorrect pattern (ends with `%c')", ESC); + *ep = p+1; + return matchclass(c, (unsigned char)*p); + case '[': { + char *end = bracket_end(p+1); + int sig = *(p+1) == '^' ? (p++, 0) : 1; + if (end == NULL) lua_error("incorrect pattern (missing `]')"); + *ep = end+1; + while (++p < end) { + if (*p == ESC) { + if (((p+1) < end) && matchclass(c, (unsigned char)*++p)) + return sig; + } + else if ((*(p+1) == '-') && (p+2 < end)) { + p+=2; + if ((unsigned char)*(p-2) <= c && c <= (unsigned char)*p) + return sig; + } + else if ((unsigned char)*p == c) return sig; + } + return !sig; + } + default: + *ep = p+1; + return ((unsigned char)*p == c); + } +} + + +static char *matchbalance (char *s, int b, int e, struct Capture *cap) +{ + if (*s != b) return NULL; + else { + int cont = 1; + while (++s < cap->src_end) { + if (*s == e) { + if (--cont == 0) return s+1; + } + else if (*s == b) cont++; + } + } + return NULL; /* string ends out of balance */ +} + + +static char *matchitem (char *s, char *p, struct Capture *cap, char **ep) +{ + if (*p == ESC) { + p++; + if (isdigit((unsigned char)*p)) { /* capture */ + int l = check_cap(*p, cap); + int len = cap->capture[l].len; + *ep = p+1; + if (cap->src_end-s >= len && memcmp(cap->capture[l].init, s, len) == 0) + return s+len; + else return NULL; + } + else if (*p == 'b') { /* balanced string */ + p++; + if (*p == 0 || *(p+1) == 0) + lua_error("unbalanced pattern"); + *ep = p+2; + return matchbalance(s, *p, *(p+1), cap); + } + else p--; /* and go through */ + } + /* "luaI_singlematch" sets "ep" (so must be called even when *s == 0) */ + return (luaI_singlematch((unsigned char)*s, p, ep) && s<cap->src_end) ? + s+1 : NULL; +} + + +static char *match (char *s, char *p, struct Capture *cap) +{ + init: /* using goto's to optimize tail recursion */ + switch (*p) { + case '(': { /* start capture */ + char *res; + if (cap->level >= MAX_CAPT) lua_error("too many captures"); + cap->capture[cap->level].init = s; + cap->capture[cap->level].len = -1; + cap->level++; + if ((res=match(s, p+1, cap)) == NULL) /* match failed? */ + cap->level--; /* undo capture */ + return res; + } + case ')': { /* end capture */ + int l = capture_to_close(cap); + char *res; + cap->capture[l].len = s - cap->capture[l].init; /* close capture */ + if ((res = match(s, p+1, cap)) == NULL) /* match failed? */ + cap->capture[l].len = -1; /* undo capture */ + return res; + } + case '\0': case '$': /* (possibly) end of pattern */ + if (*p == 0 || (*(p+1) == 0 && s == cap->src_end)) + return s; + /* else go through */ + default: { /* it is a pattern item */ + char *ep; /* get what is next */ + char *s1 = matchitem(s, p, cap, &ep); + switch (*ep) { + case '*': { /* repetition */ + char *res; + if (s1 && s1>s && ((res=match(s1, p, cap)) != NULL)) + return res; + p=ep+1; goto init; /* else return match(s, ep+1, cap); */ + } + case '?': { /* optional */ + char *res; + if (s1 && ((res=match(s1, ep+1, cap)) != NULL)) + return res; + p=ep+1; goto init; /* else return match(s, ep+1, cap); */ + } + case '-': { /* repetition */ + char *res; + if ((res = match(s, ep+1, cap)) != NULL) + return res; + else if (s1 && s1>s) { + s = s1; + goto init; /* return match(s1, p, cap); */ + } + else + return NULL; + } + default: + if (s1) { s=s1; p=ep; goto init; } /* return match(s1, ep, cap); */ + else return NULL; + } + } + } +} + + +static void str_find (void) +{ + long l; + char *s = luaL_check_lstr(1, &l); + char *p = luaL_check_string(2); + long init = posrelat(luaL_opt_number(3, 1), l) - 1; + struct Capture cap; + luaL_arg_check(0 <= init && init <= l, 3, "out of range"); + if (lua_getparam(4) != LUA_NOOBJECT || + strpbrk(p, SPECIALS) == NULL) { /* no special characters? */ + char *s2 = strstr(s+init, p); + if (s2) { + lua_pushnumber(s2-s+1); + lua_pushnumber(s2-s+strlen(p)); + return; + } + } + else { + int anchor = (*p == '^') ? (p++, 1) : 0; + char *s1=s+init; + cap.src_end = s+l; + do { + char *res; + cap.level = 0; + if ((res=match(s1, p, &cap)) != NULL) { + lua_pushnumber(s1-s+1); /* start */ + lua_pushnumber(res-s); /* end */ + push_captures(&cap); + return; + } + } while (s1++<cap.src_end && !anchor); + } + lua_pushnil(); /* if arrives here, it didn't find */ +} + + +static void add_s (lua_Object newp, struct Capture *cap) +{ + if (lua_isstring(newp)) { + char *news = lua_getstring(newp); + int l = lua_strlen(newp); + int i; + for (i=0; i<l; i++) { + if (news[i] != ESC) + luaL_addchar(news[i]); + else { + i++; /* skip ESC */ + if (!isdigit((unsigned char)news[i])) + luaL_addchar(news[i]); + else { + int level = check_cap(news[i], cap); + addnchar(cap->capture[level].init, cap->capture[level].len); + } + } + } + } + else { /* is a function */ + lua_Object res; + int status; + int oldbuff; + lua_beginblock(); + push_captures(cap); + /* function may use buffer, so save it and create a new one */ + oldbuff = luaL_newbuffer(0); + status = lua_callfunction(newp); + /* restore old buffer */ + luaL_oldbuffer(oldbuff); + if (status != 0) { + lua_endblock(); + lua_error(NULL); + } + res = lua_getresult(1); + if (lua_isstring(res)) + addnchar(lua_getstring(res), lua_strlen(res)); + lua_endblock(); + } +} + + +static void str_gsub (void) +{ + long srcl; + char *src = luaL_check_lstr(1, &srcl); + char *p = luaL_check_string(2); + lua_Object newp = lua_getparam(3); + int max_s = (int)luaL_opt_number(4, srcl+1); + int anchor = (*p == '^') ? (p++, 1) : 0; + int n = 0; + struct Capture cap; + luaL_arg_check(lua_isstring(newp) || lua_isfunction(newp), 3, + "string or function expected"); + luaL_resetbuffer(); + cap.src_end = src+srcl; + while (n < max_s) { + char *e; + cap.level = 0; + e = match(src, p, &cap); + if (e) { + n++; + add_s(newp, &cap); + } + if (e && e>src) /* non empty match? */ + src = e; /* skip it */ + else if (src < cap.src_end) + luaL_addchar(*src++); + else break; + if (anchor) break; + } + addnchar(src, cap.src_end-src); + closeandpush(); + lua_pushnumber(n); /* number of substitutions */ +} + + +static void luaI_addquoted (char *s) +{ + luaL_addchar('"'); + for (; *s; s++) { + if (strchr("\"\\\n", *s)) + luaL_addchar('\\'); + luaL_addchar(*s); + } + luaL_addchar('"'); +} + +#define MAX_FORMAT 200 + +static void str_format (void) +{ + int arg = 1; + char *strfrmt = luaL_check_string(arg); + struct Capture cap; + cap.src_end = strfrmt+strlen(strfrmt)+1; + luaL_resetbuffer(); + while (*strfrmt) { + if (*strfrmt != '%') + luaL_addchar(*strfrmt++); + else if (*++strfrmt == '%') + luaL_addchar(*strfrmt++); /* %% */ + else { /* format item */ + char form[MAX_FORMAT]; /* store the format ('%...') */ + char *buff; + char *initf = strfrmt; + form[0] = '%'; + cap.level = 0; + if (isdigit((unsigned char)initf[0]) && initf[1] == '$') { + arg = initf[0] - '0'; + initf += 2; /* skip the 'n$' */ + } + arg++; + strfrmt = match(initf, "[-+ #0]*(%d*)%.?(%d*)", &cap); + if (cap.capture[0].len > 2 || cap.capture[1].len > 2) /* < 100? */ + lua_error("invalid format (width or precision too long)"); + strncpy(form+1, initf, strfrmt-initf+1); /* +1 to include conversion */ + form[strfrmt-initf+2] = 0; + buff = luaL_openspace(1000); /* to store the formatted value */ + switch (*strfrmt++) { + case 'q': + luaI_addquoted(luaL_check_string(arg)); + continue; + case 's': { + char *s = luaL_check_string(arg); + buff = luaL_openspace(strlen(s)); + sprintf(buff, form, s); + break; + } + case 'c': case 'd': case 'i': + sprintf(buff, form, (int)luaL_check_number(arg)); + break; + case 'o': case 'u': case 'x': case 'X': + sprintf(buff, form, (unsigned int)luaL_check_number(arg)); + break; + case 'e': case 'E': case 'f': case 'g': case 'G': + sprintf(buff, form, luaL_check_number(arg)); + break; + default: /* also treat cases 'pnLlh' */ + lua_error("invalid option in `format'"); + } + luaL_addsize(strlen(buff)); + } + } + closeandpush(); /* push the result */ +} + + +static 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 */ +{"strbyte", str_byte}, +{"format", str_format}, +{"strfind", str_find}, +{"gsub", str_gsub} +}; + + +/* +** Open string library +*/ +void strlib_open (void) +{ + luaL_openlib(strlib, (sizeof(strlib)/sizeof(strlib[0]))); +} diff --git a/src/llex.c b/src/llex.c new file mode 100644 index 00000000..ec1966ca --- /dev/null +++ b/src/llex.c @@ -0,0 +1,463 @@ +/* +** $Id: llex.c,v 1.23 1998/07/06 22:04:58 roberto Exp $ +** Lexical Analizer +** See Copyright Notice in lua.h +*/ + + +#include <ctype.h> +#include <string.h> + +#include "lauxlib.h" +#include "llex.h" +#include "lmem.h" +#include "lobject.h" +#include "lparser.h" +#include "lstate.h" +#include "lstring.h" +#include "luadebug.h" +#include "lzio.h" + + + +int lua_debug=0; + + +#define next(LS) (LS->current = zgetc(LS->lex_z)) + + +#define save(c) luaL_addchar(c) +#define save_and_next(LS) (save(LS->current), next(LS)) + + +char *reserved [] = {"and", "do", "else", "elseif", "end", "function", + "if", "local", "nil", "not", "or", "repeat", "return", "then", + "until", "while"}; + + +void luaX_init (void) +{ + int i; + for (i=0; i<(sizeof(reserved)/sizeof(reserved[0])); i++) { + TaggedString *ts = luaS_new(reserved[i]); + ts->head.marked = FIRST_RESERVED+i; /* reserved word (always > 255) */ + } +} + + +void luaX_syntaxerror (LexState *ls, char *s, char *token) { + if (token[0] == 0) + token = "<eof>"; + luaL_verror("%.100s;\n last token read: `%.50s' at line %d in chunk `%.50s'", + s, token, ls->linenumber, zname(ls->lex_z)); +} + + +void luaX_error (LexState *ls, char *s) { + save(0); + luaX_syntaxerror(ls, s, luaL_buffer()); +} + + +void luaX_token2str (LexState *ls, int token, char *s) { + if (token < 255) { + s[0] = token; + s[1] = 0; + } + else + strcpy(s, reserved[token-FIRST_RESERVED]); +} + + +static void luaX_invalidchar (LexState *ls, int c) { + char buff[10]; + sprintf(buff, "0x%X", c); + luaX_syntaxerror(ls, "invalid control char", buff); +} + + +static void firstline (LexState *LS) +{ + int c = zgetc(LS->lex_z); + if (c == '#') + while ((c=zgetc(LS->lex_z)) != '\n' && c != EOZ) /* skip first line */; + zungetc(LS->lex_z); +} + + +void luaX_setinput (LexState *LS, ZIO *z) +{ + LS->current = '\n'; + LS->linenumber = 0; + LS->iflevel = 0; + LS->ifstate[0].skip = 0; + LS->ifstate[0].elsepart = 1; /* to avoid a free $else */ + LS->lex_z = z; + LS->fs = NULL; + firstline(LS); + luaL_resetbuffer(); +} + + + +/* +** ======================================================= +** PRAGMAS +** ======================================================= +*/ + +#define PRAGMASIZE 20 + +static void skipspace (LexState *LS) +{ + while (LS->current == ' ' || LS->current == '\t' || LS->current == '\r') + next(LS); +} + + +static int checkcond (LexState *LS, char *buff) +{ + static char *opts[] = {"nil", "1", NULL}; + int i = luaL_findstring(buff, opts); + if (i >= 0) return i; + else if (isalpha((unsigned char)buff[0]) || buff[0] == '_') + return luaS_globaldefined(buff); + else { + luaX_syntaxerror(LS, "invalid $if condition", buff); + return 0; /* to avoid warnings */ + } +} + + +static void readname (LexState *LS, char *buff) +{ + int i = 0; + skipspace(LS); + while (isalnum(LS->current) || LS->current == '_') { + if (i >= PRAGMASIZE) { + buff[PRAGMASIZE] = 0; + luaX_syntaxerror(LS, "pragma too long", buff); + } + buff[i++] = LS->current; + next(LS); + } + buff[i] = 0; +} + + +static void inclinenumber (LexState *LS); + + +static void ifskip (LexState *LS) +{ + while (LS->ifstate[LS->iflevel].skip) { + if (LS->current == '\n') + inclinenumber(LS); + else if (LS->current == EOZ) + luaX_error(LS, "input ends inside a $if"); + else next(LS); + } +} + + +static void inclinenumber (LexState *LS) +{ + static char *pragmas [] = + {"debug", "nodebug", "endinput", "end", "ifnot", "if", "else", NULL}; + next(LS); /* skip '\n' */ + ++LS->linenumber; + if (LS->current == '$') { /* is a pragma? */ + char buff[PRAGMASIZE+1]; + int ifnot = 0; + int skip = LS->ifstate[LS->iflevel].skip; + next(LS); /* skip $ */ + readname(LS, buff); + switch (luaL_findstring(buff, pragmas)) { + case 0: /* debug */ + if (!skip) lua_debug = 1; + break; + case 1: /* nodebug */ + if (!skip) lua_debug = 0; + break; + case 2: /* endinput */ + if (!skip) { + LS->current = EOZ; + LS->iflevel = 0; /* to allow $endinput inside a $if */ + } + break; + case 3: /* end */ + if (LS->iflevel-- == 0) + luaX_syntaxerror(LS, "unmatched $end", "$end"); + break; + case 4: /* ifnot */ + ifnot = 1; + /* go through */ + case 5: /* if */ + if (LS->iflevel == MAX_IFS-1) + luaX_syntaxerror(LS, "too many nested $ifs", "$if"); + readname(LS, buff); + LS->iflevel++; + LS->ifstate[LS->iflevel].elsepart = 0; + LS->ifstate[LS->iflevel].condition = checkcond(LS, buff) ? !ifnot : ifnot; + LS->ifstate[LS->iflevel].skip = skip || !LS->ifstate[LS->iflevel].condition; + break; + case 6: /* else */ + if (LS->ifstate[LS->iflevel].elsepart) + luaX_syntaxerror(LS, "unmatched $else", "$else"); + LS->ifstate[LS->iflevel].elsepart = 1; + LS->ifstate[LS->iflevel].skip = LS->ifstate[LS->iflevel-1].skip || + LS->ifstate[LS->iflevel].condition; + break; + default: + luaX_syntaxerror(LS, "unknown pragma", buff); + } + skipspace(LS); + if (LS->current == '\n') /* pragma must end with a '\n' ... */ + inclinenumber(LS); + else if (LS->current != EOZ) /* or eof */ + luaX_syntaxerror(LS, "invalid pragma format", buff); + ifskip(LS); + } +} + + +/* +** ======================================================= +** LEXICAL ANALIZER +** ======================================================= +*/ + + + + + +static int read_long_string (LexState *LS) +{ + int cont = 0; + while (1) { + switch (LS->current) { + case EOZ: + luaX_error(LS, "unfinished long string"); + return EOS; /* to avoid warnings */ + case '[': + save_and_next(LS); + if (LS->current == '[') { + cont++; + save_and_next(LS); + } + continue; + case ']': + save_and_next(LS); + if (LS->current == ']') { + if (cont == 0) goto endloop; + cont--; + save_and_next(LS); + } + continue; + case '\n': + save('\n'); + inclinenumber(LS); + continue; + default: + save_and_next(LS); + } + } endloop: + save_and_next(LS); /* pass the second ']' */ + LS->seminfo.ts = luaS_newlstr(L->Mbuffbase+2, + L->Mbuffnext-(L->Mbuffbase-L->Mbuffer)-4); + return STRING; +} + + +int luaX_lex (LexState *LS) { + double a; + luaL_resetbuffer(); + while (1) { + switch (LS->current) { + + case ' ': case '\t': case '\r': /* CR: to avoid problems with DOS */ + next(LS); + continue; + + case '\n': + inclinenumber(LS); + continue; + + case '-': + save_and_next(LS); + if (LS->current != '-') return '-'; + do { next(LS); } while (LS->current != '\n' && LS->current != EOZ); + luaL_resetbuffer(); + continue; + + case '[': + save_and_next(LS); + if (LS->current != '[') return '['; + else { + save_and_next(LS); /* pass the second '[' */ + return read_long_string(LS); + } + + case '=': + save_and_next(LS); + if (LS->current != '=') return '='; + else { save_and_next(LS); return EQ; } + + case '<': + save_and_next(LS); + if (LS->current != '=') return '<'; + else { save_and_next(LS); return LE; } + + case '>': + save_and_next(LS); + if (LS->current != '=') return '>'; + else { save_and_next(LS); return GE; } + + case '~': + save_and_next(LS); + if (LS->current != '=') return '~'; + else { save_and_next(LS); return NE; } + + case '"': + case '\'': { + int del = LS->current; + save_and_next(LS); + while (LS->current != del) { + switch (LS->current) { + case EOZ: + case '\n': + luaX_error(LS, "unfinished string"); + return EOS; /* to avoid warnings */ + case '\\': + next(LS); /* do not save the '\' */ + switch (LS->current) { + case 'a': save('\a'); next(LS); break; + case 'b': save('\b'); next(LS); break; + case 'f': save('\f'); next(LS); break; + case 'n': save('\n'); next(LS); break; + case 'r': save('\r'); next(LS); break; + case 't': save('\t'); next(LS); break; + case 'v': save('\v'); next(LS); break; + case '\n': save('\n'); inclinenumber(LS); break; + default : { + if (isdigit(LS->current)) { + int c = 0; + int i = 0; + do { + c = 10*c + (LS->current-'0'); + next(LS); + } while (++i<3 && isdigit(LS->current)); + if (c >= 256) + luaX_error(LS, "escape sequence too large"); + save(c); + } + else { /* handles \, ", ', and ? */ + save(LS->current); + next(LS); + } + break; + } + } + break; + default: + save_and_next(LS); + } + } + save_and_next(LS); /* skip delimiter */ + LS->seminfo.ts = luaS_newlstr(L->Mbuffbase+1, + L->Mbuffnext-(L->Mbuffbase-L->Mbuffer)-2); + return STRING; + } + + case '.': + save_and_next(LS); + if (LS->current == '.') + { + save_and_next(LS); + if (LS->current == '.') + { + save_and_next(LS); + return DOTS; /* ... */ + } + else return CONC; /* .. */ + } + else if (!isdigit(LS->current)) return '.'; + /* LS->current is a digit: goes through to number */ + a=0.0; + goto fraction; + + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + a=0.0; + do { + a = 10.0*a + (LS->current-'0'); + save_and_next(LS); + } while (isdigit(LS->current)); + if (LS->current == '.') { + save_and_next(LS); + if (LS->current == '.') { + save('.'); + luaX_error(LS, + "ambiguous syntax (decimal point x string concatenation)"); + } + } + fraction: + { double da=0.1; + while (isdigit(LS->current)) + { + a += (LS->current-'0')*da; + da /= 10.0; + save_and_next(LS); + } + if (toupper(LS->current) == 'E') { + int e = 0; + int neg; + double ea; + save_and_next(LS); + neg = (LS->current=='-'); + if (LS->current == '+' || LS->current == '-') save_and_next(LS); + if (!isdigit(LS->current)) + luaX_error(LS, "invalid numeral format"); + do { + e = 10*e + (LS->current-'0'); + save_and_next(LS); + } while (isdigit(LS->current)); + for (ea=neg?0.1:10.0; e>0; e>>=1) + { + if (e & 1) a *= ea; + ea *= ea; + } + } + LS->seminfo.r = a; + return NUMBER; + } + + case EOZ: + if (LS->iflevel > 0) + luaX_error(LS, "input ends inside a $if"); + return EOS; + + default: + if (LS->current != '_' && !isalpha(LS->current)) { + int c = LS->current; + if (iscntrl(c)) + luaX_invalidchar(LS, c); + save_and_next(LS); + return c; + } + else { /* identifier or reserved word */ + TaggedString *ts; + do { + save_and_next(LS); + } while (isalnum(LS->current) || LS->current == '_'); + save(0); + ts = luaS_new(L->Mbuffbase); + if (ts->head.marked >= 'A') + return ts->head.marked; /* reserved word */ + LS->seminfo.ts = ts; + return NAME; + } + } + } +} + diff --git a/src/llex.h b/src/llex.h new file mode 100644 index 00000000..ba8c52a3 --- /dev/null +++ b/src/llex.h @@ -0,0 +1,62 @@ +/* +** $Id: llex.h,v 1.9 1998/06/19 16:14:09 roberto Exp $ +** Lexical Analizer +** See Copyright Notice in lua.h +*/ + +#ifndef llex_h +#define llex_h + +#include "lobject.h" +#include "lzio.h" + + +#define FIRST_RESERVED 260 + +/* maximum length of a reserved word (+1 for terminal 0) */ +#define TOKEN_LEN 15 + +enum RESERVED { + /* terminal symbols denoted by reserved words */ + AND = FIRST_RESERVED, + DO, ELSE, ELSEIF, END, FUNCTION, IF, LOCAL, NIL, NOT, OR, + REPEAT, RETURN, THEN, UNTIL, WHILE, + /* other terminal symbols */ + NAME, CONC, DOTS, EQ, GE, LE, NE, NUMBER, STRING, EOS}; + + +#define MAX_IFS 5 + +/* "ifstate" keeps the state of each nested $if the lexical is dealing with. */ + +struct ifState { + int elsepart; /* true if its in the $else part */ + int condition; /* true if $if condition is true */ + int skip; /* true if part must be skipped */ +}; + + +typedef struct LexState { + int current; /* look ahead character */ + int token; /* look ahead token */ + struct FuncState *fs; /* 'FuncState' is private for the parser */ + union { + real r; + TaggedString *ts; + } seminfo; /* semantics information */ + struct zio *lex_z; /* input stream */ + int linenumber; /* input line counter */ + int iflevel; /* level of nested $if's (for lexical analysis) */ + struct ifState ifstate[MAX_IFS]; +} LexState; + + +void luaX_init (void); +void luaX_setinput (LexState *LS, ZIO *z); +int luaX_lex (LexState *LS); +void luaX_syntaxerror (LexState *ls, char *s, char *token); +void luaX_error (LexState *ls, char *s); +void luaX_token2str (LexState *ls, int token, char *s); + + +#endif diff --git a/src/lmem.c b/src/lmem.c new file mode 100644 index 00000000..bcb3c8e9 --- /dev/null +++ b/src/lmem.c @@ -0,0 +1,113 @@ +/* +** $Id: lmem.c,v 1.7 1998/06/29 22:03:06 roberto Exp $ +** Interface to Memory Manager +** See Copyright Notice in lua.h +*/ + + +#include <stdlib.h> + +#include "lmem.h" +#include "lstate.h" +#include "lua.h" + + + +int luaM_growaux (void **block, unsigned long nelems, int size, + char *errormsg, unsigned long limit) +{ + if (nelems >= limit) + lua_error(errormsg); + nelems = (nelems == 0) ? 32 : nelems*2; + if (nelems > limit) + nelems = limit; + *block = luaM_realloc(*block, nelems*size); + return (int)nelems; +} + + + +#ifndef DEBUG + +/* +** generic allocation routine. +** real ANSI systems do not need some of these tests, +** since realloc(NULL, s)==malloc(s) and realloc(b, 0)==free(b). +** But some systems (e.g. Sun OS) are not that ANSI... +*/ +void *luaM_realloc (void *block, unsigned long size) +{ + size_t s = (size_t)size; + if (s != size) + lua_error("Allocation Error: Block too big"); + if (size == 0) { + if (block) { + free(block); + } + return NULL; + } + block = block ? realloc(block, s) : malloc(s); + if (block == NULL) + lua_error(memEM); + return block; +} + + + +#else +/* DEBUG */ + +#include <string.h> + + +#define HEADER (sizeof(double)) + +#define MARK 55 + +unsigned long numblocks = 0; +unsigned long totalmem = 0; + + +static void *checkblock (void *block) +{ + unsigned long *b = (unsigned long *)((char *)block - HEADER); + unsigned long size = *b; + LUA_ASSERT(*(((char *)b)+size+HEADER) == MARK, + "corrupted block"); + numblocks--; + totalmem -= size; + return b; +} + + +void *luaM_realloc (void *block, unsigned long size) +{ + unsigned long realsize = HEADER+size+1; + if (realsize != (size_t)realsize) + lua_error("Allocation Error: Block too big"); + if (size == 0) { /* ANSI dosen't need this, but some machines... */ + if (block) { + unsigned long *b = (unsigned long *)((char *)block - HEADER); + memset(block, -1, *b); /* erase block */ + block = checkblock(block); + free(block); + } + return NULL; + } + if (block) { + block = checkblock(block); + block = (unsigned long *)realloc(block, realsize); + } + else + block = (unsigned long *)malloc(realsize); + if (block == NULL) + lua_error(memEM); + totalmem += size; + numblocks++; + *(unsigned long *)block = size; + *(((char *)block)+size+HEADER) = MARK; + return (unsigned long *)((char *)block+HEADER); +} + + +#endif diff --git a/src/lmem.h b/src/lmem.h new file mode 100644 index 00000000..3c63a534 --- /dev/null +++ b/src/lmem.h @@ -0,0 +1,43 @@ +/* +** $Id: lmem.h,v 1.5 1997/12/17 20:48:58 roberto Exp $ +** Interface to Memory Manager +** See Copyright Notice in lua.h +*/ + +#ifndef lmem_h +#define lmem_h + + +#ifndef NULL +#define NULL 0 +#endif + + +/* memory error messages */ +#define codeEM "code size overflow" +#define constantEM "constant table overflow" +#define refEM "reference table overflow" +#define tableEM "table overflow" +#define memEM "not enough memory" + +void *luaM_realloc (void *oldblock, unsigned long size); +int luaM_growaux (void **block, unsigned long nelems, int size, + char *errormsg, unsigned long limit); + +#define luaM_free(b) luaM_realloc((b), 0) +#define luaM_malloc(t) luaM_realloc(NULL, (t)) +#define luaM_new(t) ((t *)luaM_malloc(sizeof(t))) +#define luaM_newvector(n,t) ((t *)luaM_malloc((n)*sizeof(t))) +#define luaM_growvector(old,n,t,e,l) \ + (luaM_growaux((void**)old,n,sizeof(t),e,l)) +#define luaM_reallocvector(v,n,t) ((t *)luaM_realloc(v,(n)*sizeof(t))) + + +#ifdef DEBUG +extern unsigned long numblocks; +extern unsigned long totalmem; +#endif + + +#endif + diff --git a/src/lobject.c b/src/lobject.c new file mode 100644 index 00000000..8d331ef9 --- /dev/null +++ b/src/lobject.c @@ -0,0 +1,83 @@ +/* +** $Id: lobject.c,v 1.13 1998/06/19 16:14:09 roberto Exp $ +** Some generic functions over Lua objects +** See Copyright Notice in lua.h +*/ + +#include <stdlib.h> + +#include "lobject.h" +#include "lua.h" + + +char *luaO_typenames[] = { /* ORDER LUA_T */ + "userdata", "number", "string", "table", "function", "function", + "nil", "function", "mark", "mark", "mark", "line", NULL +}; + + +TObject luaO_nilobject = {LUA_T_NIL, {NULL}}; + + + +/* hash dimensions values */ +static long dimensions[] = + {5L, 11L, 23L, 47L, 97L, 197L, 397L, 797L, 1597L, 3203L, 6421L, + 12853L, 25717L, 51437L, 102811L, 205619L, 411233L, 822433L, + 1644817L, 3289613L, 6579211L, 13158023L, MAX_INT}; + + +int luaO_redimension (int oldsize) +{ + int i; + for (i=0; dimensions[i]<MAX_INT; i++) { + if (dimensions[i] > oldsize) + return dimensions[i]; + } + lua_error("table overflow"); + return 0; /* to avoid warnings */ +} + + +int luaO_equalObj (TObject *t1, TObject *t2) +{ + if (ttype(t1) != ttype(t2)) return 0; + switch (ttype(t1)) { + case LUA_T_NIL: return 1; + case LUA_T_NUMBER: return nvalue(t1) == nvalue(t2); + case LUA_T_STRING: case LUA_T_USERDATA: return svalue(t1) == svalue(t2); + case LUA_T_ARRAY: return avalue(t1) == avalue(t2); + case LUA_T_PROTO: return tfvalue(t1) == tfvalue(t2); + case LUA_T_CPROTO: return fvalue(t1) == fvalue(t2); + case LUA_T_CLOSURE: return t1->value.cl == t2->value.cl; + default: + LUA_INTERNALERROR("invalid type"); + return 0; /* UNREACHABLE */ + } +} + + +void luaO_insertlist (GCnode *root, GCnode *node) +{ + node->next = root->next; + root->next = node; + node->marked = 0; +} + +#ifdef OLD_ANSI +void luaO_memup (void *dest, void *src, int size) +{ + char *d = dest; + char *s = src; + while (size--) d[size]=s[size]; +} + +void luaO_memdown (void *dest, void *src, int size) +{ + char *d = dest; + char *s = src; + int i; + for (i=0; i<size; i++) d[i]=s[i]; +} +#endif + diff --git a/src/lobject.h b/src/lobject.h new file mode 100644 index 00000000..fbd6070c --- /dev/null +++ b/src/lobject.h @@ -0,0 +1,210 @@ +/* +** $Id: lobject.h,v 1.21 1998/06/18 16:57:03 roberto Exp $ +** Type definitions for Lua objects +** See Copyright Notice in lua.h +*/ + +#ifndef lobject_h +#define lobject_h + + +#include <limits.h> + +#include "lua.h" + + +#ifdef DEBUG +#include "lauxlib.h" +#define LUA_INTERNALERROR(s) \ + luaL_verror("INTERNAL ERROR - %s [%s:%d]",(s),__FILE__,__LINE__) +#define LUA_ASSERT(c,s) { if (!(c)) LUA_INTERNALERROR(s); } +#else +#define LUA_INTERNALERROR(s) /* empty */ +#define LUA_ASSERT(c,s) /* empty */ +#endif + + +/* +** "real" is the type "number" of Lua +** GREP LUA_NUMBER to change that +*/ +#ifndef LUA_NUM_TYPE +#define LUA_NUM_TYPE double +#endif + +/* +** format to convert number to strings +*/ +#define NUMBER_FMT "%g" + +typedef LUA_NUM_TYPE real; + +#define Byte lua_Byte /* some systems have Byte as a predefined type */ +typedef unsigned char Byte; /* unsigned 8 bits */ + + +#define MAX_INT (INT_MAX-2) /* maximum value of an int (-2 for safety) */ + +/* maximum value of a word of 2 bytes (-2 for safety); must fit in an "int" */ +#if MAX_INT < 65534 +#define MAX_WORD MAX_INT +#else +#define MAX_WORD 65534 +#endif + +typedef unsigned int IntPoint; /* unsigned with same size as a pointer (for hashing) */ + + +/* +** Lua TYPES +** WARNING: if you change the order of this enumeration, +** grep "ORDER LUA_T" +*/ +typedef enum { + LUA_T_USERDATA = 0, /* tag default for userdata */ + LUA_T_NUMBER = -1, /* fixed tag for numbers */ + LUA_T_STRING = -2, /* fixed tag for strings */ + LUA_T_ARRAY = -3, /* tag default for tables (or arrays) */ + LUA_T_PROTO = -4, /* fixed tag for functions */ + LUA_T_CPROTO = -5, /* fixed tag for Cfunctions */ + LUA_T_NIL = -6, /* last "pre-defined" tag */ + LUA_T_CLOSURE = -7, + LUA_T_CLMARK = -8, /* mark for closures */ + LUA_T_PMARK = -9, /* mark for Lua prototypes */ + LUA_T_CMARK = -10, /* mark for C prototypes */ + LUA_T_LINE = -11 +} lua_Type; + +#define NUM_TYPES 11 +#define NUM_TAGS 7 + + +typedef union { + lua_CFunction f; /* LUA_T_CPROTO, LUA_T_CMARK */ + real n; /* LUA_T_NUMBER */ + struct TaggedString *ts; /* LUA_T_STRING, LUA_T_USERDATA */ + struct TProtoFunc *tf; /* LUA_T_PROTO, LUA_T_PMARK */ + struct Closure *cl; /* LUA_T_CLOSURE, LUA_T_CLMARK */ + struct Hash *a; /* LUA_T_ARRAY */ + int i; /* LUA_T_LINE */ +} Value; + + +typedef struct TObject { + lua_Type ttype; + Value value; +} TObject; + + + +/* +** generic header for garbage collector lists +*/ +typedef struct GCnode { + struct GCnode *next; + int marked; +} GCnode; + + +/* +** String headers for string table +*/ + +typedef struct TaggedString { + GCnode head; + unsigned long hash; + int constindex; /* hint to reuse constants (= -1 if this is a userdata) */ + union { + struct { + TObject globalval; + long len; /* if this is a string, here is its length */ + } s; + struct { + int tag; + void *v; /* if this is a userdata, here is its value */ + } d; + } u; + char str[1]; /* \0 byte already reserved */ +} TaggedString; + + + + +/* +** Function Prototypes +*/ +typedef struct TProtoFunc { + GCnode head; + struct TObject *consts; + int nconsts; + Byte *code; /* ends with opcode ENDCODE */ + int lineDefined; + TaggedString *fileName; + struct LocVar *locvars; /* ends with line = -1 */ +} TProtoFunc; + +typedef struct LocVar { + TaggedString *varname; /* NULL signals end of scope */ + int line; +} LocVar; + + + + + +/* Macros to access structure members */ +#define ttype(o) ((o)->ttype) +#define nvalue(o) ((o)->value.n) +#define svalue(o) ((o)->value.ts->str) +#define tsvalue(o) ((o)->value.ts) +#define clvalue(o) ((o)->value.cl) +#define avalue(o) ((o)->value.a) +#define fvalue(o) ((o)->value.f) +#define tfvalue(o) ((o)->value.tf) + +#define protovalue(o) ((o)->value.cl->consts) + + +/* +** Closures +*/ +typedef struct Closure { + GCnode head; + int nelems; /* not included the first one (always the prototype) */ + TObject consts[1]; /* at least one for prototype */ +} Closure; + + + +typedef struct node { + TObject ref; + TObject val; +} Node; + +typedef struct Hash { + GCnode head; + Node *node; + int nhash; + int nuse; + int htag; +} Hash; + + +extern char *luaO_typenames[]; + +extern TObject luaO_nilobject; + +int luaO_equalObj (TObject *t1, TObject *t2); +int luaO_redimension (int oldsize); +void luaO_insertlist (GCnode *root, GCnode *node); + +#ifdef OLD_ANSI +void luaO_memup (void *dest, void *src, int size); +void luaO_memdown (void *dest, void *src, int size); +#else +#include <string.h> +#define luaO_memup(d,s,n) memmove(d,s,n) +#define luaO_memdown(d,s,n) memmove(d,s,n) +#endif + +#endif diff --git a/src/lopcodes.h b/src/lopcodes.h new file mode 100644 index 00000000..27dded47 --- /dev/null +++ b/src/lopcodes.h @@ -0,0 +1,181 @@ +/* +** $Id: lopcodes.h,v 1.18 1998/06/25 14:37:00 roberto Exp $ +** Opcodes for Lua virtual machine +** See Copyright Notice in lua.h +*/ + +#ifndef lopcodes_h +#define lopcodes_h + + +/* +** NOTICE: variants of the same opcode must be consecutive: First, those +** with byte parameter, then with built-in parameters, and last with +** word parameter. +*/ + + +typedef enum { +/* name parm before after side effect +-----------------------------------------------------------------------------*/ +ENDCODE,/* - - - */ + +PUSHNIL,/* b - nil_0...nil_b */ +PUSHNIL0,/* - - nil */ + +PUSHNUMBER,/* b - (float)b */ +PUSHNUMBER0,/* - - 0.0 */ +PUSHNUMBER1,/* - - 1.0 */ +PUSHNUMBER2,/* - - 2.0 */ +PUSHNUMBERW,/* w - (float)w */ + +PUSHCONSTANT,/* b - CNST[b] */ +PUSHCONSTANT0,/*- - CNST[0] */ +PUSHCONSTANT1,/*- - CNST[1] */ +PUSHCONSTANT2,/*- - CNST[2] */ +PUSHCONSTANT3,/*- - CNST[3] */ +PUSHCONSTANT4,/*- - CNST[4] */ +PUSHCONSTANT5,/*- - CNST[5] */ +PUSHCONSTANT6,/*- - CNST[6] */ +PUSHCONSTANT7,/*- - CNST[7] */ +PUSHCONSTANTW,/*w - CNST[w] */ + +PUSHUPVALUE,/* b - Closure[b] */ +PUSHUPVALUE0,/* - - Closure[0] */ +PUSHUPVALUE1,/* - - Closure[1] */ + +PUSHLOCAL,/* b - LOC[b] */ +PUSHLOCAL0,/* - - LOC[0] */ +PUSHLOCAL1,/* - - LOC[1] */ +PUSHLOCAL2,/* - - LOC[2] */ +PUSHLOCAL3,/* - - LOC[3] */ +PUSHLOCAL4,/* - - LOC[4] */ +PUSHLOCAL5,/* - - LOC[5] */ +PUSHLOCAL6,/* - - LOC[6] */ +PUSHLOCAL7,/* - - LOC[7] */ + +GETGLOBAL,/* b - VAR[CNST[b]] */ +GETGLOBAL0,/* - - VAR[CNST[0]] */ +GETGLOBAL1,/* - - VAR[CNST[1]] */ +GETGLOBAL2,/* - - VAR[CNST[2]] */ +GETGLOBAL3,/* - - VAR[CNST[3]] */ +GETGLOBAL4,/* - - VAR[CNST[4]] */ +GETGLOBAL5,/* - - VAR[CNST[5]] */ +GETGLOBAL6,/* - - VAR[CNST[6]] */ +GETGLOBAL7,/* - - VAR[CNST[7]] */ +GETGLOBALW,/* w - VAR[CNST[w]] */ + +GETTABLE,/* - i t t[i] */ + +GETDOTTED,/* b t t[CNST[b]] */ +GETDOTTED0,/* - t t[CNST[0]] */ +GETDOTTED1,/* - t t[CNST[1]] */ +GETDOTTED2,/* - t t[CNST[2]] */ +GETDOTTED3,/* - t t[CNST[3]] */ +GETDOTTED4,/* - t t[CNST[4]] */ +GETDOTTED5,/* - t t[CNST[5]] */ +GETDOTTED6,/* - t t[CNST[6]] */ +GETDOTTED7,/* - t t[CNST[7]] */ +GETDOTTEDW,/* w t t[CNST[w]] */ + +PUSHSELF,/* b t t t[CNST[b]] */ +PUSHSELF0,/* - t t t[CNST[0]] */ +PUSHSELF1,/* - t t t[CNST[1]] */ +PUSHSELF2,/* - t t t[CNST[2]] */ +PUSHSELF3,/* - t t t[CNST[3]] */ +PUSHSELF4,/* - t t t[CNST[4]] */ +PUSHSELF5,/* - t t t[CNST[5]] */ +PUSHSELF6,/* - t t t[CNST[6]] */ +PUSHSELF7,/* - t t t[CNST[7]] */ +PUSHSELFW,/* w t t t[CNST[w]] */ + +CREATEARRAY,/* b - newarray(size = b) */ +CREATEARRAY0,/* - - newarray(size = 0) */ +CREATEARRAY1,/* - - newarray(size = 1) */ +CREATEARRAYW,/* w - newarray(size = w) */ + +SETLOCAL,/* b x - LOC[b]=x */ +SETLOCAL0,/* - x - LOC[0]=x */ +SETLOCAL1,/* - x - LOC[1]=x */ +SETLOCAL2,/* - x - LOC[2]=x */ +SETLOCAL3,/* - x - LOC[3]=x */ +SETLOCAL4,/* - x - LOC[4]=x */ +SETLOCAL5,/* - x - LOC[5]=x */ +SETLOCAL6,/* - x - LOC[6]=x */ +SETLOCAL7,/* - x - LOC[7]=x */ + +SETGLOBAL,/* b x - VAR[CNST[b]]=x */ +SETGLOBAL0,/* - x - VAR[CNST[0]]=x */ +SETGLOBAL1,/* - x - VAR[CNST[1]]=x */ +SETGLOBAL2,/* - x - VAR[CNST[2]]=x */ +SETGLOBAL3,/* - x - VAR[CNST[3]]=x */ +SETGLOBAL4,/* - x - VAR[CNST[4]]=x */ +SETGLOBAL5,/* - x - VAR[CNST[5]]=x */ +SETGLOBAL6,/* - x - VAR[CNST[6]]=x */ +SETGLOBAL7,/* - x - VAR[CNST[7]]=x */ +SETGLOBALW,/* w x - VAR[CNST[w]]=x */ + +SETTABLE0,/* - v i t - t[i]=v */ + +SETTABLE,/* b v a_b...a_1 i t a_b...a_1 i t t[i]=v */ + +SETLIST,/* b c v_c...v_1 t - t[i+b*FPF]=v_i */ +SETLIST0,/* b v_b...v_1 t - t[i]=v_i */ +SETLISTW,/* w c v_c...v_1 t - t[i+w*FPF]=v_i */ + +SETMAP,/* b v_b k_b ...v_0 k_0 t t t[k_i]=v_i */ +SETMAP0,/* - v_0 k_0 t t t[k_0]=v_0 */ + +EQOP,/* - y x (x==y)? 1 : nil */ +NEQOP,/* - y x (x~=y)? 1 : nil */ +LTOP,/* - y x (x<y)? 1 : nil */ +LEOP,/* - y x (x<y)? 1 : nil */ +GTOP,/* - y x (x>y)? 1 : nil */ +GEOP,/* - y x (x>=y)? 1 : nil */ +ADDOP,/* - y x x+y */ +SUBOP,/* - y x x-y */ +MULTOP,/* - y x x*y */ +DIVOP,/* - y x x/y */ +POWOP,/* - y x x^y */ +CONCOP,/* - y x x..y */ +MINUSOP,/* - x -x */ +NOTOP,/* - x (x==nil)? 1 : nil */ + +ONTJMP,/* b x (x!=nil)? x : - (x!=nil)? PC+=b */ +ONTJMPW,/* w x (x!=nil)? x : - (x!=nil)? PC+=w */ +ONFJMP,/* b x (x==nil)? x : - (x==nil)? PC+=b */ +ONFJMPW,/* w x (x==nil)? x : - (x==nil)? PC+=w */ +JMP,/* b - - PC+=b */ +JMPW,/* w - - PC+=w */ +IFFJMP,/* b x - (x==nil)? PC+=b */ +IFFJMPW,/* w x - (x==nil)? PC+=w */ +IFTUPJMP,/* b x - (x!=nil)? PC-=b */ +IFTUPJMPW,/* w x - (x!=nil)? PC-=w */ +IFFUPJMP,/* b x - (x==nil)? PC-=b */ +IFFUPJMPW,/* w x - (x==nil)? PC-=w */ + +CLOSURE,/* b c v_c...v_1 closure(CNST[b], v_c...v_1) */ +CLOSUREW,/* w c v_b...v_1 closure(CNST[w], v_c...v_1) */ + +CALLFUNC,/* b c v_c...v_1 f r_b...r_1 f(v1,...,v_c) */ +CALLFUNC0,/* b v_b...v_1 f - f(v1,...,v_b) */ +CALLFUNC1,/* b v_b...v_1 f r_1 f(v1,...,v_b) */ + +RETCODE,/* b - - */ + +SETLINE,/* b - - LINE=b */ +SETLINEW,/* w - - LINE=w */ + +POP,/* b - - TOP-=(b+1) */ +POP0,/* - - - TOP-=1 */ +POP1/* - - - TOP-=2 */ + +} OpCode; + + +#define RFIELDS_PER_FLUSH 32 /* records (SETMAP) */ +#define LFIELDS_PER_FLUSH 64 /* lists (SETLIST) */ + +#define ZEROVARARG 64 + +#endif diff --git a/src/lparser.c b/src/lparser.c new file mode 100644 index 00000000..9b37d9df --- /dev/null +++ b/src/lparser.c @@ -0,0 +1,1333 @@ +/* +** $Id: lparser.c,v 1.3 1998/07/06 22:07:51 roberto Exp $ +** LL(1) Parser and code generator for Lua +** See Copyright Notice in lua.h +*/ + + +#include <stdio.h> + +#include "lauxlib.h" +#include "ldo.h" +#include "lfunc.h" +#include "llex.h" +#include "lmem.h" +#include "lopcodes.h" +#include "lparser.h" +#include "lstate.h" +#include "lstring.h" +#include "lua.h" +#include "luadebug.h" +#include "lzio.h" + + +/* for limit numbers in error messages */ +#define MES_LIM(x) "(limit=" x ")" + + +/* size of a "normal" jump instruction: OpCode + 1 byte */ +#define JMPSIZE 2 + +/* maximum number of local variables */ +#define MAXLOCALS 32 +#define SMAXLOCALS "32" + + +/* maximum number of upvalues */ +#define MAXUPVALUES 16 +#define SMAXUPVALUES "16" + + +/* +** Variable descriptor: +** must include a "exp" option because LL(1) cannot distinguish +** between variables, upvalues and function calls on first sight. +** VGLOBAL: info is constant index of global name +** VLOCAL: info is stack index +** VDOT: info is constant index of index name +** VEXP: info is pc index of "nparam" of function call (or 0 if exp is closed) +*/ +typedef enum {VGLOBAL, VLOCAL, VDOT, VINDEXED, VEXP} varkind; + +typedef struct { + varkind k; + int info; +} vardesc; + + +/* +** Expression List descriptor: +** tells number of expressions in the list, +** and, if last expression is open (a function call), +** where is its pc index of "nparam" +*/ +typedef struct { + int n; + int pc; /* 0 if last expression is closed */ +} listdesc; + + +/* +** 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 { + int n; + int k; +} constdesc; + + +/* state needed to generate code for a given function */ +typedef struct FuncState { + TProtoFunc *f; /* current function header */ + struct FuncState *prev; /* enclosuring function */ + int pc; /* next position to code */ + int stacksize; /* number of values on activation register */ + int maxstacksize; /* maximum number of values on activation register */ + int nlocalvar; /* number of active local variables */ + int nupvalues; /* number of upvalues */ + int nvars; /* number of entries in f->locvars */ + int maxcode; /* size of f->code */ + int maxvars; /* size of f->locvars (-1 if no debug information) */ + int maxconsts; /* size of f->consts */ + int lastsetline; /* line where last SETLINE was issued */ + vardesc upvalues[MAXUPVALUES]; /* upvalues */ + TaggedString *localvar[MAXLOCALS]; /* store local variable names */ +} FuncState; + + +static int assignment (LexState *ls, vardesc *v, int nvars); +static int cond (LexState *ls); +static int funcname (LexState *ls, vardesc *v); +static int funcparams (LexState *ls, int slf); +static int listfields (LexState *ls); +static int localnamelist (LexState *ls); +static int optional (LexState *ls, int c); +static int recfields (LexState *ls); +static int stat (LexState *ls); +static void block (LexState *ls); +static void body (LexState *ls, int needself, int line); +static void chunk (LexState *ls); +static void constructor (LexState *ls); +static void decinit (LexState *ls, listdesc *d); +static void exp0 (LexState *ls, vardesc *v); +static void exp1 (LexState *ls); +static void exp2 (LexState *ls, vardesc *v); +static void explist (LexState *ls, listdesc *e); +static void explist1 (LexState *ls, listdesc *e); +static void ifpart (LexState *ls); +static void parlist (LexState *ls); +static void part (LexState *ls, constdesc *cd); +static void recfield (LexState *ls); +static void ret (LexState *ls); +static void simpleexp (LexState *ls, vardesc *v); +static void statlist (LexState *ls); +static void var_or_func (LexState *ls, vardesc *v); +static void var_or_func_tail (LexState *ls, vardesc *v); + + + +static void check_pc (FuncState *fs, int n) { + if (fs->pc+n > fs->maxcode) + fs->maxcode = luaM_growvector(&fs->f->code, fs->maxcode, + Byte, codeEM, MAX_INT); +} + + +static void code_byte (FuncState *fs, Byte c) { + check_pc(fs, 1); + fs->f->code[fs->pc++] = c; +} + + +static void deltastack (LexState *ls, int delta) { + FuncState *fs = ls->fs; + fs->stacksize += delta; + if (fs->stacksize > fs->maxstacksize) { + if (fs->stacksize > 255) + luaX_error(ls, "function/expression too complex"); + fs->maxstacksize = fs->stacksize; + } +} + + +static int code_oparg_at (LexState *ls, int pc, OpCode op, int builtin, + int arg, int delta) { + Byte *code = ls->fs->f->code; + deltastack(ls, delta); + if (arg < builtin) { + code[pc] = op+1+arg; + return 1; + } + else if (arg <= 255) { + code[pc] = op; + code[pc+1] = arg; + return 2; + } + else if (arg <= MAX_WORD) { + code[pc] = op+1+builtin; + code[pc+1] = arg>>8; + code[pc+2] = arg&0xFF; + return 3; + } + else luaX_error(ls, "code too long " MES_LIM("64K")); + return 0; /* to avoid warnings */ +} + + +static int fix_opcode (LexState *ls, int pc, OpCode op, int builtin, int arg) { + FuncState *fs = ls->fs; + TProtoFunc *f = fs->f; + if (arg < builtin) { /* close space */ + luaO_memdown(f->code+pc+1, f->code+pc+2, fs->pc-(pc+2)); + fs->pc--; + } + else if (arg > 255) { /* open space */ + check_pc(fs, 1); + luaO_memup(f->code+pc+1, f->code+pc, fs->pc-pc); + fs->pc++; + } + return code_oparg_at(ls, pc, op, builtin, arg, 0) - 2; +} + +static void code_oparg (LexState *ls, OpCode op, int builtin, int arg, + int delta) { + check_pc(ls->fs, 3); /* maximum code size */ + ls->fs->pc += code_oparg_at(ls, ls->fs->pc, op, builtin, arg, delta); +} + + +static void code_opcode (LexState *ls, OpCode op, int delta) { + deltastack(ls, delta); + code_byte(ls->fs, op); +} + + +static void code_constant (LexState *ls, int c) { + code_oparg(ls, PUSHCONSTANT, 8, c, 1); +} + + +static int next_constant (FuncState *fs) { + TProtoFunc *f = fs->f; + if (f->nconsts >= fs->maxconsts) { + fs->maxconsts = luaM_growvector(&f->consts, fs->maxconsts, TObject, + constantEM, MAX_WORD); + } + return f->nconsts++; +} + + +static int string_constant (FuncState *fs, TaggedString *s) { + TProtoFunc *f = fs->f; + int c = s->constindex; + if (!(c < f->nconsts && + ttype(&f->consts[c]) == LUA_T_STRING && tsvalue(&f->consts[c]) == s)) { + c = next_constant(fs); + ttype(&f->consts[c]) = LUA_T_STRING; + tsvalue(&f->consts[c]) = s; + s->constindex = c; /* hint for next time */ + } + return c; +} + + +static void code_string (LexState *ls, TaggedString *s) { + code_constant(ls, string_constant(ls->fs, s)); +} + + +#define LIM 20 +static int real_constant (FuncState *fs, real r) { + /* check whether 'r' has appeared within the last LIM entries */ + TObject *cnt = fs->f->consts; + int c = fs->f->nconsts; + int lim = c < LIM ? 0 : c-LIM; + while (--c >= lim) { + if (ttype(&cnt[c]) == LUA_T_NUMBER && nvalue(&cnt[c]) == r) + return c; + } + /* not found; create a luaM_new entry */ + c = next_constant(fs); + cnt = fs->f->consts; /* 'next_constant' may reallocate this vector */ + ttype(&cnt[c]) = LUA_T_NUMBER; + nvalue(&cnt[c]) = r; + return c; +} + + +static void code_number (LexState *ls, real f) { + int i; + if (f >= 0 && f <= (real)MAX_WORD && (real)(i=(int)f) == f) + code_oparg(ls, PUSHNUMBER, 3, i, 1); /* f has a short integer value */ + else + code_constant(ls, real_constant(ls->fs, f)); +} + + +static void flush_record (LexState *ls, int n) { + if (n > 0) + code_oparg(ls, SETMAP, 1, n-1, -2*n); +} + + +static void flush_list (LexState *ls, int m, int n) { + if (n == 0) return; + code_oparg(ls, SETLIST, 1, m, -n); + code_byte(ls->fs, n); +} + + +static void luaI_registerlocalvar (FuncState *fs, TaggedString *varname, + int line) { + if (fs->maxvars != -1) { /* debug information? */ + TProtoFunc *f = fs->f; + if (fs->nvars >= fs->maxvars) + fs->maxvars = luaM_growvector(&f->locvars, fs->maxvars, + LocVar, "", MAX_WORD); + f->locvars[fs->nvars].varname = varname; + f->locvars[fs->nvars].line = line; + fs->nvars++; + } +} + + +static void luaI_unregisterlocalvar (FuncState *fs, int line) { + luaI_registerlocalvar(fs, NULL, line); +} + + +static void store_localvar (LexState *ls, TaggedString *name, int n) { + FuncState *fs = ls->fs; + if (fs->nlocalvar+n < MAXLOCALS) + fs->localvar[fs->nlocalvar+n] = name; + else + luaX_error(ls, "too many local variables " MES_LIM(SMAXLOCALS)); + luaI_registerlocalvar(fs, name, ls->linenumber); +} + + +static void add_localvar (LexState *ls, TaggedString *name) { + store_localvar(ls, name, 0); + ls->fs->nlocalvar++; +} + + +static int aux_localname (FuncState *fs, TaggedString *n) { + int i; + for (i=fs->nlocalvar-1; i >= 0; i--) + if (n == fs->localvar[i]) return i; /* local var index */ + return -1; /* not found */ +} + + +static void singlevar (LexState *ls, TaggedString *n, vardesc *var, int prev) { + FuncState *fs = prev ? ls->fs->prev : ls->fs; + int i = aux_localname(fs, n); + if (i >= 0) { /* local value */ + var->k = VLOCAL; + var->info = i; + } + else { /* check shadowing */ + FuncState *level = fs; + while ((level = level->prev) != NULL) + if (aux_localname(level, n) >= 0) + luaX_syntaxerror(ls, "cannot access a variable in outer scope", n->str); + var->k = VGLOBAL; + var->info = string_constant(fs, n); + } +} + + +static int indexupvalue (LexState *ls, TaggedString *n) { + FuncState *fs = ls->fs; + vardesc v; + int i; + singlevar(ls, n, &v, 1); + for (i=0; i<fs->nupvalues; i++) { + if (fs->upvalues[i].k == v.k && fs->upvalues[i].info == v.info) + return i; + } + /* new one */ + if (++(fs->nupvalues) > MAXUPVALUES) + luaX_error(ls, "too many upvalues in a single function " + MES_LIM(SMAXUPVALUES)); + fs->upvalues[i] = v; /* i = fs->nupvalues - 1 */ + return i; +} + + +static void pushupvalue (LexState *ls, TaggedString *n) { + int i; + if (ls->fs->prev == NULL) + luaX_syntaxerror(ls, "cannot access upvalue in main", n->str); + if (aux_localname(ls->fs, n) >= 0) + luaX_syntaxerror(ls, "cannot access an upvalue in current scope", n->str); + i = indexupvalue(ls, n); + code_oparg(ls, PUSHUPVALUE, 2, i, 1); +} + + + +static void check_debugline (LexState *ls) { + if (lua_debug && ls->linenumber != ls->fs->lastsetline) { + code_oparg(ls, SETLINE, 0, ls->linenumber, 0); + ls->fs->lastsetline = ls->linenumber; + } +} + + +static void adjuststack (LexState *ls, int n) { + if (n > 0) + code_oparg(ls, POP, 2, n-1, -n); + else if (n < 0) + code_oparg(ls, PUSHNIL, 1, (-n)-1, -n); +} + + +static void close_exp (LexState *ls, int pc, int nresults) { + if (pc > 0) { /* expression is an open function call */ + Byte *code = ls->fs->f->code; + int nparams = code[pc]; /* save nparams */ + pc += fix_opcode(ls, pc-2, CALLFUNC, 2, nresults); + code[pc] = nparams; /* restore nparams */ + if (nresults != MULT_RET) + deltastack(ls, nresults); /* "push" results */ + deltastack(ls, -(nparams+1)); /* "pop" params and function */ + } +} + + +static void adjust_mult_assign (LexState *ls, int nvars, listdesc *d) { + int diff = d->n - nvars; + if (d->pc == 0) { /* list is closed */ + /* push or pop eventual difference between list lengths */ + adjuststack(ls, diff); + } + else { /* must correct function call */ + diff--; /* do not count function call itself */ + if (diff < 0) { /* more variables than values */ + /* function call must provide extra values */ + close_exp(ls, d->pc, -diff); + } + else { /* more values than variables */ + close_exp(ls, d->pc, 0); /* call should provide no value */ + adjuststack(ls, diff); /* pop eventual extra values */ + } + } +} + + +static void code_args (LexState *ls, int nparams, int dots) { + FuncState *fs = ls->fs; + fs->nlocalvar += nparams; /* "self" may already be there */ + nparams = fs->nlocalvar; + if (!dots) { + fs->f->code[1] = nparams; /* fill-in arg information */ + deltastack(ls, nparams); + } + else { + fs->f->code[1] = nparams+ZEROVARARG; + deltastack(ls, nparams+1); + add_localvar(ls, luaS_new("arg")); + } +} + + +static void lua_pushvar (LexState *ls, vardesc *var) { + switch (var->k) { + case VLOCAL: + code_oparg(ls, PUSHLOCAL, 8, var->info, 1); + break; + case VGLOBAL: + code_oparg(ls, GETGLOBAL, 8, var->info, 1); + break; + case VDOT: + code_oparg(ls, GETDOTTED, 8, var->info, 0); + break; + case VINDEXED: + code_opcode(ls, GETTABLE, -1); + break; + case VEXP: + close_exp(ls, var->info, 1); /* function must return 1 value */ + break; + } + var->k = VEXP; + var->info = 0; /* now this is a closed expression */ +} + + +static void storevar (LexState *ls, vardesc *var) { + switch (var->k) { + case VLOCAL: + code_oparg(ls, SETLOCAL, 8, var->info, -1); + break; + case VGLOBAL: + code_oparg(ls, SETGLOBAL, 8, var->info, -1); + break; + case VINDEXED: + code_opcode(ls, SETTABLE0, -3); + break; + default: + LUA_INTERNALERROR("invalid var kind to store"); + } +} + + +static int fix_jump (LexState *ls, int pc, OpCode op, int n) { + /* jump is relative to position following jump instruction */ + return fix_opcode(ls, pc, op, 0, n-(pc+JMPSIZE)); +} + + +static void fix_upjmp (LexState *ls, OpCode op, int pos) { + int delta = ls->fs->pc+JMPSIZE - pos; /* jump is relative */ + if (delta > 255) delta++; + code_oparg(ls, op, 0, delta, 0); +} + + +static void codeIf (LexState *ls, int thenAdd, int elseAdd) { + FuncState *fs = ls->fs; + int elseinit = elseAdd+JMPSIZE; + if (fs->pc == elseinit) { /* no else part */ + fs->pc -= JMPSIZE; + elseinit = fs->pc; + } + else + elseinit += fix_jump(ls, elseAdd, JMP, fs->pc); + fix_jump(ls, thenAdd, IFFJMP, elseinit); +} + + +static void func_onstack (LexState *ls, FuncState *func) { + FuncState *fs = ls->fs; + int i; + int c = next_constant(fs); + ttype(&fs->f->consts[c]) = LUA_T_PROTO; + fs->f->consts[c].value.tf = func->f; + if (func->nupvalues == 0) + code_constant(ls, c); + else { + for (i=0; i<func->nupvalues; i++) + lua_pushvar(ls, &func->upvalues[i]); + code_oparg(ls, CLOSURE, 0, c, -func->nupvalues+1); + code_byte(fs, func->nupvalues); + } +} + + +static void init_state (LexState *ls, FuncState *fs, TaggedString *filename) { + TProtoFunc *f = luaF_newproto(); + fs->prev = ls->fs; /* linked list of funcstates */ + ls->fs = fs; + fs->stacksize = 0; + fs->maxstacksize = 0; + fs->nlocalvar = 0; + fs->nupvalues = 0; + fs->lastsetline = 0; + fs->f = f; + f->fileName = filename; + fs->pc = 0; + fs->maxcode = 0; + f->code = NULL; + fs->maxconsts = 0; + if (lua_debug) + fs->nvars = fs->maxvars = 0; + else + fs->maxvars = -1; /* flag no debug information */ + code_byte(fs, 0); /* to be filled with stacksize */ + code_byte(fs, 0); /* to be filled with arg information */ +} + + +static void close_func (LexState *ls) { + FuncState *fs = ls->fs; + TProtoFunc *f = fs->f; + code_opcode(ls, ENDCODE, 0); + f->code[0] = fs->maxstacksize; + f->code = luaM_reallocvector(f->code, fs->pc, Byte); + f->consts = luaM_reallocvector(f->consts, f->nconsts, TObject); + if (fs->maxvars != -1) { /* debug information? */ + luaI_registerlocalvar(fs, NULL, -1); /* flag end of vector */ + f->locvars = luaM_reallocvector(f->locvars, fs->nvars, LocVar); + } + ls->fs = fs->prev; +} + + + +static int expfollow [] = {ELSE, ELSEIF, THEN, IF, WHILE, REPEAT, DO, NAME, + LOCAL, FUNCTION, END, UNTIL, RETURN, ')', ']', '}', ';', EOS, ',', 0}; + +static int is_in (int tok, int *toks) { + int *t = toks; + while (*t) { + if (*t == tok) + return t-toks; + t++; + } + return -1; +} + + +static void next (LexState *ls) { + ls->token = luaX_lex(ls); +} + + +static void error_expected (LexState *ls, int token) { + char buff[100], t[TOKEN_LEN]; + luaX_token2str(ls, token, t); + sprintf(buff, "`%s' expected", t); + luaX_error(ls, buff); +} + +static void error_unmatched (LexState *ls, int what, int who, int where) { + if (where == ls->linenumber) + error_expected(ls, what); + else { + char buff[100]; + char t_what[TOKEN_LEN], t_who[TOKEN_LEN]; + luaX_token2str(ls, what, t_what); + luaX_token2str(ls, who, t_who); + sprintf(buff, "`%s' expected (to close `%s' at line %d)", + t_what, t_who, where); + luaX_error(ls, buff); + } +} + +static void check (LexState *ls, int c) { + if (ls->token != c) + error_expected(ls, c); + next(ls); +} + +static void check_match (LexState *ls, int what, int who, int where) { + if (ls->token != what) + error_unmatched(ls, what, who, where); + check_debugline(ls); /* to 'mark' the 'what' */ + next(ls); +} + +static TaggedString *checkname (LexState *ls) { + TaggedString *ts; + if (ls->token != NAME) + luaX_error(ls, "`NAME' expected"); + ts = ls->seminfo.ts; + next(ls); + return ts; +} + + +static int optional (LexState *ls, int c) { + if (ls->token == c) { + next(ls); + return 1; + } + else return 0; +} + + +TProtoFunc *luaY_parser (ZIO *z) { + struct LexState lexstate; + struct FuncState funcstate; + luaX_setinput(&lexstate, z); + init_state(&lexstate, &funcstate, luaS_new(zname(z))); + next(&lexstate); /* read first token */ + chunk(&lexstate); + if (lexstate.token != EOS) + luaX_error(&lexstate, "<eof> expected"); + close_func(&lexstate); + return funcstate.f; +} + + + +/*============================================================*/ +/* GRAMAR RULES */ +/*============================================================*/ + +static void chunk (LexState *ls) { + /* chunk -> statlist ret */ + statlist(ls); + ret(ls); +} + +static void statlist (LexState *ls) { + /* statlist -> { stat [;] } */ + while (stat(ls)) { + LUA_ASSERT(ls->fs->stacksize == ls->fs->nlocalvar, + "stack size != # local vars"); + optional(ls, ';'); + } +} + +static int stat (LexState *ls) { + int line = ls->linenumber; /* may be needed for error messages */ + FuncState *fs = ls->fs; + switch (ls->token) { + case IF: { /* stat -> IF ifpart END */ + next(ls); + ifpart(ls); + check_match(ls, END, IF, line); + return 1; + } + + case WHILE: { /* stat -> WHILE cond DO block END */ + TProtoFunc *f = fs->f; + int while_init = fs->pc; + int cond_end, cond_size; + next(ls); + cond_end = cond(ls); + check(ls, DO); + block(ls); + check_match(ls, END, WHILE, line); + cond_size = cond_end-while_init; + check_pc(fs, cond_size); + memcpy(f->code+fs->pc, f->code+while_init, cond_size); + luaO_memdown(f->code+while_init, f->code+cond_end, fs->pc-while_init); + while_init += JMPSIZE + fix_jump(ls, while_init, JMP, fs->pc-cond_size); + fix_upjmp(ls, IFTUPJMP, while_init); + return 1; + } + + case DO: { /* stat -> DO block END */ + next(ls); + block(ls); + check_match(ls, END, DO, line); + return 1; + } + + case REPEAT: { /* stat -> REPEAT block UNTIL exp1 */ + int repeat_init = fs->pc; + next(ls); + block(ls); + check_match(ls, UNTIL, REPEAT, line); + exp1(ls); + fix_upjmp(ls, IFFUPJMP, repeat_init); + deltastack(ls, -1); /* pops condition */ + return 1; + } + + case FUNCTION: { /* stat -> FUNCTION funcname body */ + int needself; + vardesc v; + if (ls->fs->prev) /* inside other function? */ + return 0; + check_debugline(ls); + next(ls); + needself = funcname(ls, &v); + body(ls, needself, line); + storevar(ls, &v); + return 1; + } + + case LOCAL: { /* stat -> LOCAL localnamelist decinit */ + listdesc d; + int nvars; + check_debugline(ls); + next(ls); + nvars = localnamelist(ls); + decinit(ls, &d); + ls->fs->nlocalvar += nvars; + adjust_mult_assign(ls, nvars, &d); + return 1; + } + + case NAME: case '%': { /* stat -> func | ['%'] NAME assignment */ + vardesc v; + check_debugline(ls); + var_or_func(ls, &v); + if (v.k == VEXP) { /* stat -> func */ + if (v.info == 0) /* is just an upper value? */ + luaX_error(ls, "syntax error"); + close_exp(ls, v.info, 0); + } + else { + int left = assignment(ls, &v, 1); /* stat -> ['%'] NAME assignment */ + adjuststack(ls, left); /* remove eventual 'garbage' left on stack */ + } + return 1; + } + + case RETURN: case ';': case ELSE: case ELSEIF: + case END: case UNTIL: case EOS: /* 'stat' follow */ + return 0; + + default: + luaX_error(ls, "<statement> expected"); + return 0; /* to avoid warnings */ + } +} + +static int SaveWord (LexState *ls) { + int res = ls->fs->pc; + check_pc(ls->fs, JMPSIZE); + ls->fs->pc += JMPSIZE; /* open space */ + return res; +} + +static int SaveWordPop (LexState *ls) { + deltastack(ls, -1); /* pop condition */ + return SaveWord(ls); +} + +static int cond (LexState *ls) { + /* cond -> exp1 */ + exp1(ls); + return SaveWordPop(ls); +} + +static void block (LexState *ls) { + /* block -> chunk */ + FuncState *fs = ls->fs; + int nlocalvar = fs->nlocalvar; + chunk(ls); + adjuststack(ls, fs->nlocalvar - nlocalvar); + for (; fs->nlocalvar > nlocalvar; fs->nlocalvar--) + luaI_unregisterlocalvar(fs, ls->linenumber); +} + +static int funcname (LexState *ls, vardesc *v) { + /* funcname -> NAME [':' NAME | '.' NAME] */ + int needself = 0; + singlevar(ls, checkname(ls), v, 0); + if (ls->token == ':' || ls->token == '.') { + needself = (ls->token == ':'); + next(ls); + lua_pushvar(ls, v); + code_string(ls, checkname(ls)); + v->k = VINDEXED; + } + return needself; +} + +static void body (LexState *ls, int needself, int line) { + /* body -> '(' parlist ')' chunk END */ + FuncState newfs; + init_state(ls, &newfs, ls->fs->f->fileName); + newfs.f->lineDefined = line; + check(ls, '('); + if (needself) + add_localvar(ls, luaS_new("self")); + parlist(ls); + check(ls, ')'); + chunk(ls); + check_match(ls, END, FUNCTION, line); + close_func(ls); + func_onstack(ls, &newfs); +} + +static void ifpart (LexState *ls) { + /* ifpart -> cond THEN block [ELSE block | ELSEIF ifpart] */ + int c = cond(ls); + int e; + check(ls, THEN); + block(ls); + e = SaveWord(ls); + switch (ls->token) { + case ELSE: + next(ls); + block(ls); + break; + + case ELSEIF: + next(ls); + ifpart(ls); + break; + } + codeIf(ls, c, e); +} + +static void ret (LexState *ls) { + /* ret -> [RETURN explist sc] */ + if (ls->token == RETURN) { + listdesc e; + check_debugline(ls); + next(ls); + explist(ls, &e); + close_exp(ls, e.pc, MULT_RET); + code_oparg(ls, RETCODE, 0, ls->fs->nlocalvar, 0); + ls->fs->stacksize = ls->fs->nlocalvar; /* removes all temp values */ + optional(ls, ';'); + } +} + + +/* +** For parsing expressions, we use a classic stack with priorities. +** Each binary operator is represented by its index in "binop" + FIRSTBIN +** (EQ=2, NE=3, ... '^'=13). The unary NOT is 0 and UNMINUS is 1. +*/ + +/* code of first binary operator */ +#define FIRSTBIN 2 + +/* code for power operator (last operator) +** '^' needs special treatment because it is right associative +*/ +#define POW 13 + +static int binop [] = {EQ, NE, '>', '<', LE, GE, CONC, + '+', '-', '*', '/', '^', 0}; + +static int priority [POW+1] = {5, 5, 1, 1, 1, 1, 1, 1, 2, 3, 3, 4, 4, 6}; + +static OpCode opcodes [POW+1] = {NOTOP, MINUSOP, EQOP, NEQOP, GTOP, LTOP, + LEOP, GEOP, CONCOP, ADDOP, SUBOP, MULTOP, DIVOP, POWOP}; + +#define MAXOPS 20 + +typedef struct { + int ops[MAXOPS]; + int top; +} stack_op; + + +static void exp1 (LexState *ls) { + vardesc v; + exp0(ls, &v); + lua_pushvar(ls, &v); + if (is_in(ls->token, expfollow) < 0) + luaX_error(ls, "ill formed expression"); +} + + +static void exp0 (LexState *ls, vardesc *v) { + exp2(ls, v); + while (ls->token == AND || ls->token == OR) { + int is_and = (ls->token == AND); + int pc; + lua_pushvar(ls, v); + next(ls); + pc = SaveWordPop(ls); + exp2(ls, v); + lua_pushvar(ls, v); + fix_jump(ls, pc, (is_and?ONFJMP:ONTJMP), ls->fs->pc); + } +} + + +static void push (LexState *ls, stack_op *s, int op) { + if (s->top == MAXOPS) + luaX_error(ls, "expression too complex"); + s->ops[s->top++] = op; +} + + +static void prefix (LexState *ls, stack_op *s) { + while (ls->token == NOT || ls->token == '-') { + push(ls, s, ls->token==NOT?0:1); + next(ls); + } +} + +static void pop_to (LexState *ls, stack_op *s, int prio) { + int op; + while (s->top > 0 && priority[(op=s->ops[s->top-1])] >= prio) { + code_opcode(ls, opcodes[op], op<FIRSTBIN?0:-1); + s->top--; + } +} + +static void exp2 (LexState *ls, vardesc *v) { + stack_op s; + int op; + s.top = 0; + prefix(ls, &s); + simpleexp(ls, v); + while ((op = is_in(ls->token, binop)) >= 0) { + op += FIRSTBIN; + lua_pushvar(ls, v); + /* '^' is right associative, so must 'simulate' a higher priority */ + pop_to(ls, &s, (op == POW)?priority[op]+1:priority[op]); + push(ls, &s, op); + next(ls); + prefix(ls, &s); + simpleexp(ls, v); + lua_pushvar(ls, v); + } + if (s.top > 0) { + lua_pushvar(ls, v); + pop_to(ls, &s, 0); + } +} + + +static void simpleexp (LexState *ls, vardesc *v) { + check_debugline(ls); + switch (ls->token) { + case '(': /* simpleexp -> '(' exp0 ')' */ + next(ls); + exp0(ls, v); + check(ls, ')'); + break; + + case NUMBER: /* simpleexp -> NUMBER */ + code_number(ls, ls->seminfo.r); + next(ls); + v->k = VEXP; v->info = 0; + break; + + case STRING: /* simpleexp -> STRING */ + code_string(ls, ls->seminfo.ts); + next(ls); + v->k = VEXP; v->info = 0; + break; + + case NIL: /* simpleexp -> NIL */ + adjuststack(ls, -1); + next(ls); + v->k = VEXP; v->info = 0; + break; + + case '{': /* simpleexp -> constructor */ + constructor(ls); + v->k = VEXP; v->info = 0; + break; + + case FUNCTION: { /* simpleexp -> FUNCTION body */ + int line = ls->linenumber; + next(ls); + body(ls, 0, line); + v->k = VEXP; v->info = 0; + break; + } + + case NAME: case '%': + var_or_func(ls, v); + break; + + default: + luaX_error(ls, "<expression> expected"); + break; + } +} + +static void var_or_func (LexState *ls, vardesc *v) { + /* var_or_func -> ['%'] NAME var_or_func_tail */ + if (optional(ls, '%')) { /* upvalue? */ + pushupvalue(ls, checkname(ls)); + v->k = VEXP; + v->info = 0; /* closed expression */ + } + else /* variable name */ + singlevar(ls, checkname(ls), v, 0); + var_or_func_tail(ls, v); +} + +static void var_or_func_tail (LexState *ls, vardesc *v) { + for (;;) { + switch (ls->token) { + case '.': /* var_or_func_tail -> '.' NAME */ + next(ls); + lua_pushvar(ls, v); /* 'v' must be on stack */ + v->k = VDOT; + v->info = string_constant(ls->fs, checkname(ls)); + break; + + case '[': /* var_or_func_tail -> '[' exp1 ']' */ + next(ls); + lua_pushvar(ls, v); /* 'v' must be on stack */ + exp1(ls); + check(ls, ']'); + v->k = VINDEXED; + break; + + case ':': /* var_or_func_tail -> ':' NAME funcparams */ + next(ls); + lua_pushvar(ls, v); /* 'v' must be on stack */ + code_oparg(ls, PUSHSELF, 8, string_constant(ls->fs, checkname(ls)), 1); + v->k = VEXP; + v->info = funcparams(ls, 1); + break; + + case '(': case STRING: case '{': /* var_or_func_tail -> funcparams */ + lua_pushvar(ls, v); /* 'v' must be on stack */ + v->k = VEXP; + v->info = funcparams(ls, 0); + break; + + default: return; /* should be follow... */ + } + } +} + +static int funcparams (LexState *ls, int slf) { + FuncState *fs = ls->fs; + int nparams = 1; /* default value */ + switch (ls->token) { + case '(': { /* funcparams -> '(' explist ')' */ + listdesc e; + next(ls); + explist(ls, &e); + check(ls, ')'); + close_exp(ls, e.pc, 1); + nparams = e.n; + break; + } + + case '{': /* funcparams -> constructor */ + constructor(ls); + break; + + case STRING: /* funcparams -> STRING */ + code_string(ls, ls->seminfo.ts); + next(ls); + break; + + default: + luaX_error(ls, "function arguments expected"); + break; + } + code_byte(fs, 0); /* save space for opcode */ + code_byte(fs, 0); /* and nresult */ + code_byte(fs, nparams+slf); + return fs->pc-1; +} + +static void explist (LexState *ls, listdesc *d) { + switch (ls->token) { + case ELSE: case ELSEIF: case END: case UNTIL: + case EOS: case ';': case ')': + d->pc = 0; + d->n = 0; + break; + + default: + explist1(ls, d); + } +} + +static void explist1 (LexState *ls, listdesc *d) { + vardesc v; + exp0(ls, &v); + d->n = 1; + while (ls->token == ',') { + d->n++; + lua_pushvar(ls, &v); + next(ls); + exp0(ls, &v); + } + if (v.k == VEXP) + d->pc = v.info; + else { + lua_pushvar(ls, &v); + d->pc = 0; + } +} + +static void parlist (LexState *ls) { + int nparams = 0; + int dots = 0; + switch (ls->token) { + case DOTS: /* parlist -> DOTS */ + next(ls); + dots = 1; + break; + + case NAME: /* parlist, tailparlist -> NAME [',' tailparlist] */ + init: + store_localvar(ls, checkname(ls), nparams++); + if (ls->token == ',') { + next(ls); + switch (ls->token) { + case DOTS: /* tailparlist -> DOTS */ + next(ls); + dots = 1; + break; + + case NAME: /* tailparlist -> NAME [',' tailparlist] */ + goto init; + + default: luaX_error(ls, "NAME or `...' expected"); + } + } + break; + + case ')': break; /* parlist -> empty */ + + default: luaX_error(ls, "NAME or `...' expected"); + } + code_args(ls, nparams, dots); +} + +static int localnamelist (LexState *ls) { + /* localnamelist -> NAME {',' NAME} */ + int i = 1; + store_localvar(ls, checkname(ls), 0); + while (ls->token == ',') { + next(ls); + store_localvar(ls, checkname(ls), i++); + } + return i; +} + +static void decinit (LexState *ls, listdesc *d) { + /* decinit -> ['=' explist1] */ + if (ls->token == '=') { + next(ls); + explist1(ls, d); + } + else { + d->n = 0; + d->pc = 0; + } +} + +static int assignment (LexState *ls, vardesc *v, int nvars) { + int left = 0; + /* dotted variables <a.x> must be stored like regular indexed vars <a["x"]> */ + if (v->k == VDOT) { + code_constant(ls, v->info); + v->k = VINDEXED; + } + if (ls->token == ',') { /* assignment -> ',' NAME assignment */ + vardesc nv; + next(ls); + var_or_func(ls, &nv); + if (nv.k == VEXP) + luaX_error(ls, "syntax error"); + left = assignment(ls, &nv, nvars+1); + } + else { /* assignment -> '=' explist1 */ + listdesc d; + check(ls, '='); + explist1(ls, &d); + adjust_mult_assign(ls, nvars, &d); + } + if (v->k != VINDEXED || left+(nvars-1) == 0) { + /* global/local var or indexed var without values in between */ + storevar(ls, v); + } + else { /* indexed var with values in between*/ + code_oparg(ls, SETTABLE, 0, left+(nvars-1), -1); + left += 2; /* table/index are not popped, because they aren't on top */ + } + return left; +} + +static void constructor (LexState *ls) { + /* constructor -> '{' part [';' part] '}' */ + int line = ls->linenumber; + int pc = SaveWord(ls); + int nelems; + constdesc cd; + deltastack(ls, 1); + check(ls, '{'); + part(ls, &cd); + nelems = cd.n; + if (ls->token == ';') { + constdesc other_cd; + next(ls); + part(ls, &other_cd); + if (cd.k == other_cd.k) /* repeated parts? */ + luaX_error(ls, "invalid constructor syntax"); + nelems += other_cd.n; + } + check_match(ls, '}', '{', line); + fix_opcode(ls, pc, CREATEARRAY, 2, nelems); +} + +static void part (LexState *ls, constdesc *cd) { + switch (ls->token) { + case ';': case '}': /* part -> empty */ + cd->n = 0; + cd->k = ls->token; + return; + + case NAME: { + vardesc v; + exp0(ls, &v); + if (ls->token == '=') { + switch (v.k) { + case VGLOBAL: + code_constant(ls, v.info); + break; + case VLOCAL: + code_string(ls, ls->fs->localvar[v.info]); + break; + default: + luaX_error(ls, "`=' unexpected"); + } + next(ls); + exp1(ls); + cd->n = recfields(ls); + cd->k = 1; /* record */ + } + else { + lua_pushvar(ls, &v); + cd->n = listfields(ls); + cd->k = 0; /* list */ + } + break; + } + + case '[': /* part -> recfield recfields */ + recfield(ls); + cd->n = recfields(ls); + cd->k = 1; /* record */ + break; + + default: /* part -> exp1 listfields */ + exp1(ls); + cd->n = listfields(ls); + cd->k = 0; /* list */ + break; + } +} + +static int recfields (LexState *ls) { + /* recfields -> { ',' recfield } [','] */ + int n = 1; /* one has been read before */ + while (ls->token == ',') { + next(ls); + if (ls->token == ';' || ls->token == '}') + break; + recfield(ls); + n++; + if (n%RFIELDS_PER_FLUSH == 0) + flush_record(ls, RFIELDS_PER_FLUSH); + } + flush_record(ls, n%RFIELDS_PER_FLUSH); + return n; +} + +static int listfields (LexState *ls) { + /* listfields -> { ',' exp1 } [','] */ + int n = 1; /* one has been read before */ + while (ls->token == ',') { + next(ls); + if (ls->token == ';' || ls->token == '}') + break; + exp1(ls); + n++; + if (n%LFIELDS_PER_FLUSH == 0) + flush_list(ls, n/LFIELDS_PER_FLUSH - 1, LFIELDS_PER_FLUSH); + } + flush_list(ls, n/LFIELDS_PER_FLUSH, n%LFIELDS_PER_FLUSH); + return n; +} + +static void recfield (LexState *ls) { + /* recfield -> (NAME | '['exp1']') = exp1 */ + switch (ls->token) { + case NAME: + code_string(ls, checkname(ls)); + break; + + case '[': + next(ls); + exp1(ls); + check(ls, ']'); + break; + + default: luaX_error(ls, "NAME or `[' expected"); + } + check(ls, '='); + exp1(ls); +} + diff --git a/src/lparser.h b/src/lparser.h new file mode 100644 index 00000000..b37fd815 --- /dev/null +++ b/src/lparser.h @@ -0,0 +1,20 @@ +/* +** $Id: lparser.h,v 1.2 1997/12/22 20:57:18 roberto Exp $ +** Syntax analizer and code generator +** See Copyright Notice in lua.h +*/ + +#ifndef lparser_h +#define lparser_h + +#include "lobject.h" +#include "lzio.h" + + +void luaY_codedebugline (int line); +TProtoFunc *luaY_parser (ZIO *z); +void luaY_error (char *s); +void luaY_syntaxerror (char *s, char *token); + + +#endif diff --git a/src/lstate.c b/src/lstate.c new file mode 100644 index 00000000..43015b97 --- /dev/null +++ b/src/lstate.c @@ -0,0 +1,86 @@ +/* +** $Id: lstate.c,v 1.6 1998/06/02 20:37:04 roberto Exp $ +** Global State +** See Copyright Notice in lua.h +*/ + + +#include "lbuiltin.h" +#include "ldo.h" +#include "lfunc.h" +#include "lgc.h" +#include "llex.h" +#include "lmem.h" +#include "lstate.h" +#include "lstring.h" +#include "ltable.h" +#include "ltm.h" + + +lua_State *lua_state = NULL; + + +void lua_open (void) +{ + if (lua_state) return; + lua_state = luaM_new(lua_State); + L->numCblocks = 0; + L->Cstack.base = 0; + L->Cstack.lua2C = 0; + L->Cstack.num = 0; + L->errorJmp = NULL; + L->rootproto.next = NULL; + L->rootproto.marked = 0; + L->rootcl.next = NULL; + L->rootcl.marked = 0; + L->rootglobal.next = NULL; + L->rootglobal.marked = 0; + L->roottable.next = NULL; + L->roottable.marked = 0; + L->refArray = NULL; + L->refSize = 0; + L->Mbuffsize = 0; + L->Mbuffnext = 0; + L->Mbuffbase = NULL; + L->Mbuffer = NULL; + L->GCthreshold = GARBAGE_BLOCK; + L->nblocks = 0; + luaD_init(); + luaS_init(); + luaX_init(); + luaT_init(); + luaB_predefine(); +} + + +void lua_close (void) +{ + TaggedString *alludata = luaS_collectudata(); + L->GCthreshold = MAX_INT; /* to avoid GC during GC */ + luaC_hashcallIM((Hash *)L->roottable.next); /* GC t.methods for tables */ + luaC_strcallIM(alludata); /* GC tag methods for userdata */ + luaD_gcIM(&luaO_nilobject); /* GC tag method for nil (signal end of GC) */ + luaH_free((Hash *)L->roottable.next); + luaF_freeproto((TProtoFunc *)L->rootproto.next); + luaF_freeclosure((Closure *)L->rootcl.next); + luaS_free(alludata); + luaS_freeall(); + luaM_free(L->stack.stack); + luaM_free(L->IMtable); + luaM_free(L->refArray); + luaM_free(L->Mbuffer); + luaM_free(L); + L = NULL; +#ifdef DEBUG + printf("total de blocos: %ld\n", numblocks); + printf("total de memoria: %ld\n", totalmem); +#endif +} + + +lua_State *lua_setstate (lua_State *st) { + lua_State *old = lua_state; + lua_state = st; + return old; +} + diff --git a/src/lstate.h b/src/lstate.h new file mode 100644 index 00000000..71d956fa --- /dev/null +++ b/src/lstate.h @@ -0,0 +1,86 @@ +/* +** $Id: lstate.h,v 1.11 1998/06/24 13:33:00 roberto Exp $ +** Global State +** See Copyright Notice in lua.h +*/ + +#ifndef lstate_h +#define lstate_h + +#include <setjmp.h> + +#include "lobject.h" +#include "lua.h" + + +#define MAX_C_BLOCKS 10 + +#define GARBAGE_BLOCK 150 + + +typedef int StkId; /* index to stack elements */ + +struct Stack { + TObject *top; + TObject *stack; + TObject *last; +}; + +struct C_Lua_Stack { + StkId base; /* when Lua calls C or C calls Lua, points to */ + /* the first slot after the last parameter. */ + StkId lua2C; /* points to first element of "array" lua2C */ + int num; /* size of "array" lua2C */ +}; + + +typedef struct { + int size; + int nuse; /* number of elements (including EMPTYs) */ + TaggedString **hash; +} stringtable; + + +enum Status {LOCK, HOLD, FREE, COLLECTED}; + +struct ref { + TObject o; + enum Status status; +}; + + +struct lua_State { + /* thread-specific state */ + struct Stack stack; /* Lua stack */ + struct C_Lua_Stack Cstack; /* C2lua struct */ + jmp_buf *errorJmp; /* current error recover point */ + char *Mbuffer; /* global buffer */ + char *Mbuffbase; /* current first position of Mbuffer */ + int Mbuffsize; /* size of Mbuffer */ + int Mbuffnext; /* next position to fill in Mbuffer */ + struct C_Lua_Stack Cblocks[MAX_C_BLOCKS]; + int numCblocks; /* number of nested Cblocks */ + /* global state */ + TObject errorim; /* error tag method */ + GCnode rootproto; /* list of all prototypes */ + GCnode rootcl; /* list of all closures */ + GCnode roottable; /* list of all tables */ + GCnode rootglobal; /* list of strings with global values */ + stringtable *string_root; /* array of hash tables for strings and udata */ + struct IM *IMtable; /* table for tag methods */ + int IMtable_size; /* size of IMtable */ + int last_tag; /* last used tag in IMtable */ + struct ref *refArray; /* locked objects */ + int refSize; /* size of refArray */ + unsigned long GCthreshold; + unsigned long nblocks; /* number of 'blocks' currently allocated */ +}; + + +extern lua_State *lua_state; + + +#define L lua_state + + +#endif diff --git a/src/lstring.c b/src/lstring.c new file mode 100644 index 00000000..fd7cc580 --- /dev/null +++ b/src/lstring.c @@ -0,0 +1,313 @@ +/* +** $Id: lstring.c,v 1.13 1998/06/19 16:14:09 roberto Exp $ +** String table (keeps all strings handled by Lua) +** See Copyright Notice in lua.h +*/ + + +#include <string.h> + +#include "lmem.h" +#include "lobject.h" +#include "lstate.h" +#include "lstring.h" +#include "lua.h" + + +#define NUM_HASHS 61 + + +#define gcsizestring(l) (1+(l/64)) /* "weight" for a string with length 'l' */ + + + +static TaggedString EMPTY = {{NULL, 2}, 0L, 0, + {{{LUA_T_NIL, {NULL}}, 0L}}, {0}}; + + +void luaS_init (void) +{ + int i; + L->string_root = luaM_newvector(NUM_HASHS, stringtable); + for (i=0; i<NUM_HASHS; i++) { + L->string_root[i].size = 0; + L->string_root[i].nuse = 0; + L->string_root[i].hash = NULL; + } +} + + +static unsigned long hash_s (char *s, long l) +{ + unsigned long h = 0; + while (l--) + h = ((h<<5)-h)^(unsigned char)*(s++); + return h; +} + +static int newsize (stringtable *tb) +{ + int size = tb->size; + int realuse = 0; + int i; + /* count how many entries are really in use */ + for (i=0; i<size; i++) + if (tb->hash[i] != NULL && tb->hash[i] != &EMPTY) + realuse++; + if (2*(realuse+1) <= size) /* +1 is the new element */ + return size; /* don't need to grow, just rehash to clear EMPTYs */ + else + return luaO_redimension(size); +} + + +static void grow (stringtable *tb) +{ + + int ns = newsize(tb); + TaggedString **newhash = luaM_newvector(ns, TaggedString *); + int i; + for (i=0; i<ns; i++) + newhash[i] = NULL; + /* rehash */ + tb->nuse = 0; + for (i=0; i<tb->size; i++) { + if (tb->hash[i] != NULL && tb->hash[i] != &EMPTY) { + int h = tb->hash[i]->hash%ns; + while (newhash[h]) + h = (h+1)%ns; + newhash[h] = tb->hash[i]; + tb->nuse++; + } + } + luaM_free(tb->hash); + tb->size = ns; + tb->hash = newhash; +} + + +static TaggedString *newone_s (char *str, long l, unsigned long h) +{ + TaggedString *ts = (TaggedString *)luaM_malloc(sizeof(TaggedString)+l); + memcpy(ts->str, str, l); + ts->str[l] = 0; /* ending 0 */ + ts->u.s.globalval.ttype = LUA_T_NIL; /* initialize global value */ + ts->u.s.len = l; + ts->constindex = 0; + L->nblocks += gcsizestring(l); + ts->head.marked = 0; + ts->head.next = (GCnode *)ts; /* signal it is in no list */ + ts->hash = h; + return ts; +} + +static TaggedString *newone_u (char *buff, int tag, unsigned long h) +{ + TaggedString *ts = luaM_new(TaggedString); + ts->u.d.v = buff; + ts->u.d.tag = (tag == LUA_ANYTAG) ? 0 : tag; + ts->constindex = -1; /* tag -> this is a userdata */ + L->nblocks++; + ts->head.marked = 0; + ts->head.next = (GCnode *)ts; /* signal it is in no list */ + ts->hash = h; + return ts; +} + +static TaggedString *insert_s (char *str, long l, stringtable *tb) +{ + TaggedString *ts; + unsigned long h = hash_s(str, l); + int size = tb->size; + int i; + int j = -1; + if ((long)tb->nuse*3 >= (long)size*2) { + grow(tb); + size = tb->size; + } + for (i = h%size; (ts = tb->hash[i]) != NULL; ) { + if (ts == &EMPTY) + j = i; + else if (ts->constindex >= 0 && + ts->u.s.len == l && + (memcmp(str, ts->str, l) == 0)) + return ts; + if (++i == size) i=0; + } + /* not found */ + if (j != -1) /* is there an EMPTY space? */ + i = j; + else + tb->nuse++; + ts = tb->hash[i] = newone_s(str, l, h); + return ts; +} + +static TaggedString *insert_u (void *buff, int tag, stringtable *tb) +{ + TaggedString *ts; + unsigned long h = (unsigned long)buff; + int size = tb->size; + int i; + int j = -1; + if ((long)tb->nuse*3 >= (long)size*2) { + grow(tb); + size = tb->size; + } + for (i = h%size; (ts = tb->hash[i]) != NULL; ) { + if (ts == &EMPTY) + j = i; + else if (ts->constindex < 0 && /* is a udata? */ + (tag == ts->u.d.tag || tag == LUA_ANYTAG) && + buff == ts->u.d.v) + return ts; + if (++i == size) i=0; + } + /* not found */ + if (j != -1) /* is there an EMPTY space? */ + i = j; + else + tb->nuse++; + ts = tb->hash[i] = newone_u(buff, tag, h); + return ts; +} + +TaggedString *luaS_createudata (void *udata, int tag) +{ + return insert_u(udata, tag, &L->string_root[(unsigned)udata%NUM_HASHS]); +} + +TaggedString *luaS_newlstr (char *str, long l) +{ + int i = (l==0)?0:(unsigned char)str[0]; + return insert_s(str, l, &L->string_root[i%NUM_HASHS]); +} + +TaggedString *luaS_new (char *str) +{ + return luaS_newlstr(str, strlen(str)); +} + +TaggedString *luaS_newfixedstring (char *str) +{ + TaggedString *ts = luaS_new(str); + if (ts->head.marked == 0) + ts->head.marked = 2; /* avoid GC */ + return ts; +} + + +void luaS_free (TaggedString *l) +{ + while (l) { + TaggedString *next = (TaggedString *)l->head.next; + L->nblocks -= (l->constindex == -1) ? 1 : gcsizestring(l->u.s.len); + luaM_free(l); + l = next; + } +} + + +/* +** Garbage collection functions. +*/ + +static void remove_from_list (GCnode *l) +{ + while (l) { + GCnode *next = l->next; + while (next && !next->marked) + next = l->next = next->next; + l = next; + } +} + + +TaggedString *luaS_collector (void) +{ + TaggedString *frees = NULL; + int i; + remove_from_list(&(L->rootglobal)); + for (i=0; i<NUM_HASHS; i++) { + stringtable *tb = &L->string_root[i]; + int j; + for (j=0; j<tb->size; j++) { + TaggedString *t = tb->hash[j]; + if (t == NULL) continue; + if (t->head.marked == 1) + t->head.marked = 0; + else if (!t->head.marked) { + t->head.next = (GCnode *)frees; + frees = t; + tb->hash[j] = &EMPTY; + } + } + } + return frees; +} + + +TaggedString *luaS_collectudata (void) +{ + TaggedString *frees = NULL; + int i; + L->rootglobal.next = NULL; /* empty list of globals */ + for (i=0; i<NUM_HASHS; i++) { + stringtable *tb = &L->string_root[i]; + int j; + for (j=0; j<tb->size; j++) { + TaggedString *t = tb->hash[j]; + if (t == NULL || t == &EMPTY || t->constindex != -1) + continue; /* get only user data */ + t->head.next = (GCnode *)frees; + frees = t; + tb->hash[j] = &EMPTY; + } + } + return frees; +} + + +void luaS_freeall (void) +{ + int i; + for (i=0; i<NUM_HASHS; i++) { + stringtable *tb = &L->string_root[i]; + int j; + for (j=0; j<tb->size; j++) { + TaggedString *t = tb->hash[j]; + if (t == &EMPTY) continue; + luaM_free(t); + } + luaM_free(tb->hash); + } + luaM_free(L->string_root); +} + + +void luaS_rawsetglobal (TaggedString *ts, TObject *newval) +{ + ts->u.s.globalval = *newval; + if (ts->head.next == (GCnode *)ts) { /* is not in list? */ + ts->head.next = L->rootglobal.next; + L->rootglobal.next = (GCnode *)ts; + } +} + + +char *luaS_travsymbol (int (*fn)(TObject *)) +{ + TaggedString *g; + for (g=(TaggedString *)L->rootglobal.next; g; g=(TaggedString *)g->head.next) + if (fn(&g->u.s.globalval)) + return g->str; + return NULL; +} + + +int luaS_globaldefined (char *name) +{ + TaggedString *ts = luaS_new(name); + return ts->u.s.globalval.ttype != LUA_T_NIL; +} + diff --git a/src/lstring.h b/src/lstring.h new file mode 100644 index 00000000..6b214a21 --- /dev/null +++ b/src/lstring.h @@ -0,0 +1,28 @@ +/* +** $Id: lstring.h,v 1.7 1998/03/06 16:54:42 roberto Exp $ +** String table (keep all strings handled by Lua) +** See Copyright Notice in lua.h +*/ + +#ifndef lstring_h +#define lstring_h + + +#include "lobject.h" + + +void luaS_init (void); +TaggedString *luaS_createudata (void *udata, int tag); +TaggedString *luaS_collector (void); +void luaS_free (TaggedString *l); +TaggedString *luaS_newlstr (char *str, long l); +TaggedString *luaS_new (char *str); +TaggedString *luaS_newfixedstring (char *str); +void luaS_rawsetglobal (TaggedString *ts, TObject *newval); +char *luaS_travsymbol (int (*fn)(TObject *)); +int luaS_globaldefined (char *name); +TaggedString *luaS_collectudata (void); +void luaS_freeall (void); + + +#endif diff --git a/src/ltable.c b/src/ltable.c new file mode 100644 index 00000000..28cd2ed5 --- /dev/null +++ b/src/ltable.c @@ -0,0 +1,216 @@ +/* +** $Id: ltable.c,v 1.12 1998/01/28 16:50:33 roberto Exp $ +** Lua tables (hash) +** See Copyright Notice in lua.h +*/ + +#include <stdlib.h> + +#include "lauxlib.h" +#include "lmem.h" +#include "lobject.h" +#include "lstate.h" +#include "ltable.h" +#include "lua.h" + + +#define gcsize(n) (1+(n/16)) + +#define nuse(t) ((t)->nuse) +#define nodevector(t) ((t)->node) + + +#define REHASH_LIMIT 0.70 /* avoid more than this % full */ + +#define TagDefault LUA_T_ARRAY; + + + +static long int hashindex (TObject *ref) +{ + long int h; + switch (ttype(ref)) { + case LUA_T_NUMBER: + h = (long int)nvalue(ref); + break; + case LUA_T_STRING: case LUA_T_USERDATA: + h = (IntPoint)tsvalue(ref); + break; + case LUA_T_ARRAY: + h = (IntPoint)avalue(ref); + break; + case LUA_T_PROTO: + h = (IntPoint)tfvalue(ref); + break; + case LUA_T_CPROTO: + h = (IntPoint)fvalue(ref); + break; + case LUA_T_CLOSURE: + h = (IntPoint)clvalue(ref); + break; + default: + lua_error("unexpected type to index table"); + h = 0; /* to avoid warnings */ + } + return (h >= 0 ? h : -(h+1)); +} + + +static int present (Hash *t, TObject *key) +{ + int tsize = nhash(t); + long int h = hashindex(key); + int h1 = h%tsize; + TObject *rf = ref(node(t, h1)); + if (ttype(rf) != LUA_T_NIL && !luaO_equalObj(key, rf)) { + int h2 = h%(tsize-2) + 1; + do { + h1 += h2; + if (h1 >= tsize) h1 -= tsize; + rf = ref(node(t, h1)); + } while (ttype(rf) != LUA_T_NIL && !luaO_equalObj(key, rf)); + } + return h1; +} + + +/* +** Alloc a vector node +*/ +static Node *hashnodecreate (int nhash) +{ + Node *v = luaM_newvector(nhash, Node); + int i; + for (i=0; i<nhash; i++) + ttype(ref(&v[i])) = LUA_T_NIL; + return v; +} + +/* +** Delete a hash +*/ +static void hashdelete (Hash *t) +{ + luaM_free(nodevector(t)); + luaM_free(t); +} + + +void luaH_free (Hash *frees) +{ + while (frees) { + Hash *next = (Hash *)frees->head.next; + L->nblocks -= gcsize(frees->nhash); + hashdelete(frees); + frees = next; + } +} + + +Hash *luaH_new (int nhash) +{ + Hash *t = luaM_new(Hash); + nhash = luaO_redimension((int)((float)nhash/REHASH_LIMIT)); + nodevector(t) = hashnodecreate(nhash); + nhash(t) = nhash; + nuse(t) = 0; + t->htag = TagDefault; + luaO_insertlist(&(L->roottable), (GCnode *)t); + L->nblocks += gcsize(nhash); + return t; +} + + +static int newsize (Hash *t) +{ + Node *v = t->node; + int size = nhash(t); + int realuse = 0; + int i; + for (i=0; i<size; i++) { + if (ttype(ref(v+i)) != LUA_T_NIL && ttype(val(v+i)) != LUA_T_NIL) + realuse++; + } + if (2*(realuse+1) <= size) /* +1 is the new element */ + return size; /* don't need to grow, just rehash */ + else + return luaO_redimension(size); +} + +static void rehash (Hash *t) +{ + int nold = nhash(t); + Node *vold = nodevector(t); + int nnew = newsize(t); + int i; + nodevector(t) = hashnodecreate(nnew); + nhash(t) = nnew; + for (i=0; i<nold; i++) { + Node *n = vold+i; + if (ttype(ref(n)) != LUA_T_NIL && ttype(val(n)) != LUA_T_NIL) + *node(t, present(t, ref(n))) = *n; /* copy old node to luaM_new hash */ + } + L->nblocks += gcsize(nnew)-gcsize(nold); + luaM_free(vold); +} + +/* +** If the hash node is present, return its pointer, otherwise return +** null. +*/ +TObject *luaH_get (Hash *t, TObject *ref) +{ + int h = present(t, ref); + if (ttype(ref(node(t, h))) != LUA_T_NIL) return val(node(t, h)); + else return NULL; +} + + +/* +** If the hash node is present, return its pointer, otherwise create a luaM_new +** node for the given reference and also return its pointer. +*/ +TObject *luaH_set (Hash *t, TObject *ref) +{ + Node *n = node(t, present(t, ref)); + if (ttype(ref(n)) == LUA_T_NIL) { + nuse(t)++; + if ((float)nuse(t) > (float)nhash(t)*REHASH_LIMIT) { + rehash(t); + n = node(t, present(t, ref)); + } + *ref(n) = *ref; + ttype(val(n)) = LUA_T_NIL; + } + return (val(n)); +} + + +static Node *hashnext (Hash *t, int i) +{ + Node *n; + int tsize = nhash(t); + if (i >= tsize) + return NULL; + n = node(t, i); + while (ttype(ref(n)) == LUA_T_NIL || ttype(val(n)) == LUA_T_NIL) { + if (++i >= tsize) + return NULL; + n = node(t, i); + } + return node(t, i); +} + +Node *luaH_next (TObject *o, TObject *r) +{ + Hash *t = avalue(o); + if (ttype(r) == LUA_T_NIL) + return hashnext(t, 0); + else { + int i = present(t, r); + Node *n = node(t, i); + luaL_arg_check(ttype(ref(n))!=LUA_T_NIL && ttype(val(n))!=LUA_T_NIL, + 2, "key not found"); + return hashnext(t, i+1); + } +} diff --git a/src/ltable.h b/src/ltable.h new file mode 100644 index 00000000..92b03167 --- /dev/null +++ b/src/ltable.h @@ -0,0 +1,24 @@ +/* +** $Id: ltable.h,v 1.5 1997/11/26 18:53:45 roberto Exp $ +** Lua tables (hash) +** See Copyright Notice in lua.h +*/ + +#ifndef ltable_h +#define ltable_h + +#include "lobject.h" + + +#define node(t,i) (&(t)->node[i]) +#define ref(n) (&(n)->ref) +#define val(n) (&(n)->val) +#define nhash(t) ((t)->nhash) + +Hash *luaH_new (int nhash); +void luaH_free (Hash *frees); +TObject *luaH_get (Hash *t, TObject *ref); +TObject *luaH_set (Hash *t, TObject *ref); +Node *luaH_next (TObject *o, TObject *r); + +#endif diff --git a/src/ltm.c b/src/ltm.c new file mode 100644 index 00000000..0bbee22c --- /dev/null +++ b/src/ltm.c @@ -0,0 +1,263 @@ +/* +** $Id: ltm.c,v 1.16 1998/06/18 16:57:03 roberto Exp $ +** Tag methods +** See Copyright Notice in lua.h +*/ + + +#include <stdio.h> +#include <string.h> + +#include "lauxlib.h" +#include "lmem.h" +#include "lobject.h" +#include "lstate.h" +#include "ltm.h" + + +char *luaT_eventname[] = { /* ORDER IM */ + "gettable", "settable", "index", "getglobal", "setglobal", "add", + "sub", "mul", "div", "pow", "unm", "lt", "le", "gt", "ge", + "concat", "gc", "function", NULL +}; + + +static int luaI_checkevent (char *name, char *list[]) +{ + int e = luaL_findstring(name, list); + if (e < 0) + luaL_verror("`%.50s' is not a valid event name", name); + return e; +} + + + +/* events in LUA_T_NIL are all allowed, since this is used as a +* 'placeholder' for "default" fallbacks +*/ +static char validevents[NUM_TAGS][IM_N] = { /* ORDER LUA_T, ORDER IM */ +{1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1}, /* LUA_T_USERDATA */ +{1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1}, /* LUA_T_NUMBER */ +{1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, /* LUA_T_STRING */ +{0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}, /* LUA_T_ARRAY */ +{1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0}, /* LUA_T_PROTO */ +{1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0}, /* LUA_T_CPROTO */ +{1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1} /* LUA_T_NIL */ +}; + + +static int validevent (int t, int e) +{ /* ORDER LUA_T */ + return (t < LUA_T_NIL) ? 1 : validevents[-t][e]; +} + + +static void init_entry (int tag) +{ + int i; + for (i=0; i<IM_N; i++) + ttype(luaT_getim(tag, i)) = LUA_T_NIL; +} + + +void luaT_init (void) +{ + int t; + L->IMtable_size = NUM_TAGS*2; + L->last_tag = -(NUM_TAGS-1); + L->IMtable = luaM_newvector(L->IMtable_size, struct IM); + for (t=L->last_tag; t<=0; t++) + init_entry(t); +} + + +int lua_newtag (void) +{ + --L->last_tag; + if ((-L->last_tag) >= L->IMtable_size) + L->IMtable_size = luaM_growvector(&L->IMtable, L->IMtable_size, + struct IM, memEM, MAX_INT); + init_entry(L->last_tag); + return L->last_tag; +} + + +static void checktag (int tag) +{ + if (!(L->last_tag <= tag && tag <= 0)) + luaL_verror("%d is not a valid tag", tag); +} + +void luaT_realtag (int tag) +{ + if (!(L->last_tag <= tag && tag < LUA_T_NIL)) + luaL_verror("tag %d is not result of `newtag'", tag); +} + + +int lua_copytagmethods (int tagto, int tagfrom) +{ + int e; + checktag(tagto); + checktag(tagfrom); + for (e=0; e<IM_N; e++) { + if (validevent(tagto, e)) + *luaT_getim(tagto, e) = *luaT_getim(tagfrom, e); + } + return tagto; +} + + +int luaT_efectivetag (TObject *o) +{ + int t; + switch (t = ttype(o)) { + case LUA_T_ARRAY: + return o->value.a->htag; + case LUA_T_USERDATA: { + int tag = o->value.ts->u.d.tag; + return (tag >= 0) ? LUA_T_USERDATA : tag; + } + case LUA_T_CLOSURE: + return o->value.cl->consts[0].ttype; +#ifdef DEBUG + case LUA_T_PMARK: case LUA_T_CMARK: + case LUA_T_CLMARK: case LUA_T_LINE: + LUA_INTERNALERROR("invalid type"); +#endif + default: + return t; + } +} + + +TObject *luaT_gettagmethod (int t, char *event) +{ + int e = luaI_checkevent(event, luaT_eventname); + checktag(t); + if (validevent(t, e)) + return luaT_getim(t,e); + else + return &luaO_nilobject; +} + + +void luaT_settagmethod (int t, char *event, TObject *func) +{ + TObject temp = *func; + int e = luaI_checkevent(event, luaT_eventname); + checktag(t); + if (!validevent(t, e)) + luaL_verror("settagmethod: cannot change tag method `%.20s' for tag %d", + luaT_eventname[e], t); + *func = *luaT_getim(t,e); + *luaT_getim(t, e) = temp; +} + + +char *luaT_travtagmethods (int (*fn)(TObject *)) +{ + int e; + if (fn(&L->errorim)) + return "error"; + for (e=IM_GETTABLE; e<=IM_FUNCTION; e++) { /* ORDER IM */ + int t; + for (t=0; t>=L->last_tag; t--) + if (fn(luaT_getim(t,e))) + return luaT_eventname[e]; + } + return NULL; +} + + +/* +* =================================================================== +* compatibility with old fallback system +*/ +#ifdef LUA_COMPAT2_5 + +#include "lapi.h" + +static void errorFB (void) +{ + lua_Object o = lua_getparam(1); + if (lua_isstring(o)) + fprintf(stderr, "lua: %s\n", lua_getstring(o)); + else + fprintf(stderr, "lua: unknown error\n"); +} + + +static void nilFB (void) { } + + +static void typeFB (void) +{ + lua_error("unexpected type"); +} + + +static void fillvalids (IMS e, TObject *func) +{ + int t; + for (t=LUA_T_NIL; t<=LUA_T_USERDATA; t++) + if (validevent(t, e)) + *luaT_getim(t, e) = *func; +} + + +void luaT_setfallback (void) +{ + static char *oldnames [] = {"error", "getglobal", "arith", "order", NULL}; + TObject oldfunc; + lua_CFunction replace; + char *name = luaL_check_string(1); + lua_Object func = lua_getparam(2); + luaL_arg_check(lua_isfunction(func), 2, "function expected"); + switch (luaL_findstring(name, oldnames)) { + case 0: /* old error fallback */ + oldfunc = L->errorim; + L->errorim = *luaA_Address(func); + replace = errorFB; + break; + case 1: /* old getglobal fallback */ + oldfunc = *luaT_getim(LUA_T_NIL, IM_GETGLOBAL); + *luaT_getim(LUA_T_NIL, IM_GETGLOBAL) = *luaA_Address(func); + replace = nilFB; + break; + case 2: { /* old arith fallback */ + int i; + oldfunc = *luaT_getim(LUA_T_NUMBER, IM_POW); + for (i=IM_ADD; i<=IM_UNM; i++) /* ORDER IM */ + fillvalids(i, luaA_Address(func)); + replace = typeFB; + break; + } + case 3: { /* old order fallback */ + int i; + oldfunc = *luaT_getim(LUA_T_NIL, IM_LT); + for (i=IM_LT; i<=IM_GE; i++) /* ORDER IM */ + fillvalids(i, luaA_Address(func)); + replace = typeFB; + break; + } + default: { + int e; + if ((e = luaL_findstring(name, luaT_eventname)) >= 0) { + oldfunc = *luaT_getim(LUA_T_NIL, e); + fillvalids(e, luaA_Address(func)); + replace = (e == IM_GC || e == IM_INDEX) ? nilFB : typeFB; + } + else { + luaL_verror("`%.50s' is not a valid fallback name", name); + replace = NULL; /* to avoid warnings */ + } + } + } + if (oldfunc.ttype != LUA_T_NIL) + luaA_pushobject(&oldfunc); + else + lua_pushcfunction(replace); +} +#endif + diff --git a/src/ltm.h b/src/ltm.h new file mode 100644 index 00000000..b688d1e1 --- /dev/null +++ b/src/ltm.h @@ -0,0 +1,62 @@ +/* +** $Id: ltm.h,v 1.4 1997/11/26 18:53:45 roberto Exp $ +** Tag methods +** See Copyright Notice in lua.h +*/ + +#ifndef ltm_h +#define ltm_h + + +#include "lobject.h" +#include "lstate.h" + +/* +* WARNING: if you change the order of this enumeration, +* grep "ORDER IM" +*/ +typedef enum { + IM_GETTABLE = 0, + IM_SETTABLE, + IM_INDEX, + IM_GETGLOBAL, + IM_SETGLOBAL, + IM_ADD, + IM_SUB, + IM_MUL, + IM_DIV, + IM_POW, + IM_UNM, + IM_LT, + IM_LE, + IM_GT, + IM_GE, + IM_CONCAT, + IM_GC, + IM_FUNCTION +} IMS; + +#define IM_N 18 + + +struct IM { + TObject int_method[IM_N]; +}; + + +#define luaT_getim(tag,event) (&L->IMtable[-(tag)].int_method[event]) +#define luaT_getimbyObj(o,e) (luaT_getim(luaT_efectivetag(o),(e))) + +extern char *luaT_eventname[]; + + +void luaT_init (void); +void luaT_realtag (int tag); +int luaT_efectivetag (TObject *o); +void luaT_settagmethod (int t, char *event, TObject *func); +TObject *luaT_gettagmethod (int t, char *event); +char *luaT_travtagmethods (int (*fn)(TObject *)); + +void luaT_setfallback (void); /* only if LUA_COMPAT2_5 */ + +#endif diff --git a/src/lua.stx b/src/lua.stx deleted file mode 100644 index 3a1bf62c..00000000 --- a/src/lua.stx +++ /dev/null @@ -1,791 +0,0 @@ -%{ - -char *rcs_luastx = "$Id: lua.stx,v 3.47 1997/06/19 17:46:12 roberto Exp $"; - -#include <stdio.h> -#include <stdlib.h> -#include <string.h> - -#include "luadebug.h" -#include "luamem.h" -#include "lex.h" -#include "opcode.h" -#include "hash.h" -#include "inout.h" -#include "tree.h" -#include "table.h" -#include "lua.h" -#include "func.h" - -/* to avoid warnings generated by yacc */ -int yyparse (void); -#define malloc luaI_malloc -#define realloc luaI_realloc -#define free luaI_free - -#ifndef LISTING -#define LISTING 0 -#endif - -#ifndef CODE_BLOCK -#define CODE_BLOCK 256 -#endif -static int maxcode; -static int maxmain; -static int maxcurr; -static Byte *funcCode = NULL; -static Byte **initcode; -static Byte *basepc; -static int maincode; -static int pc; - - -#define MAXVAR 32 -static Long varbuffer[MAXVAR]; /* variables in an assignment list; - it's long to store negative Word values */ -static int nvarbuffer=0; /* number of variables at a list */ - -#define MAXLOCALS 32 -static TaggedString *localvar[MAXLOCALS]; /* store local variable names */ -static int nlocalvar=0; /* number of local variables */ - -#define MAXFIELDS FIELDS_PER_FLUSH*2 - -int lua_debug = 0; - -/* Internal functions */ - -static void yyerror (char *s) -{ - luaI_syntaxerror(s); -} - -static void check_space (int i) -{ - if (pc+i>maxcurr-1) /* 1 byte free to code HALT of main code */ - maxcurr = growvector(&basepc, maxcurr, Byte, codeEM, MAX_INT); -} - -static void code_byte (Byte c) -{ - check_space(1); - basepc[pc++] = c; -} - -static void code_word (Word n) -{ - check_space(sizeof(Word)); - memcpy(basepc+pc, &n, sizeof(Word)); - pc += sizeof(Word); -} - -static void code_float (real n) -{ - check_space(sizeof(real)); - memcpy(basepc+pc, &n, sizeof(real)); - pc += sizeof(real); -} - -static void code_code (TFunc *tf) -{ - check_space(sizeof(TFunc *)); - memcpy(basepc+pc, &tf, sizeof(TFunc *)); - pc += sizeof(TFunc *); -} - -static void code_word_at (Byte *p, int n) -{ - Word w = n; - if (w != n) - yyerror("block too big"); - memcpy(p, &w, sizeof(Word)); -} - -static void flush_record (int n) -{ - if (n == 0) return; - code_byte(STOREMAP); - code_byte(n); -} - -static void flush_list (int m, int n) -{ - if (n == 0) return; - if (m == 0) - code_byte(STORELIST0); - else - if (m < 255) - { - code_byte(STORELIST); - code_byte(m); - } - else - yyerror ("list constructor too long"); - code_byte(n); -} - -static void store_localvar (TaggedString *name, int n) -{ - if (nlocalvar+n < MAXLOCALS) - localvar[nlocalvar+n] = name; - else - yyerror ("too many local variables"); - if (lua_debug) - luaI_registerlocalvar(name, lua_linenumber); -} - -static void add_localvar (TaggedString *name) -{ - store_localvar(name, 0); - nlocalvar++; -} - -static void add_varbuffer (Long var) -{ - if (nvarbuffer < MAXVAR) - varbuffer[nvarbuffer++] = var; - else - yyerror ("variable buffer overflow"); -} - -static void code_string (Word w) -{ - code_byte(PUSHSTRING); - code_word(w); -} - -static void code_constant (TaggedString *s) -{ - code_string(luaI_findconstant(s)); -} - -static void code_number (float f) -{ - Word i; - if (f >= 0 && f <= (float)MAX_WORD && (float)(i=(Word)f) == f) { - /* f has an (short) integer value */ - if (i <= 2) code_byte(PUSH0 + i); - else if (i <= 255) - { - code_byte(PUSHBYTE); - code_byte(i); - } - else - { - code_byte(PUSHWORD); - code_word(i); - } - } - else - { - code_byte(PUSHFLOAT); - code_float(f); - } -} - -/* -** Search a local name and if find return its index. If do not find return -1 -*/ -static int lua_localname (TaggedString *n) -{ - int i; - for (i=nlocalvar-1; i >= 0; i--) - if (n == localvar[i]) return i; /* local var */ - return -1; /* global var */ -} - -/* -** Push a variable given a number. If number is positive, push global variable -** indexed by (number -1). If negative, push local indexed by ABS(number)-1. -** Otherwise, if zero, push indexed variable (record). -*/ -static void lua_pushvar (Long number) -{ - if (number > 0) /* global var */ - { - code_byte(PUSHGLOBAL); - code_word(number-1); - } - else if (number < 0) /* local var */ - { - number = (-number) - 1; - if (number < 10) code_byte(PUSHLOCAL0 + number); - else - { - code_byte(PUSHLOCAL); - code_byte(number); - } - } - else - { - code_byte(PUSHINDEXED); - } -} - -static void lua_codeadjust (int n) -{ - if (n+nlocalvar == 0) - code_byte(ADJUST0); - else - { - code_byte(ADJUST); - code_byte(n+nlocalvar); - } -} - -static void change2main (void) -{ - /* (re)store main values */ - pc=maincode; basepc=*initcode; maxcurr=maxmain; - nlocalvar=0; -} - -static void savemain (void) -{ - /* save main values */ - maincode=pc; *initcode=basepc; maxmain=maxcurr; -} - -static void init_func (void) -{ - if (funcCode == NULL) /* first function */ - { - funcCode = newvector(CODE_BLOCK, Byte); - maxcode = CODE_BLOCK; - } - savemain(); /* save main values */ - /* set func values */ - pc=0; basepc=funcCode; maxcurr=maxcode; - nlocalvar = 0; - luaI_codedebugline(lua_linenumber); -} - -static void codereturn (void) -{ - if (nlocalvar == 0) - code_byte(RETCODE0); - else - { - code_byte(RETCODE); - code_byte(nlocalvar); - } -} - -void luaI_codedebugline (int line) -{ - static int lastline = 0; - if (lua_debug && line != lastline) - { - code_byte(SETLINE); - code_word(line); - lastline = line; - } -} - -static int adjust_functioncall (Long exp, int i) -{ - if (exp <= 0) - return -exp; /* exp is -list length */ - else - { - int temp = basepc[exp]; - basepc[exp] = i; - return temp+i; - } -} - -static void adjust_mult_assign (int vars, Long exps, int temps) -{ - if (exps > 0) - { /* must correct function call */ - int diff = vars - basepc[exps]; - if (diff >= 0) - adjust_functioncall(exps, diff); - else - { - adjust_functioncall(exps, 0); - lua_codeadjust(temps); - } - } - else if (vars != -exps) - lua_codeadjust(temps); -} - -static int close_parlist (int dots) -{ - if (!dots) - lua_codeadjust(0); - else - { - code_byte(VARARGS); - code_byte(nlocalvar); - add_localvar(luaI_createfixedstring("arg")); - } - return lua_linenumber; -} - -static void storesinglevar (Long v) -{ - if (v > 0) /* global var */ - { - code_byte(STOREGLOBAL); - code_word(v-1); - } - else if (v < 0) /* local var */ - { - int number = (-v) - 1; - if (number < 10) code_byte(STORELOCAL0 + number); - else - { - code_byte(STORELOCAL); - code_byte(number); - } - } - else - code_byte(STOREINDEXED0); -} - -static void lua_codestore (int i) -{ - if (varbuffer[i] != 0) /* global or local var */ - storesinglevar(varbuffer[i]); - else /* indexed var */ - { - int j; - int upper=0; /* number of indexed variables upper */ - int param; /* number of itens until indexed expression */ - for (j=i+1; j <nvarbuffer; j++) - if (varbuffer[j] == 0) upper++; - param = upper*2 + i; - if (param == 0) - code_byte(STOREINDEXED0); - else - { - code_byte(STOREINDEXED); - code_byte(param); - } - } -} - -static void codeIf (Long thenAdd, Long elseAdd) -{ - Long elseinit = elseAdd+sizeof(Word)+1; - if (pc == elseinit) /* no else */ - { - pc -= sizeof(Word)+1; - elseinit = pc; - } - else - { - basepc[elseAdd] = JMP; - code_word_at(basepc+elseAdd+1, pc-elseinit); - } - basepc[thenAdd] = IFFJMP; - code_word_at(basepc+thenAdd+1,elseinit-(thenAdd+sizeof(Word)+1)); -} - - -/* -** Parse LUA code. -*/ -void lua_parse (TFunc *tf) -{ - initcode = &(tf->code); - *initcode = newvector(CODE_BLOCK, Byte); - maincode = 0; - maxmain = CODE_BLOCK; - change2main(); - if (yyparse ()) lua_error("parse error"); - savemain(); - (*initcode)[maincode++] = RETCODE0; - tf->size = maincode; -#if LISTING -{ static void PrintCode (Byte *c, Byte *end); - PrintCode(*initcode,*initcode+maincode); } -#endif -} - - -%} - - -%union -{ - int vInt; - float vFloat; - char *pChar; - Word vWord; - Long vLong; - TFunc *pFunc; - TaggedString *pTStr; -} - -%start chunk - -%token WRONGTOKEN -%token NIL -%token IF THEN ELSE ELSEIF WHILE DO REPEAT UNTIL END -%token RETURN -%token LOCAL -%token FUNCTION -%token DOTS -%token <vFloat> NUMBER -%token <vWord> STRING -%token <pTStr> NAME - -%type <vLong> PrepJump -%type <vLong> exprlist, exprlist1 /* if > 0, points to function return - counter (which has list length); if <= 0, -list lenght */ -%type <vLong> functioncall, expr /* if != 0, points to function return - counter */ -%type <vInt> varlist1, funcParams, funcvalue -%type <vInt> fieldlist, localdeclist, decinit -%type <vInt> ffieldlist, ffieldlist1, semicolonpart -%type <vInt> lfieldlist, lfieldlist1 -%type <vInt> parlist, parlist1, par -%type <vLong> var, singlevar, funcname -%type <pFunc> body - -%left AND OR -%left EQ NE '>' '<' LE GE -%left CONC -%left '+' '-' -%left '*' '/' -%left UNARY NOT -%right '^' - - -%% /* beginning of rules section */ - -chunk : chunklist ret ; - -chunklist : /* empty */ - | chunklist stat sc - | chunklist function - ; - -function : FUNCTION funcname body - { - code_byte(PUSHFUNCTION); - code_code($3); - storesinglevar($2); - } - ; - -funcname : var { $$ =$1; init_func(); } - | varexp ':' NAME - { - code_constant($3); - $$ = 0; /* indexed variable */ - init_func(); - add_localvar(luaI_createfixedstring("self")); - } - ; - -body : '(' parlist ')' block END - { - codereturn(); - $$ = new(TFunc); - luaI_initTFunc($$); - $$->size = pc; - $$->code = newvector(pc, Byte); - $$->lineDefined = $2; - memcpy($$->code, basepc, pc*sizeof(Byte)); - if (lua_debug) - luaI_closelocalvars($$); - /* save func values */ - funcCode = basepc; maxcode=maxcurr; -#if LISTING - PrintCode(funcCode,funcCode+pc); -#endif - change2main(); /* change back to main code */ - } - ; - -statlist : /* empty */ - | statlist stat sc - ; - -sc : /* empty */ | ';' ; - -stat : IF expr1 THEN PrepJump block PrepJump elsepart END - { codeIf($4, $6); } - - | WHILE {$<vLong>$=pc;} expr1 DO PrepJump block PrepJump END - { - basepc[$5] = IFFJMP; - code_word_at(basepc+$5+1, pc - ($5 + sizeof(Word)+1)); - basepc[$7] = UPJMP; - code_word_at(basepc+$7+1, pc - ($<vLong>2)); - } - - | REPEAT {$<vLong>$=pc;} block UNTIL expr1 PrepJump - { - basepc[$6] = IFFUPJMP; - code_word_at(basepc+$6+1, pc - ($<vLong>2)); - } - - | varlist1 '=' exprlist1 - { - { - int i; - adjust_mult_assign(nvarbuffer, $3, $1 * 2 + nvarbuffer); - for (i=nvarbuffer-1; i>=0; i--) - lua_codestore (i); - if ($1 > 1 || ($1 == 1 && varbuffer[0] != 0)) - lua_codeadjust (0); - } - } - | functioncall {;} - | LOCAL localdeclist decinit - { nlocalvar += $2; - adjust_mult_assign($2, $3, 0); - } - ; - -elsepart : /* empty */ - | ELSE block - | ELSEIF expr1 THEN PrepJump block PrepJump elsepart - { codeIf($4, $6); } - ; - -block : {$<vInt>$ = nlocalvar;} statlist ret - { - if (nlocalvar != $<vInt>1) - { - if (lua_debug) - for (; nlocalvar > $<vInt>1; nlocalvar--) - luaI_unregisterlocalvar(lua_linenumber); - else - nlocalvar = $<vInt>1; - lua_codeadjust (0); - } - } - ; - -ret : /* empty */ - | RETURN exprlist sc - { - adjust_functioncall($2, MULT_RET); - codereturn(); - } - ; - -PrepJump : /* empty */ - { - $$ = pc; - code_byte(0); /* open space */ - code_word (0); - } - ; - -expr1 : expr { adjust_functioncall($1, 1); } - ; - -expr : '(' expr ')' { $$ = $2; } - | expr1 EQ expr1 { code_byte(EQOP); $$ = 0; } - | expr1 '<' expr1 { code_byte(LTOP); $$ = 0; } - | expr1 '>' expr1 { code_byte(GTOP); $$ = 0; } - | expr1 NE expr1 { code_byte(EQOP); code_byte(NOTOP); $$ = 0; } - | expr1 LE expr1 { code_byte(LEOP); $$ = 0; } - | expr1 GE expr1 { code_byte(GEOP); $$ = 0; } - | expr1 '+' expr1 { code_byte(ADDOP); $$ = 0; } - | expr1 '-' expr1 { code_byte(SUBOP); $$ = 0; } - | expr1 '*' expr1 { code_byte(MULTOP); $$ = 0; } - | expr1 '/' expr1 { code_byte(DIVOP); $$ = 0; } - | expr1 '^' expr1 { code_byte(POWOP); $$ = 0; } - | expr1 CONC expr1 { code_byte(CONCOP); $$ = 0; } - | '-' expr1 %prec UNARY { code_byte(MINUSOP); $$ = 0;} - | table { $$ = 0; } - | varexp { $$ = 0;} - | NUMBER { code_number($1); $$ = 0; } - | STRING - { - code_string($1); - $$ = 0; - } - | NIL {code_byte(PUSHNIL); $$ = 0; } - | functioncall { $$ = $1; } - | NOT expr1 { code_byte(NOTOP); $$ = 0;} - | expr1 AND PrepJump {code_byte(POP); } expr1 - { - basepc[$3] = ONFJMP; - code_word_at(basepc+$3+1, pc - ($3 + sizeof(Word)+1)); - $$ = 0; - } - | expr1 OR PrepJump {code_byte(POP); } expr1 - { - basepc[$3] = ONTJMP; - code_word_at(basepc+$3+1, pc - ($3 + sizeof(Word)+1)); - $$ = 0; - } - ; - -table : - { - code_byte(CREATEARRAY); - $<vLong>$ = pc; code_word(0); - } - '{' fieldlist '}' - { - code_word_at(basepc+$<vLong>1, $3); - } - ; - -functioncall : funcvalue funcParams - { - code_byte(CALLFUNC); - code_byte($1+$2); - $$ = pc; - code_byte(0); /* may be modified by other rules */ - } - ; - -funcvalue : varexp { $$ = 0; } - | varexp ':' NAME - { - code_byte(PUSHSELF); - code_word(luaI_findconstant($3)); - $$ = 1; - } - ; - -funcParams : '(' exprlist ')' - { $$ = adjust_functioncall($2, 1); } - | table { $$ = 1; } - ; - -exprlist : /* empty */ { $$ = 0; } - | exprlist1 { $$ = $1; } - ; - -exprlist1 : expr { if ($1 != 0) $$ = $1; else $$ = -1; } - | exprlist1 ',' { $<vLong>$ = adjust_functioncall($1, 1); } expr - { - if ($4 == 0) $$ = -($<vLong>3 + 1); /* -length */ - else - { - adjust_functioncall($4, $<vLong>3); - $$ = $4; - } - } - ; - -parlist : /* empty */ { $$ = close_parlist(0); } - | parlist1 { $$ = close_parlist($1); } - ; - -parlist1 : par { $$ = $1; } - | parlist1 ',' par - { - if ($1) - lua_error("invalid parameter list"); - $$ = $3; - } - ; - -par : NAME { add_localvar($1); $$ = 0; } - | DOTS { $$ = 1; } - ; - -fieldlist : lfieldlist - { flush_list($1/FIELDS_PER_FLUSH, $1%FIELDS_PER_FLUSH); } - semicolonpart - { $$ = $1+$3; } - | ffieldlist1 lastcomma - { $$ = $1; flush_record($1%FIELDS_PER_FLUSH); } - ; - -semicolonpart : /* empty */ - { $$ = 0; } - | ';' ffieldlist - { $$ = $2; flush_record($2%FIELDS_PER_FLUSH); } - ; - -lastcomma : /* empty */ - | ',' - ; - -ffieldlist : /* empty */ { $$ = 0; } - | ffieldlist1 lastcomma { $$ = $1; } - ; - -ffieldlist1 : ffield {$$=1;} - | ffieldlist1 ',' ffield - { - $$=$1+1; - if ($$%FIELDS_PER_FLUSH == 0) flush_record(FIELDS_PER_FLUSH); - } - ; - -ffield : ffieldkey '=' expr1 - ; - -ffieldkey : '[' expr1 ']' - | NAME { code_constant($1); } - ; - -lfieldlist : /* empty */ { $$ = 0; } - | lfieldlist1 lastcomma { $$ = $1; } - ; - -lfieldlist1 : expr1 {$$=1;} - | lfieldlist1 ',' expr1 - { - $$=$1+1; - if ($$%FIELDS_PER_FLUSH == 0) - flush_list($$/FIELDS_PER_FLUSH - 1, FIELDS_PER_FLUSH); - } - ; - -varlist1 : var - { - nvarbuffer = 0; - add_varbuffer($1); - $$ = ($1 == 0) ? 1 : 0; - } - | varlist1 ',' var - { - add_varbuffer($3); - $$ = ($3 == 0) ? $1 + 1 : $1; - } - ; - -var : singlevar { $$ = $1; } - | varexp '[' expr1 ']' - { - $$ = 0; /* indexed variable */ - } - | varexp '.' NAME - { - code_constant($3); - $$ = 0; /* indexed variable */ - } - ; - -singlevar : NAME - { - int local = lua_localname($1); - if (local == -1) /* global var */ - $$ = luaI_findsymbol($1)+1; /* return positive value */ - else - $$ = -(local+1); /* return negative value */ - } - ; - -varexp : var { lua_pushvar($1); } - ; - -localdeclist : NAME {store_localvar($1, 0); $$ = 1;} - | localdeclist ',' NAME - { - store_localvar($3, $1); - $$ = $1+1; - } - ; - -decinit : /* empty */ { $$ = 0; } - | '=' exprlist1 { $$ = $2; } - ; - -%% diff --git a/src/lua/Makefile b/src/lua/Makefile new file mode 100644 index 00000000..1ec83706 --- /dev/null +++ b/src/lua/Makefile @@ -0,0 +1,32 @@ +# makefile for lua interpreter + +LUA= ../.. + +include $(LUA)/config + +EXTRA_DEFS= $(POSIX) + +OBJS= lua.o +SRCS= lua.c + +T= $(BIN)/lua + +all: $T + +$T: $(OBJS) $(LIB)/liblua.a $(LIB)/liblualib.a + $(CC) -o $@ $(OBJS) -L$(LIB) -llua -llualib -lm + +$(LIB)/liblua.a: + cd ..; make + +$(LIB)/liblualib.a: + cd ../lib; make + +clean: + rm -f $(OBJS) $T + +co: + co -q -f -M $(SRCS) + +klean: clean + rm -f $(SRCS) diff --git a/src/lua/README b/src/lua/README new file mode 100644 index 00000000..31340429 --- /dev/null +++ b/src/lua/README @@ -0,0 +1,20 @@ +This client is a sample lua interpreter. +It can be used as a batch interpreter and interactively. +Here are the options it understands: + + -v print version information + -d turn debug on + -e stat dostring `stat' + -q interactive mode without prompt + -i interactive mode with prompt + - executes stdin as a file + a=b sets global `a' with string `b' (no need to quote b) + name dofile `name' + +If no options are given, then it reads and executes lines from stdin. +In this case, each line must contain a complete statement. +To span a statement across several lines, end each line with a backslash '\'. +To change the prompt, set the global variable _PROMPT to whatever you want. + +This interpreter is good for using Lua as a standalone language. +For a minimal interpreter, see etc/min.c. diff --git a/src/lua/lua.c b/src/lua/lua.c new file mode 100644 index 00000000..a6a92f71 --- /dev/null +++ b/src/lua/lua.c @@ -0,0 +1,194 @@ +/* +** $Id: lua.c,v 1.14 1998/02/11 20:56:05 roberto Exp $ +** Lua stand-alone interpreter +** See Copyright Notice in lua.h +*/ + + +#include <signal.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> + +#include "lua.h" +#include "luadebug.h" +#include "lualib.h" + + +#ifndef OLD_ANSI +#include <locale.h> +#else +#define setlocale(a,b) 0 +#endif + +#ifdef _POSIX_SOURCE +#include <unistd.h> +#else +#define isatty(x) (x==0) /* assume stdin is a tty */ +#endif + + +typedef void (*handler)(int); /* type for signal actions */ + +static void laction (int i); + +static handler lreset (void) +{ + lua_linehook = NULL; + lua_callhook = NULL; + return signal(SIGINT, laction); +} + +static void lstop (void) +{ + lreset(); + lua_error("interrupted!"); +} + +static void laction (int i) +{ + lua_linehook = (lua_LHFunction)lstop; + lua_callhook = (lua_CHFunction)lstop; +} + +static int ldo (int (*f)(char *), char *name) +{ + int res; + handler h = lreset(); + res = f(name); /* dostring | dofile */ + signal(SIGINT, h); /* restore old action */ + return res; +} + + +static void print_message (void) +{ + fprintf(stderr, +"Lua: command line options:\n" +" -v print version information\n" +" -d turn debug on\n" +" -e stat dostring `stat'\n" +" -q interactive mode without prompt\n" +" -i interactive mode with prompt\n" +" - executes stdin as a file\n" +" a=b sets global `a' with string `b'\n" +" name dofile `name'\n\n"); +} + + +static void assign (char *arg) +{ + if (strlen(arg) >= 500) + fprintf(stderr, "lua: shell argument too long"); + else { + char buffer[500]; + char *eq = strchr(arg, '='); + lua_pushstring(eq+1); + strncpy(buffer, arg, eq-arg); + buffer[eq-arg] = 0; + lua_setglobal(buffer); + } +} + +#define BUF_SIZE 512 + +static void manual_input (int prompt) +{ + int cont = 1; + while (cont) { + char buffer[BUF_SIZE]; + int i = 0; + lua_beginblock(); + if (prompt) + printf("%s", lua_getstring(lua_getglobal("_PROMPT"))); + 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 >= BUF_SIZE-1) { + fprintf(stderr, "lua: argument line too long\n"); + break; + } + else buffer[i++] = c; + } + buffer[i] = 0; + ldo(lua_dostring, buffer); + lua_endblock(); + } + printf("\n"); +} + + +int main (int argc, char *argv[]) +{ + int i; + setlocale(LC_ALL, ""); + lua_iolibopen(); + lua_strlibopen(); + lua_mathlibopen(); + lua_pushstring("> "); lua_setglobal("_PROMPT"); + if (argc < 2) { /* no arguments? */ + if (isatty(0)) { + printf("%s %s\n", LUA_VERSION, LUA_COPYRIGHT); + manual_input(1); + } + else + ldo(lua_dofile, NULL); /* executes stdin as a file */ + } + else for (i=1; i<argc; i++) { + if (argv[i][0] == '-') { /* option? */ + switch (argv[i][1]) { + case 0: + ldo(lua_dofile, NULL); /* executes stdin as a file */ + break; + case 'i': + manual_input(1); + break; + case 'q': + manual_input(0); + break; + case 'd': + lua_debug = 1; + break; + case 'v': + printf("%s %s\n(written by %s)\n\n", + LUA_VERSION, LUA_COPYRIGHT, LUA_AUTHORS); + break; + case 'e': + i++; + if (ldo(lua_dostring, argv[i]) != 0) { + fprintf(stderr, "lua: error running argument `%s'\n", argv[i]); + return 1; + } + break; + default: + print_message(); + exit(1); + } + } + else if (strchr(argv[i], '=')) + assign(argv[i]); + else { + int result = ldo(lua_dofile, argv[i]); + if (result) { + if (result == 2) { + fprintf(stderr, "lua: cannot execute file "); + perror(argv[i]); + } + exit(1); + } + } + } +#ifdef DEBUG + lua_close(); +#endif + return 0; +} + diff --git a/src/luac/Makefile b/src/luac/Makefile index 813393e4..195b5cc4 100644 --- a/src/luac/Makefile +++ b/src/luac/Makefile @@ -1,24 +1,28 @@ -# makefile for lua distribution (compiler) +# makefile for lua compiler LUA= ../.. include $(LUA)/config INCS= -I$(INC) $(EXTRA_INCS) -I.. -OBJS= dump.o luac.o print.o -SRCS= dump.c luac.c print.c luac.h print.h -T=$(BIN)/luac +OBJS= dump.o luac.o opcode.o opt.o print.o stubs.o +SRCS= dump.c luac.c opcode.c opt.c print.c stubs.c luac.h opcode.h + +T= $(BIN)/luac all: $T -$T: $(OBJS) +$T: $(OBJS) $(LIB)/liblua.a $(CC) -o $@ $(OBJS) -L$(LIB) -llua +$(LIB)/liblua.a: + cd ..; make + clean: rm -f $(OBJS) $T co: - co -f -M $(SRCS) + co -q -f -M $(SRCS) klean: clean rm -f $(SRCS) diff --git a/src/luac/README b/src/luac/README new file mode 100644 index 00000000..1fd49cc2 --- /dev/null +++ b/src/luac/README @@ -0,0 +1,25 @@ +luac translates Lua programs into binary files that can be loaded and executed +with lua_dofile in C or with dofile in Lua. +The main advantages of pre-compiling chunks are: faster loading, +protecting source code from user changes, off-line syntax error detection. + +luac can also be used to learn about the Lua virtual machine. + +Here are the options it understands: + + -c compile (default) + -u undump + -d generate debugging information + -D predefine symbol for conditional compilation + -l list (default for -u) + -o output file for -c (default is "luac.out") + -O optimize + -p parse only + -q quiet (default for -c) + -v show version information + -V verbose + - compile "stdin" + +Finally, luac is an example of how to use the internals of Lua (politely). +Also, 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 index 73839f38..ce9551e6 100644 --- a/src/luac/dump.c +++ b/src/luac/dump.c @@ -1,240 +1,158 @@ /* -** dump.c -** thread and save bytecodes to file +** $Id: dump.c,v 1.11 1998/07/12 00:17:37 lhf Exp $ +** save bytecodes to file +** See Copyright Notice in lua.h */ -char* rcs_dump="$Id: dump.c,v 1.20 1997/06/19 14:56:04 lhf Exp $"; - #include <stdio.h> #include <stdlib.h> -#include <string.h> #include "luac.h" -static int SawVar(int i, int at) +#define NotWord(x) ((unsigned short)x!=x) +#define DumpBlock(b,size,D) fwrite(b,size,1,D) +#define DumpNative(t,D) DumpBlock(&t,sizeof(t),D) + +static void DumpWord(int i, FILE* D) +{ + int hi= 0x0000FF & (i>>8); + int lo= 0x0000FF & i; + fputc(hi,D); + fputc(lo,D); +} + +static void DumpLong(long i, FILE* D) { - int old=VarLoc(i); - VarLoc(i)=at; - return old; + int hi= 0x00FFFF & (i>>16); + int lo= 0x00FFFF & i; + DumpWord(hi,D); + DumpWord(lo,D); } -static int SawStr(int i, int at) +#if ID_NUMBER==ID_REAL4 +/* LUA_NUMBER */ +/* assumes sizeof(long)==4 and sizeof(float)==4 (IEEE) */ +static void DumpFloat(float f, FILE* D) { - int old=StrLoc(i); - StrLoc(i)=at; - return old; + long l=*(long*)&f; + DumpLong(l,D); } +#endif -static void ThreadCode(Byte* code, Byte* end) +#if ID_NUMBER==ID_REAL8 +/* LUA_NUMBER */ +/* assumes sizeof(long)==4 and sizeof(double)==8 (IEEE) */ +static void DumpDouble(double f, FILE* D) { - Byte* p; - int i; - for (i=0; i<lua_ntable; i++) VarLoc(i)=0; - for (i=0; i<lua_nconstant; i++) StrLoc(i)=0; - for (p=code; p!=end;) + long* l=(long*)&f; + int x=1; + if (*(char*)&x==1) /* little-endian */ { - int op=*p; - int at=p-code+1; - switch (op) - { - case PUSHNIL: - case PUSH0: - case PUSH1: - case PUSH2: - case PUSHLOCAL0: - case PUSHLOCAL1: - case PUSHLOCAL2: - case PUSHLOCAL3: - case PUSHLOCAL4: - case PUSHLOCAL5: - case PUSHLOCAL6: - case PUSHLOCAL7: - case PUSHLOCAL8: - case PUSHLOCAL9: - case PUSHINDEXED: - case STORELOCAL0: - case STORELOCAL1: - case STORELOCAL2: - case STORELOCAL3: - case STORELOCAL4: - case STORELOCAL5: - case STORELOCAL6: - case STORELOCAL7: - case STORELOCAL8: - case STORELOCAL9: - case STOREINDEXED0: - case ADJUST0: - case EQOP: - case LTOP: - case LEOP: - case GTOP: - case GEOP: - case ADDOP: - case SUBOP: - case MULTOP: - case DIVOP: - case POWOP: - case CONCOP: - case MINUSOP: - case NOTOP: - case POP: - case RETCODE0: - p++; - break; - case PUSHBYTE: - case PUSHLOCAL: - case STORELOCAL: - case STOREINDEXED: - case STORELIST0: - case ADJUST: - case RETCODE: - case VARARGS: - case STOREMAP: - p+=2; - break; - case PUSHWORD: - case CREATEARRAY: - case ONTJMP: - case ONFJMP: - case JMP: - case UPJMP: - case IFFJMP: - case IFFUPJMP: - case SETLINE: - case STORELIST: - case CALLFUNC: - p+=3; - break; - case PUSHFLOAT: - p+=5; /* assumes sizeof(float)==4 */ - break; - case PUSHFUNCTION: - p+=sizeof(TFunc*)+1; - break; - case PUSHSTRING: - case PUSHSELF: - { - Word w; - p++; - get_word(w,p); - w=SawStr(w,at); - memcpy(p-2,&w,sizeof(w)); - break; - } - case PUSHGLOBAL: - case STOREGLOBAL: - { - Word w; - p++; - get_word(w,p); - w=SawVar(w,at); - memcpy(p-2,&w,sizeof(w)); - break; - } - case STORERECORD: - { - int n=*++p; - p++; - while (n--) - { - Word w; - at=p-code; - get_word(w,p); - w=SawStr(w,at); - memcpy(p-2,&w,sizeof(w)); - } - break; - } - default: /* cannot happen */ - fprintf(stderr,"luac: bad opcode %d at %d\n",*p,(int)(p-code)); - exit(1); - break; - } + DumpLong(l[1],D); + DumpLong(l[0],D); + } + else /* big-endian */ + { + DumpLong(l[0],D); + DumpLong(l[1],D); } } +#endif -static void DumpWord(int i, FILE* D) +static void DumpCode(TProtoFunc* tf, FILE* D) { - Word w=i; - fwrite(&w,sizeof(w),1,D); + int size=CodeSize(tf); + if (NotWord(size)) + fprintf(stderr,"luac: warning: " + "\"%s\":%d code too long for 16-bit machines (%d bytes)\n", + fileName(tf),tf->lineDefined,size); + DumpLong(size,D); + DumpBlock(tf->code,size,D); } -static void DumpBlock(void* b, int size, FILE* D) +static void DumpString(char* s, int size, FILE* D) { - fwrite(b,size,1,D); + if (s==NULL) + DumpWord(0,D); + else + { + if (NotWord(size)) + luaL_verror("string too long (%d bytes): \"%.32s...\"",size,s); + DumpWord(size,D); + DumpBlock(s,size,D); + } } -static void DumpSize(int i, FILE* D) +static void DumpTString(TaggedString* s, FILE* D) { - Word lo=i&0x0FFFF; - Word hi=(i>>16)&0x0FFFF; - fwrite(&hi,sizeof(hi),1,D); - fwrite(&lo,sizeof(lo),1,D); - if (hi!=0) - fprintf(stderr, - "luac: warning: code too long for 16-bit machines (%d bytes)\n",i); + if (s==NULL) DumpString(NULL,0,D); else DumpString(s->str,s->u.s.len+1,D); } -static void DumpString(char* s, FILE* D) +static void DumpLocals(TProtoFunc* tf, FILE* D) { - int n=strlen(s)+1; - if ((Word)n != n) + int n; + LocVar* lv; + for (n=0,lv=tf->locvars; lv && lv->line>=0; lv++) ++n; + DumpWord(n,D); + for (lv=tf->locvars; lv && lv->line>=0; lv++) { - fprintf(stderr,"luac: string too long (%d bytes): \"%.32s...\"\n",n,s); - exit(1); + DumpWord(lv->line,D); + DumpTString(lv->varname,D); } - DumpWord(n,D); - DumpBlock(s,n,D); } -static void DumpStrings(FILE* D) +static void DumpFunction(TProtoFunc* tf, FILE* D); + +static void DumpConstants(TProtoFunc* tf, FILE* D) { - int i; - for (i=0; i<lua_ntable; i++) - { - if (VarLoc(i)!=0) - { - fputc(ID_VAR,D); - DumpWord(VarLoc(i),D); - DumpString(VarStr(i),D); - } - VarLoc(i)=i; - } - for (i=0; i<lua_nconstant; i++) + int i,n=tf->nconsts; + DumpWord(n,D); + for (i=0; i<n; i++) { - if (StrLoc(i)!=0) + TObject* o=tf->consts+i; + fputc(-ttype(o),D); + switch (ttype(o)) { - fputc(ID_STR,D); - DumpWord(StrLoc(i),D); - DumpString(StrStr(i),D); + case LUA_T_NUMBER: + DumpNumber(nvalue(o),D); + break; + case LUA_T_STRING: + DumpTString(tsvalue(o),D); + break; + case LUA_T_PROTO: + DumpFunction(tfvalue(o),D); + break; + case LUA_T_NIL: + break; + default: /* cannot happen */ + luaL_verror("cannot dump constant #%d: type=%d [%s]", + i,ttype(o),luaO_typename(o)); + break; } - StrLoc(i)=i; } } -void DumpFunction(TFunc* tf, FILE* D) +static void DumpFunction(TProtoFunc* tf, FILE* D) { - ThreadCode(tf->code,tf->code+tf->size); - fputc(ID_FUN,D); - DumpSize(tf->size,D); DumpWord(tf->lineDefined,D); - if (IsMain(tf)) - DumpString(tf->fileName,D); - else - DumpWord(tf->marked,D); - DumpBlock(tf->code,tf->size,D); - DumpStrings(D); + DumpTString(tf->fileName,D); + DumpCode(tf,D); + DumpLocals(tf,D); + DumpConstants(tf,D); } -void DumpHeader(FILE* D) +static void DumpHeader(TProtoFunc* Main, FILE* D) { - Word w=TEST_WORD; - float f=TEST_FLOAT; + real t=TEST_NUMBER; fputc(ID_CHUNK,D); fputs(SIGNATURE,D); fputc(VERSION,D); - fputc(sizeof(Word),D); - fputc(sizeof(float),D); - fputc(sizeof(TFunc*),D); - fwrite(&w,sizeof(w),1,D); - fwrite(&f,sizeof(f),1,D); + fputc(ID_NUMBER,D); + fputc(sizeof(t),D); + DumpNumber(t,D); +} + +void DumpChunk(TProtoFunc* Main, FILE* D) +{ + DumpHeader(Main,D); + DumpFunction(Main,D); } diff --git a/src/luac/luac.c b/src/luac/luac.c index 713da1fb..c4619153 100644 --- a/src/luac/luac.c +++ b/src/luac/luac.c @@ -1,37 +1,51 @@ /* -** luac.c +** $Id: luac.c,v 1.10 1998/07/12 00:38:30 lhf Exp $ ** lua compiler (saves bytecodes to files; also list binary files) +** See Copyright Notice in lua.h */ -char* rcs_luac="$Id: luac.c,v 1.23 1997/06/20 20:34:04 lhf Exp $"; - #include <stdio.h> #include <stdlib.h> #include <string.h> #include "luac.h" -#include "lex.h" -#include "zio.h" +#include "lparser.h" +#include "lzio.h" +#include "luadebug.h" + +#define OUTPUT "luac.out" /* default output file */ -static void compile(char* filename); -static void undump(char* filename); +extern void DumpChunk(TProtoFunc* Main, FILE* D); +extern void PrintChunk(TProtoFunc* Main); +extern void OptChunk(TProtoFunc* Main); + +static FILE* efopen(char* name, char* mode); +static void doit(int undump, char* filename); static int listing=0; /* list bytecodes? */ +static int debugging=0; /* debug? */ static int dumping=1; /* dump bytecodes? */ static int undumping=0; /* undump bytecodes? */ +static int optimizing=0; /* optimize? */ +static int parsing=0; /* parse only? */ +static int verbose=0; /* tell user what is done */ static FILE* D; /* output file */ static void usage(void) { - fprintf(stderr, - "usage: luac [-c | -u] [-d] [-l] [-p] [-q] [-v] [-o output] file ...\n" + fprintf(stderr,"usage: " + "luac [-c | -u] [-D name] [-d] [-l] [-o output] [-O] [-p] [-q] [-v] [-V] [files]\n" " -c\tcompile (default)\n" " -u\tundump\n" " -d\tgenerate debugging information\n" + " -D\tpredefine symbol for conditional compilation\n" " -l\tlist (default for -u)\n" - " -o\toutput file for -c (default \"luac.out\")\n" + " -o\toutput file for -c (default is \"" OUTPUT "\")\n" + " -O\toptimize\n" " -p\tparse only\n" " -q\tquiet (default for -c)\n" " -v\tshow version information\n" + " -V\tverbose\n" + " -\tcompile \"stdin\"\n" ); exit(1); } @@ -40,8 +54,9 @@ static void usage(void) int main(int argc, char* argv[]) { - char* d="luac.out"; /* default output file */ + char* d=OUTPUT; /* output file name */ int i; + lua_open(); for (i=1; i<argc; i++) { if (argv[i][0]!='-') /* end of options */ @@ -53,14 +68,25 @@ int main(int argc, char* argv[]) dumping=1; undumping=0; } + else if (IS("-D")) /* $define */ + { + TaggedString* s=luaS_new(argv[++i]); + s->u.s.globalval.ttype=LUA_T_NUMBER; + s->u.s.globalval.value.n=1; + } else if (IS("-d")) /* debug */ - lua_debug=1; + debugging=1; else if (IS("-l")) /* list */ listing=1; else if (IS("-o")) /* output file */ d=argv[++i]; - else if (IS("-p")) /* parse only (for timing purposes) */ + else if (IS("-O")) /* optimize */ + optimizing=1; + else if (IS("-p")) /* parse only */ + { dumping=0; + parsing=1; + } else if (IS("-q")) /* quiet */ listing=0; else if (IS("-u")) /* undump */ @@ -71,120 +97,88 @@ int main(int argc, char* argv[]) } else if (IS("-v")) /* show version */ printf("%s %s\n(written by %s)\n\n",LUA_VERSION,LUA_COPYRIGHT,LUA_AUTHORS); + else if (IS("-V")) /* verbose */ + verbose=1; else /* unknown option */ usage(); } --i; /* fake new argv[0] */ argc-=i; argv+=i; - if (dumping) + if (dumping || parsing) { if (argc<2) usage(); - for (i=1; i<argc; i++) /* play safe with output file */ - if (IS(d)) - { - fprintf(stderr,"luac: will not overwrite input file \"%s\"\n",d); - exit(1); - } - D=fopen(d,"wb"); /* must open in binary mode */ - if (D==NULL) + if (dumping) { - fprintf(stderr,"luac: cannot open "); - perror(d); - exit(1); + for (i=1; i<argc; i++) /* play safe with output file */ + if (IS(d)) luaL_verror("will not overwrite input file \"%s\"",d); + D=efopen(d,"wb"); /* must open in binary mode */ +#if ID_NUMBER==ID_NATIVE + if (verbose) fprintf(stderr,"luac: warning: " + "saving numbers in native format. file may not be portable.\n"); +#endif } - for (i=1; i<argc; i++) compile(IS("-")? NULL : argv[i]); - fclose(D); + for (i=1; i<argc; i++) doit(0,IS("-")? NULL : argv[i]); + if (dumping) fclose(D); } if (undumping) { if (argc<2) - undump("luac.out"); + doit(1,OUTPUT); else - for (i=1; i<argc; i++) undump(IS("-")? NULL : argv[i]); + for (i=1; i<argc; i++) doit(1,IS("-")? NULL : argv[i]); } return 0; } -static void do_dump(TFunc* Main) -{ - TFunc* tf; - LinkFunctions(Main); - if (listing) - { - for (tf=Main; tf!=NULL; tf=tf->next) PrintFunction(tf,Main); - } - if (dumping) - { - DumpHeader(D); - for (tf=Main; tf!=NULL; tf=tf->next) DumpFunction(tf,D); - } - for (tf=Main; tf!=NULL; ) - { - TFunc* nf=tf->next; - luaI_freefunc(tf); - tf=nf; - } -} - static void do_compile(ZIO* z) { - TFunc* tf=new(TFunc); - lua_setinput(z); - luaI_initTFunc(tf); - tf->fileName=lua_parsedfile; - lua_parse(tf); - do_dump(tf); + TProtoFunc* Main; + if (optimizing) lua_debug=0; /* set debugging before parsing */ + if (debugging) lua_debug=1; + Main=luaY_parser(z); + if (optimizing) OptChunk(Main); + if (listing) PrintChunk(Main); + if (dumping) DumpChunk(Main,D); } -static void compile(char* filename) +static void do_undump(ZIO* z) { - FILE* f= (filename==NULL) ? stdin : fopen(filename, "r"); - if (f==NULL) - { - fprintf(stderr,"luac: cannot open "); - perror(filename); - exit(1); - } - else + while (1) { - ZIO z; - zFopen(&z,f); - luaI_setparsedfile(filename?filename:"(stdin)"); - do_compile(&z); - fclose(f); + TProtoFunc* Main=luaU_undump1(z); + if (Main==NULL) break; + if (optimizing) OptChunk(Main); + if (listing) PrintChunk(Main); } } -static void do_undump(ZIO* z) +static void doit(int undump, char* filename) { - TFunc* Main; - while ((Main=luaI_undump1(z))) + FILE* f; + ZIO z; + if (filename==NULL) { - if (listing) - { - TFunc* tf; - for (tf=Main; tf!=NULL; tf=tf->next) - PrintFunction(tf,Main); - } - luaI_freefunc(Main); /* TODO: free others */ + f=stdin; filename="(stdin)"; + } + else + { + f=efopen(filename, undump ? "rb" : "r"); } + zFopen(&z,f,filename); + if (verbose) fprintf(stderr,"%s\n",filename); + if (undump) do_undump(&z); else do_compile(&z); + if (f!=stdin) fclose(f); } -static void undump(char* filename) +static FILE* efopen(char* name, char* mode) { - FILE* f= (filename==NULL) ? stdin : fopen(filename, "rb"); + FILE* f=fopen(name,mode); if (f==NULL) { - fprintf(stderr,"luac: cannot open "); - perror(filename); + fprintf(stderr,"luac: cannot open %sput file ",mode[0]=='r' ? "in" : "out"); + perror(name); exit(1); } - else - { - ZIO z; - zFopen(&z,f); - do_undump(&z); - fclose(f); - } + return f; } diff --git a/src/luac/luac.h b/src/luac/luac.h index 815824ca..c3d8d73a 100644 --- a/src/luac/luac.h +++ b/src/luac/luac.h @@ -1,25 +1,33 @@ /* -** luac.h -** definitions for luac compiler -** $Id: luac.h,v 1.8 1997/06/19 17:32:08 lhf Exp $ +** $Id: luac.h,v 1.6 1998/07/12 00:17:37 lhf Exp $ +** definitions for luac +** See Copyright Notice in lua.h */ -#include "inout.h" -#include "luamem.h" -#include "opcode.h" -#include "table.h" -#include "undump.h" +#include "lauxlib.h" +#include "lfunc.h" +#include "lobject.h" +#include "lopcodes.h" +#include "lstring.h" +#include "lundump.h" -#define VarStr(i) (lua_table[i].varname->str) -#define VarLoc(i) (lua_table[i].varname->u.s.varindex) -#define StrStr(i) (lua_constant[i]->str) -#define StrLoc(i) (lua_constant[i]->u.s.constindex) +typedef struct +{ + char* name; + int size; + int op; + int class; + int arg; + int arg2; +} Opcode; -extern Word lua_ntable; -extern Word lua_nconstant; -extern int lua_debug; +int OpcodeInfo(TProtoFunc* tf, Byte* p, Opcode* I, char* xFILE, int xLINE); +int CodeSize(TProtoFunc* tf); -void LinkFunctions(TFunc* tf); -void PrintFunction(TFunc* tf, TFunc* Main); -void DumpHeader(FILE* D); -void DumpFunction(TFunc* tf, FILE* D); +#define INFO(tf,p,I) OpcodeInfo(tf,p,I,__FILE__,__LINE__) +#define fileName(tf) ( (tf->fileName)==NULL ? NULL : tf->fileName->str ) + +#define NOP 255 +#define STACK -1 +#define ARGS -2 +#define VARARGS -3 diff --git a/src/luac/opcode.c b/src/luac/opcode.c new file mode 100644 index 00000000..c97e46a5 --- /dev/null +++ b/src/luac/opcode.c @@ -0,0 +1,87 @@ +/* +** $Id: opcode.c,v 1.4 1998/07/12 00:17:37 lhf Exp $ +** opcode information +** See Copyright Notice in lua.h +*/ + +#include "luac.h" + +static Opcode Info[]= /* ORDER lopcodes.h */ +{ +#include "opcode.h" +}; + +#define NOPCODES (sizeof(Info)/sizeof(Info[0])) + +int OpcodeInfo(TProtoFunc* tf, Byte* p, Opcode* I, char* xFILE, int xLINE) +{ + Opcode OP; + Byte* code=tf->code; + int op=*p; + if (p==code) + { + OP.name="STACK"; + OP.size=1; + OP.op=STACK; + OP.class=STACK; + OP.arg=op; + } + else if (p==code+1) + { + OP.size=1; + if (op>=ZEROVARARG) + { + OP.name="VARARGS"; + OP.op=VARARGS; + OP.class=VARARGS; + OP.arg=op-ZEROVARARG; + } + else + { + OP.name="ARGS"; + OP.op=ARGS; + OP.class=ARGS; + OP.arg=op; + } + } + else if (op==NOP) + { + OP.name="NOP"; + OP.size=1; + OP.op=NOP; + OP.class=NOP; + } + else if (op>=NOPCODES) /* cannot happen */ + { + luaL_verror("internal error at %s:%d: bad opcode %d at %d in tf=%p", + xFILE, xLINE,op,(int)(p-code),tf); + return 0; + } + else + { + OP=Info[op]; + if (op==SETLIST || op==CLOSURE || op==CALLFUNC) + { + OP.arg=p[1]; + OP.arg2=p[2]; + } + else if (OP.size==2) OP.arg=p[1]; + else if (OP.size>=3) OP.arg=(p[1]<<8)+p[2]; + if (op==SETLISTW || op==CLOSUREW) OP.arg2=p[3]; + } + *I=OP; + return OP.size; +} + +int CodeSize(TProtoFunc* tf) +{ + Byte* code=tf->code; + Byte* p=code; + while (1) + { + Opcode OP; + p+=INFO(tf,p,&OP); + if (OP.op==ENDCODE) break; + } + return p-code; +} diff --git a/src/luac/opcode.h b/src/luac/opcode.h new file mode 100644 index 00000000..805933c7 --- /dev/null +++ b/src/luac/opcode.h @@ -0,0 +1,134 @@ +/* +** $Id: opcode.h,v 1.3 1998/06/25 15:50:09 lhf Exp $ +** opcode info to be #included into opcode.c +** extracted automatically from lopcodes.h by mkopcodeh +** See Copyright Notice in lua.h +*/ +{ "ENDCODE", 1, ENDCODE, ENDCODE, ENDCODE-ENDCODE-1, 0 }, +{ "PUSHNIL", 2, PUSHNIL, PUSHNIL, PUSHNIL-PUSHNIL-1, 0 }, +{ "PUSHNIL0", 1, PUSHNIL0, PUSHNIL, PUSHNIL0-PUSHNIL-1, 0 }, +{ "PUSHNUMBER", 2, PUSHNUMBER, PUSHNUMBER, PUSHNUMBER-PUSHNUMBER-1, 0 }, +{ "PUSHNUMBER0", 1, PUSHNUMBER0, PUSHNUMBER, PUSHNUMBER0-PUSHNUMBER-1, 0 }, +{ "PUSHNUMBER1", 1, PUSHNUMBER1, PUSHNUMBER, PUSHNUMBER1-PUSHNUMBER-1, 0 }, +{ "PUSHNUMBER2", 1, PUSHNUMBER2, PUSHNUMBER, PUSHNUMBER2-PUSHNUMBER-1, 0 }, +{ "PUSHNUMBERW", 3, PUSHNUMBERW, PUSHNUMBER, PUSHNUMBERW-PUSHNUMBER-1, 0 }, +{ "PUSHCONSTANT", 2, PUSHCONSTANT, PUSHCONSTANT, PUSHCONSTANT-PUSHCONSTANT-1, 0 }, +{ "PUSHCONSTANT0", 1, PUSHCONSTANT0, PUSHCONSTANT, PUSHCONSTANT0-PUSHCONSTANT-1, 0 }, +{ "PUSHCONSTANT1", 1, PUSHCONSTANT1, PUSHCONSTANT, PUSHCONSTANT1-PUSHCONSTANT-1, 0 }, +{ "PUSHCONSTANT2", 1, PUSHCONSTANT2, PUSHCONSTANT, PUSHCONSTANT2-PUSHCONSTANT-1, 0 }, +{ "PUSHCONSTANT3", 1, PUSHCONSTANT3, PUSHCONSTANT, PUSHCONSTANT3-PUSHCONSTANT-1, 0 }, +{ "PUSHCONSTANT4", 1, PUSHCONSTANT4, PUSHCONSTANT, PUSHCONSTANT4-PUSHCONSTANT-1, 0 }, +{ "PUSHCONSTANT5", 1, PUSHCONSTANT5, PUSHCONSTANT, PUSHCONSTANT5-PUSHCONSTANT-1, 0 }, +{ "PUSHCONSTANT6", 1, PUSHCONSTANT6, PUSHCONSTANT, PUSHCONSTANT6-PUSHCONSTANT-1, 0 }, +{ "PUSHCONSTANT7", 1, PUSHCONSTANT7, PUSHCONSTANT, PUSHCONSTANT7-PUSHCONSTANT-1, 0 }, +{ "PUSHCONSTANTW", 3, PUSHCONSTANTW, PUSHCONSTANT, PUSHCONSTANTW-PUSHCONSTANT-1, 0 }, +{ "PUSHUPVALUE", 2, PUSHUPVALUE, PUSHUPVALUE, PUSHUPVALUE-PUSHUPVALUE-1, 0 }, +{ "PUSHUPVALUE0", 1, PUSHUPVALUE0, PUSHUPVALUE, PUSHUPVALUE0-PUSHUPVALUE-1, 0 }, +{ "PUSHUPVALUE1", 1, PUSHUPVALUE1, PUSHUPVALUE, PUSHUPVALUE1-PUSHUPVALUE-1, 0 }, +{ "PUSHLOCAL", 2, PUSHLOCAL, PUSHLOCAL, PUSHLOCAL-PUSHLOCAL-1, 0 }, +{ "PUSHLOCAL0", 1, PUSHLOCAL0, PUSHLOCAL, PUSHLOCAL0-PUSHLOCAL-1, 0 }, +{ "PUSHLOCAL1", 1, PUSHLOCAL1, PUSHLOCAL, PUSHLOCAL1-PUSHLOCAL-1, 0 }, +{ "PUSHLOCAL2", 1, PUSHLOCAL2, PUSHLOCAL, PUSHLOCAL2-PUSHLOCAL-1, 0 }, +{ "PUSHLOCAL3", 1, PUSHLOCAL3, PUSHLOCAL, PUSHLOCAL3-PUSHLOCAL-1, 0 }, +{ "PUSHLOCAL4", 1, PUSHLOCAL4, PUSHLOCAL, PUSHLOCAL4-PUSHLOCAL-1, 0 }, +{ "PUSHLOCAL5", 1, PUSHLOCAL5, PUSHLOCAL, PUSHLOCAL5-PUSHLOCAL-1, 0 }, +{ "PUSHLOCAL6", 1, PUSHLOCAL6, PUSHLOCAL, PUSHLOCAL6-PUSHLOCAL-1, 0 }, +{ "PUSHLOCAL7", 1, PUSHLOCAL7, PUSHLOCAL, PUSHLOCAL7-PUSHLOCAL-1, 0 }, +{ "GETGLOBAL", 2, GETGLOBAL, GETGLOBAL, GETGLOBAL-GETGLOBAL-1, 0 }, +{ "GETGLOBAL0", 1, GETGLOBAL0, GETGLOBAL, GETGLOBAL0-GETGLOBAL-1, 0 }, +{ "GETGLOBAL1", 1, GETGLOBAL1, GETGLOBAL, GETGLOBAL1-GETGLOBAL-1, 0 }, +{ "GETGLOBAL2", 1, GETGLOBAL2, GETGLOBAL, GETGLOBAL2-GETGLOBAL-1, 0 }, +{ "GETGLOBAL3", 1, GETGLOBAL3, GETGLOBAL, GETGLOBAL3-GETGLOBAL-1, 0 }, +{ "GETGLOBAL4", 1, GETGLOBAL4, GETGLOBAL, GETGLOBAL4-GETGLOBAL-1, 0 }, +{ "GETGLOBAL5", 1, GETGLOBAL5, GETGLOBAL, GETGLOBAL5-GETGLOBAL-1, 0 }, +{ "GETGLOBAL6", 1, GETGLOBAL6, GETGLOBAL, GETGLOBAL6-GETGLOBAL-1, 0 }, +{ "GETGLOBAL7", 1, GETGLOBAL7, GETGLOBAL, GETGLOBAL7-GETGLOBAL-1, 0 }, +{ "GETGLOBALW", 3, GETGLOBALW, GETGLOBAL, GETGLOBALW-GETGLOBAL-1, 0 }, +{ "GETTABLE", 1, GETTABLE, GETTABLE, GETTABLE-GETTABLE-1, 0 }, +{ "GETDOTTED", 2, GETDOTTED, GETDOTTED, GETDOTTED-GETDOTTED-1, 0 }, +{ "GETDOTTED0", 1, GETDOTTED0, GETDOTTED, GETDOTTED0-GETDOTTED-1, 0 }, +{ "GETDOTTED1", 1, GETDOTTED1, GETDOTTED, GETDOTTED1-GETDOTTED-1, 0 }, +{ "GETDOTTED2", 1, GETDOTTED2, GETDOTTED, GETDOTTED2-GETDOTTED-1, 0 }, +{ "GETDOTTED3", 1, GETDOTTED3, GETDOTTED, GETDOTTED3-GETDOTTED-1, 0 }, +{ "GETDOTTED4", 1, GETDOTTED4, GETDOTTED, GETDOTTED4-GETDOTTED-1, 0 }, +{ "GETDOTTED5", 1, GETDOTTED5, GETDOTTED, GETDOTTED5-GETDOTTED-1, 0 }, +{ "GETDOTTED6", 1, GETDOTTED6, GETDOTTED, GETDOTTED6-GETDOTTED-1, 0 }, +{ "GETDOTTED7", 1, GETDOTTED7, GETDOTTED, GETDOTTED7-GETDOTTED-1, 0 }, +{ "GETDOTTEDW", 3, GETDOTTEDW, GETDOTTED, GETDOTTEDW-GETDOTTED-1, 0 }, +{ "PUSHSELF", 2, PUSHSELF, PUSHSELF, PUSHSELF-PUSHSELF-1, 0 }, +{ "PUSHSELF0", 1, PUSHSELF0, PUSHSELF, PUSHSELF0-PUSHSELF-1, 0 }, +{ "PUSHSELF1", 1, PUSHSELF1, PUSHSELF, PUSHSELF1-PUSHSELF-1, 0 }, +{ "PUSHSELF2", 1, PUSHSELF2, PUSHSELF, PUSHSELF2-PUSHSELF-1, 0 }, +{ "PUSHSELF3", 1, PUSHSELF3, PUSHSELF, PUSHSELF3-PUSHSELF-1, 0 }, +{ "PUSHSELF4", 1, PUSHSELF4, PUSHSELF, PUSHSELF4-PUSHSELF-1, 0 }, +{ "PUSHSELF5", 1, PUSHSELF5, PUSHSELF, PUSHSELF5-PUSHSELF-1, 0 }, +{ "PUSHSELF6", 1, PUSHSELF6, PUSHSELF, PUSHSELF6-PUSHSELF-1, 0 }, +{ "PUSHSELF7", 1, PUSHSELF7, PUSHSELF, PUSHSELF7-PUSHSELF-1, 0 }, +{ "PUSHSELFW", 3, PUSHSELFW, PUSHSELF, PUSHSELFW-PUSHSELF-1, 0 }, +{ "CREATEARRAY", 2, CREATEARRAY, CREATEARRAY, CREATEARRAY-CREATEARRAY-1, 0 }, +{ "CREATEARRAY0", 1, CREATEARRAY0, CREATEARRAY, CREATEARRAY0-CREATEARRAY-1, 0 }, +{ "CREATEARRAY1", 1, CREATEARRAY1, CREATEARRAY, CREATEARRAY1-CREATEARRAY-1, 0 }, +{ "CREATEARRAYW", 3, CREATEARRAYW, CREATEARRAY, CREATEARRAYW-CREATEARRAY-1, 0 }, +{ "SETLOCAL", 2, SETLOCAL, SETLOCAL, SETLOCAL-SETLOCAL-1, 0 }, +{ "SETLOCAL0", 1, SETLOCAL0, SETLOCAL, SETLOCAL0-SETLOCAL-1, 0 }, +{ "SETLOCAL1", 1, SETLOCAL1, SETLOCAL, SETLOCAL1-SETLOCAL-1, 0 }, +{ "SETLOCAL2", 1, SETLOCAL2, SETLOCAL, SETLOCAL2-SETLOCAL-1, 0 }, +{ "SETLOCAL3", 1, SETLOCAL3, SETLOCAL, SETLOCAL3-SETLOCAL-1, 0 }, +{ "SETLOCAL4", 1, SETLOCAL4, SETLOCAL, SETLOCAL4-SETLOCAL-1, 0 }, +{ "SETLOCAL5", 1, SETLOCAL5, SETLOCAL, SETLOCAL5-SETLOCAL-1, 0 }, +{ "SETLOCAL6", 1, SETLOCAL6, SETLOCAL, SETLOCAL6-SETLOCAL-1, 0 }, +{ "SETLOCAL7", 1, SETLOCAL7, SETLOCAL, SETLOCAL7-SETLOCAL-1, 0 }, +{ "SETGLOBAL", 2, SETGLOBAL, SETGLOBAL, SETGLOBAL-SETGLOBAL-1, 0 }, +{ "SETGLOBAL0", 1, SETGLOBAL0, SETGLOBAL, SETGLOBAL0-SETGLOBAL-1, 0 }, +{ "SETGLOBAL1", 1, SETGLOBAL1, SETGLOBAL, SETGLOBAL1-SETGLOBAL-1, 0 }, +{ "SETGLOBAL2", 1, SETGLOBAL2, SETGLOBAL, SETGLOBAL2-SETGLOBAL-1, 0 }, +{ "SETGLOBAL3", 1, SETGLOBAL3, SETGLOBAL, SETGLOBAL3-SETGLOBAL-1, 0 }, +{ "SETGLOBAL4", 1, SETGLOBAL4, SETGLOBAL, SETGLOBAL4-SETGLOBAL-1, 0 }, +{ "SETGLOBAL5", 1, SETGLOBAL5, SETGLOBAL, SETGLOBAL5-SETGLOBAL-1, 0 }, +{ "SETGLOBAL6", 1, SETGLOBAL6, SETGLOBAL, SETGLOBAL6-SETGLOBAL-1, 0 }, +{ "SETGLOBAL7", 1, SETGLOBAL7, SETGLOBAL, SETGLOBAL7-SETGLOBAL-1, 0 }, +{ "SETGLOBALW", 3, SETGLOBALW, SETGLOBAL, SETGLOBALW-SETGLOBAL-1, 0 }, +{ "SETTABLE0", 1, SETTABLE0, SETTABLE0, SETTABLE0-SETTABLE0-1, 0 }, +{ "SETTABLE", 2, SETTABLE, SETTABLE, SETTABLE-SETTABLE-1, 0 }, +{ "SETLIST", 3, SETLIST, SETLIST, SETLIST-SETLIST-1, 0 }, +{ "SETLIST0", 2, SETLIST0, SETLIST, SETLIST0-SETLIST-1, 0 }, +{ "SETLISTW", 4, SETLISTW, SETLIST, SETLISTW-SETLIST-1, 0 }, +{ "SETMAP", 2, SETMAP, SETMAP, SETMAP-SETMAP-1, 0 }, +{ "SETMAP0", 1, SETMAP0, SETMAP, SETMAP0-SETMAP-1, 0 }, +{ "EQOP", 1, EQOP, EQOP, EQOP-EQOP-1, 0 }, +{ "NEQOP", 1, NEQOP, NEQOP, NEQOP-NEQOP-1, 0 }, +{ "LTOP", 1, LTOP, LTOP, LTOP-LTOP-1, 0 }, +{ "LEOP", 1, LEOP, LEOP, LEOP-LEOP-1, 0 }, +{ "GTOP", 1, GTOP, GTOP, GTOP-GTOP-1, 0 }, +{ "GEOP", 1, GEOP, GEOP, GEOP-GEOP-1, 0 }, +{ "ADDOP", 1, ADDOP, ADDOP, ADDOP-ADDOP-1, 0 }, +{ "SUBOP", 1, SUBOP, SUBOP, SUBOP-SUBOP-1, 0 }, +{ "MULTOP", 1, MULTOP, MULTOP, MULTOP-MULTOP-1, 0 }, +{ "DIVOP", 1, DIVOP, DIVOP, DIVOP-DIVOP-1, 0 }, +{ "POWOP", 1, POWOP, POWOP, POWOP-POWOP-1, 0 }, +{ "CONCOP", 1, CONCOP, CONCOP, CONCOP-CONCOP-1, 0 }, +{ "MINUSOP", 1, MINUSOP, MINUSOP, MINUSOP-MINUSOP-1, 0 }, +{ "NOTOP", 1, NOTOP, NOTOP, NOTOP-NOTOP-1, 0 }, +{ "ONTJMP", 2, ONTJMP, ONTJMP, ONTJMP-ONTJMP-1, 0 }, +{ "ONTJMPW", 3, ONTJMPW, ONTJMP, ONTJMPW-ONTJMP-1, 0 }, +{ "ONFJMP", 2, ONFJMP, ONFJMP, ONFJMP-ONFJMP-1, 0 }, +{ "ONFJMPW", 3, ONFJMPW, ONFJMP, ONFJMPW-ONFJMP-1, 0 }, +{ "JMP", 2, JMP, JMP, JMP-JMP-1, 0 }, +{ "JMPW", 3, JMPW, JMP, JMPW-JMP-1, 0 }, +{ "IFFJMP", 2, IFFJMP, IFFJMP, IFFJMP-IFFJMP-1, 0 }, +{ "IFFJMPW", 3, IFFJMPW, IFFJMP, IFFJMPW-IFFJMP-1, 0 }, +{ "IFTUPJMP", 2, IFTUPJMP, IFTUPJMP, IFTUPJMP-IFTUPJMP-1, 0 }, +{ "IFTUPJMPW", 3, IFTUPJMPW, IFTUPJMP, IFTUPJMPW-IFTUPJMP-1, 0 }, +{ "IFFUPJMP", 2, IFFUPJMP, IFFUPJMP, IFFUPJMP-IFFUPJMP-1, 0 }, +{ "IFFUPJMPW", 3, IFFUPJMPW, IFFUPJMP, IFFUPJMPW-IFFUPJMP-1, 0 }, +{ "CLOSURE", 3, CLOSURE, CLOSURE, CLOSURE-CLOSURE-1, 0 }, +{ "CLOSUREW", 4, CLOSUREW, CLOSURE, CLOSUREW-CLOSURE-1, 0 }, +{ "CALLFUNC", 3, CALLFUNC, CALLFUNC, CALLFUNC-CALLFUNC-1, 0 }, +{ "CALLFUNC0", 2, CALLFUNC0, CALLFUNC, CALLFUNC0-CALLFUNC-1, 0 }, +{ "CALLFUNC1", 2, CALLFUNC1, CALLFUNC, CALLFUNC1-CALLFUNC-1, 0 }, +{ "RETCODE", 2, RETCODE, RETCODE, RETCODE-RETCODE-1, 0 }, +{ "SETLINE", 2, SETLINE, SETLINE, SETLINE-SETLINE-1, 0 }, +{ "SETLINEW", 3, SETLINEW, SETLINE, SETLINEW-SETLINE-1, 0 }, +{ "POP", 2, POP, POP, POP-POP-1, 0 }, +{ "POP0", 1, POP0, POP, POP0-POP-1, 0 }, +{ "POP1", 1, POP1, POP, POP1-POP-1, 0 }, diff --git a/src/luac/opt.c b/src/luac/opt.c new file mode 100644 index 00000000..5084ddee --- /dev/null +++ b/src/luac/opt.c @@ -0,0 +1,228 @@ +/* +** $Id: opt.c,v 1.4 1998/04/02 20:44:08 lhf Exp $ +** optimize bytecodes +** See Copyright Notice in lua.h +*/ + +#include <stdio.h> +#include <stdlib.h> +#include "luac.h" +#include "lmem.h" + +static void FixConstants(TProtoFunc* tf, int* C) +{ + Byte* code=tf->code; + Byte* p=code; + while (1) + { + Opcode OP; + int n=INFO(tf,p,&OP); + int op=OP.class; + int i=OP.arg; + if (op==ENDCODE) break; + if ( op==PUSHCONSTANT || op==GETDOTTED || op==PUSHSELF || + op==GETGLOBAL || op==SETGLOBAL) + { + int j=C[i]; + if (j==i) + ; + else if (n==1) + { + p[0]=op+j+1; + } + else if (n==2) + { + if (j<8) { p[0]=op+j+1; p[1]=NOP; } else p[1]=j; + } + else + { + if (j<=255) + { + p[0]=op; + p[1]=j; + p[2]=NOP; + } + else + { + p[1]= 0x0000FF & (j>>8); + p[2]= 0x0000FF & j; + } + } + } + p+=n; + } +} + +static TProtoFunc* TF; + +static int compare(const void* a, const void *b) +{ + int ia=*(int*)a; + int ib=*(int*)b; + int t; + TObject* oa=TF->consts+ia; + TObject* ob=TF->consts+ib; + t=ttype(oa)-ttype(ob); if (t) return t; + t=oa->value.i-ob->value.i; if (t) return t; + return ia-ib; +} + +static void OptConstants(TProtoFunc* tf) +{ + static int* C=NULL; + static int* D=NULL; + int i,k; + int n=tf->nconsts; + if (n==0) return; + C=luaM_reallocvector(C,n,int); + D=luaM_reallocvector(D,n,int); + for (i=0; i<n; i++) C[i]=D[i]=i; /* group duplicates */ + TF=tf; qsort(C,n,sizeof(C[0]),compare); + k=C[0]; /* build duplicate table */ + for (i=1; i<n; i++) + { + int j=C[i]; + TObject* oa=tf->consts+k; + TObject* ob=tf->consts+j; + if (ttype(oa)==ttype(ob) && oa->value.i==ob->value.i) D[j]=k; else k=j; + } + k=0; /* build rename map & pack constants */ + for (i=0; i<n; i++) + { + if (D[i]==i) { tf->consts[k]=tf->consts[i]; C[i]=k++; } else C[i]=C[D[i]]; + } + if (k>=n) return; +printf("\t\"%s\":%d reduced constants from %d to %d\n", + tf->fileName->str,tf->lineDefined,n,k); + tf->nconsts=k; + FixConstants(tf,C); +} + +static int NoDebug(TProtoFunc* tf) +{ + Byte* code=tf->code; + Byte* p=code; + int nop=0; + while (1) /* change SETLINE to NOP */ + { + Opcode OP; + int n=INFO(tf,p,&OP); + int op=OP.class; + if (op==ENDCODE) break; + if (op==NOP) ++nop; + if (op==SETLINE) { nop+=n; memset(p,NOP,n); } + p+=n; + } + return nop; +} + +static int FixJump(TProtoFunc* tf, Byte* a, Byte* b) +{ + Byte* p; + int nop=0; + for (p=a; p<b; ) + { + Opcode OP; + int n=INFO(tf,p,&OP); + int op=OP.class; + if (op==ENDCODE) break; + if (op==NOP) ++nop; + p+=n; + } + return nop; +} + +static void FixJumps(TProtoFunc* tf) +{ + Byte* code=tf->code; + Byte* p=code; + while (1) + { + Opcode OP; + int n=INFO(tf,p,&OP); + int op=OP.class; + int i=OP.arg; + int nop; + if (op==ENDCODE) break; + nop=0; + if (op==IFTUPJMP || op==IFFUPJMP) nop=FixJump(tf,p-i+n,p); else + if (op==ONTJMP || op==ONFJMP || op==JMP || op==IFFJMP) nop=FixJump(tf,p,p+i+n); + if (nop>0) + { + int j=i-nop; + if (n==2) + p[1]=j; + else +#if 0 + { + if (j<=255) /* does NOT work for nested loops */ + { + if (op==IFTUPJMP || op==IFFUPJMP) --j; + p[0]=OP.op-1; /* *JMP and *JMPW are consecutive */ + p[1]=j; + p[2]=NOP; + } + else +#endif + { + p[1]= 0x0000FF & (j>>8); + p[2]= 0x0000FF & j; + } +#if 0 + } +#endif + } + p+=n; + } +} + +static void PackCode(TProtoFunc* tf) +{ + Byte* code=tf->code; + Byte* p=code; + Byte* q=code; + while (1) + { + Opcode OP; + int n=INFO(tf,p,&OP); + int op=OP.class; + if (op!=NOP) { memcpy(q,p,n); q+=n; } + p+=n; + if (op==ENDCODE) break; + } +printf("\t\"%s\":%d reduced code from %d to %d\n", + tf->fileName->str,tf->lineDefined,(int)(p-code),(int)(q-code)); +} + +static void OptCode(TProtoFunc* tf) +{ + int nop=NoDebug(tf); + if (nop==0) return; /* cannot improve code */ + FixJumps(tf); + PackCode(tf); +} + +static void OptFunction(TProtoFunc* tf); + +static void OptFunctions(TProtoFunc* tf) +{ + int i,n=tf->nconsts; + for (i=0; i<n; i++) + { + TObject* o=tf->consts+i; + if (ttype(o)==LUA_T_PROTO) OptFunction(tfvalue(o)); + } +} + +static void OptFunction(TProtoFunc* tf) +{ + tf->locvars=NULL; /* remove local variables table */ + OptConstants(tf); + OptCode(tf); + OptFunctions(tf); +} + +void OptChunk(TProtoFunc* Main) +{ + OptFunction(Main); +} diff --git a/src/luac/print.c b/src/luac/print.c index fb7bf8a7..ce985390 100644 --- a/src/luac/print.c +++ b/src/luac/print.c @@ -1,383 +1,233 @@ /* -** print.c +** $Id: print.c,v 1.13 1998/07/12 00:17:37 lhf Exp $ ** print bytecodes +** See Copyright Notice in lua.h */ -char* rcs_print="$Id: print.c,v 1.17 1997/06/25 17:07:28 lhf Exp $"; - #include <stdio.h> #include <stdlib.h> -#include <string.h> #include "luac.h" -#include "print.h" -void LinkFunctions(TFunc* m) +#ifdef DEBUG +void PrintConstant1(TProtoFunc* tf, int i) +{ + TObject* o=tf->consts+i; + printf("%6d ",i); + if (i<0 || i>=tf->nconsts) + printf("(bad constant #%d: max=%d)",i,tf->nconsts); + else + switch (ttype(o)) + { + case LUA_T_NUMBER: + printf("N " NUMBER_FMT "\n",nvalue(o)); /* LUA_NUMBER */ + break; + case LUA_T_STRING: + printf("S %p\t\"%s\"\n",(void*)tsvalue(o),svalue(o)); + break; + case LUA_T_PROTO: + printf("F %p\n",(void*)tfvalue(o)); + break; + default: /* cannot happen */ + printf("? %d\n",ttype(o)); + break; + } +} + +static void PrintConstants(TProtoFunc* tf) { - static TFunc* lastF; /* list of functions seen in code */ - Byte* code=m->code; - Byte* end=code+m->size; - Byte* p; - if (IsMain(m)) lastF=m; - for (p=code; p!=end;) + int i,n=tf->nconsts; + printf("constants (%d):\n",n); + for (i=0; i<n; i++) PrintConstant1(tf,i); +} +#endif + +static void PrintConstant(TProtoFunc* tf, int i) +{ + if (i<0 || i>=tf->nconsts) + printf("(bad constant #%d: max=%d)",i,tf->nconsts); + else { - int op=*p; - int at=p-code+1; - switch (op) - { - case PUSHNIL: - case PUSH0: - case PUSH1: - case PUSH2: - case PUSHLOCAL0: - case PUSHLOCAL1: - case PUSHLOCAL2: - case PUSHLOCAL3: - case PUSHLOCAL4: - case PUSHLOCAL5: - case PUSHLOCAL6: - case PUSHLOCAL7: - case PUSHLOCAL8: - case PUSHLOCAL9: - case PUSHINDEXED: - case STORELOCAL0: - case STORELOCAL1: - case STORELOCAL2: - case STORELOCAL3: - case STORELOCAL4: - case STORELOCAL5: - case STORELOCAL6: - case STORELOCAL7: - case STORELOCAL8: - case STORELOCAL9: - case STOREINDEXED0: - case ADJUST0: - case EQOP: - case LTOP: - case LEOP: - case GTOP: - case GEOP: - case ADDOP: - case SUBOP: - case MULTOP: - case DIVOP: - case POWOP: - case CONCOP: - case MINUSOP: - case NOTOP: - case POP: - case RETCODE0: - p++; - break; - case PUSHBYTE: - case PUSHLOCAL: - case STORELOCAL: - case STOREINDEXED: - case STORELIST0: - case ADJUST: - case RETCODE: - case VARARGS: - case STOREMAP: - p+=2; - break; - case PUSHWORD: - case PUSHSTRING: - case PUSHGLOBAL: - case PUSHSELF: - case STOREGLOBAL: - case CREATEARRAY: - case ONTJMP: - case ONFJMP: - case JMP: - case UPJMP: - case IFFJMP: - case IFFUPJMP: - case CALLFUNC: - case SETLINE: - case STORELIST: - p+=3; - break; - case PUSHFLOAT: - p+=5; /* assumes sizeof(float)==4 */ - break; - case PUSHFUNCTION: - { - TFunc* tf; - p++; - get_code(tf,p); - tf->marked=at; - tf->next=NULL; /* TODO: remove? */ - lastF=lastF->next=tf; - break; - } - case STORERECORD: - { - int n=*++p; - p+=2*n+1; - break; - } - default: /* cannot happen */ - fprintf(stderr,"luac: bad opcode %d at %d\n",*p,(int)(p-code)); - exit(1); - break; - } + TObject* o=tf->consts+i; + switch (ttype(o)) + { + case LUA_T_NUMBER: + printf(NUMBER_FMT,nvalue(o)); /* LUA_NUMBER */ + break; + case LUA_T_STRING: + printf("\"%s\"",svalue(o)); + break; + case LUA_T_PROTO: + printf("function at %p",(void*)tfvalue(o)); + break; + case LUA_T_NIL: + printf("(nil)"); + break; + default: /* cannot happen */ + printf("(bad constant #%d: type=%d [%s])\n",i,ttype(o),luaO_typename(o)); + break; + } } } -#define LocStr(i) luaI_getlocalname(tf,i+1,line) +#define VarStr(i) svalue(tf->consts+i) -static void PrintCode(TFunc* tf) +static void PrintCode(TProtoFunc* tf) { Byte* code=tf->code; - Byte* end=code+tf->size; - Byte* p; + Byte* p=code; int line=0; - for (p=code; p!=end;) + while (1) { - int op=*p; - if (op>=NOPCODES) - { - fprintf(stderr,"luac: bad opcode %d at %d\n",op,(int)(p-code)); - exit(1); - } - printf("%6d\t%s",(int)(p-code),OpCodeName[op]); - switch (op) - { - case PUSHNIL: - case PUSH0: - case PUSH1: - case PUSH2: - case PUSHINDEXED: - case STOREINDEXED0: - case ADJUST0: - case EQOP: - case LTOP: - case LEOP: - case GTOP: - case GEOP: - case ADDOP: - case SUBOP: - case MULTOP: - case DIVOP: - case POWOP: - case CONCOP: - case MINUSOP: - case NOTOP: - case POP: - case RETCODE0: - p++; - break; - case PUSHLOCAL0: - case PUSHLOCAL1: - case PUSHLOCAL2: - case PUSHLOCAL3: - case PUSHLOCAL4: - case PUSHLOCAL5: - case PUSHLOCAL6: - case PUSHLOCAL7: - case PUSHLOCAL8: - case PUSHLOCAL9: + Opcode OP; + int n=INFO(tf,p,&OP); + int op=OP.op; + int i=OP.arg; + printf("%6d ",(int)(p-code)); { - int i=op-PUSHLOCAL0; - if (tf->locvars) printf("\t\t; %s",LocStr(i)); - p++; - break; + Byte* q=p; + int j=n; + while (j--) printf("%02X",*q++); } - case STORELOCAL0: - case STORELOCAL1: - case STORELOCAL2: - case STORELOCAL3: - case STORELOCAL4: - case STORELOCAL5: - case STORELOCAL6: - case STORELOCAL7: - case STORELOCAL8: - case STORELOCAL9: + printf("%*s%-13s",2*(5-n),"",OP.name); + + if (n!=1 || op<0) printf("\t%d",i); else if (i>=0) printf("\t"); + + switch (OP.class) { - int i=op-STORELOCAL0; - if (tf->locvars) printf("\t\t; %s",LocStr(i)); - p++; + + case ENDCODE: + printf("\n"); + return; + + case CLOSURE: + printf(" %d",OP.arg2); + case PUSHCONSTANT: + case GETDOTTED: + case PUSHSELF: + printf("\t; "); + PrintConstant(tf,i); break; - } + case PUSHLOCAL: - case STORELOCAL: + case SETLOCAL: { - int i=*(p+1); - if (tf->locvars) printf("\t%d\t; %s",i,LocStr(i)); - p+=2; + char* s=luaF_getlocalname(tf,i+1,line); + if (s) printf("\t; %s",s); break; } - case PUSHBYTE: - case STOREINDEXED: - case STORELIST0: - case ADJUST: - case RETCODE: - case VARARGS: - case STOREMAP: - printf("\t%d",*(p+1)); - p+=2; + + case GETGLOBAL: + case SETGLOBAL: + printf("\t; %s",VarStr(i)); + break; + + case SETLIST: + case CALLFUNC: + if (n>=3) printf(" %d",OP.arg2); break; - case PUSHWORD: - case CREATEARRAY: + case SETLINE: - { - Word w; - p++; - get_word(w,p); - printf("\t%d",w); - if (op==SETLINE) line=w; + printf("\t; \"%s\":%d",fileName(tf),line=i); break; - } + +/* suggested by Norman Ramsey <nr@cs.virginia.edu> */ + case IFTUPJMP: + case IFFUPJMP: + i=-i; case ONTJMP: case ONFJMP: case JMP: case IFFJMP: - { /* suggested by Norman Ramsey <nr@cs.virginia.edu> */ - Word w; - p++; - get_word(w,p); - printf("\t%d\t\t; to %d",w,(int)(p-code)+w); - break; - } - case UPJMP: - case IFFUPJMP: - { /* suggested by Norman Ramsey <nr@cs.virginia.edu> */ - Word w; - p++; - get_word(w,p); - printf("\t%d\t\t; to %d",w,(int)(p-code)-w); - break; - } - case PUSHFLOAT: - { - float f; - p++; - get_float(f,p); - printf("\t%g",f); - break; - } - case PUSHSELF: - case PUSHSTRING: - { - Word w; - p++; - get_word(w,p); - printf("\t%d\t; \"%s\"",w,StrStr(w)); - break; - } - case PUSHFUNCTION: - { - TFunc* tf; - p++; - get_code(tf,p); - printf("\t%p\t; \"%s\":%d",tf,tf->fileName,tf->lineDefined); - break; - } - case PUSHGLOBAL: - case STOREGLOBAL: - { - Word w; - p++; - get_word(w,p); - printf("\t%d\t; %s",w,VarStr(w)); - break; - } - case STORELIST: - case CALLFUNC: - printf("\t%d %d",*(p+1),*(p+2)); - p+=3; - break; - case STORERECORD: - { - int n=*++p; - printf("\t%d",n); - p++; - while (n--) - { - Word w; - printf("\n%6d\t FIELD",(int)(p-code)); - get_word(w,p); - printf("\t%d\t; \"%s\"",w,StrStr(w)); - } - break; - } - default: - printf("\tcannot happen: opcode=%d\n",*p); - fprintf(stderr,"luac: bad opcode %d at %d\n",op,(int)(p-code)); - exit(1); + printf("\t; to %d",(int)(p-code)+i+n); break; + } printf("\n"); + p+=n; } } -#undef LocStr - -static void PrintLocals(LocVar* v, int n) +static void PrintLocals(TProtoFunc* tf) { - int i=0; + LocVar* v=tf->locvars; + int n,i=0; if (v==NULL || v->varname==NULL) return; + n=tf->code[1]; if (n>=ZEROVARARG) n-=ZEROVARARG; + + printf("locals:"); if (n>0) { - printf("parameters:"); - for (i=0; i<n; v++,i++) printf(" %s[%d@%d]",v->varname->str,i,v->line); - printf("\n"); + for (i=0; i<n; v++,i++) printf(" %s",v->varname->str); } if (v->varname!=NULL) { - printf("locals:"); for (; v->line>=0; v++) { if (v->varname==NULL) -#if 0 - printf(" %s[%d@%d]","*",--i,v->line); -#else - --i; -#endif + { + printf(")"); --i; + } else - printf(" %s[%d@%d]",v->varname->str,i++,v->line); + { + printf(" (%s",v->varname->str); i++; + } } - printf("\n"); + i-=n; + while (i--) printf(")"); } + printf("\n"); } -void PrintFunction(TFunc* tf, TFunc* Main) +static void PrintHeader(TProtoFunc* tf, TProtoFunc* Main, int at) { - int n=0; + int size=CodeSize(tf); if (IsMain(tf)) - printf("\nmain of \"%s\" (%d bytes at %p)\n",tf->fileName,tf->size,tf); - else + printf("\nmain of \"%s\" (%d bytes at %p)\n",fileName(tf),size,(void*)tf); + else if (Main) + { + printf("\nfunction defined at \"%s\":%d (%d bytes at %p); used at ", + fileName(tf),tf->lineDefined,size,(void*)tf); + if (IsMain(Main)) + printf("main"); + else + printf("%p",(void*)Main); + printf("+%d\n",at); + } +} + +static void PrintFunction(TProtoFunc* tf, TProtoFunc* Main, int at); + +static void PrintFunctions(TProtoFunc* Main) +{ + Byte* code=Main->code; + Byte* p=code; + while (1) { - Byte* p; - p=tf->code; /* get number of parameters */ - while (*p==SETLINE) p+=3; - if (*p==ADJUST) n=p[1]; - p=Main->code+tf->marked+sizeof(TFunc*); - printf("\nfunction "); - switch (*p) /* try to get name */ + Opcode OP; + int n=INFO(Main,p,&OP); + if (OP.class==ENDCODE) break; + if (OP.class==PUSHCONSTANT || OP.class==CLOSURE) { - case STOREGLOBAL: - { - Word w; - p++; get_word(w,p); printf("%s defined at ",VarStr(w)); - break; - } - case STOREINDEXED0: /* try method definition */ - { - if (p[-11]==PUSHGLOBAL && p[-8]==PUSHSTRING) - { - Word w; - Byte* op=p; - int c=(tf->locvars && n>0 && strcmp(tf->locvars->varname->str,"self")==0) - ? ':' : '.'; - p=op-11; p++; get_word(w,p); printf("%s%c",VarStr(w),c); - p=op-8; p++; get_word(w,p); printf("%s defined at ",StrStr(w)); - } - break; - } + int i=OP.arg; + TObject* o=Main->consts+i; + if (ttype(o)==LUA_T_PROTO) PrintFunction(tfvalue(o),Main,(int)(p-code)); } - printf("\"%s\":%d (%d bytes at %p); used at main+%d\n", - tf->fileName,tf->lineDefined,tf->size,tf,tf->marked); + p+=n; } - PrintLocals(tf->locvars,n); +} + +static void PrintFunction(TProtoFunc* tf, TProtoFunc* Main, int at) +{ + PrintHeader(tf,Main,at); + PrintLocals(tf); PrintCode(tf); +#ifdef DEBUG + PrintConstants(tf); +#endif + PrintFunctions(tf); +} + +void PrintChunk(TProtoFunc* Main) +{ + PrintFunction(Main,0,0); } diff --git a/src/luac/print.h b/src/luac/print.h deleted file mode 100644 index 00e344ca..00000000 --- a/src/luac/print.h +++ /dev/null @@ -1,79 +0,0 @@ -/* -** print.h -** opcode names -** $Id: print.h,v 1.3 1997/04/14 14:42:50 lhf Exp $ -*/ - -static char* OpCodeName[]={ /* ATTENTION: same order as enum in opcode.h */ - "PUSHNIL", - "PUSH0", - "PUSH1", - "PUSH2", - "PUSHBYTE", - "PUSHWORD", - "PUSHFLOAT", - "PUSHSTRING", - "PUSHFUNCTION", - "PUSHLOCAL0", - "PUSHLOCAL1", - "PUSHLOCAL2", - "PUSHLOCAL3", - "PUSHLOCAL4", - "PUSHLOCAL5", - "PUSHLOCAL6", - "PUSHLOCAL7", - "PUSHLOCAL8", - "PUSHLOCAL9", - "PUSHLOCAL", - "PUSHGLOBAL", - "PUSHINDEXED", - "PUSHSELF", - "STORELOCAL0", - "STORELOCAL1", - "STORELOCAL2", - "STORELOCAL3", - "STORELOCAL4", - "STORELOCAL5", - "STORELOCAL6", - "STORELOCAL7", - "STORELOCAL8", - "STORELOCAL9", - "STORELOCAL", - "STOREGLOBAL", - "STOREINDEXED0", - "STOREINDEXED", - "STORELIST0", - "STORELIST", - "STORERECORD", - "ADJUST0", - "ADJUST", - "CREATEARRAY", - "EQOP", - "LTOP", - "LEOP", - "GTOP", - "GEOP", - "ADDOP", - "SUBOP", - "MULTOP", - "DIVOP", - "POWOP", - "CONCOP", - "MINUSOP", - "NOTOP", - "ONTJMP", - "ONFJMP", - "JMP", - "UPJMP", - "IFFJMP", - "IFFUPJMP", - "POP", - "CALLFUNC", - "RETCODE0", - "RETCODE", - "SETLINE", - "VARARGS", - "STOREMAP" -}; - -#define NOPCODES (sizeof(OpCodeName)/sizeof(OpCodeName[0])) diff --git a/src/luac/stubs.c b/src/luac/stubs.c new file mode 100644 index 00000000..d42bec25 --- /dev/null +++ b/src/luac/stubs.c @@ -0,0 +1,68 @@ +/* +** $Id: stubs.c,v 1.8 1998/07/12 00:17:37 lhf Exp $ +** avoid runtime modules in luac +** See Copyright Notice in lua.h +*/ + +#include <stdarg.h> +#include <stdio.h> +#include <stdlib.h> +#include "luac.h" + +/* +* avoid lapi lauxlib lbuiltin ldo lgc ltable ltm lvm +* use only lbuffer lfunc llex lmem lobject lparser lstate lstring lzio +*/ + +/* simplified from ldo.c */ +void lua_error(char* s) +{ + if (s) fprintf(stderr,"luac: %s\n",s); + exit(1); +} + +/* copied from lauxlib.c */ +void luaL_verror(char* fmt, ...) +{ + char buff[500]; + va_list argp; + va_start(argp,fmt); + vsprintf(buff,fmt,argp); + va_end(argp); + lua_error(buff); +} + +/* copied from lauxlib.c */ +int luaL_findstring (char* name, char* list[]) +{ + int i; + for (i=0; list[i]; i++) + if (strcmp(list[i], name) == 0) + return i; + return -1; +} + +/* avoid runtime modules in lstate.c */ +void luaB_predefine(void){} +void luaC_hashcallIM(Hash *l){} +void luaC_strcallIM(TaggedString *l){} +void luaD_gcIM(TObject *o){} +void luaD_init(void){} +void luaH_free(Hash *frees){} +void luaT_init(void){} + +/* +* the code below avoids the lexer and the parser (llex lparser). +* it is useful if you only want to load binary files. +* this works for interpreters like lua.c too. +*/ + +#ifdef NOPARSER + +int lua_debug=0; + +void luaX_init(void){} +void luaY_init(void){} +void luaY_parser(void) { lua_error("parser not loaded"); } + +#endif diff --git a/src/luamem.c b/src/luamem.c deleted file mode 100644 index e4cdd6d9..00000000 --- a/src/luamem.c +++ /dev/null @@ -1,159 +0,0 @@ -/* -** mem.c -** TecCGraf - PUC-Rio -*/ - -char *rcs_luamem = "$Id: luamem.c,v 1.16 1997/04/01 21:23:20 roberto Exp $"; - -#include <stdlib.h> - -#include "luamem.h" -#include "lua.h" - - -#define DEBUG 0 - -#if !DEBUG - -void luaI_free (void *block) -{ - if (block) - { - *((char *)block) = -1; /* to catch errors */ - free(block); - } -} - - -void *luaI_realloc (void *oldblock, unsigned long size) -{ - void *block; - size_t s = (size_t)size; - if (s != size) - lua_error("Allocation Error: Block too big"); - block = oldblock ? realloc(oldblock, s) : malloc(s); - if (block == NULL) - lua_error(memEM); - return block; -} - - -int luaI_growvector (void **block, unsigned long nelems, int size, - char *errormsg, unsigned long limit) -{ - if (nelems >= limit) - lua_error(errormsg); - nelems = (nelems == 0) ? 20 : nelems*2; - if (nelems > limit) - nelems = limit; - *block = luaI_realloc(*block, nelems*size); - return (int)nelems; -} - - -void* luaI_buffer (unsigned long size) -{ - static unsigned long buffsize = 0; - static char* buffer = NULL; - if (size > buffsize) - buffer = luaI_realloc(buffer, buffsize=size); - return buffer; -} - -#else -/* DEBUG */ - -#include <stdio.h> - -# define assert(ex) {if (!(ex)){(void)fprintf(stderr, \ - "Assertion failed: file \"%s\", line %d\n", __FILE__, __LINE__);exit(1);}} - -#define MARK 55 - -static unsigned long numblocks = 0; -static unsigned long totalmem = 0; - - -static void message (void) -{ -#define inrange(x,y) ((x) < (((y)*3)/2) && (x) > (((y)*2)/3)) - static int count = 0; - static unsigned long lastnumblocks = 0; - static unsigned long lasttotalmem = 0; - if (!inrange(numblocks, lastnumblocks) || !inrange(totalmem, lasttotalmem) - || count++ >= 5000) - { - fprintf(stderr,"blocks = %lu mem = %luK\n", numblocks, totalmem/1000); - count = 0; - lastnumblocks = numblocks; - lasttotalmem = totalmem; - } -} - - -void luaI_free (void *block) -{ - if (block) - { - unsigned long *b = (unsigned long *)block - 1; - unsigned long size = *b; - assert(*(((char *)b)+size+sizeof(unsigned long)) == MARK); - numblocks--; - totalmem -= size; - free(b); - message(); - } -} - - -void *luaI_realloc (void *oldblock, unsigned long size) -{ - unsigned long *block; - unsigned long realsize = sizeof(unsigned long)+size+sizeof(char); - if (realsize != (size_t)realsize) - lua_error("Allocation Error: Block too big"); - if (oldblock) - { - unsigned long *b = (unsigned long *)oldblock - 1; - unsigned long oldsize = *b; - assert(*(((char *)b)+oldsize+sizeof(unsigned long)) == MARK); - totalmem -= oldsize; - numblocks--; - block = (unsigned long *)realloc(b, realsize); - } - else - block = (unsigned long *)malloc(realsize); - if (block == NULL) - lua_error("not enough memory"); - totalmem += size; - numblocks++; - *block = size; - *(((char *)block)+size+sizeof(unsigned long)) = MARK; - message(); - return block+1; -} - - -int luaI_growvector (void **block, unsigned long nelems, int size, - char *errormsg, unsigned long limit) -{ - if (nelems >= limit) - lua_error(errormsg); - nelems = (nelems == 0) ? 20 : nelems*2; - if (nelems > limit) - nelems = limit; - *block = luaI_realloc(*block, nelems*size); - return (int)nelems; -} - - -void* luaI_buffer (unsigned long size) -{ - static unsigned long buffsize = 0; - static char* buffer = NULL; - if (size > buffsize) - buffer = luaI_realloc(buffer, buffsize=size); - return buffer; -} - -#endif diff --git a/src/luamem.h b/src/luamem.h deleted file mode 100644 index 86b7c8f0..00000000 --- a/src/luamem.h +++ /dev/null @@ -1,39 +0,0 @@ -/* -** mem.c -** memory manager for lua -** $Id: luamem.h,v 1.9 1997/03/31 14:10:11 roberto Exp $ -*/ - -#ifndef luamem_h -#define luamem_h - -#ifndef NULL -#define NULL 0 -#endif - - -/* memory error messages */ -#define codeEM "code size overflow" -#define symbolEM "symbol table overflow" -#define constantEM "constant table overflow" -#define stackEM "stack size overflow" -#define lexEM "lex buffer overflow" -#define refEM "reference table overflow" -#define tableEM "table overflow" -#define memEM "not enough memory" - - -void luaI_free (void *block); -void *luaI_realloc (void *oldblock, unsigned long size); -void *luaI_buffer (unsigned long size); -int luaI_growvector (void **block, unsigned long nelems, int size, - char *errormsg, unsigned long limit); - -#define luaI_malloc(s) luaI_realloc(NULL, (s)) -#define new(s) ((s *)luaI_malloc(sizeof(s))) -#define newvector(n,s) ((s *)luaI_malloc((n)*sizeof(s))) -#define growvector(old,n,s,e,l) \ - (luaI_growvector((void**)old,n,sizeof(s),e,l)) - -#endif - diff --git a/src/lundump.c b/src/lundump.c new file mode 100644 index 00000000..4fe2b0d7 --- /dev/null +++ b/src/lundump.c @@ -0,0 +1,228 @@ +/* +** $Id: lundump.c,v 1.12 1998/07/12 01:46:59 lhf Exp $ +** load bytecodes from files +** See Copyright Notice in lua.h +*/ + +#include <stdio.h> +#include <string.h> +#include "lauxlib.h" +#include "lfunc.h" +#include "lmem.h" +#include "lstring.h" +#include "lundump.h" + +#define LoadBlock(b,size,Z) ezread(Z,b,size) +#define LoadNative(t,Z) LoadBlock(&t,sizeof(t),Z) + +#if ID_NUMBER==ID_NATIVE + #define doLoadNumber(f,Z) LoadNative(f,Z) +#else + #define doLoadNumber(f,Z) f=LoadNumber(Z) +#endif + +static void unexpectedEOZ(ZIO* Z) +{ + luaL_verror("unexpected end of file in %s",zname(Z)); +} + +static int ezgetc(ZIO* Z) +{ + int c=zgetc(Z); + if (c==EOZ) unexpectedEOZ(Z); + return c; +} + +static void ezread(ZIO* Z, void* b, int n) +{ + int r=zread(Z,b,n); + if (r!=0) unexpectedEOZ(Z); +} + +static unsigned int LoadWord(ZIO* Z) +{ + unsigned int hi=ezgetc(Z); + unsigned int lo=ezgetc(Z); + return (hi<<8)|lo; +} + +static unsigned long LoadLong(ZIO* Z) +{ + unsigned long hi=LoadWord(Z); + unsigned long lo=LoadWord(Z); + return (hi<<16)|lo; +} + +#if ID_NUMBER==ID_REAL4 +/* LUA_NUMBER */ +/* assumes sizeof(long)==4 and sizeof(float)==4 (IEEE) */ +static float LoadFloat(ZIO* Z) +{ + unsigned long l=LoadLong(Z); + float f; + memcpy(&f,&l,sizeof(f)); + return f; +} +#endif + +#if ID_NUMBER==ID_REAL8 +/* LUA_NUMBER */ +/* assumes sizeof(long)==4 and sizeof(double)==8 (IEEE) */ +static double LoadDouble(ZIO* Z) +{ + unsigned long l[2]; + double f; + int x=1; + if (*(char*)&x==1) /* little-endian */ + { + l[1]=LoadLong(Z); + l[0]=LoadLong(Z); + } + else /* big-endian */ + { + l[0]=LoadLong(Z); + l[1]=LoadLong(Z); + } + memcpy(&f,l,sizeof(f)); + return f; +} +#endif + +static Byte* LoadCode(ZIO* Z) +{ + unsigned long size=LoadLong(Z); + unsigned int s=size; + void* b; + if (s!=size) luaL_verror("code too long (%ld bytes) in %s",size,zname(Z)); + b=luaM_malloc(size); + LoadBlock(b,size,Z); + return b; +} + +static TaggedString* LoadTString(ZIO* Z) +{ + int size=LoadWord(Z); + if (size==0) + return NULL; + else + { + char* s=luaL_openspace(size); + LoadBlock(s,size,Z); + return luaS_newlstr(s,size-1); + } +} + +static void LoadLocals(TProtoFunc* tf, ZIO* Z) +{ + int i,n=LoadWord(Z); + if (n==0) return; + tf->locvars=luaM_newvector(n+1,LocVar); + for (i=0; i<n; i++) + { + tf->locvars[i].line=LoadWord(Z); + tf->locvars[i].varname=LoadTString(Z); + } + tf->locvars[i].line=-1; /* flag end of vector */ + tf->locvars[i].varname=NULL; +} + +static TProtoFunc* LoadFunction(ZIO* Z); + +static void LoadConstants(TProtoFunc* tf, ZIO* Z) +{ + int i,n=LoadWord(Z); + tf->nconsts=n; + if (n==0) return; + tf->consts=luaM_newvector(n,TObject); + for (i=0; i<n; i++) + { + TObject* o=tf->consts+i; + ttype(o)=-ezgetc(Z); + switch (ttype(o)) + { + case LUA_T_NUMBER: + doLoadNumber(nvalue(o),Z); + break; + case LUA_T_STRING: + tsvalue(o)=LoadTString(Z); + break; + case LUA_T_PROTO: + tfvalue(o)=LoadFunction(Z); + break; + case LUA_T_NIL: + break; + default: + luaL_verror("bad constant #%d in %s: type=%d [%s]", + i,zname(Z),ttype(o),luaO_typename(o)); + break; + } + } +} + +static TProtoFunc* LoadFunction(ZIO* Z) +{ + TProtoFunc* tf=luaF_newproto(); + tf->lineDefined=LoadWord(Z); + tf->fileName=LoadTString(Z); + tf->code=LoadCode(Z); + LoadLocals(tf,Z); + LoadConstants(tf,Z); + return tf; +} + +static void LoadSignature(ZIO* Z) +{ + char* s=SIGNATURE; + while (*s!=0 && ezgetc(Z)==*s) + ++s; + if (*s!=0) luaL_verror("bad signature in %s",zname(Z)); +} + +static void LoadHeader(ZIO* Z) +{ + int version,id,sizeofR; + real f=-TEST_NUMBER,tf=TEST_NUMBER; + LoadSignature(Z); + version=ezgetc(Z); + if (version>VERSION) + luaL_verror( + "%s too new: version=0x%02x; expected at most 0x%02x", + zname(Z),version,VERSION); + if (version<VERSION0) /* check last major change */ + luaL_verror( + "%s too old: version=0x%02x; expected at least 0x%02x", + zname(Z),version,VERSION0); + id=ezgetc(Z); /* test number representation */ + sizeofR=ezgetc(Z); + if (id!=ID_NUMBER || sizeofR!=sizeof(real)) + { + luaL_verror("unknown number signature in %s: " + "read 0x%02x%02x; expected 0x%02x%02x", + zname(Z),id,sizeofR,ID_NUMBER,sizeof(real)); + } + doLoadNumber(f,Z); + if (f!=tf) + luaL_verror("unknown number representation in %s: " + "read " NUMBER_FMT "; expected " NUMBER_FMT, /* LUA_NUMBER */ + zname(Z),f,tf); +} + +static TProtoFunc* LoadChunk(ZIO* Z) +{ + LoadHeader(Z); + return LoadFunction(Z); +} + +/* +** load one chunk from a file or buffer +** return main if ok and NULL at EOF +*/ +TProtoFunc* luaU_undump1(ZIO* Z) +{ + int c=zgetc(Z); + if (c==ID_CHUNK) + return LoadChunk(Z); + else if (c!=EOZ) + luaL_verror("%s is not a Lua binary file",zname(Z)); + return NULL; +} diff --git a/src/lundump.h b/src/lundump.h new file mode 100644 index 00000000..3c8793cb --- /dev/null +++ b/src/lundump.h @@ -0,0 +1,78 @@ +/* +** $Id: lundump.h,v 1.9 1998/07/12 00:17:37 lhf Exp $ +** load pre-compiled Lua chunks +** See Copyright Notice in lua.h +*/ + +#ifndef lundump_h +#define lundump_h + +#include "lobject.h" +#include "lzio.h" + +TProtoFunc* luaU_undump1(ZIO* Z); /* load one chunk */ + +#define SIGNATURE "Lua" +#define VERSION 0x31 /* last format change was in 3.1 */ +#define VERSION0 0x31 /* last major change was in 3.1 */ +#define ID_CHUNK 27 /* ESC */ + +#define IsMain(f) (f->lineDefined==0) +#define luaO_typename(o) luaO_typenames[-ttype(o)] + +/* number representation */ +#define ID_INT4 'l' /* 4-byte integers */ +#define ID_REAL4 'f' /* 4-byte reals */ +#define ID_REAL8 'd' /* 8-byte reals */ +#define ID_NATIVE '?' /* whatever your machine uses */ + +/* +* use a multiple of PI for testing number representation. +* multiplying by 1E8 gives notrivial integer values. +*/ +#define TEST_NUMBER 3.14159265358979323846E8 + +/* LUA_NUMBER +* choose one below for the number representation in precompiled chunks. +* the default is ID_REAL8 because the default for LUA_NUM_TYPE is double. +* if your machine does not use IEEE 754, use ID_NATIVE. +* the next version will support conversion to/from IEEE 754. +* +* if you change LUA_NUM_TYPE, make sure you set ID_NUMBER accordingly, +* specially if sizeof(long)!=4. +* for types other than the ones listed below, you'll have to write your own +* dump and undump routines. +*/ + +#ifndef ID_NUMBER +#define ID_NUMBER ID_REAL8 +#endif + +#if 0 +#define ID_NUMBER ID_INT4 +#define ID_NUMBER ID_REAL4 +#define ID_NUMBER ID_REAL8 +#define ID_NUMBER ID_NATIVE +#endif + +#endif + +#if ID_NUMBER==ID_REAL4 + #define DumpNumber DumpFloat + #define LoadNumber LoadFloat + #define SIZEOF_NUMBER 4 +#elif ID_NUMBER==ID_REAL8 + #define DumpNumber DumpDouble + #define LoadNumber LoadDouble + #define SIZEOF_NUMBER 8 +#elif ID_NUMBER==ID_INT4 + #define DumpNumber DumpLong + #define LoadNumber LoadLong + #define SIZEOF_NUMBER 4 +#elif ID_NUMBER==ID_NATIVE + #define DumpNumber DumpNative + #define LoadNumber LoadNative + #define SIZEOF_NUMBER sizeof(real) +#else + #error bad ID_NUMBER +#endif diff --git a/src/lvm.c b/src/lvm.c new file mode 100644 index 00000000..72c26c1c --- /dev/null +++ b/src/lvm.c @@ -0,0 +1,737 @@ +/* +** $Id: lvm.c,v 1.30 1998/06/11 18:21:37 roberto Exp $ +** Lua virtual machine +** See Copyright Notice in lua.h +*/ + + +#include <stdio.h> +#include <string.h> + +#include "lauxlib.h" +#include "ldo.h" +#include "lfunc.h" +#include "lgc.h" +#include "lmem.h" +#include "lopcodes.h" +#include "lstate.h" +#include "lstring.h" +#include "ltable.h" +#include "ltm.h" +#include "luadebug.h" +#include "lvm.h" + + +#ifdef OLD_ANSI +#define strcoll(a,b) strcmp(a,b) +#endif + + +#define skip_word(pc) (pc+=2) +#define get_word(pc) ((*(pc)<<8)+(*((pc)+1))) +#define next_word(pc) (pc+=2, get_word(pc-2)) + + +/* Extra stack size to run a function: LUA_T_LINE(1), TM calls(2), ... */ +#define EXTRA_STACK 5 + + + +static TaggedString *strconc (TaggedString *l, TaggedString *r) +{ + size_t nl = l->u.s.len; + size_t nr = r->u.s.len; + char *buffer = luaL_openspace(nl+nr+1); + memcpy(buffer, l->str, nl); + memcpy(buffer+nl, r->str, nr); + return luaS_newlstr(buffer, nl+nr); +} + + +int luaV_tonumber (TObject *obj) +{ /* LUA_NUMBER */ + double t; + char c; + if (ttype(obj) != LUA_T_STRING) + return 1; + else if (sscanf(svalue(obj), "%lf %c",&t, &c) == 1) { + nvalue(obj) = (real)t; + ttype(obj) = LUA_T_NUMBER; + return 0; + } + else + return 2; +} + + +int luaV_tostring (TObject *obj) +{ /* LUA_NUMBER */ + if (ttype(obj) != LUA_T_NUMBER) + return 1; + else { + char s[60]; + real f = nvalue(obj); + int i; + if ((real)(-MAX_INT) <= f && f <= (real)MAX_INT && (real)(i=(int)f) == f) + sprintf (s, "%d", i); + else + sprintf (s, NUMBER_FMT, nvalue(obj)); + tsvalue(obj) = luaS_new(s); + ttype(obj) = LUA_T_STRING; + return 0; + } +} + + +void luaV_closure (int nelems) +{ + if (nelems > 0) { + struct Stack *S = &L->stack; + Closure *c = luaF_newclosure(nelems); + c->consts[0] = *(S->top-1); + memcpy(&c->consts[1], S->top-(nelems+1), nelems*sizeof(TObject)); + S->top -= nelems; + ttype(S->top-1) = LUA_T_CLOSURE; + (S->top-1)->value.cl = c; + } +} + + +/* +** Function to index a table. +** Receives the table at top-2 and the index at top-1. +*/ +void luaV_gettable (void) +{ + struct Stack *S = &L->stack; + TObject *im; + if (ttype(S->top-2) != LUA_T_ARRAY) /* not a table, get "gettable" method */ + im = luaT_getimbyObj(S->top-2, IM_GETTABLE); + else { /* object is a table... */ + int tg = (S->top-2)->value.a->htag; + im = luaT_getim(tg, IM_GETTABLE); + if (ttype(im) == LUA_T_NIL) { /* and does not have a "gettable" method */ + TObject *h = luaH_get(avalue(S->top-2), S->top-1); + if (h != NULL && ttype(h) != LUA_T_NIL) { + --S->top; + *(S->top-1) = *h; + } + else if (ttype(im=luaT_getim(tg, IM_INDEX)) != LUA_T_NIL) + luaD_callTM(im, 2, 1); + else { + --S->top; + ttype(S->top-1) = LUA_T_NIL; + } + return; + } + /* else it has a "gettable" method, go through to next command */ + } + /* object is not a table, or it has a "gettable" method */ + if (ttype(im) != LUA_T_NIL) + luaD_callTM(im, 2, 1); + else + lua_error("indexed expression not a table"); +} + + +/* +** Function to store indexed based on values at the stack.top +** mode = 0: raw store (without tag methods) +** mode = 1: normal store (with tag methods) +** mode = 2: "deep L->stack.stack" store (with tag methods) +*/ +void luaV_settable (TObject *t, int mode) +{ + struct Stack *S = &L->stack; + TObject *im = (mode == 0) ? NULL : luaT_getimbyObj(t, IM_SETTABLE); + if (ttype(t) == LUA_T_ARRAY && (im == NULL || ttype(im) == LUA_T_NIL)) { + TObject *h = luaH_set(avalue(t), t+1); + *h = *(S->top-1); + S->top -= (mode == 2) ? 1 : 3; + } + else { /* object is not a table, and/or has a specific "settable" method */ + if (im && ttype(im) != LUA_T_NIL) { + if (mode == 2) { + *(S->top+1) = *(L->stack.top-1); + *(S->top) = *(t+1); + *(S->top-1) = *t; + S->top += 2; /* WARNING: caller must assure stack space */ + } + luaD_callTM(im, 3, 0); + } + else + lua_error("indexed expression not a table"); + } +} + + +void luaV_getglobal (TaggedString *ts) +{ + /* WARNING: caller must assure stack space */ + TObject *value = &ts->u.s.globalval; + TObject *im = luaT_getimbyObj(value, IM_GETGLOBAL); + if (ttype(im) == LUA_T_NIL) { /* default behavior */ + *L->stack.top++ = *value; + } + else { + struct Stack *S = &L->stack; + ttype(S->top) = LUA_T_STRING; + tsvalue(S->top) = ts; + S->top++; + *S->top++ = *value; + luaD_callTM(im, 2, 1); + } +} + + +void luaV_setglobal (TaggedString *ts) +{ + TObject *oldvalue = &ts->u.s.globalval; + TObject *im = luaT_getimbyObj(oldvalue, IM_SETGLOBAL); + if (ttype(im) == LUA_T_NIL) /* default behavior */ + luaS_rawsetglobal(ts, --L->stack.top); + else { + /* WARNING: caller must assure stack space */ + struct Stack *S = &L->stack; + TObject newvalue = *(S->top-1); + ttype(S->top-1) = LUA_T_STRING; + tsvalue(S->top-1) = ts; + *S->top++ = *oldvalue; + *S->top++ = newvalue; + luaD_callTM(im, 3, 0); + } +} + + +static void call_binTM (IMS event, char *msg) +{ + TObject *im = luaT_getimbyObj(L->stack.top-2, event);/* try first operand */ + if (ttype(im) == LUA_T_NIL) { + im = luaT_getimbyObj(L->stack.top-1, event); /* try second operand */ + if (ttype(im) == LUA_T_NIL) { + im = luaT_getim(0, event); /* try a 'global' i.m. */ + if (ttype(im) == LUA_T_NIL) + lua_error(msg); + } + } + lua_pushstring(luaT_eventname[event]); + luaD_callTM(im, 3, 1); +} + + +static void call_arith (IMS event) +{ + call_binTM(event, "unexpected type in arithmetic operation"); +} + + +static int strcomp (char *l, long ll, char *r, long lr) +{ + for (;;) { + long temp = strcoll(l, r); + if (temp != 0) return temp; + /* strings are equal up to a '\0' */ + temp = strlen(l); /* index of first '\0' in both strings */ + if (temp == ll) /* l is finished? */ + return (temp == lr) ? 0 : -1; /* l is equal or smaller than r */ + else if (temp == lr) /* r is finished? */ + return 1; /* l is greater than r (because l is not finished) */ + /* both strings longer than temp; go on comparing (after the '\0') */ + temp++; + l += temp; ll -= temp; r += temp; lr -= temp; + } +} + +static void comparison (lua_Type ttype_less, lua_Type ttype_equal, + lua_Type ttype_great, IMS op) +{ + struct Stack *S = &L->stack; + TObject *l = S->top-2; + TObject *r = S->top-1; + int result; + if (ttype(l) == LUA_T_NUMBER && ttype(r) == LUA_T_NUMBER) + result = (nvalue(l) < nvalue(r)) ? -1 : (nvalue(l) == nvalue(r)) ? 0 : 1; + else if (ttype(l) == LUA_T_STRING && ttype(r) == LUA_T_STRING) + result = strcomp(svalue(l), tsvalue(l)->u.s.len, + svalue(r), tsvalue(r)->u.s.len); + else { + call_binTM(op, "unexpected type in comparison"); + return; + } + S->top--; + nvalue(S->top-1) = 1; + ttype(S->top-1) = (result < 0) ? ttype_less : + (result == 0) ? ttype_equal : ttype_great; +} + + +void luaV_pack (StkId firstel, int nvararg, TObject *tab) +{ + TObject *firstelem = L->stack.stack+firstel; + int i; + if (nvararg < 0) nvararg = 0; + avalue(tab) = luaH_new(nvararg+1); /* +1 for field 'n' */ + ttype(tab) = LUA_T_ARRAY; + for (i=0; i<nvararg; i++) { + TObject index; + ttype(&index) = LUA_T_NUMBER; + nvalue(&index) = i+1; + *(luaH_set(avalue(tab), &index)) = *(firstelem+i); + } + /* store counter in field "n" */ { + TObject index, extra; + ttype(&index) = LUA_T_STRING; + tsvalue(&index) = luaS_new("n"); + ttype(&extra) = LUA_T_NUMBER; + nvalue(&extra) = nvararg; + *(luaH_set(avalue(tab), &index)) = extra; + } +} + + +static void adjust_varargs (StkId first_extra_arg) +{ + TObject arg; + luaV_pack(first_extra_arg, + (L->stack.top-L->stack.stack)-first_extra_arg, &arg); + luaD_adjusttop(first_extra_arg); + *L->stack.top++ = arg; +} + + + +/* +** Execute the given opcode, until a RET. Parameters are between +** [stack+base,top). Returns n such that the the results are between +** [stack+n,top). +*/ +StkId luaV_execute (Closure *cl, TProtoFunc *tf, StkId base) +{ + struct Stack *S = &L->stack; /* to optimize */ + Byte *pc = tf->code; + TObject *consts = tf->consts; + if (lua_callhook) + luaD_callHook(base, tf, 0); + luaD_checkstack((*pc++)+EXTRA_STACK); + if (*pc < ZEROVARARG) + luaD_adjusttop(base+*(pc++)); + else { /* varargs */ + luaC_checkGC(); + adjust_varargs(base+(*pc++)-ZEROVARARG); + } + while (1) { + int aux; + switch ((OpCode)(aux = *pc++)) { + + case PUSHNIL0: + ttype(S->top++) = LUA_T_NIL; + break; + + case PUSHNIL: + aux = *pc++; + do { + ttype(S->top++) = LUA_T_NIL; + } while (aux--); + break; + + case PUSHNUMBER: + aux = *pc++; goto pushnumber; + + case PUSHNUMBERW: + aux = next_word(pc); goto pushnumber; + + case PUSHNUMBER0: case PUSHNUMBER1: case PUSHNUMBER2: + aux -= PUSHNUMBER0; + pushnumber: + ttype(S->top) = LUA_T_NUMBER; + nvalue(S->top) = aux; + S->top++; + break; + + case PUSHLOCAL: + aux = *pc++; goto pushlocal; + + case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2: case PUSHLOCAL3: + case PUSHLOCAL4: case PUSHLOCAL5: case PUSHLOCAL6: case PUSHLOCAL7: + aux -= PUSHLOCAL0; + pushlocal: + *S->top++ = *((S->stack+base) + aux); + break; + + case GETGLOBALW: + aux = next_word(pc); goto getglobal; + + case GETGLOBAL: + aux = *pc++; goto getglobal; + + case GETGLOBAL0: case GETGLOBAL1: case GETGLOBAL2: case GETGLOBAL3: + case GETGLOBAL4: case GETGLOBAL5: case GETGLOBAL6: case GETGLOBAL7: + aux -= GETGLOBAL0; + getglobal: + luaV_getglobal(tsvalue(&consts[aux])); + break; + + case GETTABLE: + luaV_gettable(); + break; + + case GETDOTTEDW: + aux = next_word(pc); goto getdotted; + + case GETDOTTED: + aux = *pc++; goto getdotted; + + case GETDOTTED0: case GETDOTTED1: case GETDOTTED2: case GETDOTTED3: + case GETDOTTED4: case GETDOTTED5: case GETDOTTED6: case GETDOTTED7: + aux -= GETDOTTED0; + getdotted: + *S->top++ = consts[aux]; + luaV_gettable(); + break; + + case PUSHSELFW: + aux = next_word(pc); goto pushself; + + case PUSHSELF: + aux = *pc++; goto pushself; + + case PUSHSELF0: case PUSHSELF1: case PUSHSELF2: case PUSHSELF3: + case PUSHSELF4: case PUSHSELF5: case PUSHSELF6: case PUSHSELF7: + aux -= PUSHSELF0; + pushself: { + TObject receiver = *(S->top-1); + *S->top++ = consts[aux]; + luaV_gettable(); + *S->top++ = receiver; + break; + } + + case PUSHCONSTANTW: + aux = next_word(pc); goto pushconstant; + + case PUSHCONSTANT: + aux = *pc++; goto pushconstant; + + case PUSHCONSTANT0: case PUSHCONSTANT1: case PUSHCONSTANT2: + case PUSHCONSTANT3: case PUSHCONSTANT4: case PUSHCONSTANT5: + case PUSHCONSTANT6: case PUSHCONSTANT7: + aux -= PUSHCONSTANT0; + pushconstant: + *S->top++ = consts[aux]; + break; + + case PUSHUPVALUE: + aux = *pc++; goto pushupvalue; + + case PUSHUPVALUE0: case PUSHUPVALUE1: + aux -= PUSHUPVALUE0; + pushupvalue: + *S->top++ = cl->consts[aux+1]; + break; + + case SETLOCAL: + aux = *pc++; goto setlocal; + + case SETLOCAL0: case SETLOCAL1: case SETLOCAL2: case SETLOCAL3: + case SETLOCAL4: case SETLOCAL5: case SETLOCAL6: case SETLOCAL7: + aux -= SETLOCAL0; + setlocal: + *((S->stack+base) + aux) = *(--S->top); + break; + + case SETGLOBALW: + aux = next_word(pc); goto setglobal; + + case SETGLOBAL: + aux = *pc++; goto setglobal; + + case SETGLOBAL0: case SETGLOBAL1: case SETGLOBAL2: case SETGLOBAL3: + case SETGLOBAL4: case SETGLOBAL5: case SETGLOBAL6: case SETGLOBAL7: + aux -= SETGLOBAL0; + setglobal: + luaV_setglobal(tsvalue(&consts[aux])); + break; + + case SETTABLE0: + luaV_settable(S->top-3, 1); + break; + + case SETTABLE: + luaV_settable(S->top-3-(*pc++), 2); + break; + + case SETLISTW: + aux = next_word(pc); aux *= LFIELDS_PER_FLUSH; goto setlist; + + case SETLIST: + aux = *(pc++) * LFIELDS_PER_FLUSH; goto setlist; + + case SETLIST0: + aux = 0; + setlist: { + int n = *(pc++); + TObject *arr = S->top-n-1; + for (; n; n--) { + ttype(S->top) = LUA_T_NUMBER; + nvalue(S->top) = n+aux; + *(luaH_set(avalue(arr), S->top)) = *(S->top-1); + S->top--; + } + break; + } + + case SETMAP0: + aux = 0; goto setmap; + + case SETMAP: + aux = *pc++; + setmap: { + TObject *arr = S->top-(2*aux)-3; + do { + *(luaH_set(avalue(arr), S->top-2)) = *(S->top-1); + S->top-=2; + } while (aux--); + break; + } + + case POP: + aux = *pc++; goto pop; + + case POP0: case POP1: + aux -= POP0; + pop: + S->top -= (aux+1); + break; + + case CREATEARRAYW: + aux = next_word(pc); goto createarray; + + case CREATEARRAY0: case CREATEARRAY1: + aux -= CREATEARRAY0; goto createarray; + + case CREATEARRAY: + aux = *pc++; + createarray: + luaC_checkGC(); + avalue(S->top) = luaH_new(aux); + ttype(S->top) = LUA_T_ARRAY; + S->top++; + break; + + case EQOP: case NEQOP: { + int res = luaO_equalObj(S->top-2, S->top-1); + S->top--; + if (aux == NEQOP) res = !res; + ttype(S->top-1) = res ? LUA_T_NUMBER : LUA_T_NIL; + nvalue(S->top-1) = 1; + break; + } + + case LTOP: + comparison(LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, IM_LT); + break; + + case LEOP: + comparison(LUA_T_NUMBER, LUA_T_NUMBER, LUA_T_NIL, IM_LE); + break; + + case GTOP: + comparison(LUA_T_NIL, LUA_T_NIL, LUA_T_NUMBER, IM_GT); + break; + + case GEOP: + comparison(LUA_T_NIL, LUA_T_NUMBER, LUA_T_NUMBER, IM_GE); + break; + + case ADDOP: { + TObject *l = S->top-2; + TObject *r = S->top-1; + if (tonumber(r) || tonumber(l)) + call_arith(IM_ADD); + else { + nvalue(l) += nvalue(r); + --S->top; + } + break; + } + + case SUBOP: { + TObject *l = S->top-2; + TObject *r = S->top-1; + if (tonumber(r) || tonumber(l)) + call_arith(IM_SUB); + else { + nvalue(l) -= nvalue(r); + --S->top; + } + break; + } + + case MULTOP: { + TObject *l = S->top-2; + TObject *r = S->top-1; + if (tonumber(r) || tonumber(l)) + call_arith(IM_MUL); + else { + nvalue(l) *= nvalue(r); + --S->top; + } + break; + } + + case DIVOP: { + TObject *l = S->top-2; + TObject *r = S->top-1; + if (tonumber(r) || tonumber(l)) + call_arith(IM_DIV); + else { + nvalue(l) /= nvalue(r); + --S->top; + } + break; + } + + case POWOP: + call_binTM(IM_POW, "undefined operation"); + break; + + case CONCOP: { + TObject *l = S->top-2; + TObject *r = S->top-1; + if (tostring(l) || tostring(r)) + call_binTM(IM_CONCAT, "unexpected type for concatenation"); + else { + tsvalue(l) = strconc(tsvalue(l), tsvalue(r)); + --S->top; + } + luaC_checkGC(); + break; + } + + case MINUSOP: + if (tonumber(S->top-1)) { + ttype(S->top) = LUA_T_NIL; + S->top++; + call_arith(IM_UNM); + } + else + nvalue(S->top-1) = - nvalue(S->top-1); + break; + + case NOTOP: + ttype(S->top-1) = + (ttype(S->top-1) == LUA_T_NIL) ? LUA_T_NUMBER : LUA_T_NIL; + nvalue(S->top-1) = 1; + break; + + case ONTJMPW: + aux = next_word(pc); goto ontjmp; + + case ONTJMP: + aux = *pc++; + ontjmp: + if (ttype(S->top-1) != LUA_T_NIL) pc += aux; + else S->top--; + break; + + case ONFJMPW: + aux = next_word(pc); goto onfjmp; + + case ONFJMP: + aux = *pc++; + onfjmp: + if (ttype(S->top-1) == LUA_T_NIL) pc += aux; + else S->top--; + break; + + case JMPW: + aux = next_word(pc); goto jmp; + + case JMP: + aux = *pc++; + jmp: + pc += aux; + break; + + case IFFJMPW: + aux = next_word(pc); goto iffjmp; + + case IFFJMP: + aux = *pc++; + iffjmp: + if (ttype(--S->top) == LUA_T_NIL) pc += aux; + break; + + case IFTUPJMPW: + aux = next_word(pc); goto iftupjmp; + + case IFTUPJMP: + aux = *pc++; + iftupjmp: + if (ttype(--S->top) != LUA_T_NIL) pc -= aux; + break; + + case IFFUPJMPW: + aux = next_word(pc); goto iffupjmp; + + case IFFUPJMP: + aux = *pc++; + iffupjmp: + if (ttype(--S->top) == LUA_T_NIL) pc -= aux; + break; + + case CLOSUREW: + aux = next_word(pc); goto closure; + + case CLOSURE: + aux = *pc++; + closure: + *S->top++ = consts[aux]; + luaV_closure(*pc++); + luaC_checkGC(); + break; + + case CALLFUNC: + aux = *pc++; goto callfunc; + + case CALLFUNC0: case CALLFUNC1: + aux -= CALLFUNC0; + callfunc: { + StkId newBase = (S->top-S->stack)-(*pc++); + luaD_call(newBase, aux); + break; + } + + case ENDCODE: + S->top = S->stack + base; + /* goes through */ + case RETCODE: + if (lua_callhook) + luaD_callHook(base, NULL, 1); + return (base + ((aux==RETCODE) ? *pc : 0)); + + case SETLINEW: + aux = next_word(pc); goto setline; + + case SETLINE: + aux = *pc++; + setline: + if ((S->stack+base-1)->ttype != LUA_T_LINE) { + /* open space for LINE value */ + luaD_openstack((S->top-S->stack)-base); + base++; + (S->stack+base-1)->ttype = LUA_T_LINE; + } + (S->stack+base-1)->value.i = aux; + if (lua_linehook) + luaD_lineHook(aux); + break; + +#ifdef DEBUG + default: + LUA_INTERNALERROR("opcode doesn't match"); +#endif + } + } +} + diff --git a/src/lvm.h b/src/lvm.h new file mode 100644 index 00000000..9b3f9009 --- /dev/null +++ b/src/lvm.h @@ -0,0 +1,29 @@ +/* +** $Id: lvm.h,v 1.4 1997/12/15 16:17:20 roberto Exp $ +** Lua virtual machine +** See Copyright Notice in lua.h +*/ + +#ifndef lvm_h +#define lvm_h + + +#include "ldo.h" +#include "lobject.h" + + +#define tonumber(o) ((ttype(o) != LUA_T_NUMBER) && (luaV_tonumber(o) != 0)) +#define tostring(o) ((ttype(o) != LUA_T_STRING) && (luaV_tostring(o) != 0)) + + +void luaV_pack (StkId firstel, int nvararg, TObject *tab); +int luaV_tonumber (TObject *obj); +int luaV_tostring (TObject *obj); +void luaV_gettable (void); +void luaV_settable (TObject *t, int mode); +void luaV_getglobal (TaggedString *ts); +void luaV_setglobal (TaggedString *ts); +StkId luaV_execute (Closure *cl, TProtoFunc *tf, StkId base); +void luaV_closure (int nelems); + +#endif @@ -1,43 +1,47 @@ /* -* zio.c -* a generic input stream interface -* $Id: zio.c,v 1.2 1997/06/20 19:25:54 roberto Exp $ +** $Id: lzio.c,v 1.3 1997/12/22 20:57:18 roberto Exp $ +** a generic input stream interface +** See Copyright Notice in lua.h */ + + #include <stdio.h> -#include <stdlib.h> #include <string.h> -#include "zio.h" + +#include "lzio.h" + /* ----------------------------------------------------- memory buffers --- */ -static int zmfilbuf(ZIO* z) +static int zmfilbuf (ZIO* z) { return EOZ; } -ZIO* zmopen(ZIO* z, char* b, int size) +ZIO* zmopen (ZIO* z, char* b, int size, char *name) { if (b==NULL) return NULL; z->n=size; z->p= (unsigned char *)b; z->filbuf=zmfilbuf; z->u=NULL; + z->name=name; return z; } /* ------------------------------------------------------------ strings --- */ -ZIO* zsopen(ZIO* z, char* s) +ZIO* zsopen (ZIO* z, char* s, char *name) { if (s==NULL) return NULL; - return zmopen(z,s,strlen(s)); + return zmopen(z,s,strlen(s),name); } /* -------------------------------------------------------------- FILEs --- */ -static int zffilbuf(ZIO* z) +static int zffilbuf (ZIO* z) { int n=fread(z->buffer,1,ZBSIZE,z->u); if (n==0) return EOZ; @@ -47,19 +51,20 @@ static int zffilbuf(ZIO* z) } -ZIO* zFopen(ZIO* z, FILE* f) +ZIO* zFopen (ZIO* z, FILE* f, char *name) { if (f==NULL) return NULL; z->n=0; z->p=z->buffer; z->filbuf=zffilbuf; z->u=f; + z->name=name; return z; } /* --------------------------------------------------------------- read --- */ -int zread(ZIO *z, void *b, int n) +int zread (ZIO *z, void *b, int n) { while (n) { int m; @@ -1,11 +1,12 @@ /* -* zio.h -* a generic input stream interface -* $Id: zio.h,v 1.5 1997/06/20 19:25:54 roberto Exp $ +** $Id: lzio.h,v 1.4 1998/01/09 14:57:43 roberto Exp $ +** Buffered streams +** See Copyright Notice in lua.h */ -#ifndef zio_h -#define zio_h + +#ifndef lzio_h +#define lzio_h #include <stdio.h> @@ -21,15 +22,15 @@ typedef struct zio ZIO; -ZIO* zFopen(ZIO* z, FILE* f); /* open FILEs */ -ZIO* zsopen(ZIO* z, char* s); /* string */ -ZIO* zmopen(ZIO* z, char* b, int size); /* memory */ +ZIO* zFopen (ZIO* z, FILE* f, char *name); /* open FILEs */ +ZIO* zsopen (ZIO* z, char* s, char *name); /* string */ +ZIO* zmopen (ZIO* z, char* b, int size, char *name); /* memory */ -int zread(ZIO* z, void* b, int n); /* read next n bytes */ +int zread (ZIO* z, void* b, int n); /* read next n bytes */ #define zgetc(z) (--(z)->n>=0 ? ((int)*(z)->p++): (z)->filbuf(z)) #define zungetc(z) (++(z)->n,--(z)->p) - +#define zname(z) ((z)->name) /* --------- Private Part ------------------ */ @@ -41,6 +42,7 @@ struct zio { unsigned char* p; /* current position in buffer */ int (*filbuf)(ZIO* z); void* u; /* additional data */ + char *name; unsigned char buffer[ZBSIZE]; /* buffer */ }; diff --git a/src/opcode.c b/src/opcode.c deleted file mode 100644 index ea18f9ea..00000000 --- a/src/opcode.c +++ /dev/null @@ -1,1478 +0,0 @@ -/* -** opcode.c -** TecCGraf - PUC-Rio -*/ - -char *rcs_opcode="$Id: opcode.c,v 4.15 1997/06/26 21:40:57 roberto Exp $"; - -#include <setjmp.h> -#include <stdio.h> -#include <string.h> -#include <stdlib.h> - -#include "luadebug.h" -#include "luamem.h" -#include "opcode.h" -#include "hash.h" -#include "inout.h" -#include "table.h" -#include "lua.h" -#include "fallback.h" -#include "auxlib.h" -#include "lex.h" - -#define tonumber(o) ((ttype(o) != LUA_T_NUMBER) && (lua_tonumber(o) != 0)) -#define tostring(o) ((ttype(o) != LUA_T_STRING) && (lua_tostring(o) != 0)) - - -#define STACK_SIZE 128 - -#ifndef STACK_LIMIT -#define STACK_LIMIT 6000 -#endif - -typedef int StkId; /* index to stack elements */ - -static TObject initial_stack; - -static TObject *stackLimit = &initial_stack+1; -static TObject *stack = &initial_stack; -static TObject *top = &initial_stack; - - -/* macros to convert from lua_Object to (TObject *) and back */ - -#define Address(lo) ((lo)+stack-1) -#define Ref(st) ((st)-stack+1) - - -/* macro to increment stack top. There must be always an empty slot in -* the stack -*/ -#define incr_top if (++top >= stackLimit) growstack() - -struct C_Lua_Stack { - StkId base; /* when Lua calls C or C calls Lua, points to */ - /* the first slot after the last parameter. */ - StkId lua2C; /* points to first element of "array" lua2C */ - int num; /* size of "array" lua2C */ -}; - -static struct C_Lua_Stack CLS_current = {0, 0, 0}; - -static jmp_buf *errorJmp = NULL; /* current error recover point */ - - -/* Hooks */ -lua_LHFunction lua_linehook = NULL; -lua_CHFunction lua_callhook = NULL; - - -static StkId lua_execute (Byte *pc, StkId base); -static void do_call (StkId base, int nResults); - - - -TObject *luaI_Address (lua_Object o) -{ - return Address(o); -} - - -/* -** Init stack -*/ -static void lua_initstack (void) -{ - Long maxstack = STACK_SIZE; - stack = newvector(maxstack, TObject); - stackLimit = stack+maxstack; - top = stack; - *(top++) = initial_stack; -} - - -/* -** Check stack overflow and, if necessary, realloc vector -*/ -#define lua_checkstack(nt) if ((nt) >= stackLimit) growstack() - -static void growstack (void) -{ - if (stack == &initial_stack) - lua_initstack(); - else - { - static int limit = STACK_LIMIT; - StkId t = top-stack; - Long stacksize = stackLimit - stack; - stacksize = growvector(&stack, stacksize, TObject, stackEM, limit+100); - stackLimit = stack+stacksize; - top = stack + t; - if (stacksize >= limit) - { - limit = stacksize; - lua_error(stackEM); - } - } -} - - -/* -** Concatenate two given strings. Return the new string pointer. -*/ -static char *lua_strconc (char *l, char *r) -{ - size_t nl = strlen(l); - char *buffer = luaI_buffer(nl+strlen(r)+1); - strcpy(buffer, l); - strcpy(buffer+nl, r); - return buffer; -} - - -/* -** Convert, if possible, to a number object. -** Return 0 if success, not 0 if error. -*/ -static int lua_tonumber (TObject *obj) -{ - float t; - char c; - if (ttype(obj) != LUA_T_STRING) - return 1; - else if (sscanf(svalue(obj), "%f %c",&t, &c) == 1) - { - nvalue(obj) = t; - ttype(obj) = LUA_T_NUMBER; - return 0; - } - else - return 2; -} - - -/* -** Convert, if possible, to a string ttype -** Return 0 in success or not 0 on error. -*/ -static int lua_tostring (TObject *obj) -{ - if (ttype(obj) != LUA_T_NUMBER) - return 1; - else { - char s[60]; - real f = nvalue(obj); - int i; - if ((real)(-MAX_INT) <= f && f <= (real)MAX_INT && (real)(i=(int)f) == f) - sprintf (s, "%d", i); - else - sprintf (s, "%g", nvalue(obj)); - tsvalue(obj) = lua_createstring(s); - ttype(obj) = LUA_T_STRING; - return 0; - } -} - - -/* -** Adjust stack. Set top to the given value, pushing NILs if needed. -*/ -static void adjust_top_aux (StkId newtop) -{ - TObject *nt; - lua_checkstack(stack+newtop); - nt = stack+newtop; /* warning: previous call may change stack */ - while (top < nt) ttype(top++) = LUA_T_NIL; -} - - -#define adjust_top(newtop) { if (newtop <= top-stack) \ - top = stack+newtop; \ - else adjust_top_aux(newtop); } - -#define adjustC(nParams) adjust_top(CLS_current.base+nParams) - - -static void checkCparams (int nParams) -{ - if (top-stack < CLS_current.base+nParams) - lua_error("API error - wrong number of arguments in C2lua stack"); -} - - -/* -** Open a hole below "nelems" from the top. -*/ -static void open_stack (int nelems) -{ - int i; - for (i=0; i<nelems; i++) - *(top-i) = *(top-i-1); - incr_top; -} - - -static lua_Object put_luaObject (TObject *o) -{ - open_stack((top-stack)-CLS_current.base); - stack[CLS_current.base++] = *o; - return CLS_current.base; /* this is +1 real position (see Ref) */ -} - - -static lua_Object put_luaObjectonTop (void) -{ - open_stack((top-stack)-CLS_current.base); - stack[CLS_current.base++] = *(--top); - return CLS_current.base; /* this is +1 real position (see Ref) */ -} - - -lua_Object lua_pop (void) -{ - checkCparams(1); - return put_luaObjectonTop(); -} - - - -/* -** call Line hook -*/ -static void lineHook (int line) -{ - struct C_Lua_Stack oldCLS = CLS_current; - StkId old_top = CLS_current.lua2C = CLS_current.base = top-stack; - CLS_current.num = 0; - (*lua_linehook)(line); - top = stack+old_top; - CLS_current = oldCLS; -} - - -/* -** Call hook -** The function being called is in [stack+base-1] -*/ -static void callHook (StkId base, lua_Type type, int isreturn) -{ - struct C_Lua_Stack oldCLS = CLS_current; - StkId old_top = CLS_current.lua2C = CLS_current.base = top-stack; - CLS_current.num = 0; - if (isreturn) - (*lua_callhook)(LUA_NOOBJECT, "(return)", 0); - else - { - TObject *f = stack+base-1; - if (type == LUA_T_MARK) - (*lua_callhook)(Ref(f), f->value.tf->fileName, f->value.tf->lineDefined); - else - (*lua_callhook)(Ref(f), "(C)", -1); - } - top = stack+old_top; - CLS_current = oldCLS; -} - - -/* -** Call a C function. CLS_current.base will point to the top of the stack, -** and CLS_current.num is the number of parameters. Returns an index -** to the first result from C. -*/ -static StkId callC (lua_CFunction func, StkId base) -{ - struct C_Lua_Stack oldCLS = CLS_current; - StkId firstResult; - CLS_current.num = (top-stack) - base; - /* incorporate parameters on the stack */ - CLS_current.lua2C = base; - CLS_current.base = base+CLS_current.num; /* == top-stack */ - if (lua_callhook) - callHook(base, LUA_T_CMARK, 0); - (*func)(); - if (lua_callhook) /* func may have changed lua_callhook */ - callHook(base, LUA_T_CMARK, 1); - firstResult = CLS_current.base; - CLS_current = oldCLS; - return firstResult; -} - -static void callIM (TObject *f, int nParams, int nResults) -{ - open_stack(nParams); - *(top-nParams-1) = *f; - do_call((top-stack)-nParams, nResults); -} - - -/* -** Call a function (C or Lua). The parameters must be on the stack, -** between [stack+base,top). The function to be called is at stack+base-1. -** When returns, the results are on the stack, between [stack+base-1,top). -** The number of results is nResults, unless nResults=MULT_RET. -*/ -static void do_call (StkId base, int nResults) -{ - StkId firstResult; - TObject *func = stack+base-1; - int i; - if (ttype(func) == LUA_T_CFUNCTION) { - ttype(func) = LUA_T_CMARK; - firstResult = callC(fvalue(func), base); - } - else if (ttype(func) == LUA_T_FUNCTION) { - ttype(func) = LUA_T_MARK; - firstResult = lua_execute(func->value.tf->code, base); - } - else { /* func is not a function */ - /* Check the tag method for invalid functions */ - TObject *im = luaI_getimbyObj(func, IM_FUNCTION); - if (ttype(im) == LUA_T_NIL) - lua_error("call expression not a function"); - open_stack((top-stack)-(base-1)); - stack[base-1] = *im; - do_call(base, nResults); - return; - } - /* adjust the number of results */ - if (nResults != MULT_RET) - adjust_top(firstResult+nResults); - /* move results to base-1 (to erase parameters and function) */ - base--; - nResults = top - (stack+firstResult); /* actual number of results */ - for (i=0; i<nResults; i++) - *(stack+base+i) = *(stack+firstResult+i); - top -= firstResult-base; -} - - -/* -** Function to index a table. Receives the table at top-2 and the index -** at top-1. -*/ -static void pushsubscript (void) -{ - TObject *im; - if (ttype(top-2) != LUA_T_ARRAY) /* not a table, get "gettable" method */ - im = luaI_getimbyObj(top-2, IM_GETTABLE); - else { /* object is a table... */ - int tg = (top-2)->value.a->htag; - im = luaI_getim(tg, IM_GETTABLE); - if (ttype(im) == LUA_T_NIL) { /* and does not have a "gettable" method */ - TObject *h = lua_hashget(avalue(top-2), top-1); - if (h != NULL && ttype(h) != LUA_T_NIL) { - --top; - *(top-1) = *h; - } - else if (ttype(im=luaI_getim(tg, IM_INDEX)) != LUA_T_NIL) - callIM(im, 2, 1); - else { - --top; - ttype(top-1) = LUA_T_NIL; - } - return; - } - /* else it has a "gettable" method, go through to next command */ - } - /* object is not a table, or it has a "gettable" method */ - if (ttype(im) != LUA_T_NIL) - callIM(im, 2, 1); - else - lua_error("indexed expression not a table"); -} - - -lua_Object lua_rawgettable (void) -{ - checkCparams(2); - if (ttype(top-2) != LUA_T_ARRAY) - lua_error("indexed expression not a table in raw gettable"); - else { - TObject *h = lua_hashget(avalue(top-2), top-1); - --top; - if (h != NULL) - *(top-1) = *h; - else - ttype(top-1) = LUA_T_NIL; - } - return put_luaObjectonTop(); -} - - -/* -** Function to store indexed based on values at the top -** mode = 0: raw store (without internal methods) -** mode = 1: normal store (with internal methods) -** mode = 2: "deep stack" store (with internal methods) -*/ -static void storesubscript (TObject *t, int mode) -{ - TObject *im = (mode == 0) ? NULL : luaI_getimbyObj(t, IM_SETTABLE); - if (ttype(t) == LUA_T_ARRAY && (im == NULL || ttype(im) == LUA_T_NIL)) { - TObject *h = lua_hashdefine(avalue(t), t+1); - *h = *(top-1); - top -= (mode == 2) ? 1 : 3; - } - else { /* object is not a table, and/or has a specific "settable" method */ - if (im && ttype(im) != LUA_T_NIL) { - if (mode == 2) { - lua_checkstack(top+2); - *(top+1) = *(top-1); - *(top) = *(t+1); - *(top-1) = *t; - top += 2; - } - callIM(im, 3, 0); - } - else - lua_error("indexed expression not a table"); - } -} - - -static void getglobal (Word n) -{ - TObject *value = &lua_table[n].object; - TObject *im = luaI_getimbyObj(value, IM_GETGLOBAL); - if (ttype(im) == LUA_T_NIL) { /* default behavior */ - *top = *value; - incr_top; - } - else { - ttype(top) = LUA_T_STRING; - tsvalue(top) = lua_table[n].varname; - incr_top; - *top = *value; - incr_top; - callIM(im, 2, 1); - } -} - -/* -** Traverse all objects on stack -*/ -void lua_travstack (int (*fn)(TObject *)) -{ - StkId i; - for (i = (top-1)-stack; i>=0; i--) - fn (stack+i); -} - - -/* -** Error messages and debug functions -*/ - -static void lua_message (char *s) -{ - TObject *im = luaI_geterrorim(); - if (ttype(im) != LUA_T_NIL) { - lua_pushstring(s); - callIM(im, 1, 0); - } -} - -/* -** Reports an error, and jumps up to the available recover label -*/ -void lua_error (char *s) -{ - if (s) lua_message(s); - if (errorJmp) - longjmp(*errorJmp, 1); - else - { - fprintf (stderr, "lua: exit(1). Unable to recover\n"); - exit(1); - } -} - - -lua_Function lua_stackedfunction (int level) -{ - StkId i; - for (i = (top-1)-stack; i>=0; i--) - if (stack[i].ttype == LUA_T_MARK || stack[i].ttype == LUA_T_CMARK) - if (level-- == 0) - return Ref(stack+i); - return LUA_NOOBJECT; -} - - -int lua_currentline (lua_Function func) -{ - TObject *f = Address(func); - return (f+1 < top && (f+1)->ttype == LUA_T_LINE) ? (f+1)->value.i : -1; -} - - -lua_Object lua_getlocal (lua_Function func, int local_number, char **name) -{ - TObject *f = luaI_Address(func); - *name = luaI_getlocalname(f->value.tf, local_number, lua_currentline(func)); - if (*name) - { - /* if "*name", there must be a LUA_T_LINE */ - /* therefore, f+2 points to function base */ - return Ref((f+2)+(local_number-1)); - } - else - return LUA_NOOBJECT; -} - -int lua_setlocal (lua_Function func, int local_number) -{ - TObject *f = Address(func); - char *name = luaI_getlocalname(f->value.tf, local_number, lua_currentline(func)); - checkCparams(1); - --top; - if (name) - { - /* if "name", there must be a LUA_T_LINE */ - /* therefore, f+2 points to function base */ - *((f+2)+(local_number-1)) = *top; - return 1; - } - else - return 0; -} - -/* -** Call the function at CLS_current.base, and incorporate results on -** the Lua2C structure. -*/ -static void do_callinc (int nResults) -{ - StkId base = CLS_current.base; - do_call(base+1, nResults); - CLS_current.lua2C = base; /* position of the new results */ - CLS_current.num = (top-stack) - base; /* number of results */ - CLS_current.base = base + CLS_current.num; /* incorporate results on stack */ -} - - -static void do_unprotectedrun (lua_CFunction f, int nParams, int nResults) -{ - StkId base = (top-stack)-nParams; - open_stack(nParams); - stack[base].ttype = LUA_T_CFUNCTION; - stack[base].value.f = f; - do_call(base+1, nResults); -} - - -/* -** Execute a protected call. Assumes that function is at CLS_current.base and -** parameters are on top of it. Leave nResults on the stack. -*/ -static int do_protectedrun (int nResults) -{ - jmp_buf myErrorJmp; - int status; - struct C_Lua_Stack oldCLS = CLS_current; - jmp_buf *oldErr = errorJmp; - errorJmp = &myErrorJmp; - if (setjmp(myErrorJmp) == 0) { - do_callinc(nResults); - status = 0; - } - else { /* an error occurred: restore CLS_current and top */ - CLS_current = oldCLS; - top = stack+CLS_current.base; - status = 1; - } - errorJmp = oldErr; - return status; -} - -int luaI_dorun (TFunc *tf) -{ - int status; - adjustC(1); /* one slot for the pseudo-function */ - stack[CLS_current.base].ttype = LUA_T_FUNCTION; - stack[CLS_current.base].value.tf = tf; - status = do_protectedrun(MULT_RET); - return status; -} - - -int lua_domain (void) -{ - TFunc tf; - int status; - jmp_buf myErrorJmp; - jmp_buf *oldErr = errorJmp; - errorJmp = &myErrorJmp; - luaI_initTFunc(&tf); - if (setjmp(myErrorJmp) == 0) { - lua_parse(&tf); - status = 0; - } - else { - adjustC(0); /* erase extra slot */ - status = 1; - } - if (status == 0) - status = luaI_dorun(&tf); - errorJmp = oldErr; - luaI_free(tf.code); - return status; -} - -/* -** Execute the given lua function. Return 0 on success or 1 on error. -*/ -int lua_callfunction (lua_Object function) -{ - if (function == LUA_NOOBJECT) - return 1; - else - { - open_stack((top-stack)-CLS_current.base); - stack[CLS_current.base] = *Address(function); - return do_protectedrun (MULT_RET); - } -} - - -lua_Object lua_gettagmethod (int tag, char *event) -{ - lua_pushnumber(tag); - lua_pushstring(event); - do_unprotectedrun(luaI_gettagmethod, 2, 1); - return put_luaObjectonTop(); -} - -lua_Object lua_settagmethod (int tag, char *event) -{ - TObject newmethod; - checkCparams(1); - newmethod = *(--top); - lua_pushnumber(tag); - lua_pushstring(event); - *top = newmethod; incr_top; - do_unprotectedrun(luaI_settagmethod, 3, 1); - return put_luaObjectonTop(); -} - -lua_Object lua_seterrormethod (void) -{ - checkCparams(1); - do_unprotectedrun(luaI_seterrormethod, 1, 1); - return put_luaObjectonTop(); -} - - -/* -** API: receives on the stack the table and the index. -** returns the value. -*/ -lua_Object lua_gettable (void) -{ - checkCparams(2); - pushsubscript(); - return put_luaObjectonTop(); -} - - -#define MAX_C_BLOCKS 10 - -static int numCblocks = 0; -static struct C_Lua_Stack Cblocks[MAX_C_BLOCKS]; - -/* -** API: starts a new block -*/ -void lua_beginblock (void) -{ - if (numCblocks >= MAX_C_BLOCKS) - lua_error("`lua_beginblock': too many nested blocks"); - Cblocks[numCblocks] = CLS_current; - numCblocks++; -} - -/* -** API: ends a block -*/ -void lua_endblock (void) -{ - --numCblocks; - CLS_current = Cblocks[numCblocks]; - adjustC(0); -} - -void lua_settag (int tag) -{ - checkCparams(1); - luaI_settag(tag, --top); -} - -/* -** API: receives on the stack the table, the index, and the new value. -*/ -void lua_settable (void) -{ - checkCparams(3); - storesubscript(top-3, 1); -} - -void lua_rawsettable (void) -{ - checkCparams(3); - storesubscript(top-3, 0); -} - -/* -** API: creates a new table -*/ -lua_Object lua_createtable (void) -{ - TObject o; - avalue(&o) = lua_createarray(0); - ttype(&o) = LUA_T_ARRAY; - return put_luaObject(&o); -} - -/* -** Get a parameter, returning the object handle or LUA_NOOBJECT on error. -** 'number' must be 1 to get the first parameter. -*/ -lua_Object lua_lua2C (int number) -{ - if (number <= 0 || number > CLS_current.num) return LUA_NOOBJECT; - /* Ref(stack+(CLS_current.lua2C+number-1)) == - stack+(CLS_current.lua2C+number-1)-stack+1 == */ - return CLS_current.lua2C+number; -} - -int lua_isnil (lua_Object o) -{ - return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_NIL); -} - -int lua_istable (lua_Object o) -{ - return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_ARRAY); -} - -int lua_isuserdata (lua_Object o) -{ - return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_USERDATA); -} - -int lua_iscfunction (lua_Object o) -{ - int t = lua_tag(o); - return (t == LUA_T_CMARK) || (t == LUA_T_CFUNCTION); -} - -int lua_isnumber (lua_Object o) -{ - return (o!= LUA_NOOBJECT) && (tonumber(Address(o)) == 0); -} - -int lua_isstring (lua_Object o) -{ - int t = lua_tag(o); - return (t == LUA_T_STRING) || (t == LUA_T_NUMBER); -} - -int lua_isfunction (lua_Object o) -{ - int t = lua_tag(o); - return (t == LUA_T_FUNCTION) || (t == LUA_T_CFUNCTION) || - (t == LUA_T_MARK) || (t == LUA_T_CMARK); -} - -/* -** Given an object handle, return its number value. On error, return 0.0. -*/ -real lua_getnumber (lua_Object object) -{ - if (object == LUA_NOOBJECT) return 0.0; - if (tonumber (Address(object))) return 0.0; - else return (nvalue(Address(object))); -} - -/* -** Given an object handle, return its string pointer. On error, return NULL. -*/ -char *lua_getstring (lua_Object object) -{ - if (object == LUA_NOOBJECT || tostring (Address(object))) - return NULL; - else return (svalue(Address(object))); -} - - -void *lua_getuserdata (lua_Object object) -{ - if (object == LUA_NOOBJECT || ttype(Address(object)) != LUA_T_USERDATA) - return NULL; - else return tsvalue(Address(object))->u.v; -} - - -/* -** Given an object handle, return its cfuntion pointer. On error, return NULL. -*/ -lua_CFunction lua_getcfunction (lua_Object object) -{ - if (object == LUA_NOOBJECT || ((ttype(Address(object)) != LUA_T_CFUNCTION) && - (ttype(Address(object)) != LUA_T_CMARK))) - return NULL; - else return (fvalue(Address(object))); -} - - -lua_Object lua_getref (int ref) -{ - TObject *o = luaI_getref(ref); - if (o == NULL) - return LUA_NOOBJECT; - return put_luaObject(o); -} - - -int lua_ref (int lock) -{ - checkCparams(1); - return luaI_ref(--top, lock); -} - - - -/* -** Get a global object. -*/ -lua_Object lua_getglobal (char *name) -{ - getglobal(luaI_findsymbolbyname(name)); - return put_luaObjectonTop(); -} - - -lua_Object lua_rawgetglobal (char *name) -{ - return put_luaObject(&lua_table[luaI_findsymbolbyname(name)].object); -} - - -/* -** Store top of the stack at a global variable array field. -*/ -static void setglobal (Word n) -{ - TObject *oldvalue = &lua_table[n].object; - TObject *im = luaI_getimbyObj(oldvalue, IM_SETGLOBAL); - if (ttype(im) == LUA_T_NIL) /* default behavior */ - s_object(n) = *(--top); - else { - TObject newvalue = *(top-1); - ttype(top-1) = LUA_T_STRING; - tsvalue(top-1) = lua_table[n].varname; - *top = *oldvalue; - incr_top; - *top = newvalue; - incr_top; - callIM(im, 3, 0); - } -} - - -void lua_setglobal (char *name) -{ - checkCparams(1); - setglobal(luaI_findsymbolbyname(name)); -} - -void lua_rawsetglobal (char *name) -{ - Word n = luaI_findsymbolbyname(name); - checkCparams(1); - s_object(n) = *(--top); -} - -/* -** Push a nil object -*/ -void lua_pushnil (void) -{ - ttype(top) = LUA_T_NIL; - incr_top; -} - -/* -** Push an object (ttype=number) to stack. -*/ -void lua_pushnumber (real n) -{ - ttype(top) = LUA_T_NUMBER; nvalue(top) = n; - incr_top; -} - -/* -** Push an object (ttype=string) to stack. -*/ -void lua_pushstring (char *s) -{ - if (s == NULL) - ttype(top) = LUA_T_NIL; - else - { - tsvalue(top) = lua_createstring(s); - ttype(top) = LUA_T_STRING; - } - incr_top; -} - - -/* -** Push an object (ttype=cfunction) to stack. -*/ -void lua_pushcfunction (lua_CFunction fn) -{ - ttype(top) = LUA_T_CFUNCTION; fvalue(top) = fn; - incr_top; -} - - - -void lua_pushusertag (void *u, int tag) -{ - if (tag < 0 && tag != LUA_ANYTAG) - luaI_realtag(tag); /* error if tag is not valid */ - tsvalue(top) = luaI_createudata(u, tag); - ttype(top) = LUA_T_USERDATA; - incr_top; -} - -/* -** Push an object on the stack. -*/ -void luaI_pushobject (TObject *o) -{ - *top = *o; - incr_top; -} - -/* -** Push a lua_Object on stack. -*/ -void lua_pushobject (lua_Object o) -{ - if (o == LUA_NOOBJECT) - lua_error("API error - attempt to push a NOOBJECT"); - *top = *Address(o); - if (ttype(top) == LUA_T_MARK) ttype(top) = LUA_T_FUNCTION; - else if (ttype(top) == LUA_T_CMARK) ttype(top) = LUA_T_CFUNCTION; - incr_top; -} - -int lua_tag (lua_Object lo) -{ - if (lo == LUA_NOOBJECT) return LUA_T_NIL; - else { - TObject *o = Address(lo); - lua_Type t = ttype(o); - if (t == LUA_T_USERDATA) - return o->value.ts->tag; - else if (t == LUA_T_ARRAY) - return o->value.a->htag; - else return t; - } -} - - -void luaI_gcIM (TObject *o) -{ - TObject *im = luaI_getimbyObj(o, IM_GC); - if (ttype(im) != LUA_T_NIL) { - *top = *o; - incr_top; - callIM(im, 1, 0); - } -} - - -static void call_binTM (IMS event, char *msg) -{ - TObject *im = luaI_getimbyObj(top-2, event); /* try first operand */ - if (ttype(im) == LUA_T_NIL) { - im = luaI_getimbyObj(top-1, event); /* try second operand */ - if (ttype(im) == LUA_T_NIL) { - im = luaI_getim(0, event); /* try a 'global' i.m. */ - if (ttype(im) == LUA_T_NIL) - lua_error(msg); - } - } - lua_pushstring(luaI_eventname[event]); - callIM(im, 3, 1); -} - - -static void call_arith (IMS event) -{ - call_binTM(event, "unexpected type at arithmetic operation"); -} - - -static void comparison (lua_Type ttype_less, lua_Type ttype_equal, - lua_Type ttype_great, IMS op) -{ - TObject *l = top-2; - TObject *r = top-1; - int result; - if (ttype(l) == LUA_T_NUMBER && ttype(r) == LUA_T_NUMBER) - result = (nvalue(l) < nvalue(r)) ? -1 : (nvalue(l) == nvalue(r)) ? 0 : 1; - else if (ttype(l) == LUA_T_STRING && ttype(r) == LUA_T_STRING) - result = strcmp(svalue(l), svalue(r)); - else { - call_binTM(op, "unexpected type at comparison"); - return; - } - top--; - nvalue(top-1) = 1; - ttype(top-1) = (result < 0) ? ttype_less : - (result == 0) ? ttype_equal : ttype_great; -} - - -static void adjust_varargs (StkId first_extra_arg) -{ - TObject arg; - TObject *firstelem = stack+first_extra_arg; - int nvararg = top-firstelem; - int i; - if (nvararg < 0) nvararg = 0; - avalue(&arg) = lua_createarray(nvararg+1); /* +1 for field 'n' */ - ttype(&arg) = LUA_T_ARRAY; - for (i=0; i<nvararg; i++) { - TObject index; - ttype(&index) = LUA_T_NUMBER; - nvalue(&index) = i+1; - *(lua_hashdefine(avalue(&arg), &index)) = *(firstelem+i); - } - /* store counter in field "n" */ { - TObject index, extra; - ttype(&index) = LUA_T_STRING; - tsvalue(&index) = lua_createstring("n"); - ttype(&extra) = LUA_T_NUMBER; - nvalue(&extra) = nvararg; - *(lua_hashdefine(avalue(&arg), &index)) = extra; - } - adjust_top(first_extra_arg); - *top = arg; incr_top; -} - - - -/* -** Execute the given opcode, until a RET. Parameters are between -** [stack+base,top). Returns n such that the the results are between -** [stack+n,top). -*/ -static StkId lua_execute (Byte *pc, StkId base) -{ - if (lua_callhook) - callHook (base, LUA_T_MARK, 0); - while (1) - { - OpCode opcode; - switch (opcode = (OpCode)*pc++) - { - case PUSHNIL: ttype(top) = LUA_T_NIL; incr_top; break; - - case PUSH0: case PUSH1: case PUSH2: - ttype(top) = LUA_T_NUMBER; - nvalue(top) = opcode-PUSH0; - incr_top; - break; - - case PUSHBYTE: - ttype(top) = LUA_T_NUMBER; nvalue(top) = *pc++; incr_top; break; - - case PUSHWORD: - { - Word w; - get_word(w,pc); - ttype(top) = LUA_T_NUMBER; nvalue(top) = w; - incr_top; - } - break; - - case PUSHFLOAT: - { - real num; - get_float(num,pc); - ttype(top) = LUA_T_NUMBER; nvalue(top) = num; - incr_top; - } - break; - - case PUSHSTRING: - { - Word w; - get_word(w,pc); - ttype(top) = LUA_T_STRING; tsvalue(top) = lua_constant[w]; - incr_top; - } - break; - - case PUSHFUNCTION: - { - TFunc *f; - get_code(f,pc); - luaI_insertfunction(f); /* may take part in GC */ - top->ttype = LUA_T_FUNCTION; - top->value.tf = f; - incr_top; - } - break; - - case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2: - case PUSHLOCAL3: case PUSHLOCAL4: case PUSHLOCAL5: - case PUSHLOCAL6: case PUSHLOCAL7: case PUSHLOCAL8: - case PUSHLOCAL9: - *top = *((stack+base) + (int)(opcode-PUSHLOCAL0)); incr_top; break; - - case PUSHLOCAL: *top = *((stack+base) + (*pc++)); incr_top; break; - - case PUSHGLOBAL: - { - Word w; - get_word(w,pc); - getglobal(w); - } - break; - - case PUSHINDEXED: - pushsubscript(); - break; - - case PUSHSELF: - { - TObject receiver = *(top-1); - Word w; - get_word(w,pc); - ttype(top) = LUA_T_STRING; tsvalue(top) = lua_constant[w]; - incr_top; - pushsubscript(); - *top = receiver; - incr_top; - break; - } - - case STORELOCAL0: case STORELOCAL1: case STORELOCAL2: - case STORELOCAL3: case STORELOCAL4: case STORELOCAL5: - case STORELOCAL6: case STORELOCAL7: case STORELOCAL8: - case STORELOCAL9: - *((stack+base) + (int)(opcode-STORELOCAL0)) = *(--top); - break; - - case STORELOCAL: *((stack+base) + (*pc++)) = *(--top); break; - - case STOREGLOBAL: - { - Word w; - get_word(w,pc); - setglobal(w); - } - break; - - case STOREINDEXED0: - storesubscript(top-3, 1); - break; - - case STOREINDEXED: { - int n = *pc++; - storesubscript(top-3-n, 2); - break; - } - - case STORELIST0: - case STORELIST: - { - int m, n; - TObject *arr; - if (opcode == STORELIST0) m = 0; - else m = *(pc++) * FIELDS_PER_FLUSH; - n = *(pc++); - arr = top-n-1; - while (n) - { - ttype(top) = LUA_T_NUMBER; nvalue(top) = n+m; - *(lua_hashdefine (avalue(arr), top)) = *(top-1); - top--; - n--; - } - } - break; - - case STORERECORD: /* opcode obsolete: supersed by STOREMAP */ - { - int n = *(pc++); - TObject *arr = top-n-1; - while (n) - { - Word w; - get_word(w,pc); - ttype(top) = LUA_T_STRING; tsvalue(top) = lua_constant[w]; - *(lua_hashdefine (avalue(arr), top)) = *(top-1); - top--; - n--; - } - } - break; - - case STOREMAP: { - int n = *(pc++); - TObject *arr = top-(2*n)-1; - while (n--) { - *(lua_hashdefine (avalue(arr), top-2)) = *(top-1); - top-=2; - } - } - break; - - case ADJUST0: - adjust_top(base); - break; - - case ADJUST: { - StkId newtop = base + *(pc++); - adjust_top(newtop); - break; - } - - case VARARGS: - adjust_varargs(base + *(pc++)); - break; - - case CREATEARRAY: - { - Word size; - get_word(size,pc); - avalue(top) = lua_createarray(size); - ttype(top) = LUA_T_ARRAY; - incr_top; - } - break; - - case EQOP: - { - int res = lua_equalObj(top-2, top-1); - --top; - ttype(top-1) = res ? LUA_T_NUMBER : LUA_T_NIL; - nvalue(top-1) = 1; - } - break; - - case LTOP: - comparison(LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, IM_LT); - break; - - case LEOP: - comparison(LUA_T_NUMBER, LUA_T_NUMBER, LUA_T_NIL, IM_LE); - break; - - case GTOP: - comparison(LUA_T_NIL, LUA_T_NIL, LUA_T_NUMBER, IM_GT); - break; - - case GEOP: - comparison(LUA_T_NIL, LUA_T_NUMBER, LUA_T_NUMBER, IM_GE); - break; - - case ADDOP: - { - TObject *l = top-2; - TObject *r = top-1; - if (tonumber(r) || tonumber(l)) - call_arith(IM_ADD); - else - { - nvalue(l) += nvalue(r); - --top; - } - } - break; - - case SUBOP: - { - TObject *l = top-2; - TObject *r = top-1; - if (tonumber(r) || tonumber(l)) - call_arith(IM_SUB); - else - { - nvalue(l) -= nvalue(r); - --top; - } - } - break; - - case MULTOP: - { - TObject *l = top-2; - TObject *r = top-1; - if (tonumber(r) || tonumber(l)) - call_arith(IM_MUL); - else - { - nvalue(l) *= nvalue(r); - --top; - } - } - break; - - case DIVOP: - { - TObject *l = top-2; - TObject *r = top-1; - if (tonumber(r) || tonumber(l)) - call_arith(IM_DIV); - else - { - nvalue(l) /= nvalue(r); - --top; - } - } - break; - - case POWOP: - call_arith(IM_POW); - break; - - case CONCOP: { - TObject *l = top-2; - TObject *r = top-1; - if (tostring(l) || tostring(r)) - call_binTM(IM_CONCAT, "unexpected type for concatenation"); - else { - tsvalue(l) = lua_createstring(lua_strconc(svalue(l),svalue(r))); - --top; - } - } - break; - - case MINUSOP: - if (tonumber(top-1)) - { - ttype(top) = LUA_T_NIL; - incr_top; - call_arith(IM_UNM); - } - else - nvalue(top-1) = - nvalue(top-1); - break; - - case NOTOP: - ttype(top-1) = (ttype(top-1) == LUA_T_NIL) ? LUA_T_NUMBER : LUA_T_NIL; - nvalue(top-1) = 1; - break; - - case ONTJMP: - { - Word w; - get_word(w,pc); - if (ttype(top-1) != LUA_T_NIL) pc += w; - } - break; - - case ONFJMP: - { - Word w; - get_word(w,pc); - if (ttype(top-1) == LUA_T_NIL) pc += w; - } - break; - - case JMP: - { - Word w; - get_word(w,pc); - pc += w; - } - break; - - case UPJMP: - { - Word w; - get_word(w,pc); - pc -= w; - } - break; - - case IFFJMP: - { - Word w; - get_word(w,pc); - top--; - if (ttype(top) == LUA_T_NIL) pc += w; - } - break; - - case IFFUPJMP: - { - Word w; - get_word(w,pc); - top--; - if (ttype(top) == LUA_T_NIL) pc -= w; - } - break; - - case POP: --top; break; - - case CALLFUNC: - { - int nParams = *(pc++); - int nResults = *(pc++); - StkId newBase = (top-stack)-nParams; - do_call(newBase, nResults); - } - break; - - case RETCODE0: - case RETCODE: - if (lua_callhook) - callHook (base, LUA_T_MARK, 1); - return (base + ((opcode==RETCODE0) ? 0 : *pc)); - - case SETLINE: - { - Word line; - get_word(line,pc); - if ((stack+base-1)->ttype != LUA_T_LINE) - { - /* open space for LINE value */ - open_stack((top-stack)-base); - base++; - (stack+base-1)->ttype = LUA_T_LINE; - } - (stack+base-1)->value.i = line; - if (lua_linehook) - lineHook (line); - break; - } - - default: - lua_error ("internal error - opcode doesn't match"); - } - } -} - - -#if COMPAT2_5 -/* -** API: set a function as a fallback -*/ -lua_Object lua_setfallback (char *name, lua_CFunction fallback) -{ - lua_pushstring(name); - lua_pushcfunction(fallback); - do_unprotectedrun(luaI_setfallback, 2, 1); - return put_luaObjectonTop(); -} -#endif diff --git a/src/opcode.h b/src/opcode.h deleted file mode 100644 index 0b63de96..00000000 --- a/src/opcode.h +++ /dev/null @@ -1,171 +0,0 @@ -/* -** TeCGraf - PUC-Rio -** $Id: opcode.h,v 3.34 1997/06/16 16:50:22 roberto Exp $ -*/ - -#ifndef opcode_h -#define opcode_h - -#include "lua.h" -#include "types.h" -#include "tree.h" -#include "func.h" - - -#define FIELDS_PER_FLUSH 40 - -/* -* WARNING: if you change the order of this enumeration, -* grep "ORDER LUA_T" -*/ -typedef enum -{ - LUA_T_NIL = -9, - LUA_T_NUMBER = -8, - LUA_T_STRING = -7, - LUA_T_ARRAY = -6, /* array==table */ - LUA_T_FUNCTION = -5, - LUA_T_CFUNCTION= -4, - LUA_T_MARK = -3, - LUA_T_CMARK = -2, - LUA_T_LINE = -1, - LUA_T_USERDATA = 0 -} lua_Type; - -#define NUM_TYPES 10 - - -extern char *luaI_typenames[]; - -typedef enum { -/* name parm before after side effect ------------------------------------------------------------------------------*/ - -PUSHNIL,/* - nil */ -PUSH0,/* - 0.0 */ -PUSH1,/* - 1.0 */ -PUSH2,/* - 2.0 */ -PUSHBYTE,/* b - (float)b */ -PUSHWORD,/* w - (float)w */ -PUSHFLOAT,/* f - f */ -PUSHSTRING,/* w - STR[w] */ -PUSHFUNCTION,/* p - FUN(p) */ -PUSHLOCAL0,/* - LOC[0] */ -PUSHLOCAL1,/* - LOC[1] */ -PUSHLOCAL2,/* - LOC[2] */ -PUSHLOCAL3,/* - LOC[3] */ -PUSHLOCAL4,/* - LOC[4] */ -PUSHLOCAL5,/* - LOC[5] */ -PUSHLOCAL6,/* - LOC[6] */ -PUSHLOCAL7,/* - LOC[7] */ -PUSHLOCAL8,/* - LOC[8] */ -PUSHLOCAL9,/* - LOC[9] */ -PUSHLOCAL,/* b - LOC[b] */ -PUSHGLOBAL,/* w - VAR[w] */ -PUSHINDEXED,/* i t t[i] */ -PUSHSELF,/* w t t t[STR[w]] */ -STORELOCAL0,/* x - LOC[0]=x */ -STORELOCAL1,/* x - LOC[1]=x */ -STORELOCAL2,/* x - LOC[2]=x */ -STORELOCAL3,/* x - LOC[3]=x */ -STORELOCAL4,/* x - LOC[4]=x */ -STORELOCAL5,/* x - LOC[5]=x */ -STORELOCAL6,/* x - LOC[6]=x */ -STORELOCAL7,/* x - LOC[7]=x */ -STORELOCAL8,/* x - LOC[8]=x */ -STORELOCAL9,/* x - LOC[9]=x */ -STORELOCAL,/* b x - LOC[b]=x */ -STOREGLOBAL,/* w x - VAR[w]=x */ -STOREINDEXED0,/* v i t - t[i]=v */ -STOREINDEXED,/* b v a_b...a_1 i t a_b...a_1 i t t[i]=v */ -STORELIST0,/* b v_b...v_1 t - t[i]=v_i */ -STORELIST,/* b c v_b...v_1 t - t[i+c*FPF]=v_i */ -STORERECORD,/* b - w_b...w_1 v_b...v_1 t - t[STR[w_i]]=v_i */ -ADJUST0,/* - - TOP=BASE */ -ADJUST,/* b - - TOP=BASE+b */ -CREATEARRAY,/* w - newarray(size = w) */ -EQOP,/* y x (x==y)? 1 : nil */ -LTOP,/* y x (x<y)? 1 : nil */ -LEOP,/* y x (x<y)? 1 : nil */ -GTOP,/* y x (x>y)? 1 : nil */ -GEOP,/* y x (x>=y)? 1 : nil */ -ADDOP,/* y x x+y */ -SUBOP,/* y x x-y */ -MULTOP,/* y x x*y */ -DIVOP,/* y x x/y */ -POWOP,/* y x x^y */ -CONCOP,/* y x x..y */ -MINUSOP,/* x -x */ -NOTOP,/* x (x==nil)? 1 : nil */ -ONTJMP,/* w x - (x!=nil)? PC+=w */ -ONFJMP,/* w x - (x==nil)? PC+=w */ -JMP,/* w - - PC+=w */ -UPJMP,/* w - - PC-=w */ -IFFJMP,/* w x - (x==nil)? PC+=w */ -IFFUPJMP,/* w x - (x==nil)? PC-=w */ -POP,/* x - */ -CALLFUNC,/* b c v_b...v_1 f r_c...r_1 f(v1,...,v_b) */ -RETCODE0, -RETCODE,/* b - - */ -SETLINE,/* w - - LINE=w */ -VARARGS,/* b v_b...v_1 {v_1...v_b;n=b} */ -STOREMAP/* b v_b k_b ...v_1 k_1 t - t[k_i]=v_i */ -} OpCode; - - -#define MULT_RET 255 - - -typedef union -{ - lua_CFunction f; - real n; - TaggedString *ts; - TFunc *tf; - struct Hash *a; - int i; -} Value; - -typedef struct TObject -{ - lua_Type ttype; - Value value; -} TObject; - - -/* Macros to access structure members */ -#define ttype(o) ((o)->ttype) -#define nvalue(o) ((o)->value.n) -#define svalue(o) ((o)->value.ts->str) -#define tsvalue(o) ((o)->value.ts) -#define avalue(o) ((o)->value.a) -#define fvalue(o) ((o)->value.f) - -/* Macros to access symbol table */ -#define s_object(i) (lua_table[i].object) -#define s_ttype(i) (ttype(&s_object(i))) -#define s_nvalue(i) (nvalue(&s_object(i))) -#define s_svalue(i) (svalue(&s_object(i))) -#define s_tsvalue(i) (tsvalue(&s_object(i))) -#define s_avalue(i) (avalue(&s_object(i))) -#define s_fvalue(i) (fvalue(&s_object(i))) -#define s_uvalue(i) (uvalue(&s_object(i))) - -#define get_word(code,pc) {memcpy(&code, pc, sizeof(Word)); pc+=sizeof(Word);} -#define get_float(code,pc){memcpy(&code, pc, sizeof(real)); pc+=sizeof(real);} -#define get_code(code,pc) {memcpy(&code, pc, sizeof(TFunc *)); \ - pc+=sizeof(TFunc *);} - - -/* Exported functions */ -void lua_parse (TFunc *tf); /* from "lua.stx" module */ -void luaI_codedebugline (int line); /* from "lua.stx" module */ -void lua_travstack (int (*fn)(TObject *)); -TObject *luaI_Address (lua_Object o); -void luaI_pushobject (TObject *o); -void luaI_gcIM (TObject *o); -int luaI_dorun (TFunc *tf); -int lua_domain (void); - -#endif diff --git a/src/parser.c b/src/parser.c deleted file mode 100644 index ad5f8d68..00000000 --- a/src/parser.c +++ /dev/null @@ -1,1696 +0,0 @@ -#ifndef lint -static char luaY_sccsid[] = "@(#)yaccpar 1.9 (Berkeley) 02/21/93"; -#endif -#define YYBYACC 1 -#define YYMAJOR 1 -#define YYMINOR 9 -#define luaY_clearin (luaY_char=(-1)) -#define luaY_errok (luaY_errflag=0) -#define YYRECOVERING (luaY_errflag!=0) -#define YYPREFIX "luaY_" -#line 2 "lua.stx" - -char *rcs_luastx = "$Id: parser.c,v 1.1 1997/06/30 18:59:03 lhf Exp $"; - -#include <stdio.h> -#include <stdlib.h> -#include <string.h> - -#include "luadebug.h" -#include "luamem.h" -#include "lex.h" -#include "opcode.h" -#include "hash.h" -#include "inout.h" -#include "tree.h" -#include "table.h" -#include "lua.h" -#include "func.h" - -/* to avoid warnings generated by yacc */ -int luaY_parse (void); -#define malloc luaI_malloc -#define realloc luaI_realloc -#define free luaI_free - -#ifndef LISTING -#define LISTING 0 -#endif - -#ifndef CODE_BLOCK -#define CODE_BLOCK 256 -#endif -static int maxcode; -static int maxmain; -static int maxcurr; -static Byte *funcCode = NULL; -static Byte **initcode; -static Byte *basepc; -static int maincode; -static int pc; - - -#define MAXVAR 32 -static Long varbuffer[MAXVAR]; /* variables in an assignment list; - it's long to store negative Word values */ -static int nvarbuffer=0; /* number of variables at a list */ - -#define MAXLOCALS 32 -static TaggedString *localvar[MAXLOCALS]; /* store local variable names */ -static int nlocalvar=0; /* number of local variables */ - -#define MAXFIELDS FIELDS_PER_FLUSH*2 - -int lua_debug = 0; - -/* Internal functions */ - -static void luaY_error (char *s) -{ - luaI_syntaxerror(s); -} - -static void check_space (int i) -{ - if (pc+i>maxcurr-1) /* 1 byte free to code HALT of main code */ - maxcurr = growvector(&basepc, maxcurr, Byte, codeEM, MAX_INT); -} - -static void code_byte (Byte c) -{ - check_space(1); - basepc[pc++] = c; -} - -static void code_word (Word n) -{ - check_space(sizeof(Word)); - memcpy(basepc+pc, &n, sizeof(Word)); - pc += sizeof(Word); -} - -static void code_float (real n) -{ - check_space(sizeof(real)); - memcpy(basepc+pc, &n, sizeof(real)); - pc += sizeof(real); -} - -static void code_code (TFunc *tf) -{ - check_space(sizeof(TFunc *)); - memcpy(basepc+pc, &tf, sizeof(TFunc *)); - pc += sizeof(TFunc *); -} - -static void code_word_at (Byte *p, int n) -{ - Word w = n; - if (w != n) - luaY_error("block too big"); - memcpy(p, &w, sizeof(Word)); -} - -static void flush_record (int n) -{ - if (n == 0) return; - code_byte(STOREMAP); - code_byte(n); -} - -static void flush_list (int m, int n) -{ - if (n == 0) return; - if (m == 0) - code_byte(STORELIST0); - else - if (m < 255) - { - code_byte(STORELIST); - code_byte(m); - } - else - luaY_error ("list constructor too long"); - code_byte(n); -} - -static void store_localvar (TaggedString *name, int n) -{ - if (nlocalvar+n < MAXLOCALS) - localvar[nlocalvar+n] = name; - else - luaY_error ("too many local variables"); - if (lua_debug) - luaI_registerlocalvar(name, lua_linenumber); -} - -static void add_localvar (TaggedString *name) -{ - store_localvar(name, 0); - nlocalvar++; -} - -static void add_varbuffer (Long var) -{ - if (nvarbuffer < MAXVAR) - varbuffer[nvarbuffer++] = var; - else - luaY_error ("variable buffer overflow"); -} - -static void code_string (Word w) -{ - code_byte(PUSHSTRING); - code_word(w); -} - -static void code_constant (TaggedString *s) -{ - code_string(luaI_findconstant(s)); -} - -static void code_number (float f) -{ - Word i; - if (f >= 0 && f <= (float)MAX_WORD && (float)(i=(Word)f) == f) { - /* f has an (short) integer value */ - if (i <= 2) code_byte(PUSH0 + i); - else if (i <= 255) - { - code_byte(PUSHBYTE); - code_byte(i); - } - else - { - code_byte(PUSHWORD); - code_word(i); - } - } - else - { - code_byte(PUSHFLOAT); - code_float(f); - } -} - -/* -** Search a local name and if find return its index. If do not find return -1 -*/ -static int lua_localname (TaggedString *n) -{ - int i; - for (i=nlocalvar-1; i >= 0; i--) - if (n == localvar[i]) return i; /* local var */ - return -1; /* global var */ -} - -/* -** Push a variable given a number. If number is positive, push global variable -** indexed by (number -1). If negative, push local indexed by ABS(number)-1. -** Otherwise, if zero, push indexed variable (record). -*/ -static void lua_pushvar (Long number) -{ - if (number > 0) /* global var */ - { - code_byte(PUSHGLOBAL); - code_word(number-1); - } - else if (number < 0) /* local var */ - { - number = (-number) - 1; - if (number < 10) code_byte(PUSHLOCAL0 + number); - else - { - code_byte(PUSHLOCAL); - code_byte(number); - } - } - else - { - code_byte(PUSHINDEXED); - } -} - -static void lua_codeadjust (int n) -{ - if (n+nlocalvar == 0) - code_byte(ADJUST0); - else - { - code_byte(ADJUST); - code_byte(n+nlocalvar); - } -} - -static void change2main (void) -{ - /* (re)store main values */ - pc=maincode; basepc=*initcode; maxcurr=maxmain; - nlocalvar=0; -} - -static void savemain (void) -{ - /* save main values */ - maincode=pc; *initcode=basepc; maxmain=maxcurr; -} - -static void init_func (void) -{ - if (funcCode == NULL) /* first function */ - { - funcCode = newvector(CODE_BLOCK, Byte); - maxcode = CODE_BLOCK; - } - savemain(); /* save main values */ - /* set func values */ - pc=0; basepc=funcCode; maxcurr=maxcode; - nlocalvar = 0; - luaI_codedebugline(lua_linenumber); -} - -static void codereturn (void) -{ - if (nlocalvar == 0) - code_byte(RETCODE0); - else - { - code_byte(RETCODE); - code_byte(nlocalvar); - } -} - -void luaI_codedebugline (int line) -{ - static int lastline = 0; - if (lua_debug && line != lastline) - { - code_byte(SETLINE); - code_word(line); - lastline = line; - } -} - -static int adjust_functioncall (Long exp, int i) -{ - if (exp <= 0) - return -exp; /* exp is -list length */ - else - { - int temp = basepc[exp]; - basepc[exp] = i; - return temp+i; - } -} - -static void adjust_mult_assign (int vars, Long exps, int temps) -{ - if (exps > 0) - { /* must correct function call */ - int diff = vars - basepc[exps]; - if (diff >= 0) - adjust_functioncall(exps, diff); - else - { - adjust_functioncall(exps, 0); - lua_codeadjust(temps); - } - } - else if (vars != -exps) - lua_codeadjust(temps); -} - -static int close_parlist (int dots) -{ - if (!dots) - lua_codeadjust(0); - else - { - code_byte(VARARGS); - code_byte(nlocalvar); - add_localvar(luaI_createfixedstring("arg")); - } - return lua_linenumber; -} - -static void storesinglevar (Long v) -{ - if (v > 0) /* global var */ - { - code_byte(STOREGLOBAL); - code_word(v-1); - } - else if (v < 0) /* local var */ - { - int number = (-v) - 1; - if (number < 10) code_byte(STORELOCAL0 + number); - else - { - code_byte(STORELOCAL); - code_byte(number); - } - } - else - code_byte(STOREINDEXED0); -} - -static void lua_codestore (int i) -{ - if (varbuffer[i] != 0) /* global or local var */ - storesinglevar(varbuffer[i]); - else /* indexed var */ - { - int j; - int upper=0; /* number of indexed variables upper */ - int param; /* number of itens until indexed expression */ - for (j=i+1; j <nvarbuffer; j++) - if (varbuffer[j] == 0) upper++; - param = upper*2 + i; - if (param == 0) - code_byte(STOREINDEXED0); - else - { - code_byte(STOREINDEXED); - code_byte(param); - } - } -} - -static void codeIf (Long thenAdd, Long elseAdd) -{ - Long elseinit = elseAdd+sizeof(Word)+1; - if (pc == elseinit) /* no else */ - { - pc -= sizeof(Word)+1; - elseinit = pc; - } - else - { - basepc[elseAdd] = JMP; - code_word_at(basepc+elseAdd+1, pc-elseinit); - } - basepc[thenAdd] = IFFJMP; - code_word_at(basepc+thenAdd+1,elseinit-(thenAdd+sizeof(Word)+1)); -} - - -/* -** Parse LUA code. -*/ -void lua_parse (TFunc *tf) -{ - initcode = &(tf->code); - *initcode = newvector(CODE_BLOCK, Byte); - maincode = 0; - maxmain = CODE_BLOCK; - change2main(); - if (luaY_parse ()) lua_error("parse error"); - savemain(); - (*initcode)[maincode++] = RETCODE0; - tf->size = maincode; -#if LISTING -{ static void PrintCode (Byte *c, Byte *end); - PrintCode(*initcode,*initcode+maincode); } -#endif -} - - -#line 412 "lua.stx" -typedef union -{ - int vInt; - float vFloat; - char *pChar; - Word vWord; - Long vLong; - TFunc *pFunc; - TaggedString *pTStr; -} YYSTYPE; -#line 431 "y.tab.c" -#define WRONGTOKEN 257 -#define NIL 258 -#define IF 259 -#define THEN 260 -#define ELSE 261 -#define ELSEIF 262 -#define WHILE 263 -#define DO 264 -#define REPEAT 265 -#define UNTIL 266 -#define END 267 -#define RETURN 268 -#define LOCAL 269 -#define FUNCTION 270 -#define DOTS 271 -#define NUMBER 272 -#define STRING 273 -#define NAME 274 -#define AND 275 -#define OR 276 -#define EQ 277 -#define NE 278 -#define LE 279 -#define GE 280 -#define CONC 281 -#define UNARY 282 -#define NOT 283 -#define YYERRCODE 256 -short luaY_lhs[] = { -1, - 0, 24, 24, 24, 28, 22, 22, 23, 31, 31, - 27, 27, 26, 34, 26, 35, 26, 26, 26, 26, - 33, 33, 33, 36, 30, 25, 25, 1, 32, 5, - 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, - 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, - 38, 5, 39, 5, 40, 37, 4, 8, 8, 7, - 7, 2, 2, 3, 41, 3, 17, 17, 18, 18, - 19, 19, 42, 9, 9, 14, 14, 43, 43, 12, - 12, 13, 13, 44, 45, 45, 15, 15, 16, 16, - 6, 6, 20, 20, 20, 21, 29, 10, 10, 11, - 11, -}; -short luaY_len[] = { 2, - 2, 0, 3, 2, 3, 1, 3, 5, 0, 3, - 0, 1, 8, 0, 8, 0, 6, 3, 1, 3, - 0, 2, 7, 0, 3, 0, 3, 0, 1, 3, - 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, - 3, 3, 2, 1, 1, 1, 1, 1, 1, 2, - 0, 5, 0, 5, 0, 4, 2, 1, 3, 3, - 1, 0, 1, 1, 0, 4, 0, 1, 1, 3, - 1, 1, 0, 3, 2, 0, 2, 0, 1, 0, - 2, 1, 3, 3, 3, 1, 0, 2, 1, 3, - 1, 3, 1, 4, 3, 1, 1, 1, 3, 0, - 2, -}; -short luaY_defred[] = { 2, - 0, 0, 0, 14, 16, 0, 0, 0, 96, 19, - 0, 0, 0, 93, 1, 0, 4, 0, 48, 46, - 47, 0, 0, 0, 49, 29, 97, 0, 0, 44, - 0, 0, 24, 0, 0, 0, 0, 98, 0, 0, - 0, 0, 0, 0, 0, 57, 61, 12, 3, 0, - 0, 0, 0, 0, 0, 28, 28, 28, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 9, 27, 65, 0, 0, 20, 0, - 5, 0, 0, 0, 0, 0, 59, 0, 95, 30, - 24, 51, 53, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 73, - 0, 0, 82, 0, 28, 0, 0, 0, 0, 99, - 72, 71, 0, 0, 69, 7, 60, 94, 28, 0, - 0, 0, 56, 0, 75, 0, 0, 88, 0, 24, - 0, 25, 0, 0, 24, 0, 0, 0, 0, 85, - 86, 83, 0, 74, 0, 0, 28, 17, 10, 0, - 70, 24, 0, 0, 77, 0, 0, 8, 22, 0, - 13, 81, 15, 28, 24, 28, 0, 23, -}; -short luaY_dgoto[] = { 1, - 91, 34, 35, 25, 26, 11, 46, 12, 108, 39, - 79, 165, 109, 154, 110, 111, 123, 124, 125, 27, - 14, 41, 81, 2, 15, 16, 49, 17, 28, 73, - 117, 37, 164, 32, 33, 74, 30, 130, 131, 31, - 118, 136, 135, 113, 114, -}; -short luaY_sindex[] = { 0, - 0, 288, -34, 0, 0, -34, -238, -223, 0, 0, - -6, 22, 0, 0, 0, 14, 0, 150, 0, 0, - 0, -34, -34, -34, 0, 0, 0, 150, 547, 0, - -46, -34, 0, 14, 34, 0, 212, 0, -5, 0, - 39, 156, -34, -223, -34, 0, 0, 0, 0, -194, - -34, -193, -4, -4, 48, 0, 0, 0, -34, -34, - -34, -34, -34, -34, -34, -34, -34, -34, -34, -34, - -38, 481, -173, 0, 0, 0, -34, -146, 0, -234, - 0, -138, 34, 0, -15, 96, 0, 753, 0, 0, - 0, 0, 0, -30, -30, -30, -30, -30, -30, -20, - -12, -12, -4, -4, -4, 0, -34, 16, 95, 0, - 98, 212, 0, 82, 0, -34, 328, -34, 34, 0, - 0, 0, 103, 101, 0, 0, 0, 0, 0, -34, - -34, 1181, 0, -91, 0, 92, -34, 0, -34, 0, - 212, 0, 14, 0, 0, -234, -233, 118, 118, 0, - 0, 0, -91, 0, 212, 212, 0, 0, 0, -105, - 0, 0, -34, -103, 0, 95, -101, 0, 0, 1105, - 0, 0, 0, 0, 0, 0, -233, 0, -}; -short luaY_rindex[] = { 0, - 0, 169, 52, 0, 0, 173, 0, 0, 0, 0, - 0, 52, 508, 0, 0, 146, 0, -36, 0, 0, - 0, 52, 52, 52, 0, 0, 0, 1, 0, 0, - 0, 52, 0, 47, 461, 436, 0, 0, 197, 76, - 0, 0, 52, 0, -32, 0, 0, 0, 0, 0, - 52, 0, 24, 59, 1195, 0, 0, 0, 52, 52, - 52, 52, 52, 52, 52, 52, 52, 52, 52, 52, - -27, 0, 0, 0, 0, 0, 52, 0, 0, 129, - 0, 0, 311, 142, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 746, 776, 799, 821, 844, 866, 505, - 383, 410, 88, 112, 359, 1174, 52, 0, 51, 0, - -40, -10, 0, 0, 0, 52, -153, 52, 921, 0, - 0, 0, 0, 144, 0, 0, 0, 0, 0, 52, - 52, 0, 0, 62, 0, 64, -26, 0, 52, 0, - 939, 0, 682, 474, 0, 0, -77, 894, 1137, 0, - 0, 0, 66, 0, 13, -18, 0, 0, 0, 0, - 0, 0, 52, 0, 0, 51, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, -77, 0, -}; -short luaY_gindex[] = { 0, - 53, 147, -23, 3, 134, 0, 0, 0, 0, 0, - 0, 0, 40, 0, 0, 0, 0, 0, 49, 6, - 0, 0, 0, 0, 81, 83, -16, 0, 8, -70, - 0, 1445, 27, 0, 0, 0, 187, 0, 0, 0, - 0, 0, -108, 67, 0, -}; -#define YYTABLESIZE 1608 -short luaY_table[] = { 107, - 45, 24, 138, 58, 10, 24, 22, 13, 62, 18, - 22, 68, 66, 40, 67, 42, 69, 75, 78, 83, - 129, 68, 66, 43, 67, 84, 69, 162, 163, 68, - 52, 87, 79, 89, 69, 38, 121, 44, 78, 122, - 58, 45, 45, 45, 45, 45, 11, 45, 89, 84, - 9, 85, 107, 119, 43, 77, 90, 172, 50, 45, - 45, 45, 45, 70, 43, 43, 43, 43, 43, 157, - 43, 90, 48, 70, 160, 51, 71, 76, 80, 87, - 89, 70, 43, 43, 78, 43, 58, 39, 90, 70, - 55, 169, 116, 45, 45, 55, 55, 87, 79, 50, - 50, 50, 50, 50, 176, 50, 84, 26, 26, 92, - 93, 40, 26, 26, 89, 6, 43, 50, 50, 10, - 50, 97, 13, 58, 18, 45, 159, 120, 39, 39, - 39, 39, 39, 97, 39, 126, 127, 90, 134, 36, - 133, 137, 139, 145, 146, 11, 39, 39, 43, 39, - 153, 50, 40, 40, 40, 40, 40, 55, 40, 68, - 66, 168, 67, 171, 69, 173, 97, 140, 26, 67, - 40, 40, 62, 40, 55, 78, 36, 62, 36, 61, - 39, 147, 151, 50, 68, 92, 79, 97, 76, 21, - 80, 86, 166, 158, 161, 52, 100, 142, 47, 143, - 152, 52, 92, 178, 40, 0, 0, 50, 0, 167, - 36, 70, 39, 82, 0, 0, 0, 0, 0, 19, - 0, 0, 0, 19, 0, 0, 175, 0, 177, 0, - 0, 62, 97, 20, 21, 106, 40, 20, 21, 9, - 51, 0, 0, 0, 23, 0, 51, 0, 23, 0, - 65, 144, 0, 68, 66, 100, 67, 0, 69, 45, - 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, - 45, 62, 0, 61, 45, 45, 45, 45, 45, 45, - 45, 45, 43, 43, 43, 43, 43, 43, 43, 43, - 43, 43, 43, 43, 0, 55, 0, 43, 43, 43, - 43, 43, 43, 43, 43, 70, 0, 11, 11, 0, - 18, 0, 11, 11, 0, 0, 0, 50, 50, 50, - 50, 50, 50, 50, 50, 50, 50, 50, 50, 0, - 0, 0, 50, 50, 50, 50, 50, 50, 50, 50, - 0, 0, 0, 0, 0, 0, 39, 39, 39, 39, - 39, 39, 39, 39, 39, 39, 39, 39, 41, 0, - 0, 39, 39, 39, 39, 39, 39, 39, 39, 18, - 40, 40, 40, 40, 40, 40, 40, 40, 40, 40, - 40, 40, 37, 0, 0, 40, 40, 40, 40, 40, - 40, 40, 40, 0, 59, 60, 63, 64, 65, 41, - 41, 41, 41, 41, 11, 41, 0, 0, 11, 38, - 11, 0, 0, 11, 11, 11, 0, 41, 41, 11, - 41, 0, 0, 37, 0, 37, 37, 37, 0, 0, - 0, 0, 0, 62, 62, 64, 0, 0, 62, 62, - 0, 37, 37, 0, 37, 0, 0, 0, 0, 0, - 38, 41, 38, 38, 38, 100, 0, 100, 100, 100, - 63, 100, 100, 100, 100, 100, 100, 0, 38, 38, - 100, 38, 0, 66, 0, 37, 64, 29, 29, 64, - 29, 0, 29, 41, 0, 0, 57, 58, 59, 60, - 63, 64, 65, 0, 64, 29, 0, 29, 0, 0, - 0, 63, 38, 0, 42, 0, 0, 37, 0, 0, - 0, 0, 0, 0, 66, 29, 29, 66, 29, 63, - 29, 0, 68, 66, 0, 67, 0, 69, 0, 29, - 0, 0, 66, 29, 38, 29, 0, 0, 0, 0, - 62, 0, 61, 0, 0, 42, 3, 97, 42, 0, - 4, 91, 5, 97, 0, 6, 7, 8, 0, 0, - 0, 9, 0, 42, 42, 97, 42, 29, 91, 18, - 0, 18, 18, 18, 70, 18, 18, 18, 18, 18, - 18, 0, 0, 0, 18, 0, 3, 0, 68, 66, - 4, 67, 5, 69, 0, 6, 7, 42, 97, 0, - 0, 9, 0, 0, 0, 0, 62, 0, 61, 0, - 0, 0, 0, 0, 0, 0, 0, 41, 41, 41, - 41, 41, 41, 41, 41, 41, 41, 41, 41, 42, - 97, 0, 41, 41, 41, 41, 41, 41, 41, 41, - 70, 37, 37, 37, 37, 37, 37, 37, 37, 37, - 37, 37, 37, 0, 0, 0, 37, 37, 37, 37, - 37, 37, 37, 37, 0, 0, 0, 0, 38, 38, - 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, - 0, 0, 0, 38, 38, 38, 38, 38, 38, 38, - 38, 0, 0, 0, 64, 0, 64, 64, 64, 0, - 64, 64, 64, 64, 64, 64, 0, 0, 0, 64, - 29, 29, 29, 29, 29, 29, 29, 0, 0, 0, - 0, 63, 63, 0, 0, 0, 63, 63, 0, 0, - 0, 0, 66, 0, 66, 66, 66, 0, 66, 66, - 66, 66, 66, 66, 115, 31, 0, 66, 29, 29, - 29, 29, 29, 29, 29, 57, 58, 59, 60, 63, - 64, 65, 0, 42, 42, 42, 42, 42, 42, 42, - 42, 42, 42, 42, 42, 34, 0, 0, 42, 42, - 42, 42, 42, 42, 42, 42, 31, 0, 0, 31, - 0, 0, 0, 0, 68, 66, 0, 67, 33, 69, - 0, 0, 0, 0, 31, 31, 56, 31, 0, 0, - 0, 0, 62, 0, 61, 0, 34, 0, 0, 34, - 32, 57, 58, 59, 60, 63, 64, 65, 0, 0, - 0, 0, 0, 0, 34, 34, 0, 34, 31, 33, - 0, 0, 33, 35, 0, 128, 70, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 33, 33, 0, - 33, 32, 0, 0, 32, 36, 0, 0, 34, 0, - 31, 0, 0, 0, 0, 0, 0, 0, 0, 32, - 32, 0, 32, 0, 35, 0, 0, 35, 0, 0, - 0, 33, 0, 52, 0, 0, 0, 0, 0, 0, - 34, 0, 35, 35, 0, 35, 36, 0, 0, 36, - 0, 0, 0, 32, 0, 0, 0, 0, 0, 0, - 101, 0, 0, 33, 36, 36, 0, 36, 0, 0, - 0, 0, 0, 0, 52, 0, 35, 52, 28, 0, - 11, 0, 11, 11, 11, 32, 11, 11, 11, 11, - 11, 0, 52, 0, 0, 11, 0, 0, 36, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 35, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 101, - 0, 0, 0, 0, 0, 0, 52, 0, 0, 0, - 36, 0, 0, 0, 0, 0, 0, 28, 0, 0, - 0, 0, 0, 0, 31, 31, 31, 31, 31, 31, - 31, 31, 31, 31, 31, 31, 0, 0, 52, 31, - 31, 31, 31, 31, 31, 31, 0, 57, 58, 59, - 60, 63, 64, 65, 34, 34, 34, 34, 34, 34, - 34, 34, 34, 34, 34, 34, 0, 0, 0, 34, - 34, 34, 34, 34, 34, 34, 0, 33, 33, 33, - 33, 33, 33, 33, 33, 33, 33, 33, 33, 0, - 0, 0, 33, 33, 33, 33, 33, 33, 33, 32, - 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, - 32, 0, 0, 0, 32, 32, 32, 32, 32, 32, - 32, 0, 35, 35, 35, 35, 35, 35, 35, 35, - 35, 35, 35, 35, 0, 0, 0, 35, 35, 35, - 35, 35, 35, 35, 36, 36, 36, 36, 36, 36, - 36, 36, 36, 36, 36, 36, 54, 0, 0, 36, - 36, 36, 36, 36, 36, 36, 68, 66, 0, 67, - 0, 69, 52, 52, 52, 52, 52, 52, 52, 52, - 52, 52, 52, 52, 62, 0, 61, 52, 52, 52, - 0, 0, 0, 0, 0, 0, 0, 54, 0, 101, - 54, 101, 101, 101, 0, 101, 101, 101, 101, 101, - 101, 0, 0, 0, 101, 54, 0, 28, 70, 28, - 28, 28, 0, 28, 28, 28, 28, 28, 28, 0, - 0, 0, 28, 96, 0, 96, 96, 96, 96, 96, - 96, 0, 68, 66, 0, 67, 0, 69, 0, 54, - 0, 96, 96, 96, 86, 96, 29, 29, 0, 29, - 62, 29, 61, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 29, 0, 29, 0, 0, 0, - 0, 54, 0, 0, 96, 0, 0, 96, 0, 0, - 0, 0, 0, 150, 70, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 29, 0, - 0, 0, 0, 0, 0, 0, 96, 0, 96, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 174, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 57, - 58, 59, 60, 63, 64, 65, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 54, 54, 54, 54, 54, - 54, 54, 54, 54, 54, 54, 54, 0, 0, 0, - 54, 54, 54, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 29, 96, 96, - 96, 96, 96, 96, 96, 57, 58, 59, 60, 63, - 64, 65, 0, 0, 0, 0, 53, 54, 0, 29, - 29, 29, 29, 29, 29, 29, 72, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 88, 0, 0, 0, 0, - 0, 0, 0, 94, 95, 96, 97, 98, 99, 100, - 101, 102, 103, 104, 105, 112, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 132, 0, 0, 0, 0, 0, 0, 0, 0, - 141, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 148, 149, 0, 0, 0, 0, - 0, 155, 0, 156, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 170, -}; -short luaY_check[] = { 91, - 0, 40, 111, 40, 2, 40, 45, 2, 41, 2, - 45, 42, 43, 8, 45, 8, 47, 34, 59, 43, - 91, 42, 43, 0, 45, 44, 47, 261, 262, 42, - 46, 59, 59, 44, 47, 274, 271, 44, 44, 274, - 40, 41, 42, 43, 44, 45, 0, 47, 59, 44, - 274, 44, 91, 77, 61, 61, 44, 166, 0, 59, - 60, 40, 62, 94, 41, 42, 43, 44, 45, 140, - 47, 59, 59, 94, 145, 91, 123, 44, 40, 274, - 274, 94, 59, 60, 125, 62, 123, 0, 41, 94, - 123, 162, 266, 93, 94, 123, 123, 125, 125, 41, - 42, 43, 44, 45, 175, 47, 125, 261, 262, 57, - 58, 0, 266, 267, 125, 40, 93, 59, 60, 117, - 62, 46, 117, 123, 117, 125, 143, 274, 41, 42, - 43, 44, 45, 58, 47, 274, 41, 125, 44, 6, - 125, 44, 61, 41, 44, 0, 59, 60, 125, 62, - 59, 93, 41, 42, 43, 44, 45, 24, 47, 42, - 43, 267, 45, 267, 47, 267, 91, 115, 0, 41, - 59, 60, 0, 62, 123, 125, 43, 60, 45, 62, - 93, 129, 274, 125, 41, 44, 125, 46, 125, 267, - 125, 45, 153, 141, 146, 46, 0, 117, 12, 117, - 134, 46, 61, 177, 93, -1, -1, 58, -1, 157, - 77, 94, 125, 58, -1, -1, -1, -1, -1, 258, - -1, -1, -1, 258, -1, -1, 174, -1, 176, -1, - -1, 59, 91, 272, 273, 274, 125, 272, 273, 274, - 91, -1, -1, -1, 283, -1, 91, -1, 283, -1, - 281, 118, -1, 42, 43, 59, 45, -1, 47, 259, - 260, 261, 262, 263, 264, 265, 266, 267, 268, 269, - 270, 60, -1, 62, 274, 275, 276, 277, 278, 279, - 280, 281, 259, 260, 261, 262, 263, 264, 265, 266, - 267, 268, 269, 270, -1, 123, -1, 274, 275, 276, - 277, 278, 279, 280, 281, 94, -1, 261, 262, -1, - 0, -1, 266, 267, -1, -1, -1, 259, 260, 261, - 262, 263, 264, 265, 266, 267, 268, 269, 270, -1, - -1, -1, 274, 275, 276, 277, 278, 279, 280, 281, - -1, -1, -1, -1, -1, -1, 259, 260, 261, 262, - 263, 264, 265, 266, 267, 268, 269, 270, 0, -1, - -1, 274, 275, 276, 277, 278, 279, 280, 281, 59, - 259, 260, 261, 262, 263, 264, 265, 266, 267, 268, - 269, 270, 0, -1, -1, 274, 275, 276, 277, 278, - 279, 280, 281, -1, 277, 278, 279, 280, 281, 41, - 42, 43, 44, 45, 259, 47, -1, -1, 263, 0, - 265, -1, -1, 268, 269, 270, -1, 59, 60, 274, - 62, -1, -1, 41, -1, 43, 44, 45, -1, -1, - -1, -1, -1, 261, 262, 0, -1, -1, 266, 267, - -1, 59, 60, -1, 62, -1, -1, -1, -1, -1, - 41, 93, 43, 44, 45, 259, -1, 261, 262, 263, - 0, 265, 266, 267, 268, 269, 270, -1, 59, 60, - 274, 62, -1, 0, -1, 93, 41, 42, 43, 44, - 45, -1, 47, 125, -1, -1, 275, 276, 277, 278, - 279, 280, 281, -1, 59, 60, -1, 62, -1, -1, - -1, 41, 93, -1, 0, -1, -1, 125, -1, -1, - -1, -1, -1, -1, 41, 42, 43, 44, 45, 59, - 47, -1, 42, 43, -1, 45, -1, 47, -1, 94, - -1, -1, 59, 60, 125, 62, -1, -1, -1, -1, - 60, -1, 62, -1, -1, 41, 259, 40, 44, -1, - 263, 44, 265, 46, -1, 268, 269, 270, -1, -1, - -1, 274, -1, 59, 60, 58, 62, 94, 61, 259, - -1, 261, 262, 263, 94, 265, 266, 267, 268, 269, - 270, -1, -1, -1, 274, -1, 259, -1, 42, 43, - 263, 45, 265, 47, -1, 268, 269, 93, 91, -1, - -1, 274, -1, -1, -1, -1, 60, -1, 62, -1, - -1, -1, -1, -1, -1, -1, -1, 259, 260, 261, - 262, 263, 264, 265, 266, 267, 268, 269, 270, 125, - 123, -1, 274, 275, 276, 277, 278, 279, 280, 281, - 94, 259, 260, 261, 262, 263, 264, 265, 266, 267, - 268, 269, 270, -1, -1, -1, 274, 275, 276, 277, - 278, 279, 280, 281, -1, -1, -1, -1, 259, 260, - 261, 262, 263, 264, 265, 266, 267, 268, 269, 270, - -1, -1, -1, 274, 275, 276, 277, 278, 279, 280, - 281, -1, -1, -1, 259, -1, 261, 262, 263, -1, - 265, 266, 267, 268, 269, 270, -1, -1, -1, 274, - 275, 276, 277, 278, 279, 280, 281, -1, -1, -1, - -1, 261, 262, -1, -1, -1, 266, 267, -1, -1, - -1, -1, 259, -1, 261, 262, 263, -1, 265, 266, - 267, 268, 269, 270, 264, 0, -1, 274, 275, 276, - 277, 278, 279, 280, 281, 275, 276, 277, 278, 279, - 280, 281, -1, 259, 260, 261, 262, 263, 264, 265, - 266, 267, 268, 269, 270, 0, -1, -1, 274, 275, - 276, 277, 278, 279, 280, 281, 41, -1, -1, 44, - -1, -1, -1, -1, 42, 43, -1, 45, 0, 47, - -1, -1, -1, -1, 59, 60, 260, 62, -1, -1, - -1, -1, 60, -1, 62, -1, 41, -1, -1, 44, - 0, 275, 276, 277, 278, 279, 280, 281, -1, -1, - -1, -1, -1, -1, 59, 60, -1, 62, 93, 41, - -1, -1, 44, 0, -1, 93, 94, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 59, 60, -1, - 62, 41, -1, -1, 44, 0, -1, -1, 93, -1, - 125, -1, -1, -1, -1, -1, -1, -1, -1, 59, - 60, -1, 62, -1, 41, -1, -1, 44, -1, -1, - -1, 93, -1, 0, -1, -1, -1, -1, -1, -1, - 125, -1, 59, 60, -1, 62, 41, -1, -1, 44, - -1, -1, -1, 93, -1, -1, -1, -1, -1, -1, - 0, -1, -1, 125, 59, 60, -1, 62, -1, -1, - -1, -1, -1, -1, 41, -1, 93, 44, 0, -1, - 259, -1, 261, 262, 263, 125, 265, 266, 267, 268, - 269, -1, 59, -1, -1, 274, -1, -1, 93, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 125, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 59, - -1, -1, -1, -1, -1, -1, 93, -1, -1, -1, - 125, -1, -1, -1, -1, -1, -1, 59, -1, -1, - -1, -1, -1, -1, 259, 260, 261, 262, 263, 264, - 265, 266, 267, 268, 269, 270, -1, -1, 125, 274, - 275, 276, 277, 278, 279, 280, -1, 275, 276, 277, - 278, 279, 280, 281, 259, 260, 261, 262, 263, 264, - 265, 266, 267, 268, 269, 270, -1, -1, -1, 274, - 275, 276, 277, 278, 279, 280, -1, 259, 260, 261, - 262, 263, 264, 265, 266, 267, 268, 269, 270, -1, - -1, -1, 274, 275, 276, 277, 278, 279, 280, 259, - 260, 261, 262, 263, 264, 265, 266, 267, 268, 269, - 270, -1, -1, -1, 274, 275, 276, 277, 278, 279, - 280, -1, 259, 260, 261, 262, 263, 264, 265, 266, - 267, 268, 269, 270, -1, -1, -1, 274, 275, 276, - 277, 278, 279, 280, 259, 260, 261, 262, 263, 264, - 265, 266, 267, 268, 269, 270, 0, -1, -1, 274, - 275, 276, 277, 278, 279, 280, 42, 43, -1, 45, - -1, 47, 259, 260, 261, 262, 263, 264, 265, 266, - 267, 268, 269, 270, 60, -1, 62, 274, 275, 276, - -1, -1, -1, -1, -1, -1, -1, 41, -1, 259, - 44, 261, 262, 263, -1, 265, 266, 267, 268, 269, - 270, -1, -1, -1, 274, 59, -1, 259, 94, 261, - 262, 263, -1, 265, 266, 267, 268, 269, 270, -1, - -1, -1, 274, 40, -1, 42, 43, 44, 45, 46, - 47, -1, 42, 43, -1, 45, -1, 47, -1, 93, - -1, 58, 59, 60, 61, 62, 42, 43, -1, 45, - 60, 47, 62, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 60, -1, 62, -1, -1, -1, - -1, 125, -1, -1, 91, -1, -1, 94, -1, -1, - -1, -1, -1, 93, 94, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 94, -1, - -1, -1, -1, -1, -1, -1, 123, -1, 125, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 260, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 275, - 276, 277, 278, 279, 280, 281, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 259, 260, 261, 262, 263, - 264, 265, 266, 267, 268, 269, 270, -1, -1, -1, - 274, 275, 276, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 3, 275, 276, - 277, 278, 279, 280, 281, 275, 276, 277, 278, 279, - 280, 281, -1, -1, -1, -1, 22, 23, -1, 275, - 276, 277, 278, 279, 280, 281, 32, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 51, -1, -1, -1, -1, - -1, -1, -1, 59, 60, 61, 62, 63, 64, 65, - 66, 67, 68, 69, 70, 71, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 107, -1, -1, -1, -1, -1, -1, -1, -1, - 116, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 130, 131, -1, -1, -1, -1, - -1, 137, -1, 139, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 163, -}; -#define YYFINAL 1 -#ifndef YYDEBUG -#define YYDEBUG 0 -#endif -#define YYMAXTOKEN 283 -#if YYDEBUG -char *luaY_name[] = { -"end-of-file",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, -0,0,0,0,0,0,"'('","')'","'*'","'+'","','","'-'","'.'","'/'",0,0,0,0,0,0,0,0,0,0, -"':'","';'","'<'","'='","'>'",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, -0,0,0,"'['",0,"']'","'^'",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, -0,"'{'",0,"'}'",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, -0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, -0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, -0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,"WRONGTOKEN","NIL","IF","THEN","ELSE", -"ELSEIF","WHILE","DO","REPEAT","UNTIL","END","RETURN","LOCAL","FUNCTION","DOTS", -"NUMBER","STRING","NAME","AND","OR","EQ","NE","LE","GE","CONC","UNARY","NOT", -}; -char *luaY_rule[] = { -"$accept : chunk", -"chunk : chunklist ret", -"chunklist :", -"chunklist : chunklist stat sc", -"chunklist : chunklist function", -"function : FUNCTION funcname body", -"funcname : var", -"funcname : varexp ':' NAME", -"body : '(' parlist ')' block END", -"statlist :", -"statlist : statlist stat sc", -"sc :", -"sc : ';'", -"stat : IF expr1 THEN PrepJump block PrepJump elsepart END", -"$$1 :", -"stat : WHILE $$1 expr1 DO PrepJump block PrepJump END", -"$$2 :", -"stat : REPEAT $$2 block UNTIL expr1 PrepJump", -"stat : varlist1 '=' exprlist1", -"stat : functioncall", -"stat : LOCAL localdeclist decinit", -"elsepart :", -"elsepart : ELSE block", -"elsepart : ELSEIF expr1 THEN PrepJump block PrepJump elsepart", -"$$3 :", -"block : $$3 statlist ret", -"ret :", -"ret : RETURN exprlist sc", -"PrepJump :", -"expr1 : expr", -"expr : '(' expr ')'", -"expr : expr1 EQ expr1", -"expr : expr1 '<' expr1", -"expr : expr1 '>' expr1", -"expr : expr1 NE expr1", -"expr : expr1 LE expr1", -"expr : expr1 GE expr1", -"expr : expr1 '+' expr1", -"expr : expr1 '-' expr1", -"expr : expr1 '*' expr1", -"expr : expr1 '/' expr1", -"expr : expr1 '^' expr1", -"expr : expr1 CONC expr1", -"expr : '-' expr1", -"expr : table", -"expr : varexp", -"expr : NUMBER", -"expr : STRING", -"expr : NIL", -"expr : functioncall", -"expr : NOT expr1", -"$$4 :", -"expr : expr1 AND PrepJump $$4 expr1", -"$$5 :", -"expr : expr1 OR PrepJump $$5 expr1", -"$$6 :", -"table : $$6 '{' fieldlist '}'", -"functioncall : funcvalue funcParams", -"funcvalue : varexp", -"funcvalue : varexp ':' NAME", -"funcParams : '(' exprlist ')'", -"funcParams : table", -"exprlist :", -"exprlist : exprlist1", -"exprlist1 : expr", -"$$7 :", -"exprlist1 : exprlist1 ',' $$7 expr", -"parlist :", -"parlist : parlist1", -"parlist1 : par", -"parlist1 : parlist1 ',' par", -"par : NAME", -"par : DOTS", -"$$8 :", -"fieldlist : lfieldlist $$8 semicolonpart", -"fieldlist : ffieldlist1 lastcomma", -"semicolonpart :", -"semicolonpart : ';' ffieldlist", -"lastcomma :", -"lastcomma : ','", -"ffieldlist :", -"ffieldlist : ffieldlist1 lastcomma", -"ffieldlist1 : ffield", -"ffieldlist1 : ffieldlist1 ',' ffield", -"ffield : ffieldkey '=' expr1", -"ffieldkey : '[' expr1 ']'", -"ffieldkey : NAME", -"lfieldlist :", -"lfieldlist : lfieldlist1 lastcomma", -"lfieldlist1 : expr1", -"lfieldlist1 : lfieldlist1 ',' expr1", -"varlist1 : var", -"varlist1 : varlist1 ',' var", -"var : singlevar", -"var : varexp '[' expr1 ']'", -"var : varexp '.' NAME", -"singlevar : NAME", -"varexp : var", -"localdeclist : NAME", -"localdeclist : localdeclist ',' NAME", -"decinit :", -"decinit : '=' exprlist1", -}; -#endif -#ifdef YYSTACKSIZE -#undef YYMAXDEPTH -#define YYMAXDEPTH YYSTACKSIZE -#else -#ifdef YYMAXDEPTH -#define YYSTACKSIZE YYMAXDEPTH -#else -#define YYSTACKSIZE 500 -#define YYMAXDEPTH 500 -#endif -#endif -int luaY_debug; -int luaY_nerrs; -int luaY_errflag; -int luaY_char; -short *luaY_ssp; -YYSTYPE *luaY_vsp; -YYSTYPE luaY_val; -YYSTYPE luaY_lval; -short luaY_ss[YYSTACKSIZE]; -YYSTYPE luaY_vs[YYSTACKSIZE]; -#define luaY_stacksize YYSTACKSIZE -#define YYABORT goto luaY_abort -#define YYREJECT goto luaY_abort -#define YYACCEPT goto luaY_accept -#define YYERROR goto luaY_errlab -int -luaY_parse() -{ - register int luaY_m, luaY_n, luaY_state; -#if YYDEBUG - register char *luaY_s; - extern char *getenv(); - - if (luaY_s = getenv("YYDEBUG")) - { - luaY_n = *luaY_s; - if (luaY_n >= '0' && luaY_n <= '9') - luaY_debug = luaY_n - '0'; - } -#endif - - luaY_nerrs = 0; - luaY_errflag = 0; - luaY_char = (-1); - - luaY_ssp = luaY_ss; - luaY_vsp = luaY_vs; - *luaY_ssp = luaY_state = 0; - -luaY_loop: - if (luaY_n = luaY_defred[luaY_state]) goto luaY_reduce; - if (luaY_char < 0) - { - if ((luaY_char = luaY_lex()) < 0) luaY_char = 0; -#if YYDEBUG - if (luaY_debug) - { - luaY_s = 0; - if (luaY_char <= YYMAXTOKEN) luaY_s = luaY_name[luaY_char]; - if (!luaY_s) luaY_s = "illegal-symbol"; - printf("%sdebug: state %d, reading %d (%s)\n", - YYPREFIX, luaY_state, luaY_char, luaY_s); - } -#endif - } - if ((luaY_n = luaY_sindex[luaY_state]) && (luaY_n += luaY_char) >= 0 && - luaY_n <= YYTABLESIZE && luaY_check[luaY_n] == luaY_char) - { -#if YYDEBUG - if (luaY_debug) - printf("%sdebug: state %d, shifting to state %d\n", - YYPREFIX, luaY_state, luaY_table[luaY_n]); -#endif - if (luaY_ssp >= luaY_ss + luaY_stacksize - 1) - { - goto luaY_overflow; - } - *++luaY_ssp = luaY_state = luaY_table[luaY_n]; - *++luaY_vsp = luaY_lval; - luaY_char = (-1); - if (luaY_errflag > 0) --luaY_errflag; - goto luaY_loop; - } - if ((luaY_n = luaY_rindex[luaY_state]) && (luaY_n += luaY_char) >= 0 && - luaY_n <= YYTABLESIZE && luaY_check[luaY_n] == luaY_char) - { - luaY_n = luaY_table[luaY_n]; - goto luaY_reduce; - } - if (luaY_errflag) goto luaY_inrecovery; -#ifdef lint - goto luaY_newerror; -#endif -luaY_newerror: - luaY_error("syntax error"); -#ifdef lint - goto luaY_errlab; -#endif -luaY_errlab: - ++luaY_nerrs; -luaY_inrecovery: - if (luaY_errflag < 3) - { - luaY_errflag = 3; - for (;;) - { - if ((luaY_n = luaY_sindex[*luaY_ssp]) && (luaY_n += YYERRCODE) >= 0 && - luaY_n <= YYTABLESIZE && luaY_check[luaY_n] == YYERRCODE) - { -#if YYDEBUG - if (luaY_debug) - printf("%sdebug: state %d, error recovery shifting\ - to state %d\n", YYPREFIX, *luaY_ssp, luaY_table[luaY_n]); -#endif - if (luaY_ssp >= luaY_ss + luaY_stacksize - 1) - { - goto luaY_overflow; - } - *++luaY_ssp = luaY_state = luaY_table[luaY_n]; - *++luaY_vsp = luaY_lval; - goto luaY_loop; - } - else - { -#if YYDEBUG - if (luaY_debug) - printf("%sdebug: error recovery discarding state %d\n", - YYPREFIX, *luaY_ssp); -#endif - if (luaY_ssp <= luaY_ss) goto luaY_abort; - --luaY_ssp; - --luaY_vsp; - } - } - } - else - { - if (luaY_char == 0) goto luaY_abort; -#if YYDEBUG - if (luaY_debug) - { - luaY_s = 0; - if (luaY_char <= YYMAXTOKEN) luaY_s = luaY_name[luaY_char]; - if (!luaY_s) luaY_s = "illegal-symbol"; - printf("%sdebug: state %d, error recovery discards token %d (%s)\n", - YYPREFIX, luaY_state, luaY_char, luaY_s); - } -#endif - luaY_char = (-1); - goto luaY_loop; - } -luaY_reduce: -#if YYDEBUG - if (luaY_debug) - printf("%sdebug: state %d, reducing by rule %d (%s)\n", - YYPREFIX, luaY_state, luaY_n, luaY_rule[luaY_n]); -#endif - luaY_m = luaY_len[luaY_n]; - luaY_val = luaY_vsp[1-luaY_m]; - switch (luaY_n) - { -case 5: -#line 468 "lua.stx" -{ - code_byte(PUSHFUNCTION); - code_code(luaY_vsp[0].pFunc); - storesinglevar(luaY_vsp[-1].vLong); - } -break; -case 6: -#line 475 "lua.stx" -{ luaY_val.vLong =luaY_vsp[0].vLong; init_func(); } -break; -case 7: -#line 477 "lua.stx" -{ - code_constant(luaY_vsp[0].pTStr); - luaY_val.vLong = 0; /* indexed variable */ - init_func(); - add_localvar(luaI_createfixedstring("self")); - } -break; -case 8: -#line 486 "lua.stx" -{ - codereturn(); - luaY_val.pFunc = new(TFunc); - luaI_initTFunc(luaY_val.pFunc); - luaY_val.pFunc->size = pc; - luaY_val.pFunc->code = newvector(pc, Byte); - luaY_val.pFunc->lineDefined = luaY_vsp[-3].vInt; - memcpy(luaY_val.pFunc->code, basepc, pc*sizeof(Byte)); - if (lua_debug) - luaI_closelocalvars(luaY_val.pFunc); - /* save func values */ - funcCode = basepc; maxcode=maxcurr; -#if LISTING - PrintCode(funcCode,funcCode+pc); -#endif - change2main(); /* change back to main code */ - } -break; -case 13: -#line 512 "lua.stx" -{ codeIf(luaY_vsp[-4].vLong, luaY_vsp[-2].vLong); } -break; -case 14: -#line 514 "lua.stx" -{luaY_val.vLong=pc;} -break; -case 15: -#line 515 "lua.stx" -{ - basepc[luaY_vsp[-3].vLong] = IFFJMP; - code_word_at(basepc+luaY_vsp[-3].vLong+1, pc - (luaY_vsp[-3].vLong + sizeof(Word)+1)); - basepc[luaY_vsp[-1].vLong] = UPJMP; - code_word_at(basepc+luaY_vsp[-1].vLong+1, pc - (luaY_vsp[-6].vLong)); - } -break; -case 16: -#line 522 "lua.stx" -{luaY_val.vLong=pc;} -break; -case 17: -#line 523 "lua.stx" -{ - basepc[luaY_vsp[0].vLong] = IFFUPJMP; - code_word_at(basepc+luaY_vsp[0].vLong+1, pc - (luaY_vsp[-4].vLong)); - } -break; -case 18: -#line 529 "lua.stx" -{ - { - int i; - adjust_mult_assign(nvarbuffer, luaY_vsp[0].vLong, luaY_vsp[-2].vInt * 2 + nvarbuffer); - for (i=nvarbuffer-1; i>=0; i--) - lua_codestore (i); - if (luaY_vsp[-2].vInt > 1 || (luaY_vsp[-2].vInt == 1 && varbuffer[0] != 0)) - lua_codeadjust (0); - } - } -break; -case 19: -#line 539 "lua.stx" -{;} -break; -case 20: -#line 541 "lua.stx" -{ nlocalvar += luaY_vsp[-1].vInt; - adjust_mult_assign(luaY_vsp[-1].vInt, luaY_vsp[0].vInt, 0); - } -break; -case 23: -#line 549 "lua.stx" -{ codeIf(luaY_vsp[-3].vLong, luaY_vsp[-1].vLong); } -break; -case 24: -#line 552 "lua.stx" -{luaY_val.vInt = nlocalvar;} -break; -case 25: -#line 553 "lua.stx" -{ - if (nlocalvar != luaY_vsp[-2].vInt) - { - if (lua_debug) - for (; nlocalvar > luaY_vsp[-2].vInt; nlocalvar--) - luaI_unregisterlocalvar(lua_linenumber); - else - nlocalvar = luaY_vsp[-2].vInt; - lua_codeadjust (0); - } - } -break; -case 27: -#line 568 "lua.stx" -{ - adjust_functioncall(luaY_vsp[-1].vLong, MULT_RET); - codereturn(); - } -break; -case 28: -#line 575 "lua.stx" -{ - luaY_val.vLong = pc; - code_byte(0); /* open space */ - code_word (0); - } -break; -case 29: -#line 582 "lua.stx" -{ adjust_functioncall(luaY_vsp[0].vLong, 1); } -break; -case 30: -#line 585 "lua.stx" -{ luaY_val.vLong = luaY_vsp[-1].vLong; } -break; -case 31: -#line 586 "lua.stx" -{ code_byte(EQOP); luaY_val.vLong = 0; } -break; -case 32: -#line 587 "lua.stx" -{ code_byte(LTOP); luaY_val.vLong = 0; } -break; -case 33: -#line 588 "lua.stx" -{ code_byte(GTOP); luaY_val.vLong = 0; } -break; -case 34: -#line 589 "lua.stx" -{ code_byte(EQOP); code_byte(NOTOP); luaY_val.vLong = 0; } -break; -case 35: -#line 590 "lua.stx" -{ code_byte(LEOP); luaY_val.vLong = 0; } -break; -case 36: -#line 591 "lua.stx" -{ code_byte(GEOP); luaY_val.vLong = 0; } -break; -case 37: -#line 592 "lua.stx" -{ code_byte(ADDOP); luaY_val.vLong = 0; } -break; -case 38: -#line 593 "lua.stx" -{ code_byte(SUBOP); luaY_val.vLong = 0; } -break; -case 39: -#line 594 "lua.stx" -{ code_byte(MULTOP); luaY_val.vLong = 0; } -break; -case 40: -#line 595 "lua.stx" -{ code_byte(DIVOP); luaY_val.vLong = 0; } -break; -case 41: -#line 596 "lua.stx" -{ code_byte(POWOP); luaY_val.vLong = 0; } -break; -case 42: -#line 597 "lua.stx" -{ code_byte(CONCOP); luaY_val.vLong = 0; } -break; -case 43: -#line 598 "lua.stx" -{ code_byte(MINUSOP); luaY_val.vLong = 0;} -break; -case 44: -#line 599 "lua.stx" -{ luaY_val.vLong = 0; } -break; -case 45: -#line 600 "lua.stx" -{ luaY_val.vLong = 0;} -break; -case 46: -#line 601 "lua.stx" -{ code_number(luaY_vsp[0].vFloat); luaY_val.vLong = 0; } -break; -case 47: -#line 603 "lua.stx" -{ - code_string(luaY_vsp[0].vWord); - luaY_val.vLong = 0; - } -break; -case 48: -#line 607 "lua.stx" -{code_byte(PUSHNIL); luaY_val.vLong = 0; } -break; -case 49: -#line 608 "lua.stx" -{ luaY_val.vLong = luaY_vsp[0].vLong; } -break; -case 50: -#line 609 "lua.stx" -{ code_byte(NOTOP); luaY_val.vLong = 0;} -break; -case 51: -#line 610 "lua.stx" -{code_byte(POP); } -break; -case 52: -#line 611 "lua.stx" -{ - basepc[luaY_vsp[-2].vLong] = ONFJMP; - code_word_at(basepc+luaY_vsp[-2].vLong+1, pc - (luaY_vsp[-2].vLong + sizeof(Word)+1)); - luaY_val.vLong = 0; - } -break; -case 53: -#line 616 "lua.stx" -{code_byte(POP); } -break; -case 54: -#line 617 "lua.stx" -{ - basepc[luaY_vsp[-2].vLong] = ONTJMP; - code_word_at(basepc+luaY_vsp[-2].vLong+1, pc - (luaY_vsp[-2].vLong + sizeof(Word)+1)); - luaY_val.vLong = 0; - } -break; -case 55: -#line 625 "lua.stx" -{ - code_byte(CREATEARRAY); - luaY_val.vLong = pc; code_word(0); - } -break; -case 56: -#line 630 "lua.stx" -{ - code_word_at(basepc+luaY_vsp[-3].vLong, luaY_vsp[-1].vInt); - } -break; -case 57: -#line 636 "lua.stx" -{ - code_byte(CALLFUNC); - code_byte(luaY_vsp[-1].vInt+luaY_vsp[0].vInt); - luaY_val.vLong = pc; - code_byte(0); /* may be modified by other rules */ - } -break; -case 58: -#line 644 "lua.stx" -{ luaY_val.vInt = 0; } -break; -case 59: -#line 646 "lua.stx" -{ - code_byte(PUSHSELF); - code_word(luaI_findconstant(luaY_vsp[0].pTStr)); - luaY_val.vInt = 1; - } -break; -case 60: -#line 654 "lua.stx" -{ luaY_val.vInt = adjust_functioncall(luaY_vsp[-1].vLong, 1); } -break; -case 61: -#line 655 "lua.stx" -{ luaY_val.vInt = 1; } -break; -case 62: -#line 658 "lua.stx" -{ luaY_val.vLong = 0; } -break; -case 63: -#line 659 "lua.stx" -{ luaY_val.vLong = luaY_vsp[0].vLong; } -break; -case 64: -#line 662 "lua.stx" -{ if (luaY_vsp[0].vLong != 0) luaY_val.vLong = luaY_vsp[0].vLong; else luaY_val.vLong = -1; } -break; -case 65: -#line 663 "lua.stx" -{ luaY_val.vLong = adjust_functioncall(luaY_vsp[-1].vLong, 1); } -break; -case 66: -#line 664 "lua.stx" -{ - if (luaY_vsp[0].vLong == 0) luaY_val.vLong = -(luaY_vsp[-1].vLong + 1); /* -length */ - else - { - adjust_functioncall(luaY_vsp[0].vLong, luaY_vsp[-1].vLong); - luaY_val.vLong = luaY_vsp[0].vLong; - } - } -break; -case 67: -#line 674 "lua.stx" -{ luaY_val.vInt = close_parlist(0); } -break; -case 68: -#line 675 "lua.stx" -{ luaY_val.vInt = close_parlist(luaY_vsp[0].vInt); } -break; -case 69: -#line 678 "lua.stx" -{ luaY_val.vInt = luaY_vsp[0].vInt; } -break; -case 70: -#line 680 "lua.stx" -{ - if (luaY_vsp[-2].vInt) - lua_error("invalid parameter list"); - luaY_val.vInt = luaY_vsp[0].vInt; - } -break; -case 71: -#line 687 "lua.stx" -{ add_localvar(luaY_vsp[0].pTStr); luaY_val.vInt = 0; } -break; -case 72: -#line 688 "lua.stx" -{ luaY_val.vInt = 1; } -break; -case 73: -#line 692 "lua.stx" -{ flush_list(luaY_vsp[0].vInt/FIELDS_PER_FLUSH, luaY_vsp[0].vInt%FIELDS_PER_FLUSH); } -break; -case 74: -#line 694 "lua.stx" -{ luaY_val.vInt = luaY_vsp[-2].vInt+luaY_vsp[0].vInt; } -break; -case 75: -#line 696 "lua.stx" -{ luaY_val.vInt = luaY_vsp[-1].vInt; flush_record(luaY_vsp[-1].vInt%FIELDS_PER_FLUSH); } -break; -case 76: -#line 700 "lua.stx" -{ luaY_val.vInt = 0; } -break; -case 77: -#line 702 "lua.stx" -{ luaY_val.vInt = luaY_vsp[0].vInt; flush_record(luaY_vsp[0].vInt%FIELDS_PER_FLUSH); } -break; -case 80: -#line 709 "lua.stx" -{ luaY_val.vInt = 0; } -break; -case 81: -#line 710 "lua.stx" -{ luaY_val.vInt = luaY_vsp[-1].vInt; } -break; -case 82: -#line 713 "lua.stx" -{luaY_val.vInt=1;} -break; -case 83: -#line 715 "lua.stx" -{ - luaY_val.vInt=luaY_vsp[-2].vInt+1; - if (luaY_val.vInt%FIELDS_PER_FLUSH == 0) flush_record(FIELDS_PER_FLUSH); - } -break; -case 86: -#line 725 "lua.stx" -{ code_constant(luaY_vsp[0].pTStr); } -break; -case 87: -#line 728 "lua.stx" -{ luaY_val.vInt = 0; } -break; -case 88: -#line 729 "lua.stx" -{ luaY_val.vInt = luaY_vsp[-1].vInt; } -break; -case 89: -#line 732 "lua.stx" -{luaY_val.vInt=1;} -break; -case 90: -#line 734 "lua.stx" -{ - luaY_val.vInt=luaY_vsp[-2].vInt+1; - if (luaY_val.vInt%FIELDS_PER_FLUSH == 0) - flush_list(luaY_val.vInt/FIELDS_PER_FLUSH - 1, FIELDS_PER_FLUSH); - } -break; -case 91: -#line 742 "lua.stx" -{ - nvarbuffer = 0; - add_varbuffer(luaY_vsp[0].vLong); - luaY_val.vInt = (luaY_vsp[0].vLong == 0) ? 1 : 0; - } -break; -case 92: -#line 748 "lua.stx" -{ - add_varbuffer(luaY_vsp[0].vLong); - luaY_val.vInt = (luaY_vsp[0].vLong == 0) ? luaY_vsp[-2].vInt + 1 : luaY_vsp[-2].vInt; - } -break; -case 93: -#line 754 "lua.stx" -{ luaY_val.vLong = luaY_vsp[0].vLong; } -break; -case 94: -#line 756 "lua.stx" -{ - luaY_val.vLong = 0; /* indexed variable */ - } -break; -case 95: -#line 760 "lua.stx" -{ - code_constant(luaY_vsp[0].pTStr); - luaY_val.vLong = 0; /* indexed variable */ - } -break; -case 96: -#line 767 "lua.stx" -{ - int local = lua_localname(luaY_vsp[0].pTStr); - if (local == -1) /* global var */ - luaY_val.vLong = luaI_findsymbol(luaY_vsp[0].pTStr)+1; /* return positive value */ - else - luaY_val.vLong = -(local+1); /* return negative value */ - } -break; -case 97: -#line 776 "lua.stx" -{ lua_pushvar(luaY_vsp[0].vLong); } -break; -case 98: -#line 779 "lua.stx" -{store_localvar(luaY_vsp[0].pTStr, 0); luaY_val.vInt = 1;} -break; -case 99: -#line 781 "lua.stx" -{ - store_localvar(luaY_vsp[0].pTStr, luaY_vsp[-2].vInt); - luaY_val.vInt = luaY_vsp[-2].vInt+1; - } -break; -case 100: -#line 787 "lua.stx" -{ luaY_val.vInt = 0; } -break; -case 101: -#line 788 "lua.stx" -{ luaY_val.vInt = luaY_vsp[0].vLong; } -break; -#line 1641 "y.tab.c" - } - luaY_ssp -= luaY_m; - luaY_state = *luaY_ssp; - luaY_vsp -= luaY_m; - luaY_m = luaY_lhs[luaY_n]; - if (luaY_state == 0 && luaY_m == 0) - { -#if YYDEBUG - if (luaY_debug) - printf("%sdebug: after reduction, shifting from state 0 to\ - state %d\n", YYPREFIX, YYFINAL); -#endif - luaY_state = YYFINAL; - *++luaY_ssp = YYFINAL; - *++luaY_vsp = luaY_val; - if (luaY_char < 0) - { - if ((luaY_char = luaY_lex()) < 0) luaY_char = 0; -#if YYDEBUG - if (luaY_debug) - { - luaY_s = 0; - if (luaY_char <= YYMAXTOKEN) luaY_s = luaY_name[luaY_char]; - if (!luaY_s) luaY_s = "illegal-symbol"; - printf("%sdebug: state %d, reading %d (%s)\n", - YYPREFIX, YYFINAL, luaY_char, luaY_s); - } -#endif - } - if (luaY_char == 0) goto luaY_accept; - goto luaY_loop; - } - if ((luaY_n = luaY_gindex[luaY_m]) && (luaY_n += luaY_state) >= 0 && - luaY_n <= YYTABLESIZE && luaY_check[luaY_n] == luaY_state) - luaY_state = luaY_table[luaY_n]; - else - luaY_state = luaY_dgoto[luaY_m]; -#if YYDEBUG - if (luaY_debug) - printf("%sdebug: after reduction, shifting from state %d \ -to state %d\n", YYPREFIX, *luaY_ssp, luaY_state); -#endif - if (luaY_ssp >= luaY_ss + luaY_stacksize - 1) - { - goto luaY_overflow; - } - *++luaY_ssp = luaY_state; - *++luaY_vsp = luaY_val; - goto luaY_loop; -luaY_overflow: - luaY_error("yacc stack overflow"); -luaY_abort: - return (1); -luaY_accept: - return (0); -} diff --git a/src/parser.h b/src/parser.h deleted file mode 100644 index 7087ef91..00000000 --- a/src/parser.h +++ /dev/null @@ -1,38 +0,0 @@ -#define WRONGTOKEN 257 -#define NIL 258 -#define IF 259 -#define THEN 260 -#define ELSE 261 -#define ELSEIF 262 -#define WHILE 263 -#define DO 264 -#define REPEAT 265 -#define UNTIL 266 -#define END 267 -#define RETURN 268 -#define LOCAL 269 -#define FUNCTION 270 -#define DOTS 271 -#define NUMBER 272 -#define STRING 273 -#define NAME 274 -#define AND 275 -#define OR 276 -#define EQ 277 -#define NE 278 -#define LE 279 -#define GE 280 -#define CONC 281 -#define UNARY 282 -#define NOT 283 -typedef union -{ - int vInt; - float vFloat; - char *pChar; - Word vWord; - Long vLong; - TFunc *pFunc; - TaggedString *pTStr; -} YYSTYPE; -extern YYSTYPE luaY_lval; diff --git a/src/table.c b/src/table.c deleted file mode 100644 index 6f24ca9b..00000000 --- a/src/table.c +++ /dev/null @@ -1,266 +0,0 @@ -/* -** table.c -** Module to control static tables -*/ - -char *rcs_table="$Id: table.c,v 2.72 1997/06/17 18:09:31 roberto Exp $"; - -#include "luamem.h" -#include "auxlib.h" -#include "func.h" -#include "opcode.h" -#include "tree.h" -#include "hash.h" -#include "table.h" -#include "inout.h" -#include "lua.h" -#include "fallback.h" -#include "luadebug.h" - - -#define BUFFER_BLOCK 256 - -Symbol *lua_table = NULL; -Word lua_ntable = 0; -static Long lua_maxsymbol = 0; - -TaggedString **lua_constant = NULL; -Word lua_nconstant = 0; -static Long lua_maxconstant = 0; - - -#define GARBAGE_BLOCK 100 - - -void luaI_initsymbol (void) -{ - lua_maxsymbol = BUFFER_BLOCK; - lua_table = newvector(lua_maxsymbol, Symbol); - luaI_predefine(); -} - - -/* -** Initialise constant table with pre-defined constants -*/ -void luaI_initconstant (void) -{ - lua_maxconstant = BUFFER_BLOCK; - lua_constant = newvector(lua_maxconstant, TaggedString *); - /* pre-register mem error messages, to avoid loop when error arises */ - luaI_findconstantbyname(tableEM); - luaI_findconstantbyname(memEM); -} - - -/* -** Given a name, search it at symbol table and return its index. If not -** found, allocate it. -*/ -Word luaI_findsymbol (TaggedString *t) -{ - if (t->u.s.varindex == NOT_USED) - { - if (lua_ntable == lua_maxsymbol) - lua_maxsymbol = growvector(&lua_table, lua_maxsymbol, Symbol, - symbolEM, MAX_WORD); - t->u.s.varindex = lua_ntable; - lua_table[lua_ntable].varname = t; - s_ttype(lua_ntable) = LUA_T_NIL; - lua_ntable++; - } - return t->u.s.varindex; -} - - -Word luaI_findsymbolbyname (char *name) -{ - return luaI_findsymbol(luaI_createfixedstring(name)); -} - - -/* -** Given a tree node, check it is has a correspondent constant index. If not, -** allocate it. -*/ -Word luaI_findconstant (TaggedString *t) -{ - if (t->u.s.constindex == NOT_USED) - { - if (lua_nconstant == lua_maxconstant) - lua_maxconstant = growvector(&lua_constant, lua_maxconstant, TaggedString *, - constantEM, MAX_WORD); - t->u.s.constindex = lua_nconstant; - lua_constant[lua_nconstant] = t; - lua_nconstant++; - } - return t->u.s.constindex; -} - - -Word luaI_findconstantbyname (char *name) -{ - return luaI_findconstant(luaI_createfixedstring(name)); -} - -TaggedString *luaI_createfixedstring (char *name) -{ - TaggedString *ts = lua_createstring(name); - if (!ts->marked) - ts->marked = 2; /* avoid GC */ - return ts; -} - - -int luaI_globaldefined (char *name) -{ - return ttype(&lua_table[luaI_findsymbolbyname(name)].object) != LUA_T_NIL; -} - - -/* -** Traverse symbol table objects -*/ -static char *lua_travsymbol (int (*fn)(TObject *)) -{ - Word i; - for (i=0; i<lua_ntable; i++) - if (fn(&s_object(i))) - return lua_table[i].varname->str; - return NULL; -} - - -/* -** Mark an object if it is a string or a unmarked array. -*/ -int lua_markobject (TObject *o) -{/* if already marked, does not change mark value */ - if (ttype(o) == LUA_T_USERDATA || - (ttype(o) == LUA_T_STRING && !tsvalue(o)->marked)) - tsvalue(o)->marked = 1; - else if (ttype(o) == LUA_T_ARRAY) - lua_hashmark (avalue(o)); - else if ((o->ttype == LUA_T_FUNCTION || o->ttype == LUA_T_MARK) - && !o->value.tf->marked) - o->value.tf->marked = 1; - return 0; -} - -/* -* returns 0 if the object is going to be (garbage) collected -*/ -int luaI_ismarked (TObject *o) -{ - switch (o->ttype) - { - case LUA_T_STRING: case LUA_T_USERDATA: - return o->value.ts->marked; - case LUA_T_FUNCTION: - return o->value.tf->marked; - case LUA_T_ARRAY: - return o->value.a->mark; - default: /* nil, number, cfunction, or user data */ - return 1; - } -} - - -static void call_nilIM (void) -{ /* signals end of garbage collection */ - TObject t; - ttype(&t) = LUA_T_NIL; - luaI_gcIM(&t); /* end of list */ -} - -/* -** Garbage collection. -** Delete all unused strings and arrays. -*/ -static long gc_block = GARBAGE_BLOCK; -static long gc_nentity = 0; /* total of strings, arrays, etc */ - -static void markall (void) -{ - lua_travstack(lua_markobject); /* mark stack objects */ - lua_travsymbol(lua_markobject); /* mark symbol table objects */ - luaI_travlock(lua_markobject); /* mark locked objects */ - luaI_travfallbacks(lua_markobject); /* mark fallbacks */ -} - - -long lua_collectgarbage (long limit) -{ - long recovered = 0; - Hash *freetable; - TaggedString *freestr; - TFunc *freefunc; - markall(); - luaI_invalidaterefs(); - freetable = luaI_hashcollector(&recovered); - freestr = luaI_strcollector(&recovered); - freefunc = luaI_funccollector(&recovered); - gc_nentity -= recovered; - gc_block = (limit == 0) ? 2*(gc_block-recovered) : gc_nentity+limit; - luaI_hashcallIM(freetable); - luaI_strcallIM(freestr); - call_nilIM(); - luaI_hashfree(freetable); - luaI_strfree(freestr); - luaI_funcfree(freefunc); - return recovered; -} - - -void lua_pack (void) -{ - if (++gc_nentity >= gc_block) - lua_collectgarbage(0); -} - - -/* -** Internal function: return next global variable -*/ -void luaI_nextvar (void) -{ - Word next; - if (lua_isnil(lua_getparam(1))) - next = 0; - else - next = luaI_findsymbolbyname(luaL_check_string(1)) + 1; - while (next < lua_ntable && s_ttype(next) == LUA_T_NIL) - next++; - if (next < lua_ntable) { - lua_pushstring(lua_table[next].varname->str); - luaI_pushobject(&s_object(next)); - } -} - - -static TObject *functofind; -static int checkfunc (TObject *o) -{ - if (o->ttype == LUA_T_FUNCTION) - return - ((functofind->ttype == LUA_T_FUNCTION || functofind->ttype == LUA_T_MARK) - && (functofind->value.tf == o->value.tf)); - if (o->ttype == LUA_T_CFUNCTION) - return - ((functofind->ttype == LUA_T_CFUNCTION || - functofind->ttype == LUA_T_CMARK) && - (functofind->value.f == o->value.f)); - return 0; -} - - -char *lua_getobjname (lua_Object o, char **name) -{ /* try to find a name for given function */ - functofind = luaI_Address(o); - if ((*name = luaI_travfallbacks(checkfunc)) != NULL) - return "tag-method"; - else if ((*name = lua_travsymbol(checkfunc)) != NULL) - return "global"; - else return ""; -} - diff --git a/src/table.h b/src/table.h deleted file mode 100644 index 5a628526..00000000 --- a/src/table.h +++ /dev/null @@ -1,39 +0,0 @@ -/* -** Module to control static tables -** TeCGraf - PUC-Rio -** $Id: table.h,v 2.25 1997/05/26 14:42:36 roberto Exp $ -*/ - -#ifndef table_h -#define table_h - -#include "tree.h" -#include "opcode.h" - -typedef struct -{ - TObject object; - TaggedString *varname; -} Symbol; - - -extern Symbol *lua_table; -extern Word lua_ntable; -extern TaggedString **lua_constant; -extern Word lua_nconstant; - -void luaI_initsymbol (void); -void luaI_initconstant (void); -Word luaI_findsymbolbyname (char *name); -Word luaI_findsymbol (TaggedString *t); -Word luaI_findconstant (TaggedString *t); -Word luaI_findconstantbyname (char *name); -int luaI_globaldefined (char *name); -void luaI_nextvar (void); -TaggedString *luaI_createfixedstring (char *str); -int lua_markobject (TObject *o); -int luaI_ismarked (TObject *o); -void lua_pack (void); - - -#endif diff --git a/src/tree.c b/src/tree.c deleted file mode 100644 index 6f3f2d44..00000000 --- a/src/tree.c +++ /dev/null @@ -1,211 +0,0 @@ -/* -** tree.c -** TecCGraf - PUC-Rio -*/ - -char *rcs_tree="$Id: tree.c,v 1.28 1997/06/11 14:24:40 roberto Exp $"; - - -#include <string.h> - -#include "luamem.h" -#include "lua.h" -#include "tree.h" -#include "lex.h" -#include "hash.h" -#include "table.h" -#include "fallback.h" - - -#define NUM_HASHS 64 - -typedef struct { - int size; - int nuse; /* number of elements (including EMPTYs) */ - TaggedString **hash; -} stringtable; - -static int initialized = 0; - -static stringtable string_root[NUM_HASHS]; - -static TaggedString EMPTY = {LUA_T_STRING, NULL, {{NOT_USED, NOT_USED}}, - 0, 2, {0}}; - - -static unsigned long hash (char *s, int tag) -{ - unsigned long h; - if (tag != LUA_T_STRING) - h = (unsigned long)s; - else { - h = 0; - while (*s) - h = ((h<<5)-h)^(unsigned char)*(s++); - } - return h; -} - - -static void luaI_inittree (void) -{ - int i; - for (i=0; i<NUM_HASHS; i++) { - string_root[i].size = 0; - string_root[i].nuse = 0; - string_root[i].hash = NULL; - } -} - - -static void initialize (void) -{ - initialized = 1; - luaI_inittree(); - luaI_addReserved(); - luaI_initsymbol(); - luaI_initconstant(); - luaI_initfallbacks(); -} - - -static void grow (stringtable *tb) -{ - int newsize = luaI_redimension(tb->size); - TaggedString **newhash = newvector(newsize, TaggedString *); - int i; - for (i=0; i<newsize; i++) - newhash[i] = NULL; - /* rehash */ - tb->nuse = 0; - for (i=0; i<tb->size; i++) - if (tb->hash[i] != NULL && tb->hash[i] != &EMPTY) { - int h = tb->hash[i]->hash%newsize; - while (newhash[h]) - h = (h+1)%newsize; - newhash[h] = tb->hash[i]; - tb->nuse++; - } - luaI_free(tb->hash); - tb->size = newsize; - tb->hash = newhash; -} - - -static TaggedString *newone(char *buff, int tag, unsigned long h) -{ - TaggedString *ts; - if (tag == LUA_T_STRING) { - ts = (TaggedString *)luaI_malloc(sizeof(TaggedString)+strlen(buff)); - strcpy(ts->str, buff); - ts->u.s.varindex = ts->u.s.constindex = NOT_USED; - ts->tag = LUA_T_STRING; - } - else { - ts = (TaggedString *)luaI_malloc(sizeof(TaggedString)); - ts->u.v = buff; - ts->tag = tag == LUA_ANYTAG ? 0 : tag; - } - ts->marked = 0; - ts->hash = h; - return ts; -} - -static TaggedString *insert (char *buff, int tag, stringtable *tb) -{ - TaggedString *ts; - unsigned long h = hash(buff, tag); - int i; - int j = -1; - if ((Long)tb->nuse*3 >= (Long)tb->size*2) - { - if (!initialized) - initialize(); - grow(tb); - } - i = h%tb->size; - while ((ts = tb->hash[i]) != NULL) - { - if (ts == &EMPTY) - j = i; - else if ((ts->tag == LUA_T_STRING) ? - (tag == LUA_T_STRING && (strcmp(buff, ts->str) == 0)) : - ((tag == ts->tag || tag == LUA_ANYTAG) && buff == ts->u.v)) - return ts; - i = (i+1)%tb->size; - } - /* not found */ - lua_pack(); - if (j != -1) /* is there an EMPTY space? */ - i = j; - else - tb->nuse++; - ts = tb->hash[i] = newone(buff, tag, h); - return ts; -} - -TaggedString *luaI_createudata (void *udata, int tag) -{ - return insert(udata, tag, &string_root[(unsigned)udata%NUM_HASHS]); -} - -TaggedString *lua_createstring (char *str) -{ - return insert(str, LUA_T_STRING, &string_root[(unsigned)str[0]%NUM_HASHS]); -} - - -void luaI_strcallIM (TaggedString *l) -{ - TObject o; - ttype(&o) = LUA_T_USERDATA; - for (; l; l=l->next) { - tsvalue(&o) = l; - luaI_gcIM(&o); - } -} - - -void luaI_strfree (TaggedString *l) -{ - while (l) { - TaggedString *next = l->next; - luaI_free(l); - l = next; - } -} - - -/* -** Garbage collection function. -*/ -TaggedString *luaI_strcollector (long *acum) -{ - Long counter = 0; - TaggedString *frees = NULL; - int i; - for (i=0; i<NUM_HASHS; i++) - { - stringtable *tb = &string_root[i]; - int j; - for (j=0; j<tb->size; j++) - { - TaggedString *t = tb->hash[j]; - if (t != NULL && t->marked <= 1) - { - if (t->marked) - t->marked = 0; - else - { - t->next = frees; - frees = t; - tb->hash[j] = &EMPTY; - counter++; - } - } - } - } - *acum += counter; - return frees; -} - diff --git a/src/tree.h b/src/tree.h deleted file mode 100644 index 22b81ae8..00000000 --- a/src/tree.h +++ /dev/null @@ -1,38 +0,0 @@ -/* -** tree.h -** TecCGraf - PUC-Rio -** $Id: tree.h,v 1.18 1997/06/09 17:28:14 roberto Exp $ -*/ - -#ifndef tree_h -#define tree_h - -#include "types.h" - -#define NOT_USED 0xFFFE - - -typedef struct TaggedString -{ - int tag; /* if != LUA_T_STRING, this is a userdata */ - struct TaggedString *next; - union { - struct { - Word varindex; /* != NOT_USED if this is a symbol */ - Word constindex; /* != NOT_USED if this is a constant */ - } s; - void *v; /* if this is a userdata, here is its value */ - } u; - unsigned long hash; /* 0 if not initialized */ - int marked; /* for garbage collection; never collect (nor change) if > 1 */ - char str[1]; /* \0 byte already reserved */ -} TaggedString; - - -TaggedString *lua_createstring (char *str); -TaggedString *luaI_createudata (void *udata, int tag); -TaggedString *luaI_strcollector (long *cont); -void luaI_strfree (TaggedString *l); -void luaI_strcallIM (TaggedString *l); - -#endif diff --git a/src/types.h b/src/types.h deleted file mode 100644 index 748ed83f..00000000 --- a/src/types.h +++ /dev/null @@ -1,29 +0,0 @@ -/* -** TeCGraf - PUC-Rio -** $Id: types.h,v 1.4 1996/02/07 14:13:17 roberto Exp $ -*/ - -#ifndef types_h -#define types_h - -#include <limits.h> - -#ifndef real -#define real float -#endif - -#define Byte lua_Byte /* some systems have Byte as a predefined type */ -typedef unsigned char Byte; /* unsigned 8 bits */ - -#define Word lua_Word /* some systems have Word as a predefined type */ -typedef unsigned short Word; /* unsigned 16 bits */ - -#define MAX_WORD (USHRT_MAX-2) /* maximum value of a word (-2 for safety) */ -#define MAX_INT (INT_MAX-2) /* maximum value of a int (-2 for safety) */ - -#define Long lua_Long /* some systems have Long as a predefined type */ -typedef signed long Long; /* 32 bits */ - -typedef unsigned int IntPoint; /* unsigned with same size as a pointer (for hashing) */ - -#endif diff --git a/src/undump.c b/src/undump.c deleted file mode 100644 index 1a00ef7f..00000000 --- a/src/undump.c +++ /dev/null @@ -1,330 +0,0 @@ -/* -** undump.c -** load bytecodes from files -*/ - -char* rcs_undump="$Id: undump.c,v 1.24 1997/06/17 18:19:17 roberto Exp $"; - -#include <stdio.h> -#include <string.h> -#include "auxlib.h" -#include "opcode.h" -#include "luamem.h" -#include "table.h" -#include "undump.h" -#include "zio.h" - -static int swapword=0; -static int swapfloat=0; -static TFunc* Main=NULL; /* functions in a chunk */ -static TFunc* lastF=NULL; - -static void FixCode(Byte* code, Byte* end) /* swap words */ -{ - Byte* p; - for (p=code; p!=end;) - { - int op=*p; - switch (op) - { - case PUSHNIL: - case PUSH0: - case PUSH1: - case PUSH2: - case PUSHLOCAL0: - case PUSHLOCAL1: - case PUSHLOCAL2: - case PUSHLOCAL3: - case PUSHLOCAL4: - case PUSHLOCAL5: - case PUSHLOCAL6: - case PUSHLOCAL7: - case PUSHLOCAL8: - case PUSHLOCAL9: - case PUSHINDEXED: - case STORELOCAL0: - case STORELOCAL1: - case STORELOCAL2: - case STORELOCAL3: - case STORELOCAL4: - case STORELOCAL5: - case STORELOCAL6: - case STORELOCAL7: - case STORELOCAL8: - case STORELOCAL9: - case STOREINDEXED0: - case ADJUST0: - case EQOP: - case LTOP: - case LEOP: - case GTOP: - case GEOP: - case ADDOP: - case SUBOP: - case MULTOP: - case DIVOP: - case POWOP: - case CONCOP: - case MINUSOP: - case NOTOP: - case POP: - case RETCODE0: - p++; - break; - case PUSHBYTE: - case PUSHLOCAL: - case STORELOCAL: - case STOREINDEXED: - case STORELIST0: - case ADJUST: - case RETCODE: - case VARARGS: - case STOREMAP: - p+=2; - break; - case STORELIST: - case CALLFUNC: - p+=3; - break; - case PUSHFUNCTION: - p+=5; /* TODO: use sizeof(TFunc*) or old? */ - break; - case PUSHWORD: - case PUSHSELF: - case CREATEARRAY: - case ONTJMP: - case ONFJMP: - case JMP: - case UPJMP: - case IFFJMP: - case IFFUPJMP: - case SETLINE: - case PUSHSTRING: - case PUSHGLOBAL: - case STOREGLOBAL: - { - Byte t; - t=p[1]; p[1]=p[2]; p[2]=t; - p+=3; - break; - } - case PUSHFLOAT: /* assumes sizeof(float)==4 */ - { - Byte t; - t=p[1]; p[1]=p[4]; p[4]=t; - t=p[2]; p[2]=p[3]; p[3]=t; - p+=5; - break; - } - case STORERECORD: - { - int n=*++p; - p++; - while (n--) - { - Byte t; - t=p[0]; p[0]=p[1]; p[1]=t; - p+=2; - } - break; - } - default: - luaL_verror("corrupt binary file: bad opcode %d at %d\n", - op,(int)(p-code)); - break; - } - } -} - -static void Unthread(Byte* code, int i, int v) -{ - while (i!=0) - { - Word w; - Byte* p=code+i; - memcpy(&w,p,sizeof(w)); - i=w; w=v; - memcpy(p,&w,sizeof(w)); - } -} - -static int LoadWord(ZIO* Z) -{ - Word w; - zread(Z,&w,sizeof(w)); - if (swapword) - { - Byte* p=(Byte*)&w; - Byte t; - t=p[0]; p[0]=p[1]; p[1]=t; - } - return w; -} - -static int LoadSize(ZIO* Z) -{ - Word hi=LoadWord(Z); - Word lo=LoadWord(Z); - int s=(hi<<16)|lo; - if ((Word)s != s) lua_error("code too long"); - return s; -} - -static void* LoadBlock(int size, ZIO* Z) -{ - void* b=luaI_malloc(size); - zread(Z,b,size); - return b; -} - -static char* LoadString(ZIO* Z) -{ - int size=LoadWord(Z); - char *b=luaI_buffer(size); - zread(Z,b,size); - return b; -} - -static char* LoadNewString(ZIO* Z) -{ - return LoadBlock(LoadWord(Z),Z); -} - -static void LoadFunction(ZIO* Z) -{ - TFunc* tf=new(TFunc); - tf->next=NULL; - tf->locvars=NULL; - tf->size=LoadSize(Z); - tf->lineDefined=LoadWord(Z); - if (IsMain(tf)) /* new main */ - { - tf->fileName=LoadNewString(Z); - Main=lastF=tf; - } - else /* fix PUSHFUNCTION */ - { - tf->marked=LoadWord(Z); - tf->fileName=Main->fileName; - memcpy(Main->code+tf->marked,&tf,sizeof(tf)); - lastF=lastF->next=tf; - } - tf->code=LoadBlock(tf->size,Z); - if (swapword || swapfloat) FixCode(tf->code,tf->code+tf->size); - while (1) /* unthread */ - { - int c=zgetc(Z); - if (c==ID_VAR) /* global var */ - { - int i=LoadWord(Z); - char* s=LoadString(Z); - int v=luaI_findsymbolbyname(s); - Unthread(tf->code,i,v); - } - else if (c==ID_STR) /* constant string */ - { - int i=LoadWord(Z); - char* s=LoadString(Z); - int v=luaI_findconstantbyname(s); - Unthread(tf->code,i,v); - } - else - { - zungetc(Z); - break; - } - } -} - -static void LoadSignature(ZIO* Z) -{ - char* s=SIGNATURE; - while (*s!=0 && zgetc(Z)==*s) - ++s; - if (*s!=0) lua_error("cannot load binary file: bad signature"); -} - -static void LoadHeader(ZIO* Z) -{ - Word w,tw=TEST_WORD; - float f,tf=TEST_FLOAT; - int version; - LoadSignature(Z); - version=zgetc(Z); - if (version>0x23) /* after 2.5 */ - { - int oldsizeofW=zgetc(Z); - int oldsizeofF=zgetc(Z); - int oldsizeofP=zgetc(Z); - if (oldsizeofW!=2) - luaL_verror( - "cannot load binary file created on machine with sizeof(Word)=%d; " - "expected 2",oldsizeofW); - if (oldsizeofF!=4) - luaL_verror( - "cannot load binary file created on machine with sizeof(float)=%d; " - "expected 4\nnot an IEEE machine?",oldsizeofF); - if (oldsizeofP!=sizeof(TFunc*)) /* TODO: pack? */ - luaL_verror( - "cannot load binary file created on machine with sizeof(TFunc*)=%d; " - "expected %d",oldsizeofP,(int)sizeof(TFunc*)); - } - zread(Z,&w,sizeof(w)); /* test word */ - if (w!=tw) - { - swapword=1; - } - zread(Z,&f,sizeof(f)); /* test float */ - if (f!=tf) - { - Byte* p=(Byte*)&f; - Byte t; - swapfloat=1; - t=p[0]; p[0]=p[3]; p[3]=t; - t=p[1]; p[1]=p[2]; p[2]=t; - if (f!=tf) /* TODO: try another perm? */ - lua_error("cannot load binary file: unknown float representation"); - } -} - -static void LoadChunk(ZIO* Z) -{ - LoadHeader(Z); - while (1) - { - int c=zgetc(Z); - if (c==ID_FUN) LoadFunction(Z); else { zungetc(Z); break; } - } -} - -/* -** load one chunk from a file. -** return list of functions found, headed by main, or NULL at EOF. -*/ -TFunc* luaI_undump1(ZIO* Z) -{ - int c=zgetc(Z); - if (c==ID_CHUNK) - { - LoadChunk(Z); - return Main; - } - else if (c!=EOZ) - lua_error("not a lua binary file"); - return NULL; -} - -/* -** load and run all chunks in a file -*/ -int luaI_undump(ZIO* Z) -{ - TFunc* m; - while ((m=luaI_undump1(Z))) - { - int status=luaI_dorun(m); - luaI_freefunc(m); - if (status!=0) return status; - } - return 0; -} diff --git a/src/undump.h b/src/undump.h deleted file mode 100644 index 39373583..00000000 --- a/src/undump.h +++ /dev/null @@ -1,30 +0,0 @@ -/* -** undump.h -** definitions for lua decompiler -** $Id: undump.h,v 1.6 1997/06/17 18:19:17 roberto Exp $ -*/ - -#ifndef undump_h -#define undump_h - -#include "func.h" -#include "zio.h" - -#define IsMain(f) (f->lineDefined==0) - -/* definitions for chunk headers */ - -#define ID_CHUNK 27 /* ESC */ -#define ID_FUN 'F' -#define ID_VAR 'V' -#define ID_STR 'S' -#define SIGNATURE "Lua" -#define VERSION 0x25 /* last format change was in 2.5 */ -#define TEST_WORD 0x1234 /* a word for testing byte ordering */ -#define TEST_FLOAT 0.123456789e-23 /* a float for testing representation */ - - -TFunc* luaI_undump1(ZIO* Z); -int luaI_undump(ZIO* Z); /* load all chunks */ - -#endif |