From 8cc9d7154d7daa3a9bc8bf7ff920cfe5aad92eea Mon Sep 17 00:00:00 2001 From: Fabien Fleutot Date: Mon, 31 Dec 2007 17:44:22 +0100 Subject: [PATCH] Initial import of metalua 0.3.9 (working version towards 0.4) --- .DS_Store | Bin 0 -> 6148 bytes .gitignore | 4 + src/Makefile | 30 + src/bitlib/AUTHORS | 1 + src/bitlib/COPYING | 1 + src/bitlib/ChangeLog | 1 + src/bitlib/Makefile | 8 + src/bitlib/NEWS | 1 + src/bitlib/README | 48 + src/bitlib/lbitlib.c | 59 ++ src/common.mk | 26 + src/compiler/Makefile | 60 ++ src/compiler/bootstrap.lua | 38 + src/compiler/compile.lua | 1310 +++++++++++++++++++++++++ src/compiler/frontend.lua | 146 +++ src/compiler/gg.lua | 653 +++++++++++++ src/compiler/lcode.lua | 1035 ++++++++++++++++++++ src/compiler/ldump.lua | 425 +++++++++ src/compiler/lexer.lua | 392 ++++++++ src/compiler/lopcodes.lua | 441 +++++++++ src/compiler/metaluac.mlua | 68 ++ src/compiler/mlc.mlua | 158 +++ src/compiler/mlp_expr.lua | 187 ++++ src/compiler/mlp_ext.lua | 86 ++ src/compiler/mlp_lexer.lua | 32 + src/compiler/mlp_meta.lua | 147 +++ src/compiler/mlp_misc.lua | 173 ++++ src/compiler/mlp_stat.lua | 229 +++++ src/compiler/mlp_table.lua | 89 ++ src/junk/README | 1 + src/junk/hygienic.lua | 279 ++++++ src/junk/hygienic2.lua | 101 ++ src/junk/notes.txt | 182 ++++ src/lib/autotable.lua | 9 + src/lib/clopts.lua | 118 +++ src/lib/ext-lib/classes.lua | 36 + src/lib/ext-lib/clist.lua | 1 + src/lib/ext-lib/continue.lua | 1 + src/lib/ext-lib/exceptions.lua | 21 + src/lib/ext-lib/flist.lua | 42 + src/lib/ext-lib/lazy.lua | 22 + src/lib/ext-lib/localin.lua | 1 + src/lib/ext-lib/match.lua | 1 + src/lib/ext-lib/onwith.lua | 1 + src/lib/ext-lib/ternary.lua | 1 + src/lib/ext-lib/types.lua | 135 +++ src/lib/ext-syntax/anaphoric.lua | 28 + src/lib/ext-syntax/classes.lua | 56 ++ src/lib/ext-syntax/clist.lua | 140 +++ src/lib/ext-syntax/continue.lua | 58 ++ src/lib/ext-syntax/dynamatch.lua | 29 + src/lib/ext-syntax/exceptions.lua | 39 + src/lib/ext-syntax/flist.lua | 15 + src/lib/ext-syntax/lazy.lua | 108 +++ src/lib/ext-syntax/localin.lua | 2 + src/lib/ext-syntax/match.lua | 301 ++++++ src/lib/ext-syntax/onwith.lua | 20 + src/lib/ext-syntax/ternary.lua | 10 + src/lib/ext-syntax/types.lua | 382 ++++++++ src/lib/springs.lua | 38 + src/lib/std.lua | 111 +++ src/lib/strict.lua | 38 + src/lib/string2.lua | 33 + src/lib/table2.lua | 361 +++++++ src/lib/walk.lua | 239 +++++ src/lua-vm/Makefile | 205 ++++ src/lua-vm/lapi.c | 1079 +++++++++++++++++++++ src/lua-vm/lapi.h | 16 + src/lua-vm/lauxlib.c | 674 +++++++++++++ src/lua-vm/lauxlib.h | 174 ++++ src/lua-vm/lbaselib.c | 682 +++++++++++++ src/lua-vm/lcode.c | 839 ++++++++++++++++ src/lua-vm/lcode.h | 76 ++ src/lua-vm/ldblib.c | 397 ++++++++ src/lua-vm/ldebug.c | 627 ++++++++++++ src/lua-vm/ldebug.h | 33 + src/lua-vm/ldo.c | 516 ++++++++++ src/lua-vm/ldo.h | 57 ++ src/lua-vm/ldump.c | 164 ++++ src/lua-vm/lfunc.c | 174 ++++ src/lua-vm/lfunc.h | 34 + src/lua-vm/lgc.c | 711 ++++++++++++++ src/lua-vm/lgc.h | 110 +++ src/lua-vm/linit.c | 59 ++ src/lua-vm/liolib.c | 532 +++++++++++ src/lua-vm/llex.c | 461 +++++++++ src/lua-vm/llex.h | 81 ++ src/lua-vm/llimits.h | 128 +++ src/lua-vm/lmathlib.c | 263 +++++ src/lua-vm/lmem.c | 86 ++ src/lua-vm/lmem.h | 49 + src/lua-vm/loadlib.c | 663 +++++++++++++ src/lua-vm/lobject.c | 214 +++++ src/lua-vm/lobject.h | 381 ++++++++ src/lua-vm/lopcodes.c | 102 ++ src/lua-vm/lopcodes.h | 268 ++++++ src/lua-vm/loslib.c | 244 +++++ src/lua-vm/lparser.c | 1337 ++++++++++++++++++++++++++ src/lua-vm/lparser.h | 82 ++ src/lua-vm/lstate.c | 214 +++++ src/lua-vm/lstate.h | 168 ++++ src/lua-vm/lstring.c | 111 +++ src/lua-vm/lstring.h | 31 + src/lua-vm/lstrlib.c | 868 +++++++++++++++++ src/lua-vm/ltable.c | 588 ++++++++++++ src/lua-vm/ltable.h | 40 + src/lua-vm/ltablib.c | 278 ++++++ src/lua-vm/ltm.c | 75 ++ src/lua-vm/ltm.h | 54 ++ src/lua-vm/lua.h | 389 ++++++++ src/lua-vm/luac.out | Bin 0 -> 261 bytes src/lua-vm/luaconf.h | 769 +++++++++++++++ src/lua-vm/lualib.h | 56 ++ src/lua-vm/lundump.c | 223 +++++ src/lua-vm/lundump.h | 36 + src/lua-vm/lundumplib.c | 4 + src/lua-vm/lvm.c | 765 +++++++++++++++ src/lua-vm/lvm.h | 36 + src/lua-vm/lzio.c | 82 ++ src/lua-vm/lzio.h | 67 ++ src/lua-vm/mlc.c | 246 +++++ src/lua-vm/mlr.c | 391 ++++++++ src/lua-vm/path_defaults.h | 6 + src/lua-vm/print.c | 227 +++++ src/pluto/CHANGELOG | 10 + src/pluto/FILEFORMAT | 150 +++ src/pluto/Makefile | 9 + src/pluto/README | 129 +++ src/pluto/pluto.c | 1487 +++++++++++++++++++++++++++++ src/pluto/pluto.h | 25 + src/pluto/pptest.c | 90 ++ src/pluto/pptest.lua | 136 +++ src/pluto/puptest.c | 68 ++ src/pluto/puptest.lua | 85 ++ src/rings/Makefile | 6 + src/rings/README | 36 + src/rings/doc/.DS_Store | Bin 0 -> 6148 bytes src/rings/doc/us/index.html | 128 +++ src/rings/doc/us/license.html | 118 +++ src/rings/doc/us/manual.html | 251 +++++ src/rings/doc/us/rings.png | Bin 0 -> 7448 bytes src/rings/rings.c | 278 ++++++ src/rings/stable.lua | 28 + src/samples/hello_world.lua | 7 + src/setup.sh | 4 + 145 files changed, 29095 insertions(+) create mode 100644 .DS_Store create mode 100644 .gitignore create mode 100644 src/Makefile create mode 100644 src/bitlib/AUTHORS create mode 100644 src/bitlib/COPYING create mode 100644 src/bitlib/ChangeLog create mode 100644 src/bitlib/Makefile create mode 100644 src/bitlib/NEWS create mode 100644 src/bitlib/README create mode 100644 src/bitlib/lbitlib.c create mode 100644 src/common.mk create mode 100644 src/compiler/Makefile create mode 100644 src/compiler/bootstrap.lua create mode 100644 src/compiler/compile.lua create mode 100644 src/compiler/frontend.lua create mode 100644 src/compiler/gg.lua create mode 100644 src/compiler/lcode.lua create mode 100644 src/compiler/ldump.lua create mode 100644 src/compiler/lexer.lua create mode 100644 src/compiler/lopcodes.lua create mode 100644 src/compiler/metaluac.mlua create mode 100644 src/compiler/mlc.mlua create mode 100644 src/compiler/mlp_expr.lua create mode 100644 src/compiler/mlp_ext.lua create mode 100644 src/compiler/mlp_lexer.lua create mode 100644 src/compiler/mlp_meta.lua create mode 100644 src/compiler/mlp_misc.lua create mode 100644 src/compiler/mlp_stat.lua create mode 100644 src/compiler/mlp_table.lua create mode 100644 src/junk/README create mode 100755 src/junk/hygienic.lua create mode 100644 src/junk/hygienic2.lua create mode 100644 src/junk/notes.txt create mode 100644 src/lib/autotable.lua create mode 100644 src/lib/clopts.lua create mode 100644 src/lib/ext-lib/classes.lua create mode 100644 src/lib/ext-lib/clist.lua create mode 100644 src/lib/ext-lib/continue.lua create mode 100644 src/lib/ext-lib/exceptions.lua create mode 100644 src/lib/ext-lib/flist.lua create mode 100644 src/lib/ext-lib/lazy.lua create mode 100644 src/lib/ext-lib/localin.lua create mode 100644 src/lib/ext-lib/match.lua create mode 100644 src/lib/ext-lib/onwith.lua create mode 100644 src/lib/ext-lib/ternary.lua create mode 100644 src/lib/ext-lib/types.lua create mode 100644 src/lib/ext-syntax/anaphoric.lua create mode 100644 src/lib/ext-syntax/classes.lua create mode 100644 src/lib/ext-syntax/clist.lua create mode 100644 src/lib/ext-syntax/continue.lua create mode 100644 src/lib/ext-syntax/dynamatch.lua create mode 100644 src/lib/ext-syntax/exceptions.lua create mode 100644 src/lib/ext-syntax/flist.lua create mode 100644 src/lib/ext-syntax/lazy.lua create mode 100644 src/lib/ext-syntax/localin.lua create mode 100755 src/lib/ext-syntax/match.lua create mode 100644 src/lib/ext-syntax/onwith.lua create mode 100644 src/lib/ext-syntax/ternary.lua create mode 100644 src/lib/ext-syntax/types.lua create mode 100644 src/lib/springs.lua create mode 100644 src/lib/std.lua create mode 100755 src/lib/strict.lua create mode 100644 src/lib/string2.lua create mode 100644 src/lib/table2.lua create mode 100644 src/lib/walk.lua create mode 100644 src/lua-vm/Makefile create mode 100644 src/lua-vm/lapi.c create mode 100644 src/lua-vm/lapi.h create mode 100644 src/lua-vm/lauxlib.c create mode 100644 src/lua-vm/lauxlib.h create mode 100644 src/lua-vm/lbaselib.c create mode 100644 src/lua-vm/lcode.c create mode 100644 src/lua-vm/lcode.h create mode 100644 src/lua-vm/ldblib.c create mode 100644 src/lua-vm/ldebug.c create mode 100644 src/lua-vm/ldebug.h create mode 100644 src/lua-vm/ldo.c create mode 100644 src/lua-vm/ldo.h create mode 100644 src/lua-vm/ldump.c create mode 100644 src/lua-vm/lfunc.c create mode 100644 src/lua-vm/lfunc.h create mode 100644 src/lua-vm/lgc.c create mode 100644 src/lua-vm/lgc.h create mode 100644 src/lua-vm/linit.c create mode 100644 src/lua-vm/liolib.c create mode 100644 src/lua-vm/llex.c create mode 100644 src/lua-vm/llex.h create mode 100644 src/lua-vm/llimits.h create mode 100644 src/lua-vm/lmathlib.c create mode 100644 src/lua-vm/lmem.c create mode 100644 src/lua-vm/lmem.h create mode 100644 src/lua-vm/loadlib.c create mode 100644 src/lua-vm/lobject.c create mode 100644 src/lua-vm/lobject.h create mode 100644 src/lua-vm/lopcodes.c create mode 100644 src/lua-vm/lopcodes.h create mode 100644 src/lua-vm/loslib.c create mode 100644 src/lua-vm/lparser.c create mode 100644 src/lua-vm/lparser.h create mode 100644 src/lua-vm/lstate.c create mode 100644 src/lua-vm/lstate.h create mode 100644 src/lua-vm/lstring.c create mode 100644 src/lua-vm/lstring.h create mode 100644 src/lua-vm/lstrlib.c create mode 100644 src/lua-vm/ltable.c create mode 100644 src/lua-vm/ltable.h create mode 100644 src/lua-vm/ltablib.c create mode 100644 src/lua-vm/ltm.c create mode 100644 src/lua-vm/ltm.h create mode 100644 src/lua-vm/lua.h create mode 100644 src/lua-vm/luac.out create mode 100644 src/lua-vm/luaconf.h create mode 100644 src/lua-vm/lualib.h create mode 100644 src/lua-vm/lundump.c create mode 100644 src/lua-vm/lundump.h create mode 100644 src/lua-vm/lundumplib.c create mode 100644 src/lua-vm/lvm.c create mode 100644 src/lua-vm/lvm.h create mode 100644 src/lua-vm/lzio.c create mode 100644 src/lua-vm/lzio.h create mode 100644 src/lua-vm/mlc.c create mode 100644 src/lua-vm/mlr.c create mode 100644 src/lua-vm/path_defaults.h create mode 100644 src/lua-vm/print.c create mode 100644 src/pluto/CHANGELOG create mode 100644 src/pluto/FILEFORMAT create mode 100644 src/pluto/Makefile create mode 100644 src/pluto/README create mode 100644 src/pluto/pluto.c create mode 100644 src/pluto/pluto.h create mode 100644 src/pluto/pptest.c create mode 100644 src/pluto/pptest.lua create mode 100644 src/pluto/puptest.c create mode 100644 src/pluto/puptest.lua create mode 100644 src/rings/Makefile create mode 100644 src/rings/README create mode 100644 src/rings/doc/.DS_Store create mode 100644 src/rings/doc/us/index.html create mode 100644 src/rings/doc/us/license.html create mode 100644 src/rings/doc/us/manual.html create mode 100644 src/rings/doc/us/rings.png create mode 100644 src/rings/rings.c create mode 100644 src/rings/stable.lua create mode 100644 src/samples/hello_world.lua create mode 100755 src/setup.sh diff --git a/.DS_Store b/.DS_Store new file mode 100644 index 0000000000000000000000000000000000000000..04f45677d281092f9c8a328ee4b7c8c63035a574 GIT binary patch literal 6148 zcmeHKJ8A<#43%ORhBPiy&J}Wl!8k?gTp)N2#$Z@Ta6g?7lSA51pEX`K0aq@<6G(4n zB+cx;Vl)yFT^+ZtB1;ijKn>+&W-8`4oyb$J7^>~jcbh}M!OXXt#Q(Nnxik5eFX`S7 zqx=TX&p8CU4^jJW*XJq2N6q1-kO4A42FL&zAOrU?U{w{ecn+i`17v^W?&Z6rPcp8=pX(6IEgbdKnDI513F)StXKG@tgVxuvszoApU^=N o>)|k7ih*8=F|ktoauZi<41Y~*fu4?aPY3cLV7ySsz#|yA08uX $@ + echo 'export $(ENV_PREFIX)_INIT="require [[std]]"' >> $@ + echo 'export $(ENV_PREFIX)_PATH=$(LUA_PATH)' >> $@ + echo 'export $(ENV_PREFIX)_CPATH=$(LUA_CPATH)' >> $@ + chmod a+x $@ + +lib-copy: setup.sh lib + cp -r lib/* $(TARGET_LUA_PATH)/ +lua-vm: + $(MAKE) -C lua-vm/ $(PLATFORM) +rings: + $(MAKE) -C rings/ $(PLATFORM) +pluto: + $(MAKE) -C pluto/ $(PLATFORM) +bitlib: + $(MAKE) -C bitlib/ $(PLATFORM) +compiler: + $(MAKE) -C compiler/ $(PLATFORM) + +.PHONY: all setup.sh lib-copy lua-vm rings pluto compiler diff --git a/src/bitlib/AUTHORS b/src/bitlib/AUTHORS new file mode 100644 index 0000000..5ff79bf --- /dev/null +++ b/src/bitlib/AUTHORS @@ -0,0 +1 @@ +See README for the authors. diff --git a/src/bitlib/COPYING b/src/bitlib/COPYING new file mode 100644 index 0000000..126d1ba --- /dev/null +++ b/src/bitlib/COPYING @@ -0,0 +1 @@ +See README for the license. \ No newline at end of file diff --git a/src/bitlib/ChangeLog b/src/bitlib/ChangeLog new file mode 100644 index 0000000..e29c746 --- /dev/null +++ b/src/bitlib/ChangeLog @@ -0,0 +1 @@ +See CVS history. diff --git a/src/bitlib/Makefile b/src/bitlib/Makefile new file mode 100644 index 0000000..705c1b3 --- /dev/null +++ b/src/bitlib/Makefile @@ -0,0 +1,8 @@ +# -*-makefile-*- + +T= bit +V= 21 +C_SRC= lbitlib.c +#LUA_SRC= + +include ../lib-common.mk diff --git a/src/bitlib/NEWS b/src/bitlib/NEWS new file mode 100644 index 0000000..6bb23af --- /dev/null +++ b/src/bitlib/NEWS @@ -0,0 +1 @@ +See the web site (listed in README) for news. diff --git a/src/bitlib/README b/src/bitlib/README new file mode 100644 index 0000000..6e0faec --- /dev/null +++ b/src/bitlib/README @@ -0,0 +1,48 @@ + bitlib release 21 + ----------------- + + by Reuben Thomas + http://luaforge.net/projects/bitlib + + +bitlib is a C library for Lua 5.x that provides bitwise operations. It +is copyright Reuben Thomas 2000-2006, and is released under the MIT +license, like Lua (see http://www.lua.org/copyright.html; it's +basically the same as the BSD license). There is no warranty. + +Please report bugs and make suggestions to the email address above, or +use the LuaForge trackers. + +Thanks to John Passaniti for his bitwise operations library, some of +whose ideas I used, and to Thatcher Ulrich for portability fixes. + + +Installation +------------ + +The provided Makefile builds a shared library called bit.so, which can +be installed on LUA_CPATH and used with require. + + +Use +--- + +Lua functions provided: + +bit.bnot(a) returns the one's complement of a +bit.band(w1,...) returns the bitwise and of the w's +bit.bor(w1,...) returns the bitwise or of the w's +bit.bxor(w1,...) returns the bitwise exclusive or of the w's +bit.lshift(a,b) returns a shifted left b places +bit.rshift(a,b) returns a shifted logically right b places +bit.arshift(a,b) returns a shifted arithmetically right b places +bit.mod(a,b) returns the integer remainder of a divided by b + +All function arguments should be integers. The number of bits +available for logical operations depends on the data type used to +represent Lua numbers; this is typically 8-byte IEEE floats, which +give 53 bits (the size of the mantissa). + +The logical operations start with "b" for "bit" to avoid clashing with +reserved words; although "xor" isn't a reserved word, it seemed better +to use "bxor" for consistency. diff --git a/src/bitlib/lbitlib.c b/src/bitlib/lbitlib.c new file mode 100644 index 0000000..155f243 --- /dev/null +++ b/src/bitlib/lbitlib.c @@ -0,0 +1,59 @@ +/* Bitwise operations library */ +/* Reuben Thomas nov00-08dec06 */ + +#include "lauxlib.h" +#include "lua.h" + +#include + +typedef uintmax_t Integer; +typedef intmax_t UInteger; + +#define TDYADIC(name, op, type1, type2) \ + static int bit_ ## name(lua_State* L) { \ + lua_pushnumber(L, \ + (type1)luaL_checknumber(L, 1) op (type2)luaL_checknumber(L, 2)); \ + return 1; \ + } + +#define MONADIC(name, op, type) \ + static int bit_ ## name(lua_State* L) { \ + lua_pushnumber(L, op (type)luaL_checknumber(L, 1)); \ + return 1; \ + } + +#define VARIADIC(name, op, type) \ + static int bit_ ## name(lua_State *L) { \ + int n = lua_gettop(L), i; \ + Integer w = (type)luaL_checknumber(L, 1); \ + for (i = 2; i <= n; i++) \ + w op (type)luaL_checknumber(L, i); \ + lua_pushnumber(L, w); \ + return 1; \ + } + +MONADIC(bnot, ~, Integer) +VARIADIC(band, &=, Integer) +VARIADIC(bor, |=, Integer) +VARIADIC(bxor, ^=, Integer) +TDYADIC(lshift, <<, Integer, UInteger) +TDYADIC(rshift, >>, UInteger, UInteger) +TDYADIC(arshift, >>, Integer, UInteger) +TDYADIC(mod, %, Integer, Integer) + +static const struct luaL_reg bitlib[] = { + {"bnot", bit_bnot}, + {"band", bit_band}, + {"bor", bit_bor}, + {"bxor", bit_bxor}, + {"lshift", bit_lshift}, + {"rshift", bit_rshift}, + {"arshift", bit_arshift}, + {"mod", bit_mod}, + {NULL, NULL} +}; + +LUALIB_API int luaopen_bit (lua_State *L) { + luaL_openlib(L, "bit", bitlib, 0); + return 1; +} diff --git a/src/common.mk b/src/common.mk new file mode 100644 index 0000000..28f4201 --- /dev/null +++ b/src/common.mk @@ -0,0 +1,26 @@ +UNAME = Darwin +MLC = lua-vm/mlc +MLR = lua-vm/mlr +CC = gcc +CFLAGS = -g3 -Wall -ansi -I ../lua-vm +OBJEXT = o +TARGET_LUA_PATH = /tmp/lua +TARGET_LUA_CPATH = $(TARGET_LUA_PATH) +COMPILE = mlc +RUN = mlr +ENV_PREFIX = METALUA + +ifeq ($(UNAME),Darwin) + LIBEXT = dylib + LUA_PLATFORM = macosx + MKLIB = gcc -bundle -undefined dynamic_lookup +else + LIBEXT = so + LUA_PLATFORM ?= unix + MKLIB = I DONT HAVE A CLUE, uname is $(UNAME) +endif + +LUA_PATH_DIRS = ./?.EXT;$(TARGET_LUA_PATH)/?.EXT +LUA_PATH = "$(subst EXT,lua,$(LUA_PATH_DIRS));$(subst EXT,luac,$(LUA_PATH_DIRS))" +LUA_CPATH = "$(TARGET_LUA_CPATH)/?.$(LIBEXT);$(TARGET_LUA_CPATH)/?/linit.$(LIBEXT)" + diff --git a/src/compiler/Makefile b/src/compiler/Makefile new file mode 100644 index 0000000..056ef82 --- /dev/null +++ b/src/compiler/Makefile @@ -0,0 +1,60 @@ +include ../common.mk + +#VM = $(TARGET_LUA_CPATH)/$(VM) + +TARGETS = bytecode.luac mlp.luac mlc.luac metaluac + +all: $(TARGETS) install + +# Library which compiles an AST into a bytecode string. +# Written in pure lua +BYTECODE_LUA = \ + lopcodes.lua \ + lcode.lua \ + ldump.lua \ + compile.lua + +bytecode.luac: $(BYTECODE_LUA) + ../lua-vm/$(COMPILE) -o $@ $^ + +# Library which compiles strings into AST +MLP_LUA = \ + lexer.lua \ + gg.lua \ + mlp_lexer.lua \ + mlp_misc.lua \ + mlp_table.lua \ + mlp_meta.lua \ + mlp_expr.lua \ + mlp_stat.lua \ + mlp_ext.lua + +mlp.luac: $(MLP_LUA) + ../lua-vm/$(COMPILE) -o $@ $^ + +# bootstrap is the minimal executable that turns a metalua source file into +# a bytecode file. It's used to generate +BOOTSTRAP_LUA = \ + bootstrap.lua + +bootstrap: $(BOOTSTRAP_LUA) + ../lua-vm/$(COMPILE) -o $@ $^ + +COMPILER_LUA = \ + metaluac.lua + +%.luac: %.mlua bootstrap + ../lua-vm/$(RUN) bootstrap $< + +metaluac: metaluac.luac + echo '#!$(TARGET_LUA_CPATH)/$(RUN)' > $@ + cat $^ >> $@ + chmod a+x $@ + +install: $(TARGETS) + cp $^ $(TARGET_LUA_CPATH)/ + +.PHONY: all install-lib + +clean: + rm *.luac $(TARGETS) \ No newline at end of file diff --git a/src/compiler/bootstrap.lua b/src/compiler/bootstrap.lua new file mode 100644 index 0000000..430b21a --- /dev/null +++ b/src/compiler/bootstrap.lua @@ -0,0 +1,38 @@ +-- This only serves in the bootstrapping process, it isn't +-- included in the final compiler. When compiled with std.lua, +-- mlp and bytecode modules, it is able to compile metalua +-- sources into .luac bytecode files. +-- It allows to precompile files such as + +print ' *** LOAD BOOTSTRAP with fake MLC' + +require 'std' +require 'bytecode' +require 'mlp' + +mlc = { } +mlc.metabugs = false + +function mlc.function_of_ast (ast) + local proto = bytecode.metalua_compile (ast) + local dump = bytecode.dump_string (proto) + local func = undump(dump) + return func +end + +local function compile_file (src_filename) + local src_file = io.open (src_filename, 'r') + local src = src_file:read '*a'; src_file:close() + local lx = mlp.lexer:newstream (src) + local ast = mlp.chunk (lx) + local proto = bytecode.metalua_compile (ast) + local dump = bytecode.dump_string (proto) + local dst_filename = src_filename:gsub ("%.mlua$", ".luac") + local dst_file = io.open (dst_filename, 'w') + dst_file:write(dump) + dst_file:close() +end + + +for _, x in ipairs{...} do compile_file (x) end + diff --git a/src/compiler/compile.lua b/src/compiler/compile.lua new file mode 100644 index 0000000..64e6c94 --- /dev/null +++ b/src/compiler/compile.lua @@ -0,0 +1,1310 @@ +---------------------------------------------------------------------- +-- +-- WARNING! You're entering a hackish area, proceed at your own risks! +-- +-- This code partly results from the borrowing, then ruthless abuse, of +-- Yueliang's implementation of Lua 5.0 compiler. I claim +-- responsibility for all of the ugly, dirty stuff that you might spot +-- in it. +-- +-- Eventually, this code will be rewritten, either in Lua or more +-- probably in C. Meanwhile, if you're interested into digging +-- metalua's sources, this is not the best part to invest your time +-- on. +-- +-- End of warning. +-- +---------------------------------------------------------------------- + +---------------------------------------------------------------------- +-- Metalua: $Id: compile.lua,v 1.7 2006/11/15 09:07:50 fab13n Exp $ +-- +-- Summary: Compile ASTs to Lua 5.1 VM function prototype. +-- Largely based on: +-- +-- * Yueliang (http://luaforge.net/projects/yueliang), +-- yueliang-0.1.2/orig-5.0.2/lparser.lua +-- +-- * Lua 5.1 sources (http://www.lua.org), src/lparser.c +-- +---------------------------------------------------------------------- +-- +-- Copyright (c) 2006, Fabien Fleutot . +-- +-- This software is released under the MIT Licence, see licence.txt +-- for details. +-- +---------------------------------------------------------------------- +-- History: +-- $Log: compile.lua,v $ +-- Revision 1.7 2006/11/15 09:07:50 fab13n +-- debugged meta operators. +-- Added command line options handling. +-- +-- Revision 1.6 2006/11/10 02:11:17 fab13n +-- compiler faithfulness to 5.1 improved +-- gg.expr extended +-- mlp.expr refactored +-- +-- Revision 1.5 2006/11/09 09:39:57 fab13n +-- some cleanup +-- +-- Revision 1.4 2006/11/07 21:29:02 fab13n +-- improved quasi-quoting +-- +-- Revision 1.3 2006/11/07 04:37:59 fab13n +-- first bootstrapping version. +-- +-- Revision 1.2 2006/11/05 15:08:34 fab13n +-- updated code generation, to be compliant with 5.1 +-- +---------------------------------------------------------------------- + +module ("bytecode", package.seeall) +--require "lopcodes" +--require "lcode" + +local debugf = function() end +--local debugf=printf + +local stat = { } +local expr = { } + +-- GENERAL FIXME: je ne gere pas les parentheses pour empecher l'unpack +-- des fonctions dans return et dans table. + +-- GENERAL FIXME: growvector --> checkvector + +MAX_INT = 2147483645 -- INT_MAX-2 for 32-bit systems (llimits.h) +MAXVARS = 200 -- (llimits.h) +MAXUPVALUES = 32 -- (llimits.h) +MAXPARAMS = 100 -- (llimits.h) +LUA_MAXPARSERLEVEL = 200 -- (llimits.h) + +-- from lobject.h +VARARG_HASARG = 1 +VARARG_ISVARARG = 2 +VARARG_NEEDSARG = 4 + + +local function hasmultret (k) return k=="VCALL" or k=="VVARARG" end + +----------------------------------------------------------------------- +-- Some ASTs take expression lists as children; it should be +-- acceptible to give an expression instead, and to automatically +-- interpret it as a single element list. That's what does this +-- function, adding a surrounding list iff needed. +-- +-- WARNING: "Do" is the tag for chunks, which are essentially lists. +-- Therefore, we don't listify stuffs with a "Do" tag. +----------------------------------------------------------------------- +local function ensure_list (ast) + return ast.tag and ast.tag ~= "Do" and {ast} or ast end + +----------------------------------------------------------------------- +-- Get a localvar structure { varname, startpc, endpc } from a +-- (zero-based) index of active variable. The catch is: don't get +-- confused between local index and active index. +-- +-- locvars[x] contains { varname, startpc, endpc }; +-- actvar[i] contains the index of the variable in locvars +----------------------------------------------------------------------- +local function getlocvar (fs, i) + return fs.f.locvars[fs.actvar[i]] +end + +local function removevars (fs, tolevel) + while fs.nactvar > tolevel do + fs.nactvar = fs.nactvar - 1 + -- There may be dummy locvars due to expr.Stat + -- FIXME: strange that they didn't disappear?! + local locvar = getlocvar (fs, fs.nactvar) + --printf("[REMOVEVARS] removing var #%i = %s", fs.nactvar, + -- locvar and tostringv(locvar) or "") + if locvar then locvar.endpc = fs.pc end + end +end + +----------------------------------------------------------------------- +-- [f] has a list of all its local variables, active and inactive. +-- Some local vars can correspond to the same register, if they exist +-- in different scopes. +-- [fs.nlocvars] is the total number of local variables, not to be +-- confused with [fs.nactvar] the numebr of variables active at the +-- current PC. +-- At this stage, the existence of the variable is not yet aknowledged, +-- since [fs.nactvar] and [fs.freereg] aren't updated. +----------------------------------------------------------------------- +local function registerlocalvar (fs, varname) + debugf("[locvar: %s = reg %i]", varname, fs.nlocvars) + local f = fs.f + f.locvars[fs.nlocvars] = { } -- LocVar + f.locvars[fs.nlocvars].varname = varname + local nlocvars = fs.nlocvars + fs.nlocvars = fs.nlocvars + 1 + return nlocvars +end + +----------------------------------------------------------------------- +-- update the active vars counter in [fs] by adding [nvars] of them, +-- and sets those variables' [startpc] to the current [fs.pc]. +-- These variables were allready created, but not yet counted, by +-- new_localvar. +----------------------------------------------------------------------- +local function adjustlocalvars (fs, nvars) + --debugf("adjustlocalvars, nvars=%i, previous fs.nactvar=%i,".. + -- " #locvars=%i, #actvar=%i", + -- nvars, fs.nactvar, #fs.f.locvars, #fs.actvar) + + fs.nactvar = fs.nactvar + nvars + for i = nvars, 1, -1 do + --printf ("adjusting actvar #%i", fs.nactvar - i) + getlocvar (fs, fs.nactvar - i).startpc = fs.pc + end +end + +------------------------------------------------------------------------ +-- check whether, in an assignment to a local variable, the local variable +-- is needed in a previous assignment (to a table). If so, save original +-- local value in a safe place and use this safe copy in the previous +-- assignment. +------------------------------------------------------------------------ +local function check_conflict (fs, lh, v) + local extra = fs.freereg -- eventual position to save local variable + local conflict = false + while lh do + if lh.v.k == "VINDEXED" then + if lh.v.info == v.info then -- conflict? + conflict = true + lh.v.info = extra -- previous assignment will use safe copy + end + if lh.v.aux == v.info then -- conflict? + conflict = true + lh.v.aux = extra -- previous assignment will use safe copy + end + end + lh = lh.prev + end + if conflict then + luaK:codeABC (fs, "OP_MOVE", fs.freereg, v.info, 0) -- make copy + luaK:reserveregs (fs, 1) + end +end + +----------------------------------------------------------------------- +-- Create an expdesc. To be updated when expdesc is lua-ified. +----------------------------------------------------------------------- +local function init_exp (e, k, i) + e.f, e.t, e.k, e.info = luaK.NO_JUMP, luaK.NO_JUMP, k, i end + +----------------------------------------------------------------------- +-- Reserve the string in tthe constant pool, and return an expdesc +-- referring to it. +----------------------------------------------------------------------- +local function codestring (fs, e, str) + --printf( "codestring(%s)", disp.ast(str)) + init_exp (e, "VK", luaK:stringK (fs, str)) +end + +----------------------------------------------------------------------- +-- search for a local variable named [name] in the function being +-- built by [fs]. Doesn't try to visit upvalues. +----------------------------------------------------------------------- +local function searchvar (fs, name) + for i = fs.nactvar - 1, 0, -1 do + -- Because of expr.Stat, there can be some actvars which don't + -- correspond to any locvar. Hence the checking for locvar's + -- nonnilness before getting the varname. + local locvar = getlocvar(fs, i) + if locvar and name == locvar.varname then + --printf("Found local var: %s; i = %i", tostringv(locvar), i) + return i + end + end + return -1 -- not found +end + +----------------------------------------------------------------------- +-- create and return a new proto [f] +----------------------------------------------------------------------- +local function newproto () + local f = {} + f.k = {} + f.sizek = 0 + f.p = {} + f.sizep = 0 + f.code = {} + f.sizecode = 0 + f.sizelineinfo = 0 + f.sizeupvalues = 0 + f.nups = 0 + f.upvalues = {} + f.numparams = 0 + f.is_vararg = 0 + f.maxstacksize = 0 + f.lineinfo = {} + f.sizelocvars = 0 + f.locvars = {} + f.lineDefined = 0 + f.source = nil + return f +end + +------------------------------------------------------------------------ +-- create and return a function state [new_fs] as a sub-funcstate of [fs]. +------------------------------------------------------------------------ +local function open_func (old_fs) + local new_fs = { } + new_fs.upvalues = { } + new_fs.actvar = { } + local f = newproto () + new_fs.f = f + new_fs.prev = old_fs -- linked list of funcstates + new_fs.pc = 0 + new_fs.lasttarget = -1 + new_fs.jpc = luaK.NO_JUMP + new_fs.freereg = 0 + new_fs.nk = 0 + new_fs.h = {} -- constant table; was luaH_new call + new_fs.np = 0 + new_fs.nlocvars = 0 + new_fs.nactvar = 0 + new_fs.bl = nil + new_fs.nestlevel = old_fs and old_fs.nestlevel or 0 + f.maxstacksize = 2 -- registers 0/1 are always valid + new_fs.lastline = 0 + new_fs.forward_gotos = { } + new_fs.labels = { } + return new_fs +end + +------------------------------------------------------------------------ +-- Finish to set up [f] according to final state of [fs] +------------------------------------------------------------------------ +local function close_func (fs) + local f = fs.f + --printf("[CLOSE_FUNC] remove any remaining var") + removevars (fs, 0) + luaK:ret (fs, 0, 0) + f.sizecode = fs.pc + f.sizelineinfo = fs.pc + f.sizek = fs.nk + f.sizep = fs.np + f.sizelocvars = fs.nlocvars + f.sizeupvalues = f.nups + assert (fs.bl == nil) + if next(fs.forward_gotos) then + local x = table.tostring(fs.forward_gotos) + error ("Unresolved goto: "..x) + end +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function pushclosure(fs, func, v) + local f = fs.f + f.p [fs.np] = func.f + fs.np = fs.np + 1 + init_exp (v, "VRELOCABLE", luaK:codeABx (fs, "OP_CLOSURE", 0, fs.np - 1)) + for i = 0, func.f.nups - 1 do + local o = (func.upvalues[i].k == "VLOCAL") and "OP_MOVE" or "OP_GETUPVAL" + luaK:codeABC (fs, o, 0, func.upvalues[i].info, 0) + end +end + +------------------------------------------------------------------------ +-- FIXME: is there a need for f=fs.f? if yes, why not always using it? +------------------------------------------------------------------------ +function indexupvalue(fs, name, v) + local f = fs.f + for i = 0, f.nups - 1 do + if fs.upvalues[i].k == v.k and fs.upvalues[i].info == v.info then + assert(fs.f.upvalues[i] == name) + return i + end + end + -- new one + f.upvalues[f.nups] = name + assert (v.k == "VLOCAL" or v.k == "VUPVAL") + fs.upvalues[f.nups] = { k = v.k; info = v.info } + local nups = f.nups + f.nups = f.nups + 1 + return nups +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function markupval(fs, level) + local bl = fs.bl + while bl and bl.nactvar > level do bl = bl.previous end + if bl then bl.upval = true end +end + + +--for debug only +--[[ +local function bldepth(fs) + local i, x= 1, fs.bl + while x do i=i+1; x=x.previous end + return i +end +--]] + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function enterblock (fs, bl, isbreakable) + bl.breaklist = luaK.NO_JUMP + bl.isbreakable = isbreakable + bl.nactvar = fs.nactvar + bl.upval = false + bl.previous = fs.bl + fs.bl = bl + assert (fs.freereg == fs.nactvar) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function leaveblock (fs) + local bl = fs.bl + fs.bl = bl.previous + --printf("[LEAVEBLOCK] Removing vars...") + removevars (fs, bl.nactvar) + --printf("[LEAVEBLOCK] ...Vars removed") + if bl.upval then + luaK:codeABC (fs, "OP_CLOSE", bl.nactvar, 0, 0) + end + -- a block either controls scope or breaks (never both) + assert (not bl.isbreakable or not bl.upval) + assert (bl.nactvar == fs.nactvar) + fs.freereg = fs.nactvar -- free registers + luaK:patchtohere (fs, bl.breaklist) +end + + +------------------------------------------------------------------------ +-- read a list of expressions from a list of ast [astlist] +-- starts at the [offset]th element of the list (defaults to 1) +------------------------------------------------------------------------ +local function explist(fs, astlist, v, offset) + offset = offset or 1 + if #astlist < offset then error "I don't handle empty expr lists yet" end + --printf("[EXPLIST] about to precompile 1st element %s", disp.ast(astlist[offset])) + expr.expr (fs, astlist[offset], v) + --printf("[EXPLIST] precompiled first element v=%s", tostringv(v)) + for i = offset+1, #astlist do + luaK:exp2nextreg (fs, v) + --printf("[EXPLIST] flushed v=%s", tostringv(v)) + expr.expr (fs, astlist[i], v) + --printf("[EXPLIST] precompiled element v=%s", tostringv(v)) + end + return #astlist - offset + 1 +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function funcargs (fs, ast, v, idx_from) + local args = { } -- expdesc + local nparams + if #ast < idx_from then args.k = "VVOID" else + explist(fs, ast, args, idx_from) + luaK:setmultret(fs, args) + end + assert(v.k == "VNONRELOC") + local base = v.info -- base register for call + if hasmultret(args.k) then nparams = luaK.LUA_MULTRET else -- open call + if args.k ~= "VVOID" then + luaK:exp2nextreg(fs, args) end -- close last argument + nparams = fs.freereg - (base + 1) + end + init_exp(v, "VCALL", luaK:codeABC(fs, "OP_CALL", base, nparams + 1, 2)) + luaK:fixline(fs, ast.line) + fs.freereg = base + 1 -- call remove function and arguments and leaves + -- (unless changed) one result +end + +------------------------------------------------------------------------ +-- calculates log value for encoding the hash portion's size +------------------------------------------------------------------------ +local function log2(x) + -- math result is always one more than lua0_log2() + local mn, ex = math.frexp(x) + return ex - 1 +end + +------------------------------------------------------------------------ +-- converts an integer to a "floating point byte", represented as +-- (mmmmmxxx), where the real value is (xxx) * 2^(mmmmm) +------------------------------------------------------------------------ + +-- local function int2fb(x) +-- local m = 0 -- mantissa +-- while x >= 8 do x = math.floor((x + 1) / 2); m = m + 1 end +-- return m * 8 + x +-- end + +local function int2fb(x) + local e = 0 + while x >= 16 do + x = math.floor ( (x+1) / 2) + e = e+1 + end + if x<8 then return x + else return (e+1) * 8 + x - 8 end +end + + +------------------------------------------------------------------------ +-- FIXME: to be unified with singlevar +------------------------------------------------------------------------ +local function singlevaraux(fs, n, var, base) +--[[ +print("\n\nsinglevaraux: fs, n, var, base") +printv(fs) +printv(n) +printv(var) +printv(base) +print("\n") +--]] + if fs == nil then -- no more levels? + init_exp(var, "VGLOBAL", luaP.NO_REG) -- default is global variable + return "VGLOBAL" + else + local v = searchvar(fs, n) -- look up at current level + if v >= 0 then + init_exp(var, "VLOCAL", v) + if not base then + markupval(fs, v) -- local will be used as an upval + end + else -- not found at current level; try upper one + if singlevaraux(fs.prev, n, var, false) == "VGLOBAL" then + return "VGLOBAL" end + var.info = indexupvalue (fs, n, var) + var.k = "VUPVAL" + return "VUPVAL" + end + end +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function singlevar(fs, varname, var) + if singlevaraux(fs, varname, var, true) == "VGLOBAL" then + var.info = luaK:stringK (fs, varname) end +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function new_localvar (fs, name, n) + assert (type (name) == "string") + if fs.nactvar + n > MAXVARS then error ("too many local vars") end + fs.actvar[fs.nactvar + n] = registerlocalvar (fs, name) + --printf("[NEW_LOCVAR] %i = %s", fs.nactvar+n, name) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function parlist (fs, ast_params) + local dots = (#ast_params > 0 and ast_params[#ast_params].tag == "Dots") + local nparams = dots and #ast_params - 1 or #ast_params + for i = 1, nparams do + assert (ast_params[i].tag == "Id", "Function parameters must be Ids") + new_localvar (fs, ast_params[i][1], i-1) + end + -- from [code_param]: + --checklimit (fs, fs.nactvar, self.MAXPARAMS, "parameters") + fs.f.numparams = fs.nactvar + fs.f.is_vararg = dots and VARARG_ISVARARG or 0 + adjustlocalvars (fs, nparams) + fs.f.numparams = fs.nactvar --FIXME vararg must be taken in account + luaK:reserveregs (fs, fs.nactvar) -- reserve register for parameters +end + +------------------------------------------------------------------------ +-- if there's more variables than expressions in an assignment, +-- some assignations to nil are made for extraneous vars. +-- Also handles multiret functions +------------------------------------------------------------------------ +local function adjust_assign (fs, nvars, nexps, e) + local extra = nvars - nexps + if hasmultret (e.k) then + extra = extra+1 -- includes call itself + if extra <= 0 then extra = 0 end + luaK:setreturns(fs, e, extra) -- call provides the difference + if extra > 1 then luaK:reserveregs(fs, extra-1) end + else + if e.k ~= "VVOID" then + luaK:exp2nextreg(fs, e) end -- close last expression + if extra > 0 then + local reg = fs.freereg + luaK:reserveregs(fs, extra) + luaK:_nil(fs, reg, extra) + end + end +end + + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function enterlevel (fs) + fs.nestlevel = fs.nestlevel + 1 + assert (fs.nestlevel <= LUA_MAXPARSERLEVEL, "too many syntax levels") +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function leavelevel (fs) + fs.nestlevel = fs.nestlevel - 1 +end + +------------------------------------------------------------------------ +-- Parse conditions in if/then/else, while, repeat +------------------------------------------------------------------------ +local function cond (fs, ast) + local v = { } + expr.expr(fs, ast, v) -- read condition + if v.k == "VNIL" then v.k = "VFALSE" end -- 'falses' are all equal here + luaK:goiftrue (fs, v) + return v.f +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function chunk (fs, ast) + enterlevel (fs) + assert (not ast.tag) + for i=1, #ast do + stat.stat (fs, ast[i]); + fs.freereg = fs.nactvar + end + leavelevel (fs) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function block (fs, ast) + local bl = {} + enterblock (fs, bl, false) + for i=1, #ast do + stat.stat (fs, ast[i]) + fs.freereg = fs.nactvar + end + assert (bl.breaklist == luaK.NO_JUMP) + leaveblock (fs) +end + +------------------------------------------------------------------------ +-- Forin / Fornum body parser +-- [fs] +-- [body] +-- [base] +-- [nvars] +-- [isnum] +------------------------------------------------------------------------ +local function forbody (fs, ast_body, base, nvars, isnum) + local bl = {} -- BlockCnt + adjustlocalvars (fs, 3) -- control variables + local prep = + isnum and luaK:codeAsBx (fs, "OP_FORPREP", base, luaK.NO_JUMP) + or luaK:jump (fs) + enterblock (fs, bl, false) -- loop block + adjustlocalvars (fs, nvars) -- scope for declared variables + luaK:reserveregs (fs, nvars) + block (fs, ast_body) + leaveblock (fs) + --luaK:patchtohere (fs, prep-1) + luaK:patchtohere (fs, prep) + local endfor = + isnum and luaK:codeAsBx (fs, "OP_FORLOOP", base, luaK.NO_JUMP) + or luaK:codeABC (fs, "OP_TFORLOOP", base, 0, nvars) + luaK:fixline (fs, ast_body.line) -- pretend that 'OP_FOR' starts the loop + luaK:patchlist (fs, isnum and endfor or luaK:jump(fs), prep + 1) +end + + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function recfield (fs, ast, cc) + local reg = fs.freereg + local key, val = {}, {} -- expdesc + --FIXME: expr + exp2val = index --> + -- check reduncancy between exp2val and exp2rk + cc.nh = cc.nh + 1 + expr.expr(fs, ast[1], key); + luaK:exp2val (fs, key) + local keyreg = luaK:exp2RK (fs, key) + expr.expr(fs, ast[2], val) + local valreg = luaK:exp2RK (fs, val) + luaK:codeABC(fs, "OP_SETTABLE", cc.t.info, keyreg, valreg) + fs.freereg = reg -- free registers +end + + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function listfield(fs, ast, cc) + expr.expr(fs, ast, cc.v) + assert (cc.na <= luaP.MAXARG_Bx) -- FIXME check <= or < + cc.na = cc.na + 1 + cc.tostore = cc.tostore + 1 +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +local function closelistfield(fs, cc) + if cc.v.k == "VVOID" then return end -- there is no list item + luaK:exp2nextreg(fs, cc.v) + cc.v.k = "VVOID" + if cc.tostore == luaP.LFIELDS_PER_FLUSH then + luaK:setlist (fs, cc.t.info, cc.na, cc.tostore) + cc.tostore = 0 + end +end + +------------------------------------------------------------------------ +-- The last field might be a call to a multireturn function. In that +-- case, we must unfold all of its results into the list. +------------------------------------------------------------------------ +local function lastlistfield(fs, cc) + if cc.tostore == 0 then return end + if hasmultret (cc.v.k) then + luaK:setmultret(fs, cc.v) + luaK:setlist (fs, cc.t.info, cc.na, luaK.LUA_MULTRET) + cc.na = cc.na - 1 + else + if cc.v.k ~= "VVOID" then luaK:exp2nextreg(fs, cc.v) end + luaK:setlist (fs, cc.t.info, cc.na, cc.tostore) + end +end +------------------------------------------------------------------------ +------------------------------------------------------------------------ +-- +-- Statement parsers table +-- +------------------------------------------------------------------------ +------------------------------------------------------------------------ + +function stat.stat (fs, ast) + if ast.line then fs.lastline = ast.line end + -- debugf (" - Statement %s", disp.ast (ast) ) + + if not ast.tag then chunk (fs, ast) else + + local parser = stat [ast.tag] + if not parser then + error ("A statement cannot have tag `"..ast.tag) end + parser (fs, ast) + end + --debugf (" - /Statement `%s", ast.tag or "") + debugf (" - /Statement `%s", ast.tag) +end + +------------------------------------------------------------------------ + +stat.Do = block + +------------------------------------------------------------------------ + +function stat.Break (fs, ast) + local bl, upval = fs.bl, false + while bl and not bl.isbreakable do + if bl.upval then upval = true end + bl = bl.previous + end + assert (bl, "no loop to break") + if upval then luaK:codeABC(fs, "OP_CLOSE", bl.nactvar, 0, 0) end + bl.breaklist = luaK:concat(fs, bl.breaklist, luaK:jump(fs)) +end + +------------------------------------------------------------------------ + +function stat.Return (fs, ast) + local e = {} -- expdesc + local first -- registers with returned values + local nret = #ast + + if nret == 0 then first = 0 + else + --printf("[RETURN] compiling explist") + explist (fs, ast, e) + --printf("[RETURN] explist e=%s", tostringv(e)) + if hasmultret (e.k) then + luaK:setmultret(fs, e) + if e.k == "VCALL" and nret == 1 then + luaP:SET_OPCODE(luaK:getcode(fs, e), "OP_TAILCALL") + assert(luaP:GETARG_A(luaK:getcode(fs, e)) == fs.nactvar) + end + first = fs.nactvar + nret = luaK.LUA_MULTRET -- return all values + elseif nret == 1 then + --printf("[RETURN] 1 val: e=%s", tostringv(e)) + first = luaK:exp2anyreg(fs, e) + --printf("[RETURN] 1 val in reg %i", first) + else + --printf("* Return multiple vals in nextreg %i", fs.freereg) + luaK:exp2nextreg(fs, e) -- values must go to the 'stack' + first = fs.nactvar -- return all 'active' values + assert(nret == fs.freereg - first) + end + end + luaK:ret(fs, first, nret) +end +------------------------------------------------------------------------ + +function stat.Local (fs, ast) + local names, values = ast[1], ast[2] + for i = 1, #names do new_localvar (fs, names[i][1], i-1) end + local e = { } + if #values == 0 then e.k = "VVOID" else explist (fs, values, e) end + adjust_assign (fs, #names, #values, e) + adjustlocalvars (fs, #names) +end + +------------------------------------------------------------------------ + +function stat.Localrec (fs, ast) + assert(#ast[1]==1 and #ast[2]==1, "Multiple letrecs not implemented yet") + local ast_var, ast_val, e_var, e_val = ast[1][1], ast[2][1], { }, { } + new_localvar (fs, ast_var[1], 0) + init_exp (e_var, "VLOCAL", fs.freereg) + luaK:reserveregs (fs, 1) + adjustlocalvars (fs, 1) + expr.expr (fs, ast_val, e_val) + luaK:storevar (fs, e_var, e_val) + getlocvar (fs, fs.nactvar-1).startpc = fs.pc +end + +------------------------------------------------------------------------ + +function stat.If (fs, ast) + local astlen = #ast + -- Degenerate case #1: no statement + if astlen==0 then return block(fs, { }) end + -- Degenerate case #2: only an else statement + if astlen==1 then return block(fs, ast[1]) end + + local function test_then_block (fs, test, body) + local condexit = cond (fs, test); + block (fs, body) + return condexit + end + + local escapelist = luaK.NO_JUMP + + local flist = test_then_block (fs, ast[1], ast[2]) -- 'then' statement + for i = 3, #ast - 1, 2 do -- 'elseif' statement + escapelist = luaK:concat( fs, escapelist, luaK:jump(fs)) + luaK:patchtohere (fs, flist) + flist = test_then_block (fs, ast[i], ast[i+1]) + end + if #ast % 2 == 1 then -- 'else' statement + escapelist = luaK:concat(fs, escapelist, luaK:jump(fs)) + luaK:patchtohere(fs, flist) + block (fs, ast[#ast]) + else + escapelist = luaK:concat(fs, escapelist, flist) + end + luaK:patchtohere(fs, escapelist) +end + +------------------------------------------------------------------------ + +function stat.Forin (fs, ast) + local vars, vals, body = ast[1], ast[2], ast[3] + -- imitating forstat: + local bl = { } + enterblock (fs, bl, true) + -- imitating forlist: + local e, base = { }, fs.freereg + new_localvar (fs, "(for generator)", 0) + new_localvar (fs, "(for state)", 1) + new_localvar (fs, "(for control)", 2) + for i = 1, #vars do new_localvar (fs, vars[i][1], i+2) end + explist (fs, vals, e) + adjust_assign (fs, 3, #vals, e) + luaK:checkstack (fs, 3) + forbody (fs, body, base, #vars, false) + -- back to forstat: + leaveblock (fs) +end + +------------------------------------------------------------------------ + +function stat.Fornum (fs, ast) + + local function exp1 (ast_e) + local e = { } + expr.expr (fs, ast_e, e) + luaK:exp2nextreg (fs, e) + end + -- imitating forstat: + local bl = { } + enterblock (fs, bl, true) + -- imitating fornum: + local base = fs.freereg + new_localvar (fs, "(for index)", 0) + new_localvar (fs, "(for limit)", 1) + new_localvar (fs, "(for step)", 2) + new_localvar (fs, ast[1][1], 3) + exp1 (ast[2]) -- initial value + exp1 (ast[3]) -- limit + if #ast == 5 then exp1 (ast[4]) else -- default step = 1 + luaK:codeABx(fs, "OP_LOADK", fs.freereg, luaK:numberK(fs, 1)) + luaK:reserveregs(fs, 1) + end + forbody (fs, ast[#ast], base, 1, true) + -- back to forstat: + leaveblock (fs) +end + +------------------------------------------------------------------------ +function stat.Repeat (fs, ast) + local repeat_init = luaK:getlabel (fs) + local bl1, bl2 = { }, { } + enterblock (fs, bl1, true) + enterblock (fs, bl2, false) + chunk (fs, ast[1]) + local condexit = cond (fs, ast[2]) + if not bl2.upval then + leaveblock (fs) + luaK:patchlist (fs, condexit, repeat_init) + else + stat.Break (fs) + luaK:patchtohere (fs, condexit) + leaveblock (fs) + luaK:patchlist (fs, luaK:jump (fs), repeat_init) + end + leaveblock (fs) +end + +------------------------------------------------------------------------ + +function stat.While (fs, ast) + local whileinit = luaK:getlabel (fs) + local condexit = cond (fs, ast[1]) + local bl = { } + enterblock (fs, bl, true) + block (fs, ast[2]) + luaK:patchlist (fs, luaK:jump (fs), whileinit) + leaveblock (fs) + luaK:patchtohere (fs, condexit); +end + +------------------------------------------------------------------------ + +-- FIXME: it's cumbersome to write this in this semi-recursive way. +function stat.Let (fs, ast) + local ast_lhs, ast_vals, e = ast[1], ast[2], { } + + --print "\n\nLet ast_lhs ast_vals:" + --print(disp.ast(ast_lhs)) + --print(disp.ast(ast_vals)) + + local function let_aux (lhs, nvars) + local legal = { VLOCAL=1, VUPVAL=1, VGLOBAL=1, VINDEXED=1 } + --printv(lhs) + if not legal [lhs.v.k] then + error ("Bad lhs expr: "..table.tostring(ast_lhs)) + end + if nvars < #ast_lhs then -- this is not the last lhs + local nv = { v = { }, prev = lhs } + expr.expr (fs, ast_lhs [nvars+1], nv.v) + if nv.v.k == "VLOCAL" then check_conflict (fs, lhs, nv.v) end + let_aux (nv, nvars+1) + else -- this IS the last lhs + explist (fs, ast_vals, e) + if #ast_vals < nvars then + adjust_assign (fs, nvars, #ast_vals, e) + elseif #ast_vals > nvars then + adjust_assign (fs, nvars, #ast_vals, e) + fs.freereg = fs.freereg - #ast_vals + nvars + else -- #ast_vals == nvars (and we're at last lhs) + luaK:setoneret (fs, e) -- close last expression + luaK:storevar (fs, lhs.v, e) + return -- avoid default + end + end + init_exp (e, "VNONRELOC", fs.freereg - 1) -- default assignment + luaK:storevar (fs, lhs.v, e) + end + + local lhs = { v = { }, prev = nil } + expr.expr (fs, ast_lhs[1], lhs.v) + let_aux( lhs, 1) +end + +------------------------------------------------------------------------ + +function stat.Call (fs, ast) + local v = { } + expr.Call (fs, ast, v) + luaP:SETARG_C (luaK:getcode(fs, v), 1) +end + +------------------------------------------------------------------------ + +function stat.Method (fs, ast) + local v = { } + expr.Method (fs, ast, v) +--FIXME: didn't check that, just copied from stat.Call + luaP:SETARG_C (luaK:getcode(fs, v), 1) +end + + +local function patch_goto (fs, src, dst) + +end + + +------------------------------------------------------------------------ +-- Goto/Label data: +-- fs.labels :: string => { nactvar :: int; pc :: int } +-- fs.forward_gotos :: string => list(int) +-- +-- fs.labels goes from label ids to the number of active variables at +-- the label's PC, and that PC +-- +-- fs.forward_gotos goes from label ids to the list of the PC where +-- some goto wants to jump to this label. Since gotos are actually made +-- up of two instructions OP_CLOSE and OP_JMP, it's the first instruction's +-- PC that's stored in fs.forward_gotos +-- +-- Note that backward gotos aren't stored: since their destination is knowns +-- when they're compiled, their target is directly set. +------------------------------------------------------------------------ + +------------------------------------------------------------------------ +-- Set a Label to jump to with Goto +------------------------------------------------------------------------ +function stat.Label (fs, ast) + local label_id = ast[1] + if type(label_id)=='table' then label_id=label_id[1] end + -- printf("Label %s at PC %i", label_id, fs.pc) + ------------------------------------------------------------------- + -- Register the label, so that future gotos can use it. + ------------------------------------------------------------------- + if fs.labels [label_id] then error "Duplicate label in function" + else fs.labels [label_id] = { pc = fs.pc; nactvar = fs.nactvar } end + local gotos = fs.forward_gotos [label_id] + if gotos then + ---------------------------------------------------------------- + -- Patch forward gotos which were targetting this label. + ---------------------------------------------------------------- + for _, goto_pc in ipairs(gotos) do + local close_instr = fs.f.code[goto_pc] + local jmp_instr = fs.f.code[goto_pc+1] + local goto_nactvar = luaP:GETARG_A (close_instr) + if fs.nactvar < goto_nactvar then + luaP:SETARG_A (close_instr, fs.nactvar) end + luaP:SETARG_sBx (jmp_instr, fs.pc - goto_pc - 2) + end + ---------------------------------------------------------------- + -- Gotos are patched, they can be forgotten about (when the + -- function will be finished, it will be checked that all gotos + -- have been patched, by checking that forward_goto is empty). + ---------------------------------------------------------------- + fs.forward_gotos[label_id] = nil + end +end + +------------------------------------------------------------------------ +-- jumps to a label set with stat.Label. +-- Argument must be a String or an Id +-- FIXME/optim: get rid of useless OP_CLOSE when nactvar doesn't change. +-- Thsi must be done both here for backward gotos, and in +-- stat.Label for forward gotos. +------------------------------------------------------------------------ +function stat.Goto (fs, ast) + local label_id = ast[1] + if type(label_id)=='table' then label_id=label_id[1] end + -- printf("Goto %s at PC %i", label_id, fs.pc) + local label = fs.labels[label_id] + if label then + ---------------------------------------------------------------- + -- Backward goto: the label already exists, so I can get its + -- nactvar and address directly. nactvar is used to close + -- upvalues if we get out of scoping blocks by jumping. + ---------------------------------------------------------------- + if fs.nactvar > label.nactvar then + luaK:codeABC (fs, "OP_CLOSE", label.nactvar, 0, 0) end + local offset = label.pc - fs.pc - 1 + luaK:codeAsBx (fs, "OP_JMP", 0, offset) + else + ---------------------------------------------------------------- + -- Forward goto: will be patched when the matching label is + -- found, forward_gotos[label_id] keeps the PC of the CLOSE + -- instruction just before the JMP. [stat.Label] will use it to + -- patch the OP_CLOSE and the OP_JMP. + ---------------------------------------------------------------- + if not fs.forward_gotos[label_id] then + fs.forward_gotos[label_id] = { } end + table.insert (fs.forward_gotos[label_id], fs.pc) + luaK:codeABC (fs, "OP_CLOSE", fs.nactvar, 0, 0) + luaK:codeAsBx (fs, "OP_JMP", 0, luaK.NO_JUMP) + end +end + +------------------------------------------------------------------------ +------------------------------------------------------------------------ +-- +-- Expression parsers table +-- +------------------------------------------------------------------------ +------------------------------------------------------------------------ + +function expr.expr (fs, ast, v) + if type(ast) ~= "table" then + error ("Expr AST expected, got "..table.tostring(ast)) end + if ast.line then fs.lastline = ast.line end + --debugf (" - Expression %s", tostringv (ast)) + local parser = expr[ast.tag] + if parser then parser (fs, ast, v) + elseif not ast.tag then + error ("No tag in expression "..table.tostring(ast)) + else + error ("No parser for node `"..ast.tag) end + debugf (" - /`%s", ast.tag) +end + +------------------------------------------------------------------------ + +function expr.Nil (fs, ast, v) init_exp (v, "VNIL", 0) end +function expr.True (fs, ast, v) init_exp (v, "VTRUE", 0) end +function expr.False (fs, ast, v) init_exp (v, "VFALSE", 0) end +function expr.String (fs, ast, v) codestring (fs, v, ast[1]) end +function expr.Number (fs, ast, v) + init_exp (v, "VKNUM", 0) + v.nval = ast[1] +end + +function expr.One (fs, ast, v) + expr.expr (fs, ast[1], v) + luaK:setoneret (fs, v) +end + +function expr.Dots (fs, ast, v) + assert (fs.f.is_vararg ~= 0, "No vararg in this function") + -- NEEDSARG flag is set if and only if the function is a vararg, + -- but no vararg has been used yet in its code. + if fs.f.is_vararg < VARARG_NEEDSARG then + fs.f.is_varag = fs.f.is_vararg - VARARG_NEEDSARG end + init_exp (v, "VVARARG", luaK:codeABC (fs, "OP_VARARG", 0, 1, 0)) +end + +------------------------------------------------------------------------ + +function expr.Table (fs, ast, v) + local pc = luaK:codeABC(fs, "OP_NEWTABLE", 0, 0, 0) + local cc = { v = { } , na = 0, nh = 0, tostore = 0, t = v } -- ConsControl + init_exp (v, "VRELOCABLE", pc) + init_exp (cc.v, "VVOID", 0) -- no value (yet) + luaK:exp2nextreg (fs, v) -- fix it at stack top (for gc) + for i = 1, #ast do + assert(cc.v.k == "VVOID" or cc.tostore > 0) + closelistfield(fs, cc); + (ast[i].tag == "Key" and recfield or listfield) (fs, ast[i], cc) + end + lastlistfield(fs, cc) + + -- Configure [OP_NEWTABLE] dimensions + luaP:SETARG_B(fs.f.code[pc], int2fb(cc.na)) -- set initial array size + luaP:SETARG_C(fs.f.code[pc], int2fb(cc.nh)) -- set initial table size + --printv(fs.f.code[pc]) +end + + +------------------------------------------------------------------------ + +function expr.Function (fs, ast, v) + local new_fs = open_func(fs) + if ast.line then new_fs.f.lineDefined = ast.line end + parlist (new_fs, ast[1]) + chunk (new_fs, ast[2]) + close_func (new_fs) + pushclosure(fs, new_fs, v) +end + +------------------------------------------------------------------------ + +function expr.Op (fs, ast, v) + if #ast == 2 then + expr.expr (fs, ast[2], v) + luaK:prefix (fs, ast[1], v) + elseif #ast == 3 then + local v2 = { } + expr.expr (fs, ast[2], v) + luaK:infix (fs, ast[1], v) + expr.expr (fs, ast[3], v2) + luaK:posfix (fs, ast[1], v, v2) + else + error "Wrong arg number" + end +end + +------------------------------------------------------------------------ + +function expr.Call (fs, ast, v) + expr.expr (fs, ast[1], v) + luaK:exp2nextreg (fs, v) + funcargs(fs, ast, v, 2) + --debugf("after expr.Call: %s, %s", v.k, luaP.opnames[luaK:getcode(fs, v).OP]) +end + +------------------------------------------------------------------------ +-- `Method{ table key args } +function expr.Method (fs, ast, v) + expr.expr (fs, ast[1], v) + luaK:dischargevars (fs, v) + local key = { } + codestring (fs, key, ast[2][1]) + luaK:_self (fs, v, key) + funcargs (fs, ast, v, 3) +end + +------------------------------------------------------------------------ + +function expr.Index (fs, ast, v) + if #ast ~= 2 then error "generalized indexes not implemented" end + + expr.expr (fs, ast[1], v) + luaK:exp2anyreg (fs, v) + + local k = { } + expr.expr (fs, ast[2], k) + luaK:exp2val (fs, k) + luaK:indexed (fs, v, k) +end + +------------------------------------------------------------------------ + +function expr.Id (fs, ast, v) + assert (ast.tag == "Id") + singlevar (fs, ast[1], v) +end + +------------------------------------------------------------------------ + +-- function expr.Stat (fs, ast, v) +-- -- Protect temporary stack values as phony local vars: +-- -- this way, they won't be overwritten. +-- local save_nactvar = fs.nactvar +-- -- Eventually, the result should go on top of stack, +-- -- whose index is saved in dest_reg. +-- local dest_reg = fs.freereg + +-- -- the part of actvar which is over nactvar might be filled with local var +-- -- indexes, although these variables don't have a register yet, typically in +-- -- `Local{ {...}, { `Stat{ ... } } }. Save them to restore them. +-- -- The computation of [last_unreg_var] is hackish because [fs.actvar] is +-- -- indexed form 0, and lua is much more comfortable with arrays starting +-- -- at 1. +-- local save_actvar = { } +-- local last_unreg_var = #fs.actvar +-- if last_unreg_var > 0 or fs.actvar[0] then +-- for i = fs.nactvar, last_unreg_var do +-- --printf("[STAT] save unregistered variable %i -> %i", i, fs.actvar[i]) +-- save_actvar[i] = fs.actvar[i] +-- end +-- end +-- fs.nactvar = fs.freereg +-- --printf("[STAT] pretend that there are %i actvars. Entering block...", fs.nactvar) +-- enterblock (fs, { }, false) +-- chunk (fs, ast[1]) +-- --printf("[STAT] result expr = %s", disp.ast (ast[2])) +-- expr.expr (fs, ast[2], v) +-- --printf("[STAT] v == %s must go to reg %i", tostringv(v), dest_reg) +-- -- Push the result on top of stack: + +-- -- FIXME: s'il y a des upvalues dans le bloc, il ne faut pas ecrire directement +-- -- dans dest_reg, mais [1] ecrire dans l'actuel freereg [2] fermer le bloc et +-- -- [3] transferer l'ancien freereg dans dest_reg. +-- -- Sinon, le CLOSE ne sera pas appele, et les upvalue ne seront pas fermees. + +-- luaK:exp2reg (fs, v, dest_reg) +-- --printf("[STAT] leaving block...") +-- leaveblock (fs) +-- --printf("[STAT] ...block leaved, nactvar back to %i", save_nactvar) +-- assert (dest_reg == fs.freereg) +-- -- Reserve the newly allocated stack level +-- fs.freereg=fs.freereg+1 +-- -- Push back nactvar, so that intermediate stacked value stop +-- -- being protected. +-- fs.nactvar = save_nactvar + +-- -- restore messed-up unregistered local vars +-- for i, j in pairs(save_actvar) do +-- fs.actvar[i] = j +-- end +-- end + +function expr.Stat (fs, ast, v) + -- Protect temporary stack values as phony local vars: + -- this way, they won't be overwritten. + local save_nactvar = fs.nactvar + -- Eventually, the result should go on top of stack, + -- whose index is saved in dest_reg. + local dest_reg = fs.freereg + + -- the part of actvar which is over nactvar might be filled with local var + -- indexes, although these variables don't have a register yet, typically in + -- `Local{ {...}, { `Stat{ ... } } }. Save them to restore them. + -- The computation of [last_unreg_var] is hackish because [fs.actvar] is + -- indexed form 0, and lua is much more comfortable with arrays starting + -- at 1. + local save_actvar = { } + local last_unreg_var = #fs.actvar + if last_unreg_var > 0 or fs.actvar[0] then + for i = fs.nactvar, last_unreg_var do + save_actvar[i] = fs.actvar[i] + end + end + fs.nactvar = fs.freereg + enterblock (fs, { }, false) + chunk (fs, ast[1]) + expr.expr (fs, ast[2], v) + luaK:exp2nextreg (fs, v) + leaveblock (fs) + luaK:exp2reg (fs, v, dest_reg) + + -- Reserve the newly allocated stack level + fs.freereg = fs.freereg+1 + -- Push back nactvar, so that intermediate stacked value stop + -- being protected. + fs.nactvar = save_nactvar + + -- restore messed-up unregistered local vars + for i, j in pairs(save_actvar) do + fs.actvar[i] = j + end +end + + + +------------------------------------------------------------------------ +-- Main function: ast --> proto +------------------------------------------------------------------------ +function metalua_compile (ast, source) + local fs = open_func (nil) + fs.f.is_vararg = VARARG_ISVARARG + chunk (fs, ast) + close_func (fs) + assert (fs.prev == nil) + assert (fs.f.nups == 0) + assert (fs.nestlevel == 0) + if source then fs.f.source = source end + return fs.f +end diff --git a/src/compiler/frontend.lua b/src/compiler/frontend.lua new file mode 100644 index 0000000..27b0bf8 --- /dev/null +++ b/src/compiler/frontend.lua @@ -0,0 +1,146 @@ +---------------------------------------------------------------------- +-- Metalua: $Id$ +-- +-- Summary: Main source file for Metalua compiler. +-- +---------------------------------------------------------------------- +-- +-- Copyright (c) 2006, Fabien Fleutot . +-- +-- This software is released under the MIT Licence, see licence.txt +-- for details. +-- +---------------------------------------------------------------------- + +do + local level = 0 + local function trace(e) + local name = debug.getinfo(2).name or "?" + if e=="call" then + print((": "):rep(level) .. e .. " " .. name) + level=level+1 + elseif e=="return" then + level=level-1 + --print(("."):rep(level) .. e .. " " .. name) + else + --print(("."):rep(level) .. e .. " " .. name) + end + end + --debug.sethook(trace, "cr") +end + +mlc.SHOW_METABUGS = false +PRINT_AST = false +EXECUTE = false +VERBOSE = false +PRINT_LINE_MAX = 80 +UNIX_SHARPBANG = [[#!/usr/bin/env lua]]..'\n' +LONG_NAMES = { + help = "-h" ; + ast = "-a" ; + output = "-o" ; + metabugs = "-b" ; + execute = "-x" ; + sharpbang = "-s" ; + verbose = "-v" } + +USAGE = [[ +Metalua compiler. +Usage: mlc [options] [files] +Options: + --help, -h: display this help + --ast, -a: print the AST resulting from file compilation + --output, -o: set the name of the next compiled file + --execute, -x: run the function instead of saving it + --metabugs, -b: undocumented + --verbose, -v: verbose + +Options -a, -x, -b can be reversed with +a, +x, +b. + +Options are taken into account only for the files that appear after them, +e.g. mlc foo.lua -x bar.lua will compile both files, but only execute bar.luac.]] + +local function print_if_verbose(msg) + if VERBOSE then printf(" [%3is]: %s", os.clock(), msg) end +end + +-- Compilation of a file: +-- [src_name] is the name of the input file; +-- [dst_name] is the optional name of the output file; if nil, an appropriate +-- name is built from [src_name] +-- What to do with the file is decided by the global variables. + +local function compile_file (src_name, dst_name) + printf("Compiling %s...", src_name) + + print_if_verbose "Build AST" + local ast = mlc.ast_of_luafile (src_name) + if not ast then error "Can't open or parse file" end + if PRINT_AST then table.print(ast, PRINT_LINE_MAX, "nohash") end + + -- Execute and save: + if EXECUTE and dst_name then + EXECUTE = false + dst_name = src_name .. (src_name:match ".*%.lua" and "c" or ".luac") + print_if_verbose "Build binary dump" + local bin = mlc.bin_of_ast (ast, src_name) + if not ast then error "Invalid parse tree" end + print_if_verbose "Write dump in file" + mlc.luacfile_of_bin (bin, dst_name) + printf("...Wrote %s; execute it:", dst_name) + print_if_verbose "Build function from dump" + local f = mlc.function_of_bin (bin) + f() + + -- Execute, don't save + elseif EXECUTE then + EXECUTE = false + print_if_verbose "Build function" + local f = mlc.function_of_ast(ast) + if not f then error "Invalid parse tree" end + printf("...Execute it:", dst_name) + f() + -- Save, don't execute + else + dst_name = dst_name or + src_name .. (src_name:match ".*%.lua" and "c" or ".luac") + print_if_verbose "Build dump and write to file" + mlc.luacfile_of_ast(ast, dst_name) + printf("...Wrote %s.", dst_name) + end +end + +-- argument parsing loop +local i = 1 +while i <= #arg do + local dst_name + local a = arg[i] + i=i+1 + local x = a:sub(1,1) + if x == "-" or x == "+" then + local bool = (x=="-") + if bool and a[1]=="-" then + -- double-dash: read long option + a = LONG_NAMES [a:sub(2)] + if not a then + printf("Unknown option %s\n\n%s", arg[i], USAGE) + return -1 + end + end + for j = 2, #a do + local opt = a:sub (j, j) + if opt == "h" then print (USAGE); return 0 + elseif opt == "a" then PRINT_AST = bool + elseif opt == "o" then dst_name = arg[i]; i=i+1 + elseif opt == "b" then mlc.SHOW_METABUGS = bool + elseif opt == "x" then EXECUTE = bool + elseif opt == "v" then VERBOSE = bool + elseif opt == "s" then + if bool then UNIX_SHARPBANG = arg[i]; i=i+1 + else UNIX_SHARPBANG = nil end + else error ("Unknown option -"..opt) end + end + else compile_file (a, dst_name) end +end + + diff --git a/src/compiler/gg.lua b/src/compiler/gg.lua new file mode 100644 index 0000000..180e212 --- /dev/null +++ b/src/compiler/gg.lua @@ -0,0 +1,653 @@ +---------------------------------------------------------------------- +-- Metalua: $Id: gg.lua,v 1.2 2006/11/15 09:07:50 fab13n Exp $ +-- +-- Summary: parser generator. Collection of higher order functors, +-- which allow to build and combine parsers. Relies on a lexer +-- that supports the same API as the one exposed in mll.lua. +-- +---------------------------------------------------------------------- +-- +-- Copyright (c) 2006, Fabien Fleutot . +-- +-- This software is released under the MIT Licence, see licence.txt +-- for details. +-- +---------------------------------------------------------------------- +-- History: +-- $Log: gg.lua,v $ +-- +---------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- +-- Exported API: +-- +-- Parser generators: +-- * [gg.sequence()] +-- * [gg.multisequence()] +-- * [gg.expr()] +-- * [gg.list()] +-- * [gg.onkeyword()] +-- * [gg.optkeyword()] +-- +-- Other functions: +-- * [gg.parse_error()] +-- * [gg.make_parser()] +-- * [gg.is_parser()] +-- +-------------------------------------------------------------------------------- + +module("gg", package.seeall) + +------------------------------------------------------------------------------- +-- parser metatable, which maps __call to method parse, and adds some +-- error tracing boilerplate. +------------------------------------------------------------------------------- +local parser_metatable = { } +function parser_metatable.__call (parser, lx, ...) + --printf ("Call parser %s/%s", parser.kind, parser.name or "?") + if mlc.metabugs then + --return parser:parse (lx, ...) + local x = parser:parse (lx, ...) + --printf ("Result: %s", _G.table.tostring(x, "nohash", 60)) + return x + else + local char = lx:peek().char + local status, ast = pcall (parser.parse, parser, lx, ...) + if status then return ast else + local msg = ast + if msg then print(msg) end + printf(" - (%i) in parser %s", char, parser.name or parser.kind) + error() + end + end +end + +------------------------------------------------------------------------------- +-- Turn a table into a parser, mainly by setting the metatable. +------------------------------------------------------------------------------- +function make_parser(kind, p) + p.kind = kind + if not p.transformers then p.transformers = { } end + function p.transformers:add (x) + table.insert (self, x) + end + setmetatable (p, parser_metatable) + return p +end + +------------------------------------------------------------------------------- +-- Return true iff [x] is a parser. +-- If it's a gg-generated parser, reutrn the name of its kind. +------------------------------------------------------------------------------- +function is_parser (x) + return type(x)=="function" or getmetatable(x)==parser_metatable and x.kind +end + +------------------------------------------------------------------------------- +-- Parse a sequence, without applying builder nor transformers +------------------------------------------------------------------------------- +local function raw_parse_sequence (lx, p) + local r = { } + for i=1, #p do + e=p[i] + if type(e) == "string" then + if not lx:is_keyword (lx:next(), e) then + parse_error (lx, "Keyword '%s' expected", e) end + elseif is_parser (e) then + table.insert (r, e (lx)) + else + gg.parse_error (lx,"Sequence `%s': element #%i is not a string ".. + "nor a parser: %s", + p.name, i, table.tostring(e)) + end + end + return r +end + +------------------------------------------------------------------------------- +-- Parse a multisequence, without applying multisequence transformers. +-- The sequences are completely parsed. +------------------------------------------------------------------------------- +local function raw_parse_multisequence (lx, sequence_table, default) + local seq_parser = sequence_table[lx:is_keyword(lx:peek())] + if seq_parser then return seq_parser (lx) + elseif default then return default (lx) + else return false end +end + +------------------------------------------------------------------------------- +-- Applies all transformers listed in parser on ast. +------------------------------------------------------------------------------- +local function transform (ast, parser) + if parser.transformers then + for _, t in ipairs (parser.transformers) do ast = t(ast) or ast end + end + return ast +end + +------------------------------------------------------------------------------- +-- Generate a tracable parsing error (not implemented yet) +------------------------------------------------------------------------------- +function parse_error(lx, fmt, ...) + local line = lx:peek().line or -1 + local char = lx:peek().char or -1 + local msg = string.format("line %i, char %i: "..fmt, line, char, ...) + local src = lx.src + if char>0 and src then + local i, j = char, char + while src:sub(i,i) ~= '\n' and i>=0 do i=i-1 end + while src:sub(j,j) ~= '\n' and j<=#src do j=j+1 end + local srcline = src:sub (i+1, j-1) + local idx = string.rep (" ", char-i-1).."^" + msg = printf("%s\n>>> %s\n>>> %s", msg, srcline, idx) + end + error(msg) +end + +------------------------------------------------------------------------------- +-- +-- Sequence parser generator +-- +------------------------------------------------------------------------------- +-- Input fields: +-- +-- * [builder]: how to build an AST out of sequence parts. let [x] be the list +-- of subparser results (keywords are simply omitted). [builder] can be: +-- - [nil], in which case the result of parsing is simply [x] +-- - a string, which is then put as a tag on [x] +-- - a function, which takes [x] as a parameter and returns an AST. +-- +-- * [name]: the name of the parser. Used for debug messages +-- +-- * [transformers]: a list of AST->AST functions, applied in order on ASTs +-- returned by the parser. +-- +-- * Table-part entries corresponds to keywords (strings) and subparsers +-- (function and callable objects). +-- +-- After creation, the following fields are added: +-- * [parse] the parsing function lexer->AST +-- * [kind] == "sequence" +-- * [name] is set, if it wasn't in the input. +-- +------------------------------------------------------------------------------- +function sequence (p) + make_parser ("sequence", p) + + ------------------------------------------------------------------- + -- Parsing method + ------------------------------------------------------------------- + function p:parse (lx) + -- Raw parsing: + local x = raw_parse_sequence (lx, self) + + -- Builder application: + local builder, tb = self.builder, type (self.builder) + if tb == "string" then x.tag = builder + elseif tb == "function" or builder and builder.__call then x = builder(x) + elseif builder == nil then -- nothing + else error("Invalid builder of type "..tb.." in sequence") end + return transform (x, self) + end + + ------------------------------------------------------------------- + -- Construction + ------------------------------------------------------------------- + -- Try to build a proper name + if not p.name and type(p[1])=="string" then + p.name = p[1].." ..." + if type(p[#p])=="string" then p.name = p.name .. " " .. p[#p] end + else + p.name = "" + end + + return p +end -- + + +------------------------------------------------------------------------------- +-- +-- Multiple, keyword-driven, sequence parser generator +-- +------------------------------------------------------------------------------- +-- in [p], useful fields are: +-- +-- * [transformers]: as usual +-- +-- * [name]: as usual +-- +-- * Table-part entries must be sequence parsers, or tables which can +-- be turned into a sequence parser by [gg.sequence]. These +-- sequences must start with a keyword, and this initial keyword +-- must be different for each sequence. The table-part entries will +-- be removed after [gg.multisequence] returns. +-- +-- * [default]: the parser to run if the next keyword in the lexer is +-- none of the registered initial keywords. If there's no default +-- parser and no suitable initial keyword, the multisequence parser +-- simply returns [false]. +-- +-- After creation, the following fields are added: +-- +-- * [parse] the parsing function lexer->AST +-- +-- * [sequences] the table of sequences, indexed by initial keywords. +-- +-- * [add] method takes a sequence parser or a config table for +-- [gg.sequence], and adds/replaces the corresponding sequence +-- parser. If the keyword was already used, the former sequence is +-- removed and a warning is issued. +-- +-- * [get] method returns a sequence by its initial keyword +-- +-- * [kind] == "multisequence" +-- +------------------------------------------------------------------------------- +function multisequence (p) + make_parser ("multisequence", p) + + ------------------------------------------------------------------- + -- Add a sequence (might be just a config table for [gg.sequence]) + ------------------------------------------------------------------- + function p:add (s) + -- compile if necessary: + if not is_parser(s) then sequence(s) end + if type(s[1]) ~= "string" then + error "Invalid sequence for multiseq" + elseif self.sequences[s[1]] then + printf (" *** Warning: keyword %q overloaded in multisequence ***", s[1]) + end + self.sequences[s[1]] = s + end -- + + ------------------------------------------------------------------- + -- Get the sequence starting with this keyword. [kw :: string] + ------------------------------------------------------------------- + function p:get (kw) return self.sequences[kw] end + + ------------------------------------------------------------------- + -- Get the sequence starting with this keyword. [kw :: string] + ------------------------------------------------------------------- + function p:remove (kw) + local x = self.sequences[kw] + self.sequences[kw] = nil + return x + end + + ------------------------------------------------------------------- + -- Parsing method + ------------------------------------------------------------------- + function p:parse (lx) + local x = raw_parse_multisequence (lx, self.sequences, self.default) + return transform (x, self) end + + ------------------------------------------------------------------- + -- Construction + ------------------------------------------------------------------- + -- Register the sequences passed to the constructor. They're going + -- from the array part of the parser to the hash part of field + -- [sequence] + p.sequences = { } + for i=1, #p do p:add (p[i]); p[i] = nil end + --if p.default and not is_parser(p.default) then sequence(p.default) end + return p +end -- + + +------------------------------------------------------------------------------- +-- +-- Expression parser generator +-- +------------------------------------------------------------------------------- +-- +-- Expression configuration relies on three tables: [prefix], [infix] +-- and [suffix]. Moreover, the primary parser can be replaced by a +-- table: in this case the [primary] table will be passed to +-- [gg.multisequence] to create a parser. +-- +-- Each of these tables is a modified multisequence parser: the +-- differences with respect to regular multisequence config tables are: +-- +-- * the builder takes specific parameters: +-- - for [prefix], it takes the result of the prefix sequence parser, +-- and the prefixed expression +-- - for [infix], it takes the left-hand-side expression, the results +-- of the infix sequence parser, and the right-hand-side expression. +-- - for [suffix], it takes the suffixed expression, and theresult +-- of the suffix sequence parser. +-- +-- * the default field is a list, with parameters: +-- - [parser] the raw parsing function +-- - [transformers], as usual +-- - [prec], the operator's precedence +-- - [assoc] for [infix] table, the operator's associativity, which +-- can be "left", "right" or "flat" (default to left) +-- +-- In [p], useful fields are: +-- * [transformers]: as usual +-- * [name]: as usual +-- * [primary]: the atomic expression parser, or a multisequence config +-- table (mandatory) +-- * [prefix]: prefix operators config table, see above. +-- * [infix]: infix operators config table, see above. +-- * [suffix]: suffix operators config table, see above. +-- +-- After creation, these fields are added: +-- * [kind] == "expr" +-- * [parse] as usual +-- * each table is turned into a multisequence, and therefore has an +-- [add] method +-- +------------------------------------------------------------------------------- +function expr (p) + make_parser ("expr", p) + + ------------------------------------------------------------------- + -- parser method. + -- In addition to the lexer, it takes an optional precedence: + -- it won't read expressions whose precedence is lower or equal + -- to [prec]. + ------------------------------------------------------------------- + function p:parse (lx, prec) + if not prec then prec = 0 end + + ------------------------------------------------------ + -- Extract the right parser and the corresponding + -- options table, for (pre|in|post)fix operators. + -- Options include prec, assoc, transformers. + ------------------------------------------------------ + local function get_parser_info (tab) + local p2 = tab:get (lx:is_keyword (lx:peek())) + if p2 then -- keyword-based sequence found + local function parser(lx) return raw_parse_sequence(lx, p2) end + return parser, p2 + else -- Got to use the default parser + local d = tab.default + if d then return d.parse or d.parser, d + else return false, false end + end + end + + ------------------------------------------------------ + -- Look for a prefix sequence. Multiple prefixes are + -- handled through the recursive [p.parse] call. + -- Notice the double-transform: one for the primary + -- expr, and one for the one with the prefix op. + ------------------------------------------------------ + local function handle_prefix () + local p2_func, p2 = get_parser_info (self.prefix) + local op = p2_func and p2_func(lx) + if op then -- Keyword-based sequence found + local e = p2.builder (op, self:parse (lx, p2.prec)) + return transform (transform (e, p2), self) + else -- No prefix found, get a primary expression + return transform (self.primary (lx), self) + end + end -- + + ------------------------------------------------------ + -- Look for an infix sequence+right-hand-side operand. + -- Return the whole binary expression result, + -- or false if no operator was found. + ------------------------------------------------------ + local function handle_infix (e) + local p2_func, p2 = get_parser_info (self.infix) + if not p2 then return false end + + ----------------------------------------- + -- Handle flattening operators: gather all operands + -- of the series in [list]; when a different operator + -- is found, stop, build from [list], [transform] and + -- return. + ----------------------------------------- + if (not p2.prec or p2.prec>prec) and p2.assoc=="flat" then + local pflat, list = p2, { } + repeat + local op = p2_func(lx) + if not op then break end + table.insert (list, self:parse (lx, p2.prec)) + p2 = get_parser_info (self.infix) + until p2 ~= pflat + return transform (transform (p2.builder (list), p2), self) + + ----------------------------------------- + -- Handle regular infix operators: [e] the LHS is known, + -- just gather the operator and [e2] the RHS. + ----------------------------------------- + elseif p2.prec and p2.prec>prec or + p2.prec==prec and p2.assoc=="right" then + local op = p2_func(lx) + if not op then return false end + local e2 = self:parse (lx, p2.prec) + return transform (transform (p2.builder (e, op, e2), p2), self) + + ----------------------------------------- + -- Check for non-associative operators, and complain if applicable. + ----------------------------------------- + elseif p2.assoc=="none" and p2.prec==prec then + parser_error (lx, "non-associative operator!") + + ----------------------------------------- + -- No infix operator suitable at that precedence + ----------------------------------------- + else return false end + + end -- + + ------------------------------------------------------ + -- Look for a suffix sequence. + -- Return the result of suffix operator on [e], + -- or false if no operator was found. + ------------------------------------------------------ + local function handle_suffix (e) + local p2_func, p2 = get_parser_info (self.suffix) + if not p2 then return false end + if not p2.prec or p2.prec>=prec then + local op = p2_func(lx) + if not op then return false end + e = p2.builder (e, op) + return transform (transform (e, p2), self) + end + return false + end -- + + ------------------------------------------------------ + -- Parser body: read suffix and (infix+operand) + -- extensions as long as we're able to fetch more at + -- this precedence level. + ------------------------------------------------------ + local e = handle_prefix() + repeat + local x = handle_suffix (e); e = x or e + local y = handle_infix (e); e = y or e + until not (x or y) + + -- No transform: it already happened in operators handling + return e + end -- + + ------------------------------------------------------------------- + -- Construction + ------------------------------------------------------------------- + if not p.primary then p.primary=p[1]; p[1]=nil end + for _, t in ipairs{ "primary", "prefix", "infix", "suffix" } do + if not p[t] then p[t] = { } end + if not is_parser(p[t]) then multisequence(p[t]) end + end + function p:add(...) return self.primary:add(...) end + return p +end -- + + +------------------------------------------------------------------------------- +-- +-- List parser generator +-- +------------------------------------------------------------------------------- +-- In [p], the following fields can be provided in input: +-- +-- * [builder]: takes list of subparser results, returns AST +-- * [transformers]: as usual +-- * [name]: as usual +-- +-- * [terminators]: list of strings representing the keywords which +-- might mark the end of the list. When non-empty, the list is +-- allowed to be empty. A string is treated as a single-element +-- table, whose element is that string, e.g. ["do"] is the same as +-- [{"do"}]. +-- +-- * [separators]: list of strings representing the keywords which can +-- separate elements of the list. When non-empty, one of these +-- keyword has to be found between each element. Lack of a separator +-- indicates the end of the list. A string is treated as a +-- single-element table, whose element is that string, e.g. ["do"] +-- is the same as [{"do"}]. If [terminators] is empty/nil, then +-- [separators] has to be non-empty. +-- +-- After creation, the following fields are added: +-- * [parse] the parsing function lexer->AST +-- * [kind] == "list" +-- +------------------------------------------------------------------------------- +function list (p) + make_parser ("list", p) + + ------------------------------------------------------------------- + -- Parsing method + ------------------------------------------------------------------- + function p:parse (lx) + + ------------------------------------------------------ + -- Used to quickly check whether there's a terminator + -- or a separator immediately ahead + ------------------------------------------------------ + local function peek_is_in (keywords) + return keywords and lx:is_keyword(lx:peek(), unpack(keywords)) end + + local x = { } + + -- if there's a terminator to start with, don't bother trying + if not peek_is_in (self.terminators) then + repeat table.insert (x, self.primary (lx)) -- read one element + until + -- First reason to stop: There's a separator list specified, + -- and next token isn't one. Otherwise, consume it with [lx:next()] + self.separators and not(peek_is_in (self.separators) and lx:next()) or + -- Other reason to stop: terminator token ahead + peek_is_in (self.terminators) or + -- Last reason: end of file reached + lx:peek().tag=="Eof" + end + + -- Apply the builder. It can be a string, or a callable value, + -- or simply nothing. + local b = self.builder + if b then + if type(b)=="string" then x.tag = b -- b is a string, use it as a tag + elseif type(b)=="function" then x=b(x) + else + local bmt = getmetatable(b) + if bmt and bmt.__call then x=b(x) end + end + end + return transform (x, self) + end -- + + ------------------------------------------------------------------- + -- Construction + ------------------------------------------------------------------- + if not p.primary then p.primary = p[1]; p[1] = nil end + if type(p.terminators) == "string" then p.terminators = { p.terminators } + elseif p.terminators and #p.terminators == 0 then p.terminators = nil end + if type(p.separators) == "string" then p.separators = { p.separators } + elseif p.separators and #p.separators == 0 then p.separators = nil end + + return p +end -- + + +------------------------------------------------------------------------------- +-- +-- Keyword-conditionned parser generator +-- +------------------------------------------------------------------------------- +-- +-- Only apply a parser if a given keyword is found. The result of +-- [gg.onkeyword] parser is the result of the subparser (modulo +-- [transformers] applications). +-- +-- Input fields: +-- +-- * [name]: as usual +-- +-- * [transformers]: as usual +-- +-- * [peek]: if non-nil, the conditionning keyword is left in the lexeme +-- stream instead of being consumed. +-- +-- * [primary]: the subparser. +-- +-- * [keywords]: list of strings representing triggering keywords. +-- +-- * Table-part entries can contain strings, and/or exactly one parser. +-- Strings are put in [keywords], and the parser is put in [primary]. +-- +-- After the call, the following fields will be set: +-- +-- * [parse] the parsing method +-- * [kind] == "onkeyword" +-- * [primary] +-- * [keywords] +-- +------------------------------------------------------------------------------- +function onkeyword (p) + make_parser ("onkeyword", p) + + ------------------------------------------------------------------- + -- Parsing method + ------------------------------------------------------------------- + function p:parse(lx) + if lx:is_keyword (lx:peek(), unpack(self.keywords)) then + if not self.peek then lx:next() end + return transform (self.primary(lx), p) + else return false end + end + + ------------------------------------------------------------------- + -- Construction + ------------------------------------------------------------------- + if not p.keywords then p.keywords = { } end + for _, x in ipairs(p) do + if type(x)=="string" then table.insert (p.keywords, x) + else assert (not p.primary and is_parser (x)); p.primary = x end + end + assert (p.primary) + return p +end -- + + +------------------------------------------------------------------------------- +-- +-- Optional keyword consummer pseudo-parser generator +-- +------------------------------------------------------------------------------- +-- +-- This doesn't return a real parser, just a function. That function parses +-- one of the keywords passed as parameters, and returns it. It returns +-- [false] if no matching keyword is found. +-- +------------------------------------------------------------------------------- +function optkeyword (...) + local args = {...} + if type (args[1]) == "table" then + assert (#args == 1) + args = args[1] + end + for _, v in ipairs(args) do assert (type(v)=="string") end + return function (lx) + local x = lx:is_keyword (lx:peek(), unpack (args)) + if x then lx:next(); return x + else return false end + end +end diff --git a/src/compiler/lcode.lua b/src/compiler/lcode.lua new file mode 100644 index 0000000..6d61f94 --- /dev/null +++ b/src/compiler/lcode.lua @@ -0,0 +1,1035 @@ +---------------------------------------------------------------------- +-- +-- WARNING! You're entering a hackish area, proceed at your own risks! +-- +-- This code results from the borrowing, then ruthless abuse, of +-- Yueliang's implementation of Lua 5.0 compiler. I claim +-- responsibility for all of the ugly, dirty stuff that you might spot +-- in it. +-- +-- Eventually, this code will be rewritten, either in Lua or more +-- probably in C. Meanwhile, if you're interested into digging +-- metalua's sources, this is not the best part to invest your time +-- on. +-- +-- End of warning. +-- +---------------------------------------------------------------------- + +--[[-------------------------------------------------------------------- + + $Id: lcode.lua,v 1.5 2006/11/15 09:07:50 fab13n Exp $ + + lcode.lua + Lua 5 code generator in Lua + This file is part of Yueliang. + + Copyright (c) 2005 Kein-Hong Man + The COPYRIGHT file describes the conditions + under which this software may be distributed. + + See the ChangeLog for more information. + +------------------------------------------------------------------------ + + [FF] Slightly modified, mainly to produce Lua 5.1 bytecode. + + $Log: lcode.lua,v $ + Revision 1.5 2006/11/15 09:07:50 fab13n + debugged meta operators. + Added command line options handling. + + Revision 1.4 2006/11/09 09:39:57 fab13n + some cleanup + + Revision 1.3 2006/11/07 04:37:59 fab13n + first bootstrapping version. + + Revision 1.2 2006/11/05 15:08:34 fab13n + updated code generation, to be compliant with 5.1 + + +----------------------------------------------------------------------]] + +--[[-------------------------------------------------------------------- +-- Notes: +-- * one function manipulate a pointer argument with a simple data type +-- (can't be emulated by a table, ambiguous), now returns that value: +-- luaK:concat(fs, l1, l2) +-- * some function parameters changed to boolean, additional code +-- translates boolean back to 1/0 for instruction fields +-- * Added: +-- luaK:ttisnumber(o) (from lobject.h) +-- luaK:nvalue(o) (from lobject.h) +-- luaK:setnilvalue(o) (from lobject.h) +-- luaK:setsvalue(o) (from lobject.h) +-- luaK:setnvalue(o) (from lobject.h) +-- luaK:sethvalue(o) (from lobject.h) +----------------------------------------------------------------------]] + +module("bytecode", package.seeall) + +local function debugf() end + +luaK = {} + +luaK.MAXSTACK = 250 -- (llimits.h, used in lcode.lua) +luaK.LUA_MULTRET = -1 -- (lua.h) + +------------------------------------------------------------------------ +-- Marks the end of a patch list. It is an invalid value both as an absolute +-- address, and as a list link (would link an element to itself). +------------------------------------------------------------------------ +luaK.NO_JUMP = -1 + +--FF 5.1 +function luaK:isnumeral(e) + return e.k=="VKNUM" and e.t==self.NO_JUMP and e.t==self.NO_JUMP +end + +------------------------------------------------------------------------ +-- emulation of TObject macros (these are from lobject.h) +-- * TObject is a table since lcode passes references around +-- * tt member field removed, using Lua's type() instead +------------------------------------------------------------------------ +function luaK:ttisnumber(o) + if o then return type(o.value) == "number" else return false end +end +function luaK:nvalue(o) return o.value end +function luaK:setnilvalue(o) o.value = nil end +function luaK:setsvalue(o, s) o.value = s end +luaK.setnvalue = luaK.setsvalue +luaK.sethvalue = luaK.setsvalue + +------------------------------------------------------------------------ +-- returns the instruction object for given e (expdesc) +------------------------------------------------------------------------ +function luaK:getcode(fs, e) + return fs.f.code[e.info] +end + +------------------------------------------------------------------------ +-- codes an instruction with a signed Bx (sBx) field +------------------------------------------------------------------------ +function luaK:codeAsBx(fs, o, A, sBx) + return self:codeABx(fs, o, A, sBx + luaP.MAXARG_sBx) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:hasjumps(e) + return e.t ~= e.f +end + +------------------------------------------------------------------------ +-- FF updated 5.1 +------------------------------------------------------------------------ +function luaK:_nil(fs, from, n) + if fs.pc > fs.lasttarget then -- no jumps to current position? + if fs.pc == 0 then return end --function start, positions are already clean + local previous = fs.f.code[fs.pc - 1] + if luaP:GET_OPCODE(previous) == "OP_LOADNIL" then + local pfrom = luaP:GETARG_A(previous) + local pto = luaP:GETARG_B(previous) + if pfrom <= from and from <= pto + 1 then -- can connect both? + if from + n - 1 > pto then + luaP:SETARG_B(previous, from + n - 1) + end + return + end + end + end + self:codeABC(fs, "OP_LOADNIL", from, from + n - 1, 0) -- else no optimization +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:jump(fs) + local jpc = fs.jpc -- save list of jumps to here + fs.jpc = self.NO_JUMP + local j = self:codeAsBx(fs, "OP_JMP", 0, self.NO_JUMP) + return self:concat(fs, j, jpc) -- keep them on hold +end + +--FF 5.1 +function luaK:ret (fs, first, nret) + luaK:codeABC (fs, "OP_RETURN", first, nret+1, 0) +end + + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:condjump(fs, op, A, B, C) + self:codeABC(fs, op, A, B, C) + return self:jump(fs) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:fixjump(fs, pc, dest) + local jmp = fs.f.code[pc] + local offset = dest - (pc + 1) + assert(dest ~= self.NO_JUMP) + if math.abs(offset) > luaP.MAXARG_sBx then + luaX:syntaxerror(fs.ls, "control structure too long") + end + luaP:SETARG_sBx(jmp, offset) +end + +------------------------------------------------------------------------ +-- returns current 'pc' and marks it as a jump target (to avoid wrong +-- optimizations with consecutive instructions not in the same basic block). +------------------------------------------------------------------------ +function luaK:getlabel(fs) + fs.lasttarget = fs.pc + return fs.pc +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:getjump(fs, pc) + local offset = luaP:GETARG_sBx(fs.f.code[pc]) + if offset == self.NO_JUMP then -- point to itself represents end of list + return self.NO_JUMP -- end of list + else + return (pc + 1) + offset -- turn offset into absolute position + end +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:getjumpcontrol(fs, pc) + local pi = fs.f.code[pc] + local ppi = fs.f.code[pc - 1] + if pc >= 1 and luaP:testOpMode(luaP:GET_OPCODE(ppi), "OpModeT") then + return ppi + else + return pi + end +end + +------------------------------------------------------------------------ +-- check whether list has any jump that do not produce a value +-- (or produce an inverted value) +------------------------------------------------------------------------ +--FF updated 5.1 +function luaK:need_value(fs, list, cond) + while list ~= self.NO_JUMP do + local i = self:getjumpcontrol(fs, list) + if luaP:GET_OPCODE(i) ~= "OP_TESTSET" or + luaP:GETARG_A(i) ~= luaP.NO_REG or + luaP:GETARG_C(i) ~= cond then + return true + end + list = self:getjump(fs, list) + end + return false -- not found +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +--FF updated 5.1 +function luaK:patchtestreg(fs, node, reg) + assert(reg) -- pour assurer, vu que j'ai ajoute un parametre p/r a 5.0 + local i = self:getjumpcontrol(fs, node) + if luaP:GET_OPCODE(i) ~= "OP_TESTSET" then + return false end -- cannot patch other instructions + if reg ~= luaP.NO_REG and reg ~= luaP:GETARG_B(i) then + luaP:SETARG_A(i, reg) + else + -- no register to put value or register already has the value + luaP:SET_OPCODE(i, "OP_TEST") + luaP:SETARG_A(i, luaP:GETARG_B(i)) + luaP:SETARG_B(i, 0) + luaP:SETARG_C(i, luaP:GETARG_C(i)) + end + return true +end + +--FF added 5.1 +function luaK:removevalues (fs, list) + while list ~= self.NO_JUMP do + self:patchtestreg (fs, list, luaP.NO_REG) + list = self:getjump (fs, list) + end +end + +------------------------------------------------------------------------ +-- FF updated 5.1 +------------------------------------------------------------------------ +function luaK:patchlistaux(fs, list, vtarget, reg, dtarget) + while list ~= self.NO_JUMP do + local _next = self:getjump(fs, list) + if self:patchtestreg (fs, list, reg) then + self:fixjump(fs, list, vtarget) + else + self:fixjump (fs, list, dtarget) + end + list = _next + end +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:dischargejpc(fs) + self:patchlistaux(fs, fs.jpc, fs.pc, luaP.NO_REG, fs.pc) + fs.jpc = self.NO_JUMP +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:patchlist(fs, list, target) + if target == fs.pc then + self:patchtohere(fs, list) + else + assert(target < fs.pc) + self:patchlistaux(fs, list, target, luaP.NO_REG, target) + end +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:patchtohere(fs, list) + self:getlabel(fs) + fs.jpc = self:concat(fs, fs.jpc, list) +end + +------------------------------------------------------------------------ +-- * l1 was a pointer, now l1 is returned and callee assigns the value +------------------------------------------------------------------------ +function luaK:concat(fs, l1, l2) + if l2 == self.NO_JUMP then return l1 -- unchanged + elseif l1 == self.NO_JUMP then + return l2 -- changed + else + local list = l1 + local _next = self:getjump(fs, list) + while _next ~= self.NO_JUMP do -- find last element + list = _next + _next = self:getjump(fs, list) + end + self:fixjump(fs, list, l2) + end + return l1 -- unchanged +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:checkstack(fs, n) + local newstack = fs.freereg + n + if newstack > fs.f.maxstacksize then + if newstack >= luaK.MAXSTACK then + luaX:syntaxerror(fs.ls, "function or expression too complex") + end + fs.f.maxstacksize = newstack + end +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:reserveregs(fs, n) + self:checkstack(fs, n) + fs.freereg = fs.freereg + n +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:freereg(fs, reg) + if not luaP:ISK (reg) and reg >= fs.nactvar then + fs.freereg = fs.freereg - 1 + assert(reg == fs.freereg, + string.format("reg=%i, fs.freereg=%i", reg, fs.freereg)) + end +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:freeexp(fs, e) + if e.k == "VNONRELOC" then + self:freereg(fs, e.info) + end +end + +------------------------------------------------------------------------ +-- k is a constant, v is... what? +-- fs.h is a hash value --> index in f.k +------------------------------------------------------------------------ +-- * luaH_get, luaH_set deleted; direct table access used instead +-- * luaO_rawequalObj deleted in first assert +-- * setobj2n deleted in assignment of v to f.k table +------------------------------------------------------------------------ +--FF radically updated, not completely understood +function luaK:addk(fs, k, v) + local idx = fs.h[k.value] + local f = fs.f +-- local oldsize = f.sizek + if self:ttisnumber (idx) then + --TODO this assert currently FAILS + --assert(fs.f.k[self:nvalue(idx)] == v) + return self:nvalue(idx) + else -- constant not found; create a new entry + do + local t = type (v.value) + assert(t=="nil" or t=="string" or t=="number" or t=="boolean") + end + --debugf("[const: k[%i] = %s ]", fs.nk, tostringv(v.value)) + fs.f.k[fs.nk] = v + fs.h[k.value] = { } + self:setnvalue(fs.h[k.value], fs.nk) + local nk = fs.nk + fs.nk = fs.nk+1 + return nk + end +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:stringK(fs, s) + assert (type(s)=="string") + local o = {} -- TObject + self:setsvalue(o, s) + return self:addk(fs, o, o) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:numberK(fs, r) + assert (type(r)=="number") + local o = {} -- TObject + self:setnvalue(o, r) + return self:addk(fs, o, o) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:boolK(fs, r) + assert (type(r)=="boolean") + local o = {} -- TObject + self:setnvalue(o, r) + return self:addk(fs, o, o) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:nilK(fs) + local k, v = {}, {} -- TObject + self:setnilvalue(v) + self:sethvalue(k, fs.h) -- cannot use nil as key; instead use table itself + return self:addk(fs, k, v) +end + + +--FF 5.1 +function luaK:setreturns (fs, e, nresults) + if e.k == "VCALL" then -- expression is an open function call? + luaP:SETARG_C(self:getcode(fs, e), nresults + 1) + elseif e.k == "VVARARG" then + luaP:SETARG_B (self:getcode (fs, e), nresults + 1) + luaP:SETARG_A (self:getcode (fs, e), fs.freereg) + self:reserveregs (fs, 1) + end +end + +--FF 5.1 +function luaK:setmultret (fs, e) + self:setreturns (fs, e, self.LUA_MULTRET) +end + +--FF 5.1 +function luaK:setoneret (fs, e) + if e.k == "VCALL" then -- expression is an open function call? + e.k = "VNONRELOC" + e.info = luaP:GETARG_A(self:getcode(fs, e)) + elseif e.k == "VVARARG" then + luaP:SETARG_B (self:getcode (fs, e), 2) + e.k = "VRELOCABLE" + end +end + + +------------------------------------------------------------------------ +--FF deprecated in 5.1 +------------------------------------------------------------------------ +function luaK:setcallreturns(fs, e, nresults) + assert (false, "setcallreturns deprecated") + --print "SCR:" + --printv(e) + --printv(self:getcode(fs, e)) + if e.k == "VCALL" then -- expression is an open function call? + luaP:SETARG_C(self:getcode(fs, e), nresults + 1) + if nresults == 1 then -- 'regular' expression? + e.k = "VNONRELOC" + e.info = luaP:GETARG_A(self:getcode(fs, e)) + end + elseif e.k == "VVARARG" then + --printf("Handle vararg return on expr %s, whose code is %s", + -- tostringv(e), tostringv(self:getcode(fs, e))) + if nresults == 1 then + luaP:SETARG_B (self:getcode (fs, e), 2) + e.k = "VRELOCABLE" +--FIXME: why no SETARG_A??? + else + luaP:SETARG_B (self:getcode (fs, e), nresults + 1) + luaP:SETARG_A (self:getcode (fs, e), fs.freereg) + self:reserveregs (fs, 1) + --printf("Now code is %s", tostringv(self:getcode(fs, e))) + end + end +end + +------------------------------------------------------------------------ +-- Ajoute le code pour effectuer l'extraction de la locvar/upval/globvar +-- /idx, sachant +------------------------------------------------------------------------ +function luaK:dischargevars(fs, e) +--printf("\ndischargevars\n") + local k = e.k + if k == "VLOCAL" then + e.k = "VNONRELOC" + elseif k == "VUPVAL" then + e.info = self:codeABC(fs, "OP_GETUPVAL", 0, e.info, 0) + e.k = "VRELOCABLE" + elseif k == "VGLOBAL" then + e.info = self:codeABx(fs, "OP_GETGLOBAL", 0, e.info) + e.k = "VRELOCABLE" + elseif k == "VINDEXED" then + self:freereg(fs, e.aux) + self:freereg(fs, e.info) + e.info = self:codeABC(fs, "OP_GETTABLE", 0, e.info, e.aux) + e.k = "VRELOCABLE" + elseif k == "VCALL" or k == "VVARARG" then + self:setoneret(fs, e) + else + -- there is one value available (somewhere) + end +--printf("\n/dischargevars\n") +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:code_label(fs, A, b, jump) + self:getlabel(fs) -- those instructions may be jump targets + return self:codeABC(fs, "OP_LOADBOOL", A, b, jump) +end + +------------------------------------------------------------------------ +-- FF updated 5.1 +------------------------------------------------------------------------ +function luaK:discharge2reg(fs, e, reg) + self:dischargevars(fs, e) + local k = e.k + if k == "VNIL" then + self:_nil(fs, reg, 1) + elseif k == "VFALSE" or k == "VTRUE" then + self:codeABC(fs, "OP_LOADBOOL", reg, (e.k == "VTRUE") and 1 or 0, 0) + elseif k == "VKNUM" then + self:codeABx (fs, "OP_LOADK", reg, self:numberK(fs, e.nval)) + elseif k == "VK" then + self:codeABx(fs, "OP_LOADK", reg, e.info) + elseif k == "VRELOCABLE" then + local pc = self:getcode(fs, e) + luaP:SETARG_A(pc, reg) + elseif k == "VNONRELOC" then + if reg ~= e.info then + self:codeABC(fs, "OP_MOVE", reg, e.info, 0) + end + else + assert(e.k == "VVOID" or e.k == "VJMP") + return -- nothing to do... + end + e.info = reg + e.k = "VNONRELOC" +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:discharge2anyreg(fs, e) + if e.k ~= "VNONRELOC" then + self:reserveregs(fs, 1) + self:discharge2reg(fs, e, fs.freereg - 1) + end +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:exp2reg(fs, e, reg) + self:discharge2reg(fs, e, reg) + if e.k == "VJMP" then + e.t = self:concat(fs, e.t, e.info) -- put this jump in 't' list + end + if self:hasjumps(e) then + local final -- position after whole expression + local p_f = self.NO_JUMP -- position of an eventual LOAD false + local p_t = self.NO_JUMP -- position of an eventual LOAD true + if self:need_value(fs, e.t, 1) or self:need_value(fs, e.f, 0) then + local fj = self.NO_JUMP -- first jump (over LOAD ops.) + if e.k ~= "VJMP" then fj = self:jump(fs) end + p_f = self:code_label(fs, reg, 0, 1) + p_t = self:code_label(fs, reg, 1, 0) + self:patchtohere(fs, fj) + end + final = self:getlabel(fs) + self:patchlistaux(fs, e.f, final, reg, p_f) + self:patchlistaux(fs, e.t, final, reg, p_t) + end + e.f, e.t = self.NO_JUMP, self.NO_JUMP + e.info = reg + e.k = "VNONRELOC" +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:exp2nextreg(fs, e) + self:dischargevars(fs, e) + --[FF] Allready in place (added for expr.Stat) + if e.k == "VNONRELOC" and e.info == fs.freereg then + return end + self:freeexp(fs, e) + self:reserveregs(fs, 1) + self:exp2reg(fs, e, fs.freereg - 1) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:exp2anyreg(fs, e) + --printf("exp2anyregs(e=%s)", tostringv(e)) + self:dischargevars(fs, e) + if e.k == "VNONRELOC" then + if not self:hasjumps(e) then -- exp is already in a register + return e.info + end + if e.info >= fs.nactvar then -- reg. is not a local? + self:exp2reg(fs, e, e.info) -- put value on it + return e.info + end + end + self:exp2nextreg(fs, e) -- default + return e.info +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:exp2val(fs, e) + if self:hasjumps(e) then + self:exp2anyreg(fs, e) + else + self:dischargevars(fs, e) + end +end + +------------------------------------------------------------------------ +-- FF updated 5.1 +------------------------------------------------------------------------ +function luaK:exp2RK(fs, e) + self:exp2val(fs, e) + local k = e.k + if k=="VNIL" or k=="VTRUE" or k=="VFALSE" or k=="VKNUM" then + if fs.nk <= luaP.MAXINDEXRK then + if k=="VNIL" then e.info = self:nilK(fs) + elseif k=="VKNUM" then e.info = self:numberK (fs, e.nval) + else e.info = self:boolK(fs, e.k=="VTRUE") end + e.k = "VK" + return luaP:RKASK(e.info) + end + elseif k == "VK" then + if e.info <= luaP.MAXINDEXRK then -- constant fit in argC? + return luaP:RKASK (e.info) + end + end + -- not a constant in the right range: put it in a register + return self:exp2anyreg(fs, e) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:storevar(fs, var, exp) + --print("STOREVAR") + --printf("var=%s", tostringv(var)) + --printf("exp=%s", tostringv(exp)) + + local k = var.k + if k == "VLOCAL" then + self:freeexp(fs, exp) + self:exp2reg(fs, exp, var.info) + return + elseif k == "VUPVAL" then + local e = self:exp2anyreg(fs, exp) + self:codeABC(fs, "OP_SETUPVAL", e, var.info, 0) + elseif k == "VGLOBAL" then + --printf("store global, exp=%s", tostringv(exp)) + local e = self:exp2anyreg(fs, exp) + self:codeABx(fs, "OP_SETGLOBAL", e, var.info) + elseif k == "VINDEXED" then + local e = self:exp2RK(fs, exp) + self:codeABC(fs, "OP_SETTABLE", var.info, var.aux, e) + else + assert(0) -- invalid var kind to store + end + self:freeexp(fs, exp) + --print("/STOREVAR") +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:_self(fs, e, key) + self:exp2anyreg(fs, e) + self:freeexp(fs, e) + local func = fs.freereg + self:reserveregs(fs, 2) + self:codeABC(fs, "OP_SELF", func, e.info, self:exp2RK(fs, key)) + self:freeexp(fs, key) + e.info = func + e.k = "VNONRELOC" +end + +------------------------------------------------------------------------ +-- FF updated 5.1 +------------------------------------------------------------------------ +function luaK:invertjump(fs, e) + --printf("invertjump on jump instruction #%i", e.info) + --printv(self:getcode(fs, e)) + local pc = self:getjumpcontrol(fs, e.info) + assert(luaP:testOpMode(luaP:GET_OPCODE(pc), "OpModeT") and + luaP:GET_OPCODE(pc) ~= "OP_TESTSET" and + luaP:GET_OPCODE(pc) ~= "OP_TEST") + --printf("Before invert:") + --printv(pc) + luaP:SETARG_A(pc, (luaP:GETARG_A(pc) == 0) and 1 or 0) + --printf("After invert:") + --printv(pc) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:jumponcond(fs, e, cond) + if e.k == "VRELOCABLE" then + local ie = self:getcode(fs, e) + if luaP:GET_OPCODE(ie) == "OP_NOT" then + fs.pc = fs.pc - 1 -- remove previous OP_NOT + return self:condjump(fs, "OP_TEST", luaP:GETARG_B(ie), 0, + cond and 0 or 1) + end + -- else go through + end + self:discharge2anyreg(fs, e) + self:freeexp(fs, e) + return self:condjump(fs, "OP_TESTSET", luaP.NO_REG, e.info, cond and 1 or 0) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:goiftrue(fs, e) + local pc -- pc of last jump + self:dischargevars(fs, e) + local k = e.k + if k == "VK" or k == "VTRUE" or k == "VKNUM" then + pc = self.NO_JUMP -- always true; do nothing + elseif k == "VFALSE" then + pc = self:jump(fs) -- always jump + elseif k == "VJMP" then + self:invertjump(fs, e) + pc = e.info + else + pc = self:jumponcond(fs, e, false) + end + e.f = self:concat(fs, e.f, pc) -- insert last jump in 'f' list + self:patchtohere(fs, e.t) + e.t = self.NO_JUMP +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:goiffalse(fs, e) + local pc -- pc of last jump + self:dischargevars(fs, e) + local k = e.k + if k == "VNIL" or k == "VFALSE"then + pc = self.NO_JUMP -- always false; do nothing + elseif k == "VTRUE" then + pc = self:jump(fs) -- always jump + elseif k == "VJMP" then + pc = e.info + else + pc = self:jumponcond(fs, e, true) + end + e.t = self:concat(fs, e.t, pc) -- insert last jump in 't' list + self:patchtohere(fs, e.f) + e.f = self.NO_JUMP +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:codenot(fs, e) + self:dischargevars(fs, e) + local k = e.k + if k == "VNIL" or k == "VFALSE" then + e.k = "VTRUE" + elseif k == "VK" or k == "VKNUM" or k == "VTRUE" then + e.k = "VFALSE" + elseif k == "VJMP" then + self:invertjump(fs, e) + elseif k == "VRELOCABLE" or k == "VNONRELOC" then + self:discharge2anyreg(fs, e) + self:freeexp(fs, e) + e.info = self:codeABC(fs, "OP_NOT", 0, e.info, 0) + e.k = "VRELOCABLE" + else + assert(0) -- cannot happen + end + -- interchange true and false lists + e.f, e.t = e.t, e.f + self:removevalues(fs, e.f) + self:removevalues(fs, e.t) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:indexed(fs, t, k) + t.aux = self:exp2RK(fs, k) + t.k = "VINDEXED" +end + +--FF 5.1 +function luaK:constfolding (op, e1, e2) + if not self:isnumeral(e1) or not self:isnumeral(e2) then return false end + local v1, v2, e, r = e1.nval, e2 and e2.nval, nil + if op == "OP_ADD" then r = v1+v2 + elseif op == "OP_SUB" then r = v1-v2 + elseif op == "OP_MUL" then r = v1*v2 + elseif op == "OP_DIV" then if v2==0 then return false end r = v1/v2 + elseif op == "OP_MOD" then if v2==0 then return false end r = v1%v2 + elseif op == "OP_POW" then r = v1^v2 + elseif op == "OP_UNM" then r = -v1 + elseif op == "OP_LEN" then return false + else assert (false, "Unknown numeric value") end + e1.nval = r + return true +end + +--FF 5.1 +function luaK:codearith (fs, op, e1, e2) + if self:constfolding (op, e1, e2) then return else + local o1 = self:exp2RK (fs, e1) + local o2 = 0 + if op ~= "OP_UNM" and op ~= "OP_LEN" then + o2 = self:exp2RK (fs, e2) end + self:freeexp(fs, e2) + self:freeexp(fs, e1) + e1.info = self:codeABC (fs, op, 0, o1, o2) + e1.k = "VRELOCABLE" + end +end + +--FF 5.1 +function luaK:codecomp (fs, op, cond, e1, e2) + assert (type (cond) == "boolean") + local o1 = self:exp2RK (fs, e1) + local o2 = self:exp2RK (fs, e2) + self:freeexp (fs, e2) + self:freeexp (fs, e1) + if not cond and op ~= "OP_EQ" then + local temp = o1; o1=o2; o2=temp cond = true end + e1.info = self:condjump (fs, op, cond and 1 or 0, o1, o2) + e1.k = "VJMP" +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:prefix (fs, op, e) + local e2 = { t = self.NO_JUMP; f = self.NO_JUMP; + k = "VKNUM"; nval = 0 } + if op == "unm" then + if e.k == "VK" then + self:exp2anyreg (fs, e) end + self:codearith (fs, "OP_UNM", e, e2) + elseif op == "not" then + self:codenot (fs, e) + elseif op == "len" then + self:exp2anyreg (fs, e) + self:codearith (fs, "OP_LEN", e, e2) + else + assert (false, "Unknown unary operator") + end +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:infix (fs, op, v) + if op == "and" then + self:goiftrue(fs, v) + elseif op == "or" then + self:goiffalse(fs, v) + elseif op == "concat" then + self:exp2nextreg(fs, v) -- operand must be on the 'stack' + else + if not self:isnumeral (v) then self:exp2RK(fs, v) end + end +end + +------------------------------------------------------------------------ +-- +-- grep "ORDER OPR" if you change these enums +------------------------------------------------------------------------ +luaK.arith_opc = { -- done as a table lookup instead of a calc + add = "OP_ADD", + sub = "OP_SUB", + mul = "OP_MUL", + mod = "OP_MOD", + div = "OP_DIV", + pow = "OP_POW", + len = "OP_LEN", + ["not"] = "OP_NOT" +} +luaK.test_opc = { -- was ops[] in the codebinop function + eq = {opc="OP_EQ", cond=true}, + lt = {opc="OP_LT", cond=true}, + le = {opc="OP_LE", cond=true}, + + -- Pseudo-ops, with no metatable equivalent: + ne = {opc="OP_EQ", cond=false}, + gt = {opc="OP_LT", cond=false}, + ge = {opc="OP_LE", cond=false} +} + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:posfix(fs, op, e1, e2) + if op == "and" then + assert(e1.t == self.NO_JUMP) -- list must be closed + self:dischargevars(fs, e2) + e2.f = self:concat(fs, e2.f, e1.f) + for k,v in pairs(e2) do e1[k]=v end -- *e1 = *e2 + elseif op == "or" then + assert(e1.f == self.NO_JUMP) -- list must be closed + self:dischargevars(fs, e2) + e2.t = self:concat(fs, e2.t, e1.t) + for k,v in pairs(e2) do e1[k]=v end -- *e1 = *e2 + elseif op == "concat" then + self:exp2val(fs, e2) + if e2.k == "VRELOCABLE" + and luaP:GET_OPCODE(self:getcode(fs, e2)) == "OP_CONCAT" then + assert(e1.info == luaP:GETARG_B(self:getcode(fs, e2)) - 1) + self:freeexp(fs, e1) + luaP:SETARG_B(self:getcode(fs, e2), e1.info) + e1.k = "VRELOCABLE"; e1.info = e2.info + else + self:exp2nextreg(fs, e2) + self:codearith (fs, "OP_CONCAT", e1, e2) + end + else + local opc = self.arith_opc[op] + if opc then self:codearith (fs, opc, e1, e2) else + opc = self.test_opc[op] or error ("Unknown operator "..op) + self:codecomp (fs, opc.opc, opc.cond, e1, e2) + end + end +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:fixline(fs, line) + --assert (line) + fs.f.lineinfo[fs.pc - 1] = line or 0 +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:code(fs, i, line) + assert (line) + local f = fs.f + + do -- print it + local params = { } + for _,x in ipairs{"A","B","Bx", "sBx", "C"} do + if i[x] then table.insert (params, string.format ("%s=%i", x, i[x])) end + end + debugf ("[code:\t%s\t%s]", luaP.opnames[i.OP], table.concat (params, ", ")) + end + + self:dischargejpc(fs) -- 'pc' will change + -- put new instruction in code array +--FF luaY:growvector(fs.L, f.code, fs.pc, f.sizecode, nil, +--FF luaY.MAX_INT, "code size overflow") + f.code[fs.pc] = i + -- save corresponding line information +--FF luaY:growvector(fs.L, f.lineinfo, fs.pc, f.sizelineinfo, nil, +--FF luaY.MAX_INT, "code size overflow") + f.lineinfo[fs.pc] = line + local pc = fs.pc + fs.pc = fs.pc + 1 + return pc +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:codeABC(fs, o, a, b, c) + assert(luaP:getOpMode(o) == "iABC", o.." is not an ABC operation") + --assert getbmode(o) ~= opargn or b == 0 + --assert getcmode(o) ~= opargn or c == 0 + --FF + --return self:code(fs, luaP:CREATE_ABC(o, a, b, c), fs.ls.lastline) + return self:code(fs, luaP:CREATE_ABC(o, a, b, c), fs.lastline) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:codeABx(fs, o, a, bc) + assert(luaP:getOpMode(o) == "iABx" or luaP:getOpMode(o) == "iAsBx") + --assert getcmode(o) == opargn + --FF + --return self:code(fs, luaP:CREATE_ABx(o, a, bc), fs.ls.lastline) + return self:code(fs, luaP:CREATE_ABx(o, a, bc), fs.lastline) +end + +------------------------------------------------------------------------ +-- +------------------------------------------------------------------------ +function luaK:setlist (fs, base, nelems, tostore) + local c = math.floor ((nelems-1) / luaP.LFIELDS_PER_FLUSH + 1) + local b = tostore == self.LUA_MULTRET and 0 or tostore + assert (tostore ~= 0) + if c <= luaP.MAXARG_C then self:codeABC (fs, "OP_SETLIST", base, b, c) + else + self:codeABC (fs, "OP_SETLIST", base, b, 0) + self:code (fs, c, fs.lastline)--FIXME + end + fs.freereg = base + 1 +end diff --git a/src/compiler/ldump.lua b/src/compiler/ldump.lua new file mode 100644 index 0000000..3bf6ebf --- /dev/null +++ b/src/compiler/ldump.lua @@ -0,0 +1,425 @@ +---------------------------------------------------------------------- +-- +-- WARNING! You're entering a hackish area, proceed at your own risks! +-- +-- This code results from the borrowing, then ruthless abuse, of +-- Yueliang's implementation of Lua 5.0 compiler. I claim +-- responsibility for all of the ugly, dirty stuff that you might spot +-- in it. +-- +-- Eventually, this code will be rewritten, either in Lua or more +-- probably in C. Meanwhile, if you're interested into digging +-- metalua's sources, this is not the best part to invest your time +-- on. +-- +-- End of warning. +-- +---------------------------------------------------------------------- + +--[[-------------------------------------------------------------------- + + $Id: ldump.lua,v 1.3 2006/11/07 04:38:00 fab13n Exp $ + + ldump.lua + Save bytecodes in Lua + This file is part of Yueliang. + + Copyright (c) 2005 Kein-Hong Man + The COPYRIGHT file describes the conditions + under which this software may be distributed. + +------------------------------------------------------------------------ + + [FF] Slightly modified, mainly to produce Lua 5.1 bytecode. + + $Log: ldump.lua,v $ + Revision 1.3 2006/11/07 04:38:00 fab13n + first bootstrapping version. + + Revision 1.2 2006/11/05 15:08:34 fab13n + updated code generation, to be compliant with 5.1 + + +----------------------------------------------------------------------]] + +--[[-------------------------------------------------------------------- +-- Notes: +-- * LUA_NUMBER (double), byte order (little endian) and some other +-- header values hard-coded; see other notes below... +-- * One significant difference is that instructions are still in table +-- form (with OP/A/B/C/Bx fields) and luaP:Instruction() is needed to +-- convert them into 4-char strings +-- * Deleted: +-- luaU:DumpVector: folded into DumpLines, DumpCode +-- * Added: +-- luaU:endianness() (from lundump.c) +-- luaU:make_setS: create a chunk writer that writes to a string +-- luaU:make_setF: create a chunk writer that writes to a file +-- (lua.h contains a typedef for a Chunkwriter pointer, and +-- a Lua-based implementation exists, writer() in lstrlib.c) +-- luaU:from_double(x): encode double value for writing +-- luaU:from_int(x): encode integer value for writing +-- (error checking is limited for these conversion functions) +-- (double conversion does not support denormals or NaNs) +-- luaU:ttype(o) (from lobject.h) +----------------------------------------------------------------------]] + +module("bytecode", package.seeall) + +--requires luaP +luaU = {} + +-- constants used by dumper +luaU.LUA_TNIL = 0 +luaU.LUA_TBOOLEAN = 1 +luaU.LUA_TNUMBER = 3 -- (all in lua.h) +luaU.LUA_TSTRING = 4 +luaU.LUA_TNONE = -1 + +-- definitions for headers of binary files +luaU.LUA_SIGNATURE = "\27Lua" -- binary files start with "Lua" +luaU.VERSION = 81 -- 0x50; last format change was in 5.0 +luaU.FORMAT_VERSION = 0 -- 0 is official version. yeah I know I'm a liar. + +-- a multiple of PI for testing native format +-- multiplying by 1E7 gives non-trivial integer values +--luaU.TEST_NUMBER = 3.14159265358979323846E7 + +--[[-------------------------------------------------------------------- +-- Additional functions to handle chunk writing +-- * to use make_setS and make_setF, see test_ldump.lua elsewhere +----------------------------------------------------------------------]] + +------------------------------------------------------------------------ +-- works like the lobject.h version except that TObject used in these +-- scripts only has a 'value' field, no 'tt' field (native types used) +------------------------------------------------------------------------ +function luaU:ttype(o) + local tt = type(o.value) + if tt == "number" then return self.LUA_TNUMBER + elseif tt == "string" then return self.LUA_TSTRING + elseif tt == "nil" then return self.LUA_TNIL + elseif tt == "boolean" then return self.LUA_TBOOLEAN + else + return self.LUA_TNONE -- the rest should not appear + end +end + +------------------------------------------------------------------------ +-- create a chunk writer that writes to a string +-- * returns the writer function and a table containing the string +-- * to get the final result, look in buff.data +------------------------------------------------------------------------ +function luaU:make_setS() + local buff = {} + buff.data = "" + local writer = + function(s, buff) -- chunk writer + if not s then return end + buff.data = buff.data..s + end + return writer, buff +end + +------------------------------------------------------------------------ +-- create a chunk writer that writes to a file +-- * returns the writer function and a table containing the file handle +-- * if a nil is passed, then writer should close the open file +------------------------------------------------------------------------ +function luaU:make_setF(filename) + local buff = {} + buff.h = io.open(filename, "wb") + if not buff.h then return nil end + local writer = + function(s, buff) -- chunk writer + if not buff.h then return end + if not s then buff.h:close(); return end + buff.h:write(s) + end + return writer, buff +end + +----------------------------------------------------------------------- +-- converts a IEEE754 double number to an 8-byte little-endian string +-- * luaU:from_double() and luaU:from_int() are from ChunkBake project +-- * supports +/- Infinity, but not denormals or NaNs +----------------------------------------------------------------------- +function luaU:from_double(x) + local function grab_byte(v) + return math.floor(v / 256), + string.char(math.mod(math.floor(v), 256)) + end + local sign = 0 + if x < 0 then sign = 1; x = -x end + local mantissa, exponent = math.frexp(x) + if x == 0 then -- zero + mantissa, exponent = 0, 0 + elseif x == 1/0 then + mantissa, exponent = 0, 2047 + else + mantissa = (mantissa * 2 - 1) * math.ldexp(0.5, 53) + exponent = exponent + 1022 + end + local v, byte = "" -- convert to bytes + x = mantissa + for i = 1,6 do + x, byte = grab_byte(x); v = v..byte -- 47:0 + end + x, byte = grab_byte(exponent * 16 + x); v = v..byte -- 55:48 + x, byte = grab_byte(sign * 128 + x); v = v..byte -- 63:56 + return v +end + +----------------------------------------------------------------------- +-- converts a number to a little-endian 32-bit integer string +-- * input value assumed to not overflow, can be signed/unsigned +----------------------------------------------------------------------- +function luaU:from_int(x) + local v = "" + x = math.floor(x) + if x >= 0 then + for i = 1, 4 do + v = v..string.char(math.mod(x, 256)); x = math.floor(x / 256) + end + else -- x < 0 + x = -x + local carry = 1 + for i = 1, 4 do + local c = 255 - math.mod(x, 256) + carry + if c == 256 then c = 0; carry = 1 else carry = 0 end + v = v..string.char(c); x = math.floor(x / 256) + end + end + return v +end + +--[[-------------------------------------------------------------------- +-- Functions to make a binary chunk +-- * many functions have the size parameter removed, since output is +-- in the form of a string and some sizes are implicit or hard-coded +-- * luaU:DumpVector has been deleted (used in DumpCode & DumpLines) +----------------------------------------------------------------------]] + +------------------------------------------------------------------------ +-- dump a block of literal bytes +------------------------------------------------------------------------ +function luaU:DumpLiteral(s, D) self:DumpBlock(s, D) end + +--[[-------------------------------------------------------------------- +-- struct DumpState: +-- L -- lua_State (not used in this script) +-- write -- lua_Chunkwriter (chunk writer function) +-- data -- void* (chunk writer context or data already written) +----------------------------------------------------------------------]] + +------------------------------------------------------------------------ +-- dumps a block of bytes +-- * lua_unlock(D.L), lua_lock(D.L) deleted +------------------------------------------------------------------------ +function luaU:DumpBlock(b, D) D.write(b, D.data) end + +------------------------------------------------------------------------ +-- dumps a single byte +------------------------------------------------------------------------ +function luaU:DumpByte(y, D) + self:DumpBlock(string.char(y), D) +end + +------------------------------------------------------------------------ +-- dumps a 32-bit signed integer (for int) +------------------------------------------------------------------------ +function luaU:DumpInt(x, D) + self:DumpBlock(self:from_int(x), D) +end + +------------------------------------------------------------------------ +-- dumps a 32-bit unsigned integer (for size_t) +------------------------------------------------------------------------ +function luaU:DumpSize(x, D) + self:DumpBlock(self:from_int(x), D) +end + +------------------------------------------------------------------------ +-- dumps a LUA_NUMBER (hard-coded as a double) +------------------------------------------------------------------------ +function luaU:DumpNumber(x, D) + self:DumpBlock(self:from_double(x), D) +end + +------------------------------------------------------------------------ +-- dumps a Lua string +------------------------------------------------------------------------ +function luaU:DumpString(s, D) + if s == nil then + self:DumpSize(0, D) + else + s = s.."\0" -- include trailing '\0' + self:DumpSize(string.len(s), D) + self:DumpBlock(s, D) + end +end + +------------------------------------------------------------------------ +-- dumps instruction block from function prototype +------------------------------------------------------------------------ +function luaU:DumpCode(f, D) + local n = f.sizecode + self:DumpInt(n, D) + --was DumpVector + for i = 0, n - 1 do + self:DumpBlock(luaP:Instruction(f.code[i]), D) + end +end + +------------------------------------------------------------------------ +-- dumps local variable names from function prototype +------------------------------------------------------------------------ +function luaU:DumpLocals(f, D) + local n = f.sizelocvars + self:DumpInt(n, D) + for i = 0, n - 1 do + --printf("[DUMPLOCALS] dumping local var #%i = %s", i, tostringv(f.locvars[i])) + self:DumpString(f.locvars[i].varname, D) + self:DumpInt(f.locvars[i].startpc, D) + self:DumpInt(f.locvars[i].endpc, D) + end +end + +------------------------------------------------------------------------ +-- dumps line information from function prototype +------------------------------------------------------------------------ +function luaU:DumpLines(f, D) + local n = f.sizelineinfo + self:DumpInt(n, D) + --was DumpVector + for i = 0, n - 1 do + self:DumpInt(f.lineinfo[i], D) -- was DumpBlock + end +end + +------------------------------------------------------------------------ +-- dump upvalue names from function prototype +------------------------------------------------------------------------ +function luaU:DumpUpvalues(f, D) + local n = f.sizeupvalues + self:DumpInt(n, D) + for i = 0, n - 1 do + self:DumpString(f.upvalues[i], D) + end +end + +------------------------------------------------------------------------ +-- dump constant pool from function prototype +-- * nvalue(o) and tsvalue(o) macros removed +------------------------------------------------------------------------ +function luaU:DumpConstants(f, D) + local n = f.sizek + self:DumpInt(n, D) + for i = 0, n - 1 do + local o = f.k[i] -- TObject + local tt = self:ttype(o) + assert (tt >= 0) + self:DumpByte(tt, D) + if tt == self.LUA_TNUMBER then + self:DumpNumber(o.value, D) + elseif tt == self.LUA_TSTRING then + self:DumpString(o.value, D) + elseif tt == self.LUA_TBOOLEAN then + self:DumpByte (o.value and 1 or 0, D) + elseif tt == self.LUA_TNIL then + else + assert(false) -- cannot happen + end + end +end + + +function luaU:DumpProtos (f, D) + local n = f.sizep + assert (n) + self:DumpInt(n, D) + for i = 0, n - 1 do + self:DumpFunction(f.p[i], f.source, D) + end +end + +------------------------------------------------------------------------ +-- dump child function prototypes from function prototype +--FF completely reworked for 5.1 format +------------------------------------------------------------------------ +function luaU:DumpFunction(f, p, D) + local source = f.source + if source == p then source = nil end + self:DumpString(source, D) + self:DumpInt(f.lineDefined, D) + self:DumpInt(42, D) -- lastlinedefined, not implemented, FIXME +-- self:DumpInt(f.lastlineDefined, D) + self:DumpByte(f.nups, D) + self:DumpByte(f.numparams, D) + self:DumpByte(f.is_vararg, D) + self:DumpByte(f.maxstacksize, D) + self:DumpCode(f, D) + self:DumpConstants(f, D) + self:DumpProtos( f, D) + self:DumpLines(f, D) + self:DumpLocals(f, D) + self:DumpUpvalues(f, D) +end + +------------------------------------------------------------------------ +-- dump Lua header section (some sizes hard-coded) +--FF: updated for version 5.1 +------------------------------------------------------------------------ +function luaU:DumpHeader(D) + self:DumpLiteral(self.LUA_SIGNATURE, D) + self:DumpByte(self.VERSION, D) + self:DumpByte(self.FORMAT_VERSION, D) + self:DumpByte(self:endianness(), D) + self:DumpByte(4, D) -- sizeof(int) + self:DumpByte(4, D) -- sizeof(size_t) + self:DumpByte(4, D) -- sizeof(Instruction) + self:DumpByte(8, D) -- sizeof lua_Number + self:DumpByte(0, D) -- integral flag +end + +------------------------------------------------------------------------ +-- dump function as precompiled chunk +-- * w, data are created from make_setS, make_setF +--FF: suppressed extraneous [L] param +------------------------------------------------------------------------ +function luaU:dump (Main, w, data) + local D = {} -- DumpState + D.write = w + D.data = data + self:DumpHeader(D) + self:DumpFunction(Main, nil, D) + -- added: for a chunk writer writing to a file, this final call with + -- nil data is to indicate to the writer to close the file + D.write(nil, D.data) +end + +------------------------------------------------------------------------ +-- find byte order (from lundump.c) +-- * hard-coded to little-endian +------------------------------------------------------------------------ +function luaU:endianness() + return 1 +end + +-- FIXME: ugly concat-base generation in [make_setS], bufferize properly! +function dump_string (proto) + local writer, buff = luaU:make_setS() + luaU:dump (proto, writer, buff) + return buff.data +end + +-- FIXME: [make_setS] sucks, perform synchronous file writing +function dump_file (proto, filename) + local writer, buff = luaU:make_setS() + luaU:dump (proto, writer, buff) + local file = io.open (filename, "wb") + file:write (UNIX_SHARPBANG or "") + file:write (buff.data) + io.close(file) + if UNIX_SHARPBANG then os.execute ("chmod a+x "..filename) end +end \ No newline at end of file diff --git a/src/compiler/lexer.lua b/src/compiler/lexer.lua new file mode 100644 index 0000000..2506761 --- /dev/null +++ b/src/compiler/lexer.lua @@ -0,0 +1,392 @@ +---------------------------------------------------------------------- +-- Metalua: $Id: mll.lua,v 1.3 2006/11/15 09:07:50 fab13n Exp $ +-- +-- Summary: generic Lua-style lexer definition. You need this plus +-- some keyword additions to create the complete Lua lexer, +-- as is done in mlp_lexer.lua. +-- +-- TODO: +-- +-- * Make it possible to change lexer on the fly. This implies the +-- ability to easily undo any pre-extracted tokens; +-- +-- * Make it easy to define new flavors of strings. Replacing the +-- lexer.patterns.long_string regexp by an extensible list, with +-- customizable token tag, would probably be enough. Maybe add: +-- + an index of capture for the regexp, that would specify +-- which capture holds the content of the string-like token +-- + a token tag +-- + or a string->string transformer function. +---------------------------------------------------------------------- +-- +-- Copyright (c) 2006, Fabien Fleutot . +-- +-- This software is released under the MIT Licence, see licence.txt +-- for details. +-- +---------------------------------------------------------------------- + +module ("lexer", package.seeall) +require "std" + +lexer = { alpha={ }, sym={ } } +lexer.__index=lexer + +local debugf = function() end +--local debugf=printf + +---------------------------------------------------------------------- +-- Patterns used by [lexer:extract] to decompose the raw string into +-- correctly tagged tokens. +---------------------------------------------------------------------- +lexer.patterns = { + spaces = "^[ \r\n\t]*()", + short_comment = "^%-%-([^\n]*)()\n", + final_short_comment = "^%-%-([^\n]*)()$", + long_comment = "^%-%-%[(=*)%[\n?(.-)%]%1%]()", + long_string = "^%[(=*)%[\n?(.-)%]%1%]()", + number_mantissa = { + "^%d+%.?%d*()", + "^%d*%d%.%d+()" }, + number_exponant = "^[eE][%+%-]?%d+()", + word = "^([%a_][%w_]*)()" +} + +---------------------------------------------------------------------- +-- Take a letter [x], and returns the character represented by the +-- sequence ['\\'..x], e.g. [unesc_letter "n" == "\n"]. +---------------------------------------------------------------------- +local function unesc_letter(x) + local t = { + a = "\a", b = "\b", f = "\f", + n = "\n", r = "\r", t = "\t", v = "\v", + ["\\"] = "\\", ["'"] = "'", ['"'] = '"' } + return t[x] or error("Unknown escape sequence \\"..x) +end + +---------------------------------------------------------------------- +-- Turn the digits of an escape sequence into the corresponding +-- character, e.g. [unesc_digits("123") == string.char(123)]. +---------------------------------------------------------------------- +local function unesc_digits (x) + local k, j, i = x:reverse():byte(1, 3) + local z = _G.string.byte "0" + return _G.string.char ((k or z) + 10*(j or z) + 100*(i or z) - 111*z) +end + +---------------------------------------------------------------------- +-- unescape a whole string, applying [unesc_digits] and [unesc_letter] +-- as many times as required. +---------------------------------------------------------------------- +local function unescape_string (s) + return s:gsub("\\([0-9]+)", unesc_digits):gsub("\\(.)",unesc_letter) +end + +lexer.extractors = { + "skip_whitespaces_and_comments", + "extract_short_string", "extract_word", "extract_number", + "extract_long_string", "extract_symbol" } + +---------------------------------------------------------------------- +-- Really extract next token fron the raw string +-- (and update the index). +---------------------------------------------------------------------- +function lexer:extract () + local previous_i = self.i + local loc, eof, token = self.i + + local function tk (tag, content) + assert (tag and content) + local i, ln = previous_i, self.line + -- update line numbers + while true do + i = self.src:find("\n", i+1, true) + if not i then break end + if loc and i <= loc then ln = ln+1 end + if i <= self.i then self.line = self.line+1 else break end + end + local a = { tag = tag, char=loc, line=ln, content } + if #self.attached_comments > 0 then + a.comments = self.attached_comments + self.attached_comments = nil + end + local amt = { + __tostring = function() + return _G.string.format ("`%s{'%s'}",a.tag, a[1]) end } + setmetatable (a, amt) + return a + end + + self.attached_comments = { } + + for ext_idx, extractor in ipairs(self.extractors) do + -- printf("method = %s", method) + local tag, content = self[extractor](self) + -- [loc] is placed just after the leading whitespaces and comments, + -- and the whitespace extractor is at index 1. + if ext_idx==1 then loc = self.i end + + if tag then + --printf("`%s{ %q }\t%i", tag, content, loc); + return tk (tag, content) + end + end + + error "Cant extract anything!" +end + +---------------------------------------------------------------------- +-- skip whites and comments +-- FIXME: doesn't take into account: +-- - unterminated long comments +-- - short comments without a final \n +---------------------------------------------------------------------- +function lexer:skip_whitespaces_and_comments() + local attached_comments = { } + repeat + local _, j + local again = false + local last_comment_content = nil + -- skip spaces + self.i = self.src:match (self.patterns.spaces, self.i) + -- skip a long comment if any + _, last_comment_content, j = self.src:match (self.patterns.long_comment, self.i) + if j then + _G.table.insert(self.attached_comments, + {last_comment_content, self.i, j, "long"}) + self.i=j; again=true + end + -- skip a short comment if any + last_comment_content, j = self.src:match (self.patterns.short_comment, self.i) + if j then + _G.table.insert(attached_comments, + {last_comment_content, self.i, j, "short"}) + self.i=j; again=true + end + if self.i>#self.src then return "Eof", "eof" end + until not again + + if self.src:match (self.patterns.final_short_comment, self.i) then + return "Eof", "eof" end + --assert (not self.src:match(self.patterns.short_comment, self.i)) + --assert (not self.src:match(self.patterns.long_comment, self.i)) + -- --assert (not self.src:match(self.patterns.spaces, self.i)) + return +end + +---------------------------------------------------------------------- +-- +---------------------------------------------------------------------- +function lexer:extract_short_string() + -- [k] is the first unread char, [self.i] points to [k] in [self.src] + local j, k = self.i, self.src:sub (self.i,self.i) + if k=="'" or k=='"' then + -- short string + repeat + self.i=self.i+1; + local kk = self.src:sub (self.i, self.i) + if kk=="\\" then + self.i=self.i+1; + kk = self.src:sub (self.i, self.i) + end + if self.i > #self.src then error "Unterminated string" end + if self.i == "\r" or self.i == "\n" then error "no \\n in short strings!" end + until self.src:sub (self.i, self.i) == k + and ( self.src:sub (self.i-1, self.i-1) ~= '\\' + or self.src:sub (self.i-2, self.i-2) == '\\') + self.i=self.i+1 + return "String", unescape_string (self.src:sub (j+1,self.i-2)) + end +end + +---------------------------------------------------------------------- +-- +---------------------------------------------------------------------- +function lexer:extract_word() + -- Id / keyword + local word, j = self.src:match (self.patterns.word, self.i) + if word then + self.i = j + if self.alpha [word] then return "Keyword", word + else return "Id", word end + end +end + +---------------------------------------------------------------------- +-- +---------------------------------------------------------------------- +function lexer:extract_number() + -- Number + local j = self.src:match (self.patterns.number_mantissa[1], self.i) or + self.src:match (self.patterns.number_mantissa[2], self.i) + if j then + j = self.src:match (self.patterns.number_exponant, j) or j; + local n = tonumber (self.src:sub (self.i, j-1)) + self.i = j + return "Number", n + end +end + +---------------------------------------------------------------------- +-- +---------------------------------------------------------------------- +function lexer:extract_long_string() + -- Long string + local _, content, j = self.src:match (self.patterns.long_string, self.i) + if j then self.i = j; return "String", content end +end + +---------------------------------------------------------------------- +-- +---------------------------------------------------------------------- +function lexer:extract_symbol() + -- compound symbol + local k = self.src:sub (self.i,self.i) + local symk = self.sym [k] + if not symk then + self.i = self.i + 1 + return "Keyword", k + end + for _, sym in pairs (symk) do + if sym == self.src:sub (self.i, self.i + #sym - 1) then + self.i = self.i + #sym; + return "Keyword", sym + end + end + -- single char symbol + self.i = self.i+1 + return "Keyword", k +end + +---------------------------------------------------------------------- +-- Add a keyword to the list of keywords recognized by the lexer. +---------------------------------------------------------------------- +function lexer:add (w) + if type (w) == "table" then + for _, x in ipairs (w) do self:add (x) end + else + if w:match (self.patterns.word .. "$") then self.alpha [w] = true + elseif w:match "^%p%p+$" then + local k = w:sub(1,1) + local list = self.sym [k] + if not list then list = { }; self.sym [k] = list end + _G.table.insert (list, w) + elseif w:match "^%p$" then return + else error "Invalid keyword" end + end +end + +---------------------------------------------------------------------- +-- Return the [n]th next token, without consumming it. +-- [n] defaults to 1. If it goes pass the end of the stream, an EOF +-- token is returned. +---------------------------------------------------------------------- +function lexer:peek (n) + assert(self) + if not n then n=1 end + if n > #self.peeked then + for i = #self.peeked+1, n do + self.peeked [i] = self:extract() + end + end + return self.peeked [n] +end + +---------------------------------------------------------------------- +-- Return the [n]th next token, removing it as well as the 0..n-1 +-- previous tokens. [n] defaults to 1. If it goes pass the end of the +-- stream, an EOF token is returned. +---------------------------------------------------------------------- +function lexer:next (n) + if not n then n=1 end + self:peek (n) + local a + for i=1,n do + a = _G.table.remove (self.peeked, 1) + if a then debugf ("[L:%i K:%i T:%s %q]", a.line or -1, a.char or -1, a.tag or '', a[1]) end + end + return a or eof_token +end + +---------------------------------------------------------------------- +-- Returns an object which saves the stream's current state. +---------------------------------------------------------------------- +function lexer:save () return { self.i; _G.table.cat(self.peeked) } end + +---------------------------------------------------------------------- +-- Restore the stream's state, as saved by method [save]. +---------------------------------------------------------------------- +function lexer:restore (s) self.i=s[1]; self.peeked=s[2] end + +---------------------------------------------------------------------- +-- Create a new lexstream. +---------------------------------------------------------------------- +function lexer:newstream (src) + local stream = { + src = src; -- The source, as a single string + peeked = { }; -- Already peeked, but not discarded yet, tokens + i = 1; -- Character offset in src + line = 1; -- current line number + } + setmetatable (stream, self) + + -- skip initial sharp-bang for unix scripts + if src:match "^#!" then stream.i = src:find "\n" + 1 end + return stream +end + +---------------------------------------------------------------------- +-- if there's no ... args, return the token a (whose truth value is +-- true) if it's a `Keyword{ }, or nil. If there are ... args, they +-- have to be strings. if the token a is a keyword, and it's content +-- is one of the ... args, then returns it (it's truth value is +-- true). If no a keyword or not in ..., return nil. +---------------------------------------------------------------------- +function lexer:is_keyword (a, ...) + if not a or a.tag ~= "Keyword" then return false end + local words = {...} + if #words == 0 then return a[1] end + for _, w in ipairs (words) do + if w == a[1] then return w end + end + return false +end + +---------------------------------------------------------------------- +-- Cause an error if the next token isn't a keyword whose content +-- is listed among ... args (which have to be strings). +---------------------------------------------------------------------- +function lexer:check (...) + local words = {...} + local a = self:next() + local function err () + error ("Got " .. tostring (a) .. + ", expected one of these keywords : '" .. + _G.table.concat (words,"', '") .. "'") end + + if not a or a.tag ~= "Keyword" then err () end + if #words == 0 then return a[1] end + for _, w in ipairs (words) do + if w == a[1] then return w end + end + err () +end + +---------------------------------------------------------------------- +-- +---------------------------------------------------------------------- +function lexer:clone() + local clone = { + alpha = table.deep_copy(self.alpha), + sym = table.deep_copy(self.sym) } + setmetatable(clone, self) + clone.__index = clone + return clone +end + +---------------------------------------------------------------------- +-- +---------------------------------------------------------------------- +function is_stream (x) + return getmetable(x) == lexer +end diff --git a/src/compiler/lopcodes.lua b/src/compiler/lopcodes.lua new file mode 100644 index 0000000..5801063 --- /dev/null +++ b/src/compiler/lopcodes.lua @@ -0,0 +1,441 @@ +---------------------------------------------------------------------- +-- +-- WARNING! You're entering a hackish area, proceed at your own risks! +-- +-- This code results from the borrowing, then ruthless abuse, of +-- Yueliang's implementation of Lua 5.0 compiler. I claim +-- responsibility for all of the ugly, dirty stuff that you might spot +-- in it. +-- +-- Eventually, this code will be rewritten, either in Lua or more +-- probably in C. Meanwhile, if you're interested into digging +-- metalua's sources, this is not the best part to invest your time +-- on. +-- +-- End of warning. +-- +---------------------------------------------------------------------- + +--[[-------------------------------------------------------------------- + + $Id: lopcodes.lua,v 1.4 2006/11/10 02:11:17 fab13n Exp $ + + lopcodes.lua + Lua 5 virtual machine opcodes in Lua + This file is part of Yueliang. + + Copyright (c) 2005 Kein-Hong Man + The COPYRIGHT file describes the conditions + under which this software may be distributed. + + See the ChangeLog for more information. + +------------------------------------------------------------------------ + + [FF] Slightly modified, mainly to produce Lua 5.1 bytecode. + + $Log: lopcodes.lua,v $ + Revision 1.4 2006/11/10 02:11:17 fab13n + compiler faithfulness to 5.1 improved + gg.expr extended + mlp.expr refactored + + Revision 1.3 2006/11/07 04:38:00 fab13n + first bootstrapping version. + + Revision 1.2 2006/11/05 15:08:34 fab13n + updated code generation, to be compliant with 5.1 + + +----------------------------------------------------------------------]] + +--[[-------------------------------------------------------------------- +-- Notes: +-- * an Instruction is a table with OP, A, B, C, Bx elements; this +-- should allow instruction handling to work with doubles and ints +-- * Added: +-- luaP:Instruction(i): convert field elements to a 4-char string +-- luaP:DecodeInst(x): convert 4-char string into field elements +-- * WARNING luaP:Instruction outputs instructions encoded in little- +-- endian form and field size and positions are hard-coded +----------------------------------------------------------------------]] + +module("bytecode", package.seeall) + +local function debugf() end + +luaP = { } + +--[[ +=========================================================================== + We assume that instructions are unsigned numbers. + All instructions have an opcode in the first 6 bits. + Instructions can have the following fields: + 'A' : 8 bits + 'B' : 9 bits + 'C' : 9 bits + 'Bx' : 18 bits ('B' and 'C' together) + 'sBx' : signed Bx + + A signed argument is represented in excess K; that is, the number + value is the unsigned value minus K. K is exactly the maximum value + for that argument (so that -max is represented by 0, and +max is + represented by 2*max), which is half the maximum for the corresponding + unsigned argument. +=========================================================================== +--]] + +luaP.OpMode = {"iABC", "iABx", "iAsBx"} -- basic instruction format + +------------------------------------------------------------------------ +-- size and position of opcode arguments. +-- * WARNING size and position is hard-coded elsewhere in this script +------------------------------------------------------------------------ +luaP.SIZE_C = 9 +luaP.SIZE_B = 9 +luaP.SIZE_Bx = luaP.SIZE_C + luaP.SIZE_B +luaP.SIZE_A = 8 + +luaP.SIZE_OP = 6 + +luaP.POS_C = luaP.SIZE_OP +luaP.POS_B = luaP.POS_C + luaP.SIZE_C +luaP.POS_Bx = luaP.POS_C +luaP.POS_A = luaP.POS_B + luaP.SIZE_B + +--FF from 5.1 +luaP.BITRK = 2^(luaP.SIZE_B - 1) +function luaP:ISK(x) return x >= self.BITRK end +luaP.MAXINDEXRK = luaP.BITRK - 1 +function luaP:RKASK(x) + if x < self.BITRK then return x+self.BITRK else return x end +end + + + +------------------------------------------------------------------------ +-- limits for opcode arguments. +-- we use (signed) int to manipulate most arguments, +-- so they must fit in BITS_INT-1 bits (-1 for sign) +------------------------------------------------------------------------ +-- removed "#if SIZE_Bx < BITS_INT-1" test, assume this script is +-- running on a Lua VM with double or int as LUA_NUMBER + +luaP.MAXARG_Bx = math.ldexp(1, luaP.SIZE_Bx) - 1 +luaP.MAXARG_sBx = math.floor(luaP.MAXARG_Bx / 2) -- 'sBx' is signed + +luaP.MAXARG_A = math.ldexp(1, luaP.SIZE_A) - 1 +luaP.MAXARG_B = math.ldexp(1, luaP.SIZE_B) - 1 +luaP.MAXARG_C = math.ldexp(1, luaP.SIZE_C) - 1 + +-- creates a mask with 'n' 1 bits at position 'p' +-- MASK1(n,p) deleted +-- creates a mask with 'n' 0 bits at position 'p' +-- MASK0(n,p) deleted + +--[[-------------------------------------------------------------------- + Visual representation for reference: + + 31 | | | 0 bit position + +-----+-----+-----+----------+ + | B | C | A | Opcode | iABC format + +-----+-----+-----+----------+ + - 9 - 9 - 8 - 6 - field sizes + +-----+-----+-----+----------+ + | [s]Bx | A | Opcode | iABx | iAsBx format + +-----+-----+-----+----------+ +----------------------------------------------------------------------]] + +------------------------------------------------------------------------ +-- the following macros help to manipulate instructions +-- * changed to a table object representation, very clean compared to +-- the [nightmare] alternatives of using a number or a string +------------------------------------------------------------------------ + +-- these accept or return opcodes in the form of string names +function luaP:GET_OPCODE(i) return self.ROpCode[i.OP] end +function luaP:SET_OPCODE(i, o) i.OP = self.OpCode[o] end + +function luaP:GETARG_A(i) return i.A end +function luaP:SETARG_A(i, u) i.A = u end + +function luaP:GETARG_B(i) return i.B end +function luaP:SETARG_B(i, b) i.B = b end + +function luaP:GETARG_C(i) return i.C end +function luaP:SETARG_C(i, b) i.C = b end + +function luaP:GETARG_Bx(i) return i.Bx end +function luaP:SETARG_Bx(i, b) i.Bx = b end + +function luaP:GETARG_sBx(i) return i.Bx - self.MAXARG_sBx end +function luaP:SETARG_sBx(i, b) i.Bx = b + self.MAXARG_sBx end + +function luaP:CREATE_ABC(o,a,b,c) + return {OP = self.OpCode[o], A = a, B = b, C = c} +end + +function luaP:CREATE_ABx(o,a,bc) + return {OP = self.OpCode[o], A = a, Bx = bc} +end + +------------------------------------------------------------------------ +-- Bit shuffling stuffs +------------------------------------------------------------------------ +local p2 = {1,2,4,8,16,32,64,128,256, 512, 1024, 2048, 4096} +-- keeps [n] bits from [x] +local function keep (x, n) return x % p2[n+1] end +-- shifts bits of [x] [n] places to the right +local function srb (x,n) return math.floor (x / p2[n+1]) end +-- shifts bits of [x] [n] places to the left +local function slb (x,n) return x * p2[n+1] end + +------------------------------------------------------------------------ +-- returns a 4-char string little-endian encoded form of an instruction +------------------------------------------------------------------------ +function luaP:Instruction(i) + --printf("Instruction->string: %s %s", self.opnames[i.OP], table.tostring(i)) + local c0, c1, c2, c3 + -- change to OP/A/B/C format if needed + if i.Bx then i.C = keep (i.Bx, 9); i.B = srb (i.Bx, 9) end + -- c0 = 6B from opcode + 2LSB from A (flushed to MSB) + c0 = i.OP + slb (keep (i.A, 2), 6) + -- c1 = 6MSB from A + 2LSB from C (flushed to MSB) + c1 = srb (i.A, 2) + slb (keep (i.C, 2), 6) + -- c2 = 7MSB from C + 1LSB from B (flushed to MSB) + c2 = srb (i.C, 2) + slb (keep (i.B, 1), 7) + -- c3 = 8MSB from B + c3 = srb (i.B, 1) + --printf ("Instruction: %s %s", self.opnames[i.OP], tostringv (i)) + --printf ("Bin encoding: %x %x %x %x", c0, c1, c2, c3) + return string.char(c0, c1, c2, c3) +end + +------------------------------------------------------------------------ +-- decodes a 4-char little-endian string into an instruction struct +------------------------------------------------------------------------ +function luaP:DecodeInst(x) + error "Not implemented" +end + +------------------------------------------------------------------------ +-- invalid register that fits in 8 bits +------------------------------------------------------------------------ +luaP.NO_REG = luaP.MAXARG_A + +------------------------------------------------------------------------ +-- R(x) - register +-- Kst(x) - constant (in constant table) +-- RK(x) == if x < MAXSTACK then R(x) else Kst(x-MAXSTACK) +------------------------------------------------------------------------ + +------------------------------------------------------------------------ +-- grep "ORDER OP" if you change these enums +------------------------------------------------------------------------ + +--[[-------------------------------------------------------------------- +Lua virtual machine opcodes (enum OpCode): +------------------------------------------------------------------------ +name args description +------------------------------------------------------------------------ +OP_MOVE A B R(A) := R(B) +OP_LOADK A Bx R(A) := Kst(Bx) +OP_LOADBOOL A B C R(A) := (Bool)B; if (C) PC++ +OP_LOADNIL A B R(A) := ... := R(B) := nil +OP_GETUPVAL A B R(A) := UpValue[B] +OP_GETGLOBAL A Bx R(A) := Gbl[Kst(Bx)] +OP_GETTABLE A B C R(A) := R(B)[RK(C)] +OP_SETGLOBAL A Bx Gbl[Kst(Bx)] := R(A) +OP_SETUPVAL A B UpValue[B] := R(A) +OP_SETTABLE A B C R(A)[RK(B)] := RK(C) +OP_NEWTABLE A B C R(A) := {} (size = B,C) +OP_SELF A B C R(A+1) := R(B); R(A) := R(B)[RK(C)] +OP_ADD A B C R(A) := RK(B) + RK(C) +OP_SUB A B C R(A) := RK(B) - RK(C) +OP_MUL A B C R(A) := RK(B) * RK(C) +OP_DIV A B C R(A) := RK(B) / RK(C) +OP_POW A B C R(A) := RK(B) ^ RK(C) +OP_UNM A B R(A) := -R(B) +OP_NOT A B R(A) := not R(B) +OP_CONCAT A B C R(A) := R(B).. ... ..R(C) +OP_JMP sBx PC += sBx +OP_EQ A B C if ((RK(B) == RK(C)) ~= A) then pc++ +OP_LT A B C if ((RK(B) < RK(C)) ~= A) then pc++ +OP_LE A B C if ((RK(B) <= RK(C)) ~= A) then pc++ +OP_TEST A B C if (R(B) <=> C) then R(A) := R(B) else pc++ +OP_CALL A B C R(A), ... ,R(A+C-2) := R(A)(R(A+1), ... ,R(A+B-1)) +OP_TAILCALL A B C return R(A)(R(A+1), ... ,R(A+B-1)) +OP_RETURN A B return R(A), ... ,R(A+B-2) (see note) +OP_FORLOOP A sBx R(A)+=R(A+2); if R(A) =) R(A) +OP_CLOSURE A Bx R(A) := closure(KPROTO[Bx], R(A), ... ,R(A+n)) +----------------------------------------------------------------------]] + +luaP.opnames = {} -- opcode names +luaP.OpCode = {} -- lookup name -> number +luaP.ROpCode = {} -- lookup number -> name + +local i = 0 +for v in string.gfind([[ +MOVE -- 0 +LOADK +LOADBOOL +LOADNIL +GETUPVAL +GETGLOBAL -- 5 +GETTABLE +SETGLOBAL +SETUPVAL +SETTABLE +NEWTABLE -- 10 +SELF +ADD +SUB +MUL +DIV -- 15 +MOD +POW +UNM +NOT +LEN -- 20 +CONCAT +JMP +EQ +LT +LE -- 25 +TEST +TESTSET +CALL +TAILCALL +RETURN -- 30 +FORLOOP +FORPREP +TFORLOOP +SETLIST +CLOSE -- 35 +CLOSURE +VARARG +]], "[%a]+") do + local n = "OP_"..v + luaP.opnames[i] = v + luaP.OpCode[n] = i + luaP.ROpCode[i] = n + i = i + 1 +end +luaP.NUM_OPCODES = i + +--[[ +=========================================================================== + Notes: + (1) In OP_CALL, if (B == 0) then B = top. C is the number of returns - 1, + and can be 0: OP_CALL then sets 'top' to last_result+1, so + next open instruction (OP_CALL, OP_RETURN, OP_SETLIST) may use 'top'. + + (2) In OP_RETURN, if (B == 0) then return up to 'top' + + (3) For comparisons, B specifies what conditions the test should accept. + + (4) All 'skips' (pc++) assume that next instruction is a jump + + (5) OP_SETLISTO is used when the last item in a table constructor is a + function, so the number of elements set is up to top of stack +=========================================================================== +--]] + +------------------------------------------------------------------------ +-- masks for instruction properties +------------------------------------------------------------------------ +-- was enum OpModeMask: +luaP.OpModeBreg = 2 -- B is a register +luaP.OpModeBrk = 3 -- B is a register/constant +luaP.OpModeCrk = 4 -- C is a register/constant +luaP.OpModesetA = 5 -- instruction set register A +luaP.OpModeK = 6 -- Bx is a constant +luaP.OpModeT = 1 -- operator is a test + +------------------------------------------------------------------------ +-- get opcode mode, e.g. "iABC" +------------------------------------------------------------------------ +function luaP:getOpMode(m) + --printv(m) + --printv(self.OpCode[m]) + --printv(self.opmodes [self.OpCode[m]+1]) + return self.OpMode[tonumber(string.sub(self.opmodes[self.OpCode[m] + 1], 7, 7))] +end + +------------------------------------------------------------------------ +-- test an instruction property flag +-- * b is a string, e.g. "OpModeBreg" +------------------------------------------------------------------------ +function luaP:testOpMode(m, b) + return (string.sub(self.opmodes[self.OpCode[m] + 1], self[b], self[b]) == "1") +end + +-- number of list items to accumulate before a SETLIST instruction +-- (must be a power of 2) +-- * used in lparser, lvm, ldebug, ltests +luaP.LFIELDS_PER_FLUSH = 50 --FF updated to match 5.1 + +-- luaP_opnames[] is set above, as the luaP.opnames table +-- opmode(t,b,bk,ck,sa,k,m) deleted + +--[[-------------------------------------------------------------------- + Legend for luaP:opmodes: + 1 T -> T (is a test?) + 2 B -> B is a register + 3 b -> B is an RK register/constant combination + 4 C -> C is an RK register/constant combination + 5 A -> register A is set by the opcode + 6 K -> Bx is a constant + 7 m -> 1 if iABC layout, + 2 if iABx layout, + 3 if iAsBx layout +----------------------------------------------------------------------]] + +luaP.opmodes = { +-- TBbCAKm opcode + "0100101", -- OP_MOVE 0 + "0000112", -- OP_LOADK + "0000101", -- OP_LOADBOOL + "0100101", -- OP_LOADNIL + "0000101", -- OP_GETUPVAL + "0000112", -- OP_GETGLOBAL 5 + "0101101", -- OP_GETTABLE + "0000012", -- OP_SETGLOBAL + "0000001", -- OP_SETUPVAL + "0011001", -- OP_SETTABLE + "0000101", -- OP_NEWTABLE 10 + "0101101", -- OP_SELF + "0011101", -- OP_ADD + "0011101", -- OP_SUB + "0011101", -- OP_MUL + "0011101", -- OP_DIV 15 + "0011101", -- OP_MOD + "0011101", -- OP_POW + "0100101", -- OP_UNM + "0100101", -- OP_NOT + "0100101", -- OP_LEN 20 + "0101101", -- OP_CONCAT + "0000003", -- OP_JMP + "1011001", -- OP_EQ + "1011001", -- OP_LT + "1011001", -- OP_LE 25 + "1000101", -- OP_TEST + "1100101", -- OP_TESTSET + "0000001", -- OP_CALL + "0000001", -- OP_TAILCALL + "0000001", -- OP_RETURN 30 + "0000003", -- OP_FORLOOP + "0000103", -- OP_FORPREP + "1000101", -- OP_TFORLOOP + "0000001", -- OP_SETLIST + "0000001", -- OP_CLOSE 35 + "0000102", -- OP_CLOSURE + "0000101" -- OP_VARARG +} diff --git a/src/compiler/metaluac.mlua b/src/compiler/metaluac.mlua new file mode 100644 index 0000000..c4d1b81 --- /dev/null +++ b/src/compiler/metaluac.mlua @@ -0,0 +1,68 @@ +--*-lua-*- Set as a metalua file because it requires some metalua libs + +--[[do + local xrequire, n, ind = require, 0, "| " + function require (x) + print(ind:rep(n).."require: "..x) + n=n+1 + local y = xrequire(x) + n=n-1 + print(ind:rep(n).."/"..x); + return x + end +end--]] + +require 'mlc' +require 'clopts' + +local PRINT_AST, OUTPUT_FILE, EXECUTE, VERBOSE, SHARPBANG + +function parse_input_file(input_file) + local f + local ast = mlc.ast_of_luafile(input_file) + if PRINT_AST then table.print(ast, 80, 'nohash') end + if EXECUTE then f = mlc.function_of_ast(ast, input_file) end + if not EXECUTE or OUTPUT_FILE then + OUTPUT_FILE = OUTPUT_FILE or input_file:gsub('%.lua$', '.luac') + local o = io.open (OUTPUT_FILE, 'w') + if SHARPBANG then + o:write(SHARPBANG) + if not SHARPBANG:strmatch '\n$' then o:write '\n' end + end + o:write(luacstring_of_function(f, input_file)) + o:close() + end + if EXECUTE then f() end + OUTPUT_FILE, EXECUTE = nil, nil +end + +parser = clopts { + { short = 'a', long = 'ast', type = 'boolean', + action = function (b) PRINT_AST=b end, + usage = 'print the AST resulting from file compilation' + }, + { short = 'o', long = 'output', type = 'string', + action = function (s) OUTPUT_FILE=s end, + usage = 'set the target name of the next compiled file' + }, + { short = 'b', long = 'metabugs', type = 'boolean', + action = function (b) mlc.SHOW_METABUGS=b end, + usage = 'show syntax errors at metalevel 1 as metalevel 0 runtime errors' + }, + { short = 'x', long = 'execute', type = 'boolean', + action = function (b) EXECUTE=b end, + usage = 'execute the compiled file instead of saving it (unless -o is also used)' + }, + { short = 'v', long = 'verbose', type = 'boolean', + action = function (b) VERBOSE=b end, + usage = 'verbose mode' + }, + { short = 's', long = 'sharpbang', type = 'string', + action = function (s) SHARPBANG=s end, + usage = 'set a first line to add to compiled file, typically "#!/bin/env mlr"' + }, + parse_input_file, + usage='Compile and/or execute a metalua source file\nmetaluac [option|file]+', +} + +parser(...) \ No newline at end of file diff --git a/src/compiler/mlc.mlua b/src/compiler/mlc.mlua new file mode 100644 index 0000000..29e6dec --- /dev/null +++ b/src/compiler/mlc.mlua @@ -0,0 +1,158 @@ +--*-lua-*----------------------------------------------------------------------- +-- This module is written in a more hackish way than necessary, just +-- because I can. Its core feature is to dynamically generate a +-- function that converts from a source format to a destination +-- format; these formats are the various ways to represent a piece of +-- program, from the source file to the executable function. Legal +-- formats are: +-- +-- * luafile: the name of a file containing sources. +-- * luastring: these sources as a single string. +-- * lexstream: a stream of lexemes. +-- * ast: an abstract syntax tree. +-- * proto: a (Yueliang) struture containing a high level +-- representation of bytecode. Largely based on the +-- Proto structure in Lua's VM. +-- * luacstring: a string dump of the function, as taken by +-- loadstring() and produced by string.dump(). +-- * function: an executable lua function in RAM. +-- +-------------------------------------------------------------------------------- + +require 'bytecode' +require 'mlp' + +mlc = { } +setmetatable(mlc, mlc) +mlc.metabugs = false + +-------------------------------------------------------------------------------- +-- Order of the transformations. if 'a' is on the left of 'b', then a 'a' can +-- be transformed into a 'b' (but not the other way around). Since the table +-- is transposed, the test is 'if mlc.order.a > mlc.order.b then error(...) end' +-------------------------------------------------------------------------------- +mlc.order = table.transpose{ + 'luafile', 'luastring', 'lexstream', 'ast', 'proto', + 'luacstring', 'function' } + +-------------------------------------------------------------------------------- +-- The macro 'POINT(point_name, expected_type)' creates an entry point in the +-- 'mlc.convert' function. When we convert a 'a' into a 'b', FIXME +-------------------------------------------------------------------------------- +-{ block: + jump_to_point = `If{ } + function point_builder(args) + local name, point_type, code = unpack(args) + table.insert(jump_to_point, +{src_fmt == -{name}}) -- if source format is 'name' + table.insert(jump_to_point, { `Goto{name} }) -- then jump to label 'name' + return { + --------------------------------------------------- + -- Stop if this is the destination format + --------------------------------------------------- + +{stat: if dst_fmt == -{name} then return x end }, + --------------------------------------------------- + -- Start here if the source format matches + --------------------------------------------------- + `Label{ name }, + -- +{print(" *** point "..-{name})}, -- debug trace + --------------------------------------------------- + -- Check that the type matches + --------------------------------------------------- + +{stat: assert (-{point_type} == type(x), "Invalid source type") }, + -- perform transformation operations to the next type + } + end + mlp.lexer:add 'POINT' + mlp.stat:add{ 'POINT', mlp.string, ',', mlp.string, builder = point_builder } +} -- end of meta-block + +function mlc.convert (x, src_fmt, dst_fmt, name) + -- printf(" *** Convert a %s into a %s", src_fmt, dst_fmt) + -{ jump_to_point } + + error "Can't perform this conversion (bad src name)" + + POINT 'luafile', 'string' -- x is the src file's name + + if not name then name = x end + local f, msg = io.open(x, "rb") + if not f then error(msg) end + x = f:read'*a' + f:close() + + POINT 'luastring', 'string' -- x is the source + + x = mlp.lexer:newstream(x) + + POINT 'lexstream', 'table' -- x is the lexeme stream + + local status -- status = compilation success + local lx=x + if SHOW_METABUGS + -- If SHOW_METABUGS is true, errors should be attributed to a parser bug. + then status, x = true, mlp.chunk (lx) + -- If SHOW_METABUGS is false, errors should be attributed to an invalid entry. + else status, x = pcall (mlp.chunk, lx) end + -- FIXME: this test seems wrong ??? + if status and lx:peek().tag ~= "Eof" + then status, x = false, "Premature Eof" + elseif status and lx:peek().tag == "End" + then status, x = false, "Unexpected 'end' keyword" end + if not status and x then + -- x = error msg; get rid of ??? + x = x:match "[^:]+:[0-9]+: (.*)" or x + printf("Parsing error in %s line %s, char %s: \n%s", + filename or "?", lx.line, lx.i, x) + return nil + end + + POINT 'ast', 'table' -- x is the AST + x = bytecode.metalua_compile(x) + x.source = name + POINT 'proto', 'table' + x = bytecode.dump_string (x) + POINT 'luacstring', 'string' -- normally x is a bytecode dump + x = undump(x, name) + POINT 'function', 'function' + error "Can't perform this conversion (bad dst name)" +end + +-- Dynamically compose a conversion function from a function name +-- xxx_of_yyy() or yyy_to_xxx(). +function mlc.__index(_, name) + local dst, src = name:strmatch '^([a-z]+)_of_([a-z]+)$' + if not dst then src, dst = name:strmatch '^([a-z]+)_to_([a-z]+)$' end + if not src and dst then error "Bad converter name" end + local osrc, odst = mlc.order[src], mlc.order[dst] + if not src or not dst then error ("malformed mlc function "..name) end + if not osrc then error ("unknown source format "..src) end + if not odst then error ("unknown destination format "..src) end + if osrc > odst then error "Can't convert in this direction" end + return |x, name| mlc.convert(x, src, dst, name) +end + +-- This case isn't handled by the __index method, as it goes "in the wrong direction" +mlc.function_to_luacstring = string.dump +mlc.luacstring_of_function = string.dump + +-- These are drop-in replacement for loadfile() and loadstring(). The +-- C functions will call them instead of the original versions if +-- they're referenced in the registry. + +local function metalua_loadstring(str, name) + if type(str) ~= 'string' then error 'string expected' end + if str:match '^\027LuaQ' then return undump(str) end + local n = str:match '^#![^\n]*\n()' + if n then str=str:sub(n, -1) end + return mlc.function_of_luastring(str, name) +end + +local function metalua_loadfile(filename) + local f = io.open(filename, 'rb') + local src = f:read '*a' + f:close() + return metalua_loadstring(src, '@'..filename) +end + +debug.getregistry().loadstring = metalua_loadstring +debug.getregistry().loadfile = metalua_loadfile diff --git a/src/compiler/mlp_expr.lua b/src/compiler/mlp_expr.lua new file mode 100644 index 0000000..b9735a3 --- /dev/null +++ b/src/compiler/mlp_expr.lua @@ -0,0 +1,187 @@ +---------------------------------------------------------------------- +-- Metalua: $Id: mlp_expr.lua,v 1.7 2006/11/15 09:07:50 fab13n Exp $ +-- +-- Summary: metalua parser, expression parser. This is part of the +-- definition of module [mlp]. +-- +---------------------------------------------------------------------- +-- +-- Copyright (c) 2006, Fabien Fleutot . +-- +-- This software is released under the MIT Licence, see licence.txt +-- for details. +-- +---------------------------------------------------------------------- +-- History: +-- $Log: mlp_expr.lua,v $ +-- Revision 1.7 2006/11/15 09:07:50 fab13n +-- debugged meta operators. +-- Added command line options handling. +-- +-- Revision 1.6 2006/11/10 02:11:17 fab13n +-- compiler faithfulness to 5.1 improved +-- gg.expr extended +-- mlp.expr refactored +-- +-- Revision 1.5 2006/11/09 09:39:57 fab13n +-- some cleanup +-- +-- Revision 1.4 2006/11/07 21:29:02 fab13n +-- improved quasi-quoting +-- +-- Revision 1.3 2006/11/07 04:38:00 fab13n +-- first bootstrapping version. +-- +-- Revision 1.2 2006/11/05 15:08:34 fab13n +-- updated code generation, to be compliant with 5.1 +-- +---------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- +-- Exported API: +-- * [mlp.expr()] +-- * [mlp.expr_list()] +-- * [mlp.func_val()] +-- +-------------------------------------------------------------------------------- + +--require "gg" +--require "mlp_misc" +--require "mlp_table" +--require "mlp_meta" + +-------------------------------------------------------------------------------- +-- These function wrappers (eta-expansions ctually) are just here to break +-- some circular dependencies between mlp_xxx.lua files. +-------------------------------------------------------------------------------- +local function _expr (lx) return mlp.expr (lx) end +local function _table_content (lx) return mlp.table_content (lx) end +local function block (lx) return mlp.block (lx) end +local function stat (lx) return mlp.stat (lx) end + +module ("mlp", package.seeall) + +-------------------------------------------------------------------------------- +-- Non-empty expression list. Actually, this isn't used here, but that's +-- handy to give to users. +-------------------------------------------------------------------------------- +expr_list = gg.list{ _expr, separators = "," } + +-------------------------------------------------------------------------------- +-- Helpers for function applications / method applications +-------------------------------------------------------------------------------- +local func_args_content = gg.list { + name = "function arguments", + _expr, separators = ",", terminators = ")" } + +-- Used to parse methods +local method_args = gg.multisequence{ + name = "function argument(s)", + { "{", table_content, "}" }, + { "(", func_args_content, ")", builder = fget(1) }, + default = function(lx) local r = opt_string(lx); return r and {r} or { } end } + +-------------------------------------------------------------------------------- +-- [func_val] parses a function, from opening parameters parenthese to +-- "end" keyword included. Used for anonymous functions as well as +-- function declaration statements (both local and global). +-- +-- It's wrapped in a [_func_val] eta expansion, so that when expr +-- parser uses the latter, they will notice updates of [func_val] +-- definitions. +-------------------------------------------------------------------------------- +func_params_content = gg.list{ name="function parameters", + gg.multisequence{ { "...", builder = "Dots" }, default = id }, + separators = ",", terminators = {")", "|"} } + +local _func_params_content = function (lx) return func_params_content(lx) end + +func_val = gg.sequence { name="function body", + "(", func_params_content, ")", block, "end", builder = "Function" } + +local _func_val = function (lx) return func_val(lx) end + +-------------------------------------------------------------------------------- +-- Default parser for primary expressions +-------------------------------------------------------------------------------- +local function id_or_literal (lx) + local a = lx:next() + if a.tag~="Id" and a.tag~="String" and a.tag~="Number" then + gg.parse_error (lx, "Unexpected expr token %s", _G.table.tostring(a)) + end + return a +end + + +-------------------------------------------------------------------------------- +-- Builder generator for operators. Wouldn't be worth it if "|x|" notation +-- were allowed, but then lua 5.1 wouldn't compile it +-------------------------------------------------------------------------------- +-- opf1 = |op| |_,a| `Op{ op, a } +local function opf1 (op) return + function (_,a) return { tag="Op", op, a } end end +-- opf2 = |op| |a,_,b| `Op{ op, a, b } +local function opf2 (op) return + function (a,_,b) return { tag="Op", op, a, b } end end + + +-------------------------------------------------------------------------------- +-- +-- complete expression +-- +-------------------------------------------------------------------------------- + +-- FIXME: set line number. In [expr] transformers probably + +expr = gg.expr { name = "expression", + + primary = gg.multisequence{ name="expr primary", + { "(", _expr, ")", builder = "One" }, + { "function", _func_val, builder = fget(1) }, + { "-{", splice_content, "}", builder = fget(1) }, + { "+{", quote_content, "}", builder = fget(1) }, + { "nil", builder = "Nil" }, + { "true", builder = "True" }, + { "false", builder = "False" }, + { "...", builder = "Dots" }, + table, + default = id_or_literal }, + + infix = { name="expr infix op", + { "+", prec = 60, builder = opf2 "add" }, + { "-", prec = 60, builder = opf2 "sub" }, + { "*", prec = 70, builder = opf2 "mul" }, + { "/", prec = 70, builder = opf2 "div" }, + { "%", prec = 70, builder = opf2 "mod" }, + { "^", prec = 90, builder = opf2 "pow", assoc = "right" }, + { "..", prec = 40, builder = opf2 "concat", assoc = "right" }, + { "==", prec = 30, builder = opf2 "eq" }, + { "~=", prec = 30, builder = opf2 "ne" }, + { ">", prec = 30, builder = opf2 "gt" }, + { ">=", prec = 30, builder = opf2 "ge" }, + { "<", prec = 30, builder = opf2 "lt" }, + { "<=", prec = 30, builder = opf2 "le" }, + { "and",prec = 20, builder = opf2 "and" }, + { "or", prec = 10, builder = opf2 "or" } }, + + prefix = { name="expr prefix op", + { "not", prec = 80, builder = opf1 "not" }, + { "#", prec = 80, builder = opf1 "len" }, + { "-", prec = 80, builder = opf1 "unm" } }, + + suffix = { name="expr suffix op", + { "[", _expr, "]", builder = function (tab, idx) + return {tag="Index", tab, idx[1]} end}, + { ".", id, builder = function (tab, field) + return {tag="Index", tab, id2string(field[1])} end }, + { "(", func_args_content, ")", builder = function(f, args) + return {tag="Call", f, unpack(args[1])} end }, + { "{", _table_content, "}", builder = function (f, arg) + return {tag="Call", f, arg[1]} end}, + { ":", id, method_args, builder = function (obj, post) + return {tag="Method", obj, id2string(post[1]), unpack(post[2])} end}, + { "+{", quote_content, "}", builder = function (f, arg) + return {tag="Call", f, arg[1] } end }, + default = { parse=mlp.opt_string, builder = function(f, arg) + return {tag="Call", f, arg } end } } } diff --git a/src/compiler/mlp_ext.lua b/src/compiler/mlp_ext.lua new file mode 100644 index 0000000..566165d --- /dev/null +++ b/src/compiler/mlp_ext.lua @@ -0,0 +1,86 @@ +-------------------------------------------------------------------------------- +-- +-- Non-Lua syntax extensions +-- +-------------------------------------------------------------------------------- + +module ("mlp", package.seeall) + +-------------------------------------------------------------------------------- +-- Alebraic Datatypes +-------------------------------------------------------------------------------- +local function adt (lx) + local tagval = id (lx) [1] + local tagkey = {tag="Key", {tag="String", "tag"}, {tag="String", tagval} } + if lx:peek().tag == "String" or lx:peek().tag == "Number" then + return { tag="Table", tagkey, lx:next() } + elseif lx:is_keyword (lx:peek(), "{") then + local x = table (lx) + _G.table.insert (x, 1, tagkey) + return x + else return { tag="Table", tagkey } end +end + +expr:add{ "`", adt, builder = fget(1) } + +-------------------------------------------------------------------------------- +-- Anonymous lambda +-------------------------------------------------------------------------------- +local lambda_expr = gg.sequence{ + "|", func_params_content, "|", expr, + builder= function (x) + return {tag="Function", x[1], { {tag="Return", x[2] } } } end } + +-- In an earlier version, lambda_expr took an expr_list rather than an expr +-- after the 2nd bar. However, it happened to be much more of a burden than an +-- help, So finally I disabled it. If you want to return several results, +-- use the long syntax. +-------------------------------------------------------------------------------- +-- local lambda_expr = gg.sequence{ +-- "|", func_params_content, "|", expr_list, +-- builder= function (x) +-- return {tag="Function", x[1], { {tag="Return", unpack(x[2]) } } } end } + +expr:add (lambda_expr) + +-------------------------------------------------------------------------------- +-- Allows to write "a `f` b" instead of "f(a, b)". Taken from Haskell. +-- This is not part of Lua 5.1 syntax, so it's added to the expression +-- afterwards, so that it's easier to disable. +-------------------------------------------------------------------------------- +local function expr_in_backquotes (lx) return expr(lx, 35) end + +expr.infix:add{ name = "infix function", + "`", expr_in_backquotes, "`", prec = 35, assoc="left", + builder = function(a, op, b) return {tag="Call", op[1], a, b} end } + + +-------------------------------------------------------------------------------- +-- table.override assignment +-------------------------------------------------------------------------------- + +mlp.lexer:add "<-" +stat.assignments["<-"] = function (a, b) + assert( #a==1 and #b==1, "No multi-args for '<-'") + return { tag="Call", { tag="Index", { tag="Id", "table" }, + { tag="String", "override" } }, + a[1], b[1]} +end + +-------------------------------------------------------------------------------- +-- C-style op+assignments +-------------------------------------------------------------------------------- +local function op_assign(kw, op) + local function rhs(a, b) + return { tag="Op", op, a, b } + end + local function f(a,b) + return { tag="Let", a, _G.table.imap(rhs, a, b) } + end + mlp.lexer:add (kw) + mlp.stat.assignments[kw] = f +end + +_G.table.iforeach (op_assign, + {"+=", "-=", "*=", "/="}, + {"add", "sub", "mul", "div"}) \ No newline at end of file diff --git a/src/compiler/mlp_lexer.lua b/src/compiler/mlp_lexer.lua new file mode 100644 index 0000000..469fcb9 --- /dev/null +++ b/src/compiler/mlp_lexer.lua @@ -0,0 +1,32 @@ +---------------------------------------------------------------------- +-- Metalua: $Id: mll.lua,v 1.3 2006/11/15 09:07:50 fab13n Exp $ +-- +-- Summary: Source file lexer. ~~Currently only works on strings. +-- Some API refactoring is needed. +-- +---------------------------------------------------------------------- +-- +-- Copyright (c) 2006-2007, Fabien Fleutot . +-- +-- This software is released under the MIT Licence, see licence.txt +-- for details. +-- +---------------------------------------------------------------------- + +module ("mlp", package.seeall) +require "std" +require "lexer" + +local mlp_lexer = lexer.lexer:clone() + +local keywords = { + "and", "break", "do", "else", "elseif", + "end", "false", "for", "function", "if", + "in", "local", "nil", "not", "or", "repeat", + "return", "then", "true", "until", "while", + "...", "..", "==", ">=", "<=", "~=", + "+{", "-{" } + +for w in values(keywords) do mlp_lexer:add(w) end + +_M.lexer = mlp_lexer diff --git a/src/compiler/mlp_meta.lua b/src/compiler/mlp_meta.lua new file mode 100644 index 0000000..179bf1b --- /dev/null +++ b/src/compiler/mlp_meta.lua @@ -0,0 +1,147 @@ +---------------------------------------------------------------------- +-- Metalua: $Id: mlp_meta.lua,v 1.4 2006/11/15 09:07:50 fab13n Exp $ +-- +-- Summary: Meta-operations: AST quasi-quoting and splicing +-- +---------------------------------------------------------------------- +-- +-- Copyright (c) 2006, Fabien Fleutot . +-- +-- This software is released under the MIT Licence, see licence.txt +-- for details. +-- +---------------------------------------------------------------------- +-- History: +-- $Log: mlp_meta.lua,v $ +-- Revision 1.4 2006/11/15 09:07:50 fab13n +-- debugged meta operators. +-- +-- Revision 1.2 2006/11/09 09:39:57 fab13n +-- some cleanup +-- +-- Revision 1.1 2006/11/07 21:29:02 fab13n +-- improved quasi-quoting +-- +-- Revision 1.3 2006/11/07 04:38:00 fab13n +-- first bootstrapping version. +-- +-- Revision 1.2 2006/11/05 15:08:34 fab13n +-- updated code generation, to be compliant with 5.1 +-- +---------------------------------------------------------------------- + + +-------------------------------------------------------------------------------- +-- +-- Exported API: +-- * [mlp.splice_content()] +-- * [mlp.quote_content()] +-- +-------------------------------------------------------------------------------- + +--require "compile" +--require "ldump" + +module ("mlp", package.seeall) + +-------------------------------------------------------------------------------- +-- External splicing: compile an AST into a chunk, load and evaluate +-- that chunk, and replace the chunk by its result (which must also be +-- an AST). +-------------------------------------------------------------------------------- + +local function splice (ast) + --printf(" [SPLICE] Ready to compile:\n%s", _G.table.tostring (ast, "nohash", 60)) + local f = mlc.function_of_ast(ast) + --printf " [SPLICE] Splice Compiled." + local r = f() + --printf " [SPLICE] Splice Evaled." + return r +end + +-------------------------------------------------------------------------------- +-- Going from an AST to an AST representing that AST +-- the only key being lifted in this version is ["tag"] +-------------------------------------------------------------------------------- +function quote (t) + --print("QUOTING:", _G.table.tostring(t, 60)) + local cases = { } + function cases.table (t) + local mt = { tag = "Table" } + if t.tag == "Splice" then + assert (#t==1, "Invalid splice") + return t[1] + elseif t.tag then + _G.table.insert (mt, { tag = "Key", quote "tag", quote (t.tag) }) + end + for _, v in ipairs (t) do + _G.table.insert (mt, quote(v)) + end + return mt + end + function cases.number (t) return { tag = "Number", t } end + function cases.string (t) return { tag = "String", t } end + return cases [ type (t) ] (t) +end + +-------------------------------------------------------------------------------- +-- when this variable is false, code inside [-{...}] is compiled and +-- avaluated immediately. When it's true (supposedly when we're +-- parsing data inside a quasiquote), [-{foo}] is replaced by +-- [`Splice{foo}], which will be unpacked by [quote()]. +-------------------------------------------------------------------------------- +in_a_quote = false + +-------------------------------------------------------------------------------- +-- Parse the inside of a "-{ ... }" +-------------------------------------------------------------------------------- +function splice_content (lx) + local parser_name = "expr" + if lx:is_keyword (lx:peek(2), ":") then + local a = lx:next() + lx:next() -- skip ":" + assert (a.tag=="Id", "Invalid splice parser name") + parser_name = a[1] +-- printf("this splice is a %s", parser_name) +-- else +-- printf("no splice specifier:\npeek(1)") +-- _G.table.print(lx:peek(1)) +-- printf("peek(2)") +-- _G.table.print(lx:peek(2)) + end + local ast = mlp[parser_name](lx) + if in_a_quote then + --printf("SPLICE_IN_QUOTE:\n%s", _G.table.tostring(ast, "nohash", 60)) + return { tag="Splice", ast } + else + if parser_name == "expr" then ast = { { tag="Return", ast } } + elseif parser_name == "stat" then ast = { ast } + elseif parser_name ~= "block" then + error ("splice content must be an expr, stat or block") end + --printf("EXEC THIS SPLICE:\n%s", _G.table.tostring(ast, "nohash", 60)) + return splice (ast) + end +end + +-------------------------------------------------------------------------------- +-- Parse the inside of a "+{ ... }" +-------------------------------------------------------------------------------- +function quote_content (lx) + local parser = mlp.expr + if lx:is_keyword (lx:peek(2), ":") then + parser = mlp[id(lx)[1]] + lx:next() + end + --assert(not in_a_quote, "Nested quotes not handled yet") + local prev_iq = in_a_quote + in_a_quote = true + --print("IN_A_QUOTE") + local content = parser (lx) + local q_content = quote (content) + --printf("/IN_A_QUOTE:\n* content=\n%s\n* q_content=\n%s\n", + -- _G.table.tostring(content, "nohash", 60), + -- _G.table.tostring(q_content, "nohash", 60)) + in_a_quote = prev_iq + return q_content +end + diff --git a/src/compiler/mlp_misc.lua b/src/compiler/mlp_misc.lua new file mode 100644 index 0000000..29ddb87 --- /dev/null +++ b/src/compiler/mlp_misc.lua @@ -0,0 +1,173 @@ +---------------------------------------------------------------------- +-- Metalua: $Id: mlp_misc.lua,v 1.6 2006/11/15 09:07:50 fab13n Exp $ +-- +-- Summary: metalua parser, miscellaneous utility functions. +-- +---------------------------------------------------------------------- +-- +-- Copyright (c) 2006, Fabien Fleutot . +-- +-- This software is released under the MIT Licence, see licence.txt +-- for details. +-- +---------------------------------------------------------------------- +-- History: +-- $Log: mlp_misc.lua,v $ +-- Revision 1.6 2006/11/15 09:07:50 fab13n +-- debugged meta operators. +-- Added command line options handling. +-- +-- Revision 1.5 2006/11/10 02:11:17 fab13n +-- compiler faithfulness to 5.1 improved +-- gg.expr extended +-- mlp.expr refactored +-- +-- Revision 1.4 2006/11/09 09:39:57 fab13n +-- some cleanup +-- +-- Revision 1.3 2006/11/07 04:38:00 fab13n +-- first bootstrapping version. +-- +-- Revision 1.2 2006/11/05 15:08:34 fab13n +-- updated code generation, to be compliant with 5.1 +-- +---------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- +-- Exported API: +-- * [mlp.fget()] +-- * [mlp.id()] +-- * [mlp.opt_id()] +-- * [mlp.id_list()] +-- * [mlp.gensym()] +-- * [mlp.string()] +-- * [mlp.opt_string()] +-- * [mlp.id2string()] +-- +-------------------------------------------------------------------------------- + +--require "gg" +--require "mll" + +module ("mlp", package.seeall) + +-------------------------------------------------------------------------------- +-- returns a function that takes the [n]th element of a table. +-- if [tag] is provided, then this element is expected to be a +-- table, and this table receives a "tag" field whose value is +-- set to [tag]. +-- +-- The primary purpose of this is to generate builders for +-- grammar generators. It has little purpose in metalua, as lambda has +-- a lightweight syntax. +-------------------------------------------------------------------------------- + +function fget (n, tag) + assert (type (n) == "number") + if tag then + assert (type (tag) == "string") + return function (x) + assert (type (x[n]) == "table") + return {tag=tag, unpack(x[n])} end + else + return function (x) return x[n] end + end +end + + +-------------------------------------------------------------------------------- +-- Try to read an identifier (possibly as a splice), or return [false] if no +-- id is found. +-------------------------------------------------------------------------------- +function opt_id (lx) + local a = lx:peek(); + if lx:is_keyword (a, "-{") then + local v = gg.sequence{ "-{", splice_content, "}" } (lx) [1] + if v.tag ~= "Id" and v.tag ~= "Splice" then + gg.parse_error(lx,"Bad id splice") + end + return v + elseif a.tag == "Id" then return lx:next() + else return false end +end + +-------------------------------------------------------------------------------- +-- Mandatory reading of an id: causes an error if it can't read one. +-------------------------------------------------------------------------------- +function id (lx) + return opt_id (lx) or gg.parse_error(lx,"Identifier expected") +end + +-------------------------------------------------------------------------------- +-- Common helper function +-------------------------------------------------------------------------------- +id_list = gg.list { primary = mlp.id, separators = "," } + +-------------------------------------------------------------------------------- +-- Symbol generator: [gensym()] returns a guaranteed-to-be-unique identifier. +-- The main purpose is to avoid variable capture in macros. +-- +-- If a string is passed as an argument, theis string will be part of the +-- id name (helpful for macro debugging) +-------------------------------------------------------------------------------- +local gensymidx = 0 + +function gensym (arg) + gensymidx = gensymidx + 1 + return { tag="Id", _G.string.format("$%i$%s", gensymidx, arg or "")} +end + +-------------------------------------------------------------------------------- +-- Converts an identifier into a string. Hopefully one day it'll handle +-- splices gracefully, but that proves quite tricky. +-------------------------------------------------------------------------------- +function id2string (id) + --print("id2string:", disp.ast(id)) + if id.tag == "Id" then id.tag = "String"; return id + elseif id.tag == "Splice" then + assert (in_a_quote, "can't do id2string on an outermost splice") + error ("id2string on splice not implemented") + -- Evaluating id[1] will produce `Id{ xxx }, + -- and we want it to produce `String{ xxx } + -- Morally, this is what I want: + -- return `String{ `Index{ `Splice{ id[1] }, `Number 1 } } + -- That is, without sugar: + return {tag="String", {tag="Index", {tag="Splice", id[1] }, + {tag="Number", 1 } } } + else error ("Not an identifier: "..table.tostring(id)) end +end + +-------------------------------------------------------------------------------- +-- Read a string, possibly spliced, or return an error if it can't +-------------------------------------------------------------------------------- +function string (lx) + local a = lx:peek() + if lx:is_keyword (a, "-{") then + local v = gg.sequence{ "-{", splice_content, "}" } (lx) [1] + if v.tag ~= "" and v.tag ~= "Splice" then + gg.parse_error(lx,"Bad string splice") + end + return v + elseif a.tag == "String" then return lx:next() + else error "String expected" end +end + +-------------------------------------------------------------------------------- +-- Try to read a string, or return false if it can't. No splice allowed. +-------------------------------------------------------------------------------- +function opt_string (lx) + return lx:peek().tag == "String" and lx:next() +end + +-------------------------------------------------------------------------------- +-- Chunk reader: block + Eof +-------------------------------------------------------------------------------- +local function _block(...) return block(...) end +local function mandatory_eof (lx) + local eof = lx:peek() + if eof.tag ~= "Eof" then error "End-of-file expected" end + return true +end + +chunk = gg.sequence{ _block, mandatory_eof, builder = fget(1) } \ No newline at end of file diff --git a/src/compiler/mlp_stat.lua b/src/compiler/mlp_stat.lua new file mode 100644 index 0000000..4b086a4 --- /dev/null +++ b/src/compiler/mlp_stat.lua @@ -0,0 +1,229 @@ +---------------------------------------------------------------------- +-- Metalua: $Id: mlp_stat.lua,v 1.7 2006/11/15 09:07:50 fab13n Exp $ +-- +-- Summary: metalua parser, statement/block parser. This is part of +-- the definition of module [mlp]. +-- +---------------------------------------------------------------------- +-- +-- Copyright (c) 2006, Fabien Fleutot . +-- +-- This software is released under the MIT Licence, see licence.txt +-- for details. +-- +---------------------------------------------------------------------- +-- History: +-- $Log: mlp_stat.lua,v $ +-- Revision 1.7 2006/11/15 09:07:50 fab13n +-- debugged meta operators. +-- Added command line options handling. +-- +-- Revision 1.6 2006/11/10 02:11:17 fab13n +-- compiler faithfulness to 5.1 improved +-- gg.expr extended +-- mlp.expr refactored +-- +-- Revision 1.5 2006/11/09 09:39:57 fab13n +-- some cleanup +-- +-- Revision 1.4 2006/11/07 21:29:02 fab13n +-- improved quasi-quoting +-- +-- Revision 1.3 2006/11/07 04:38:00 fab13n +-- first bootstrapping version. +-- +-- Revision 1.2 2006/11/05 15:08:34 fab13n +-- updated code generation, to be compliant with 5.1 +-- +---------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- +-- Exports API: +-- * [mlp.stat()] +-- * [mlp.block()] +-- * [mlp.for_header()] +-- * [mlp.add_block_terminators()] +-- +-------------------------------------------------------------------------------- + +--require "gg" +--require "mll" +--require "mlp_misc" +--require "mlp_expr" +--require "mlp_meta" + +-------------------------------------------------------------------------------- +-- eta-expansions to break circular dependency +-------------------------------------------------------------------------------- +local expr = function (lx) return mlp.expr (lx) end +local func_val = function (lx) return mlp.func_val (lx) end +local expr_list = function (lx) return mlp.expr_list(lx) end + +module ("mlp", package.seeall) + +-------------------------------------------------------------------------------- +-- List of all keywords that indicate the end of a statement block. Users are +-- likely to extend this list when designing extensions. +-------------------------------------------------------------------------------- + + +local block_terminators = { "else", "elseif", "end", "until", ")", "}", "]" } + +-- FIXME: this must be handled from within GG!!! +function block_terminators:add(x) + if type (x) == "table" then for _, y in ipairs(x) do self:add (y) end + else _G.table.insert (self, x) end +end + +-------------------------------------------------------------------------------- +-- list of statements, possibly followed by semicolons +-------------------------------------------------------------------------------- +block = gg.list { + name = "statements block", + terminators = block_terminators, + primary = function (lx) + local x = stat (lx) + if lx:is_keyword (lx:peek(), ";") then lx:next() end + return x + end } + +-------------------------------------------------------------------------------- +-- Helper function for "return " parsing. +-- Called when parsing return statements +-------------------------------------------------------------------------------- +local return_expr_list_parser = gg.list { + expr, separators = ",", terminators = block_terminators } + +-------------------------------------------------------------------------------- +-- for header, between [for] and [do] (exclusive). +-- Return the `Forxxx{...} AST, without the body element (the last one). +-------------------------------------------------------------------------------- +function for_header (lx) + local var = mlp.id (lx) + if lx:is_keyword (lx:peek(), "=") then + -- Fornum: only 1 variable + lx:next() -- skip "=" + local e = expr_list (lx) + assert (2 <= #e and #e <= 3, "2 or 3 values in a fornum") + return { tag="Fornum", var, unpack (e) } + else + -- Forin: there might be several vars + local a = lx:is_keyword (lx:next(), ",", "in") + if a=="in" then var_list = { var } else + -- several vars; first "," skipped, read other vars + var_list = gg.list{ + primary = id, separators = ",", terminators = "in" } (lx) + _G.table.insert (var_list, 1, var) -- put back the first variable + lx:next() -- skip "in" + end + local e = expr_list (lx) + return { tag="Forin", var_list, e } + end +end + +-------------------------------------------------------------------------------- +-- Function def parser helper: id ( . id ) * +-------------------------------------------------------------------------------- +local function fn_builder (list) + local r = list[1] + for i = 2, #list do r = { tag="Index", r, id2string(list[i]) } end + return r +end +local func_name = gg.list{ id, separators = ".", builder = fn_builder } + +-------------------------------------------------------------------------------- +-- Function def parser helper: ( : id )? +-------------------------------------------------------------------------------- +local method_name = gg.onkeyword{ name = "method invocation", ":", id, + transformers = { function(x) return x and id2string(x) end } } + +-------------------------------------------------------------------------------- +-- Function def builder +-------------------------------------------------------------------------------- +local function funcdef_builder(x) + local name, method, func = x[1], x[2], x[3] + if method then + name = { tag="Index", name, method } + _G.table.insert (func[1], 1, {tag="Id", "self"}) + end + return { tag="Let", {name}, {func} } +end + + +-------------------------------------------------------------------------------- +-- if statement builder +-------------------------------------------------------------------------------- +local function if_builder (x) + local cb_pairs, else_block, r = x[1], x[2], {tag="If"} + for i=1,#cb_pairs do r[2*i-1]=cb_pairs[i][1]; r[2*i]=cb_pairs[i][2] end + if else_block then r[#r+1] = else_block end + return r +end + +-------------------------------------------------------------------------------- +-- produce a list of (expr,block) pairs +-------------------------------------------------------------------------------- +local elseifs_parser = gg.list { + gg.sequence { expr, "then", block }, + separators = "elseif", + terminators = { "else", "end" } } + +-------------------------------------------------------------------------------- +-- assignments and calls: statements that don't start with a keyword +-------------------------------------------------------------------------------- +local function assign_or_call_stat_parser (lx) + local e = expr_list (lx) + local a = lx:is_keyword(lx:peek()) + local op = a and stat.assignments[a] + if op then + --FIXME: check that [e] is a LHS + lx:next() + local v = expr_list (lx) + if type(op)=="string" then return { tag=op, e, v } + else return op (e, v) end + else + assert (#e > 0) + if #e > 1 then + gg.parse_error (lx, "comma is not a valid statement separator") end + if e[1].tag ~= "Call" and e[1].tag ~= "Method" then + gg.parse_error (lx, "This expression is of type '%s'; ".. + "only function and method calls make valid statements", + e[1].tag or "") + end + return e[1] + end +end + +local local_stat_parser = gg.multisequence{ + -- local function + { "function", id, func_val, builder = + function(x) return { tag="Localrec", { x[1] }, { x[2] } } end }, + -- local ( = )? + default = gg.sequence{ id_list, gg.onkeyword{ "=", expr_list }, + builder = function(x) return {tag="Local", x[1], x[2] or { } } end } } + +-------------------------------------------------------------------------------- +-- statement +-------------------------------------------------------------------------------- +stat = gg.multisequence { + name="statement", + { "do", block, "end", builder = + function (x) return { tag="Do", unpack (x[1]) } end }, + { "for", for_header, "do", block, "end", builder = + function (x) x[1][#x[1]+1] = x[2]; return x[1] end }, + { "function", func_name, method_name, func_val, builder=funcdef_builder }, + { "while", expr, "do", block, "end", builder = "While" }, + { "repeat", block, "until", expr, builder = "Repeat" }, + { "local", local_stat_parser, builder = fget (1) }, + { "return", return_expr_list_parser, builder = fget (1, "Return") }, + { "break", builder = function() return { tag="Break" } end }, + { "-{", splice_content, "}", builder = fget(1) }, + { "if", elseifs_parser, gg.onkeyword{ "else", block }, "end", + builder = if_builder }, + default = assign_or_call_stat_parser } + +stat.assignments = { + ["="] = "Let" } + +function stat.assignments:add(k, v) self[k] = v end \ No newline at end of file diff --git a/src/compiler/mlp_table.lua b/src/compiler/mlp_table.lua new file mode 100644 index 0000000..b578853 --- /dev/null +++ b/src/compiler/mlp_table.lua @@ -0,0 +1,89 @@ +---------------------------------------------------------------------- +-- Metalua: $Id: mlp_table.lua,v 1.5 2006/11/10 02:11:17 fab13n Exp $ +-- +-- Summary: metalua parser, table constructor parser. This is part +-- of thedefinition of module [mlp]. +-- +---------------------------------------------------------------------- +-- +-- Copyright (c) 2006, Fabien Fleutot . +-- +-- This software is released under the MIT Licence, see licence.txt +-- for details. +-- +---------------------------------------------------------------------- +-- History: +-- $Log: mlp_table.lua,v $ +-- Revision 1.5 2006/11/10 02:11:17 fab13n +-- compiler faithfulness to 5.1 improved +-- gg.expr extended +-- mlp.expr refactored +-- +-- Revision 1.4 2006/11/09 09:39:57 fab13n +-- some cleanup +-- +-- Revision 1.3 2006/11/07 04:38:00 fab13n +-- first bootstrapping version. +-- +-- Revision 1.2 2006/11/05 15:08:34 fab13n +-- updated code generation, to be compliant with 5.1 +-- +---------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- +-- Exported API: +-- * [mlp.table_field()] +-- * [mlp.table_content()] +-- * [mlp.table()] +-- +-- KNOWN BUG: doesn't handle final ";" or "," before final "}" +-- +-------------------------------------------------------------------------------- + +--require "gg" +--require "mll" +--require "mlp_misc" + +module ("mlp", package.seeall) + +-------------------------------------------------------------------------------- +-- eta expansion to break circular dependencies: +-------------------------------------------------------------------------------- +local function _expr (lx) return expr(lx) end + +-------------------------------------------------------------------------------- +-- [[key] = value] table field definition +-------------------------------------------------------------------------------- +local bracket_field = gg.sequence{ "[", _expr, "]", "=", _expr, builder = "Key" } + +-------------------------------------------------------------------------------- +-- [id = value] or [value] table field definition; +-- [[key]=val] are delegated to [bracket_field()] +-------------------------------------------------------------------------------- +function table_field (lx) + if lx:is_keyword (lx:peek(), "[") then return bracket_field (lx) end + local e = _expr (lx) + if lx:is_keyword (lx:peek(), "=") then + if e.tag ~= 'Id' then _G.table.print(e,80) end + assert (e.tag == "Id", "Identifier required on the left of = in table") + lx:next(); return {tag="Key", {tag="String", e[1]}, _expr(lx)} + else return e end +end + +local function _table_field(lx) return table_field(lx) end + +-------------------------------------------------------------------------------- +-- table constructor, without enclosing braces; returns a full table object +-------------------------------------------------------------------------------- +table_content = gg.list { _table_field, + separators = { ",", ";" }, terminators = "}", builder = "Table" } + +local function _table_content(lx) return table_content(lx) end + +-------------------------------------------------------------------------------- +-- complete table constructor including [{...}] +-------------------------------------------------------------------------------- +table = gg.sequence{ "{", _table_content, "}", builder = fget(1) } + + diff --git a/src/junk/README b/src/junk/README new file mode 100644 index 0000000..c818c4b --- /dev/null +++ b/src/junk/README @@ -0,0 +1 @@ +This directory is intended to contain unfinished, random, poor or temporary stuff that shouldn't make it to a distro. \ No newline at end of file diff --git a/src/junk/hygienic.lua b/src/junk/hygienic.lua new file mode 100755 index 0000000..dac0ce7 --- /dev/null +++ b/src/junk/hygienic.lua @@ -0,0 +1,279 @@ +---------------------------------------------------------------------- +-- Metalua: $Id$ +-- +-- Summary: Hygienic macro facility for Metalua +-- +---------------------------------------------------------------------- +-- +-- Copyright (c) 2006, Fabien Fleutot . +-- +-- This software is released under the MIT Licence, see licence.txt +-- for details. +-- +-------------------------------------------------------------------------------- +-- +-- ============= +-- W A R N I N G +-- ============= +-- +-- THIS IS AN OLD NAIVE IMPLEMENTATION. IT'S PARATIAL (NO HYGIENE WRT OUTSIDE) +-- AND WRITTEN FROM SCRATCH WITH PATTERN MATCHING. MUST BE DONE WITH A WALKER. +-- +-- Traditional macros carry a well-known pitfall, called variable capture: +-- when pasting a piece of source code A into another code B, if B bonds some +-- variables used by A, then the meaning of A is modified in a way probably +-- not intended by the user. +-- +-- Example: +-- A = +{ n = 5 } +-- B = +{ local n=3; -{ A } } +-- +-- In this example, [n] in [A] will be captured by the local variable declared +-- by [B], and this is probably a bug. +-- +-- Notice that this also exists in C. Typical example: +-- +-- #define swap (type, a, b) do { type tmp=a; a=b; b=tmp } while(0) +-- void f() { +-- int tmp=1, a=2; +-- swap (int, tmp, a); // won't work, [tmp] is captured in the macro +-- } +-- +-- We can fix this by making sure that all local variables and parameters +-- created by [B] have fresh names. [mlp.gensym()] produces guaranteed-to-be-unique +-- variable names; we use it to replace all local var names declarations and +-- occurences in [B] by such fresh names. +-- +-- Such macros which are guaranteed not to capture any variable are called +-- hygienic macros. By extension, an AST guaranteed not to contain capturing +-- variables is called an hygienic AST. +-- +-- We implement here some functions which make sure that an AST is hygienic: +-- +-- - [hygienize_stat (ast)] for statement AST; +-- - [hygienize_stat (ast)] for statement block AST; +-- - [hygienize_expr (ast)] for expression AST; +-- +-- This sample deconstructs AST by structural pattern matching, which is +-- supported by Metalua extension "match.lua" +-- +-------------------------------------------------------------------------------- + +-{ extension "match" } + +require "std" + +local clone_ctx = std.shallow_copy + +-------------------------------------------------------------------------------- +-- Tag tables: these allow [hygienize] to decide whether an AST is +-- an expression, a statement, or something which isn't changed by +-- alpha renaming. +-------------------------------------------------------------------------------- +local stat_tags = { + Do = true, Let = true, + While = true, Repeat = true, + If = true, Fornum = true, + Forin = true, Local = true, + Localrec = true, Return = true } + +local expr_tags = { + Function = true, Table = true, + Op = true, Call = true, + Method = true, Index = true } + +local neutral_tags = { + String = true, Number = true, + True = true, False = true, + Dots = true, Break = true, + Id = true } + +-------------------------------------------------------------------------------- +-- Choose the relevant [hygienize_xxx()] function according to the AST's tag +-- and the tables above. +-------------------------------------------------------------------------------- +function hygienize (ast) + if not ast.tag then hygienize_block (ast) + elseif neutral_tags[ast.tag] then -- pass + elseif stat_tags[ast.tag] then hygienize_stat (ast) + elseif expr_tags[ast.tag] then hygienize_expr (ast) + else error "Unrecognized AST" end + return ast +end + +if mlp then + -- Add hygienic parsers for quotes + mlp.hexpr = hygienize `o` mlp.expr + mlp.hstat = hygienize `o` mlp.stat + mlp.hblock = hygienize `o` mlp.block +end + +-------------------------------------------------------------------------------- +-- Make a statement AST hygienic. The optional [ctx] parameter is a +-- [old_name -> new_name] map, which holds variable name substitutions +-- to perform. +-------------------------------------------------------------------------------- +function hygienize_stat (ast, ctx) + if not ctx then ctx = { } end + match ast with + | { ... } if not ast.tag -> hygienize_block (ast, ctx) + | `Do{ ... } -> hygienize_block (ast, clone_ctx (ctx)) + + | `Let{ vars, vals } -> + hygienize_expr_list (vars, ctx) + hygienize_expr_list (vals, ctx) + + | `While{ cond, block } -> + hygienize_expr (cond, ctx) + -- use a clone of [ctx], since the block has a separate scope + hygienize_block (ast, clone_ctx (ctx)) + + | `Repeat{ block, cond } -> + -- use a clone of [ctx], since the block has a separate scope. + -- Notice that the condition in [repeat ... until] is evaluated + -- inside the block's scope, i.e. with [inner_ctx] rather than [ctx]. + local inner_ctx = clone_ctx (ctx) + hygienize_block (ast, inner_ctx) + hygienize (cond, inner_ctx) + + | `If{ ... } -> + for i=1, #ast-1, 2 do + hygienize_expr (ast[i], ctx) -- condtion + -- each block has its own scope + hygienize_block (ast[i+1], clone_ctx (ctx)) -- conditional block + end + if #ast % 2 == 1 then + hygienize_block (ast[#ast], clone_ctx (ctx)) -- else block + end + + | `Fornum{ var, ... } -> + hygienize_expr (ast[i], ctx, 2, #ast-1) -- start, finish, step? exprs + local inner_ctx = clone_ctx (ctx) + alpha_rename (var, inner_ctx) -- rename local var [var] in [inner_ctx] + hygienize_block (ast[#ast], inner_ctx) + + | `Forin{ vars, vals, block } -> + hygienize_expr_list (vals, ctx) + local inner_ctx = clone_ctx (ctx) + alpha_rename_list (vars, inner_ctx) -- rename local vars [vars] in [inner_ctx] + hygienize_block (block, inner_ctx) + + | `Local{ vars, vals } -> + -- locals only enter in scope after their values are computed + -- --> parse values first, then rename vars + hygienize_expr_list (vals, ctx) + alpha_rename_list (vars, ctx) + + | `Localrec{ vars, vals } -> + -- As opposed to [`Local], vars are in scope during their values' + -- computation --> rename before parsing values. + alpha_rename_list (vars, ctx) + hygienize_expr_list (vals, ctx) + + | `Call{ ... } | `Method{ ... } -> + -- these are actually expr, delegate to [hygienize_expr] + hygienize_expr (ast, ctx) + + | `Return{ ... } -> hygienize_expr_list (ast, ctx) + | `Break -> + | _ -> error ("Unknown statement "..ast.tag) + end +end + + +-------------------------------------------------------------------------------- +-- Make an expression AST hygienic. The optional [ctx] parameter is a +-- [old_name -> new_name] map, which holds variable name substitutions +-- to perform. +-------------------------------------------------------------------------------- +function hygienize_expr (ast, ctx) + if not ctx then ctx = { } end + match ast with + | `String{ _ } | `Number{ _ } | `True | `False | `Dots -> -- nothing + + | `Function{ params, block } -> + local inner_ctx = clone_ctx (ctx) + alpha_rename_list (params, inner_ctx) + hygienize_block (block, inner_ctx) + + | `Table{ ... } -> + for _, x in ipairs (ast) do + match x with + | `Key{ key, val } -> + hygienize_expr (key, ctx) + hygienize_expr (val, ctx) + | _ -> hygienize (x, ctx) + end + end + + | `Id{ x } -> + -- Check for substitutions to apply: + local y = ctx[x]; if y then ast[1] = y end + + | `Op{ op, ... } -> + hygienize_expr_list (ast, ctx, 2, #ast) + + -- Just dispatch to sub-expressions: + | `Call{ func, ... } + | `Method{ obj, `String{ name }, ... } + | `Index{ table, key } -> + hygienize_expr_list (ast, ctx) + | _ -> error ("Unknown expression "..ast.tag) + end +end + +-------------------------------------------------------------------------------- +-- Make an statements block AST hygienic. The optional [ctx] parameter is a +-- [old_name -> new_name] map, which holds variable name substitutions +-- to perform. +-------------------------------------------------------------------------------- +function hygienize_block (ast, ctx) + if not ctx then ctx = { } end + table.iter ((|x| hygienize(x, ctx)), ast) +-- for i = 1, #ast do +-- hygienize_stat (ast[i], ctx) +-- end +end + +-------------------------------------------------------------------------------- +-- Makes a shallow copy of a table. Used to make a copy of [ctx] substitution +-- tables, when entering a new scope. +-------------------------------------------------------------------------------- +--[[ +function clone_ctx (ctx) + local r = { } + for k, v in pairs (ctx) do r[k] = v end + return r +end +]] + +-------------------------------------------------------------------------------- +-- Make every expression from index [start] to [finish], in list +-- [ast], hygienic. The optional [ctx] parameter is a [old_name -> +-- new_name] map, which holds variable name substitutions to perform. +-- [start] defaults to 1, [finish] defaults to the list's size. +-------------------------------------------------------------------------------- +function hygienize_expr_list (ast, ctx, start, finish) + for i = start or 1, finish or #ast do + hygienize_expr (ast[i], ctx) + end +end + +-------------------------------------------------------------------------------- +-- Replace the identifier [var]'s name with a fresh one generated by +-- [mlp.gensym()], and store the new association in [ctx], so that the +-- calling function will be able to substitute identifier occurences with +-- its new name. +-------------------------------------------------------------------------------- +function alpha_rename (var, ctx) + assert (var.tag == "Id") + ctx[var[1]] = mlp.gensym()[1] + var[1] = ctx[var[1]] +end + +-------------------------------------------------------------------------------- +-- runs [alpha_rename] on a list of identifiers. +-------------------------------------------------------------------------------- +function alpha_rename_list (vars, ctx) + for _, v in ipairs(vars) do alpha_rename (v, ctx) end +end diff --git a/src/junk/hygienic2.lua b/src/junk/hygienic2.lua new file mode 100644 index 0000000..d0ca8c3 --- /dev/null +++ b/src/junk/hygienic2.lua @@ -0,0 +1,101 @@ +-------------------------------------------------------------------------------- +-- +-- (c) Fabien Fleutot 2007, published under the MIT license. +-- +-- +-- API: +-- ---- +-- * freevars.block(ast) +-- * freevars.expr(ast) +-- * freevars.stat(ast) +-- +-------------------------------------------------------------------------------- + +require 'std' +require 'walk' +require 'freevars' + +-{ extension 'match' } + +-------------------------------------------------------------------------------- +-- Return the string->boolean hash table of the names of all free variables +-- in 'term'. 'kind' is the name of an entry in module 'walk', presumably +-- one of 'expr', 'stat' or 'block'. +-------------------------------------------------------------------------------- +local function alpha (kind, term) + local cfg = { expr = { }, stat = { }, block = { } } + + ----------------------------------------------------------------------------- + -- Monkey-patch the scope add method, so that it associates a unique name + -- to bound vars. + ----------------------------------------------------------------------------- + local scope = scope:new() + function scope:add(vars) + for v in values(vars) do self.current[v] = mlp.gensym(v) end + end + + ----------------------------------------------------------------------------- + -- Check identifiers; add functions parameters to scope + ----------------------------------------------------------------------------- + function cfg.expr.down(x) + match x with + | `Splice{...} -> return 'break' -- don't touch user parts + | `Id{ name } -> + local alpha = scope.current[name] + if alpha then x[1] = alpha end + | `Function{ params, _ } -> scope:push(); scope:add (params) + | _ -> -- pass + end + end + + ----------------------------------------------------------------------------- + -- Close the function scope opened by 'down()' + ----------------------------------------------------------------------------- + function cfg.expr.up(x) + match x with `Function{...} -> scope:pop() | _ -> end + end + + ----------------------------------------------------------------------------- + -- Create a new scope and register loop variable[s] in it + ----------------------------------------------------------------------------- + function cfg.stat.down(x) + match x with + | `Splice{...} -> return 'break' + | `Forin{ vars, ... } -> scope:push(); scope:add(vars) + | `Fornum{ var, ... } -> scope:push(); scope:add{var} + | `Localrec{ vars, ... } -> scope:add(vars) + | `Repeat{ block, cond } -> -- 'cond' is in the scope of 'block' + scope:push() + for s in values (block) do walk.stat(cfg)(s) end -- no new scope + walk.expr(cfg)(cond) + scope:pop() + return 'break' -- No automatic walking of subparts + | _ -> -- pass + end + end + + ----------------------------------------------------------------------------- + -- Close the scopes opened by 'up()' + ----------------------------------------------------------------------------- + function cfg.stat.up(x) + match x with + | `Forin{ ... } | `Fornum{ ... } -> scope:pop() -- `Repeat has no up(). + | `Local{ vars, ... } -> scope:add(vars) + | _ -> -- pass + end + end + + ----------------------------------------------------------------------------- + -- Create a separate scope for each block + ----------------------------------------------------------------------------- + function cfg.block.down() scope:push() end + function cfg.block.up() scope:pop() end + + walk[kind](cfg)(term) + return freevars +end + +-------------------------------------------------------------------------------- +-- A wee bit of metatable hackery. Just couldn't resist, sorry. +-------------------------------------------------------------------------------- +freevars = setmetatable ({ scope=scope }, { __index = |_, k| |t| fv(k, t) }) diff --git a/src/junk/notes.txt b/src/junk/notes.txt new file mode 100644 index 0000000..8bfe06c --- /dev/null +++ b/src/junk/notes.txt @@ -0,0 +1,182 @@ +This distribution of metalua tries to favor ease of install over +saving a couple of kilobytes; therefore it directly embeds pieces of +useful other free software rather than letting users fetch and +configure them, and it installs separately from a regular lua install, +instead of messing it up. + + +Open source code used by metalua + + +Metalua current sources include (possibly slightly modified versions +of) these open source projects: + +- Lua, of course. + +- Yueliang, a Lua compiler in written in Lua: this is + the base of metalua's bytecode dumper. + +- Rings, a part of the Kelper project, which lets handle multiple Lua + states from within Lua. + +- Editline, an interactive command line editor, very similar to GNU + readline but with a more permissive licence. + +- bitlib for bitwise manipulations (especially useful for bytecode + dumping) + +How to make it: +1 - make lua compiler and VM +2 - make bitlib and rings +3 - compile metalua .lua files +4 - compile metalua .c files + + +modifications to mlc/mlr: + +- when several files are compiled with mlc, each chunk receives the + command line arguments in '...' + +- luaL_loadfile() and luaL_loadstring() try to call + debug.getregistry().loadfile() and debug.getregistry().loadstring(). + It affects Lua functions loadstring(), loadfile(), dostring(), + dofile(), require(). + +steps: +- take back std libs into metalua +- take back compiler +- put metalua compilation in separate rings +- rework lexer: allow lexer subclassing, changing lexer dynamically in mlp +- change AST +- rework code generator with bitlib + + +Functions to patch +- pairs/ipairs +- type/rawtype + +Comment gerer le bootstrap: +- si ca foire, j'emets un warning mais je ne crashe pas +- a la compil initiale, ca va pas le faire evidemment +- je compile tous les fichiers de metalua en un seul package + mlc.luac + + +au debut, je tente un "require 'base'" + +mon probleme: je voudrais eviter de charger metalua si je cherche +juste a executer du bytecode. donc le chargement de mlc.lua se fait +s'il y a une source a compiler, dans loadstring. Ici une variable +booleenne statique peut faire gagner du temps, sans etre indispensable + +Au et puis merde, on s'en fout, si le bloc est precompile c'est +vraiment pas la mer a boire + +Changing luac into mlc +---------------------- +The first step is to patch luaL_loadfile() and luaL_loadstring(), so +that they attempt to run a custom compiler provided in Lua. That +compiler is taken from the registry's "loadfile" (respectively +"loadstring") entry, which should be a function. If absent, we just +fallback to the original compiler that comes with Lua. This takes +little extra resources, and dramatically simplifies the bootstrapping +process: you don't need some bytecode nor some external Lua +distribution to compile metalua (Fixes happen in "lauxlib.c") + +There also are some extra options handled, -a to show the AST, -b to +cause parsing failure to appear as Lua parser crashes (instead of +trying to produce a sensible syntax error message: useful when your +compile-time parts are buggy). + +The mlc module +-------------- +This module contains all of the compilation stuff. The version +available after compilation is heavily based on the pattern matching +extension, so it isn't used in the code required for bootstrapping +(which has to be in lua inter metalua. That is, then, Lua) + +Libraries +--------- + +The mechanism of metalua libraries is exactly the same as Lua's, +except that the environment variable names ahve been changed to allow +peaceful cohabitation with Lua. + +FIXME: il faut pouvoir verifier la presence, chargeable, d'une +librairie sans reellement la charger. findfile() dans loadlib.c semble +etre charge de ca. Avec ca, je peux verifier, dans extension(), si la +lib runtime existe ou pas, et decider de l'inclure ou pas dans le +code resultant. + + +bootstrap: +========== +le but c'est de compiler les bouts en pur lua pour faire un compilo +minimaliste. Puis, l'utiliser pour generer le bytecode de la version +complete. + +Par ailleurs, je me melange entre le compilo basique et la lib. Le +compilo doit s'appeler mlc tout court, et la lib mlc.luac. + +Autre approche: je laisse tomber le mlc en C, il est facile a +implementer avec mlr. Il faut juste garder/exporter le combine(). + +Etancheite: +=========== +Il faut s'assurer qu'il n'y a pas de fuites entre differents niveaux +et differentes sessions de compil. Il faut donc: +- repartir de zero a chaque compilation (chaque + luaL_load[file/string]()). +- shell interactif: + * separer les niveaux + * permettre de monter/descendre d'un niveau avec des commandes + dediees: "+:" et "-:" +- + +Hygiene: +======== +Unifier freevars avec un walker plus generique. + + +Restent a faire: +================ +- ajouter des METALUA_PATH et METALUA_CPATH qui overrident LUA_XXX + quand ils sont presents. [X] + +- choisir une structure definitive pour les librairies + +- swap de lexers + +- reflechir a l'addition automatique des mots-clef par les parsers qui + vont bien. Peut-etre qu'ils sont attaches optionnellement a un lexer, + et que cet attachement est transmis par defaut qd on insere un + parser ds un autre + +- renommer x_quote/x_splice quote/splice [X] + +- ipairs/pairs/type -> rawipairs/rawpairs/type [X] + +- ajouter std au libs autochargees [X] + +- splitter std/table2 [X] + +- le $ pour les macros en standard + +- extension: determiner s'il y a un runtime a la compil + +- etancheite + +- Voir le compilo d'EVE + +Bugs connus: +- require qui merde -> regle +- reentrance de in_a_quote dans mlp_meta.lua +- refuser les flags autres qu'expr dans les splices in_a_quote + +Variante d'organisation: +======================== + +On considere le compilo comme une librairie classique, et on compte +des les depart sur la presence d'un tas de libs standard. + + diff --git a/src/lib/autotable.lua b/src/lib/autotable.lua new file mode 100644 index 0000000..2a8a4fd --- /dev/null +++ b/src/lib/autotable.lua @@ -0,0 +1,9 @@ +local mt = { } +function mt:__index(key) + local v = auto{ } + self[key] = v + return v +end + +auto = |t| setmetatable(t or { }, mt) + \ No newline at end of file diff --git a/src/lib/clopts.lua b/src/lib/clopts.lua new file mode 100644 index 0000000..e3d316c --- /dev/null +++ b/src/lib/clopts.lua @@ -0,0 +1,118 @@ +-{ extension 'match' } + +function clopts(cfg) + local legal_types = table.transpose{'boolean','string','number','nil'} + + -- Fill short and long name indexes, and check its validity + local short, long, param_func = { }, { } + for x in ivalues(cfg) do + match x with + | { action=a } -> + if not x.type then x.type='nil' end + if not legal_types[x.type] then error ("Invalid type name "..x.type) end + if x.short then + if short[x.short] then error ("multiple definitions for option "..x.short) + else short[x.short] = x end + end + if x.long then + if long[x.long] then error ("multiple definitions for option "..x.long) + else long[x.long] = x end + end + | { ... } -> error "invalid table entry in clopts: no action specified" + | _ if type(x)=='function' -> + if param_func then error "multiple parameters handler in clopts" + else param_func=x end + | _ -> error ("invalid clopts config entry of type "..type(x)) + end + end + + -- Print a help message, summarizing how to use the command line + local function print_usage(msg) + if msg then print(msg,'\n') end + print(cfg.usage or "Options:\n") + for x in values(cfg) do + if type(x) == 'table' then + local opts = { } + if x.type=='boolean' then + if x.short then opts = { '-'..x.short, '+'..x.short } end + if x.long then table.insert (opts, '--'..x.long) end + else + if x.short then opts = { '-'..x.short..' <'..x.type..'>' } end + if x.long then table.insert (opts, '--'..x.long..' <'..x.type..'>' ) end + end + printf(" %s: %s", table.concat(opts,', '), x.usage or '') + end + end + end + + -- Unless overridden, -h and --help display the help msg + if not short.h then short.h = {action=print_usage;type='nil'} end + if not long.help then long.help = {action=print_usage;type='nil'} end + + -- Helper function for parse + local function actionate(table, flag, opt, i, args) + local x = table[opt] + if not x then print_usage ("invalid option "..flag..opt); return false; end + match x.type with + | 'string' | 'number' -> + if flag=='+' then + print_usage ("flag "..flag.." is reserved for boolean options, not for "..opt) + return false + end + local arg = args[i+1] + if not arg then + print_usage ("missing parameter for option "..flag..opt) + return false + end + x.action(arg) + return i+2 + | 'boolean' -> x.action(flag~='+'); return i+1 + | 'nil' -> x.action(); return i+1 + | t -> error('bad type for clopts action: '..t) + end + end + + -- Parse a list of commands + local function parse(...) + local args = type(...)=='table' and ... or {...} + local i, i_max = 1, #args + while i <= i_max do + local arg, flags, opts, opt = args[i] + --printf('beginning of loop: i=%i/%i, arg=%q', i, i_max, arg) + flag, opt = arg:strmatch "^(%-%-)(.+)" + if opt then + -- double dash option + i=actionate (long, flag, opt, i, args) + -{ `Goto 'continue' } + end + flag, opts = arg:strmatch "^([+-])(.+)" + if opts then + -- single plus or single dash series of short options + local j_max, i2 = opts:len() + for j = 1, j_max do + opt = opts:sub(j,j) + --printf ('parsing short opt %q', opt) + i2 = actionate (short, flag, opt, i, args) + if i2 ~= i+1 and j < j_max then + error ('short option '..opt..' needs a param of type '..short[opt]) + end + end + i=i2 + -{ `Goto 'continue' } + end + if param_func then + -- handler for non-option parameter + param_func(args[i]) + i=i+1 + else + print_usage "No option before parameter" + return false + end + -{ `Label 'continue' } + if not i then return false end + end -- + end + return parse +end + + diff --git a/src/lib/ext-lib/classes.lua b/src/lib/ext-lib/classes.lua new file mode 100644 index 0000000..8a68950 --- /dev/null +++ b/src/lib/ext-lib/classes.lua @@ -0,0 +1,36 @@ +-{ extension "match" } + +-------------------------------------------------------------------------------- +-- rootclass: there's a need for one object +-------------------------------------------------------------------------------- +rootclass = { init = const(nil), prototype = { } } +rootinstance_mt = { __index = rootclass } +function rootclass:new() + local this = table.shallow_copy (self.prototype) + setmetatable (this, rootinstance_mt) + return this +end + +-------------------------------------------------------------------------------- +-- creatng a new class +-------------------------------------------------------------------------------- +function newclass (ancestors, fields, methods) + local thisclass = methods + match #ancestors with + | 0 -> thisclass.super = rootclass + | 1 -> thisclass.super = ancestors[1] + | n -> error "This class model doesn't support multiple inheritance" + end + thisclass.prototype = fields + local instance_mt = { __index = thisclass } + local class_mt = { __index = thisclass.super } + setmetatable (thisclass, class_mt) + function thisclass:new (...) + local this = self.super:new() + for k, v in pairs (self.prototype) do this[k]=v end + setmetatable (this, instance_mt) + this:init (...) + return this + end + return thisclass +end diff --git a/src/lib/ext-lib/clist.lua b/src/lib/ext-lib/clist.lua new file mode 100644 index 0000000..ace0f14 --- /dev/null +++ b/src/lib/ext-lib/clist.lua @@ -0,0 +1 @@ +do end \ No newline at end of file diff --git a/src/lib/ext-lib/continue.lua b/src/lib/ext-lib/continue.lua new file mode 100644 index 0000000..ace0f14 --- /dev/null +++ b/src/lib/ext-lib/continue.lua @@ -0,0 +1 @@ +do end \ No newline at end of file diff --git a/src/lib/ext-lib/exceptions.lua b/src/lib/ext-lib/exceptions.lua new file mode 100644 index 0000000..289c38a --- /dev/null +++ b/src/lib/ext-lib/exceptions.lua @@ -0,0 +1,21 @@ +exception = { } +exn_mt = { } +setmetatable (exception, exn_mt) + +function exn_mt.__lt(a,b) + return getmetatable(a) == exn_mt and + getmetatable(b) == exn_mt and + b.super and a <= b.super +end + +function exn_mt.__le (a,b) + return a==b or a") + elseif flist.p (l.tl) then + table.insert (acc, ", ") + aux (l.tl, acc) + else -- there's a non-list tl + table.insert (acc, " | ") + table.insert (acc, tostring(l.tl)) + table.insert (acc, " |>") + end + end + aux (l) + return table.concat (acc) +end + diff --git a/src/lib/ext-lib/lazy.lua b/src/lib/ext-lib/lazy.lua new file mode 100644 index 0000000..f698ecf --- /dev/null +++ b/src/lib/ext-lib/lazy.lua @@ -0,0 +1,22 @@ +module("lazy", package.seeall) + +local THUNK_MT = { } + +function thunk (f) + return setmetatable ({raw=f}, THUNK_MT) +end + +is_thunk = |th| getmetatable(th) == THUNK_MT + +function force (th) + if not is_thunk(th) then return th + elseif th.raw then th.value=th.raw(); th.raw=nil; return th.value + else return th.value end +end + +function table (t) + local mt = { __rawtable = t } + function mt.__index(_, key) return force(t[key]) end + function mt.__newindex(_, key, val) t[key]=val end + return setmetatable({}, mt) +end \ No newline at end of file diff --git a/src/lib/ext-lib/localin.lua b/src/lib/ext-lib/localin.lua new file mode 100644 index 0000000..ace0f14 --- /dev/null +++ b/src/lib/ext-lib/localin.lua @@ -0,0 +1 @@ +do end \ No newline at end of file diff --git a/src/lib/ext-lib/match.lua b/src/lib/ext-lib/match.lua new file mode 100644 index 0000000..ace0f14 --- /dev/null +++ b/src/lib/ext-lib/match.lua @@ -0,0 +1 @@ +do end \ No newline at end of file diff --git a/src/lib/ext-lib/onwith.lua b/src/lib/ext-lib/onwith.lua new file mode 100644 index 0000000..ace0f14 --- /dev/null +++ b/src/lib/ext-lib/onwith.lua @@ -0,0 +1 @@ +do end \ No newline at end of file diff --git a/src/lib/ext-lib/ternary.lua b/src/lib/ext-lib/ternary.lua new file mode 100644 index 0000000..ace0f14 --- /dev/null +++ b/src/lib/ext-lib/ternary.lua @@ -0,0 +1 @@ +do end \ No newline at end of file diff --git a/src/lib/ext-lib/types.lua b/src/lib/ext-lib/types.lua new file mode 100644 index 0000000..838e88e --- /dev/null +++ b/src/lib/ext-lib/types.lua @@ -0,0 +1,135 @@ +-------------------------------------------------------------------------------- +-- Initialize the types table. It has an __index metatable entry, +-- so that if a symbol is not found in it, it is looked for in the current +-- environment. It allows to write things like [ n=3; x :: vector(n) ]. +-------------------------------------------------------------------------------- +types = { } +setmetatable (types, { __index = getfenv(0)}) + +-------------------------------------------------------------------------------- +-- Built-in types +-------------------------------------------------------------------------------- +for typename in values{ "number", "string", "boolean", "function", "thread" } do + types[typename] = + function (val) + if type(val) ~= typename then error (typename .. " expected") end + end +end + +-------------------------------------------------------------------------------- +-- [list (subtype)] checks that the term is a table, and all of its +-- integer-indexed elements are of type [subtype]. +-------------------------------------------------------------------------------- +function types.table (...) + local key_type, val_type, range_from, range_to + -- arguments parsing + for x in values{...} do + if type(x) == "number" then + if range2 then error "Invalid type: too many numbers in table type" + elseif range1 then range2 = x + else range1 = x end + else + if type_key then error "Invalid type: too many types" + elseif type_val then type_key, type_val = type_val, x + else type_val = x end + end + end + if not range2 then range2=range1 end + if not type_key then type_key = types.integer end + return function (val) + if type(val) ~= "table" then error "table expected" end + local s = #val + if range2 and range2 > s then error "Not enough elements" end + if range1 and range1 < s then error "Too many elements elements" end + for k,v in pairs(args) do + type_key(k) + type_val(v) + end + end +end + +types.list = |...| types.table (types.integer, ...) + +-------------------------------------------------------------------------------- +-- Check that [x] is an integral number +-------------------------------------------------------------------------------- +function types.int (x) + if type(x)~="number" or x%1~=0 then error "Integer number expected" end +end + +-------------------------------------------------------------------------------- +-- [range(a,b)] checks that number [val] is between [a] and [b]. [a] and [b] +-- can be omitted. +-------------------------------------------------------------------------------- +function types.range (a,b) + return function (val) + if type(val)~="number" or a and valb then + error (string.format("Number between %s and %s expected", + a and tostring(a) or "-infty", + b and tostring(b) or "+infty")) + end + end +end + +-------------------------------------------------------------------------------- +-- [inter (x, y)] checks that the term has both types [x] and [y]. +-------------------------------------------------------------------------------- +function types.inter (...) + local args={...} + return function(val) + for t in values(args) do t(args) end + end +end + +-------------------------------------------------------------------------------- +-- [inter (x, y)] checks that the term has type either [x] or [y]. +-------------------------------------------------------------------------------- +function types.union (...) + local args={...} + return function(val) + for t in values(args) do if pcall(t, val) then return end end + error "None of the types in the union fits" + end +end + +-------------------------------------------------------------------------------- +-- [optional(t)] accepts values of types [t] or [nil]. +-------------------------------------------------------------------------------- +function types.optional(t) + return function(val) if val~=nil then t(val) end end +end + +-------------------------------------------------------------------------------- +-- A call to this is done on litteral tables passed as types, i.e. +-- type {1,2,3} is transformed into types.__table{1,2,3}. +-------------------------------------------------------------------------------- +function types.__table(s_type) + return function (s_val) + if type(s_val) ~= "table" then error "Struct table expected" end + for k, field_type in pairs (s_type) do + local r, msg = pcall (field_type, s_val[k]) + if not r then + error(string.format("In structure field `%s': %s", k, msg)) + end + end + end +end + +-------------------------------------------------------------------------------- +-- Same as __table, except that it's called on literal strings. +-------------------------------------------------------------------------------- +function types.__string(s_type) + return function (s_val) + if s_val ~= s_type then + error(string.format("String %q expected", s_type)) + end + end +end + +-------------------------------------------------------------------------------- +-- Top and Bottom: +-------------------------------------------------------------------------------- +function types.any() end +function types.none() error "Empty type" end +types.__add = types.union +types.__mul = types.inter \ No newline at end of file diff --git a/src/lib/ext-syntax/anaphoric.lua b/src/lib/ext-syntax/anaphoric.lua new file mode 100644 index 0000000..e5ac6c5 --- /dev/null +++ b/src/lib/ext-syntax/anaphoric.lua @@ -0,0 +1,28 @@ +require 'freevars' + +local function anaphoric_if(ast) + local it_found = false + for i=2, #ast do + if freevars.block(ast[i])['it'] then + it_found = true + break + end + end + if it_found then + local cond = ast[1] + ast[1] = +{it} + return +{stat: do local it = -{cond}; -{ast} end } + end +end + +local function anaphoric_while(ast) + local it_found = false + if freevars.block(ast[2])['it'] then + local cond = ast[1] + ast[1] = +{it} + return +{stat: do local it = -{cond}; -{ast} end } + end +end + +mlp.stat:get'if'.transformers:add(anaphoric_if) +mlp.stat:get'while'.transformers:add(anaphoric_while) \ No newline at end of file diff --git a/src/lib/ext-syntax/classes.lua b/src/lib/ext-syntax/classes.lua new file mode 100644 index 0000000..3aaf4e2 --- /dev/null +++ b/src/lib/ext-syntax/classes.lua @@ -0,0 +1,56 @@ +require "std" + +-{ extension "match" } + +-------------------------------------------------------------------------------- +-- Build the call to [newclass] +-------------------------------------------------------------------------------- +local function class_builder(x) + local ancestors, decl = x[1] or `Table{ }, x[2] + local methods, fields = `Table{ }, `Table{ } + ancestors.tag = "Table" + for line in values(decl) do + match line with + | `Field{ lhs, rhs } -> for i = 1, #lhs do + table.insert (fields, `Key{ mlp.id2string(lhs[i]), rhs[i] or `Nil }) end + | `Method{ name, m } -> + table.insert (m[1], 1, `Id "self") -- add self as 1st param + table.insert (methods, `Key{ name, m }) + end + end + return `Call{ `Id "newclass", ancestors, fields, methods } +end + +-------------------------------------------------------------------------------- +-- Parsers +-------------------------------------------------------------------------------- +local ancestry = gg.onkeyword{ name="class ancestors", + "<:", gg.list{ mlp.expr, separators="," } } + +local method_parser = gg.sequence{ name="in-class method definition", + "function", mlp.id, mlp.func_val, + builder = |x| `Method{ mlp.id2string(x[1]), x[2] } } + +local field_parser = gg.sequence{ name="in-class instance field declaration", + "local", gg.list{ mlp.id, separators="," }, + gg.onkeyword{ "=", + gg.list{ mlp.expr, separators=",", + terminators={ "local", "function", "end" } } }, + builder = |x| `Field{ x[1], x[2] or { } } } + +local class_val = gg.sequence { name = "class body", + ancestry, + gg.list {gg.multisequence {method_parser, field_parser}, terminators="end"}, + "end", + builder = class_builder } + +-------------------------------------------------------------------------------- +-- Pluging the parsers in the syntax +-------------------------------------------------------------------------------- +mlp.lexer:add{ "class", "<:" } + +mlp.stat:add{ name = "class declaration", + "class", mlp.expr, class_val, builder = |x| `Let{ {x[1]}, {x[2]} } } + +mlp.expr:add{ name = "anonymous class", + "class", class_val, builder = |x| x[1] } \ No newline at end of file diff --git a/src/lib/ext-syntax/clist.lua b/src/lib/ext-syntax/clist.lua new file mode 100644 index 0000000..751df0c --- /dev/null +++ b/src/lib/ext-syntax/clist.lua @@ -0,0 +1,140 @@ +---------------------------------------------------------------------- +-- Metalua samples: $Id$ +-- +-- Summary: Lists by comprehension +-- +---------------------------------------------------------------------- +-- +-- Copyright (c) 2006-2007, Fabien Fleutot . +-- +-- This software is released under the MIT Licence, see licence.txt +-- for details. +-- +-------------------------------------------------------------------------------- +-- +-- This extension implements list comprehensions, similar to Haskell and +-- Python syntax, to easily describe lists. +-- +-------------------------------------------------------------------------------- + +-{ extension "match" } + +require "std" + +local function dots_builder (x) return `Dots{ x } end + +local function for_builder (x, h) + match x with + | `Comp{ _, acc } -> table.insert (acc, h[1]); return x + | `Key{ _, _ } -> error "No explicit key in a for list generator" + | _ -> return `Comp{ x, {h[1]} } + end +end + +local function if_builder (x, p) + match x with + | `Comp{ _, acc } -> table.insert (acc, `If{ p[1] }); return x + | `Key{ _, _ } -> error "No explicit key in a list guard" + | _ -> return `Comp{ x, p[1] } + end +end + +local function comp_builder(core, list, no_unpack) + -- [ti] = temp var holding table.insert + -- [v] = variable holding the table being built + -- [r] = the core of the list being built + local ti, v, r = mlp.gensym "table_insert", mlp.gensym "table" + + ----------------------------------------------------------------------------- + -- 1 - Build the loop's core: if it has suffix "...", every elements of the + -- multi-return must be inserted, hence the extra [for] loop. + ----------------------------------------------------------------------------- + match core with + | `Dots{ x } -> + local w = mlp.gensym() + r = +{stat: for -{w} in values( -{x} ) do -{ `Call{ ti, v, w } } end } + | `Key{ k, w } -> + r = `Let{ { `Index{ v, k } }, { w } } + | x -> r = `Call{ ti, v, x } + end + + ----------------------------------------------------------------------------- + -- 2 - Stack the if and for control structures, from outside to inside. + -- This is done in a destructive way for the elements of [list]. + ----------------------------------------------------------------------------- + for i = #list, 1, -1 do + table.insert (list[i], {r}) + r = list[i] + end + if no_unpack then + return `Stat{ { `Local{ {ti, v}, { +{table.insert}, `Table} }, r }, v } + else + return +{ function() + local -{ti}, -{v} = table.insert, { } + -{r}; return unpack(-{v}) + end () } + end +end + +local function table_content_builder (list) + match list with + | { `Comp{ y, acc } } -> return comp_builder( y, acc, "no unpack") + | _ -> + local tables = { `Table } + local ctable = tables[1] + local function flush() ctable=`Table; table.insert(tables, ctable) end + for x in values(list) do + match x with + | `Comp{ y, acc } -> table.insert(ctable, comp_builder(y, acc)); flush() + | `Dots{ y } -> table.insert(ctable, y); flush() + | _ -> table.insert (ctable, x); + end + end + match tables with + | { x } | { x, { } } -> return x + | _ -> + if #tables[#tables]==0 then table.remove(tables) end --suppress empty table + return `Call{ +{table.cat}, unpack(tables) } + end + end +end + +mlp.table_field = gg.expr{ name="table cell", + primary = mlp.table_field, + suffix = { name="table cell suffix", + { "...", builder = dots_builder }, + { "for", mlp.for_header, builder = for_builder }, + { "if", mlp.expr, builder = if_builder } } } + +mlp.table_content.builder = table_content_builder + +--[[ +mlp.stat:add{ "for", gg.expr { + primary = for_header, + suffix = { + { "for", mlp.for_header, builder = for_builder }, + { "if", mlp.expr, builder = if_builder } } }, + "do", mlp.block, "end", builder = for_stat_builder } +]] + +local function index_builder(a, suffix) + match suffix[1] with + | { { e, false } } -> return `Index{ a, e } + | ranges -> + local r = `Call{ +{table.isub}, a } + local function acc(x,y) table.insert(r,x); table.insert(r,y) end + for seq in values(ranges) do + match seq with + | { e, false } -> acc(e,e) + | { e, f } -> acc(e,f) + end + end + return r + end +end + +mlp.expr.suffix:add{ name="table index/range", + "[", gg.list{ + gg.sequence { mlp.expr, gg.onkeyword{ "...", mlp.expr } } , + separators = { ",", ";" } }, + "]", builder = index_builder } diff --git a/src/lib/ext-syntax/continue.lua b/src/lib/ext-syntax/continue.lua new file mode 100644 index 0000000..4c4aeaf --- /dev/null +++ b/src/lib/ext-syntax/continue.lua @@ -0,0 +1,58 @@ +require "walk" + +---------------------------------------------------------------------- +-- * [loop_tags] are the tags of statements which support continue. +-- * [loop_keywords] are the initial keywords which trigger the parsing +-- of these statements: they're indeed indexed by keyword in [mlp.stat]. +---------------------------------------------------------------------- + +local loop_tags = { "Forin", "Fornum", "While", "Repeat" } +local loop_keywords = { "for", "while", "repeat" } + +---------------------------------------------------------------------- +-- This function takes the AST of a continue-enabled loop, parse +-- its body to find all instances of [`Continue]. If any of them +-- is found ([label~=nil]), they're transformed in [`Goto{...}], and +-- the corresponding label is added at the end of the loop's body. +-- +-- Caveat: if a [continue] appears in the non-body part of a loop +-- (and therefore is relative to some enclosing loop), it isn't +-- handled, and therefore causes a compilation error. This could +-- only happen due in a [`Stat{ }], however, since [`Function{ }] +-- cuts the search for [`Continue]. +---------------------------------------------------------------------- +local function loop_transformer (ast) + local label = nil + local cfg = { + stat = { cut = loop_tags; pred = "Continue" } ; + expr = { cut = "Function" } } + + -------------------------------------------------------------- + -- This function will be called on every "Continue" in the loop + -- body which isn't into a Forin/Fornum/While/Repeat/Function: + -------------------------------------------------------------- + function cfg.stat.map_down (x) + if not label then label = mlp.gensym() end + x <- `Goto{ label } + end + + -------------------------------------------------------------- + -- walk [cfg.stat.map_down()] through the loop's body: + -------------------------------------------------------------- + local body = ast.tag=="Repeat" and ast[1] or ast[#ast] + walk.block (cfg) (body) + if label then table.insert (body, `Label{ label }) end + return ast +end + +---------------------------------------------------------------------- +-- Register the transformer for each kind of loop: +---------------------------------------------------------------------- +for keyword in values (loop_keywords) do + mlp.stat:get(keyword).transformers:add (loop_transformer) +end + +mlp.lexer:add "continue" +mlp.stat:add{ "continue", builder = ||`Continue } + + diff --git a/src/lib/ext-syntax/dynamatch.lua b/src/lib/ext-syntax/dynamatch.lua new file mode 100644 index 0000000..611ce24 --- /dev/null +++ b/src/lib/ext-syntax/dynamatch.lua @@ -0,0 +1,29 @@ +--x = dynamatch() +--x <| foo | bar -> do toto end +--table.insert(x.cases, |$| match $ with foo|bar -> toto end ) + + +local match_builder = mlp.stat:get "match" + +function dynacase_builder (d, s) + local v = mlp.gensym() + local m = match_builder{ v, false, { s[1], s[2], s[3] } } + local c = `Function{ {v}, {m} } + return `Call{ `Index{ d, "extend" }, c } +end + +--fixme: limiter la precedence du expr de droite +mlp.expr.suffix:add{ + name = "dynamatch extension", prec=30, + "<|", + gg.list{ name = "patterns", + primary = mlp.expr, + separators = "|", + terminators = { "->", "if" } }, + gg.onkeyword{ "if", mlp.expr }, + "->", + gg.multisequence{ + { "do", mlp.block, "end", builder = |x| x[1] }, + default = { mlp.expr, builder = |x| { `Return{ x[1] } } } }, + builder = |x| dyna_builder (x[1], x[3]) } + diff --git a/src/lib/ext-syntax/exceptions.lua b/src/lib/ext-syntax/exceptions.lua new file mode 100644 index 0000000..b451ffe --- /dev/null +++ b/src/lib/ext-syntax/exceptions.lua @@ -0,0 +1,39 @@ +require "std" + +function try_with_builder(x) + local block, handlers = x[1], x[3] + local result, exn, endmark = + mlp.gensym "_result", mlp.gensym "_exn", mlp.gensym "_endmark" + local function parse_exn_handler (x) + local exn_test, block = x[1], x[2] + return { +{ -{exn_test} <= -{exn} }, block } + end + local catchers = table.flatten (table.map(parse_exn_handler, handlers)) + catchers.tag = "If" + table.insert (catchers, { `Call{ `Id "error", exn } } ) + table.insert (block, `Return{ endmark }) + return +{ block: + local -{endmark} = { } + local -{result} = { pcall (function() -{block} end) } + if -{result}[1] then -- no exception raised + if -{result}[2] ~= -{endmark} then -- user-caused return: propagate it + table.remove( -{result}, 1) + return unpack( -{result}) + end + else -- an error/exception occured + local -{exn} = -{result}[2] + -{catchers} + end } +end + +mlp.block.terminators:add{ "|", "with" } +mlp.lexer:add{ "try", "with", "->" } +mlp.stat:add{ name="try block", + "try", mlp.block, "with", + gg.optkeyword "|", + gg.list{ name="exception catchers list", + gg.sequence{ name="exception catching case", + mlp.expr, "->", mlp.block }, + separators = "|", terminators = "end" }, + "end", + builder = try_with_builder } \ No newline at end of file diff --git a/src/lib/ext-syntax/flist.lua b/src/lib/ext-syntax/flist.lua new file mode 100644 index 0000000..6dbaf0b --- /dev/null +++ b/src/lib/ext-syntax/flist.lua @@ -0,0 +1,15 @@ +-{ extension "match" } +-{ extension "ternary" } + + +local flist_builder = |x| x[2] ? + +{ flist.of_table(-{x[1]}) `flist.concat` -{x[2]} }, + +{ flist.of_table(-{x[1]}) } + + +mlp.lexer:add{"<|","|>"} +mlp.expr:add{ name="flist", "<|", + gg.list{ mlp.expr, separators=",", terminators={":","|"}, builder = "Table" }, + gg.onkeyword{"|", mlp.expr }, "|>", builder = flist_builder } + + diff --git a/src/lib/ext-syntax/lazy.lua b/src/lib/ext-syntax/lazy.lua new file mode 100644 index 0000000..caecc77 --- /dev/null +++ b/src/lib/ext-syntax/lazy.lua @@ -0,0 +1,108 @@ +-- Lazy evaluation extension for Lua. +-- The distinctive mark of lazy constructions is the "%" sign. These +-- constructions are: +-- +-- * lazy values: an expression preceded by "%". It creates a thunk, +-- i.e. an unevaluated lazy expression. +-- +-- * thunk forcing: %! thunk will force the evaluation of the thunk, +-- and return that value. the evaluation's result is cached, so +-- that it won't be computed twice if the thunk is forceed twice. +-- It is legal to force a non-thunk: it simply returns the value +-- directly. +-- +-- * lazy table: %{ ... } is a special case: all values in the table +-- are created as thunks, and a proxy is returned, which forces them +-- on demand, so that users aren't even aware that the table is lazy. +-- +-- * lazy function: it supposes that all parameters are potentially +-- lazy, and therefore add %! thunk=forcing operators around all +-- of their usages in the function's body. Such a function is created +-- by replacing the parameters' opening parenthese with a "%(". +-- +-- * lazy call: all parameters are automatically put into thunks. +-- The caleld function must therefore be lazy, or it won't know how +-- to force the thunks. It only has an interest if some of the args +-- are expansive-to-compute expressions. + +---------------------------------------------------------------------- +-- Take an AST, return the AST of the thunk which forces to that AST. +---------------------------------------------------------------------- +local mk_thunk = |x| +{lazy.thunk(||-{x})} + +---------------------------------------------------------------------- +-- Build a table where all values are put in thunks, and return a +-- proxy which forces them transparently on demand. +---------------------------------------------------------------------- +local function lazy_table_builder(x) + local c = x[1] + local d = `Table + for i = 1, #c do + if c[i].tag=="Key" + then d[i] = `Key{ c[i][1], mk_thunk (c[i][2]) } + else d[i] = mk_thunk (c[i]) end + end + return +{ lazy.table(-{d})} +end + +-- Mon probleme: les parametres doivent pouvoir etre remplaces par des +-- thunks -> il faut qu'ils soient forces a chaque usage en interne. +-- Sauf s'ils sont utilises dans un appel paresseux. + +-- Et dans les index? +--[[--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--| +local function lazy_func_val_builder (func) + func.tag = "Function" + local params, body = unpack (func) + local function lazify (id) + + id <- +{ lazy. (|| -{} ) + + for v in values (params) do + walk.block (walk.alpha_id (lazify, v)) (body) + end +end +--]]--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--| + +---------------------------------------------------------------------- +-- Keywords declaration, simple operators and lazy tables: +---------------------------------------------------------------------- +mlp.lexer:add{ "%", "%(", "%{", "%!" } +mlp.expr.prefix:add{ "%", prec=30, builder= |_,x| mk_thunk(x) } +mlp.expr.prefix:add{ "%!", prec=30, builder= |_,x| +{lazy.force(-{x})} } +mlp.expr.primary:add{ "%{", mlp.table_content, "}", builder=lazy_table_builder } + +--[[--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--| + +---------------------------------------------------------------------- +-- Add lazy call rules to method invocations. This involves getting +-- the method argument parser from [mlp], which is a multisequence, +-- and adding new sequences to it. +---------------------------------------------------------------------- +local method_args_parser = mlp.expr.suffix:get(":")[3] + +method_args_parser:add{ + "%(", gg.list{ mlp.expr, separators=",", terminators=")" }, ")", + builder = |x| table.imap (mk_thunk, x[1]) } + +method_args_parser:add{ + "%{", mlp.table_content, "}", builder=|x| { lazy_table_builder(x) } } + +---------------------------------------------------------------------- +-- Lazy function call +---------------------------------------------------------------------- +mlp.expr.suffix:add{ + "%(", gg.list{ mlp.expr, separators=",", terminators=")" }, ")", + builder = |f, suffix| `Call{ f, unpack(table.imap(mk_thunk, suffix[1]))}} + + +---------------------------------------------------------------------- +-- Lazy function definition +---------------------------------------------------------------------- +local func_params_content = mlp.func_val[2] +func_val = gg.multisequence { + { "(", func_params_content, ")", mlp.block, "end", builder = "Function" }, + { "%(", func_params_content, ")", mlp.block, "end", + builder = lazy_func_val_builder } } + +--]]--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--| \ No newline at end of file diff --git a/src/lib/ext-syntax/localin.lua b/src/lib/ext-syntax/localin.lua new file mode 100644 index 0000000..fb336e6 --- /dev/null +++ b/src/lib/ext-syntax/localin.lua @@ -0,0 +1,2 @@ +mlp.expr:add{ "local", mlp.id, "=", mlp.expr, "in", mlp.expr, + builder=|x| `Stat{ { `Local{ { x[1] }, { x[2] } } }, x[3] } } \ No newline at end of file diff --git a/src/lib/ext-syntax/match.lua b/src/lib/ext-syntax/match.lua new file mode 100755 index 0000000..fa1351b --- /dev/null +++ b/src/lib/ext-syntax/match.lua @@ -0,0 +1,301 @@ +---------------------------------------------------------------------- +-- Metalua samples: $Id$ +-- +-- Summary: Structural pattern matching for metalua ADT. +-- +---------------------------------------------------------------------- +-- +-- Copyright (c) 2006, Fabien Fleutot . +-- +-- This software is released under the MIT Licence, see licence.txt +-- for details. +-- +-------------------------------------------------------------------------------- +-- +-- This extension, borrowed from ML dialects, allows in a single operation to +-- analyze the structure of nested ADT, and bind local variables to subtrees +-- of the analyzed ADT before executing a block of statements chosen depending +-- on the tested term's structure. +-- +-- The general form of a pattern matching statement is: +-- +-- match with +-- | | | -> +-- | -> +-- | | if -> +-- end +-- +-- If one of the patterns accurately describes the +-- structure of , then is executed (and no +-- other block of the match statement is tested). If none of +-- patterns mathc , but does, +-- then is evaluated before exiting. If no pattern matches, +-- the whole statemetn does nothing. If more than one pattern +-- matches, the first one wins. +-- +-- When an additional condition, introduced by [if], is put after +-- the patterns, this condition is evaluated if one of the patterns matches, +-- and the case is considered successful only if the condition returns neither +-- [nil] nor [false]. +-- +-- Terminology +-- =========== +-- +-- The whole compound statement is called a match; Each schema is +-- called a pattern; Each sequence (list of patterns, optional guard, +-- statements block) is called a case. +-- +-- Patterns +-- ======== +-- Patterns can consist of: +-- +-- - numbers, booleans, strings: they only match terms equal to them +-- +-- - variables: they match everything, and bind it, i.e. the variable +-- will be set to the corresponding tested value when the block will +-- be executed (if the whole pattern and the guard match). If a +-- variable appears more than once in a single pattern, all captured +-- values have to be equal, in the sense of the "==" operator. +-- +-- - tables: a table matches if all these conditions are met: +-- * the tested term is a table; +-- * all of the pattern's keys are strings or integer or implicit indexes; +-- * all of the pattern's values are valid patterns, except maybe the +-- last value with implicit integer key, which can also be [...]; +-- * every value in the tested term is matched by the corresponding +-- sub-pattern; +-- * There are as many integer-indexed values in the tested term as in +-- the pattern, or there is a [...] at the end of the table pattern. +-- +-- Pattern examples +-- ================ +-- +-- Pattern { 1, a } matches term { 1, 2 }, and binds [a] to [2]. +-- It doesn't match term { 1, 2, 3 } (wrong number of parameters). +-- +-- Pattern { 1, a, ... } matches term { 1, 2 } as well as { 1, 2, 3 } +-- (the trailing [...] suppresses the same-length condition) +-- +-- `Foo{ a, { bar = 2, b } } matches `Foo{ 1, { bar = 2, "THREE" } }, +-- and binds [a] to [1], [b] to ["THREE"] (the syntax sugar for [tag] fields +-- is available in patterns as well as in regular terms). +-- +-- Implementation hints +-- ==================== +-- +-- Since the control flow quickly becomes hairy, it's implemented with +-- gotos and labels. [on_success] holds the label name where the +-- control flow must go when the currently parsed pattern +-- matches. [on_failure] is the next position to reach if the current +-- pattern mismatches: either the next pattern in a multiple-patterns +-- case, or the next case when parsing the last pattern of a case, or +-- the end of the match code for the last pattern of the last case. +-- +-- [case_vars] is the list of variables created for the current +-- case. It's kept to generate the local variables declaration. +-- [pattern_vars] is also kept, to detect non-linear variables +-- (variables which appear more than once in a given pattern, and +-- therefore require an == test). +-- +-------------------------------------------------------------------------------- +-- +-- TODO: +-- +-- [CHECK WHETHER IT'S STILL TRUE AFTER TESTS INVERSION] +-- - Optimize jumps: the bytecode generated often contains several +-- [OP_JMP 1] in a row, which is quite silly. That might be due to the +-- implementation of [goto], but something can also probably be done +-- in pattern matching implementation. +-- +---------------------------------------------------------------------- + +---------------------------------------------------------------------- +-- Convert a tested term and a list of (pattern, statement) pairs +-- into a pattern-matching AST. +---------------------------------------------------------------------- +local function match_builder (tested_terms_list, cases) + + local local_vars = { } + local var = |n| `Id{ "$v" .. n } + local on_failure -- current target upon pattern mismatch + + local literal_tags = { String=1, Number=1, Boolean=1 } + + local current_code -- list where instructions are accumulated + local pattern_vars -- list where local vars are accumulated + local case_vars -- list where local vars are accumulated + + ------------------------------------------------------------------- + -- Accumulate statements in [current_code] + ------------------------------------------------------------------- + local function acc (x) + --printf ("%s", disp.ast (x)) + table.insert (current_code, x) end + local function acc_test (it) -- the test must fail for match to succeeed. + acc +{stat: if -{it} then -{`Goto{ on_failure }} end } end + local function acc_assign (lhs, rhs) + local_vars[lhs[1]] = true + acc (`Let{ {lhs}, {rhs} }) end + + ------------------------------------------------------------------- + -- Set of variables bound in the current pattern, to find + -- non-linear patterns. + ------------------------------------------------------------------- + local function handle_id (id, val) + assert (id.tag=="Id") + if id[1] == "_" then + -- "_" is used as a dummy var ==> no assignment, no == checking + case_vars["_"] = true + elseif pattern_vars[id[1]] then + -- This var is already bound ==> test for equality + acc_test +{ -{val} ~= -{id} } + else + -- Free var ==> bind it, and remember it for latter linearity checking + acc_assign (id, val) + pattern_vars[id[1]] = true + case_vars[id[1]] = true + end + end + + ------------------------------------------------------------------- + -- Turn a pattern into a list of tests and assignments stored into + -- [current_code]. [n] is the depth of the subpattern into the + -- toplevel pattern; [pattern] is the AST of a pattern, or a + -- subtree of that pattern when [n>0]. + ------------------------------------------------------------------- + local function pattern_builder (n, pattern) + local v = var(n) + if literal_tags[pattern.tag] then acc_test +{ -{v} ~= -{pattern} } + elseif "Id" == pattern.tag then handle_id (pattern, v) + elseif "Op" == pattern.tag and "div" == pattern[1] then + local n2 = n>0 and n+1 or 1 + local regexp = pattern[3] + assert (regexp.tag=="String", + "right hand side operand for '/' in a pattern must be ".. + "a literal string representing a regular expression") + local m = +{ { string.strmatch( -{var(n2)}, -{regexp} ) } } + acc +{stat: local -{var(n2)} = -{m} } + acc_test +{ next (-{var(n2)}) } + pattern_builder (n2, pattern[2]) + elseif "Table" == pattern.tag then + local seen_dots, len = false, 0 + acc_test +{ type( -{v} ) ~= "table" } + for i = 1, #pattern do + local key, sub_pattern + if pattern[i].tag=="Key" then -- Explicit key + key, sub_pattern = unpack (pattern[i]) + assert (literal_tags[key.tag], "Invalid key") + else -- Implicit key + len, key, sub_pattern = len+1, `Number{ len+1 }, pattern[i] + end + assert (not seen_dots, "Wrongly placed `...' ") + if sub_pattern.tag == "Id" then + -- Optimization: save a useless [ v(n+1)=v(n).key ] + handle_id (sub_pattern, `Index{ v, key }) + if sub_pattern[1] ~= "_" then + acc_test +{ -{sub_pattern} == nil } + end + elseif sub_pattern.tag == "Dots" then + -- Remember to suppress arity checking + seen_dots = true + else + -- Business as usual: + local n2 = n>0 and n+1 or 1 + acc_assign (var(n2), `Index{ v, key }) + pattern_builder (n2, sub_pattern) + end + end + if not seen_dots then -- Check arity + acc_test +{ #-{v} ~= -{`Number{len}} } + end + else + error ("Invalid pattern: "..table.tostring(pattern, "nohash")) + end + end + + local end_of_match = mlp.gensym "_end_of_match" + local arity = #tested_terms_list + local x = `Local{ { }, { } } + for i=1,arity do + x[1][i]=var(-i) + x[2][i]= tested_terms_list[i] + end + local complete_code = `Do{ x } + + -- Foreach [{patterns, guard, block}]: + for i = 1, #cases do + local patterns, guard, block = unpack (cases[i]) + + -- Reset accumulators + local local_decl_stat = { } + current_code = `Do{ `Local { local_decl_stat, { } } } -- reset code accumulator + case_vars = { } + table.insert (complete_code, current_code) + + local on_success = mlp.gensym "_on_success" -- 1 success target per case + + ----------------------------------------------------------- + -- Foreach [pattern] in [patterns]: + -- on failure go to next pattern if any, + -- next case if no more pattern in current case. + -- on success (i.e. no [goto on_failure]), go to after last pattern test + -- if there is a guard, test it before the block: it's common to all patterns, + ----------------------------------------------------------- + for j = 1, #patterns do + if #patterns[j] ~= arity then + error( "Invalid match: pattern has only ".. + #patterns[j].." elements, ".. + arity.." were expected") + end + pattern_vars = { } + on_failure = mlp.gensym "_on_failure" -- 1 failure target per pattern + + for k = 1, arity do pattern_builder (-k, patterns[j][k]) end + if j<#patterns then + acc (`Goto{on_success}) + acc (`Label{on_failure}) + end + end + acc (`Label{on_success}) + if guard then acc_test (`Op{ "not", guard}) end + acc (block) + acc (`Goto{end_of_match}) + acc (`Label{on_failure}) + + -- fill local variables declaration: + local v1 = var(1)[1] + for k, _ in pairs(case_vars) do + if k[1] ~= v1 then table.insert (local_decl_stat, `Id{k}) end + end + + end + acc +{error "mismatch"} -- cause a mismatch error after last case failed + table.insert(complete_code, `Label{ end_of_match }) + return complete_code +end + +---------------------------------------------------------------------- +-- Sugar: add the syntactic extension that makes pattern matching +-- pleasant to read and write. +---------------------------------------------------------------------- + +mlp.lexer:add{ "match", "with", "->" } +mlp.block.terminators:add "|" + +mlp.stat:add{ name = "match statement", + "match", mlp.expr_list, "with", + gg.optkeyword "|", + gg.list{ name = "match cases list", + primary = gg.sequence{ name = "match case", + gg.list{ name = "patterns", + primary = mlp.expr_list, + separators = "|", + terminators = { "->", "if" } }, + gg.onkeyword{ "if", mlp.expr, consume = true }, + "->", + mlp.block }, + separators = "|", + terminators = "end" }, + "end", + builder = |x| match_builder (x[1], x[3]) } + diff --git a/src/lib/ext-syntax/onwith.lua b/src/lib/ext-syntax/onwith.lua new file mode 100644 index 0000000..8b3ebe2 --- /dev/null +++ b/src/lib/ext-syntax/onwith.lua @@ -0,0 +1,20 @@ +-- > on , , ... with +-- is translated to: +-- > (, , , ... ) +-- +-- That's useful for stuff of the "foreach" family, where some +-- function is passed as a first argument, but is meant to represent +-- some sort of loop body. Typically, the following: +-- +-- > [table.imap ((|x,y|x+y), t1, t2)] +-- is translated to: +-- > table.imap on t1, t2 with function (x, y) +-- > return x+y +-- > end +-- or even: +-- > table.imap on t1, t2 with |x,y| x+y + + +mlp.lexer:add{ "on", "with" } +mlp.expr.suffix:add{ "on", mlp.expr_list, "with", mlp.expr, + builder = |x, y| `Call{x, y[2], unpack(y[1])} } \ No newline at end of file diff --git a/src/lib/ext-syntax/ternary.lua b/src/lib/ext-syntax/ternary.lua new file mode 100644 index 0000000..9b0043f --- /dev/null +++ b/src/lib/ext-syntax/ternary.lua @@ -0,0 +1,10 @@ +local function b(x, suffix) + local v, ontrue, onfalse = mlp.gensym "test", unpack (suffix) + return `Stat{ + +{ block: + local -{v} + if -{x} then (-{v}) = -{ontrue} else (-{v}) = -{onfalse or `Nil} end }, + v } +end + +mlp.expr.suffix:add{ "?", mlp.expr, gg.onkeyword{ ",", mlp.expr }, prec=5, builder=b } diff --git a/src/lib/ext-syntax/types.lua b/src/lib/ext-syntax/types.lua new file mode 100644 index 0000000..b6cec60 --- /dev/null +++ b/src/lib/ext-syntax/types.lua @@ -0,0 +1,382 @@ +-- This extension inserts type-checking code at approriate place in the code, +-- thanks to annotations based on "::" keyword: +-- +-- * function declarations can be annotated with a returned type. When they +-- are, type-checking code is inserted in each of their return statements, +-- to make sure they return the expected type. +-- +-- * function parameters can also be annotated. If they are, type-checking +-- code is inserted in the function body, which checks the arguments' types +-- and cause an explicit error upon incorrect calls. Moreover, if a new value +-- is assigned to the parameter in the function's body, the new value's type +-- is checked before the assignment is performed. +-- +-- * Local variables can also be annotated. If they are, type-checking +-- code is inserted before any value assignment or re-assignment is +-- performed on them. +-- +-- Type checking can be disabled with: +-- +-- -{stat: types.enabled = false } +-- +-- Code transformation is performed at the chunk level, i.e. file by +-- file. Therefore, it the value of compile-time variable +-- [types.enabled] changes in the file, the only value that counts is +-- its value once the file is entirely parsed. +-- +-- Syntax +-- ====== +-- +-- Syntax annotations consist of "::" followed by a type +-- specifier. They can appear after a function parameter name, after +-- the closing parameter parenthese of a function, or after a local +-- variable name in the declaration. See example in samples. +-- +-- Type specifiers are expressions, in which identifiers are taken +-- from table types. For instance, [number] is transformed into +-- [types.number]. These [types.xxx] fields must contain functions, +-- which generate an error when they receive an argument which doesn't +-- belong to the type they represent. It is perfectly acceptible for a +-- type-checking function to return another type-checking function, +-- thus defining parametric/generic types. Parameters can be +-- identifiers (they're then considered as indexes in table [types]) +-- or literals. +-- +-- Design hints +-- ============ +-- +-- This extension uses the code walking library [walk] to globally +-- transform the chunk AST. See [chunk_transformer()] for details +-- about the walker. +-- +-- During parsing, type informations are stored in string-indexed +-- fields, in the AST nodes of tags `Local and `Function. They are +-- used by the walker to generate code only if [types.enabled] is +-- true. +-- +-- TODO +-- ==== +-- +-- It's easy to add global vars type-checking, by declaring :: as an +-- assignment operator. It's easy to add arbitrary expr +-- type-checking, by declaring :: as an infix operator. How to make +-- both cohabit? + +-------------------------------------------------------------------------------- +-- +-- Function chunk_transformer() +-- +-------------------------------------------------------------------------------- +-- +-- Takes a block annotated with extra fields, describing typing +-- constraints, and returns a normal AST where these constraints have +-- been turned into type-checking instructions. +-- +-- It relies on the following annotations: +-- +-- * [`Local{ }] statements may have a [types] field, which contains a +-- id name ==> type name map. +-- +-- * [Function{ }] expressions may have an [param_types] field, also a +-- id name ==> type name map. They may also have a [ret_type] field +-- containing the type of the returned value. +-- +-- Design hints: +-- ============= +-- +-- It relies on the code walking library, and two states: +-- +-- * [return_types] is a stack of the expected return values types for +-- the functions currently in scope, the most deeply nested one +-- having the biggest index. +-- +-- * [scopes] is a stack of id name ==> type name scopes, one per +-- currently acive variables scope. +-- +-- What's performed by the walker: +-- +-- * Assignments to a typed variable involve a type checking of the +-- new value; +-- +-- * Local declarations are checked for additional type declarations. +-- +-- * Blocks create and destroy variable scopes in [scopes] +-- +-- * Functions create an additional scope (around its body block's scope) +-- which retains its argument type associations, and stacks another +-- return type (or [false] if no type constraint is given) +-- +-- * Return statements get the additional type checking statement if +-- applicable. +-- +-------------------------------------------------------------------------------- + +require "walk" + +module("types", package.seeall) + +enabled = true + +local function chunk_transformer (block) + if not enabled then return end + local return_types, scopes = { }, { } + local cfg = { + block = { }; + stat = { pred = { "Local"; "Let"; "Return" }; down = { } }; + expr = { pred = "Function"; up = { }; down = { } } } + + ------------------------------------------------------------- + -- Declaration of a new local variable in the current block: + -- gather type constraints in local current scope. + ------------------------------------------------------------- + function cfg.stat.down.Local (s) + if s.types then + + -- Add new types in current scope + local myscope = scopes[#scopes] + for var, type in pairs (s.types) do + myscope[var] = process_type (type) + end + + -- Type-check the rhs values + local lhs, rhs = unpack(s) + for i=1, max(#lhs, #rhs) do + local type = myscope[lhs[i][1]] + if type and rhs[i] then + rhs[i] = checktype_builder (type, rhs[i], 'expr') + end + end + end + end + + ------------------------------------------------------------- + -- Variable assignment: add type checking to the right-hand + -- side value, before assigning it to the left-hand side, + -- if it is typed. + ------------------------------------------------------------- + function cfg.stat.down.Let (s) + local lhs, rhs = unpack (s) + for i=1, #lhs do -- foreach lhs variable: + + -- Retrieve the variable type, if any: + local type + for j=#scopes, 1, -1 do + type = scopes[j][lhs[i][1]] + if type then break end + end + + -- Type constraint found, apply it: + if type then + rhs[i] = checktype_builder(type, rhs[i] or `Nil, 'expr') + end + end + end + + ------------------------------------------------------------- + -- Return statements: if there is a returned type constraint, + -- enforce it. + ------------------------------------------------------------- + function cfg.stat.down.Return (s) + local rtype = return_types[#return_types] + if rtype then s[1] = checktype_builder (rtype, s[1], 'expr') end + end + + ------------------------------------------------------------------- + -- On expressions: the only expressions watched are functions. + -- function parameters are to be treated like + -- local variables. Also, if a return type constraint is given, + -- register it. + ------------------------------------------------------------------- + function cfg.expr.down.Function (e) + local myscope = { } + table.insert (scopes, myscope) + if e.param_types then + for var, type in pairs (e.param_types) do + myscope[var] = process_type (type) + end + end + local r = e.ret_type and process_type (e.ret_type) or false + table.insert (return_types, r) + end + + ------------------------------------------------------------------- + -- Unregister the returned type and the variable scope in which + -- arguments are registered; + -- then, adds the parameters type checking instructions at the + -- beginning of the function, if applicable. + ------------------------------------------------------------------- + function cfg.expr.up.Function (e) + -- Unregister stuff going out of scope: + table.remove (return_types) + table.remove (scopes) + -- Add initial type checking: + if e.param_types then + for v, t in pairs(e.param_types) do + table.insert(e[2], 1, checktype_builder(t, `Id{v}, 'stat')) + end + end + end + + ------------------------------------------------------------------- + -- Create/delete scopes as we enter/leave blocks. + ------------------------------------------------------------------- + function cfg.block.down (_) table.insert (scopes, { }) end + function cfg.block.up (_) table.remove (scopes) end + walk.block(cfg)(block) +end + +-------------------------------------------------------------------------- +-- Translate operators into their metatable entry: +-- used by [process_type] to translate operation expressions into +-- calls to the corresponding [types] entry. +-------------------------------------------------------------------------- +ast2mt = { + Mul="__mul"; Add="__add"; Sub="__sub"; Div="__div"; + Mod="__mod"; Pow="__pow"; Len="__len"; Not="__not" } + +-------------------------------------------------------------------------- +-- Perform required transformations to change a raw type expression into +-- a callable function: +-- +-- * identifiers are changed into indexes in [types], unless they're +-- allready indexed, or into parentheses; +-- +-- * literal tables are embedded into a call to types.__table +-- +-- This transformation is not performed when type checking is disabled: +-- types are stored under their raw form in the AST; the transformation is +-- only performed when they're put in the stacks (scopes and return_types) +-- of the main walker. +-------------------------------------------------------------------------- +function process_type (type) + -- Transform the type: + cfg = { + expr = { + pred = { "Id", "Table", "String", "Op" }; + cut = { "Index", "One" }; + up = { } } } + function cfg.expr.up.Id (x) + x <- `Index{ `Id "types", `String{ x[1] } } + end + function cfg.expr.up.Table (x) + local xcopy = table.shallow_copy(x) + x <- `Call{ `Index{ `Id "types", `String "__table" }, xcopy } + end + function cfg.expr.up.String (x) + local xcopy = table.shallow_copy(x) + x <- `Call{ `Index{ `Id "types", `String "__string" }, xcopy } + end + function cfg.expr.up.Op (x) + local f = "__"..x[1] + if not f then error ("Invalid operator __"..x[1]) end + x <- `Call{ `Index{ `Id "types", `String{ f } }, x[2], x[3] } + end + walk.expr(cfg)(type) + return type +end + +-------------------------------------------------------------------------- +-- Insert a type-checking function call on [term] before returning +-- [term]'s value. Only legal in an expression context. +-------------------------------------------------------------------------- +function checktype_builder(type, term, kind) + + -- Shove type-checking code into the term to check: + local v = mlp.gensym() + local non_const_tags = { Dots=1, Op=1, Index=1, Call=1, Method=1, Table=1 } + if kind=="expr" and non_const_tags[term.tag] then + return `Stat{ { `Local{ {v}, {term} }; `Call{ type, v } }, v } + elseif kind=="expr" then + return `Stat{ { `Call{ type, term } }, term } + elseif kind=="stat" then + return `Call{ type, term } + else + error "checktype_builder must take type 'expr' or 'stat'" + end +end + +-------------------------------------------------------------------------- +-- Parse the typechecking tests in a function definition, and adds the +-- corresponding tests at the beginning of the function's body. +-------------------------------------------------------------------------- +local function func_val_builder (x) + local typed_params, ret_type, body = unpack(x) + local e = `Function{ { }, body; param_types = { }; ret_type = ret_type } + + -- Build [untyped_params] list, and [e.param_types] dictionary. + for i, y in ipairs (typed_params) do + if y.tag=="Dots" then + assert(i==#typed_params, "`...' must be the last parameter") + break + end + local param, type = unpack(y) + e[1][i] = param + if type then e.param_types[param[1]] = type end + end + return e +end + +-------------------------------------------------------------------------- +-- Parse ":: type" annotation if next token is "::", or return false. +-- Called by function parameters parser +-------------------------------------------------------------------------- +local opt_type = gg.onkeyword{ "::", mlp.expr } + +-------------------------------------------------------------------------- +-- Updated function definition parser, which accepts typed vars as +-- parameters. +-------------------------------------------------------------------------- + +-- Parameters parsing: +local id_or_dots = gg.multisequence{ { "...", builder = "Dots" }, default = mlp.id } + +-- Function parsing: +mlp.func_val = gg.sequence{ + "(", gg.list{ + gg.sequence{ id_or_dots, opt_type }, terminators = ")", separators = "," }, + ")", opt_type, mlp.block, "end", + builder = func_val_builder } + +mlp.lexer:add { "::", "newtype" } +mlp.chunk.transformers:add (chunk_transformer) + +-- Local declarations parsing: +local local_decl_parser = mlp.stat:get "local" [2].default + +local_decl_parser[1].primary = gg.sequence{ mlp.id, opt_type } + +function local_decl_parser.builder(x) + local lhs, rhs = unpack(x) + local s, stypes = `Local{ { }, rhs or { } }, { } + for i = 1, #lhs do + local id, type = unpack(lhs[i]) + s[1][i] = id + if type then stypes[id[1]]=type end + end + if next(stypes) then s.types = stypes end + return s +end + +function newtype_builder(x) + local lhs, rhs = unpack(x) + match lhs with + | `Id{ x } -> t = process_type (rhs) + | `Call{ `Id{ x }, ... } -> + t = `Function{ { }, rhs } + for i = 2, #lhs do + if lhs[i].tag ~= "Id" then error "Invalid newtype parameter" end + t[1][i-1] = lhs[i] + end + | _ -> error "Invalid newtype definition" + end + return `Let{ { `Index{ `Id "types", `String{ x } } }, { t } } +end + +mlp.stat:add{ "newtype", mlp.expr, "=", mlp.expr, builder = newtype_builder } + + +-------------------------------------------------------------------------- +-- Register as an operator +-------------------------------------------------------------------------- +--mlp.expr.infix:add{ "::", prec=100, builder = |a, _, b| insert_test(a,b) } + diff --git a/src/lib/springs.lua b/src/lib/springs.lua new file mode 100644 index 0000000..735ef08 --- /dev/null +++ b/src/lib/springs.lua @@ -0,0 +1,38 @@ + +require 'pluto' +require 'rings' + +-- Permanent tables for Pluto's persist() and unpersist() functions. +local rings_p_perms = { } +local rings_u_perms = { } + +-- Serialize, send the request to the child state, deserialize the result +local function call_send (r, ...) + local msg_snd = pluto.persist (rings_p_perms, {...}) + local st, msg_rcv = + r:dostring (string.format ("return rings.call_receive %q", msg_snd)) + if st then return unpack(pluto.unpersist (rings_u_perms, msg_rcv)) + else return st, msg_rcv end +end + +-- Receive a request from the master state, deserialize it, do it, +-- serialize the result. +local function call_receive (rcv_msg) + local args = pluto.unpersist (rings_u_perms, rcv_msg) + local r = { pcall (unpack (args)) } + return pluto.persist (rings_p_perms, r) +end + +-- Monkey-patch rings +debug.getregistry()['state metatable'].__index.call = call_send +rings.call_receive = call_receive + +local original_rings_new = rings.new +function rings.new () + local r = original_rings_new () + r:dostring [[require'springs']] + return r +end + +-- Make the name match the module +springs=rings diff --git a/src/lib/std.lua b/src/lib/std.lua new file mode 100644 index 0000000..ac2b63c --- /dev/null +++ b/src/lib/std.lua @@ -0,0 +1,111 @@ +---------------------------------------------------------------------- +---------------------------------------------------------------------- +-- +-- Base library extension +-- +---------------------------------------------------------------------- +---------------------------------------------------------------------- + +METALUA_VERSION = "v-0.4" +METALUA_EXTLIB_PREFIX = "ext-lib/" +METALUA_EXTSYNTAX_PREFIX = "ext-syntax/" + +function pairs(x) + assert(type(x)=='table', 'pairs() expects a table') + local mt = getmetatable(x) + if mt then + local mtp = mt.__pairs + if mtp then return mtp(x) end + end + return rawpairs(x) +end + +function ipairs(x) + assert(type(x)=='table', 'ipairs() expects a table') + local mt = getmetatable(x) + if mt then + local mti = mt.__ipairs + if mti then return mti(x) end + end + return rawipairs(x) +end + +function type(x) + local mt = getmetatable(x) + if mt then + local mtt = mt.__type + if mtt then return mtt end + end + return rawtype(x) +end + +function min (a, ...) + for n in values{...} do if na then a=n end end + return a +end + +function o (...) + local args = {...} + local function g (...) + local result = {...} + for i=#args, 1, -1 do result = {args[i](unpack(result))} end + return unpack (result) + end + return g +end + +function id (...) return ... end +function const (k) return function () return k end end + +function printf(...) return print(string.format(...)) end + +function ivalues (x) + local i = 1 + local function iterator () + local r = x[i]; i=i+1; return r + end + return iterator +end + + +function values (x) + local function iterator (state) + local it + state.content, it = next(state.list, state.content) + return it + end + return iterator, { list = x } +end + +function keys (x) + local function iterator (state) + local it = next(state.list, state.content) + state.content = it + return it + end + return iterator, { list = x } +end + +-- Loads a couple syntax extension + support library in a single +-- operation. For instance, [-{ extension "exceptions" }] should both +-- * load the exception syntax in the parser at compile time +-- * put the instruction to load the support lib in the compiled file + +function extension (name, noruntime) + local extlib_name = METALUA_EXTLIB_PREFIX .. name + local extsyn_name = METALUA_EXTSYNTAX_PREFIX .. name + require (extsyn_name) + if not noruntime then + return {tag="Call", {tag="Id", "require"}, + {tag="String", extlib_name} } + end +end + +require 'table2' +require 'string2' + diff --git a/src/lib/strict.lua b/src/lib/strict.lua new file mode 100755 index 0000000..8ca18fa --- /dev/null +++ b/src/lib/strict.lua @@ -0,0 +1,38 @@ +-- +-- strict.lua +-- checks uses of undeclared global variables +-- All global variables must be 'declared' through a regular assignment +-- (even assigning nil will do) in a main chunk before being used +-- anywhere or assigned to inside a function. +-- + +local mt = getmetatable(_G) +if mt == nil then + mt = {} + setmetatable(_G, mt) +end + +__STRICT = true +mt.__declared = {} + +mt.__newindex = function (t, n, v) + if __STRICT and not mt.__declared[n] then + local w = debug.getinfo(2, "S").what + if w ~= "main" and w ~= "C" then + error("assign to undeclared variable '"..n.."'", 2) + end + mt.__declared[n] = true + end + rawset(t, n, v) +end + +mt.__index = function (t, n) + if not mt.__declared[n] and debug.getinfo(2, "S").what ~= "C" then + error("variable '"..n.."' is not declared", 2) + end + return rawget(t, n) +end + +function global(...) + for _, v in ipairs{...} do mt.__declared[v] = true end +end diff --git a/src/lib/string2.lua b/src/lib/string2.lua new file mode 100644 index 0000000..7695e1b --- /dev/null +++ b/src/lib/string2.lua @@ -0,0 +1,33 @@ + +---------------------------------------------------------------------- +---------------------------------------------------------------------- +-- +-- String module extension +-- +---------------------------------------------------------------------- +---------------------------------------------------------------------- + +-- Courtesy of lua-users.org +function string.split(str, pat) + local t = {} + local fpat = "(.-)" .. pat + local last_end = 1 + local s, e, cap = string.find(str, fpat, 1) + while s do + if s ~= 1 or cap ~= "" then + table.insert(t,cap) + end + last_end = e+1 + s, e, cap = string.find(str, fpat, last_end) + end + if last_end <= string.len(str) then + cap = string.sub(str, last_end) + table.insert(t, cap) + end + return t +end + +-- "match" tends to be used as a keyword for pattern matching, +-- so here is an always available substitute. +string.strmatch = string["match"] + diff --git a/src/lib/table2.lua b/src/lib/table2.lua new file mode 100644 index 0000000..ceec5ae --- /dev/null +++ b/src/lib/table2.lua @@ -0,0 +1,361 @@ +---------------------------------------------------------------------- +---------------------------------------------------------------------- +-- +-- Table module extension +-- +---------------------------------------------------------------------- +---------------------------------------------------------------------- + +-- todo: table.scan (scan1?) fold1? flip? + +function table.transpose(t) + local tt = { } + for a, b in pairs(t) do tt[b] = a end + return tt +end + +function table.iforeach(f, ...) + -- assert (type (f) == "function") [wouldn't allow metamethod __call] + local nargs = select("#", ...) + if nargs==1 then -- Quick iforeach (most common case), just one table arg + local t = ... + assert (type (t) == "table") + for i = 1, #t do + local result = f (t[i]) + -- If the function returns non-false, stop iteration + if result then return result end + end + else -- advanced case: boundaries and/or multiple tables + -- 1 - find boundaries if any + local args, fargs, first, last, arg1 = {...}, { } + if type(args[1]) ~= "number" then first, arg1 = 1, 1 + elseif type(args[2]) ~= "number" then first, last, arg1 = 1, args[1], 2 + else first, last, i = args[1], args[2], 3 end + assert (nargs > arg1) + -- 2 - determine upper boundary if not given + if not last then for i = arg1, nargs do + assert (type (args[i]) == "table") + last = max (#args[i], last) + end end + -- 3 - perform the iteration + for i = first, last do + for j = arg1, nargs do fargs[j] = args[j][i] end -- build args list + local result = f (unpack (fargs)) -- here is the call + -- If the function returns non-false, stop iteration + if result then return result end + end + end +end + +function table.imap (f, ...) + local result, idx = { }, 1 + local function g(...) result[idx] = f(...); idx=idx+1 end + table.iforeach(g, ...) + return result +end + +function table.ifold (f, acc, ...) + local function g(...) acc = f (acc,...) end + table.iforeach (g, ...) + return acc +end + +-- function table.ifold1 (f, ...) +-- return table.ifold (f, acc, 2, false, ...) +-- end + +function table.izip(...) + local function g(...) return {...} end + return table.imap(g, ...) +end + +function table.ifilter(f, t) + local yes, no = { }, { } + for i=1,#t do table.insert (f(t) and yes or no, t[i]) end + return yes, no +end + +function table.icat(...) + local result = { } + for t in values {...} do + for x in values (t) do + table.insert (result, x) + end + end + return result +end + +function table.iflatten (x) return table.icat (unpack (x)) end + +function table.irev (t) + local result, nt = { }, #t + for i=0, nt-1 do result[nt-i] = t[i+1] end + return result +end + +function table.isub (t, ...) + local ti, u = table.insert, { } + local args, nargs = {...}, select("#", ...) + for i=1, nargs/2 do + local a, b = args[2*i-1], args[2*i] + for i=a, b, a<=b and 1 or -1 do ti(u, t[i]) end + end + return u +end + +--[[ +function table.iall (f, ...) + local result = true + local function g(...) return not f(...) end + table.iforeach(g, ...) + return result +end + +function table.iany (f, ...) + local function g(...) return not f(...) end + return table.iall(g, ...) +end +]] + +function table.inverse (t) + local i = { } + for a, b in pairs(t) do i[b]=a end + return i +end + +function table.shallow_copy(x) + local y={ } + for k, v in pairs(x) do y[k]=v end + return y +end + +-- Warning, this is implementation dependent: it relies on +-- the fact the [next()] enumerates the array-part before the hash-part. +function table.cat(...) + local y={ } + for x in values{...} do + -- cat array-part + for _, v in ipairs(x) do table.insert(y,v) end + -- cat hash-part + local lx, k = #x + if lx>0 then k=next(x,lx) else k=next(x) end + while k do y[k]=x[k]; k=next(x,k) end + end + return y +end + +function table.deep_copy(x) + local tracker = { } + local function aux (x) + if type(x) == "table" then + local y=tracker[x] + if y then return y end + y = { }; tracker[x] = y + setmetatable (y, getmetatable (x)) + for k,v in pairs(x) do y[aux(k)] = aux(v) end + return y + else return x end + end + return aux(x) +end + +function table.override(dst, src) + for k, v in pairs(src) do dst[k] = v end + for i = #src+1, #dst do dst[i] = nil end + return dst +end + + +function table.range(a,b,c) + if not b then assert(not(c)); b=a; a=1 + elseif not c then c = (b>=a) and 1 or -1 end + local result = { } + for i=a, b, c do table.insert(result, i) end + return result +end + +function table.tostring(t, ...) + local LINE_MAX, PRINT_HASH = math.huge, true + for _, x in ipairs {...} do + if type(x) == "number" then LINE_MAX = x + elseif x=="nohash" then PRINT_HASH = false + end + end + + local current_offset = 0 -- indentation level + local xlen_cache = { } -- cached results for xlen() + local acc_list = { } -- Generated bits of string + local function acc(...) -- Accumulate a bit of string + local x = table.concat{...} + current_offset = current_offset + #x + table.insert(acc_list, x) + end + local function valid_id(x) + -- FIXME: we should also reject keywords. + return type(x) == "string" and x:strmatch "[a-zA-Z_][a-zA-Z0-9_]*" + end + + -- Compute the number of chars it would require to display the table + -- as a single line. Helps to decide whether some carriage returns are + -- required. Since the size of each sub-table is required many times, + -- it's cached in [xlen_cache]. + local xlen_type = { } + local function xlen(x, tracker, nested) + tracker = tracker or { } + nested = nested or { } + if x==nil then return #"nil" end + --if nested[x] then return #tostring(x) end -- already done in table + local len = xlen_cache[x] + if len then return len end + local f = xlen_type[type(x)] + if not f then return #tostring(x) end + len = f (x, tracker, nested) + xlen_cache[x] = len + return len + end + + -- optim: no need to compute lengths if I'm not going to use them + -- anyway. + if LINE_MAX == math.huge then xlen = function() return 0 end end + + xlen_type["nil"] = function() return 3 end + function xlen_type.number(x) return #tostring(x) end + function xlen_type.boolean(x) return x and 4 or 5 end + function xlen_type.string(x) return #string.format("%q",x) end + function xlen_type.table (adt, tracker, nested) + + -- Circular references detection + if nested[adt] then return #tostring(adt) end + tracker = table.shallow_copy(tracker) + tracker [adt] = true + nested[adt] = true + + local has_tag = valid_id(adt.tag) + local alen = #adt + local has_arr = alen>0 + local has_hash = false + local x = 0 + + if PRINT_HASH then + -- first pass: count hash-part + for k, v in pairs(adt) do + if k=="tag" and has_tag then + -- this is the tag -> do nothing! + elseif type(k)=="number" and k<=alen and math.fmod(k,1)==0 then + -- array-part pair -> do nothing! + else + has_hash = true + if valid_id(k) then x=x+#k + else x = x + xlen (k, tracker, nested) + 2 end -- count surrounding barckets + x = x + xlen (v, tracker, nested) + 5 -- count " = " and ", " + end + end + end + + for i = 1, alen do x = x + xlen (adt[i], tracker, nested) + 2 end -- count ", " + + nested[adt] = false -- No more nested calls + + if not (has_tag or has_arr or has_hash) then return 3 end + if has_tag then x=x+#adt.tag+1 end + if not (has_arr or has_hash) then return x end + if not has_hash and alen==1 and type(adt[1])~="table" then + return x-2 -- substract extraneous ", " + end + return x+2 -- count "{ " and " }", substract extraneous ", " + end + + -- Recursively print a (sub) table at given indentation level. + -- [newline] indicates whether newlines should be inserted. + local function rec (adt, indent, tracker, nested) + local function acc_newline() + acc ("\n"); acc (string.rep (" ", indent)) + current_offset = indent + end + local x = { } + x["nil"] = function() acc "nil" end + function x.number() acc (tostring (adt)) end + function x.string() acc (string.format ("%q", adt)) end + function x.boolean() acc (adt and "true" or "false") end + function x.table() + if nested[adt] then acc(tostring(adt)); return end + tracker[adt] = true + nested[adt] = true + + + local has_tag = valid_id(adt.tag) + local alen = #adt + local has_arr = alen>0 + local has_hash = false + local new_indent + if has_tag then acc("`"); acc(adt.tag) end + + -- First pass: handle hash-part + if PRINT_HASH then + for k, v in pairs(adt) do + if k=="tag" and has_tag then -- this is the tag -> do nothing! + elseif type(k)=="number" and k<=alen and math.fmod(k,1)==0 then + -- nothing: this an array-part pair, parsed later + else -- hash-part pair + + -- Is it the first time we parse a hash pair? + if not has_hash then acc "{ "; indent = current_offset + else acc ", " end + + -- Determine whether a newline is required + local is_id, expected_len = valid_id(k) + if is_id then expected_len = #k + xlen (v, tracker, nested) + #" = , " + else expected_len = xlen (k, tracker, nested) + + xlen (v, tracker, nested) + #"[] = , " end + if has_hash and expected_len + current_offset > LINE_MAX + then acc_newline() end + + -- Print the key + if is_id then acc(k); acc " = " + else acc "["; rec (k, current_offset, tracker, nested); acc "] = " end + + -- Print the value + rec (v, current_offset, tracker, nested) + has_hash = true + end + end + end + + -- now we know whether there's a hash-part, an array-part, and a tag. + -- Tag and hash-part are already printed if they're present. + if not has_tag and not has_hash and not has_arr then acc "{ }"; + elseif has_tag and not has_hash and not has_arr then -- nothing, tag already in acc + else -- has_hash or has_arr + local no_brace = false + if has_hash and has_arr then acc ", " + elseif has_tag and not has_hash and alen==1 and type(adt[1])~="table" then + -- No brace required; don't print "{", remember not to print "}" + acc (" "); rec (adt[1], new_indent, tracker, nested) + no_brace = true + elseif not has_hash then + -- Braces required, but not opened by hash-part handler yet + acc "{ "; indent = current_offset + end + + -- 2nd pass: array-part + if not no_brace and has_arr then + rec (adt[1], new_indent, tracker, nested) + for i=2, alen do + acc ", "; + if current_offset + xlen (adt[i], { }) > LINE_MAX + then acc_newline() end + rec (adt[i], new_indent, tracker, nested) + end + end + if not no_brace then acc " }" end + end + nested[adt] = false -- No more nested calls + end + local y = x[type(adt)] + if y then y() else acc(tostring(adt)) end + end + rec(t, 0, { }, { }) + return table.concat (acc_list) +end + +function table.print(...) return print(table.tostring(...)) end diff --git a/src/lib/walk.lua b/src/lib/walk.lua new file mode 100644 index 0000000..6464a23 --- /dev/null +++ b/src/lib/walk.lua @@ -0,0 +1,239 @@ +-------------------------------------------------------------------------------- +-- Code walkers generator +-- "Make everything as simple as possible, but not simpler" (Einstein) +-- +-- This library offers a generic way to write AST transforming +-- functions. Macros can take bits of AST as parameters and generate a +-- more complex AST with them; but modifying an AST a posteriori is +-- much more difficult; typical tasks requiring code walking are +-- transformation such as lazy evaluation or Continuation Passing +-- Style. +-- +-- The API is not extremely easy to handle, but I can't think of a +-- better one. It might change if I get more inspired. +-- +-- We deal here with 3 important kinds of AST: statements, expressions +-- and blocks. Code walkers for these three kinds for AST are +-- generated by [walk.stat (cfg)], [walk.expr (cfg)] and [walk.block +-- (cfg)] respectively: each of these generate a function transforming +-- an AST of the corresponding type. The nature of this transformation +-- is determined by [cfg], or more accurately [cfg.stat], [cfg.expr] +-- and [cfg.block]. +-- +-- [cfg.stat] is a table which migh have any of these fields: +-- +-- * [cfg.stat.down()] is a function taking a statement AST and +-- returning [nil] or ["break"]. It will be applied to some +-- statements in the transformed term, depending on +-- [cfg.stat.pred]. This is applied top-bottom, i.e. from the AST +-- root to its leaves. +-- +-- If it returns ["break"], the walking stops at this level, and no +-- sub-node of this will be visited. +-- +-- [New in 0.3.1] +-- It can also be a table of functions indexed by strings. In this +-- case, the function whose index matches the visited term's tag +-- is selected. +-- +-- * [cfg.stat.up()] is similar, except that it is applied bottom-up, +-- from leaves to the root. On a given node, [down()] is always +-- applied before [up()]. Moreover, if [down()] returns ["break"], +-- [up()] is never called. The value returned by [up()] is irrelevant. +-- +-- * [cfg.stat.pred] is a predicate, i.e. it can contain: +-- + a function taking a statement AST and returning [true] or [false] +-- + or a boolean, which is equivalent to the function [||true] or [||false] +-- + or a string [s], which is equivalent to the function [|ast| ast.tag==s] +-- + or a table of predicates, which is equivalent to a predicate returning +-- [true] whenever on of the sub-predicates returns true. +-- +-- Actions [cfg.stat.down()] and [cfg.stat.up()] are only applied on +-- a statement AST if this predicate returns true, or if there is no +-- [pred] field. +-- +-- * [cfg.stat.cut()] DEPRECATED(?) if present and returning true, this +-- predicate stops traversal between [up()] and [down()]. +-- +-- Notice that this [cfg.stat] fields is meaningful in every walker +-- generator, not only [walk.stat()], as expressions and blocks can +-- contain ASTs. +-- +-- [cfg.expr] and [cfg.block] are similar to [cfg.stat], except that +-- they work on expressions and blocks respectively. Both of them can +-- also appear in all three walker generators. +-- +-------------------------------------------------------------------------------- + +-- FIXME: maintenant qu'up et down peuvent etre des tables, peut-etre que +-- pred ne sert plus a rien ? Ou au moins, s'il n'y a pas de pred, +-- on peut peut-etre l'inferer des tables up/down ? + +-{ extension "match" } + +walk = { traverse = { } } + +-------------------------------------------------------------------------------- +-- These [traverse.xxx()] functions are in charge of actually going through +-- ASTs. At each node, they make sure to call the appropriate walker. +-------------------------------------------------------------------------------- +local traverse = walk.traverse + +-- In `Call{ } and `Method{ } as statements, each strict subexpression +-- is treated as an expression, but the whole AST is *not* treated +-- as en expr. This allows to target calls-as-statements without +-- targetting calls-as-real-expr. +function traverse.stat (cfg, x) + local B = walk.block(cfg) + local S = walk.stat(cfg) + local E = walk.expr(cfg) + local EL = walk.expr_list(cfg) + match x with + | `Do{...} -> B(x) + | {...} if x.tag == nil -> B(x) + | `Let{ lhs, rhs } -> EL(lhs); EL(rhs) + | `While{ cond, body } -> E(cond); B(body) + | `Repeat{ body, cond } -> B(body); E(cond) + | `Local{ _, rhs } | `Localrec{ _, rhs } -> EL(rhs) + | `Call{...} | `Method{...} | `Return{...} -> EL(x) + | `Fornum{ _, a, b, body } + | `Fornum{ _, a, b, c, body } -> E(a); E(b); if #x==5 then E(c) end; B(body) + | `Forin{ _, rhs, body } -> EL(rhs); B(body) + | `If{...} -> for i=1, #x-1, 2 do E(x[i]); B(x[i+1]) end + if #x%2 == 1 then B(x[#x]) end + | `Break | `Goto{ _ } | `Label{ _ } -> -- nothing + | {...} -> print("Warning: unknown stat node `"..x.tag) + | _ -> print("Warning: unexpected stat node of type "..type(x)) + end +end + +function traverse.expr (cfg, x) + local B = walk.block(cfg) + local S = walk.stat(cfg) + local E = walk.expr(cfg) + local EL = walk.expr_list(cfg) + match x with + | `One{ e } -> E(e) + | `Call{...} | `Method{...} -> EL(x) + | `Index{ a, b } -> E(a); E(b) + | `Op{ opid, ... } -> E(x[2]); if #x==3 then E(x[3]) end + | `Function{ params, body } -> B(body) + | `Stat{ b, e } -> B(b); E(e) + | `Table{ ... } -> + for i = 1, #x do match x[i] with + | `Key{ k, v } -> E(k); E(v) + | v -> E(v) + end end + |`Nil|`Dots|`True|`False|`Number{_}|`String{_}|`Id{_} -> -- nothing + | {...} -> printf("Warning: unknown expr node %s", table.tostring(x)) + | _ -> print("Warning: unexpected expr node of type "..type(x)) + end +end + +function traverse.block (cfg, x) + table.iforeach(walk.stat(cfg), x) +end + +function traverse.expr_list (cfg, x) + table.iforeach(walk.expr(cfg), x) +end + +---------------------------------------------------------------------- +-- Generic walker generator +---------------------------------------------------------------------- +local walker_builder = |cfg_field, traverse| |cfg| function (x) + local function pred_builder (pred) + match type(pred) with + | "boolean" -> return (|| pred) + | "nil" -> return nil + | "function" -> return pred + | "string" -> return (|x| x.tag==pred) + | "table" -> + local preds = table.imap (pred_builder, pred) + return function(x) + for p in values(preds) do + if p(x) then return true end + end + return false + end + --return (|x| table.iany((|p| p(x)), preds)) + | _ -> error "Invalid predicate" + end + end + local subcfg = cfg[cfg_field] or { } + local map_pred = pred_builder (subcfg.pred) + local broken = false + local function map(f) + if f and (not map_pred or map_pred(x)) then + if type(f) == "table" then + local maptable = f + f = |x| maptable[x.tag](x) + end + local r=f(x) + if r=="break" then broken=true + else assert(not r, "Map functions must return 'break' or nil") end + end + end + --printf("\n--> walk.%s (cfg) (\n%s)", cfg_field, table.tostring(x,"nohash",60)) + map (subcfg.down) + --printf("\n--- walk.%s (cfg) (\n%s)", cfg_field, table.tostring(x,"nohash",60)) + local cut_pred = pred_builder(subcfg.cut) + if not broken and (not cut_pred or not cut_pred(x)) then + traverse(cfg, x) + end + map (subcfg.up) + --printf("\n<-- walk.%s (cfg) (\n%s)", cfg_field, table.tostring(x,"nohash",60)) +end + +-- Declare [walk.stat], [walk.expr], [walk.block] and [walk.expr_list] +for w in values{ "stat", "expr", "block", "expr_list" } do + walk[w] = walker_builder (w, traverse[w]) +end + +-------------------------------------------------------------------------------- +-- Useful example of a non-trivial usage: this generates a walker +-- which applies [f] on every occurence of an identifier whose name is +-- [id_name], but takes care of variable capture: if a [local] +-- statement or a function parameter with the same name shadows it, +-- [f] is not applied to the homonymous id occurences. +-------------------------------------------------------------------------------- +function walk.alpha_id (f, id_name) + local cfg = { expr = { pred = { "Function", "Id" } }, + block = { cut = true } } + + ----------------------------------------------------------------------------- + -- Apply [f] on id, make sure that function parameters don't capture id. + ----------------------------------------------------------------------------- + function cfg.expr.down(x) + match x with + | `Id{ name } if name==id_name -> f(x) + | `Function{ params, _ } if table.iforeach (|p| p[1]==id_name, params) -> + return "break" + end + end + + ----------------------------------------------------------------------------- + -- Blocks must be traversed in a custom way, in order to stop as soon as + -- a local declaration captures the id. + ----------------------------------------------------------------------------- + function cfg.block.down(b) + assert(b, "Null block in alpha conversion") + for s in values(b) do + if (s.tag=="Local" or s.tag=="Localrec") and + table.iforeach (|p| p[1]==id_name, s[1]) then + -------------------------------------------------------------------- + -- Local declaration captures Id: stop traversing this block. + -- However, for `Local{lhs, rhs} stats, the rhs is out of scope + -- and must be traversed. + -------------------------------------------------------------------- + if s.tag=="Local" then walk.expr_list(cfg)(s[2]) end + return "break" + end + -- No capture occured --> traverse and go on. + walk.stat(cfg)(s) + end + end + + return cfg +end + diff --git a/src/lua-vm/Makefile b/src/lua-vm/Makefile new file mode 100644 index 0000000..fb50dc8 --- /dev/null +++ b/src/lua-vm/Makefile @@ -0,0 +1,205 @@ +# makefile for building Lua +# see ../INSTALL for installation instructions +# see ../Makefile and luaconf.h for further customization + +# == CHANGE THE SETTINGS BELOW TO SUIT YOUR ENVIRONMENT ======================= + +#get LUA_PATH and LUA_CPATH +include ../common.mk + +# Your platform. See PLATS for possible values. +PLAT= none + +CC= gcc +CFLAGS= -g -Wall $(MYCFLAGS) +#CFLAGS= -O2 -Wall $(MYCFLAGS) +AR= ar rcu +RANLIB= ranlib +RM= rm -f +LIBS= -lm $(MYLIBS) + +MYCFLAGS= +MYLDFLAGS= +MYLIBS= + +# == END OF USER SETTINGS. NO NEED TO CHANGE ANYTHING BELOW THIS LINE ========= + +PLATS= aix ansi bsd freebsd generic linux macosx mingw posix solaris + +LUA_A= libmetalua.a +CORE_O= lapi.o lcode.o ldebug.o ldo.o ldump.o lfunc.o lgc.o llex.o lmem.o \ + lobject.o lopcodes.o lparser.o lstate.o lstring.o ltable.o ltm.o \ + lundump.o lvm.o lzio.o +LIB_O= lauxlib.o lbaselib.o ldblib.o liolib.o lmathlib.o loslib.o ltablib.o \ + lstrlib.o loadlib.o linit.o + +LUA_T= $(RUN) +LUA_O= mlr.o + +LUAC_T= $(COMPILE) +LUAC_O= mlc.o print.o + +ALL_O= $(CORE_O) $(LIB_O) $(LUA_O) $(LUAC_O) +ALL_T= $(LUA_A) $(LUA_T) $(LUAC_T) +ALL_A= $(LUA_A) + +#default: $(PLAT) +default: macosx + +path_defaults.h: ../common.mk + echo '/* Generated by the Makefile, dont edit manually */' > $@ + echo '#define LUA_INIT "$(ENV_PREFIX)_INIT"' >> $@ + echo '#define LUA_PATH "$(ENV_PREFIX)_PATH"' >> $@ + echo '#define LUA_CPATH "$(ENV_PREFIX)_CPATH"' >> $@ + echo '#define LUA_PATH_DEFAULT $(LUA_PATH)' >> $@ + echo '#define LUA_CPATH_DEFAULT $(LUA_CPATH)' >> $@ + + +# echo '#undef LUA_PATH_DEFAULT' > $@ +# echo '#undef LUA_CPATH_DEFAULT' >> $@ +# echo '#undef LUA_INIT' >> $@ +# echo '#undef LUA_PATH' >> $@ +# echo '#undef LUA_CPATH' >> $@ + +all: $(ALL_T) + +o: $(ALL_O) + +a: $(ALL_A) + +$(LUA_A): $(CORE_O) $(LIB_O) + $(AR) $@ $? + $(RANLIB) $@ + +$(LUA_T): $(LUA_O) $(LUA_A) + $(CC) -o $@ $(MYLDFLAGS) $(LUA_O) $(LUA_A) $(LIBS) + +$(LUAC_T): $(LUAC_O) $(LUA_A) + $(CC) -o $@ $(MYLDFLAGS) $(LUAC_O) $(LUA_A) $(LIBS) + +clean: + $(RM) $(ALL_T) $(ALL_O) + +depend: + @$(CC) $(CFLAGS) -MM l*.c print.c + +echo: + @echo "PLAT = $(PLAT)" + @echo "CC = $(CC)" + @echo "CFLAGS = $(CFLAGS)" + @echo "AR = $(AR)" + @echo "RANLIB = $(RANLIB)" + @echo "RM = $(RM)" + @echo "MYCFLAGS = $(MYCFLAGS)" + @echo "MYLDFLAGS = $(MYLDFLAGS)" + @echo "MYLIBS = $(MYLIBS)" + +# convenience targets for popular platforms + +none: + @echo "Please choose a platform:" + @echo " $(PLATS)" + +aix: + $(MAKE) all CC="xlc" CFLAGS="-O2 -DLUA_USE_POSIX -DLUA_USE_DLOPEN" MYLIBS="-ldl" MYLDFLAGS="-brtl -bexpall" + +ansi: + $(MAKE) all MYCFLAGS=-DLUA_ANSI + +bsd: + $(MAKE) all MYCFLAGS="-DLUA_USE_POSIX -DLUA_USE_DLOPEN" MYLIBS="-Wl,-E" + +freebsd: + $(MAKE) all MYCFLAGS="-DLUA_USE_LINUX" MYLIBS="-Wl,-E -lreadline" + +generic: + $(MAKE) all MYCFLAGS= + +linux: + $(MAKE) all MYCFLAGS=-DLUA_USE_LINUX MYLIBS="-Wl,-E -ldl -lreadline -lhistory -lncurses" + +macosx: + $(MAKE) all MYCFLAGS="-DLUA_USE_MACOSX -DLUA_USE_READLINE" MYLIBS="-lreadline" + +# use this on Mac OS X 10.[0123] +macosx_noreadline: + $(MAKE) all MYCFLAGS=-DLUA_USE_MACOSX + +mingw: + $(MAKE) "LUA_A=lua51.dll" "LUA_T=lua.exe" \ + "AR=$(CC) -shared -o" "RANLIB=strip --strip-unneeded" \ + "MYCFLAGS=-DLUA_BUILD_AS_DLL" "MYLIBS=" "MYLDFLAGS=-s" lua.exe + $(MAKE) "LUAC_T=luac.exe" luac.exe + +posix: + $(MAKE) all MYCFLAGS=-DLUA_USE_POSIX + +solaris: + $(MAKE) all MYCFLAGS="-DLUA_USE_POSIX -DLUA_USE_DLOPEN" MYLIBS="-ldl" + +# list targets that do not create files (but not all makes understand .PHONY) +.PHONY: all $(PLATS) default o a clean depend echo none + +# DO NOT DELETE + +lapi.o: lapi.c lua.h path_defaults.h luaconf.h lapi.h lobject.h llimits.h ldebug.h \ + lstate.h ltm.h lzio.h lmem.h ldo.h lfunc.h lgc.h lstring.h ltable.h \ + lundump.h lvm.h +lauxlib.o: lauxlib.c lua.h path_defaults.h luaconf.h lauxlib.h +lbaselib.o: lbaselib.c lua.h path_defaults.h luaconf.h lauxlib.h lualib.h +lcode.o: lcode.c lua.h path_defaults.h luaconf.h lcode.h llex.h lobject.h llimits.h \ + lzio.h lmem.h lopcodes.h lparser.h ldebug.h lstate.h ltm.h ldo.h lgc.h \ + ltable.h +ldblib.o: ldblib.c lua.h path_defaults.h luaconf.h lauxlib.h lualib.h +ldebug.o: ldebug.c lua.h path_defaults.h luaconf.h lapi.h lobject.h llimits.h lcode.h \ + llex.h lzio.h lmem.h lopcodes.h lparser.h ldebug.h lstate.h ltm.h ldo.h \ + lfunc.h lstring.h lgc.h ltable.h lvm.h +ldo.o: ldo.c lua.h path_defaults.h luaconf.h ldebug.h lstate.h lobject.h llimits.h ltm.h \ + lzio.h lmem.h ldo.h lfunc.h lgc.h lopcodes.h lparser.h lstring.h \ + ltable.h lundump.h lvm.h +ldump.o: ldump.c lua.h path_defaults.h luaconf.h lobject.h llimits.h lstate.h ltm.h \ + lzio.h lmem.h lundump.h +lfunc.o: lfunc.c lua.h path_defaults.h luaconf.h lfunc.h lobject.h llimits.h lgc.h lmem.h \ + lstate.h ltm.h lzio.h +lgc.o: lgc.c lua.h path_defaults.h luaconf.h ldebug.h lstate.h lobject.h llimits.h ltm.h \ + lzio.h lmem.h ldo.h lfunc.h lgc.h lstring.h ltable.h +linit.o: linit.c lua.h path_defaults.h luaconf.h lualib.h lauxlib.h +liolib.o: liolib.c lua.h path_defaults.h luaconf.h lauxlib.h lualib.h +llex.o: llex.c lua.h path_defaults.h luaconf.h ldo.h lobject.h llimits.h lstate.h ltm.h \ + lzio.h lmem.h llex.h lparser.h lstring.h lgc.h ltable.h +lmathlib.o: lmathlib.c lua.h path_defaults.h luaconf.h lauxlib.h lualib.h +lmem.o: lmem.c lua.h path_defaults.h luaconf.h ldebug.h lstate.h lobject.h llimits.h \ + ltm.h lzio.h lmem.h ldo.h +loadlib.o: loadlib.c lauxlib.h lua.h path_defaults.h luaconf.h lobject.h llimits.h \ + lualib.h +lobject.o: lobject.c lua.h path_defaults.h luaconf.h ldo.h lobject.h llimits.h lstate.h \ + ltm.h lzio.h lmem.h lstring.h lgc.h lvm.h +lopcodes.o: lopcodes.c lopcodes.h llimits.h lua.h path_defaults.h luaconf.h +loslib.o: loslib.c lua.h path_defaults.h luaconf.h lauxlib.h lualib.h +lparser.o: lparser.c lua.h path_defaults.h luaconf.h lcode.h llex.h lobject.h llimits.h \ + lzio.h lmem.h lopcodes.h lparser.h ldebug.h lstate.h ltm.h ldo.h \ + lfunc.h lstring.h lgc.h ltable.h +lstate.o: lstate.c lua.h path_defaults.h luaconf.h ldebug.h lstate.h lobject.h llimits.h \ + ltm.h lzio.h lmem.h ldo.h lfunc.h lgc.h llex.h lstring.h ltable.h +lstring.o: lstring.c lua.h path_defaults.h luaconf.h lmem.h llimits.h lobject.h lstate.h \ + ltm.h lzio.h lstring.h lgc.h +lstrlib.o: lstrlib.c lua.h path_defaults.h luaconf.h lauxlib.h lualib.h +ltable.o: ltable.c lua.h path_defaults.h luaconf.h ldebug.h lstate.h lobject.h llimits.h \ + ltm.h lzio.h lmem.h ldo.h lgc.h ltable.h +ltablib.o: ltablib.c lua.h path_defaults.h luaconf.h lauxlib.h lualib.h +ltm.o: ltm.c lua.h path_defaults.h luaconf.h lobject.h llimits.h lstate.h ltm.h lzio.h \ + lmem.h lstring.h lgc.h ltable.h +mlr.o: mlr.c lua.h path_defaults.h luaconf.h lauxlib.h lualib.h +mlc.o: mlc.c lua.h path_defaults.h luaconf.h lauxlib.h ldo.h lobject.h llimits.h \ + lstate.h ltm.h lzio.h lmem.h lfunc.h lopcodes.h lstring.h lgc.h \ + lundump.h +lundump.o: lundump.c lua.h path_defaults.h luaconf.h ldebug.h lstate.h lobject.h \ + llimits.h ltm.h lzio.h lmem.h ldo.h lfunc.h lstring.h lgc.h lundump.h +lvm.o: lvm.c lua.h path_defaults.h luaconf.h ldebug.h lstate.h lobject.h llimits.h ltm.h \ + lzio.h lmem.h ldo.h lfunc.h lgc.h lopcodes.h lstring.h ltable.h lvm.h +lzio.o: lzio.c lua.h path_defaults.h luaconf.h llimits.h lmem.h lstate.h lobject.h ltm.h \ + lzio.h +print.o: print.c ldebug.h lstate.h lua.h path_defaults.h luaconf.h lobject.h llimits.h \ + ltm.h lzio.h lmem.h lopcodes.h lundump.h + +# (end of Makefile) diff --git a/src/lua-vm/lapi.c b/src/lua-vm/lapi.c new file mode 100644 index 0000000..088c5f0 --- /dev/null +++ b/src/lua-vm/lapi.c @@ -0,0 +1,1079 @@ +/* +** $Id: lapi.c,v 2.55 2006/06/07 12:37:17 roberto Exp $ +** Lua API +** See Copyright Notice in lua.h +*/ + + +#include +#include +#include +#include + +#define lapi_c +#define LUA_CORE + +#include "lua.h" + +#include "lapi.h" +#include "ldebug.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 "lundump.h" +#include "lvm.h" + + + +const char lua_ident[] = + "$Lua: " LUA_RELEASE " " LUA_COPYRIGHT " $\n" + "$Authors: " LUA_AUTHORS " $\n" + "$URL: www.lua.org $\n"; + + + +#define api_checknelems(L, n) api_check(L, (n) <= (L->top - L->base)) + +#define api_checkvalidindex(L, i) api_check(L, (i) != luaO_nilobject) + +#define api_incr_top(L) {api_check(L, L->top < L->ci->top); L->top++;} + + + +static TValue *index2adr (lua_State *L, int idx) { + if (idx > 0) { + TValue *o = L->base + (idx - 1); + api_check(L, idx <= L->ci->top - L->base); + if (o >= L->top) return cast(TValue *, luaO_nilobject); + else return o; + } + else if (idx > LUA_REGISTRYINDEX) { + api_check(L, idx != 0 && -idx <= L->top - L->base); + return L->top + idx; + } + else switch (idx) { /* pseudo-indices */ + case LUA_REGISTRYINDEX: return registry(L); + case LUA_ENVIRONINDEX: { + Closure *func = curr_func(L); + sethvalue(L, &L->env, func->c.env); + return &L->env; + } + case LUA_GLOBALSINDEX: return gt(L); + default: { + Closure *func = curr_func(L); + idx = LUA_GLOBALSINDEX - idx; + return (idx <= func->c.nupvalues) + ? &func->c.upvalue[idx-1] + : cast(TValue *, luaO_nilobject); + } + } +} + + +static Table *getcurrenv (lua_State *L) { + if (L->ci == L->base_ci) /* no enclosing function? */ + return hvalue(gt(L)); /* use global table as environment */ + else { + Closure *func = curr_func(L); + return func->c.env; + } +} + + +void luaA_pushobject (lua_State *L, const TValue *o) { + setobj2s(L, L->top, o); + api_incr_top(L); +} + + +LUA_API int lua_checkstack (lua_State *L, int size) { + int res; + lua_lock(L); + if ((L->top - L->base + size) > LUAI_MAXCSTACK) + res = 0; /* stack overflow */ + else { + luaD_checkstack(L, size); + if (L->ci->top < L->top + size) + L->ci->top = L->top + size; + res = 1; + } + lua_unlock(L); + return res; +} + + +LUA_API void lua_xmove (lua_State *from, lua_State *to, int n) { + int i; + if (from == to) return; + lua_lock(to); + api_checknelems(from, n); + api_check(from, G(from) == G(to)); + api_check(from, to->ci->top - to->top >= n); + from->top -= n; + for (i = 0; i < n; i++) { + setobj2s(to, to->top++, from->top + i); + } + lua_unlock(to); +} + + +LUA_API lua_CFunction lua_atpanic (lua_State *L, lua_CFunction panicf) { + lua_CFunction old; + lua_lock(L); + old = G(L)->panic; + G(L)->panic = panicf; + lua_unlock(L); + return old; +} + + +LUA_API lua_State *lua_newthread (lua_State *L) { + lua_State *L1; + lua_lock(L); + luaC_checkGC(L); + L1 = luaE_newthread(L); + setthvalue(L, L->top, L1); + api_incr_top(L); + lua_unlock(L); + luai_userstatethread(L, L1); + return L1; +} + + + +/* +** basic stack manipulation +*/ + + +LUA_API int lua_gettop (lua_State *L) { + return cast_int(L->top - L->base); +} + + +LUA_API void lua_settop (lua_State *L, int idx) { + lua_lock(L); + if (idx >= 0) { + api_check(L, idx <= L->stack_last - L->base); + while (L->top < L->base + idx) + setnilvalue(L->top++); + L->top = L->base + idx; + } + else { + api_check(L, -(idx+1) <= (L->top - L->base)); + L->top += idx+1; /* `subtract' index (index is negative) */ + } + lua_unlock(L); +} + + +LUA_API void lua_remove (lua_State *L, int idx) { + StkId p; + lua_lock(L); + p = index2adr(L, idx); + api_checkvalidindex(L, p); + while (++p < L->top) setobjs2s(L, p-1, p); + L->top--; + lua_unlock(L); +} + + +LUA_API void lua_insert (lua_State *L, int idx) { + StkId p; + StkId q; + lua_lock(L); + p = index2adr(L, idx); + api_checkvalidindex(L, p); + for (q = L->top; q>p; q--) setobjs2s(L, q, q-1); + setobjs2s(L, p, L->top); + lua_unlock(L); +} + + +LUA_API void lua_replace (lua_State *L, int idx) { + StkId o; + lua_lock(L); + /* explicit test for incompatible code */ + if (idx == LUA_ENVIRONINDEX && L->ci == L->base_ci) + luaG_runerror(L, "no calling environment"); + api_checknelems(L, 1); + o = index2adr(L, idx); + api_checkvalidindex(L, o); + if (idx == LUA_ENVIRONINDEX) { + Closure *func = curr_func(L); + api_check(L, ttistable(L->top - 1)); + func->c.env = hvalue(L->top - 1); + luaC_barrier(L, func, L->top - 1); + } + else { + setobj(L, o, L->top - 1); + if (idx < LUA_GLOBALSINDEX) /* function upvalue? */ + luaC_barrier(L, curr_func(L), L->top - 1); + } + L->top--; + lua_unlock(L); +} + + +LUA_API void lua_pushvalue (lua_State *L, int idx) { + lua_lock(L); + setobj2s(L, L->top, index2adr(L, idx)); + api_incr_top(L); + lua_unlock(L); +} + + + +/* +** access functions (stack -> C) +*/ + + +LUA_API int lua_type (lua_State *L, int idx) { + StkId o = index2adr(L, idx); + return (o == luaO_nilobject) ? LUA_TNONE : ttype(o); +} + + +LUA_API const char *lua_typename (lua_State *L, int t) { + UNUSED(L); + return (t == LUA_TNONE) ? "no value" : luaT_typenames[t]; +} + + +LUA_API int lua_iscfunction (lua_State *L, int idx) { + StkId o = index2adr(L, idx); + return iscfunction(o); +} + + +LUA_API int lua_isnumber (lua_State *L, int idx) { + TValue n; + const TValue *o = index2adr(L, idx); + return tonumber(o, &n); +} + + +LUA_API int lua_isstring (lua_State *L, int idx) { + int t = lua_type(L, idx); + return (t == LUA_TSTRING || t == LUA_TNUMBER); +} + + +LUA_API int lua_isuserdata (lua_State *L, int idx) { + const TValue *o = index2adr(L, idx); + return (ttisuserdata(o) || ttislightuserdata(o)); +} + + +LUA_API int lua_rawequal (lua_State *L, int index1, int index2) { + StkId o1 = index2adr(L, index1); + StkId o2 = index2adr(L, index2); + return (o1 == luaO_nilobject || o2 == luaO_nilobject) ? 0 + : luaO_rawequalObj(o1, o2); +} + + +LUA_API int lua_equal (lua_State *L, int index1, int index2) { + StkId o1, o2; + int i; + lua_lock(L); /* may call tag method */ + o1 = index2adr(L, index1); + o2 = index2adr(L, index2); + i = (o1 == luaO_nilobject || o2 == luaO_nilobject) ? 0 : equalobj(L, o1, o2); + lua_unlock(L); + return i; +} + + +LUA_API int lua_lessthan (lua_State *L, int index1, int index2) { + StkId o1, o2; + int i; + lua_lock(L); /* may call tag method */ + o1 = index2adr(L, index1); + o2 = index2adr(L, index2); + i = (o1 == luaO_nilobject || o2 == luaO_nilobject) ? 0 + : luaV_lessthan(L, o1, o2); + lua_unlock(L); + return i; +} + + + +LUA_API lua_Number lua_tonumber (lua_State *L, int idx) { + TValue n; + const TValue *o = index2adr(L, idx); + if (tonumber(o, &n)) + return nvalue(o); + else + return 0; +} + + +LUA_API lua_Integer lua_tointeger (lua_State *L, int idx) { + TValue n; + const TValue *o = index2adr(L, idx); + if (tonumber(o, &n)) { + lua_Integer res; + lua_Number num = nvalue(o); + lua_number2integer(res, num); + return res; + } + else + return 0; +} + + +LUA_API int lua_toboolean (lua_State *L, int idx) { + const TValue *o = index2adr(L, idx); + return !l_isfalse(o); +} + + +LUA_API const char *lua_tolstring (lua_State *L, int idx, size_t *len) { + StkId o = index2adr(L, idx); + if (!ttisstring(o)) { + lua_lock(L); /* `luaV_tostring' may create a new string */ + if (!luaV_tostring(L, o)) { /* conversion failed? */ + if (len != NULL) *len = 0; + lua_unlock(L); + return NULL; + } + luaC_checkGC(L); + o = index2adr(L, idx); /* previous call may reallocate the stack */ + lua_unlock(L); + } + if (len != NULL) *len = tsvalue(o)->len; + return svalue(o); +} + + +LUA_API size_t lua_objlen (lua_State *L, int idx) { + StkId o = index2adr(L, idx); + switch (ttype(o)) { + case LUA_TSTRING: return tsvalue(o)->len; + case LUA_TUSERDATA: return uvalue(o)->len; + case LUA_TTABLE: return luaH_getn(hvalue(o)); + case LUA_TNUMBER: { + size_t l; + lua_lock(L); /* `luaV_tostring' may create a new string */ + l = (luaV_tostring(L, o) ? tsvalue(o)->len : 0); + lua_unlock(L); + return l; + } + default: return 0; + } +} + + +LUA_API lua_CFunction lua_tocfunction (lua_State *L, int idx) { + StkId o = index2adr(L, idx); + return (!iscfunction(o)) ? NULL : clvalue(o)->c.f; +} + + +LUA_API void *lua_touserdata (lua_State *L, int idx) { + StkId o = index2adr(L, idx); + switch (ttype(o)) { + case LUA_TUSERDATA: return (rawuvalue(o) + 1); + case LUA_TLIGHTUSERDATA: return pvalue(o); + default: return NULL; + } +} + + +LUA_API lua_State *lua_tothread (lua_State *L, int idx) { + StkId o = index2adr(L, idx); + return (!ttisthread(o)) ? NULL : thvalue(o); +} + + +LUA_API const void *lua_topointer (lua_State *L, int idx) { + StkId o = index2adr(L, idx); + switch (ttype(o)) { + case LUA_TTABLE: return hvalue(o); + case LUA_TFUNCTION: return clvalue(o); + case LUA_TTHREAD: return thvalue(o); + case LUA_TUSERDATA: + case LUA_TLIGHTUSERDATA: + return lua_touserdata(L, idx); + default: return NULL; + } +} + + + +/* +** push functions (C -> stack) +*/ + + +LUA_API void lua_pushnil (lua_State *L) { + lua_lock(L); + setnilvalue(L->top); + api_incr_top(L); + lua_unlock(L); +} + + +LUA_API void lua_pushnumber (lua_State *L, lua_Number n) { + lua_lock(L); + setnvalue(L->top, n); + api_incr_top(L); + lua_unlock(L); +} + + +LUA_API void lua_pushinteger (lua_State *L, lua_Integer n) { + lua_lock(L); + setnvalue(L->top, cast_num(n)); + api_incr_top(L); + lua_unlock(L); +} + + +LUA_API void lua_pushlstring (lua_State *L, const char *s, size_t len) { + lua_lock(L); + luaC_checkGC(L); + setsvalue2s(L, L->top, luaS_newlstr(L, s, len)); + api_incr_top(L); + lua_unlock(L); +} + + +LUA_API void lua_pushstring (lua_State *L, const char *s) { + if (s == NULL) + lua_pushnil(L); + else + lua_pushlstring(L, s, strlen(s)); +} + + +LUA_API const char *lua_pushvfstring (lua_State *L, const char *fmt, + va_list argp) { + const char *ret; + lua_lock(L); + luaC_checkGC(L); + ret = luaO_pushvfstring(L, fmt, argp); + lua_unlock(L); + return ret; +} + + +LUA_API const char *lua_pushfstring (lua_State *L, const char *fmt, ...) { + const char *ret; + va_list argp; + lua_lock(L); + luaC_checkGC(L); + va_start(argp, fmt); + ret = luaO_pushvfstring(L, fmt, argp); + va_end(argp); + lua_unlock(L); + return ret; +} + + +LUA_API void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n) { + Closure *cl; + lua_lock(L); + luaC_checkGC(L); + api_checknelems(L, n); + cl = luaF_newCclosure(L, n, getcurrenv(L)); + cl->c.f = fn; + L->top -= n; + while (n--) + setobj2n(L, &cl->c.upvalue[n], L->top+n); + setclvalue(L, L->top, cl); + lua_assert(iswhite(obj2gco(cl))); + api_incr_top(L); + lua_unlock(L); +} + + +LUA_API void lua_pushboolean (lua_State *L, int b) { + lua_lock(L); + setbvalue(L->top, (b != 0)); /* ensure that true is 1 */ + api_incr_top(L); + lua_unlock(L); +} + + +LUA_API void lua_pushlightuserdata (lua_State *L, void *p) { + lua_lock(L); + setpvalue(L->top, p); + api_incr_top(L); + lua_unlock(L); +} + + +LUA_API int lua_pushthread (lua_State *L) { + lua_lock(L); + setthvalue(L, L->top, L); + api_incr_top(L); + lua_unlock(L); + return (G(L)->mainthread == L); +} + + + +/* +** get functions (Lua -> stack) +*/ + + +LUA_API void lua_gettable (lua_State *L, int idx) { + StkId t; + lua_lock(L); + t = index2adr(L, idx); + api_checkvalidindex(L, t); + luaV_gettable(L, t, L->top - 1, L->top - 1); + lua_unlock(L); +} + + +LUA_API void lua_getfield (lua_State *L, int idx, const char *k) { + StkId t; + TValue key; + lua_lock(L); + t = index2adr(L, idx); + api_checkvalidindex(L, t); + setsvalue(L, &key, luaS_new(L, k)); + luaV_gettable(L, t, &key, L->top); + api_incr_top(L); + lua_unlock(L); +} + + +LUA_API void lua_rawget (lua_State *L, int idx) { + StkId t; + lua_lock(L); + t = index2adr(L, idx); + api_check(L, ttistable(t)); + setobj2s(L, L->top - 1, luaH_get(hvalue(t), L->top - 1)); + lua_unlock(L); +} + + +LUA_API void lua_rawgeti (lua_State *L, int idx, int n) { + StkId o; + lua_lock(L); + o = index2adr(L, idx); + api_check(L, ttistable(o)); + setobj2s(L, L->top, luaH_getnum(hvalue(o), n)); + api_incr_top(L); + lua_unlock(L); +} + + +LUA_API void lua_createtable (lua_State *L, int narray, int nrec) { + lua_lock(L); + luaC_checkGC(L); + sethvalue(L, L->top, luaH_new(L, narray, nrec)); + api_incr_top(L); + lua_unlock(L); +} + + +LUA_API int lua_getmetatable (lua_State *L, int objindex) { + const TValue *obj; + Table *mt = NULL; + int res; + lua_lock(L); + obj = index2adr(L, objindex); + switch (ttype(obj)) { + case LUA_TTABLE: + mt = hvalue(obj)->metatable; + break; + case LUA_TUSERDATA: + mt = uvalue(obj)->metatable; + break; + default: + mt = G(L)->mt[ttype(obj)]; + break; + } + if (mt == NULL) + res = 0; + else { + sethvalue(L, L->top, mt); + api_incr_top(L); + res = 1; + } + lua_unlock(L); + return res; +} + + +LUA_API void lua_getfenv (lua_State *L, int idx) { + StkId o; + lua_lock(L); + o = index2adr(L, idx); + api_checkvalidindex(L, o); + switch (ttype(o)) { + case LUA_TFUNCTION: + sethvalue(L, L->top, clvalue(o)->c.env); + break; + case LUA_TUSERDATA: + sethvalue(L, L->top, uvalue(o)->env); + break; + case LUA_TTHREAD: + setobj2s(L, L->top, gt(thvalue(o))); + break; + default: + setnilvalue(L->top); + break; + } + api_incr_top(L); + lua_unlock(L); +} + + +/* +** set functions (stack -> Lua) +*/ + + +LUA_API void lua_settable (lua_State *L, int idx) { + StkId t; + lua_lock(L); + api_checknelems(L, 2); + t = index2adr(L, idx); + api_checkvalidindex(L, t); + luaV_settable(L, t, L->top - 2, L->top - 1); + L->top -= 2; /* pop index and value */ + lua_unlock(L); +} + + +LUA_API void lua_setfield (lua_State *L, int idx, const char *k) { + StkId t; + TValue key; + lua_lock(L); + api_checknelems(L, 1); + t = index2adr(L, idx); + api_checkvalidindex(L, t); + setsvalue(L, &key, luaS_new(L, k)); + luaV_settable(L, t, &key, L->top - 1); + L->top--; /* pop value */ + lua_unlock(L); +} + + +LUA_API void lua_rawset (lua_State *L, int idx) { + StkId t; + lua_lock(L); + api_checknelems(L, 2); + t = index2adr(L, idx); + api_check(L, ttistable(t)); + setobj2t(L, luaH_set(L, hvalue(t), L->top-2), L->top-1); + luaC_barriert(L, hvalue(t), L->top-1); + L->top -= 2; + lua_unlock(L); +} + + +LUA_API void lua_rawseti (lua_State *L, int idx, int n) { + StkId o; + lua_lock(L); + api_checknelems(L, 1); + o = index2adr(L, idx); + api_check(L, ttistable(o)); + setobj2t(L, luaH_setnum(L, hvalue(o), n), L->top-1); + luaC_barriert(L, hvalue(o), L->top-1); + L->top--; + lua_unlock(L); +} + + +LUA_API int lua_setmetatable (lua_State *L, int objindex) { + TValue *obj; + Table *mt; + lua_lock(L); + api_checknelems(L, 1); + obj = index2adr(L, objindex); + api_checkvalidindex(L, obj); + if (ttisnil(L->top - 1)) + mt = NULL; + else { + api_check(L, ttistable(L->top - 1)); + mt = hvalue(L->top - 1); + } + switch (ttype(obj)) { + case LUA_TTABLE: { + hvalue(obj)->metatable = mt; + if (mt) + luaC_objbarriert(L, hvalue(obj), mt); + break; + } + case LUA_TUSERDATA: { + uvalue(obj)->metatable = mt; + if (mt) + luaC_objbarrier(L, rawuvalue(obj), mt); + break; + } + default: { + G(L)->mt[ttype(obj)] = mt; + break; + } + } + L->top--; + lua_unlock(L); + return 1; +} + + +LUA_API int lua_setfenv (lua_State *L, int idx) { + StkId o; + int res = 1; + lua_lock(L); + api_checknelems(L, 1); + o = index2adr(L, idx); + api_checkvalidindex(L, o); + api_check(L, ttistable(L->top - 1)); + switch (ttype(o)) { + case LUA_TFUNCTION: + clvalue(o)->c.env = hvalue(L->top - 1); + break; + case LUA_TUSERDATA: + uvalue(o)->env = hvalue(L->top - 1); + break; + case LUA_TTHREAD: + sethvalue(L, gt(thvalue(o)), hvalue(L->top - 1)); + break; + default: + res = 0; + break; + } + luaC_objbarrier(L, gcvalue(o), hvalue(L->top - 1)); + L->top--; + lua_unlock(L); + return res; +} + + +/* +** `load' and `call' functions (run Lua code) +*/ + + +#define adjustresults(L,nres) \ + { if (nres == LUA_MULTRET && L->top >= L->ci->top) L->ci->top = L->top; } + + +#define checkresults(L,na,nr) \ + api_check(L, (nr) == LUA_MULTRET || (L->ci->top - L->top >= (nr) - (na))) + + +LUA_API void lua_call (lua_State *L, int nargs, int nresults) { + StkId func; + lua_lock(L); + api_checknelems(L, nargs+1); + checkresults(L, nargs, nresults); + func = L->top - (nargs+1); + luaD_call(L, func, nresults); + adjustresults(L, nresults); + lua_unlock(L); +} + + +/* +** Execute a protected call. +*/ +struct CallS { /* data to `f_call' */ + StkId func; + int nresults; +}; + + +static void f_call (lua_State *L, void *ud) { + struct CallS *c = cast(struct CallS *, ud); + luaD_call(L, c->func, c->nresults); +} + + + +LUA_API int lua_pcall (lua_State *L, int nargs, int nresults, int errfunc) { + struct CallS c; + int status; + ptrdiff_t func; + lua_lock(L); + api_checknelems(L, nargs+1); + checkresults(L, nargs, nresults); + if (errfunc == 0) + func = 0; + else { + StkId o = index2adr(L, errfunc); + api_checkvalidindex(L, o); + func = savestack(L, o); + } + c.func = L->top - (nargs+1); /* function to be called */ + c.nresults = nresults; + status = luaD_pcall(L, f_call, &c, savestack(L, c.func), func); + adjustresults(L, nresults); + lua_unlock(L); + return status; +} + + +/* +** Execute a protected C call. +*/ +struct CCallS { /* data to `f_Ccall' */ + lua_CFunction func; + void *ud; +}; + + +static void f_Ccall (lua_State *L, void *ud) { + struct CCallS *c = cast(struct CCallS *, ud); + Closure *cl; + cl = luaF_newCclosure(L, 0, getcurrenv(L)); + cl->c.f = c->func; + setclvalue(L, L->top, cl); /* push function */ + api_incr_top(L); + setpvalue(L->top, c->ud); /* push only argument */ + api_incr_top(L); + luaD_call(L, L->top - 2, 0); +} + + +LUA_API int lua_cpcall (lua_State *L, lua_CFunction func, void *ud) { + struct CCallS c; + int status; + lua_lock(L); + c.func = func; + c.ud = ud; + status = luaD_pcall(L, f_Ccall, &c, savestack(L, L->top), 0); + lua_unlock(L); + return status; +} + + +LUA_API int lua_load (lua_State *L, lua_Reader reader, void *data, + const char *chunkname) { + ZIO z; + int status; + lua_lock(L); + if (!chunkname) chunkname = "?"; + luaZ_init(L, &z, reader, data); + status = luaD_protectedparser(L, &z, chunkname); + lua_unlock(L); + return status; +} + + +LUA_API int lua_dump (lua_State *L, lua_Writer writer, void *data) { + int status; + TValue *o; + lua_lock(L); + api_checknelems(L, 1); + o = L->top - 1; + if (isLfunction(o)) + status = luaU_dump(L, clvalue(o)->l.p, writer, data, 0); + else + status = 1; + lua_unlock(L); + return status; +} + + +LUA_API int lua_status (lua_State *L) { + return L->status; +} + + +/* +** Garbage-collection function +*/ + +LUA_API int lua_gc (lua_State *L, int what, int data) { + int res = 0; + global_State *g; + lua_lock(L); + g = G(L); + switch (what) { + case LUA_GCSTOP: { + g->GCthreshold = MAX_LUMEM; + break; + } + case LUA_GCRESTART: { + g->GCthreshold = g->totalbytes; + break; + } + case LUA_GCCOLLECT: { + luaC_fullgc(L); + break; + } + case LUA_GCCOUNT: { + /* GC values are expressed in Kbytes: #bytes/2^10 */ + res = cast_int(g->totalbytes >> 10); + break; + } + case LUA_GCCOUNTB: { + res = cast_int(g->totalbytes & 0x3ff); + break; + } + case LUA_GCSTEP: { + lu_mem a = (cast(lu_mem, data) << 10); + if (a <= g->totalbytes) + g->GCthreshold = g->totalbytes - a; + else + g->GCthreshold = 0; + while (g->GCthreshold <= g->totalbytes) + luaC_step(L); + if (g->gcstate == GCSpause) /* end of cycle? */ + res = 1; /* signal it */ + break; + } + case LUA_GCSETPAUSE: { + res = g->gcpause; + g->gcpause = data; + break; + } + case LUA_GCSETSTEPMUL: { + res = g->gcstepmul; + g->gcstepmul = data; + break; + } + default: res = -1; /* invalid option */ + } + lua_unlock(L); + return res; +} + + + +/* +** miscellaneous functions +*/ + + +LUA_API int lua_error (lua_State *L) { + lua_lock(L); + api_checknelems(L, 1); + luaG_errormsg(L); + lua_unlock(L); + return 0; /* to avoid warnings */ +} + + +LUA_API int lua_next (lua_State *L, int idx) { + StkId t; + int more; + lua_lock(L); + t = index2adr(L, idx); + api_check(L, ttistable(t)); + more = luaH_next(L, hvalue(t), L->top - 1); + if (more) { + api_incr_top(L); + } + else /* no more elements */ + L->top -= 1; /* remove key */ + lua_unlock(L); + return more; +} + + +LUA_API void lua_concat (lua_State *L, int n) { + lua_lock(L); + api_checknelems(L, n); + if (n >= 2) { + luaC_checkGC(L); + luaV_concat(L, n, cast_int(L->top - L->base) - 1); + L->top -= (n-1); + } + else if (n == 0) { /* push empty string */ + setsvalue2s(L, L->top, luaS_newlstr(L, "", 0)); + api_incr_top(L); + } + /* else n == 1; nothing to do */ + lua_unlock(L); +} + + +LUA_API lua_Alloc lua_getallocf (lua_State *L, void **ud) { + lua_Alloc f; + lua_lock(L); + if (ud) *ud = G(L)->ud; + f = G(L)->frealloc; + lua_unlock(L); + return f; +} + + +LUA_API void lua_setallocf (lua_State *L, lua_Alloc f, void *ud) { + lua_lock(L); + G(L)->ud = ud; + G(L)->frealloc = f; + lua_unlock(L); +} + + +LUA_API void *lua_newuserdata (lua_State *L, size_t size) { + Udata *u; + lua_lock(L); + luaC_checkGC(L); + u = luaS_newudata(L, size, getcurrenv(L)); + setuvalue(L, L->top, u); + api_incr_top(L); + lua_unlock(L); + return u + 1; +} + + + + +static const char *aux_upvalue (StkId fi, int n, TValue **val) { + Closure *f; + if (!ttisfunction(fi)) return NULL; + f = clvalue(fi); + if (f->c.isC) { + if (!(1 <= n && n <= f->c.nupvalues)) return NULL; + *val = &f->c.upvalue[n-1]; + return ""; + } + else { + Proto *p = f->l.p; + if (!(1 <= n && n <= p->sizeupvalues)) return NULL; + *val = f->l.upvals[n-1]->v; + return getstr(p->upvalues[n-1]); + } +} + + +LUA_API const char *lua_getupvalue (lua_State *L, int funcindex, int n) { + const char *name; + TValue *val; + lua_lock(L); + name = aux_upvalue(index2adr(L, funcindex), n, &val); + if (name) { + setobj2s(L, L->top, val); + api_incr_top(L); + } + lua_unlock(L); + return name; +} + + +LUA_API const char *lua_setupvalue (lua_State *L, int funcindex, int n) { + const char *name; + TValue *val; + StkId fi; + lua_lock(L); + fi = index2adr(L, funcindex); + api_checknelems(L, 1); + name = aux_upvalue(fi, n, &val); + if (name) { + L->top--; + setobj(L, val, L->top); + luaC_barrier(L, clvalue(fi), L->top); + } + lua_unlock(L); + return name; +} + diff --git a/src/lua-vm/lapi.h b/src/lua-vm/lapi.h new file mode 100644 index 0000000..9d1d435 --- /dev/null +++ b/src/lua-vm/lapi.h @@ -0,0 +1,16 @@ +/* +** $Id: lapi.h,v 2.2 2005/04/25 19:24:10 roberto Exp $ +** Auxiliary functions from Lua API +** See Copyright Notice in lua.h +*/ + +#ifndef lapi_h +#define lapi_h + + +#include "lobject.h" + + +LUAI_FUNC void luaA_pushobject (lua_State *L, const TValue *o); + +#endif diff --git a/src/lua-vm/lauxlib.c b/src/lua-vm/lauxlib.c new file mode 100644 index 0000000..956d29c --- /dev/null +++ b/src/lua-vm/lauxlib.c @@ -0,0 +1,674 @@ +/* +** $Id: lauxlib.c,v 1.159 2006/03/21 19:31:09 roberto Exp $ +** Auxiliary functions for building Lua libraries +** See Copyright Notice in lua.h +*/ + + +#include +#include +#include +#include +#include +#include + + +/* This file uses only the official API of Lua. +** Any function declared here could be written as an application function. +*/ + +#define lauxlib_c +#define LUA_LIB + +#include "lua.h" + +#include "lauxlib.h" + + +#define FREELIST_REF 0 /* free list of references */ + + +/* convert a stack index to positive */ +#define abs_index(L, i) ((i) > 0 || (i) <= LUA_REGISTRYINDEX ? (i) : \ + lua_gettop(L) + (i) + 1) + + +/* +** {====================================================== +** Error-report functions +** ======================================================= +*/ + + +LUALIB_API int luaL_argerror (lua_State *L, int narg, const char *extramsg) { + lua_Debug ar; + if (!lua_getstack(L, 0, &ar)) /* no stack frame? */ + return luaL_error(L, "bad argument #%d (%s)", narg, extramsg); + lua_getinfo(L, "n", &ar); + if (strcmp(ar.namewhat, "method") == 0) { + narg--; /* do not count `self' */ + if (narg == 0) /* error is in the self argument itself? */ + return luaL_error(L, "calling " LUA_QS " on bad self (%s)", + ar.name, extramsg); + } + if (ar.name == NULL) + ar.name = "?"; + return luaL_error(L, "bad argument #%d to " LUA_QS " (%s)", + narg, ar.name, extramsg); +} + + +LUALIB_API int luaL_typerror (lua_State *L, int narg, const char *tname) { + const char *msg = lua_pushfstring(L, "%s expected, got %s", + tname, luaL_typename(L, narg)); + return luaL_argerror(L, narg, msg); +} + + +static void tag_error (lua_State *L, int narg, int tag) { + luaL_typerror(L, narg, lua_typename(L, tag)); +} + + +LUALIB_API void luaL_where (lua_State *L, int level) { + lua_Debug ar; + if (lua_getstack(L, level, &ar)) { /* check function at level */ + lua_getinfo(L, "Sl", &ar); /* get info about it */ + if (ar.currentline > 0) { /* is there info? */ + lua_pushfstring(L, "%s:%d: ", ar.short_src, ar.currentline); + return; + } + } + lua_pushliteral(L, ""); /* else, no information available... */ +} + + +LUALIB_API int luaL_error (lua_State *L, const char *fmt, ...) { + va_list argp; + va_start(argp, fmt); + luaL_where(L, 1); + lua_pushvfstring(L, fmt, argp); + va_end(argp); + lua_concat(L, 2); + return lua_error(L); +} + +/* }====================================================== */ + + +LUALIB_API int luaL_checkoption (lua_State *L, int narg, const char *def, + const char *const lst[]) { + const char *name = (def) ? luaL_optstring(L, narg, def) : + luaL_checkstring(L, narg); + int i; + for (i=0; lst[i]; i++) + if (strcmp(lst[i], name) == 0) + return i; + return luaL_argerror(L, narg, + lua_pushfstring(L, "invalid option " LUA_QS, name)); +} + + +LUALIB_API int luaL_newmetatable (lua_State *L, const char *tname) { + lua_getfield(L, LUA_REGISTRYINDEX, tname); /* get registry.name */ + if (!lua_isnil(L, -1)) /* name already in use? */ + return 0; /* leave previous value on top, but return 0 */ + lua_pop(L, 1); + lua_newtable(L); /* create metatable */ + lua_pushvalue(L, -1); + lua_setfield(L, LUA_REGISTRYINDEX, tname); /* registry.name = metatable */ + return 1; +} + + +LUALIB_API void *luaL_checkudata (lua_State *L, int ud, const char *tname) { + void *p = lua_touserdata(L, ud); + if (p != NULL) { /* value is a userdata? */ + if (lua_getmetatable(L, ud)) { /* does it have a metatable? */ + lua_getfield(L, LUA_REGISTRYINDEX, tname); /* get correct metatable */ + if (lua_rawequal(L, -1, -2)) { /* does it have the correct mt? */ + lua_pop(L, 2); /* remove both metatables */ + return p; + } + } + } + luaL_typerror(L, ud, tname); /* else error */ + return NULL; /* to avoid warnings */ +} + + +LUALIB_API void luaL_checkstack (lua_State *L, int space, const char *mes) { + if (!lua_checkstack(L, space)) + luaL_error(L, "stack overflow (%s)", mes); +} + + +LUALIB_API void luaL_checktype (lua_State *L, int narg, int t) { + if (lua_type(L, narg) != t) + tag_error(L, narg, t); +} + + +LUALIB_API void luaL_checkany (lua_State *L, int narg) { + if (lua_type(L, narg) == LUA_TNONE) + luaL_argerror(L, narg, "value expected"); +} + + +LUALIB_API const char *luaL_checklstring (lua_State *L, int narg, size_t *len) { + const char *s = lua_tolstring(L, narg, len); + if (!s) tag_error(L, narg, LUA_TSTRING); + return s; +} + + +LUALIB_API const char *luaL_optlstring (lua_State *L, int narg, + const char *def, size_t *len) { + if (lua_isnoneornil(L, narg)) { + if (len) + *len = (def ? strlen(def) : 0); + return def; + } + else return luaL_checklstring(L, narg, len); +} + + +LUALIB_API lua_Number luaL_checknumber (lua_State *L, int narg) { + lua_Number d = lua_tonumber(L, narg); + if (d == 0 && !lua_isnumber(L, narg)) /* avoid extra test when d is not 0 */ + tag_error(L, narg, LUA_TNUMBER); + return d; +} + + +LUALIB_API lua_Number luaL_optnumber (lua_State *L, int narg, lua_Number def) { + return luaL_opt(L, luaL_checknumber, narg, def); +} + + +LUALIB_API lua_Integer luaL_checkinteger (lua_State *L, int narg) { + lua_Integer d = lua_tointeger(L, narg); + if (d == 0 && !lua_isnumber(L, narg)) /* avoid extra test when d is not 0 */ + tag_error(L, narg, LUA_TNUMBER); + return d; +} + + +LUALIB_API lua_Integer luaL_optinteger (lua_State *L, int narg, + lua_Integer def) { + return luaL_opt(L, luaL_checkinteger, narg, def); +} + + +LUALIB_API int luaL_getmetafield (lua_State *L, int obj, const char *event) { + if (!lua_getmetatable(L, obj)) /* no metatable? */ + return 0; + lua_pushstring(L, event); + lua_rawget(L, -2); + if (lua_isnil(L, -1)) { + lua_pop(L, 2); /* remove metatable and metafield */ + return 0; + } + else { + lua_remove(L, -2); /* remove only metatable */ + return 1; + } +} + + +LUALIB_API int luaL_callmeta (lua_State *L, int obj, const char *event) { + obj = abs_index(L, obj); + if (!luaL_getmetafield(L, obj, event)) /* no metafield? */ + return 0; + lua_pushvalue(L, obj); + lua_call(L, 1, 1); + return 1; +} + + +LUALIB_API void (luaL_register) (lua_State *L, const char *libname, + const luaL_Reg *l) { + luaI_openlib(L, libname, l, 0); +} + + +static int libsize (const luaL_Reg *l) { + int size = 0; + for (; l->name; l++) size++; + return size; +} + + +LUALIB_API void luaI_openlib (lua_State *L, const char *libname, + const luaL_Reg *l, int nup) { + if (libname) { + int size = libsize(l); + /* check whether lib already exists */ + luaL_findtable(L, LUA_REGISTRYINDEX, "_LOADED", size); + lua_getfield(L, -1, libname); /* get _LOADED[libname] */ + if (!lua_istable(L, -1)) { /* not found? */ + lua_pop(L, 1); /* remove previous result */ + /* try global variable (and create one if it does not exist) */ + if (luaL_findtable(L, LUA_GLOBALSINDEX, libname, size) != NULL) + luaL_error(L, "name conflict for module " LUA_QS, libname); + lua_pushvalue(L, -1); + lua_setfield(L, -3, libname); /* _LOADED[libname] = new table */ + } + lua_remove(L, -2); /* remove _LOADED table */ + lua_insert(L, -(nup+1)); /* move library table to below upvalues */ + } + for (; l->name; l++) { + int i; + for (i=0; ifunc, nup); + lua_setfield(L, -(nup+2), l->name); + } + lua_pop(L, nup); /* remove upvalues */ +} + + + +/* +** {====================================================== +** getn-setn: size for arrays +** ======================================================= +*/ + +#if defined(LUA_COMPAT_GETN) + +static int checkint (lua_State *L, int topop) { + int n = (lua_type(L, -1) == LUA_TNUMBER) ? lua_tointeger(L, -1) : -1; + lua_pop(L, topop); + return n; +} + + +static void getsizes (lua_State *L) { + lua_getfield(L, LUA_REGISTRYINDEX, "LUA_SIZES"); + if (lua_isnil(L, -1)) { /* no `size' table? */ + lua_pop(L, 1); /* remove nil */ + lua_newtable(L); /* create it */ + lua_pushvalue(L, -1); /* `size' will be its own metatable */ + lua_setmetatable(L, -2); + lua_pushliteral(L, "kv"); + lua_setfield(L, -2, "__mode"); /* metatable(N).__mode = "kv" */ + lua_pushvalue(L, -1); + lua_setfield(L, LUA_REGISTRYINDEX, "LUA_SIZES"); /* store in register */ + } +} + + +LUALIB_API void luaL_setn (lua_State *L, int t, int n) { + t = abs_index(L, t); + lua_pushliteral(L, "n"); + lua_rawget(L, t); + if (checkint(L, 1) >= 0) { /* is there a numeric field `n'? */ + lua_pushliteral(L, "n"); /* use it */ + lua_pushinteger(L, n); + lua_rawset(L, t); + } + else { /* use `sizes' */ + getsizes(L); + lua_pushvalue(L, t); + lua_pushinteger(L, n); + lua_rawset(L, -3); /* sizes[t] = n */ + lua_pop(L, 1); /* remove `sizes' */ + } +} + + +LUALIB_API int luaL_getn (lua_State *L, int t) { + int n; + t = abs_index(L, t); + lua_pushliteral(L, "n"); /* try t.n */ + lua_rawget(L, t); + if ((n = checkint(L, 1)) >= 0) return n; + getsizes(L); /* else try sizes[t] */ + lua_pushvalue(L, t); + lua_rawget(L, -2); + if ((n = checkint(L, 2)) >= 0) return n; + return (int)lua_objlen(L, t); +} + +#endif + +/* }====================================================== */ + + + +LUALIB_API const char *luaL_gsub (lua_State *L, const char *s, const char *p, + const char *r) { + const char *wild; + size_t l = strlen(p); + luaL_Buffer b; + luaL_buffinit(L, &b); + while ((wild = strstr(s, p)) != NULL) { + luaL_addlstring(&b, s, wild - s); /* push prefix */ + luaL_addstring(&b, r); /* push replacement in place of pattern */ + s = wild + l; /* continue after `p' */ + } + luaL_addstring(&b, s); /* push last suffix */ + luaL_pushresult(&b); + return lua_tostring(L, -1); +} + + +LUALIB_API const char *luaL_findtable (lua_State *L, int idx, + const char *fname, int szhint) { + const char *e; + lua_pushvalue(L, idx); + do { + e = strchr(fname, '.'); + if (e == NULL) e = fname + strlen(fname); + lua_pushlstring(L, fname, e - fname); + lua_rawget(L, -2); + if (lua_isnil(L, -1)) { /* no such field? */ + lua_pop(L, 1); /* remove this nil */ + lua_createtable(L, 0, (*e == '.' ? 1 : szhint)); /* new table for field */ + lua_pushlstring(L, fname, e - fname); + lua_pushvalue(L, -2); + lua_settable(L, -4); /* set new table into field */ + } + else if (!lua_istable(L, -1)) { /* field has a non-table value? */ + lua_pop(L, 2); /* remove table and value */ + return fname; /* return problematic part of the name */ + } + lua_remove(L, -2); /* remove previous table */ + fname = e + 1; + } while (*e == '.'); + return NULL; +} + + + +/* +** {====================================================== +** Generic Buffer manipulation +** ======================================================= +*/ + + +#define bufflen(B) ((B)->p - (B)->buffer) +#define bufffree(B) ((size_t)(LUAL_BUFFERSIZE - bufflen(B))) + +#define LIMIT (LUA_MINSTACK/2) + + +static int emptybuffer (luaL_Buffer *B) { + size_t l = bufflen(B); + if (l == 0) return 0; /* put nothing on stack */ + else { + lua_pushlstring(B->L, B->buffer, l); + B->p = B->buffer; + B->lvl++; + return 1; + } +} + + +static void adjuststack (luaL_Buffer *B) { + if (B->lvl > 1) { + lua_State *L = B->L; + int toget = 1; /* number of levels to concat */ + size_t toplen = lua_strlen(L, -1); + do { + size_t l = lua_strlen(L, -(toget+1)); + if (B->lvl - toget + 1 >= LIMIT || toplen > l) { + toplen += l; + toget++; + } + else break; + } while (toget < B->lvl); + lua_concat(L, toget); + B->lvl = B->lvl - toget + 1; + } +} + + +LUALIB_API char *luaL_prepbuffer (luaL_Buffer *B) { + if (emptybuffer(B)) + adjuststack(B); + return B->buffer; +} + + +LUALIB_API void luaL_addlstring (luaL_Buffer *B, const char *s, size_t l) { + while (l--) + luaL_addchar(B, *s++); +} + + +LUALIB_API void luaL_addstring (luaL_Buffer *B, const char *s) { + luaL_addlstring(B, s, strlen(s)); +} + + +LUALIB_API void luaL_pushresult (luaL_Buffer *B) { + emptybuffer(B); + lua_concat(B->L, B->lvl); + B->lvl = 1; +} + + +LUALIB_API void luaL_addvalue (luaL_Buffer *B) { + lua_State *L = B->L; + size_t vl; + const char *s = lua_tolstring(L, -1, &vl); + if (vl <= bufffree(B)) { /* fit into buffer? */ + memcpy(B->p, s, vl); /* put it there */ + B->p += vl; + lua_pop(L, 1); /* remove from stack */ + } + else { + if (emptybuffer(B)) + lua_insert(L, -2); /* put buffer before new value */ + B->lvl++; /* add new value into B stack */ + adjuststack(B); + } +} + + +LUALIB_API void luaL_buffinit (lua_State *L, luaL_Buffer *B) { + B->L = L; + B->p = B->buffer; + B->lvl = 0; +} + +/* }====================================================== */ + + +LUALIB_API int luaL_ref (lua_State *L, int t) { + int ref; + t = abs_index(L, t); + if (lua_isnil(L, -1)) { + lua_pop(L, 1); /* remove from stack */ + return LUA_REFNIL; /* `nil' has a unique fixed reference */ + } + lua_rawgeti(L, t, FREELIST_REF); /* get first free element */ + ref = (int)lua_tointeger(L, -1); /* ref = t[FREELIST_REF] */ + lua_pop(L, 1); /* remove it from stack */ + if (ref != 0) { /* any free element? */ + lua_rawgeti(L, t, ref); /* remove it from list */ + lua_rawseti(L, t, FREELIST_REF); /* (t[FREELIST_REF] = t[ref]) */ + } + else { /* no free elements */ + ref = (int)lua_objlen(L, t); + ref++; /* create new reference */ + } + lua_rawseti(L, t, ref); + return ref; +} + + +LUALIB_API void luaL_unref (lua_State *L, int t, int ref) { + if (ref >= 0) { + t = abs_index(L, t); + lua_rawgeti(L, t, FREELIST_REF); + lua_rawseti(L, t, ref); /* t[ref] = t[FREELIST_REF] */ + lua_pushinteger(L, ref); + lua_rawseti(L, t, FREELIST_REF); /* t[FREELIST_REF] = ref */ + } +} + + + +/* +** {====================================================== +** Load functions +** ======================================================= +*/ + +typedef struct LoadF { + int extraline; + FILE *f; + char buff[LUAL_BUFFERSIZE]; +} LoadF; + + +static const char *getF (lua_State *L, void *ud, size_t *size) { + LoadF *lf = (LoadF *)ud; + (void)L; + if (lf->extraline) { + lf->extraline = 0; + *size = 1; + return "\n"; + } + if (feof(lf->f)) return NULL; + *size = fread(lf->buff, 1, LUAL_BUFFERSIZE, lf->f); + return (*size > 0) ? lf->buff : NULL; +} + + +static int errfile (lua_State *L, const char *what, int fnameindex) { + const char *serr = strerror(errno); + const char *filename = lua_tostring(L, fnameindex) + 1; + lua_pushfstring(L, "cannot %s %s: %s", what, filename, serr); + lua_remove(L, fnameindex); + return LUA_ERRFILE; +} + + +static int original_loadfile (lua_State *L, const char *filename) { + LoadF lf; + int status, readstatus; + int c; + int fnameindex = lua_gettop(L) + 1; /* index of filename on the stack */ + lf.extraline = 0; + if (filename == NULL) { + lua_pushliteral(L, "=stdin"); + lf.f = stdin; + } + else { + lua_pushfstring(L, "@%s", filename); + lf.f = fopen(filename, "r"); + if (lf.f == NULL) return errfile(L, "open", fnameindex); + } + c = getc(lf.f); + if (c == '#') { /* Unix exec. file? */ + lf.extraline = 1; + while ((c = getc(lf.f)) != EOF && c != '\n') ; /* skip first line */ + if (c == '\n') c = getc(lf.f); + } + if (c == LUA_SIGNATURE[0] && lf.f != stdin) { /* binary file? */ + fclose(lf.f); + lf.f = fopen(filename, "rb"); /* reopen in binary mode */ + if (lf.f == NULL) return errfile(L, "reopen", fnameindex); + /* skip eventual `#!...' */ + while ((c = getc(lf.f)) != EOF && c != LUA_SIGNATURE[0]) ; + lf.extraline = 0; + } + ungetc(c, lf.f); + status = lua_load(L, getF, &lf, lua_tostring(L, -1)); + readstatus = ferror(lf.f); + if (lf.f != stdin) fclose(lf.f); /* close file (even in case of errors) */ + if (readstatus) { + lua_settop(L, fnameindex); /* ignore results from `lua_load' */ + return errfile(L, "read", fnameindex); + } + lua_remove(L, fnameindex); + return status; +} + + +/* A hook has been added for metalua: if there is a loadfile function + * in the registry index, it is called instead of the C implementation. + */ +LUALIB_API int luaL_loadfile (lua_State *L, const char *filename) { + lua_getfield( L, LUA_REGISTRYINDEX, "loadfile"); + if( lua_isfunction( L, -1)) { + if( filename) lua_pushstring( L, filename); else lua_pushnil( L); + return lua_pcall( L, 1, 1, 0); + } else { + lua_pop( L, 1); // drop registry.loadfile + return original_loadfile( L, filename); + } +} + +typedef struct LoadS { + const char *s; + size_t size; +} LoadS; + + +static const char *getS (lua_State *L, void *ud, size_t *size) { + LoadS *ls = (LoadS *)ud; + (void)L; + if (ls->size == 0) return NULL; + *size = ls->size; + ls->size = 0; + return ls->s; +} + + +LUALIB_API int luaL_loadbuffer (lua_State *L, const char *buff, size_t size, + const char *name) { + LoadS ls; + ls.s = buff; + ls.size = size; + return lua_load(L, getS, &ls, name); +} + +/* Return 0 on success, LUA_ERRSYNTAC or LUA_ERRMEM on error */ +LUALIB_API int (luaL_loadstring) (lua_State *L, const char *s) { + lua_getfield( L, LUA_REGISTRYINDEX, "loadstring"); + if( lua_isfunction( L, -1)) { + if( s) lua_pushstring( L, s); else lua_pushnil( L); + return lua_pcall( L, 1, 1, 0); + } else { + lua_pop( L, 1); // drop registry.loadstring + return luaL_loadbuffer(L, s, strlen(s), s); + } +} + + + +/* }====================================================== */ + + +static void *l_alloc (void *ud, void *ptr, size_t osize, size_t nsize) { + (void)ud; + (void)osize; + if (nsize == 0) { + free(ptr); + return NULL; + } + else + return realloc(ptr, nsize); +} + + +static int panic (lua_State *L) { + (void)L; /* to avoid warnings */ + fprintf(stderr, "PANIC: unprotected error in call to Lua API (%s)\n", + lua_tostring(L, -1)); + return 0; +} + + +LUALIB_API lua_State *luaL_newstate (void) { + lua_State *L = lua_newstate(l_alloc, NULL); + if (L) lua_atpanic(L, &panic); + return L; +} + diff --git a/src/lua-vm/lauxlib.h b/src/lua-vm/lauxlib.h new file mode 100644 index 0000000..1f34308 --- /dev/null +++ b/src/lua-vm/lauxlib.h @@ -0,0 +1,174 @@ +/* +** $Id: lauxlib.h,v 1.88 2006/04/12 20:31:15 roberto Exp $ +** Auxiliary functions for building Lua libraries +** See Copyright Notice in lua.h +*/ + + +#ifndef lauxlib_h +#define lauxlib_h + + +#include +#include + +#include "lua.h" + + +#if defined(LUA_COMPAT_GETN) +LUALIB_API int (luaL_getn) (lua_State *L, int t); +LUALIB_API void (luaL_setn) (lua_State *L, int t, int n); +#else +#define luaL_getn(L,i) ((int)lua_objlen(L, i)) +#define luaL_setn(L,i,j) ((void)0) /* no op! */ +#endif + +#if defined(LUA_COMPAT_OPENLIB) +#define luaI_openlib luaL_openlib +#endif + + +/* extra error code for `luaL_load' */ +#define LUA_ERRFILE (LUA_ERRERR+1) + + +typedef struct luaL_Reg { + const char *name; + lua_CFunction func; +} luaL_Reg; + + + +LUALIB_API void (luaI_openlib) (lua_State *L, const char *libname, + const luaL_Reg *l, int nup); +LUALIB_API void (luaL_register) (lua_State *L, const char *libname, + const luaL_Reg *l); +LUALIB_API int (luaL_getmetafield) (lua_State *L, int obj, const char *e); +LUALIB_API int (luaL_callmeta) (lua_State *L, int obj, const char *e); +LUALIB_API int (luaL_typerror) (lua_State *L, int narg, const char *tname); +LUALIB_API int (luaL_argerror) (lua_State *L, int numarg, const char *extramsg); +LUALIB_API const char *(luaL_checklstring) (lua_State *L, int numArg, + size_t *l); +LUALIB_API const char *(luaL_optlstring) (lua_State *L, int numArg, + const char *def, size_t *l); +LUALIB_API lua_Number (luaL_checknumber) (lua_State *L, int numArg); +LUALIB_API lua_Number (luaL_optnumber) (lua_State *L, int nArg, lua_Number def); + +LUALIB_API lua_Integer (luaL_checkinteger) (lua_State *L, int numArg); +LUALIB_API lua_Integer (luaL_optinteger) (lua_State *L, int nArg, + lua_Integer def); + +LUALIB_API void (luaL_checkstack) (lua_State *L, int sz, const char *msg); +LUALIB_API void (luaL_checktype) (lua_State *L, int narg, int t); +LUALIB_API void (luaL_checkany) (lua_State *L, int narg); + +LUALIB_API int (luaL_newmetatable) (lua_State *L, const char *tname); +LUALIB_API void *(luaL_checkudata) (lua_State *L, int ud, const char *tname); + +LUALIB_API void (luaL_where) (lua_State *L, int lvl); +LUALIB_API int (luaL_error) (lua_State *L, const char *fmt, ...); + +LUALIB_API int (luaL_checkoption) (lua_State *L, int narg, const char *def, + const char *const lst[]); + +LUALIB_API int (luaL_ref) (lua_State *L, int t); +LUALIB_API void (luaL_unref) (lua_State *L, int t, int ref); + +LUALIB_API int (luaL_loadfile) (lua_State *L, const char *filename); +LUALIB_API int (luaL_loadbuffer) (lua_State *L, const char *buff, size_t sz, + const char *name); +LUALIB_API int (luaL_loadstring) (lua_State *L, const char *s); + +LUALIB_API lua_State *(luaL_newstate) (void); + + +LUALIB_API const char *(luaL_gsub) (lua_State *L, const char *s, const char *p, + const char *r); + +LUALIB_API const char *(luaL_findtable) (lua_State *L, int idx, + const char *fname, int szhint); + + + + +/* +** =============================================================== +** some useful macros +** =============================================================== +*/ + +#define luaL_argcheck(L, cond,numarg,extramsg) \ + ((void)((cond) || luaL_argerror(L, (numarg), (extramsg)))) +#define luaL_checkstring(L,n) (luaL_checklstring(L, (n), NULL)) +#define luaL_optstring(L,n,d) (luaL_optlstring(L, (n), (d), NULL)) +#define luaL_checkint(L,n) ((int)luaL_checkinteger(L, (n))) +#define luaL_optint(L,n,d) ((int)luaL_optinteger(L, (n), (d))) +#define luaL_checklong(L,n) ((long)luaL_checkinteger(L, (n))) +#define luaL_optlong(L,n,d) ((long)luaL_optinteger(L, (n), (d))) + +#define luaL_typename(L,i) lua_typename(L, lua_type(L,(i))) + +#define luaL_dofile(L, fn) \ + (luaL_loadfile(L, fn) || lua_pcall(L, 0, LUA_MULTRET, 0)) + +#define luaL_dostring(L, s) \ + (luaL_loadstring(L, s) || lua_pcall(L, 0, LUA_MULTRET, 0)) + +#define luaL_getmetatable(L,n) (lua_getfield(L, LUA_REGISTRYINDEX, (n))) + +#define luaL_opt(L,f,n,d) (lua_isnoneornil(L,(n)) ? (d) : f(L,(n))) + +/* +** {====================================================== +** Generic Buffer manipulation +** ======================================================= +*/ + + + +typedef struct luaL_Buffer { + char *p; /* current position in buffer */ + int lvl; /* number of strings in the stack (level) */ + lua_State *L; + char buffer[LUAL_BUFFERSIZE]; +} luaL_Buffer; + +#define luaL_addchar(B,c) \ + ((void)((B)->p < ((B)->buffer+LUAL_BUFFERSIZE) || luaL_prepbuffer(B)), \ + (*(B)->p++ = (char)(c))) + +/* compatibility only */ +#define luaL_putchar(B,c) luaL_addchar(B,c) + +#define luaL_addsize(B,n) ((B)->p += (n)) + +LUALIB_API void (luaL_buffinit) (lua_State *L, luaL_Buffer *B); +LUALIB_API char *(luaL_prepbuffer) (luaL_Buffer *B); +LUALIB_API void (luaL_addlstring) (luaL_Buffer *B, const char *s, size_t l); +LUALIB_API void (luaL_addstring) (luaL_Buffer *B, const char *s); +LUALIB_API void (luaL_addvalue) (luaL_Buffer *B); +LUALIB_API void (luaL_pushresult) (luaL_Buffer *B); + + +/* }====================================================== */ + + +/* compatibility with ref system */ + +/* pre-defined references */ +#define LUA_NOREF (-2) +#define LUA_REFNIL (-1) + +#define lua_ref(L,lock) ((lock) ? luaL_ref(L, LUA_REGISTRYINDEX) : \ + (lua_pushstring(L, "unlocked references are obsolete"), lua_error(L), 0)) + +#define lua_unref(L,ref) luaL_unref(L, LUA_REGISTRYINDEX, (ref)) + +#define lua_getref(L,ref) lua_rawgeti(L, LUA_REGISTRYINDEX, (ref)) + + +#define luaL_reg luaL_Reg + +#endif + + diff --git a/src/lua-vm/lbaselib.c b/src/lua-vm/lbaselib.c new file mode 100644 index 0000000..c0e6212 --- /dev/null +++ b/src/lua-vm/lbaselib.c @@ -0,0 +1,682 @@ +/* +** $Id: lbaselib.c,v 1.191a 2006/06/02 15:34:00 roberto Exp $ +** Basic library +** See Copyright Notice in lua.h +*/ + + + +#include +#include +#include +#include + +#define lbaselib_c +#define LUA_LIB + +#include "lua.h" + +#include "lauxlib.h" +#include "lualib.h" + + + + +/* +** If your system does not support `stdout', you can just remove this function. +** If you need, you can define your own `print' function, following this +** model but changing `fputs' to put the strings at a proper place +** (a console window or a log file, for instance). +*/ +static int luaB_print (lua_State *L) { + int n = lua_gettop(L); /* number of arguments */ + int i; + lua_getglobal(L, "tostring"); + for (i=1; i<=n; i++) { + const char *s; + lua_pushvalue(L, -1); /* function to be called */ + lua_pushvalue(L, i); /* value to print */ + lua_call(L, 1, 1); + s = lua_tostring(L, -1); /* get result */ + if (s == NULL) + return luaL_error(L, LUA_QL("tostring") " must return a string to " + LUA_QL("print")); + if (i>1) fputs("\t", stdout); + fputs(s, stdout); + lua_pop(L, 1); /* pop result */ + } + fputs("\n", stdout); + return 0; +} + + +static int luaB_tonumber (lua_State *L) { + int base = luaL_optint(L, 2, 10); + if (base == 10) { /* standard conversion */ + luaL_checkany(L, 1); + if (lua_isnumber(L, 1)) { + lua_pushnumber(L, lua_tonumber(L, 1)); + return 1; + } + } + else { + const char *s1 = luaL_checkstring(L, 1); + char *s2; + unsigned long n; + luaL_argcheck(L, 2 <= base && base <= 36, 2, "base out of range"); + n = strtoul(s1, &s2, base); + if (s1 != s2) { /* at least one valid digit? */ + while (isspace((unsigned char)(*s2))) s2++; /* skip trailing spaces */ + if (*s2 == '\0') { /* no invalid trailing characters? */ + lua_pushnumber(L, (lua_Number)n); + return 1; + } + } + } + lua_pushnil(L); /* else not a number */ + return 1; +} + + +static int luaB_error (lua_State *L) { + int level = luaL_optint(L, 2, 1); + lua_settop(L, 1); + if (lua_isstring(L, 1) && level > 0) { /* add extra information? */ + luaL_where(L, level); + lua_pushvalue(L, 1); + lua_concat(L, 2); + } + return lua_error(L); +} + + +static int luaB_getmetatable (lua_State *L) { + luaL_checkany(L, 1); + if (!lua_getmetatable(L, 1)) { + lua_pushnil(L); + return 1; /* no metatable */ + } + luaL_getmetafield(L, 1, "__metatable"); + return 1; /* returns either __metatable field (if present) or metatable */ +} + + +static int luaB_setmetatable (lua_State *L) { + int t = lua_type(L, 2); + luaL_checktype(L, 1, LUA_TTABLE); + luaL_argcheck(L, t == LUA_TNIL || t == LUA_TTABLE, 2, + "nil or table expected"); + if (luaL_getmetafield(L, 1, "__metatable")) + luaL_error(L, "cannot change a protected metatable"); + lua_settop(L, 2); + lua_setmetatable(L, 1); + return 1; +} + + +static void getfunc (lua_State *L, int opt) { + if (lua_isfunction(L, 1)) lua_pushvalue(L, 1); + else { + lua_Debug ar; + int level = opt ? luaL_optint(L, 1, 1) : luaL_checkint(L, 1); + luaL_argcheck(L, level >= 0, 1, "level must be non-negative"); + if (lua_getstack(L, level, &ar) == 0) + luaL_argerror(L, 1, "invalid level"); + lua_getinfo(L, "f", &ar); + if (lua_isnil(L, -1)) + luaL_error(L, "no function environment for tail call at level %d", + level); + } +} + + +static int luaB_getfenv (lua_State *L) { + getfunc(L, 1); + if (lua_iscfunction(L, -1)) /* is a C function? */ + lua_pushvalue(L, LUA_GLOBALSINDEX); /* return the thread's global env. */ + else + lua_getfenv(L, -1); + return 1; +} + +static int luaB_setfenv (lua_State *L) { + luaL_checktype(L, 2, LUA_TTABLE); + getfunc(L, 0); + lua_pushvalue(L, 2); + if (lua_isnumber(L, 1) && lua_tonumber(L, 1) == 0) { + /* change environment of current thread */ + lua_pushthread(L); + lua_insert(L, -2); + lua_setfenv(L, -2); + return 0; + } + else if (lua_iscfunction(L, -2) || lua_setfenv(L, -2) == 0) + luaL_error(L, + LUA_QL("setfenv") " cannot change environment of given object"); + return 1; +} + +static int luaB_initfenv (lua_State *L) { + luaL_openlibs( L); + return 0; +} + +static int luaB_rawequal (lua_State *L) { + luaL_checkany(L, 1); + luaL_checkany(L, 2); + lua_pushboolean(L, lua_rawequal(L, 1, 2)); + return 1; +} + + +static int luaB_rawget (lua_State *L) { + luaL_checktype(L, 1, LUA_TTABLE); + luaL_checkany(L, 2); + lua_settop(L, 2); + lua_rawget(L, 1); + return 1; +} + +static int luaB_rawset (lua_State *L) { + luaL_checktype(L, 1, LUA_TTABLE); + luaL_checkany(L, 2); + luaL_checkany(L, 3); + lua_settop(L, 3); + lua_rawset(L, 1); + return 1; +} + + +static int luaB_gcinfo (lua_State *L) { + lua_pushinteger(L, lua_getgccount(L)); + return 1; +} + + +static int luaB_collectgarbage (lua_State *L) { + static const char *const opts[] = {"stop", "restart", "collect", + "count", "step", "setpause", "setstepmul", NULL}; + static const int optsnum[] = {LUA_GCSTOP, LUA_GCRESTART, LUA_GCCOLLECT, + LUA_GCCOUNT, LUA_GCSTEP, LUA_GCSETPAUSE, LUA_GCSETSTEPMUL}; + int o = luaL_checkoption(L, 1, "collect", opts); + int ex = luaL_optint(L, 2, 0); + int res = lua_gc(L, optsnum[o], ex); + switch (optsnum[o]) { + case LUA_GCCOUNT: { + int b = lua_gc(L, LUA_GCCOUNTB, 0); + lua_pushnumber(L, res + ((lua_Number)b/1024)); + return 1; + } + case LUA_GCSTEP: { + lua_pushboolean(L, res); + return 1; + } + default: { + lua_pushnumber(L, res); + return 1; + } + } +} + + +static int luaB_type (lua_State *L) { + luaL_checkany(L, 1); + lua_pushstring(L, luaL_typename(L, 1)); + return 1; +} + + +static int luaB_next (lua_State *L) { + luaL_checktype(L, 1, LUA_TTABLE); + lua_settop(L, 2); /* create a 2nd argument if there isn't one */ + if (lua_next(L, 1)) + return 2; + else { + lua_pushnil(L); + return 1; + } +} + + +static int luaB_pairs (lua_State *L) { + luaL_checktype(L, 1, LUA_TTABLE); + lua_pushvalue(L, lua_upvalueindex(1)); /* return generator, */ + lua_pushvalue(L, 1); /* state, */ + lua_pushnil(L); /* and initial value */ + return 3; +} + + +static int ipairsaux (lua_State *L) { + int i = luaL_checkint(L, 2); + luaL_checktype(L, 1, LUA_TTABLE); + i++; /* next value */ + lua_pushinteger(L, i); + lua_rawgeti(L, 1, i); + return (lua_isnil(L, -1)) ? 0 : 2; +} + + +static int luaB_ipairs (lua_State *L) { + luaL_checktype(L, 1, LUA_TTABLE); + lua_pushvalue(L, lua_upvalueindex(1)); /* return generator, */ + lua_pushvalue(L, 1); /* state, */ + lua_pushinteger(L, 0); /* and initial value */ + return 3; +} + + +static int load_aux (lua_State *L, int status) { + if (status == 0) /* OK? */ + return 1; + else { + lua_pushnil(L); + lua_insert(L, -2); /* put before error message */ + return 2; /* return nil plus error message */ + } +} + + +static int luaB_loadstring (lua_State *L) { + size_t l; + const char *s = luaL_checklstring(L, 1, &l); + const char *chunkname = luaL_optstring(L, 2, s); + //FIXME: no way to set the name! + return load_aux(L, luaL_loadstring(L, s)); + // Was loadbuffer, but loadbuffer isn't patched to + // use a custom compiler. + //return load_aux(L, luaL_loadbuffer(L, s, l, chunkname)); +} + + +static int luaB_loadfile (lua_State *L) { + const char *fname = luaL_optstring(L, 1, NULL); + return load_aux(L, luaL_loadfile(L, fname)); +} + + +/* +** Reader for generic `load' function: `lua_load' uses the +** stack for internal stuff, so the reader cannot change the +** stack top. Instead, it keeps its resulting string in a +** reserved slot inside the stack. +*/ +static const char *generic_reader (lua_State *L, void *ud, size_t *size) { + (void)ud; /* to avoid warnings */ + luaL_checkstack(L, 2, "too many nested functions"); + lua_pushvalue(L, 1); /* get function */ + lua_call(L, 0, 1); /* call it */ + if (lua_isnil(L, -1)) { + *size = 0; + return NULL; + } + else if (lua_isstring(L, -1)) { + lua_replace(L, 3); /* save string in a reserved stack slot */ + return lua_tolstring(L, 3, size); + } + else luaL_error(L, "reader function must return a string"); + return NULL; /* to avoid warnings */ +} + + +static int luaB_load (lua_State *L) { + int status; + const char *cname = luaL_optstring(L, 2, "=(load)"); + luaL_checktype(L, 1, LUA_TFUNCTION); + lua_settop(L, 3); /* function, eventual name, plus one reserved slot */ + status = lua_load(L, generic_reader, NULL, cname); + return load_aux(L, status); +} + + +static int luaB_dofile (lua_State *L) { + const char *fname = luaL_optstring(L, 1, NULL); + int n = lua_gettop(L); + if (luaL_loadfile(L, fname) != 0) lua_error(L); + lua_call(L, 0, LUA_MULTRET); + return lua_gettop(L) - n; +} + + +static int luaB_assert (lua_State *L) { + luaL_checkany(L, 1); + if (!lua_toboolean(L, 1)) + return luaL_error(L, "%s", luaL_optstring(L, 2, "assertion failed!")); + return lua_gettop(L); +} + + +static int luaB_unpack (lua_State *L) { + int i, e, n; + luaL_checktype(L, 1, LUA_TTABLE); + i = luaL_optint(L, 2, 1); + e = luaL_opt(L, luaL_checkint, 3, luaL_getn(L, 1)); + n = e - i + 1; /* number of elements */ + if (n <= 0) return 0; /* empty range */ + luaL_checkstack(L, n, "table too big to unpack"); + for (; i<=e; i++) /* push arg[i...e] */ + lua_rawgeti(L, 1, i); + return n; +} + + +static int luaB_select (lua_State *L) { + int n = lua_gettop(L); + if (lua_type(L, 1) == LUA_TSTRING && *lua_tostring(L, 1) == '#') { + lua_pushinteger(L, n-1); + return 1; + } + else { + int i = luaL_checkint(L, 1); + if (i < 0) i = n + i; + else if (i > n) i = n; + luaL_argcheck(L, 1 <= i, 1, "index out of range"); + return n - i; + } +} + + +static int luaB_pcall (lua_State *L) { + int status; + luaL_checkany(L, 1); + status = lua_pcall(L, lua_gettop(L) - 1, LUA_MULTRET, 0); + lua_pushboolean(L, (status == 0)); + lua_insert(L, 1); + return lua_gettop(L); /* return status + all results */ +} + + +static int luaB_xpcall (lua_State *L) { + int status; + luaL_checkany(L, 2); + lua_settop(L, 2); + lua_insert(L, 1); /* put error function under function to be called */ + status = lua_pcall(L, 0, LUA_MULTRET, 1); + lua_pushboolean(L, (status == 0)); + lua_replace(L, 1); + return lua_gettop(L); /* return status + all results */ +} + + +static int luaB_tostring (lua_State *L) { + luaL_checkany(L, 1); + if (luaL_callmeta(L, 1, "__tostring")) /* is there a metafield? */ + return 1; /* use its value */ + switch (lua_type(L, 1)) { + case LUA_TNUMBER: + lua_pushstring(L, lua_tostring(L, 1)); + break; + case LUA_TSTRING: + lua_pushvalue(L, 1); + break; + case LUA_TBOOLEAN: + lua_pushstring(L, (lua_toboolean(L, 1) ? "true" : "false")); + break; + case LUA_TNIL: + lua_pushliteral(L, "nil"); + break; + default: + lua_pushfstring(L, "%s: %p", luaL_typename(L, 1), lua_topointer(L, 1)); + break; + } + return 1; +} + + +static int luaB_newproxy (lua_State *L) { + lua_settop(L, 1); + lua_newuserdata(L, 0); /* create proxy */ + if (lua_toboolean(L, 1) == 0) + return 1; /* no metatable */ + else if (lua_isboolean(L, 1)) { + lua_newtable(L); /* create a new metatable `m' ... */ + lua_pushvalue(L, -1); /* ... and mark `m' as a valid metatable */ + lua_pushboolean(L, 1); + lua_rawset(L, lua_upvalueindex(1)); /* weaktable[m] = true */ + } + else { + int validproxy = 0; /* to check if weaktable[metatable(u)] == true */ + if (lua_getmetatable(L, 1)) { + lua_rawget(L, lua_upvalueindex(1)); + validproxy = lua_toboolean(L, -1); + lua_pop(L, 1); /* remove value */ + } + luaL_argcheck(L, validproxy, 1, "boolean or proxy expected"); + lua_getmetatable(L, 1); /* metatable is valid; get it */ + } + lua_setmetatable(L, 2); + return 1; +} + +/* Binary string undump */ + +struct LoadS { const char *s; size_t size; }; + +static const char *getS (lua_State *L, void *ud, size_t *size) { + struct LoadS *ls = (struct LoadS *)ud; + (void) L; + if (ls->size == 0) return NULL; + *size = ls->size; + ls->size = 0; + return ls->s; +} + +static int luaB_undump( lua_State *L) { + struct LoadS ls; + ls.s = luaL_checklstring( L, 1, & ls.size); + if( LUA_SIGNATURE[0] != ls.s[0]) { + lua_pushstring( L, "undump: not a dump string"); + lua_error( L); + } + if( lua_load( L, getS, & ls, luaL_optstring( L, 2, NULL))) { + lua_error( L); + } + return 1; +} + +/* End of binary string undump */ + + +static const luaL_Reg base_funcs[] = { + {"assert", luaB_assert}, + {"collectgarbage", luaB_collectgarbage}, + {"dofile", luaB_dofile}, + {"error", luaB_error}, + {"gcinfo", luaB_gcinfo}, + {"getfenv", luaB_getfenv}, + {"getmetatable", luaB_getmetatable}, + {"initfenv", luaB_initfenv}, + {"loadfile", luaB_loadfile}, + {"load", luaB_load}, + {"loadstring", luaB_loadstring}, + {"next", luaB_next}, + {"pcall", luaB_pcall}, + {"print", luaB_print}, + {"rawequal", luaB_rawequal}, + {"rawget", luaB_rawget}, + {"rawset", luaB_rawset}, + {"select", luaB_select}, + {"setfenv", luaB_setfenv}, + {"setmetatable", luaB_setmetatable}, + {"tonumber", luaB_tonumber}, + {"tostring", luaB_tostring}, + {"rawtype", luaB_type}, + {"unpack", luaB_unpack}, + {"xpcall", luaB_xpcall}, + {"undump", luaB_undump}, + {NULL, NULL} +}; + + +/* +** {====================================================== +** Coroutine library +** ======================================================= +*/ + +static int auxresume (lua_State *L, lua_State *co, int narg) { + int status; + if (!lua_checkstack(co, narg)) + luaL_error(L, "too many arguments to resume"); + if (lua_status(co) == 0 && lua_gettop(co) == 0) { + lua_pushliteral(L, "cannot resume dead coroutine"); + return -1; /* error flag */ + } + lua_xmove(L, co, narg); + status = lua_resume(co, narg); + if (status == 0 || status == LUA_YIELD) { + int nres = lua_gettop(co); + if (!lua_checkstack(L, nres)) + luaL_error(L, "too many results to resume"); + lua_xmove(co, L, nres); /* move yielded values */ + return nres; + } + else { + lua_xmove(co, L, 1); /* move error message */ + return -1; /* error flag */ + } +} + + +static int luaB_coresume (lua_State *L) { + lua_State *co = lua_tothread(L, 1); + int r; + luaL_argcheck(L, co, 1, "coroutine expected"); + r = auxresume(L, co, lua_gettop(L) - 1); + if (r < 0) { + lua_pushboolean(L, 0); + lua_insert(L, -2); + return 2; /* return false + error message */ + } + else { + lua_pushboolean(L, 1); + lua_insert(L, -(r + 1)); + return r + 1; /* return true + `resume' returns */ + } +} + + +static int luaB_auxwrap (lua_State *L) { + lua_State *co = lua_tothread(L, lua_upvalueindex(1)); + int r = auxresume(L, co, lua_gettop(L)); + if (r < 0) { + if (lua_isstring(L, -1)) { /* error object is a string? */ + luaL_where(L, 1); /* add extra info */ + lua_insert(L, -2); + lua_concat(L, 2); + } + lua_error(L); /* propagate error */ + } + return r; +} + + +static int luaB_cocreate (lua_State *L) { + lua_State *NL = lua_newthread(L); + luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1), 1, + "Lua function expected"); + lua_pushvalue(L, 1); /* move function to top */ + lua_xmove(L, NL, 1); /* move function from L to NL */ + return 1; +} + + +static int luaB_cowrap (lua_State *L) { + luaB_cocreate(L); + lua_pushcclosure(L, luaB_auxwrap, 1); + return 1; +} + + +static int luaB_yield (lua_State *L) { + return lua_yield(L, lua_gettop(L)); +} + + +static int luaB_costatus (lua_State *L) { + lua_State *co = lua_tothread(L, 1); + luaL_argcheck(L, co, 1, "coroutine expected"); + if (L == co) lua_pushliteral(L, "running"); + else { + switch (lua_status(co)) { + case LUA_YIELD: + lua_pushliteral(L, "suspended"); + break; + case 0: { + lua_Debug ar; + if (lua_getstack(co, 0, &ar) > 0) /* does it have frames? */ + lua_pushliteral(L, "normal"); /* it is running */ + else if (lua_gettop(co) == 0) + lua_pushliteral(L, "dead"); + else + lua_pushliteral(L, "suspended"); /* initial state */ + break; + } + default: /* some error occured */ + lua_pushliteral(L, "dead"); + break; + } + } + return 1; +} + + +static int luaB_corunning (lua_State *L) { + if (lua_pushthread(L)) + return 0; /* main thread is not a coroutine */ + else + return 1; +} + + +static const luaL_Reg co_funcs[] = { + {"create", luaB_cocreate}, + {"resume", luaB_coresume}, + {"running", luaB_corunning}, + {"status", luaB_costatus}, + {"wrap", luaB_cowrap}, + {"yield", luaB_yield}, + {NULL, NULL} +}; + +/* }====================================================== */ + + +static void auxopen (lua_State *L, const char *name, + lua_CFunction f, lua_CFunction u) { + lua_pushcfunction(L, u); + lua_pushcclosure(L, f, 1); + lua_setfield(L, -2, name); +} + + +static void base_open (lua_State *L) { + /* set global _G */ + lua_pushvalue(L, LUA_GLOBALSINDEX); + lua_setglobal(L, "_G"); + /* open lib into global table */ + luaL_register(L, "_G", base_funcs); + lua_pushliteral(L, LUA_VERSION); + lua_setglobal(L, "_VERSION"); /* set global _VERSION */ + /* `ipairs' and `pairs' need auxliliary functions as upvalues */ + auxopen(L, "rawipairs", luaB_ipairs, ipairsaux); + auxopen(L, "rawpairs", luaB_pairs, luaB_next); + /* `newproxy' needs a weaktable as upvalue */ + lua_createtable(L, 0, 1); /* new table `w' */ + lua_pushvalue(L, -1); /* `w' will be its own metatable */ + lua_setmetatable(L, -2); + lua_pushliteral(L, "kv"); + lua_setfield(L, -2, "__mode"); /* metatable(w).__mode = "kv" */ + lua_pushcclosure(L, luaB_newproxy, 1); + lua_setglobal(L, "newproxy"); /* set global `newproxy' */ +} + + +LUALIB_API int luaopen_base (lua_State *L) { + base_open(L); + luaL_register(L, LUA_COLIBNAME, co_funcs); + return 2; +} + + + diff --git a/src/lua-vm/lcode.c b/src/lua-vm/lcode.c new file mode 100644 index 0000000..9ce515a --- /dev/null +++ b/src/lua-vm/lcode.c @@ -0,0 +1,839 @@ +/* +** $Id: lcode.c,v 2.25a 2006/03/21 19:28:49 roberto Exp $ +** Code generator for Lua +** See Copyright Notice in lua.h +*/ + + +#include + +#define lcode_c +#define LUA_CORE + +#include "lua.h" + +#include "lcode.h" +#include "ldebug.h" +#include "ldo.h" +#include "lgc.h" +#include "llex.h" +#include "lmem.h" +#include "lobject.h" +#include "lopcodes.h" +#include "lparser.h" +#include "ltable.h" + + +#define hasjumps(e) ((e)->t != (e)->f) + + +static int isnumeral(expdesc *e) { + return (e->k == VKNUM && e->t == NO_JUMP && e->f == NO_JUMP); +} + + +void luaK_nil (FuncState *fs, int from, int n) { + Instruction *previous; + if (fs->pc > fs->lasttarget) { /* no jumps to current position? */ + if (fs->pc == 0) { /* function start? */ + if (from >= fs->nactvar) + return; /* positions are already clean */ + } + else { + previous = &fs->f->code[fs->pc-1]; + if (GET_OPCODE(*previous) == OP_LOADNIL) { + int pfrom = GETARG_A(*previous); + int pto = GETARG_B(*previous); + if (pfrom <= from && from <= pto+1) { /* can connect both? */ + if (from+n-1 > pto) + SETARG_B(*previous, from+n-1); + return; + } + } + } + } + luaK_codeABC(fs, OP_LOADNIL, from, from+n-1, 0); /* else no optimization */ +} + + +int luaK_jump (FuncState *fs) { + int jpc = fs->jpc; /* save list of jumps to here */ + int j; + fs->jpc = NO_JUMP; + j = luaK_codeAsBx(fs, OP_JMP, 0, NO_JUMP); + luaK_concat(fs, &j, jpc); /* keep them on hold */ + return j; +} + + +void luaK_ret (FuncState *fs, int first, int nret) { + luaK_codeABC(fs, OP_RETURN, first, nret+1, 0); +} + + +static int condjump (FuncState *fs, OpCode op, int A, int B, int C) { + luaK_codeABC(fs, op, A, B, C); + return luaK_jump(fs); +} + + +static void fixjump (FuncState *fs, int pc, int dest) { + Instruction *jmp = &fs->f->code[pc]; + int offset = dest-(pc+1); + lua_assert(dest != NO_JUMP); + if (abs(offset) > MAXARG_sBx) + luaX_syntaxerror(fs->ls, "control structure too long"); + SETARG_sBx(*jmp, offset); +} + + +/* +** returns current `pc' and marks it as a jump target (to avoid wrong +** optimizations with consecutive instructions not in the same basic block). +*/ +int luaK_getlabel (FuncState *fs) { + fs->lasttarget = fs->pc; + return fs->pc; +} + + +static int getjump (FuncState *fs, int pc) { + int offset = GETARG_sBx(fs->f->code[pc]); + if (offset == NO_JUMP) /* point to itself represents end of list */ + return NO_JUMP; /* end of list */ + else + return (pc+1)+offset; /* turn offset into absolute position */ +} + + +static Instruction *getjumpcontrol (FuncState *fs, int pc) { + Instruction *pi = &fs->f->code[pc]; + if (pc >= 1 && testTMode(GET_OPCODE(*(pi-1)))) + return pi-1; + else + return pi; +} + + +/* +** check whether list has any jump that do not produce a value +** (or produce an inverted value) +*/ +static int need_value (FuncState *fs, int list) { + for (; list != NO_JUMP; list = getjump(fs, list)) { + Instruction i = *getjumpcontrol(fs, list); + if (GET_OPCODE(i) != OP_TESTSET) return 1; + } + return 0; /* not found */ +} + + +static int patchtestreg (FuncState *fs, int node, int reg) { + Instruction *i = getjumpcontrol(fs, node); + if (GET_OPCODE(*i) != OP_TESTSET) + return 0; /* cannot patch other instructions */ + if (reg != NO_REG && reg != GETARG_B(*i)) + SETARG_A(*i, reg); + else /* no register to put value or register already has the value */ + *i = CREATE_ABC(OP_TEST, GETARG_B(*i), 0, GETARG_C(*i)); + + return 1; +} + + +static void removevalues (FuncState *fs, int list) { + for (; list != NO_JUMP; list = getjump(fs, list)) + patchtestreg(fs, list, NO_REG); +} + + +static void patchlistaux (FuncState *fs, int list, int vtarget, int reg, + int dtarget) { + while (list != NO_JUMP) { + int next = getjump(fs, list); + if (patchtestreg(fs, list, reg)) + fixjump(fs, list, vtarget); + else + fixjump(fs, list, dtarget); /* jump to default target */ + list = next; + } +} + + +static void dischargejpc (FuncState *fs) { + patchlistaux(fs, fs->jpc, fs->pc, NO_REG, fs->pc); + fs->jpc = NO_JUMP; +} + + +void luaK_patchlist (FuncState *fs, int list, int target) { + if (target == fs->pc) + luaK_patchtohere(fs, list); + else { + lua_assert(target < fs->pc); + patchlistaux(fs, list, target, NO_REG, target); + } +} + + +void luaK_patchtohere (FuncState *fs, int list) { + luaK_getlabel(fs); + luaK_concat(fs, &fs->jpc, list); +} + + +void luaK_concat (FuncState *fs, int *l1, int l2) { + if (l2 == NO_JUMP) return; + else if (*l1 == NO_JUMP) + *l1 = l2; + else { + int list = *l1; + int next; + while ((next = getjump(fs, list)) != NO_JUMP) /* find last element */ + list = next; + fixjump(fs, list, l2); + } +} + + +void luaK_checkstack (FuncState *fs, int n) { + int newstack = fs->freereg + n; + if (newstack > fs->f->maxstacksize) { + if (newstack >= MAXSTACK) + luaX_syntaxerror(fs->ls, "function or expression too complex"); + fs->f->maxstacksize = cast_byte(newstack); + } +} + + +void luaK_reserveregs (FuncState *fs, int n) { + luaK_checkstack(fs, n); + fs->freereg += n; +} + + +static void freereg (FuncState *fs, int reg) { + if (!ISK(reg) && reg >= fs->nactvar) { + fs->freereg--; + lua_assert(reg == fs->freereg); + } +} + + +static void freeexp (FuncState *fs, expdesc *e) { + if (e->k == VNONRELOC) + freereg(fs, e->u.s.info); +} + + +static int addk (FuncState *fs, TValue *k, TValue *v) { + lua_State *L = fs->L; + TValue *idx = luaH_set(L, fs->h, k); + Proto *f = fs->f; + int oldsize = f->sizek; + if (ttisnumber(idx)) { + lua_assert(luaO_rawequalObj(&fs->f->k[cast_int(nvalue(idx))], v)); + return cast_int(nvalue(idx)); + } + else { /* constant not found; create a new entry */ + setnvalue(idx, cast_num(fs->nk)); + luaM_growvector(L, f->k, fs->nk, f->sizek, TValue, + MAXARG_Bx, "constant table overflow"); + while (oldsize < f->sizek) setnilvalue(&f->k[oldsize++]); + setobj(L, &f->k[fs->nk], v); + luaC_barrier(L, f, v); + return fs->nk++; + } +} + + +int luaK_stringK (FuncState *fs, TString *s) { + TValue o; + setsvalue(fs->L, &o, s); + return addk(fs, &o, &o); +} + + +int luaK_numberK (FuncState *fs, lua_Number r) { + TValue o; + setnvalue(&o, r); + return addk(fs, &o, &o); +} + + +static int boolK (FuncState *fs, int b) { + TValue o; + setbvalue(&o, b); + return addk(fs, &o, &o); +} + + +static int nilK (FuncState *fs) { + TValue k, v; + setnilvalue(&v); + /* cannot use nil as key; instead use table itself to represent nil */ + sethvalue(fs->L, &k, fs->h); + return addk(fs, &k, &v); +} + + +void luaK_setreturns (FuncState *fs, expdesc *e, int nresults) { + if (e->k == VCALL) { /* expression is an open function call? */ + SETARG_C(getcode(fs, e), nresults+1); + } + else if (e->k == VVARARG) { + SETARG_B(getcode(fs, e), nresults+1); + SETARG_A(getcode(fs, e), fs->freereg); + luaK_reserveregs(fs, 1); + } +} + + +void luaK_setoneret (FuncState *fs, expdesc *e) { + if (e->k == VCALL) { /* expression is an open function call? */ + e->k = VNONRELOC; + e->u.s.info = GETARG_A(getcode(fs, e)); + } + else if (e->k == VVARARG) { + SETARG_B(getcode(fs, e), 2); + e->k = VRELOCABLE; /* can relocate its simple result */ + } +} + + +void luaK_dischargevars (FuncState *fs, expdesc *e) { + switch (e->k) { + case VLOCAL: { + e->k = VNONRELOC; + break; + } + case VUPVAL: { + e->u.s.info = luaK_codeABC(fs, OP_GETUPVAL, 0, e->u.s.info, 0); + e->k = VRELOCABLE; + break; + } + case VGLOBAL: { + e->u.s.info = luaK_codeABx(fs, OP_GETGLOBAL, 0, e->u.s.info); + e->k = VRELOCABLE; + break; + } + case VINDEXED: { + freereg(fs, e->u.s.aux); + freereg(fs, e->u.s.info); + e->u.s.info = luaK_codeABC(fs, OP_GETTABLE, 0, e->u.s.info, e->u.s.aux); + e->k = VRELOCABLE; + break; + } + case VVARARG: + case VCALL: { + luaK_setoneret(fs, e); + break; + } + default: break; /* there is one value available (somewhere) */ + } +} + + +static int code_label (FuncState *fs, int A, int b, int jump) { + luaK_getlabel(fs); /* those instructions may be jump targets */ + return luaK_codeABC(fs, OP_LOADBOOL, A, b, jump); +} + + +static void discharge2reg (FuncState *fs, expdesc *e, int reg) { + luaK_dischargevars(fs, e); + switch (e->k) { + case VNIL: { + luaK_nil(fs, reg, 1); + break; + } + case VFALSE: case VTRUE: { + luaK_codeABC(fs, OP_LOADBOOL, reg, e->k == VTRUE, 0); + break; + } + case VK: { + luaK_codeABx(fs, OP_LOADK, reg, e->u.s.info); + break; + } + case VKNUM: { + luaK_codeABx(fs, OP_LOADK, reg, luaK_numberK(fs, e->u.nval)); + break; + } + case VRELOCABLE: { + Instruction *pc = &getcode(fs, e); + SETARG_A(*pc, reg); + break; + } + case VNONRELOC: { + if (reg != e->u.s.info) + luaK_codeABC(fs, OP_MOVE, reg, e->u.s.info, 0); + break; + } + default: { + lua_assert(e->k == VVOID || e->k == VJMP); + return; /* nothing to do... */ + } + } + e->u.s.info = reg; + e->k = VNONRELOC; +} + + +static void discharge2anyreg (FuncState *fs, expdesc *e) { + if (e->k != VNONRELOC) { + luaK_reserveregs(fs, 1); + discharge2reg(fs, e, fs->freereg-1); + } +} + + +static void exp2reg (FuncState *fs, expdesc *e, int reg) { + discharge2reg(fs, e, reg); + if (e->k == VJMP) + luaK_concat(fs, &e->t, e->u.s.info); /* put this jump in `t' list */ + if (hasjumps(e)) { + int final; /* position after whole expression */ + int p_f = NO_JUMP; /* position of an eventual LOAD false */ + int p_t = NO_JUMP; /* position of an eventual LOAD true */ + if (need_value(fs, e->t) || need_value(fs, e->f)) { + int fj = (e->k == VJMP) ? NO_JUMP : luaK_jump(fs); + p_f = code_label(fs, reg, 0, 1); + p_t = code_label(fs, reg, 1, 0); + luaK_patchtohere(fs, fj); + } + final = luaK_getlabel(fs); + patchlistaux(fs, e->f, final, reg, p_f); + patchlistaux(fs, e->t, final, reg, p_t); + } + e->f = e->t = NO_JUMP; + e->u.s.info = reg; + e->k = VNONRELOC; +} + + +void luaK_exp2nextreg (FuncState *fs, expdesc *e) { + luaK_dischargevars(fs, e); + freeexp(fs, e); + luaK_reserveregs(fs, 1); + exp2reg(fs, e, fs->freereg - 1); +} + + +int luaK_exp2anyreg (FuncState *fs, expdesc *e) { + luaK_dischargevars(fs, e); + if (e->k == VNONRELOC) { + if (!hasjumps(e)) return e->u.s.info; /* exp is already in a register */ + if (e->u.s.info >= fs->nactvar) { /* reg. is not a local? */ + exp2reg(fs, e, e->u.s.info); /* put value on it */ + return e->u.s.info; + } + } + luaK_exp2nextreg(fs, e); /* default */ + return e->u.s.info; +} + + +void luaK_exp2val (FuncState *fs, expdesc *e) { + if (hasjumps(e)) + luaK_exp2anyreg(fs, e); + else + luaK_dischargevars(fs, e); +} + + +int luaK_exp2RK (FuncState *fs, expdesc *e) { + luaK_exp2val(fs, e); + switch (e->k) { + case VKNUM: + case VTRUE: + case VFALSE: + case VNIL: { + if (fs->nk <= MAXINDEXRK) { /* constant fit in RK operand? */ + e->u.s.info = (e->k == VNIL) ? nilK(fs) : + (e->k == VKNUM) ? luaK_numberK(fs, e->u.nval) : + boolK(fs, (e->k == VTRUE)); + e->k = VK; + return RKASK(e->u.s.info); + } + else break; + } + case VK: { + if (e->u.s.info <= MAXINDEXRK) /* constant fit in argC? */ + return RKASK(e->u.s.info); + else break; + } + default: break; + } + /* not a constant in the right range: put it in a register */ + return luaK_exp2anyreg(fs, e); +} + + +void luaK_storevar (FuncState *fs, expdesc *var, expdesc *ex) { + switch (var->k) { + case VLOCAL: { + freeexp(fs, ex); + exp2reg(fs, ex, var->u.s.info); + return; + } + case VUPVAL: { + int e = luaK_exp2anyreg(fs, ex); + luaK_codeABC(fs, OP_SETUPVAL, e, var->u.s.info, 0); + break; + } + case VGLOBAL: { + int e = luaK_exp2anyreg(fs, ex); + luaK_codeABx(fs, OP_SETGLOBAL, e, var->u.s.info); + break; + } + case VINDEXED: { + int e = luaK_exp2RK(fs, ex); + luaK_codeABC(fs, OP_SETTABLE, var->u.s.info, var->u.s.aux, e); + break; + } + default: { + lua_assert(0); /* invalid var kind to store */ + break; + } + } + freeexp(fs, ex); +} + + +void luaK_self (FuncState *fs, expdesc *e, expdesc *key) { + int func; + luaK_exp2anyreg(fs, e); + freeexp(fs, e); + func = fs->freereg; + luaK_reserveregs(fs, 2); + luaK_codeABC(fs, OP_SELF, func, e->u.s.info, luaK_exp2RK(fs, key)); + freeexp(fs, key); + e->u.s.info = func; + e->k = VNONRELOC; +} + + +static void invertjump (FuncState *fs, expdesc *e) { + Instruction *pc = getjumpcontrol(fs, e->u.s.info); + lua_assert(testTMode(GET_OPCODE(*pc)) && GET_OPCODE(*pc) != OP_TESTSET && + GET_OPCODE(*pc) != OP_TEST); + SETARG_A(*pc, !(GETARG_A(*pc))); +} + + +static int jumponcond (FuncState *fs, expdesc *e, int cond) { + if (e->k == VRELOCABLE) { + Instruction ie = getcode(fs, e); + if (GET_OPCODE(ie) == OP_NOT) { + fs->pc--; /* remove previous OP_NOT */ + return condjump(fs, OP_TEST, GETARG_B(ie), 0, !cond); + } + /* else go through */ + } + discharge2anyreg(fs, e); + freeexp(fs, e); + return condjump(fs, OP_TESTSET, NO_REG, e->u.s.info, cond); +} + + +void luaK_goiftrue (FuncState *fs, expdesc *e) { + int pc; /* pc of last jump */ + luaK_dischargevars(fs, e); + switch (e->k) { + case VK: case VKNUM: case VTRUE: { + pc = NO_JUMP; /* always true; do nothing */ + break; + } + case VFALSE: { + pc = luaK_jump(fs); /* always jump */ + break; + } + case VJMP: { + invertjump(fs, e); + pc = e->u.s.info; + break; + } + default: { + pc = jumponcond(fs, e, 0); + break; + } + } + luaK_concat(fs, &e->f, pc); /* insert last jump in `f' list */ + luaK_patchtohere(fs, e->t); + e->t = NO_JUMP; +} + + +static void luaK_goiffalse (FuncState *fs, expdesc *e) { + int pc; /* pc of last jump */ + luaK_dischargevars(fs, e); + switch (e->k) { + case VNIL: case VFALSE: { + pc = NO_JUMP; /* always false; do nothing */ + break; + } + case VTRUE: { + pc = luaK_jump(fs); /* always jump */ + break; + } + case VJMP: { + pc = e->u.s.info; + break; + } + default: { + pc = jumponcond(fs, e, 1); + break; + } + } + luaK_concat(fs, &e->t, pc); /* insert last jump in `t' list */ + luaK_patchtohere(fs, e->f); + e->f = NO_JUMP; +} + + +static void codenot (FuncState *fs, expdesc *e) { + luaK_dischargevars(fs, e); + switch (e->k) { + case VNIL: case VFALSE: { + e->k = VTRUE; + break; + } + case VK: case VKNUM: case VTRUE: { + e->k = VFALSE; + break; + } + case VJMP: { + invertjump(fs, e); + break; + } + case VRELOCABLE: + case VNONRELOC: { + discharge2anyreg(fs, e); + freeexp(fs, e); + e->u.s.info = luaK_codeABC(fs, OP_NOT, 0, e->u.s.info, 0); + e->k = VRELOCABLE; + break; + } + default: { + lua_assert(0); /* cannot happen */ + break; + } + } + /* interchange true and false lists */ + { int temp = e->f; e->f = e->t; e->t = temp; } + removevalues(fs, e->f); + removevalues(fs, e->t); +} + + +void luaK_indexed (FuncState *fs, expdesc *t, expdesc *k) { + t->u.s.aux = luaK_exp2RK(fs, k); + t->k = VINDEXED; +} + + +static int constfolding (OpCode op, expdesc *e1, expdesc *e2) { + lua_Number v1, v2, r; + if (!isnumeral(e1) || !isnumeral(e2)) return 0; + v1 = e1->u.nval; + v2 = e2->u.nval; + switch (op) { + case OP_ADD: r = luai_numadd(v1, v2); break; + case OP_SUB: r = luai_numsub(v1, v2); break; + case OP_MUL: r = luai_nummul(v1, v2); break; + case OP_DIV: + if (v2 == 0) return 0; /* do not attempt to divide by 0 */ + r = luai_numdiv(v1, v2); break; + case OP_MOD: + if (v2 == 0) return 0; /* do not attempt to divide by 0 */ + r = luai_nummod(v1, v2); break; + case OP_POW: r = luai_numpow(v1, v2); break; + case OP_UNM: r = luai_numunm(v1); break; + case OP_LEN: return 0; /* no constant folding for 'len' */ + default: lua_assert(0); r = 0; break; + } + if (luai_numisnan(r)) return 0; /* do not attempt to produce NaN */ + e1->u.nval = r; + return 1; +} + + +static void codearith (FuncState *fs, OpCode op, expdesc *e1, expdesc *e2) { + if (constfolding(op, e1, e2)) + return; + else { + int o2 = (op != OP_UNM && op != OP_LEN) ? luaK_exp2RK(fs, e2) : 0; + int o1 = luaK_exp2RK(fs, e1); + if (o1 > o2) { + freeexp(fs, e1); + freeexp(fs, e2); + } + else { + freeexp(fs, e2); + freeexp(fs, e1); + } + e1->u.s.info = luaK_codeABC(fs, op, 0, o1, o2); + e1->k = VRELOCABLE; + } +} + + +static void codecomp (FuncState *fs, OpCode op, int cond, expdesc *e1, + expdesc *e2) { + int o1 = luaK_exp2RK(fs, e1); + int o2 = luaK_exp2RK(fs, e2); + freeexp(fs, e2); + freeexp(fs, e1); + if (cond == 0 && op != OP_EQ) { + int temp; /* exchange args to replace by `<' or `<=' */ + temp = o1; o1 = o2; o2 = temp; /* o1 <==> o2 */ + cond = 1; + } + e1->u.s.info = condjump(fs, op, cond, o1, o2); + e1->k = VJMP; +} + + +void luaK_prefix (FuncState *fs, UnOpr op, expdesc *e) { + expdesc e2; + e2.t = e2.f = NO_JUMP; e2.k = VKNUM; e2.u.nval = 0; + switch (op) { + case OPR_MINUS: { + if (e->k == VK) + luaK_exp2anyreg(fs, e); /* cannot operate on non-numeric constants */ + codearith(fs, OP_UNM, e, &e2); + break; + } + case OPR_NOT: codenot(fs, e); break; + case OPR_LEN: { + luaK_exp2anyreg(fs, e); /* cannot operate on constants */ + codearith(fs, OP_LEN, e, &e2); + break; + } + default: lua_assert(0); + } +} + + +void luaK_infix (FuncState *fs, BinOpr op, expdesc *v) { + switch (op) { + case OPR_AND: { + luaK_goiftrue(fs, v); + break; + } + case OPR_OR: { + luaK_goiffalse(fs, v); + break; + } + case OPR_CONCAT: { + luaK_exp2nextreg(fs, v); /* operand must be on the `stack' */ + break; + } + case OPR_ADD: case OPR_SUB: case OPR_MUL: case OPR_DIV: + case OPR_MOD: case OPR_POW: { + if (!isnumeral(v)) luaK_exp2RK(fs, v); + break; + } + default: { + luaK_exp2RK(fs, v); + break; + } + } +} + + +void luaK_posfix (FuncState *fs, BinOpr op, expdesc *e1, expdesc *e2) { + switch (op) { + case OPR_AND: { + lua_assert(e1->t == NO_JUMP); /* list must be closed */ + luaK_dischargevars(fs, e2); + luaK_concat(fs, &e2->f, e1->f); + *e1 = *e2; + break; + } + case OPR_OR: { + lua_assert(e1->f == NO_JUMP); /* list must be closed */ + luaK_dischargevars(fs, e2); + luaK_concat(fs, &e2->t, e1->t); + *e1 = *e2; + break; + } + case OPR_CONCAT: { + luaK_exp2val(fs, e2); + if (e2->k == VRELOCABLE && GET_OPCODE(getcode(fs, e2)) == OP_CONCAT) { + lua_assert(e1->u.s.info == GETARG_B(getcode(fs, e2))-1); + freeexp(fs, e1); + SETARG_B(getcode(fs, e2), e1->u.s.info); + e1->k = VRELOCABLE; e1->u.s.info = e2->u.s.info; + } + else { + luaK_exp2nextreg(fs, e2); /* operand must be on the 'stack' */ + codearith(fs, OP_CONCAT, e1, e2); + } + break; + } + case OPR_ADD: codearith(fs, OP_ADD, e1, e2); break; + case OPR_SUB: codearith(fs, OP_SUB, e1, e2); break; + case OPR_MUL: codearith(fs, OP_MUL, e1, e2); break; + case OPR_DIV: codearith(fs, OP_DIV, e1, e2); break; + case OPR_MOD: codearith(fs, OP_MOD, e1, e2); break; + case OPR_POW: codearith(fs, OP_POW, e1, e2); break; + case OPR_EQ: codecomp(fs, OP_EQ, 1, e1, e2); break; + case OPR_NE: codecomp(fs, OP_EQ, 0, e1, e2); break; + case OPR_LT: codecomp(fs, OP_LT, 1, e1, e2); break; + case OPR_LE: codecomp(fs, OP_LE, 1, e1, e2); break; + case OPR_GT: codecomp(fs, OP_LT, 0, e1, e2); break; + case OPR_GE: codecomp(fs, OP_LE, 0, e1, e2); break; + default: lua_assert(0); + } +} + + +void luaK_fixline (FuncState *fs, int line) { + fs->f->lineinfo[fs->pc - 1] = line; +} + + +static int luaK_code (FuncState *fs, Instruction i, int line) { + Proto *f = fs->f; + dischargejpc(fs); /* `pc' will change */ + /* put new instruction in code array */ + luaM_growvector(fs->L, f->code, fs->pc, f->sizecode, Instruction, + MAX_INT, "code size overflow"); + f->code[fs->pc] = i; + /* save corresponding line information */ + luaM_growvector(fs->L, f->lineinfo, fs->pc, f->sizelineinfo, int, + MAX_INT, "code size overflow"); + f->lineinfo[fs->pc] = line; + return fs->pc++; +} + + +int luaK_codeABC (FuncState *fs, OpCode o, int a, int b, int c) { + lua_assert(getOpMode(o) == iABC); + lua_assert(getBMode(o) != OpArgN || b == 0); + lua_assert(getCMode(o) != OpArgN || c == 0); + return luaK_code(fs, CREATE_ABC(o, a, b, c), fs->ls->lastline); +} + + +int luaK_codeABx (FuncState *fs, OpCode o, int a, unsigned int bc) { + lua_assert(getOpMode(o) == iABx || getOpMode(o) == iAsBx); + lua_assert(getCMode(o) == OpArgN); + return luaK_code(fs, CREATE_ABx(o, a, bc), fs->ls->lastline); +} + + +void luaK_setlist (FuncState *fs, int base, int nelems, int tostore) { + int c = (nelems - 1)/LFIELDS_PER_FLUSH + 1; + int b = (tostore == LUA_MULTRET) ? 0 : tostore; + lua_assert(tostore != 0); + if (c <= MAXARG_C) + luaK_codeABC(fs, OP_SETLIST, base, b, c); + else { + luaK_codeABC(fs, OP_SETLIST, base, b, 0); + luaK_code(fs, cast(Instruction, c), fs->ls->lastline); + } + fs->freereg = base + 1; /* free registers with list values */ +} + diff --git a/src/lua-vm/lcode.h b/src/lua-vm/lcode.h new file mode 100644 index 0000000..c02cb2b --- /dev/null +++ b/src/lua-vm/lcode.h @@ -0,0 +1,76 @@ +/* +** $Id: lcode.h,v 1.48 2006/03/21 19:28:03 roberto Exp $ +** Code generator for Lua +** See Copyright Notice in lua.h +*/ + +#ifndef lcode_h +#define lcode_h + +#include "llex.h" +#include "lobject.h" +#include "lopcodes.h" +#include "lparser.h" + + +/* +** Marks the end of a patch list. It is an invalid value both as an absolute +** address, and as a list link (would link an element to itself). +*/ +#define NO_JUMP (-1) + + +/* +** grep "ORDER OPR" if you change these enums +*/ +typedef enum BinOpr { + OPR_ADD, OPR_SUB, OPR_MUL, OPR_DIV, OPR_MOD, OPR_POW, + OPR_CONCAT, + OPR_NE, OPR_EQ, + OPR_LT, OPR_LE, OPR_GT, OPR_GE, + OPR_AND, OPR_OR, + OPR_NOBINOPR +} BinOpr; + + +typedef enum UnOpr { OPR_MINUS, OPR_NOT, OPR_LEN, OPR_NOUNOPR } UnOpr; + + +#define getcode(fs,e) ((fs)->f->code[(e)->u.s.info]) + +#define luaK_codeAsBx(fs,o,A,sBx) luaK_codeABx(fs,o,A,(sBx)+MAXARG_sBx) + +#define luaK_setmultret(fs,e) luaK_setreturns(fs, e, LUA_MULTRET) + +LUAI_FUNC int luaK_codeABx (FuncState *fs, OpCode o, int A, unsigned int Bx); +LUAI_FUNC int luaK_codeABC (FuncState *fs, OpCode o, int A, int B, int C); +LUAI_FUNC void luaK_fixline (FuncState *fs, int line); +LUAI_FUNC void luaK_nil (FuncState *fs, int from, int n); +LUAI_FUNC void luaK_reserveregs (FuncState *fs, int n); +LUAI_FUNC void luaK_checkstack (FuncState *fs, int n); +LUAI_FUNC int luaK_stringK (FuncState *fs, TString *s); +LUAI_FUNC int luaK_numberK (FuncState *fs, lua_Number r); +LUAI_FUNC void luaK_dischargevars (FuncState *fs, expdesc *e); +LUAI_FUNC int luaK_exp2anyreg (FuncState *fs, expdesc *e); +LUAI_FUNC void luaK_exp2nextreg (FuncState *fs, expdesc *e); +LUAI_FUNC void luaK_exp2val (FuncState *fs, expdesc *e); +LUAI_FUNC int luaK_exp2RK (FuncState *fs, expdesc *e); +LUAI_FUNC void luaK_self (FuncState *fs, expdesc *e, expdesc *key); +LUAI_FUNC void luaK_indexed (FuncState *fs, expdesc *t, expdesc *k); +LUAI_FUNC void luaK_goiftrue (FuncState *fs, expdesc *e); +LUAI_FUNC void luaK_storevar (FuncState *fs, expdesc *var, expdesc *e); +LUAI_FUNC void luaK_setreturns (FuncState *fs, expdesc *e, int nresults); +LUAI_FUNC void luaK_setoneret (FuncState *fs, expdesc *e); +LUAI_FUNC int luaK_jump (FuncState *fs); +LUAI_FUNC void luaK_ret (FuncState *fs, int first, int nret); +LUAI_FUNC void luaK_patchlist (FuncState *fs, int list, int target); +LUAI_FUNC void luaK_patchtohere (FuncState *fs, int list); +LUAI_FUNC void luaK_concat (FuncState *fs, int *l1, int l2); +LUAI_FUNC int luaK_getlabel (FuncState *fs); +LUAI_FUNC void luaK_prefix (FuncState *fs, UnOpr op, expdesc *v); +LUAI_FUNC void luaK_infix (FuncState *fs, BinOpr op, expdesc *v); +LUAI_FUNC void luaK_posfix (FuncState *fs, BinOpr op, expdesc *v1, expdesc *v2); +LUAI_FUNC void luaK_setlist (FuncState *fs, int base, int nelems, int tostore); + + +#endif diff --git a/src/lua-vm/ldblib.c b/src/lua-vm/ldblib.c new file mode 100644 index 0000000..26a19b6 --- /dev/null +++ b/src/lua-vm/ldblib.c @@ -0,0 +1,397 @@ +/* +** $Id: ldblib.c,v 1.104 2005/12/29 15:32:11 roberto Exp $ +** Interface from Lua to its debug API +** See Copyright Notice in lua.h +*/ + + +#include +#include +#include + +#define ldblib_c +#define LUA_LIB + +#include "lua.h" + +#include "lauxlib.h" +#include "lualib.h" + + + +static int db_getregistry (lua_State *L) { + lua_pushvalue(L, LUA_REGISTRYINDEX); + return 1; +} + + +static int db_getmetatable (lua_State *L) { + luaL_checkany(L, 1); + if (!lua_getmetatable(L, 1)) { + lua_pushnil(L); /* no metatable */ + } + return 1; +} + + +static int db_setmetatable (lua_State *L) { + int t = lua_type(L, 2); + luaL_argcheck(L, t == LUA_TNIL || t == LUA_TTABLE, 2, + "nil or table expected"); + lua_settop(L, 2); + lua_pushboolean(L, lua_setmetatable(L, 1)); + return 1; +} + + +static int db_getfenv (lua_State *L) { + lua_getfenv(L, 1); + return 1; +} + + +static int db_setfenv (lua_State *L) { + luaL_checktype(L, 2, LUA_TTABLE); + lua_settop(L, 2); + if (lua_setfenv(L, 1) == 0) + luaL_error(L, LUA_QL("setfenv") + " cannot change environment of given object"); + return 1; +} + + +static void settabss (lua_State *L, const char *i, const char *v) { + lua_pushstring(L, v); + lua_setfield(L, -2, i); +} + + +static void settabsi (lua_State *L, const char *i, int v) { + lua_pushinteger(L, v); + lua_setfield(L, -2, i); +} + + +static lua_State *getthread (lua_State *L, int *arg) { + if (lua_isthread(L, 1)) { + *arg = 1; + return lua_tothread(L, 1); + } + else { + *arg = 0; + return L; + } +} + + +static void treatstackoption (lua_State *L, lua_State *L1, const char *fname) { + if (L == L1) { + lua_pushvalue(L, -2); + lua_remove(L, -3); + } + else + lua_xmove(L1, L, 1); + lua_setfield(L, -2, fname); +} + + +static int db_getinfo (lua_State *L) { + lua_Debug ar; + int arg; + lua_State *L1 = getthread(L, &arg); + const char *options = luaL_optstring(L, arg+2, "flnSu"); + if (lua_isnumber(L, arg+1)) { + if (!lua_getstack(L1, (int)lua_tointeger(L, arg+1), &ar)) { + lua_pushnil(L); /* level out of range */ + return 1; + } + } + else if (lua_isfunction(L, arg+1)) { + lua_pushfstring(L, ">%s", options); + options = lua_tostring(L, -1); + lua_pushvalue(L, arg+1); + lua_xmove(L, L1, 1); + } + else + return luaL_argerror(L, arg+1, "function or level expected"); + if (!lua_getinfo(L1, options, &ar)) + return luaL_argerror(L, arg+2, "invalid option"); + lua_createtable(L, 0, 2); + if (strchr(options, 'S')) { + settabss(L, "source", ar.source); + settabss(L, "short_src", ar.short_src); + settabsi(L, "linedefined", ar.linedefined); + settabsi(L, "lastlinedefined", ar.lastlinedefined); + settabss(L, "what", ar.what); + } + if (strchr(options, 'l')) + settabsi(L, "currentline", ar.currentline); + if (strchr(options, 'u')) + settabsi(L, "nups", ar.nups); + if (strchr(options, 'n')) { + settabss(L, "name", ar.name); + settabss(L, "namewhat", ar.namewhat); + } + if (strchr(options, 'L')) + treatstackoption(L, L1, "activelines"); + if (strchr(options, 'f')) + treatstackoption(L, L1, "func"); + return 1; /* return table */ +} + + +static int db_getlocal (lua_State *L) { + int arg; + lua_State *L1 = getthread(L, &arg); + lua_Debug ar; + const char *name; + if (!lua_getstack(L1, luaL_checkint(L, arg+1), &ar)) /* out of range? */ + return luaL_argerror(L, arg+1, "level out of range"); + name = lua_getlocal(L1, &ar, luaL_checkint(L, arg+2)); + if (name) { + lua_xmove(L1, L, 1); + lua_pushstring(L, name); + lua_pushvalue(L, -2); + return 2; + } + else { + lua_pushnil(L); + return 1; + } +} + + +static int db_setlocal (lua_State *L) { + int arg; + lua_State *L1 = getthread(L, &arg); + lua_Debug ar; + if (!lua_getstack(L1, luaL_checkint(L, arg+1), &ar)) /* out of range? */ + return luaL_argerror(L, arg+1, "level out of range"); + luaL_checkany(L, arg+3); + lua_settop(L, arg+3); + lua_xmove(L, L1, 1); + lua_pushstring(L, lua_setlocal(L1, &ar, luaL_checkint(L, arg+2))); + return 1; +} + + +static int auxupvalue (lua_State *L, int get) { + const char *name; + int n = luaL_checkint(L, 2); + luaL_checktype(L, 1, LUA_TFUNCTION); + if (lua_iscfunction(L, 1)) return 0; /* cannot touch C upvalues from Lua */ + name = get ? lua_getupvalue(L, 1, n) : lua_setupvalue(L, 1, n); + if (name == NULL) return 0; + lua_pushstring(L, name); + lua_insert(L, -(get+1)); + return get + 1; +} + + +static int db_getupvalue (lua_State *L) { + return auxupvalue(L, 1); +} + + +static int db_setupvalue (lua_State *L) { + luaL_checkany(L, 3); + return auxupvalue(L, 0); +} + + + +static const char KEY_HOOK = 'h'; + + +static void hookf (lua_State *L, lua_Debug *ar) { + static const char *const hooknames[] = + {"call", "return", "line", "count", "tail return"}; + lua_pushlightuserdata(L, (void *)&KEY_HOOK); + lua_rawget(L, LUA_REGISTRYINDEX); + lua_pushlightuserdata(L, L); + lua_rawget(L, -2); + if (lua_isfunction(L, -1)) { + lua_pushstring(L, hooknames[(int)ar->event]); + if (ar->currentline >= 0) + lua_pushinteger(L, ar->currentline); + else lua_pushnil(L); + lua_assert(lua_getinfo(L, "lS", ar)); + lua_call(L, 2, 0); + } +} + + +static int makemask (const char *smask, int count) { + int mask = 0; + if (strchr(smask, 'c')) mask |= LUA_MASKCALL; + if (strchr(smask, 'r')) mask |= LUA_MASKRET; + if (strchr(smask, 'l')) mask |= LUA_MASKLINE; + if (count > 0) mask |= LUA_MASKCOUNT; + return mask; +} + + +static char *unmakemask (int mask, char *smask) { + int i = 0; + if (mask & LUA_MASKCALL) smask[i++] = 'c'; + if (mask & LUA_MASKRET) smask[i++] = 'r'; + if (mask & LUA_MASKLINE) smask[i++] = 'l'; + smask[i] = '\0'; + return smask; +} + + +static void gethooktable (lua_State *L) { + lua_pushlightuserdata(L, (void *)&KEY_HOOK); + lua_rawget(L, LUA_REGISTRYINDEX); + if (!lua_istable(L, -1)) { + lua_pop(L, 1); + lua_createtable(L, 0, 1); + lua_pushlightuserdata(L, (void *)&KEY_HOOK); + lua_pushvalue(L, -2); + lua_rawset(L, LUA_REGISTRYINDEX); + } +} + + +static int db_sethook (lua_State *L) { + int arg; + lua_State *L1 = getthread(L, &arg); + if (lua_isnoneornil(L, arg+1)) { + lua_settop(L, arg+1); + lua_sethook(L1, NULL, 0, 0); /* turn off hooks */ + } + else { + const char *smask = luaL_checkstring(L, arg+2); + int count = luaL_optint(L, arg+3, 0); + luaL_checktype(L, arg+1, LUA_TFUNCTION); + lua_sethook(L1, hookf, makemask(smask, count), count); + } + gethooktable(L1); + lua_pushlightuserdata(L1, L1); + lua_pushvalue(L, arg+1); + lua_xmove(L, L1, 1); + lua_rawset(L1, -3); /* set new hook */ + lua_pop(L1, 1); /* remove hook table */ + return 0; +} + + +static int db_gethook (lua_State *L) { + int arg; + lua_State *L1 = getthread(L, &arg); + char buff[5]; + int mask = lua_gethookmask(L1); + lua_Hook hook = lua_gethook(L1); + if (hook != NULL && hook != hookf) /* external hook? */ + lua_pushliteral(L, "external hook"); + else { + gethooktable(L1); + lua_pushlightuserdata(L1, L1); + lua_rawget(L1, -2); /* get hook */ + lua_remove(L1, -2); /* remove hook table */ + lua_xmove(L1, L, 1); + } + lua_pushstring(L, unmakemask(mask, buff)); + lua_pushinteger(L, lua_gethookcount(L1)); + return 3; +} + + +static int db_debug (lua_State *L) { + for (;;) { + char buffer[250]; + fputs("lua_debug> ", stderr); + if (fgets(buffer, sizeof(buffer), stdin) == 0 || + strcmp(buffer, "cont\n") == 0) + return 0; + if (luaL_loadbuffer(L, buffer, strlen(buffer), "=(debug command)") || + lua_pcall(L, 0, 0, 0)) { + fputs(lua_tostring(L, -1), stderr); + fputs("\n", stderr); + } + lua_settop(L, 0); /* remove eventual returns */ + } +} + + +#define LEVELS1 12 /* size of the first part of the stack */ +#define LEVELS2 10 /* size of the second part of the stack */ + +static int db_errorfb (lua_State *L) { + int level; + int firstpart = 1; /* still before eventual `...' */ + int arg; + lua_State *L1 = getthread(L, &arg); + lua_Debug ar; + if (lua_isnumber(L, arg+2)) { + level = (int)lua_tointeger(L, arg+2); + lua_pop(L, 1); + } + else + level = (L == L1) ? 1 : 0; /* level 0 may be this own function */ + if (lua_gettop(L) == arg) + lua_pushliteral(L, ""); + else if (!lua_isstring(L, arg+1)) return 1; /* message is not a string */ + else lua_pushliteral(L, "\n"); + lua_pushliteral(L, "stack traceback:"); + while (lua_getstack(L1, level++, &ar)) { + if (level > LEVELS1 && firstpart) { + /* no more than `LEVELS2' more levels? */ + if (!lua_getstack(L1, level+LEVELS2, &ar)) + level--; /* keep going */ + else { + lua_pushliteral(L, "\n\t..."); /* too many levels */ + while (lua_getstack(L1, level+LEVELS2, &ar)) /* find last levels */ + level++; + } + firstpart = 0; + continue; + } + lua_pushliteral(L, "\n\t"); + lua_getinfo(L1, "Snl", &ar); + lua_pushfstring(L, "%s:", ar.short_src); + if (ar.currentline > 0) + lua_pushfstring(L, "%d:", ar.currentline); + if (*ar.namewhat != '\0') /* is there a name? */ + lua_pushfstring(L, " in function " LUA_QS, ar.name); + else { + if (*ar.what == 'm') /* main? */ + lua_pushfstring(L, " in main chunk"); + else if (*ar.what == 'C' || *ar.what == 't') + lua_pushliteral(L, " ?"); /* C function or tail call */ + else + lua_pushfstring(L, " in function <%s:%d>", + ar.short_src, ar.linedefined); + } + lua_concat(L, lua_gettop(L) - arg); + } + lua_concat(L, lua_gettop(L) - arg); + return 1; +} + + +static const luaL_Reg dblib[] = { + {"debug", db_debug}, + {"getfenv", db_getfenv}, + {"gethook", db_gethook}, + {"getinfo", db_getinfo}, + {"getlocal", db_getlocal}, + {"getregistry", db_getregistry}, + {"getmetatable", db_getmetatable}, + {"getupvalue", db_getupvalue}, + {"setfenv", db_setfenv}, + {"sethook", db_sethook}, + {"setlocal", db_setlocal}, + {"setmetatable", db_setmetatable}, + {"setupvalue", db_setupvalue}, + {"traceback", db_errorfb}, + {NULL, NULL} +}; + + +LUALIB_API int luaopen_debug (lua_State *L) { + luaL_register(L, LUA_DBLIBNAME, dblib); + return 1; +} + diff --git a/src/lua-vm/ldebug.c b/src/lua-vm/ldebug.c new file mode 100644 index 0000000..1aea00c --- /dev/null +++ b/src/lua-vm/ldebug.c @@ -0,0 +1,627 @@ +/* +** $Id: ldebug.c,v 2.29a 2005/12/22 16:19:56 roberto Exp $ +** Debug Interface +** See Copyright Notice in lua.h +*/ + + +#include +#include +#include + + +#define ldebug_c +#define LUA_CORE + +#include "lua.h" + +#include "lapi.h" +#include "lcode.h" +#include "ldebug.h" +#include "ldo.h" +#include "lfunc.h" +#include "lobject.h" +#include "lopcodes.h" +#include "lstate.h" +#include "lstring.h" +#include "ltable.h" +#include "ltm.h" +#include "lvm.h" + + + +static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name); + + +static int currentpc (lua_State *L, CallInfo *ci) { + if (!isLua(ci)) return -1; /* function is not a Lua function? */ + if (ci == L->ci) + ci->savedpc = L->savedpc; + return pcRel(ci->savedpc, ci_func(ci)->l.p); +} + + +static int currentline (lua_State *L, CallInfo *ci) { + int pc = currentpc(L, ci); + if (pc < 0) + return -1; /* only active lua functions have current-line information */ + else + return getline(ci_func(ci)->l.p, pc); +} + + +/* +** this function can be called asynchronous (e.g. during a signal) +*/ +LUA_API int lua_sethook (lua_State *L, lua_Hook func, int mask, int count) { + if (func == NULL || mask == 0) { /* turn off hooks? */ + mask = 0; + func = NULL; + } + L->hook = func; + L->basehookcount = count; + resethookcount(L); + L->hookmask = cast_byte(mask); + return 1; +} + + +LUA_API lua_Hook lua_gethook (lua_State *L) { + return L->hook; +} + + +LUA_API int lua_gethookmask (lua_State *L) { + return L->hookmask; +} + + +LUA_API int lua_gethookcount (lua_State *L) { + return L->basehookcount; +} + + +LUA_API int lua_getstack (lua_State *L, int level, lua_Debug *ar) { + int status; + CallInfo *ci; + lua_lock(L); + for (ci = L->ci; level > 0 && ci > L->base_ci; ci--) { + level--; + if (f_isLua(ci)) /* Lua function? */ + level -= ci->tailcalls; /* skip lost tail calls */ + } + if (level == 0 && ci > L->base_ci) { /* level found? */ + status = 1; + ar->i_ci = cast_int(ci - L->base_ci); + } + else if (level < 0) { /* level is of a lost tail call? */ + status = 1; + ar->i_ci = 0; + } + else status = 0; /* no such level */ + lua_unlock(L); + return status; +} + + +static Proto *getluaproto (CallInfo *ci) { + return (isLua(ci) ? ci_func(ci)->l.p : NULL); +} + + +static const char *findlocal (lua_State *L, CallInfo *ci, int n) { + const char *name; + Proto *fp = getluaproto(ci); + if (fp && (name = luaF_getlocalname(fp, n, currentpc(L, ci))) != NULL) + return name; /* is a local variable in a Lua function */ + else { + StkId limit = (ci == L->ci) ? L->top : (ci+1)->func; + if (limit - ci->base >= n && n > 0) /* is 'n' inside 'ci' stack? */ + return "(*temporary)"; + else + return NULL; + } +} + + +LUA_API const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n) { + CallInfo *ci = L->base_ci + ar->i_ci; + const char *name = findlocal(L, ci, n); + lua_lock(L); + if (name) + luaA_pushobject(L, ci->base + (n - 1)); + lua_unlock(L); + return name; +} + + +LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n) { + CallInfo *ci = L->base_ci + ar->i_ci; + const char *name = findlocal(L, ci, n); + lua_lock(L); + if (name) + setobjs2s(L, ci->base + (n - 1), L->top - 1); + L->top--; /* pop value */ + lua_unlock(L); + return name; +} + + +static void funcinfo (lua_Debug *ar, Closure *cl) { + if (cl->c.isC) { + ar->source = "=[C]"; + ar->linedefined = -1; + ar->lastlinedefined = -1; + ar->what = "C"; + } + else { + ar->source = getstr(cl->l.p->source); + ar->linedefined = cl->l.p->linedefined; + ar->lastlinedefined = cl->l.p->lastlinedefined; + ar->what = (ar->linedefined == 0) ? "main" : "Lua"; + } + luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE); +} + + +static void info_tailcall (lua_Debug *ar) { + ar->name = ar->namewhat = ""; + ar->what = "tail"; + ar->lastlinedefined = ar->linedefined = ar->currentline = -1; + ar->source = "=(tail call)"; + luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE); + ar->nups = 0; +} + + +static void collectvalidlines (lua_State *L, Closure *f) { + if (f == NULL || f->c.isC) { + setnilvalue(L->top); + } + else { + Table *t = luaH_new(L, 0, 0); + int *lineinfo = f->l.p->lineinfo; + int i; + for (i=0; il.p->sizelineinfo; i++) + setbvalue(luaH_setnum(L, t, lineinfo[i]), 1); + sethvalue(L, L->top, t); + } + incr_top(L); +} + + +static int auxgetinfo (lua_State *L, const char *what, lua_Debug *ar, + Closure *f, CallInfo *ci) { + int status = 1; + if (f == NULL) { + info_tailcall(ar); + return status; + } + for (; *what; what++) { + switch (*what) { + case 'S': { + funcinfo(ar, f); + break; + } + case 'l': { + ar->currentline = (ci) ? currentline(L, ci) : -1; + break; + } + case 'u': { + ar->nups = f->c.nupvalues; + break; + } + case 'n': { + ar->namewhat = (ci) ? getfuncname(L, ci, &ar->name) : NULL; + if (ar->namewhat == NULL) { + ar->namewhat = ""; /* not found */ + ar->name = NULL; + } + break; + } + case 'L': + case 'f': /* handled by lua_getinfo */ + break; + default: status = 0; /* invalid option */ + } + } + return status; +} + + +LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) { + int status; + Closure *f = NULL; + CallInfo *ci = NULL; + lua_lock(L); + if (*what == '>') { + StkId func = L->top - 1; + luai_apicheck(L, ttisfunction(func)); + what++; /* skip the '>' */ + f = clvalue(func); + L->top--; /* pop function */ + } + else if (ar->i_ci != 0) { /* no tail call? */ + ci = L->base_ci + ar->i_ci; + lua_assert(ttisfunction(ci->func)); + f = clvalue(ci->func); + } + status = auxgetinfo(L, what, ar, f, ci); + if (strchr(what, 'f')) { + if (f == NULL) setnilvalue(L->top); + else setclvalue(L, L->top, f); + incr_top(L); + } + if (strchr(what, 'L')) + collectvalidlines(L, f); + lua_unlock(L); + return status; +} + + +/* +** {====================================================== +** Symbolic Execution and code checker +** ======================================================= +*/ + +static int bad(const char *test, const char *file, const int line) { + extern int printf(const char *fmt,...); + printf("Code sanity check failure:%s:%i: %s\n", file, line, test); + return 0; +} +#define check(x) if (!(x)) return bad(#x, __FILE__, __LINE__); + +#define checkjump(pt,pc) check(0 <= pc && pc < pt->sizecode) + +#define checkreg(pt,reg) check((reg) < (pt)->maxstacksize) + + + +static int precheck (const Proto *pt) { + check(pt->maxstacksize <= MAXSTACK); + lua_assert(pt->numparams+(pt->is_vararg & VARARG_HASARG) <= pt->maxstacksize); + lua_assert(!(pt->is_vararg & VARARG_NEEDSARG) || + (pt->is_vararg & VARARG_HASARG)); + check(pt->sizeupvalues <= pt->nups); + check(pt->sizelineinfo == pt->sizecode || pt->sizelineinfo == 0); + check(GET_OPCODE(pt->code[pt->sizecode-1]) == OP_RETURN); + return 1; +} + + +#define checkopenop(pt,pc) luaG_checkopenop((pt)->code[(pc)+1]) + +int luaG_checkopenop (Instruction i) { + switch (GET_OPCODE(i)) { + case OP_CALL: + case OP_TAILCALL: + case OP_RETURN: + case OP_SETLIST: { + check(GETARG_B(i) == 0); + return 1; + } + default: return 0; /* invalid instruction after an open call */ + } +} + + +static int checkArgMode (const Proto *pt, int r, enum OpArgMask mode) { + switch (mode) { + case OpArgN: check(r == 0); break; + case OpArgU: break; + case OpArgR: checkreg(pt, r); break; + case OpArgK: + check(ISK(r) ? INDEXK(r) < pt->sizek : r < pt->maxstacksize); + break; + } + return 1; +} + + +static Instruction symbexec (const Proto *pt, int lastpc, int reg) { + int pc; + int last; /* stores position of last instruction that changed `reg' */ + last = pt->sizecode-1; /* points to final return (a `neutral' instruction) */ + check(precheck(pt)); + for (pc = 0; pc < lastpc; pc++) { + Instruction i = pt->code[pc]; + OpCode op = GET_OPCODE(i); + int a = GETARG_A(i); + int b = 0; + int c = 0; + check(op < NUM_OPCODES); + checkreg(pt, a); + switch (getOpMode(op)) { + case iABC: { + b = GETARG_B(i); + c = GETARG_C(i); + check(checkArgMode(pt, b, getBMode(op))); + check(checkArgMode(pt, c, getCMode(op))); + break; + } + case iABx: { + b = GETARG_Bx(i); + if (getBMode(op) == OpArgK) check(b < pt->sizek); + break; + } + case iAsBx: { + b = GETARG_sBx(i); + if (getBMode(op) == OpArgR) { + int dest = pc+1+b; + check(0 <= dest && dest < pt->sizecode); + if (dest > 0) { + /* cannot jump to a setlist count */ + Instruction d = pt->code[dest-1]; + check(!(GET_OPCODE(d) == OP_SETLIST && GETARG_C(d) == 0)); + } + } + break; + } + } + if (testAMode(op)) { + if (a == reg) last = pc; /* change register `a' */ + } + if (testTMode(op)) { + check(pc+2 < pt->sizecode); /* check skip */ + check(GET_OPCODE(pt->code[pc+1]) == OP_JMP); + } + switch (op) { + case OP_LOADBOOL: { + check(c == 0 || pc+2 < pt->sizecode); /* check its jump */ + break; + } + case OP_LOADNIL: { + if (a <= reg && reg <= b) + last = pc; /* set registers from `a' to `b' */ + break; + } + case OP_GETUPVAL: + case OP_SETUPVAL: { + check(b < pt->nups); + break; + } + case OP_GETGLOBAL: + case OP_SETGLOBAL: { + check(ttisstring(&pt->k[b])); + break; + } + case OP_SELF: { + checkreg(pt, a+1); + if (reg == a+1) last = pc; + break; + } + case OP_CONCAT: { + check(b < c); /* at least two operands */ + break; + } + case OP_TFORLOOP: { + check(c >= 1); /* at least one result (control variable) */ + checkreg(pt, a+2+c); /* space for results */ + if (reg >= a+2) last = pc; /* affect all regs above its base */ + break; + } + case OP_FORLOOP: + case OP_FORPREP: + checkreg(pt, a+3); + /* go through */ + case OP_JMP: { + int dest = pc+1+b; + /* not full check and jump is forward and do not skip `lastpc'? */ + if (reg != NO_REG && pc < dest && dest <= lastpc) + pc += b; /* do the jump */ + break; + } + case OP_CALL: + case OP_TAILCALL: { + if (b != 0) { + checkreg(pt, a+b-1); + } + c--; /* c = num. returns */ + if (c == LUA_MULTRET) { + check(checkopenop(pt, pc)); + } + else if (c != 0) + checkreg(pt, a+c-1); + if (reg >= a) last = pc; /* affect all registers above base */ + break; + } + case OP_RETURN: { + b--; /* b = num. returns */ + if (b > 0) checkreg(pt, a+b-1); + break; + } + case OP_SETLIST: { + if (b > 0) checkreg(pt, a + b); + if (c == 0) pc++; + break; + } + case OP_CLOSURE: { + int nup, j; + check(b < pt->sizep); + nup = pt->p[b]->nups; + check(pc + nup < pt->sizecode); + for (j = 1; j <= nup; j++) { + OpCode op1 = GET_OPCODE(pt->code[pc + j]); + check(op1 == OP_GETUPVAL || op1 == OP_MOVE); + } + if (reg != NO_REG) /* tracing? */ + pc += nup; /* do not 'execute' these pseudo-instructions */ + break; + } + case OP_VARARG: { + check((pt->is_vararg & VARARG_ISVARARG) && + !(pt->is_vararg & VARARG_NEEDSARG)); + b--; + if (b == LUA_MULTRET) check(checkopenop(pt, pc)); + checkreg(pt, a+b-1); + break; + } + default: break; + } + } + return pt->code[last]; +} + +#undef check +#undef checkjump +#undef checkreg + +/* }====================================================== */ + + +int luaG_checkcode (const Proto *pt) { + return (symbexec(pt, pt->sizecode, NO_REG) != 0); +} + + +static const char *kname (Proto *p, int c) { + if (ISK(c) && ttisstring(&p->k[INDEXK(c)])) + return svalue(&p->k[INDEXK(c)]); + else + return "?"; +} + + +static const char *getobjname (lua_State *L, CallInfo *ci, int stackpos, + const char **name) { + if (isLua(ci)) { /* a Lua function? */ + Proto *p = ci_func(ci)->l.p; + int pc = currentpc(L, ci); + Instruction i; + *name = luaF_getlocalname(p, stackpos+1, pc); + if (*name) /* is a local? */ + return "local"; + i = symbexec(p, pc, stackpos); /* try symbolic execution */ + lua_assert(pc != -1); + switch (GET_OPCODE(i)) { + case OP_GETGLOBAL: { + int g = GETARG_Bx(i); /* global index */ + lua_assert(ttisstring(&p->k[g])); + *name = svalue(&p->k[g]); + return "global"; + } + case OP_MOVE: { + int a = GETARG_A(i); + int b = GETARG_B(i); /* move from `b' to `a' */ + if (b < a) + return getobjname(L, ci, b, name); /* get name for `b' */ + break; + } + case OP_GETTABLE: { + int k = GETARG_C(i); /* key index */ + *name = kname(p, k); + return "field"; + } + case OP_GETUPVAL: { + int u = GETARG_B(i); /* upvalue index */ + *name = p->upvalues ? getstr(p->upvalues[u]) : "?"; + return "upvalue"; + } + case OP_SELF: { + int k = GETARG_C(i); /* key index */ + *name = kname(p, k); + return "method"; + } + default: break; + } + } + return NULL; /* no useful name found */ +} + + +static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name) { + Instruction i; + if ((isLua(ci) && ci->tailcalls > 0) || !isLua(ci - 1)) + return NULL; /* calling function is not Lua (or is unknown) */ + ci--; /* calling function */ + i = ci_func(ci)->l.p->code[currentpc(L, ci)]; + if (GET_OPCODE(i) == OP_CALL || GET_OPCODE(i) == OP_TAILCALL || + GET_OPCODE(i) == OP_TFORLOOP) + return getobjname(L, ci, GETARG_A(i), name); + else + return NULL; /* no useful name can be found */ +} + + +/* only ANSI way to check whether a pointer points to an array */ +static int isinstack (CallInfo *ci, const TValue *o) { + StkId p; + for (p = ci->base; p < ci->top; p++) + if (o == p) return 1; + return 0; +} + + +void luaG_typeerror (lua_State *L, const TValue *o, const char *op) { + const char *name = NULL; + const char *t = luaT_typenames[ttype(o)]; + const char *kind = (isinstack(L->ci, o)) ? + getobjname(L, L->ci, cast_int(o - L->base), &name) : + NULL; + if (kind) + luaG_runerror(L, "attempt to %s %s " LUA_QS " (a %s value)", + op, kind, name, t); + else + luaG_runerror(L, "attempt to %s a %s value", op, t); +} + + +void luaG_concaterror (lua_State *L, StkId p1, StkId p2) { + if (ttisstring(p1)) p1 = p2; + lua_assert(!ttisstring(p1)); + luaG_typeerror(L, p1, "concatenate"); +} + + +void luaG_aritherror (lua_State *L, const TValue *p1, const TValue *p2) { + TValue temp; + if (luaV_tonumber(p1, &temp) == NULL) + p2 = p1; /* first operand is wrong */ + luaG_typeerror(L, p2, "perform arithmetic on"); +} + + +int luaG_ordererror (lua_State *L, const TValue *p1, const TValue *p2) { + const char *t1 = luaT_typenames[ttype(p1)]; + const char *t2 = luaT_typenames[ttype(p2)]; + if (t1[2] == t2[2]) + luaG_runerror(L, "attempt to compare two %s values", t1); + else + luaG_runerror(L, "attempt to compare %s with %s", t1, t2); + return 0; +} + + +static void addinfo (lua_State *L, const char *msg) { + CallInfo *ci = L->ci; + if (isLua(ci)) { /* is Lua code? */ + char buff[LUA_IDSIZE]; /* add file:line information */ + int line = currentline(L, ci); + luaO_chunkid(buff, getstr(getluaproto(ci)->source), LUA_IDSIZE); + luaO_pushfstring(L, "%s:%d: %s", buff, line, msg); + } +} + + +void luaG_errormsg (lua_State *L) { + if (L->errfunc != 0) { /* is there an error handling function? */ + StkId errfunc = restorestack(L, L->errfunc); + if (!ttisfunction(errfunc)) luaD_throw(L, LUA_ERRERR); + setobjs2s(L, L->top, L->top - 1); /* move argument */ + setobjs2s(L, L->top - 1, errfunc); /* push function */ + incr_top(L); + luaD_call(L, L->top - 2, 1); /* call it */ + } + luaD_throw(L, LUA_ERRRUN); +} + + +void luaG_runerror (lua_State *L, const char *fmt, ...) { + va_list argp; + va_start(argp, fmt); + addinfo(L, luaO_pushvfstring(L, fmt, argp)); + va_end(argp); + luaG_errormsg(L); +} + diff --git a/src/lua-vm/ldebug.h b/src/lua-vm/ldebug.h new file mode 100644 index 0000000..9c76aa1 --- /dev/null +++ b/src/lua-vm/ldebug.h @@ -0,0 +1,33 @@ +/* +** $Id: ldebug.h,v 2.3 2005/04/25 19:24:10 roberto Exp $ +** Auxiliary functions from Debug Interface module +** See Copyright Notice in lua.h +*/ + +#ifndef ldebug_h +#define ldebug_h + + +#include "lstate.h" + + +#define pcRel(pc, p) (cast(int, (pc) - (p)->code) - 1) + +#define getline(f,pc) (((f)->lineinfo) ? (f)->lineinfo[pc] : 0) + +#define resethookcount(L) (L->hookcount = L->basehookcount) + + +LUAI_FUNC void luaG_typeerror (lua_State *L, const TValue *o, + const char *opname); +LUAI_FUNC void luaG_concaterror (lua_State *L, StkId p1, StkId p2); +LUAI_FUNC void luaG_aritherror (lua_State *L, const TValue *p1, + const TValue *p2); +LUAI_FUNC int luaG_ordererror (lua_State *L, const TValue *p1, + const TValue *p2); +LUAI_FUNC void luaG_runerror (lua_State *L, const char *fmt, ...); +LUAI_FUNC void luaG_errormsg (lua_State *L); +LUAI_FUNC int luaG_checkcode (const Proto *pt); +LUAI_FUNC int luaG_checkopenop (Instruction i); + +#endif diff --git a/src/lua-vm/ldo.c b/src/lua-vm/ldo.c new file mode 100644 index 0000000..ab86fb7 --- /dev/null +++ b/src/lua-vm/ldo.c @@ -0,0 +1,516 @@ +/* +** $Id: ldo.c,v 2.38 2006/06/05 19:36:14 roberto Exp $ +** Stack and Call structure of Lua +** See Copyright Notice in lua.h +*/ + + +#include +#include +#include + +#define ldo_c +#define LUA_CORE + +#include "lua.h" + +#include "ldebug.h" +#include "ldo.h" +#include "lfunc.h" +#include "lgc.h" +#include "lmem.h" +#include "lobject.h" +#include "lopcodes.h" +#include "lparser.h" +#include "lstate.h" +#include "lstring.h" +#include "ltable.h" +#include "ltm.h" +#include "lundump.h" +#include "lvm.h" +#include "lzio.h" + + + + +/* +** {====================================================== +** Error-recovery functions +** ======================================================= +*/ + + +/* chain list of long jump buffers */ +struct lua_longjmp { + struct lua_longjmp *previous; + luai_jmpbuf b; + volatile int status; /* error code */ +}; + + +void luaD_seterrorobj (lua_State *L, int errcode, StkId oldtop) { + switch (errcode) { + case LUA_ERRMEM: { + setsvalue2s(L, oldtop, luaS_newliteral(L, MEMERRMSG)); + break; + } + case LUA_ERRERR: { + setsvalue2s(L, oldtop, luaS_newliteral(L, "error in error handling")); + break; + } + case LUA_ERRSYNTAX: + case LUA_ERRRUN: { + setobjs2s(L, oldtop, L->top - 1); /* error message on current top */ + break; + } + } + L->top = oldtop + 1; +} + + +static void restore_stack_limit (lua_State *L) { + lua_assert(L->stack_last - L->stack == L->stacksize - EXTRA_STACK - 1); + if (L->size_ci > LUAI_MAXCALLS) { /* there was an overflow? */ + int inuse = cast_int(L->ci - L->base_ci); + if (inuse + 1 < LUAI_MAXCALLS) /* can `undo' overflow? */ + luaD_reallocCI(L, LUAI_MAXCALLS); + } +} + + +static void resetstack (lua_State *L, int status) { + L->ci = L->base_ci; + L->base = L->ci->base; + luaF_close(L, L->base); /* close eventual pending closures */ + luaD_seterrorobj(L, status, L->base); + L->nCcalls = 0; + L->allowhook = 1; + restore_stack_limit(L); + L->errfunc = 0; + L->errorJmp = NULL; +} + + +void luaD_throw (lua_State *L, int errcode) { + if (L->errorJmp) { + L->errorJmp->status = errcode; + LUAI_THROW(L, L->errorJmp); + } + else { + L->status = cast_byte(errcode); + if (G(L)->panic) { + resetstack(L, errcode); + lua_unlock(L); + G(L)->panic(L); + } + exit(EXIT_FAILURE); + } +} + + +int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud) { + struct lua_longjmp lj; + lj.status = 0; + lj.previous = L->errorJmp; /* chain new error handler */ + L->errorJmp = &lj; + LUAI_TRY(L, &lj, + (*f)(L, ud); + ); + L->errorJmp = lj.previous; /* restore old error handler */ + return lj.status; +} + +/* }====================================================== */ + + +static void correctstack (lua_State *L, TValue *oldstack) { + CallInfo *ci; + GCObject *up; + L->top = (L->top - oldstack) + L->stack; + for (up = L->openupval; up != NULL; up = up->gch.next) + gco2uv(up)->v = (gco2uv(up)->v - oldstack) + L->stack; + for (ci = L->base_ci; ci <= L->ci; ci++) { + ci->top = (ci->top - oldstack) + L->stack; + ci->base = (ci->base - oldstack) + L->stack; + ci->func = (ci->func - oldstack) + L->stack; + } + L->base = (L->base - oldstack) + L->stack; +} + + +void luaD_reallocstack (lua_State *L, int newsize) { + TValue *oldstack = L->stack; + int realsize = newsize + 1 + EXTRA_STACK; + lua_assert(L->stack_last - L->stack == L->stacksize - EXTRA_STACK - 1); + luaM_reallocvector(L, L->stack, L->stacksize, realsize, TValue); + L->stacksize = realsize; + L->stack_last = L->stack+newsize; + correctstack(L, oldstack); +} + + +void luaD_reallocCI (lua_State *L, int newsize) { + CallInfo *oldci = L->base_ci; + luaM_reallocvector(L, L->base_ci, L->size_ci, newsize, CallInfo); + L->size_ci = newsize; + L->ci = (L->ci - oldci) + L->base_ci; + L->end_ci = L->base_ci + L->size_ci - 1; +} + + +void luaD_growstack (lua_State *L, int n) { + if (n <= L->stacksize) /* double size is enough? */ + luaD_reallocstack(L, 2*L->stacksize); + else + luaD_reallocstack(L, L->stacksize + n); +} + + +static CallInfo *growCI (lua_State *L) { + if (L->size_ci > LUAI_MAXCALLS) /* overflow while handling overflow? */ + luaD_throw(L, LUA_ERRERR); + else { + luaD_reallocCI(L, 2*L->size_ci); + if (L->size_ci > LUAI_MAXCALLS) + luaG_runerror(L, "stack overflow"); + } + return ++L->ci; +} + + +void luaD_callhook (lua_State *L, int event, int line) { + lua_Hook hook = L->hook; + if (hook && L->allowhook) { + ptrdiff_t top = savestack(L, L->top); + ptrdiff_t ci_top = savestack(L, L->ci->top); + lua_Debug ar; + ar.event = event; + ar.currentline = line; + if (event == LUA_HOOKTAILRET) + ar.i_ci = 0; /* tail call; no debug information about it */ + else + ar.i_ci = cast_int(L->ci - L->base_ci); + luaD_checkstack(L, LUA_MINSTACK); /* ensure minimum stack size */ + L->ci->top = L->top + LUA_MINSTACK; + lua_assert(L->ci->top <= L->stack_last); + L->allowhook = 0; /* cannot call hooks inside a hook */ + lua_unlock(L); + (*hook)(L, &ar); + lua_lock(L); + lua_assert(!L->allowhook); + L->allowhook = 1; + L->ci->top = restorestack(L, ci_top); + L->top = restorestack(L, top); + } +} + + +static StkId adjust_varargs (lua_State *L, Proto *p, int actual) { + int i; + int nfixargs = p->numparams; + Table *htab = NULL; + StkId base, fixed; + for (; actual < nfixargs; ++actual) + setnilvalue(L->top++); +#if defined(LUA_COMPAT_VARARG) + if (p->is_vararg & VARARG_NEEDSARG) { /* compat. with old-style vararg? */ + int nvar = actual - nfixargs; /* number of extra arguments */ + lua_assert(p->is_vararg & VARARG_HASARG); + luaC_checkGC(L); + htab = luaH_new(L, nvar, 1); /* create `arg' table */ + for (i=0; itop - nvar + i); + /* store counter in field `n' */ + setnvalue(luaH_setstr(L, htab, luaS_newliteral(L, "n")), cast_num(nvar)); + } +#endif + /* move fixed parameters to final position */ + fixed = L->top - actual; /* first fixed argument */ + base = L->top; /* final position of first argument */ + for (i=0; itop++, fixed+i); + setnilvalue(fixed+i); + } + /* add `arg' parameter */ + if (htab) { + sethvalue(L, L->top++, htab); + lua_assert(iswhite(obj2gco(htab))); + } + return base; +} + + +static StkId tryfuncTM (lua_State *L, StkId func) { + const TValue *tm = luaT_gettmbyobj(L, func, TM_CALL); + StkId p; + ptrdiff_t funcr = savestack(L, func); + if (!ttisfunction(tm)) + luaG_typeerror(L, func, "call"); + /* Open a hole inside the stack at `func' */ + for (p = L->top; p > func; p--) setobjs2s(L, p, p-1); + incr_top(L); + func = restorestack(L, funcr); /* previous call may change stack */ + setobj2s(L, func, tm); /* tag method is the new function to be called */ + return func; +} + + + +#define inc_ci(L) \ + ((L->ci == L->end_ci) ? growCI(L) : \ + (condhardstacktests(luaD_reallocCI(L, L->size_ci)), ++L->ci)) + + +int luaD_precall (lua_State *L, StkId func, int nresults) { + LClosure *cl; + ptrdiff_t funcr; + if (!ttisfunction(func)) /* `func' is not a function? */ + func = tryfuncTM(L, func); /* check the `function' tag method */ + funcr = savestack(L, func); + cl = &clvalue(func)->l; + L->ci->savedpc = L->savedpc; + if (!cl->isC) { /* Lua function? prepare its call */ + CallInfo *ci; + StkId st, base; + Proto *p = cl->p; + luaD_checkstack(L, p->maxstacksize); + func = restorestack(L, funcr); + if (!p->is_vararg) { /* no varargs? */ + base = func + 1; + if (L->top > base + p->numparams) + L->top = base + p->numparams; + } + else { /* vararg function */ + int nargs = cast_int(L->top - func) - 1; + base = adjust_varargs(L, p, nargs); + func = restorestack(L, funcr); /* previous call may change the stack */ + } + ci = inc_ci(L); /* now `enter' new function */ + ci->func = func; + L->base = ci->base = base; + ci->top = L->base + p->maxstacksize; + lua_assert(ci->top <= L->stack_last); + L->savedpc = p->code; /* starting point */ + ci->tailcalls = 0; + ci->nresults = nresults; + for (st = L->top; st < ci->top; st++) + setnilvalue(st); + L->top = ci->top; + if (L->hookmask & LUA_MASKCALL) { + L->savedpc++; /* hooks assume 'pc' is already incremented */ + luaD_callhook(L, LUA_HOOKCALL, -1); + L->savedpc--; /* correct 'pc' */ + } + return PCRLUA; + } + else { /* if is a C function, call it */ + CallInfo *ci; + int n; + luaD_checkstack(L, LUA_MINSTACK); /* ensure minimum stack size */ + ci = inc_ci(L); /* now `enter' new function */ + ci->func = restorestack(L, funcr); + L->base = ci->base = ci->func + 1; + ci->top = L->top + LUA_MINSTACK; + lua_assert(ci->top <= L->stack_last); + ci->nresults = nresults; + if (L->hookmask & LUA_MASKCALL) + luaD_callhook(L, LUA_HOOKCALL, -1); + lua_unlock(L); + n = (*curr_func(L)->c.f)(L); /* do the actual call */ + lua_lock(L); + if (n < 0) /* yielding? */ + return PCRYIELD; + else { + luaD_poscall(L, L->top - n); + return PCRC; + } + } +} + + +static StkId callrethooks (lua_State *L, StkId firstResult) { + ptrdiff_t fr = savestack(L, firstResult); /* next call may change stack */ + luaD_callhook(L, LUA_HOOKRET, -1); + if (f_isLua(L->ci)) { /* Lua function? */ + while (L->ci->tailcalls--) /* call hook for eventual tail calls */ + luaD_callhook(L, LUA_HOOKTAILRET, -1); + } + return restorestack(L, fr); +} + + +int luaD_poscall (lua_State *L, StkId firstResult) { + StkId res; + int wanted, i; + CallInfo *ci; + if (L->hookmask & LUA_MASKRET) + firstResult = callrethooks(L, firstResult); + ci = L->ci--; + res = ci->func; /* res == final position of 1st result */ + wanted = ci->nresults; + L->base = (ci - 1)->base; /* restore base */ + L->savedpc = (ci - 1)->savedpc; /* restore savedpc */ + /* move results to correct place */ + for (i = wanted; i != 0 && firstResult < L->top; i--) + setobjs2s(L, res++, firstResult++); + while (i-- > 0) + setnilvalue(res++); + L->top = res; + return (wanted - LUA_MULTRET); /* 0 iff wanted == LUA_MULTRET */ +} + + +/* +** Call a function (C or Lua). The function to be called is at *func. +** The arguments are on the stack, right after the function. +** When returns, all the results are on the stack, starting at the original +** function position. +*/ +void luaD_call (lua_State *L, StkId func, int nResults) { + if (++L->nCcalls >= LUAI_MAXCCALLS) { + if (L->nCcalls == LUAI_MAXCCALLS) + luaG_runerror(L, "C stack overflow"); + else if (L->nCcalls >= (LUAI_MAXCCALLS + (LUAI_MAXCCALLS>>3))) + luaD_throw(L, LUA_ERRERR); /* error while handing stack error */ + } + if (luaD_precall(L, func, nResults) == PCRLUA) /* is a Lua function? */ + luaV_execute(L, 1); /* call it */ + L->nCcalls--; + luaC_checkGC(L); +} + + +static void resume (lua_State *L, void *ud) { + StkId firstArg = cast(StkId, ud); + CallInfo *ci = L->ci; + if (L->status == 0) { /* start coroutine? */ + lua_assert(ci == L->base_ci && firstArg > L->base); + if (luaD_precall(L, firstArg - 1, LUA_MULTRET) != PCRLUA) + return; + } + else { /* resuming from previous yield */ + lua_assert(L->status == LUA_YIELD); + L->status = 0; + if (!f_isLua(ci)) { /* `common' yield? */ + /* finish interrupted execution of `OP_CALL' */ + lua_assert(GET_OPCODE(*((ci-1)->savedpc - 1)) == OP_CALL || + GET_OPCODE(*((ci-1)->savedpc - 1)) == OP_TAILCALL); + if (luaD_poscall(L, firstArg)) /* complete it... */ + L->top = L->ci->top; /* and correct top if not multiple results */ + } + else /* yielded inside a hook: just continue its execution */ + L->base = L->ci->base; + } + luaV_execute(L, cast_int(L->ci - L->base_ci)); +} + + +static int resume_error (lua_State *L, const char *msg) { + L->top = L->ci->base; + setsvalue2s(L, L->top, luaS_new(L, msg)); + incr_top(L); + lua_unlock(L); + return LUA_ERRRUN; +} + + +LUA_API int lua_resume (lua_State *L, int nargs) { + int status; + lua_lock(L); + if (L->status != LUA_YIELD) { + if (L->status != 0) + return resume_error(L, "cannot resume dead coroutine"); + else if (L->ci != L->base_ci) + return resume_error(L, "cannot resume non-suspended coroutine"); + } + luai_userstateresume(L, nargs); + lua_assert(L->errfunc == 0 && L->nCcalls == 0); + status = luaD_rawrunprotected(L, resume, L->top - nargs); + if (status != 0) { /* error? */ + L->status = cast_byte(status); /* mark thread as `dead' */ + luaD_seterrorobj(L, status, L->top); + L->ci->top = L->top; + } + else + status = L->status; + lua_unlock(L); + return status; +} + + +LUA_API int lua_yield (lua_State *L, int nresults) { + luai_userstateyield(L, nresults); + lua_lock(L); + if (L->nCcalls > 0) + luaG_runerror(L, "attempt to yield across metamethod/C-call boundary"); + L->base = L->top - nresults; /* protect stack slots below */ + L->status = LUA_YIELD; + lua_unlock(L); + return -1; +} + + +int luaD_pcall (lua_State *L, Pfunc func, void *u, + ptrdiff_t old_top, ptrdiff_t ef) { + int status; + unsigned short oldnCcalls = L->nCcalls; + ptrdiff_t old_ci = saveci(L, L->ci); + lu_byte old_allowhooks = L->allowhook; + ptrdiff_t old_errfunc = L->errfunc; + L->errfunc = ef; + status = luaD_rawrunprotected(L, func, u); + if (status != 0) { /* an error occurred? */ + StkId oldtop = restorestack(L, old_top); + luaF_close(L, oldtop); /* close eventual pending closures */ + luaD_seterrorobj(L, status, oldtop); + L->nCcalls = oldnCcalls; + L->ci = restoreci(L, old_ci); + L->base = L->ci->base; + L->savedpc = L->ci->savedpc; + L->allowhook = old_allowhooks; + restore_stack_limit(L); + } + L->errfunc = old_errfunc; + return status; +} + + + +/* +** Execute a protected parser. +*/ +struct SParser { /* data to `f_parser' */ + ZIO *z; + Mbuffer buff; /* buffer to be used by the scanner */ + const char *name; +}; + +static void f_parser (lua_State *L, void *ud) { + int i; + Proto *tf; + Closure *cl; + struct SParser *p = cast(struct SParser *, ud); + int c = luaZ_lookahead(p->z); + luaC_checkGC(L); + tf = ((c == LUA_SIGNATURE[0]) ? luaU_undump : luaY_parser)(L, p->z, + &p->buff, p->name); + cl = luaF_newLclosure(L, tf->nups, hvalue(gt(L))); + cl->l.p = tf; + for (i = 0; i < tf->nups; i++) /* initialize eventual upvalues */ + cl->l.upvals[i] = luaF_newupval(L); + setclvalue(L, L->top, cl); + incr_top(L); +} + + +int luaD_protectedparser (lua_State *L, ZIO *z, const char *name) { + struct SParser p; + int status; + p.z = z; p.name = name; + luaZ_initbuffer(L, &p.buff); + status = luaD_pcall(L, f_parser, &p, savestack(L, L->top), L->errfunc); + luaZ_freebuffer(L, &p.buff); + return status; +} + + diff --git a/src/lua-vm/ldo.h b/src/lua-vm/ldo.h new file mode 100644 index 0000000..b2de92b --- /dev/null +++ b/src/lua-vm/ldo.h @@ -0,0 +1,57 @@ +/* +** $Id: ldo.h,v 2.7 2005/08/24 16:15:49 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" +#include "lzio.h" + + +#define luaD_checkstack(L,n) \ + if ((char *)L->stack_last - (char *)L->top <= (n)*(int)sizeof(TValue)) \ + luaD_growstack(L, n); \ + else condhardstacktests(luaD_reallocstack(L, L->stacksize - EXTRA_STACK - 1)); + + +#define incr_top(L) {luaD_checkstack(L,1); L->top++;} + +#define savestack(L,p) ((char *)(p) - (char *)L->stack) +#define restorestack(L,n) ((TValue *)((char *)L->stack + (n))) + +#define saveci(L,p) ((char *)(p) - (char *)L->base_ci) +#define restoreci(L,n) ((CallInfo *)((char *)L->base_ci + (n))) + + +/* results from luaD_precall */ +#define PCRLUA 0 /* initiated a call to a Lua function */ +#define PCRC 1 /* did a call to a C function */ +#define PCRYIELD 2 /* C funtion yielded */ + + +/* type of protected functions, to be ran by `runprotected' */ +typedef void (*Pfunc) (lua_State *L, void *ud); + +LUAI_FUNC int luaD_protectedparser (lua_State *L, ZIO *z, const char *name); +LUAI_FUNC void luaD_callhook (lua_State *L, int event, int line); +LUAI_FUNC int luaD_precall (lua_State *L, StkId func, int nresults); +LUAI_FUNC void luaD_call (lua_State *L, StkId func, int nResults); +LUAI_FUNC int luaD_pcall (lua_State *L, Pfunc func, void *u, + ptrdiff_t oldtop, ptrdiff_t ef); +LUAI_FUNC int luaD_poscall (lua_State *L, StkId firstResult); +LUAI_FUNC void luaD_reallocCI (lua_State *L, int newsize); +LUAI_FUNC void luaD_reallocstack (lua_State *L, int newsize); +LUAI_FUNC void luaD_growstack (lua_State *L, int n); + +LUAI_FUNC void luaD_throw (lua_State *L, int errcode); +LUAI_FUNC int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud); + +LUAI_FUNC void luaD_seterrorobj (lua_State *L, int errcode, StkId oldtop); + +#endif + diff --git a/src/lua-vm/ldump.c b/src/lua-vm/ldump.c new file mode 100644 index 0000000..f08277d --- /dev/null +++ b/src/lua-vm/ldump.c @@ -0,0 +1,164 @@ +/* +** $Id: ldump.c,v 1.15 2006/02/16 15:53:49 lhf Exp $ +** save precompiled Lua chunks +** See Copyright Notice in lua.h +*/ + +#include + +#define ldump_c +#define LUA_CORE + +#include "lua.h" + +#include "lobject.h" +#include "lstate.h" +#include "lundump.h" + +typedef struct { + lua_State* L; + lua_Writer writer; + void* data; + int strip; + int status; +} DumpState; + +#define DumpMem(b,n,size,D) DumpBlock(b,(n)*(size),D) +#define DumpVar(x,D) DumpMem(&x,1,sizeof(x),D) + +static void DumpBlock(const void* b, size_t size, DumpState* D) +{ + if (D->status==0) + { + lua_unlock(D->L); + D->status=(*D->writer)(D->L,b,size,D->data); + lua_lock(D->L); + } +} + +static void DumpChar(int y, DumpState* D) +{ + char x=(char)y; + DumpVar(x,D); +} + +static void DumpInt(int x, DumpState* D) +{ + DumpVar(x,D); +} + +static void DumpNumber(lua_Number x, DumpState* D) +{ + DumpVar(x,D); +} + +static void DumpVector(const void* b, int n, size_t size, DumpState* D) +{ + DumpInt(n,D); + DumpMem(b,n,size,D); +} + +static void DumpString(const TString* s, DumpState* D) +{ + if (s==NULL || getstr(s)==NULL) + { + size_t size=0; + DumpVar(size,D); + } + else + { + size_t size=s->tsv.len+1; /* include trailing '\0' */ + DumpVar(size,D); + DumpBlock(getstr(s),size,D); + } +} + +#define DumpCode(f,D) DumpVector(f->code,f->sizecode,sizeof(Instruction),D) + +static void DumpFunction(const Proto* f, const TString* p, DumpState* D); + +static void DumpConstants(const Proto* f, DumpState* D) +{ + int i,n=f->sizek; + DumpInt(n,D); + for (i=0; ik[i]; + DumpChar(ttype(o),D); + switch (ttype(o)) + { + case LUA_TNIL: + break; + case LUA_TBOOLEAN: + DumpChar(bvalue(o),D); + break; + case LUA_TNUMBER: + DumpNumber(nvalue(o),D); + break; + case LUA_TSTRING: + DumpString(rawtsvalue(o),D); + break; + default: + lua_assert(0); /* cannot happen */ + break; + } + } + n=f->sizep; + DumpInt(n,D); + for (i=0; ip[i],f->source,D); +} + +static void DumpDebug(const Proto* f, DumpState* D) +{ + int i,n; + n= (D->strip) ? 0 : f->sizelineinfo; + DumpVector(f->lineinfo,n,sizeof(int),D); + n= (D->strip) ? 0 : f->sizelocvars; + DumpInt(n,D); + for (i=0; ilocvars[i].varname,D); + DumpInt(f->locvars[i].startpc,D); + DumpInt(f->locvars[i].endpc,D); + } + n= (D->strip) ? 0 : f->sizeupvalues; + DumpInt(n,D); + for (i=0; iupvalues[i],D); +} + +static void DumpFunction(const Proto* f, const TString* p, DumpState* D) +{ + DumpString((f->source==p || D->strip) ? NULL : f->source,D); + DumpInt(f->linedefined,D); + DumpInt(f->lastlinedefined,D); + DumpChar(f->nups,D); + DumpChar(f->numparams,D); + DumpChar(f->is_vararg,D); + DumpChar(f->maxstacksize,D); + DumpCode(f,D); + DumpConstants(f,D); + DumpDebug(f,D); +} + +static void DumpHeader(DumpState* D) +{ + char h[LUAC_HEADERSIZE]; + luaU_header(h); + DumpBlock(h,LUAC_HEADERSIZE,D); +} + +/* +** dump Lua function as precompiled chunk +*/ +int luaU_dump (lua_State* L, const Proto* f, lua_Writer w, void* data, int strip) +{ + DumpState D; + D.L=L; + D.writer=w; + D.data=data; + D.strip=strip; + D.status=0; + DumpHeader(&D); + DumpFunction(f,NULL,&D); + return D.status; +} diff --git a/src/lua-vm/lfunc.c b/src/lua-vm/lfunc.c new file mode 100644 index 0000000..05bd5ff --- /dev/null +++ b/src/lua-vm/lfunc.c @@ -0,0 +1,174 @@ +/* +** $Id: lfunc.c,v 2.12a 2005/12/22 16:19:56 roberto Exp $ +** Auxiliary functions to manipulate prototypes and closures +** See Copyright Notice in lua.h +*/ + + +#include + +#define lfunc_c +#define LUA_CORE + +#include "lua.h" + +#include "lfunc.h" +#include "lgc.h" +#include "lmem.h" +#include "lobject.h" +#include "lstate.h" + + + +Closure *luaF_newCclosure (lua_State *L, int nelems, Table *e) { + Closure *c = cast(Closure *, luaM_malloc(L, sizeCclosure(nelems))); + luaC_link(L, obj2gco(c), LUA_TFUNCTION); + c->c.isC = 1; + c->c.env = e; + c->c.nupvalues = cast_byte(nelems); + return c; +} + + +Closure *luaF_newLclosure (lua_State *L, int nelems, Table *e) { + Closure *c = cast(Closure *, luaM_malloc(L, sizeLclosure(nelems))); + luaC_link(L, obj2gco(c), LUA_TFUNCTION); + c->l.isC = 0; + c->l.env = e; + c->l.nupvalues = cast_byte(nelems); + while (nelems--) c->l.upvals[nelems] = NULL; + return c; +} + + +UpVal *luaF_newupval (lua_State *L) { + UpVal *uv = luaM_new(L, UpVal); + luaC_link(L, obj2gco(uv), LUA_TUPVAL); + uv->v = &uv->u.value; + setnilvalue(uv->v); + return uv; +} + + +UpVal *luaF_findupval (lua_State *L, StkId level) { + global_State *g = G(L); + GCObject **pp = &L->openupval; + UpVal *p; + UpVal *uv; + while (*pp != NULL && (p = ngcotouv(*pp))->v >= level) { + lua_assert(p->v != &p->u.value); + if (p->v == level) { /* found a corresponding upvalue? */ + if (isdead(g, obj2gco(p))) /* is it dead? */ + changewhite(obj2gco(p)); /* ressurect it */ + return p; + } + pp = &p->next; + } + uv = luaM_new(L, UpVal); /* not found: create a new one */ + uv->tt = LUA_TUPVAL; + uv->marked = luaC_white(g); + uv->v = level; /* current value lives in the stack */ + uv->next = *pp; /* chain it in the proper position */ + *pp = obj2gco(uv); + uv->u.l.prev = &g->uvhead; /* double link it in `uvhead' list */ + uv->u.l.next = g->uvhead.u.l.next; + uv->u.l.next->u.l.prev = uv; + g->uvhead.u.l.next = uv; + lua_assert(uv->u.l.next->u.l.prev == uv && uv->u.l.prev->u.l.next == uv); + return uv; +} + + +static void unlinkupval (UpVal *uv) { + lua_assert(uv->u.l.next->u.l.prev == uv && uv->u.l.prev->u.l.next == uv); + uv->u.l.next->u.l.prev = uv->u.l.prev; /* remove from `uvhead' list */ + uv->u.l.prev->u.l.next = uv->u.l.next; +} + + +void luaF_freeupval (lua_State *L, UpVal *uv) { + if (uv->v != &uv->u.value) /* is it open? */ + unlinkupval(uv); /* remove from open list */ + luaM_free(L, uv); /* free upvalue */ +} + + +void luaF_close (lua_State *L, StkId level) { + UpVal *uv; + global_State *g = G(L); + while (L->openupval != NULL && (uv = ngcotouv(L->openupval))->v >= level) { + GCObject *o = obj2gco(uv); + lua_assert(!isblack(o) && uv->v != &uv->u.value); + L->openupval = uv->next; /* remove from `open' list */ + if (isdead(g, o)) + luaF_freeupval(L, uv); /* free upvalue */ + else { + unlinkupval(uv); + setobj(L, &uv->u.value, uv->v); + uv->v = &uv->u.value; /* now current value lives here */ + luaC_linkupval(L, uv); /* link upvalue into `gcroot' list */ + } + } +} + + +Proto *luaF_newproto (lua_State *L) { + Proto *f = luaM_new(L, Proto); + luaC_link(L, obj2gco(f), LUA_TPROTO); + f->k = NULL; + f->sizek = 0; + f->p = NULL; + f->sizep = 0; + f->code = NULL; + f->sizecode = 0; + f->sizelineinfo = 0; + f->sizeupvalues = 0; + f->nups = 0; + f->upvalues = NULL; + f->numparams = 0; + f->is_vararg = 0; + f->maxstacksize = 0; + f->lineinfo = NULL; + f->sizelocvars = 0; + f->locvars = NULL; + f->linedefined = 0; + f->lastlinedefined = 0; + f->source = NULL; + return f; +} + + +void luaF_freeproto (lua_State *L, Proto *f) { + luaM_freearray(L, f->code, f->sizecode, Instruction); + luaM_freearray(L, f->p, f->sizep, Proto *); + luaM_freearray(L, f->k, f->sizek, TValue); + luaM_freearray(L, f->lineinfo, f->sizelineinfo, int); + luaM_freearray(L, f->locvars, f->sizelocvars, struct LocVar); + luaM_freearray(L, f->upvalues, f->sizeupvalues, TString *); + luaM_free(L, f); +} + + +void luaF_freeclosure (lua_State *L, Closure *c) { + int size = (c->c.isC) ? sizeCclosure(c->c.nupvalues) : + sizeLclosure(c->l.nupvalues); + luaM_freemem(L, c, size); +} + + +/* +** Look for n-th local variable at line `line' in function `func'. +** Returns NULL if not found. +*/ +const char *luaF_getlocalname (const Proto *f, int local_number, int pc) { + int i; + for (i = 0; isizelocvars && f->locvars[i].startpc <= pc; i++) { + if (pc < f->locvars[i].endpc) { /* is variable active? */ + local_number--; + if (local_number == 0) + return getstr(f->locvars[i].varname); + } + } + return NULL; /* not found */ +} + diff --git a/src/lua-vm/lfunc.h b/src/lua-vm/lfunc.h new file mode 100644 index 0000000..2e02419 --- /dev/null +++ b/src/lua-vm/lfunc.h @@ -0,0 +1,34 @@ +/* +** $Id: lfunc.h,v 2.4 2005/04/25 19:24:10 roberto Exp $ +** Auxiliary functions to manipulate prototypes and closures +** See Copyright Notice in lua.h +*/ + +#ifndef lfunc_h +#define lfunc_h + + +#include "lobject.h" + + +#define sizeCclosure(n) (cast(int, sizeof(CClosure)) + \ + cast(int, sizeof(TValue)*((n)-1))) + +#define sizeLclosure(n) (cast(int, sizeof(LClosure)) + \ + cast(int, sizeof(TValue *)*((n)-1))) + + +LUAI_FUNC Proto *luaF_newproto (lua_State *L); +LUAI_FUNC Closure *luaF_newCclosure (lua_State *L, int nelems, Table *e); +LUAI_FUNC Closure *luaF_newLclosure (lua_State *L, int nelems, Table *e); +LUAI_FUNC UpVal *luaF_newupval (lua_State *L); +LUAI_FUNC UpVal *luaF_findupval (lua_State *L, StkId level); +LUAI_FUNC void luaF_close (lua_State *L, StkId level); +LUAI_FUNC void luaF_freeproto (lua_State *L, Proto *f); +LUAI_FUNC void luaF_freeclosure (lua_State *L, Closure *c); +LUAI_FUNC void luaF_freeupval (lua_State *L, UpVal *uv); +LUAI_FUNC const char *luaF_getlocalname (const Proto *func, int local_number, + int pc); + + +#endif diff --git a/src/lua-vm/lgc.c b/src/lua-vm/lgc.c new file mode 100644 index 0000000..2d24a12 --- /dev/null +++ b/src/lua-vm/lgc.c @@ -0,0 +1,711 @@ +/* +** $Id: lgc.c,v 2.38 2006/05/24 14:34:06 roberto Exp $ +** Garbage Collector +** See Copyright Notice in lua.h +*/ + +#include + +#define lgc_c +#define LUA_CORE + +#include "lua.h" + +#include "ldebug.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" + + +#define GCSTEPSIZE 1024u +#define GCSWEEPMAX 40 +#define GCSWEEPCOST 10 +#define GCFINALIZECOST 100 + + +#define maskmarks cast_byte(~(bitmask(BLACKBIT)|WHITEBITS)) + +#define makewhite(g,x) \ + ((x)->gch.marked = cast_byte(((x)->gch.marked & maskmarks) | luaC_white(g))) + +#define white2gray(x) reset2bits((x)->gch.marked, WHITE0BIT, WHITE1BIT) +#define black2gray(x) resetbit((x)->gch.marked, BLACKBIT) + +#define stringmark(s) reset2bits((s)->tsv.marked, WHITE0BIT, WHITE1BIT) + + +#define isfinalized(u) testbit((u)->marked, FINALIZEDBIT) +#define markfinalized(u) l_setbit((u)->marked, FINALIZEDBIT) + + +#define KEYWEAK bitmask(KEYWEAKBIT) +#define VALUEWEAK bitmask(VALUEWEAKBIT) + + + +#define markvalue(g,o) { checkconsistency(o); \ + if (iscollectable(o) && iswhite(gcvalue(o))) reallymarkobject(g,gcvalue(o)); } + +#define markobject(g,t) { if (iswhite(obj2gco(t))) \ + reallymarkobject(g, obj2gco(t)); } + + +#define setthreshold(g) (g->GCthreshold = (g->estimate/100) * g->gcpause) + + +static void removeentry (Node *n) { + lua_assert(ttisnil(gval(n))); + if (iscollectable(gkey(n))) + setttype(gkey(n), LUA_TDEADKEY); /* dead key; remove it */ +} + + +static void reallymarkobject (global_State *g, GCObject *o) { + lua_assert(iswhite(o) && !isdead(g, o)); + white2gray(o); + switch (o->gch.tt) { + case LUA_TSTRING: { + return; + } + case LUA_TUSERDATA: { + Table *mt = gco2u(o)->metatable; + gray2black(o); /* udata are never gray */ + if (mt) markobject(g, mt); + markobject(g, gco2u(o)->env); + return; + } + case LUA_TUPVAL: { + UpVal *uv = gco2uv(o); + markvalue(g, uv->v); + if (uv->v == &uv->u.value) /* closed? */ + gray2black(o); /* open upvalues are never black */ + return; + } + case LUA_TFUNCTION: { + gco2cl(o)->c.gclist = g->gray; + g->gray = o; + break; + } + case LUA_TTABLE: { + gco2h(o)->gclist = g->gray; + g->gray = o; + break; + } + case LUA_TTHREAD: { + gco2th(o)->gclist = g->gray; + g->gray = o; + break; + } + case LUA_TPROTO: { + gco2p(o)->gclist = g->gray; + g->gray = o; + break; + } + default: lua_assert(0); + } +} + + +static void marktmu (global_State *g) { + GCObject *u = g->tmudata; + if (u) { + do { + u = u->gch.next; + makewhite(g, u); /* may be marked, if left from previous GC */ + reallymarkobject(g, u); + } while (u != g->tmudata); + } +} + + +/* move `dead' udata that need finalization to list `tmudata' */ +size_t luaC_separateudata (lua_State *L, int all) { + global_State *g = G(L); + size_t deadmem = 0; + GCObject **p = &g->mainthread->next; + GCObject *curr; + while ((curr = *p) != NULL) { + if (!(iswhite(curr) || all) || isfinalized(gco2u(curr))) + p = &curr->gch.next; /* don't bother with them */ + else if (fasttm(L, gco2u(curr)->metatable, TM_GC) == NULL) { + markfinalized(gco2u(curr)); /* don't need finalization */ + p = &curr->gch.next; + } + else { /* must call its gc method */ + deadmem += sizeudata(gco2u(curr)); + markfinalized(gco2u(curr)); + *p = curr->gch.next; + /* link `curr' at the end of `tmudata' list */ + if (g->tmudata == NULL) /* list is empty? */ + g->tmudata = curr->gch.next = curr; /* creates a circular list */ + else { + curr->gch.next = g->tmudata->gch.next; + g->tmudata->gch.next = curr; + g->tmudata = curr; + } + } + } + return deadmem; +} + + +static int traversetable (global_State *g, Table *h) { + int i; + int weakkey = 0; + int weakvalue = 0; + const TValue *mode; + if (h->metatable) + markobject(g, h->metatable); + mode = gfasttm(g, h->metatable, TM_MODE); + if (mode && ttisstring(mode)) { /* is there a weak mode? */ + weakkey = (strchr(svalue(mode), 'k') != NULL); + weakvalue = (strchr(svalue(mode), 'v') != NULL); + if (weakkey || weakvalue) { /* is really weak? */ + h->marked &= ~(KEYWEAK | VALUEWEAK); /* clear bits */ + h->marked |= cast_byte((weakkey << KEYWEAKBIT) | + (weakvalue << VALUEWEAKBIT)); + h->gclist = g->weak; /* must be cleared after GC, ... */ + g->weak = obj2gco(h); /* ... so put in the appropriate list */ + } + } + if (weakkey && weakvalue) return 1; + if (!weakvalue) { + i = h->sizearray; + while (i--) + markvalue(g, &h->array[i]); + } + i = sizenode(h); + while (i--) { + Node *n = gnode(h, i); + lua_assert(ttype(gkey(n)) != LUA_TDEADKEY || ttisnil(gval(n))); + if (ttisnil(gval(n))) + removeentry(n); /* remove empty entries */ + else { + lua_assert(!ttisnil(gkey(n))); + if (!weakkey) markvalue(g, gkey(n)); + if (!weakvalue) markvalue(g, gval(n)); + } + } + return weakkey || weakvalue; +} + + +/* +** All marks are conditional because a GC may happen while the +** prototype is still being created +*/ +static void traverseproto (global_State *g, Proto *f) { + int i; + if (f->source) stringmark(f->source); + for (i=0; isizek; i++) /* mark literals */ + markvalue(g, &f->k[i]); + for (i=0; isizeupvalues; i++) { /* mark upvalue names */ + if (f->upvalues[i]) + stringmark(f->upvalues[i]); + } + for (i=0; isizep; i++) { /* mark nested protos */ + if (f->p[i]) + markobject(g, f->p[i]); + } + for (i=0; isizelocvars; i++) { /* mark local-variable names */ + if (f->locvars[i].varname) + stringmark(f->locvars[i].varname); + } +} + + + +static void traverseclosure (global_State *g, Closure *cl) { + markobject(g, cl->c.env); + if (cl->c.isC) { + int i; + for (i=0; ic.nupvalues; i++) /* mark its upvalues */ + markvalue(g, &cl->c.upvalue[i]); + } + else { + int i; + lua_assert(cl->l.nupvalues == cl->l.p->nups); + markobject(g, cl->l.p); + for (i=0; il.nupvalues; i++) /* mark its upvalues */ + markobject(g, cl->l.upvals[i]); + } +} + + +static void checkstacksizes (lua_State *L, StkId max) { + int ci_used = cast_int(L->ci - L->base_ci); /* number of `ci' in use */ + int s_used = cast_int(max - L->stack); /* part of stack in use */ + if (L->size_ci > LUAI_MAXCALLS) /* handling overflow? */ + return; /* do not touch the stacks */ + if (4*ci_used < L->size_ci && 2*BASIC_CI_SIZE < L->size_ci) + luaD_reallocCI(L, L->size_ci/2); /* still big enough... */ + condhardstacktests(luaD_reallocCI(L, ci_used + 1)); + if (4*s_used < L->stacksize && + 2*(BASIC_STACK_SIZE+EXTRA_STACK) < L->stacksize) + luaD_reallocstack(L, L->stacksize/2); /* still big enough... */ + condhardstacktests(luaD_reallocstack(L, s_used)); +} + + +static void traversestack (global_State *g, lua_State *l) { + StkId o, lim; + CallInfo *ci; + markvalue(g, gt(l)); + lim = l->top; + for (ci = l->base_ci; ci <= l->ci; ci++) { + lua_assert(ci->top <= l->stack_last); + if (lim < ci->top) lim = ci->top; + } + for (o = l->stack; o < l->top; o++) + markvalue(g, o); + for (; o <= lim; o++) + setnilvalue(o); + checkstacksizes(l, lim); +} + + +/* +** traverse one gray object, turning it to black. +** Returns `quantity' traversed. +*/ +static l_mem propagatemark (global_State *g) { + GCObject *o = g->gray; + lua_assert(isgray(o)); + gray2black(o); + switch (o->gch.tt) { + case LUA_TTABLE: { + Table *h = gco2h(o); + g->gray = h->gclist; + if (traversetable(g, h)) /* table is weak? */ + black2gray(o); /* keep it gray */ + return sizeof(Table) + sizeof(TValue) * h->sizearray + + sizeof(Node) * sizenode(h); + } + case LUA_TFUNCTION: { + Closure *cl = gco2cl(o); + g->gray = cl->c.gclist; + traverseclosure(g, cl); + return (cl->c.isC) ? sizeCclosure(cl->c.nupvalues) : + sizeLclosure(cl->l.nupvalues); + } + case LUA_TTHREAD: { + lua_State *th = gco2th(o); + g->gray = th->gclist; + th->gclist = g->grayagain; + g->grayagain = o; + black2gray(o); + traversestack(g, th); + return sizeof(lua_State) + sizeof(TValue) * th->stacksize + + sizeof(CallInfo) * th->size_ci; + } + case LUA_TPROTO: { + Proto *p = gco2p(o); + g->gray = p->gclist; + traverseproto(g, p); + return sizeof(Proto) + sizeof(Instruction) * p->sizecode + + sizeof(Proto *) * p->sizep + + sizeof(TValue) * p->sizek + + sizeof(int) * p->sizelineinfo + + sizeof(LocVar) * p->sizelocvars + + sizeof(TString *) * p->sizeupvalues; + } + default: lua_assert(0); return 0; + } +} + + +static size_t propagateall (global_State *g) { + size_t m = 0; + while (g->gray) m += propagatemark(g); + return m; +} + + +/* +** The next function tells whether a key or value can be cleared from +** a weak table. Non-collectable objects are never removed from weak +** tables. Strings behave as `values', so are never removed too. for +** other objects: if really collected, cannot keep them; for userdata +** being finalized, keep them in keys, but not in values +*/ +static int iscleared (const TValue *o, int iskey) { + if (!iscollectable(o)) return 0; + if (ttisstring(o)) { + stringmark(rawtsvalue(o)); /* strings are `values', so are never weak */ + return 0; + } + return iswhite(gcvalue(o)) || + (ttisuserdata(o) && (!iskey && isfinalized(uvalue(o)))); +} + + +/* +** clear collected entries from weaktables +*/ +static void cleartable (GCObject *l) { + while (l) { + Table *h = gco2h(l); + int i = h->sizearray; + lua_assert(testbit(h->marked, VALUEWEAKBIT) || + testbit(h->marked, KEYWEAKBIT)); + if (testbit(h->marked, VALUEWEAKBIT)) { + while (i--) { + TValue *o = &h->array[i]; + if (iscleared(o, 0)) /* value was collected? */ + setnilvalue(o); /* remove value */ + } + } + i = sizenode(h); + while (i--) { + Node *n = gnode(h, i); + if (!ttisnil(gval(n)) && /* non-empty entry? */ + (iscleared(key2tval(n), 1) || iscleared(gval(n), 0))) { + setnilvalue(gval(n)); /* remove value ... */ + removeentry(n); /* remove entry from table */ + } + } + l = h->gclist; + } +} + + +static void freeobj (lua_State *L, GCObject *o) { + switch (o->gch.tt) { + case LUA_TPROTO: luaF_freeproto(L, gco2p(o)); break; + case LUA_TFUNCTION: luaF_freeclosure(L, gco2cl(o)); break; + case LUA_TUPVAL: luaF_freeupval(L, gco2uv(o)); break; + case LUA_TTABLE: luaH_free(L, gco2h(o)); break; + case LUA_TTHREAD: { + lua_assert(gco2th(o) != L && gco2th(o) != G(L)->mainthread); + luaE_freethread(L, gco2th(o)); + break; + } + case LUA_TSTRING: { + G(L)->strt.nuse--; + luaM_freemem(L, o, sizestring(gco2ts(o))); + break; + } + case LUA_TUSERDATA: { + luaM_freemem(L, o, sizeudata(gco2u(o))); + break; + } + default: lua_assert(0); + } +} + + + +#define sweepwholelist(L,p) sweeplist(L,p,MAX_LUMEM) + + +static GCObject **sweeplist (lua_State *L, GCObject **p, lu_mem count) { + GCObject *curr; + global_State *g = G(L); + int deadmask = otherwhite(g); + while ((curr = *p) != NULL && count-- > 0) { + if (curr->gch.tt == LUA_TTHREAD) /* sweep open upvalues of each thread */ + sweepwholelist(L, &gco2th(curr)->openupval); + if ((curr->gch.marked ^ WHITEBITS) & deadmask) { /* not dead? */ + lua_assert(!isdead(g, curr) || testbit(curr->gch.marked, FIXEDBIT)); + makewhite(g, curr); /* make it white (for next cycle) */ + p = &curr->gch.next; + } + else { /* must erase `curr' */ + lua_assert(isdead(g, curr) || deadmask == bitmask(SFIXEDBIT)); + *p = curr->gch.next; + if (curr == g->rootgc) /* is the first element of the list? */ + g->rootgc = curr->gch.next; /* adjust first */ + freeobj(L, curr); + } + } + return p; +} + + +static void checkSizes (lua_State *L) { + global_State *g = G(L); + /* check size of string hash */ + if (g->strt.nuse < cast(lu_int32, g->strt.size/4) && + g->strt.size > MINSTRTABSIZE*2) + luaS_resize(L, g->strt.size/2); /* table is too big */ + /* check size of buffer */ + if (luaZ_sizebuffer(&g->buff) > LUA_MINBUFFER*2) { /* buffer too big? */ + size_t newsize = luaZ_sizebuffer(&g->buff) / 2; + luaZ_resizebuffer(L, &g->buff, newsize); + } +} + + +static void GCTM (lua_State *L) { + global_State *g = G(L); + GCObject *o = g->tmudata->gch.next; /* get first element */ + Udata *udata = rawgco2u(o); + const TValue *tm; + /* remove udata from `tmudata' */ + if (o == g->tmudata) /* last element? */ + g->tmudata = NULL; + else + g->tmudata->gch.next = udata->uv.next; + udata->uv.next = g->mainthread->next; /* return it to `root' list */ + g->mainthread->next = o; + makewhite(g, o); + tm = fasttm(L, udata->uv.metatable, TM_GC); + if (tm != NULL) { + lu_byte oldah = L->allowhook; + lu_mem oldt = g->GCthreshold; + L->allowhook = 0; /* stop debug hooks during GC tag method */ + g->GCthreshold = 2*g->totalbytes; /* avoid GC steps */ + setobj2s(L, L->top, tm); + setuvalue(L, L->top+1, udata); + L->top += 2; + luaD_call(L, L->top - 2, 0); + L->allowhook = oldah; /* restore hooks */ + g->GCthreshold = oldt; /* restore threshold */ + } +} + + +/* +** Call all GC tag methods +*/ +void luaC_callGCTM (lua_State *L) { + while (G(L)->tmudata) + GCTM(L); +} + + +void luaC_freeall (lua_State *L) { + global_State *g = G(L); + int i; + g->currentwhite = WHITEBITS | bitmask(SFIXEDBIT); /* mask to collect all elements */ + sweepwholelist(L, &g->rootgc); + for (i = 0; i < g->strt.size; i++) /* free all string lists */ + sweepwholelist(L, &g->strt.hash[i]); +} + + +static void markmt (global_State *g) { + int i; + for (i=0; imt[i]) markobject(g, g->mt[i]); +} + + +/* mark root set */ +static void markroot (lua_State *L) { + global_State *g = G(L); + g->gray = NULL; + g->grayagain = NULL; + g->weak = NULL; + markobject(g, g->mainthread); + /* make global table be traversed before main stack */ + markvalue(g, gt(g->mainthread)); + markvalue(g, registry(L)); + markmt(g); + g->gcstate = GCSpropagate; +} + + +static void remarkupvals (global_State *g) { + UpVal *uv; + for (uv = g->uvhead.u.l.next; uv != &g->uvhead; uv = uv->u.l.next) { + lua_assert(uv->u.l.next->u.l.prev == uv && uv->u.l.prev->u.l.next == uv); + if (isgray(obj2gco(uv))) + markvalue(g, uv->v); + } +} + + +static void atomic (lua_State *L) { + global_State *g = G(L); + size_t udsize; /* total size of userdata to be finalized */ + /* remark occasional upvalues of (maybe) dead threads */ + remarkupvals(g); + /* traverse objects cautch by write barrier and by 'remarkupvals' */ + propagateall(g); + /* remark weak tables */ + g->gray = g->weak; + g->weak = NULL; + lua_assert(!iswhite(obj2gco(g->mainthread))); + markobject(g, L); /* mark running thread */ + markmt(g); /* mark basic metatables (again) */ + propagateall(g); + /* remark gray again */ + g->gray = g->grayagain; + g->grayagain = NULL; + propagateall(g); + udsize = luaC_separateudata(L, 0); /* separate userdata to be finalized */ + marktmu(g); /* mark `preserved' userdata */ + udsize += propagateall(g); /* remark, to propagate `preserveness' */ + cleartable(g->weak); /* remove collected objects from weak tables */ + /* flip current white */ + g->currentwhite = cast_byte(otherwhite(g)); + g->sweepstrgc = 0; + g->sweepgc = &g->rootgc; + g->gcstate = GCSsweepstring; + g->estimate = g->totalbytes - udsize; /* first estimate */ +} + + +static l_mem singlestep (lua_State *L) { + global_State *g = G(L); + /*lua_checkmemory(L);*/ + switch (g->gcstate) { + case GCSpause: { + markroot(L); /* start a new collection */ + return 0; + } + case GCSpropagate: { + if (g->gray) + return propagatemark(g); + else { /* no more `gray' objects */ + atomic(L); /* finish mark phase */ + return 0; + } + } + case GCSsweepstring: { + lu_mem old = g->totalbytes; + sweepwholelist(L, &g->strt.hash[g->sweepstrgc++]); + if (g->sweepstrgc >= g->strt.size) /* nothing more to sweep? */ + g->gcstate = GCSsweep; /* end sweep-string phase */ + lua_assert(old >= g->totalbytes); + g->estimate -= old - g->totalbytes; + return GCSWEEPCOST; + } + case GCSsweep: { + lu_mem old = g->totalbytes; + g->sweepgc = sweeplist(L, g->sweepgc, GCSWEEPMAX); + if (*g->sweepgc == NULL) { /* nothing more to sweep? */ + checkSizes(L); + g->gcstate = GCSfinalize; /* end sweep phase */ + } + lua_assert(old >= g->totalbytes); + g->estimate -= old - g->totalbytes; + return GCSWEEPMAX*GCSWEEPCOST; + } + case GCSfinalize: { + if (g->tmudata) { + GCTM(L); + if (g->estimate > GCFINALIZECOST) + g->estimate -= GCFINALIZECOST; + return GCFINALIZECOST; + } + else { + g->gcstate = GCSpause; /* end collection */ + g->gcdept = 0; + return 0; + } + } + default: lua_assert(0); return 0; + } +} + + +void luaC_step (lua_State *L) { + global_State *g = G(L); + l_mem lim = (GCSTEPSIZE/100) * g->gcstepmul; + if (lim == 0) + lim = (MAX_LUMEM-1)/2; /* no limit */ + g->gcdept += g->totalbytes - g->GCthreshold; + do { + lim -= singlestep(L); + if (g->gcstate == GCSpause) + break; + } while (lim > 0); + if (g->gcstate != GCSpause) { + if (g->gcdept < GCSTEPSIZE) + g->GCthreshold = g->totalbytes + GCSTEPSIZE; /* - lim/g->gcstepmul;*/ + else { + g->gcdept -= GCSTEPSIZE; + g->GCthreshold = g->totalbytes; + } + } + else { + lua_assert(g->totalbytes >= g->estimate); + setthreshold(g); + } +} + + +void luaC_fullgc (lua_State *L) { + global_State *g = G(L); + if (g->gcstate <= GCSpropagate) { + /* reset sweep marks to sweep all elements (returning them to white) */ + g->sweepstrgc = 0; + g->sweepgc = &g->rootgc; + /* reset other collector lists */ + g->gray = NULL; + g->grayagain = NULL; + g->weak = NULL; + g->gcstate = GCSsweepstring; + } + lua_assert(g->gcstate != GCSpause && g->gcstate != GCSpropagate); + /* finish any pending sweep phase */ + while (g->gcstate != GCSfinalize) { + lua_assert(g->gcstate == GCSsweepstring || g->gcstate == GCSsweep); + singlestep(L); + } + markroot(L); + while (g->gcstate != GCSpause) { + singlestep(L); + } + setthreshold(g); +} + + +void luaC_barrierf (lua_State *L, GCObject *o, GCObject *v) { + global_State *g = G(L); + lua_assert(isblack(o) && iswhite(v) && !isdead(g, v) && !isdead(g, o)); + lua_assert(g->gcstate != GCSfinalize && g->gcstate != GCSpause); + lua_assert(ttype(&o->gch) != LUA_TTABLE); + /* must keep invariant? */ + if (g->gcstate == GCSpropagate) + reallymarkobject(g, v); /* restore invariant */ + else /* don't mind */ + makewhite(g, o); /* mark as white just to avoid other barriers */ +} + + +void luaC_barrierback (lua_State *L, Table *t) { + global_State *g = G(L); + GCObject *o = obj2gco(t); + lua_assert(isblack(o) && !isdead(g, o)); + lua_assert(g->gcstate != GCSfinalize && g->gcstate != GCSpause); + black2gray(o); /* make table gray (again) */ + t->gclist = g->grayagain; + g->grayagain = o; +} + + +void luaC_link (lua_State *L, GCObject *o, lu_byte tt) { + global_State *g = G(L); + o->gch.next = g->rootgc; + g->rootgc = o; + o->gch.marked = luaC_white(g); + o->gch.tt = tt; +} + + +void luaC_linkupval (lua_State *L, UpVal *uv) { + global_State *g = G(L); + GCObject *o = obj2gco(uv); + o->gch.next = g->rootgc; /* link upvalue into `rootgc' list */ + g->rootgc = o; + if (isgray(o)) { + if (g->gcstate == GCSpropagate) { + gray2black(o); /* closed upvalues need barrier */ + luaC_barrier(L, uv, uv->v); + } + else { /* sweep phase: sweep it (turning it into white) */ + makewhite(g, o); + lua_assert(g->gcstate != GCSfinalize && g->gcstate != GCSpause); + } + } +} + diff --git a/src/lua-vm/lgc.h b/src/lua-vm/lgc.h new file mode 100644 index 0000000..5f69acb --- /dev/null +++ b/src/lua-vm/lgc.h @@ -0,0 +1,110 @@ +/* +** $Id: lgc.h,v 2.15 2005/08/24 16:15:49 roberto Exp $ +** Garbage Collector +** See Copyright Notice in lua.h +*/ + +#ifndef lgc_h +#define lgc_h + + +#include "lobject.h" + + +/* +** Possible states of the Garbage Collector +*/ +#define GCSpause 0 +#define GCSpropagate 1 +#define GCSsweepstring 2 +#define GCSsweep 3 +#define GCSfinalize 4 + + +/* +** some userful bit tricks +*/ +#define resetbits(x,m) ((x) &= cast(lu_byte, ~(m))) +#define setbits(x,m) ((x) |= (m)) +#define testbits(x,m) ((x) & (m)) +#define bitmask(b) (1<<(b)) +#define bit2mask(b1,b2) (bitmask(b1) | bitmask(b2)) +#define l_setbit(x,b) setbits(x, bitmask(b)) +#define resetbit(x,b) resetbits(x, bitmask(b)) +#define testbit(x,b) testbits(x, bitmask(b)) +#define set2bits(x,b1,b2) setbits(x, (bit2mask(b1, b2))) +#define reset2bits(x,b1,b2) resetbits(x, (bit2mask(b1, b2))) +#define test2bits(x,b1,b2) testbits(x, (bit2mask(b1, b2))) + + + +/* +** Layout for bit use in `marked' field: +** bit 0 - object is white (type 0) +** bit 1 - object is white (type 1) +** bit 2 - object is black +** bit 3 - for userdata: has been finalized +** bit 3 - for tables: has weak keys +** bit 4 - for tables: has weak values +** bit 5 - object is fixed (should not be collected) +** bit 6 - object is "super" fixed (only the main thread) +*/ + + +#define WHITE0BIT 0 +#define WHITE1BIT 1 +#define BLACKBIT 2 +#define FINALIZEDBIT 3 +#define KEYWEAKBIT 3 +#define VALUEWEAKBIT 4 +#define FIXEDBIT 5 +#define SFIXEDBIT 6 +#define WHITEBITS bit2mask(WHITE0BIT, WHITE1BIT) + + +#define iswhite(x) test2bits((x)->gch.marked, WHITE0BIT, WHITE1BIT) +#define isblack(x) testbit((x)->gch.marked, BLACKBIT) +#define isgray(x) (!isblack(x) && !iswhite(x)) + +#define otherwhite(g) (g->currentwhite ^ WHITEBITS) +#define isdead(g,v) ((v)->gch.marked & otherwhite(g) & WHITEBITS) + +#define changewhite(x) ((x)->gch.marked ^= WHITEBITS) +#define gray2black(x) l_setbit((x)->gch.marked, BLACKBIT) + +#define valiswhite(x) (iscollectable(x) && iswhite(gcvalue(x))) + +#define luaC_white(g) cast(lu_byte, (g)->currentwhite & WHITEBITS) + + +#define luaC_checkGC(L) { \ + condhardstacktests(luaD_reallocstack(L, L->stacksize - EXTRA_STACK - 1)); \ + if (G(L)->totalbytes >= G(L)->GCthreshold) \ + luaC_step(L); } + + +#define luaC_barrier(L,p,v) { if (valiswhite(v) && isblack(obj2gco(p))) \ + luaC_barrierf(L,obj2gco(p),gcvalue(v)); } + +#define luaC_barriert(L,t,v) { if (valiswhite(v) && isblack(obj2gco(t))) \ + luaC_barrierback(L,t); } + +#define luaC_objbarrier(L,p,o) \ + { if (iswhite(obj2gco(o)) && isblack(obj2gco(p))) \ + luaC_barrierf(L,obj2gco(p),obj2gco(o)); } + +#define luaC_objbarriert(L,t,o) \ + { if (iswhite(obj2gco(o)) && isblack(obj2gco(t))) luaC_barrierback(L,t); } + +LUAI_FUNC size_t luaC_separateudata (lua_State *L, int all); +LUAI_FUNC void luaC_callGCTM (lua_State *L); +LUAI_FUNC void luaC_freeall (lua_State *L); +LUAI_FUNC void luaC_step (lua_State *L); +LUAI_FUNC void luaC_fullgc (lua_State *L); +LUAI_FUNC void luaC_link (lua_State *L, GCObject *o, lu_byte tt); +LUAI_FUNC void luaC_linkupval (lua_State *L, UpVal *uv); +LUAI_FUNC void luaC_barrierf (lua_State *L, GCObject *o, GCObject *v); +LUAI_FUNC void luaC_barrierback (lua_State *L, Table *t); + + +#endif diff --git a/src/lua-vm/linit.c b/src/lua-vm/linit.c new file mode 100644 index 0000000..3c1fb3a --- /dev/null +++ b/src/lua-vm/linit.c @@ -0,0 +1,59 @@ +/* +** $Id: linit.c,v 1.14 2005/12/29 15:32:11 roberto Exp $ +** Initialization of libraries for lua.c +** See Copyright Notice in lua.h +*/ + + +#define linit_c +#define LUA_LIB + +#include "lua.h" + +#include "lualib.h" +#include "lauxlib.h" + + +static const luaL_Reg objlibs[] = { + {"", luaopen_base}, + {LUA_LOADLIBNAME, luaopen_package}, + {LUA_TABLIBNAME, luaopen_table}, + {LUA_IOLIBNAME, luaopen_io}, + {LUA_OSLIBNAME, luaopen_os}, + {LUA_STRLIBNAME, luaopen_string}, + {LUA_MATHLIBNAME, luaopen_math}, + {LUA_DBLIBNAME, luaopen_debug}, + {NULL, NULL} +}; + +static const char *lualibs[] = { + // "metalua", + NULL +}; + + +LUALIB_API void luaL_openlibs (lua_State *L) { + const luaL_Reg *objlib; + const char **lualib; + + for (objlib = objlibs; objlib->func; objlib++) { + lua_pushcfunction(L, objlib->func); + lua_pushstring(L, objlib->name); + lua_call(L, 1, 0); + } + + for (lualib = lualibs; *lualib; lualib++) { + int r; + lua_getglobal (L, "require"); + lua_pushstring (L, *lualib); + r = lua_pcall (L, 1, 0, 0); + if( 0 != r) { + const char *msg = lua_tostring( L, -1); + if( ! msg) msg = "unprintable"; + printf( "Lua non fatal init error loading lua library '%s':\n%s\n", + *lualib, msg); + lua_pop( L, 1); /* Restore the stack in its original state */ + } + } +} + diff --git a/src/lua-vm/liolib.c b/src/lua-vm/liolib.c new file mode 100644 index 0000000..be60972 --- /dev/null +++ b/src/lua-vm/liolib.c @@ -0,0 +1,532 @@ +/* +** $Id: liolib.c,v 2.73 2006/05/08 20:14:16 roberto Exp $ +** Standard I/O (and system) library +** See Copyright Notice in lua.h +*/ + + +#include +#include +#include +#include + +#define liolib_c +#define LUA_LIB + +#include "lua.h" + +#include "lauxlib.h" +#include "lualib.h" + + + +#define IO_INPUT 1 +#define IO_OUTPUT 2 + + +static const char *const fnames[] = {"input", "output"}; + + +static int pushresult (lua_State *L, int i, const char *filename) { + int en = errno; /* calls to Lua API may change this value */ + if (i) { + lua_pushboolean(L, 1); + return 1; + } + else { + lua_pushnil(L); + if (filename) + lua_pushfstring(L, "%s: %s", filename, strerror(en)); + else + lua_pushfstring(L, "%s", strerror(en)); + lua_pushinteger(L, en); + return 3; + } +} + + +static void fileerror (lua_State *L, int arg, const char *filename) { + lua_pushfstring(L, "%s: %s", filename, strerror(errno)); + luaL_argerror(L, arg, lua_tostring(L, -1)); +} + + +#define topfile(L) ((FILE **)luaL_checkudata(L, 1, LUA_FILEHANDLE)) + + +static int io_type (lua_State *L) { + void *ud; + luaL_checkany(L, 1); + ud = lua_touserdata(L, 1); + lua_getfield(L, LUA_REGISTRYINDEX, LUA_FILEHANDLE); + if (ud == NULL || !lua_getmetatable(L, 1) || !lua_rawequal(L, -2, -1)) + lua_pushnil(L); /* not a file */ + else if (*((FILE **)ud) == NULL) + lua_pushliteral(L, "closed file"); + else + lua_pushliteral(L, "file"); + return 1; +} + + +static FILE *tofile (lua_State *L) { + FILE **f = topfile(L); + if (*f == NULL) + luaL_error(L, "attempt to use a closed file"); + return *f; +} + + + +/* +** When creating file handles, always creates a `closed' file handle +** before opening the actual file; so, if there is a memory error, the +** file is not left opened. +*/ +static FILE **newfile (lua_State *L) { + FILE **pf = (FILE **)lua_newuserdata(L, sizeof(FILE *)); + *pf = NULL; /* file handle is currently `closed' */ + luaL_getmetatable(L, LUA_FILEHANDLE); + lua_setmetatable(L, -2); + return pf; +} + + +/* +** this function has a separated environment, which defines the +** correct __close for 'popen' files +*/ +static int io_pclose (lua_State *L) { + FILE **p = topfile(L); + int ok = lua_pclose(L, *p); + *p = NULL; + return pushresult(L, ok, NULL); +} + + +static int io_fclose (lua_State *L) { + FILE **p = topfile(L); + int ok = (fclose(*p) == 0); + *p = NULL; + return pushresult(L, ok, NULL); +} + + +static int aux_close (lua_State *L) { + lua_getfenv(L, 1); + lua_getfield(L, -1, "__close"); + return (lua_tocfunction(L, -1))(L); +} + + +static int io_close (lua_State *L) { + if (lua_isnone(L, 1)) + lua_rawgeti(L, LUA_ENVIRONINDEX, IO_OUTPUT); + tofile(L); /* make sure argument is a file */ + return aux_close(L); +} + + +static int io_gc (lua_State *L) { + FILE *f = *topfile(L); + /* ignore closed files and standard files */ + if (f != NULL && f != stdin && f != stdout && f != stderr) + aux_close(L); + return 0; +} + + +static int io_tostring (lua_State *L) { + FILE *f = *topfile(L); + if (f == NULL) + lua_pushstring(L, "file (closed)"); + else + lua_pushfstring(L, "file (%p)", f); + return 1; +} + + +static int io_open (lua_State *L) { + const char *filename = luaL_checkstring(L, 1); + const char *mode = luaL_optstring(L, 2, "r"); + FILE **pf = newfile(L); + *pf = fopen(filename, mode); + return (*pf == NULL) ? pushresult(L, 0, filename) : 1; +} + + +static int io_popen (lua_State *L) { + const char *filename = luaL_checkstring(L, 1); + const char *mode = luaL_optstring(L, 2, "r"); + FILE **pf = newfile(L); + *pf = lua_popen(L, filename, mode); + return (*pf == NULL) ? pushresult(L, 0, filename) : 1; +} + + +static int io_tmpfile (lua_State *L) { + FILE **pf = newfile(L); + *pf = tmpfile(); + return (*pf == NULL) ? pushresult(L, 0, NULL) : 1; +} + + +static FILE *getiofile (lua_State *L, int findex) { + FILE *f; + lua_rawgeti(L, LUA_ENVIRONINDEX, findex); + f = *(FILE **)lua_touserdata(L, -1); + if (f == NULL) + luaL_error(L, "standard %s file is closed", fnames[findex - 1]); + return f; +} + + +static int g_iofile (lua_State *L, int f, const char *mode) { + if (!lua_isnoneornil(L, 1)) { + const char *filename = lua_tostring(L, 1); + if (filename) { + FILE **pf = newfile(L); + *pf = fopen(filename, mode); + if (*pf == NULL) + fileerror(L, 1, filename); + } + else { + tofile(L); /* check that it's a valid file handle */ + lua_pushvalue(L, 1); + } + lua_rawseti(L, LUA_ENVIRONINDEX, f); + } + /* return current value */ + lua_rawgeti(L, LUA_ENVIRONINDEX, f); + return 1; +} + + +static int io_input (lua_State *L) { + return g_iofile(L, IO_INPUT, "r"); +} + + +static int io_output (lua_State *L) { + return g_iofile(L, IO_OUTPUT, "w"); +} + + +static int io_readline (lua_State *L); + + +static void aux_lines (lua_State *L, int idx, int toclose) { + lua_pushvalue(L, idx); + lua_pushboolean(L, toclose); /* close/not close file when finished */ + lua_pushcclosure(L, io_readline, 2); +} + + +static int f_lines (lua_State *L) { + tofile(L); /* check that it's a valid file handle */ + aux_lines(L, 1, 0); + return 1; +} + + +static int io_lines (lua_State *L) { + if (lua_isnoneornil(L, 1)) { /* no arguments? */ + /* will iterate over default input */ + lua_rawgeti(L, LUA_ENVIRONINDEX, IO_INPUT); + return f_lines(L); + } + else { + const char *filename = luaL_checkstring(L, 1); + FILE **pf = newfile(L); + *pf = fopen(filename, "r"); + if (*pf == NULL) + fileerror(L, 1, filename); + aux_lines(L, lua_gettop(L), 1); + return 1; + } +} + + +/* +** {====================================================== +** READ +** ======================================================= +*/ + + +static int read_number (lua_State *L, FILE *f) { + lua_Number d; + if (fscanf(f, LUA_NUMBER_SCAN, &d) == 1) { + lua_pushnumber(L, d); + return 1; + } + else return 0; /* read fails */ +} + + +static int test_eof (lua_State *L, FILE *f) { + int c = getc(f); + ungetc(c, f); + lua_pushlstring(L, NULL, 0); + return (c != EOF); +} + + +static int read_line (lua_State *L, FILE *f) { + luaL_Buffer b; + luaL_buffinit(L, &b); + for (;;) { + size_t l; + char *p = luaL_prepbuffer(&b); + if (fgets(p, LUAL_BUFFERSIZE, f) == NULL) { /* eof? */ + luaL_pushresult(&b); /* close buffer */ + return (lua_strlen(L, -1) > 0); /* check whether read something */ + } + l = strlen(p); + if (l == 0 || p[l-1] != '\n') + luaL_addsize(&b, l); + else { + luaL_addsize(&b, l - 1); /* do not include `eol' */ + luaL_pushresult(&b); /* close buffer */ + return 1; /* read at least an `eol' */ + } + } +} + + +static int read_chars (lua_State *L, FILE *f, size_t n) { + size_t rlen; /* how much to read */ + size_t nr; /* number of chars actually read */ + luaL_Buffer b; + luaL_buffinit(L, &b); + rlen = LUAL_BUFFERSIZE; /* try to read that much each time */ + do { + char *p = luaL_prepbuffer(&b); + if (rlen > n) rlen = n; /* cannot read more than asked */ + nr = fread(p, sizeof(char), rlen, f); + luaL_addsize(&b, nr); + n -= nr; /* still have to read `n' chars */ + } while (n > 0 && nr == rlen); /* until end of count or eof */ + luaL_pushresult(&b); /* close buffer */ + return (n == 0 || lua_strlen(L, -1) > 0); +} + + +static int g_read (lua_State *L, FILE *f, int first) { + int nargs = lua_gettop(L) - 1; + int success; + int n; + clearerr(f); + if (nargs == 0) { /* no arguments? */ + success = read_line(L, f); + n = first+1; /* to return 1 result */ + } + else { /* ensure stack space for all results and for auxlib's buffer */ + luaL_checkstack(L, nargs+LUA_MINSTACK, "too many arguments"); + success = 1; + for (n = first; nargs-- && success; n++) { + if (lua_type(L, n) == LUA_TNUMBER) { + size_t l = (size_t)lua_tointeger(L, n); + success = (l == 0) ? test_eof(L, f) : read_chars(L, f, l); + } + else { + const char *p = lua_tostring(L, n); + luaL_argcheck(L, p && p[0] == '*', n, "invalid option"); + switch (p[1]) { + case 'n': /* number */ + success = read_number(L, f); + break; + case 'l': /* line */ + success = read_line(L, f); + break; + case 'a': /* file */ + read_chars(L, f, ~((size_t)0)); /* read MAX_SIZE_T chars */ + success = 1; /* always success */ + break; + default: + return luaL_argerror(L, n, "invalid format"); + } + } + } + } + if (ferror(f)) + return pushresult(L, 0, NULL); + if (!success) { + lua_pop(L, 1); /* remove last result */ + lua_pushnil(L); /* push nil instead */ + } + return n - first; +} + + +static int io_read (lua_State *L) { + return g_read(L, getiofile(L, IO_INPUT), 1); +} + + +static int f_read (lua_State *L) { + return g_read(L, tofile(L), 2); +} + + +static int io_readline (lua_State *L) { + FILE *f = *(FILE **)lua_touserdata(L, lua_upvalueindex(1)); + int sucess; + if (f == NULL) /* file is already closed? */ + luaL_error(L, "file is already closed"); + sucess = read_line(L, f); + if (ferror(f)) + return luaL_error(L, "%s", strerror(errno)); + if (sucess) return 1; + else { /* EOF */ + if (lua_toboolean(L, lua_upvalueindex(2))) { /* generator created file? */ + lua_settop(L, 0); + lua_pushvalue(L, lua_upvalueindex(1)); + aux_close(L); /* close it */ + } + return 0; + } +} + +/* }====================================================== */ + + +static int g_write (lua_State *L, FILE *f, int arg) { + int nargs = lua_gettop(L) - 1; + int status = 1; + for (; nargs--; arg++) { + if (lua_type(L, arg) == LUA_TNUMBER) { + /* optimization: could be done exactly as for strings */ + status = status && + fprintf(f, LUA_NUMBER_FMT, lua_tonumber(L, arg)) > 0; + } + else { + size_t l; + const char *s = luaL_checklstring(L, arg, &l); + status = status && (fwrite(s, sizeof(char), l, f) == l); + } + } + return pushresult(L, status, NULL); +} + + +static int io_write (lua_State *L) { + return g_write(L, getiofile(L, IO_OUTPUT), 1); +} + + +static int f_write (lua_State *L) { + return g_write(L, tofile(L), 2); +} + + +static int f_seek (lua_State *L) { + static const int mode[] = {SEEK_SET, SEEK_CUR, SEEK_END}; + static const char *const modenames[] = {"set", "cur", "end", NULL}; + FILE *f = tofile(L); + int op = luaL_checkoption(L, 2, "cur", modenames); + long offset = luaL_optlong(L, 3, 0); + op = fseek(f, offset, mode[op]); + if (op) + return pushresult(L, 0, NULL); /* error */ + else { + lua_pushinteger(L, ftell(f)); + return 1; + } +} + + +static int f_setvbuf (lua_State *L) { + static const int mode[] = {_IONBF, _IOFBF, _IOLBF}; + static const char *const modenames[] = {"no", "full", "line", NULL}; + FILE *f = tofile(L); + int op = luaL_checkoption(L, 2, NULL, modenames); + lua_Integer sz = luaL_optinteger(L, 3, LUAL_BUFFERSIZE); + int res = setvbuf(f, NULL, mode[op], sz); + return pushresult(L, res == 0, NULL); +} + + + +static int io_flush (lua_State *L) { + return pushresult(L, fflush(getiofile(L, IO_OUTPUT)) == 0, NULL); +} + + +static int f_flush (lua_State *L) { + return pushresult(L, fflush(tofile(L)) == 0, NULL); +} + + +static const luaL_Reg iolib[] = { + {"close", io_close}, + {"flush", io_flush}, + {"input", io_input}, + {"lines", io_lines}, + {"open", io_open}, + {"output", io_output}, + {"popen", io_popen}, + {"read", io_read}, + {"tmpfile", io_tmpfile}, + {"type", io_type}, + {"write", io_write}, + {NULL, NULL} +}; + + +static const luaL_Reg flib[] = { + {"close", io_close}, + {"flush", f_flush}, + {"lines", f_lines}, + {"read", f_read}, + {"seek", f_seek}, + {"setvbuf", f_setvbuf}, + {"write", f_write}, + {"__gc", io_gc}, + {"__tostring", io_tostring}, + {NULL, NULL} +}; + + +static void createmeta (lua_State *L) { + luaL_newmetatable(L, LUA_FILEHANDLE); /* create metatable for file handles */ + lua_pushvalue(L, -1); /* push metatable */ + lua_setfield(L, -2, "__index"); /* metatable.__index = metatable */ + luaL_register(L, NULL, flib); /* file methods */ +} + + +static void createstdfile (lua_State *L, FILE *f, int k, const char *fname) { + *newfile(L) = f; + if (k > 0) { + lua_pushvalue(L, -1); + lua_rawseti(L, LUA_ENVIRONINDEX, k); + } + lua_setfield(L, -2, fname); +} + + +LUALIB_API int luaopen_io (lua_State *L) { + createmeta(L); + /* create (private) environment (with fields IO_INPUT, IO_OUTPUT, __close) */ + lua_createtable(L, 2, 1); + lua_replace(L, LUA_ENVIRONINDEX); + /* open library */ + luaL_register(L, LUA_IOLIBNAME, iolib); + /* create (and set) default files */ + createstdfile(L, stdin, IO_INPUT, "stdin"); + createstdfile(L, stdout, IO_OUTPUT, "stdout"); + createstdfile(L, stderr, 0, "stderr"); + /* create environment for 'popen' */ + lua_getfield(L, -1, "popen"); + lua_createtable(L, 0, 1); + lua_pushcfunction(L, io_pclose); + lua_setfield(L, -2, "__close"); + lua_setfenv(L, -2); + lua_pop(L, 1); /* pop 'popen' */ + /* set default close function */ + lua_pushcfunction(L, io_fclose); + lua_setfield(L, LUA_ENVIRONINDEX, "__close"); + return 1; +} + diff --git a/src/lua-vm/llex.c b/src/lua-vm/llex.c new file mode 100644 index 0000000..1c07cad --- /dev/null +++ b/src/lua-vm/llex.c @@ -0,0 +1,461 @@ +/* +** $Id: llex.c,v 2.20 2006/03/09 18:14:31 roberto Exp $ +** Lexical Analyzer +** See Copyright Notice in lua.h +*/ + + +#include +#include +#include + +#define llex_c +#define LUA_CORE + +#include "lua.h" + +#include "ldo.h" +#include "llex.h" +#include "lobject.h" +#include "lparser.h" +#include "lstate.h" +#include "lstring.h" +#include "ltable.h" +#include "lzio.h" + + + +#define next(ls) (ls->current = zgetc(ls->z)) + + + + +#define currIsNewline(ls) (ls->current == '\n' || ls->current == '\r') + + +/* ORDER RESERVED */ +const char *const luaX_tokens [] = { + "and", "break", "do", "else", "elseif", + "end", "false", "for", "function", "if", + "in", "local", "nil", "not", "or", "repeat", + "return", "then", "true", "until", "while", + "..", "...", "==", ">=", "<=", "~=", + "", "", "", "", + NULL +}; + + +#define save_and_next(ls) (save(ls, ls->current), next(ls)) + + +static void save (LexState *ls, int c) { + Mbuffer *b = ls->buff; + if (b->n + 1 > b->buffsize) { + size_t newsize; + if (b->buffsize >= MAX_SIZET/2) + luaX_lexerror(ls, "lexical element too long", 0); + newsize = b->buffsize * 2; + luaZ_resizebuffer(ls->L, b, newsize); + } + b->buffer[b->n++] = cast(char, c); +} + + +void luaX_init (lua_State *L) { + int i; + for (i=0; itsv.reserved = cast_byte(i+1); /* reserved word */ + } +} + + +#define MAXSRC 80 + + +const char *luaX_token2str (LexState *ls, int token) { + if (token < FIRST_RESERVED) { + lua_assert(token == cast(unsigned char, token)); + return (iscntrl(token)) ? luaO_pushfstring(ls->L, "char(%d)", token) : + luaO_pushfstring(ls->L, "%c", token); + } + else + return luaX_tokens[token-FIRST_RESERVED]; +} + + +static const char *txtToken (LexState *ls, int token) { + switch (token) { + case TK_NAME: + case TK_STRING: + case TK_NUMBER: + save(ls, '\0'); + return luaZ_buffer(ls->buff); + default: + return luaX_token2str(ls, token); + } +} + + +void luaX_lexerror (LexState *ls, const char *msg, int token) { + char buff[MAXSRC]; + luaO_chunkid(buff, getstr(ls->source), MAXSRC); + msg = luaO_pushfstring(ls->L, "%s:%d: %s", buff, ls->linenumber, msg); + if (token) + luaO_pushfstring(ls->L, "%s near " LUA_QS, msg, txtToken(ls, token)); + luaD_throw(ls->L, LUA_ERRSYNTAX); +} + + +void luaX_syntaxerror (LexState *ls, const char *msg) { + luaX_lexerror(ls, msg, ls->t.token); +} + + +TString *luaX_newstring (LexState *ls, const char *str, size_t l) { + lua_State *L = ls->L; + TString *ts = luaS_newlstr(L, str, l); + TValue *o = luaH_setstr(L, ls->fs->h, ts); /* entry for `str' */ + if (ttisnil(o)) + setbvalue(o, 1); /* make sure `str' will not be collected */ + return ts; +} + + +static void inclinenumber (LexState *ls) { + int old = ls->current; + lua_assert(currIsNewline(ls)); + next(ls); /* skip `\n' or `\r' */ + if (currIsNewline(ls) && ls->current != old) + next(ls); /* skip `\n\r' or `\r\n' */ + if (++ls->linenumber >= MAX_INT) + luaX_syntaxerror(ls, "chunk has too many lines"); +} + + +void luaX_setinput (lua_State *L, LexState *ls, ZIO *z, TString *source) { + ls->decpoint = '.'; + ls->L = L; + ls->lookahead.token = TK_EOS; /* no look-ahead token */ + ls->z = z; + ls->fs = NULL; + ls->linenumber = 1; + ls->lastline = 1; + ls->source = source; + luaZ_resizebuffer(ls->L, ls->buff, LUA_MINBUFFER); /* initialize buffer */ + next(ls); /* read first char */ +} + + + +/* +** ======================================================= +** LEXICAL ANALYZER +** ======================================================= +*/ + + + +static int check_next (LexState *ls, const char *set) { + if (!strchr(set, ls->current)) + return 0; + save_and_next(ls); + return 1; +} + + +static void buffreplace (LexState *ls, char from, char to) { + size_t n = luaZ_bufflen(ls->buff); + char *p = luaZ_buffer(ls->buff); + while (n--) + if (p[n] == from) p[n] = to; +} + + +static void trydecpoint (LexState *ls, SemInfo *seminfo) { + /* format error: try to update decimal point separator */ + struct lconv *cv = localeconv(); + char old = ls->decpoint; + ls->decpoint = (cv ? cv->decimal_point[0] : '.'); + buffreplace(ls, old, ls->decpoint); /* try updated decimal separator */ + if (!luaO_str2d(luaZ_buffer(ls->buff), &seminfo->r)) { + /* format error with correct decimal point: no more options */ + buffreplace(ls, ls->decpoint, '.'); /* undo change (for error message) */ + luaX_lexerror(ls, "malformed number", TK_NUMBER); + } +} + + +/* LUA_NUMBER */ +static void read_numeral (LexState *ls, SemInfo *seminfo) { + lua_assert(isdigit(ls->current)); + do { + save_and_next(ls); + } while (isdigit(ls->current) || ls->current == '.'); + if (check_next(ls, "Ee")) /* `E'? */ + check_next(ls, "+-"); /* optional exponent sign */ + while (isalnum(ls->current) || ls->current == '_') + save_and_next(ls); + save(ls, '\0'); + buffreplace(ls, '.', ls->decpoint); /* follow locale for decimal point */ + if (!luaO_str2d(luaZ_buffer(ls->buff), &seminfo->r)) /* format error? */ + trydecpoint(ls, seminfo); /* try to update decimal point separator */ +} + + +static int skip_sep (LexState *ls) { + int count = 0; + int s = ls->current; + lua_assert(s == '[' || s == ']'); + save_and_next(ls); + while (ls->current == '=') { + save_and_next(ls); + count++; + } + return (ls->current == s) ? count : (-count) - 1; +} + + +static void read_long_string (LexState *ls, SemInfo *seminfo, int sep) { + int cont = 0; + (void)(cont); /* avoid warnings when `cont' is not used */ + save_and_next(ls); /* skip 2nd `[' */ + if (currIsNewline(ls)) /* string starts with a newline? */ + inclinenumber(ls); /* skip it */ + for (;;) { + switch (ls->current) { + case EOZ: + luaX_lexerror(ls, (seminfo) ? "unfinished long string" : + "unfinished long comment", TK_EOS); + break; /* to avoid warnings */ +#if defined(LUA_COMPAT_LSTR) + case '[': { + if (skip_sep(ls) == sep) { + save_and_next(ls); /* skip 2nd `[' */ + cont++; +#if LUA_COMPAT_LSTR == 1 + if (sep == 0) + luaX_lexerror(ls, "nesting of [[...]] is deprecated", '['); +#endif + } + break; + } +#endif + case ']': { + if (skip_sep(ls) == sep) { + save_and_next(ls); /* skip 2nd `]' */ +#if defined(LUA_COMPAT_LSTR) && LUA_COMPAT_LSTR == 2 + cont--; + if (sep == 0 && cont >= 0) break; +#endif + goto endloop; + } + break; + } + case '\n': + case '\r': { + save(ls, '\n'); + inclinenumber(ls); + if (!seminfo) luaZ_resetbuffer(ls->buff); /* avoid wasting space */ + break; + } + default: { + if (seminfo) save_and_next(ls); + else next(ls); + } + } + } endloop: + if (seminfo) + seminfo->ts = luaX_newstring(ls, luaZ_buffer(ls->buff) + (2 + sep), + luaZ_bufflen(ls->buff) - 2*(2 + sep)); +} + + +static void read_string (LexState *ls, int del, SemInfo *seminfo) { + save_and_next(ls); + while (ls->current != del) { + switch (ls->current) { + case EOZ: + luaX_lexerror(ls, "unfinished string", TK_EOS); + continue; /* to avoid warnings */ + case '\n': + case '\r': + luaX_lexerror(ls, "unfinished string", TK_STRING); + continue; /* to avoid warnings */ + case '\\': { + int c; + next(ls); /* do not save the `\' */ + switch (ls->current) { + case 'a': c = '\a'; break; + case 'b': c = '\b'; break; + case 'f': c = '\f'; break; + case 'n': c = '\n'; break; + case 'r': c = '\r'; break; + case 't': c = '\t'; break; + case 'v': c = '\v'; break; + case '\n': /* go through */ + case '\r': save(ls, '\n'); inclinenumber(ls); continue; + case EOZ: continue; /* will raise an error next loop */ + default: { + if (!isdigit(ls->current)) + save_and_next(ls); /* handles \\, \", \', and \? */ + else { /* \xxx */ + int i = 0; + c = 0; + do { + c = 10*c + (ls->current-'0'); + next(ls); + } while (++i<3 && isdigit(ls->current)); + if (c > UCHAR_MAX) + luaX_lexerror(ls, "escape sequence too large", TK_STRING); + save(ls, c); + } + continue; + } + } + save(ls, c); + next(ls); + continue; + } + default: + save_and_next(ls); + } + } + save_and_next(ls); /* skip delimiter */ + seminfo->ts = luaX_newstring(ls, luaZ_buffer(ls->buff) + 1, + luaZ_bufflen(ls->buff) - 2); +} + + +static int llex (LexState *ls, SemInfo *seminfo) { + luaZ_resetbuffer(ls->buff); + for (;;) { + switch (ls->current) { + case '\n': + case '\r': { + inclinenumber(ls); + continue; + } + case '-': { + next(ls); + if (ls->current != '-') return '-'; + /* else is a comment */ + next(ls); + if (ls->current == '[') { + int sep = skip_sep(ls); + luaZ_resetbuffer(ls->buff); /* `skip_sep' may dirty the buffer */ + if (sep >= 0) { + read_long_string(ls, NULL, sep); /* long comment */ + luaZ_resetbuffer(ls->buff); + continue; + } + } + /* else short comment */ + while (!currIsNewline(ls) && ls->current != EOZ) + next(ls); + continue; + } + case '[': { + int sep = skip_sep(ls); + if (sep >= 0) { + read_long_string(ls, seminfo, sep); + return TK_STRING; + } + else if (sep == -1) return '['; + else luaX_lexerror(ls, "invalid long string delimiter", TK_STRING); + } + case '=': { + next(ls); + if (ls->current != '=') return '='; + else { next(ls); return TK_EQ; } + } + case '<': { + next(ls); + if (ls->current != '=') return '<'; + else { next(ls); return TK_LE; } + } + case '>': { + next(ls); + if (ls->current != '=') return '>'; + else { next(ls); return TK_GE; } + } + case '~': { + next(ls); + if (ls->current != '=') return '~'; + else { next(ls); return TK_NE; } + } + case '"': + case '\'': { + read_string(ls, ls->current, seminfo); + return TK_STRING; + } + case '.': { + save_and_next(ls); + if (check_next(ls, ".")) { + if (check_next(ls, ".")) + return TK_DOTS; /* ... */ + else return TK_CONCAT; /* .. */ + } + else if (!isdigit(ls->current)) return '.'; + else { + read_numeral(ls, seminfo); + return TK_NUMBER; + } + } + case EOZ: { + return TK_EOS; + } + default: { + if (isspace(ls->current)) { + lua_assert(!currIsNewline(ls)); + next(ls); + continue; + } + else if (isdigit(ls->current)) { + read_numeral(ls, seminfo); + return TK_NUMBER; + } + else if (isalpha(ls->current) || ls->current == '_') { + /* identifier or reserved word */ + TString *ts; + do { + save_and_next(ls); + } while (isalnum(ls->current) || ls->current == '_'); + ts = luaX_newstring(ls, luaZ_buffer(ls->buff), + luaZ_bufflen(ls->buff)); + if (ts->tsv.reserved > 0) /* reserved word? */ + return ts->tsv.reserved - 1 + FIRST_RESERVED; + else { + seminfo->ts = ts; + return TK_NAME; + } + } + else { + int c = ls->current; + next(ls); + return c; /* single-char tokens (+ - / ...) */ + } + } + } + } +} + + +void luaX_next (LexState *ls) { + ls->lastline = ls->linenumber; + if (ls->lookahead.token != TK_EOS) { /* is there a look-ahead token? */ + ls->t = ls->lookahead; /* use this one */ + ls->lookahead.token = TK_EOS; /* and discharge it */ + } + else + ls->t.token = llex(ls, &ls->t.seminfo); /* read next token */ +} + + +void luaX_lookahead (LexState *ls) { + lua_assert(ls->lookahead.token == TK_EOS); + ls->lookahead.token = llex(ls, &ls->lookahead.seminfo); +} + diff --git a/src/lua-vm/llex.h b/src/lua-vm/llex.h new file mode 100644 index 0000000..ff07e83 --- /dev/null +++ b/src/lua-vm/llex.h @@ -0,0 +1,81 @@ +/* +** $Id: llex.h,v 1.58 2006/03/23 18:23:32 roberto Exp $ +** Lexical Analyzer +** See Copyright Notice in lua.h +*/ + +#ifndef llex_h +#define llex_h + +#include "lobject.h" +#include "lzio.h" + + +#define FIRST_RESERVED 257 + +/* maximum length of a reserved word */ +#define TOKEN_LEN (sizeof("function")/sizeof(char)) + + +/* +* WARNING: if you change the order of this enumeration, +* grep "ORDER RESERVED" +*/ +enum RESERVED { + /* terminal symbols denoted by reserved words */ + TK_AND = FIRST_RESERVED, TK_BREAK, + TK_DO, TK_ELSE, TK_ELSEIF, TK_END, TK_FALSE, TK_FOR, TK_FUNCTION, + TK_IF, TK_IN, TK_LOCAL, TK_NIL, TK_NOT, TK_OR, TK_REPEAT, + TK_RETURN, TK_THEN, TK_TRUE, TK_UNTIL, TK_WHILE, + /* other terminal symbols */ + TK_CONCAT, TK_DOTS, TK_EQ, TK_GE, TK_LE, TK_NE, TK_NUMBER, + TK_NAME, TK_STRING, TK_EOS +}; + +/* number of reserved words */ +#define NUM_RESERVED (cast(int, TK_WHILE-FIRST_RESERVED+1)) + + +/* array with token `names' */ +LUAI_DATA const char *const luaX_tokens []; + + +typedef union { + lua_Number r; + TString *ts; +} SemInfo; /* semantics information */ + + +typedef struct Token { + int token; + SemInfo seminfo; +} Token; + + +typedef struct LexState { + int current; /* current character (charint) */ + int linenumber; /* input line counter */ + int lastline; /* line of last token `consumed' */ + Token t; /* current token */ + Token lookahead; /* look ahead token */ + struct FuncState *fs; /* `FuncState' is private to the parser */ + struct lua_State *L; + ZIO *z; /* input stream */ + Mbuffer *buff; /* buffer for tokens */ + TString *source; /* current source name */ + char decpoint; /* locale decimal point */ +} LexState; + + +LUAI_FUNC void luaX_init (lua_State *L); +LUAI_FUNC void luaX_setinput (lua_State *L, LexState *ls, ZIO *z, + TString *source); +LUAI_FUNC TString *luaX_newstring (LexState *ls, const char *str, size_t l); +LUAI_FUNC void luaX_next (LexState *ls); +LUAI_FUNC void luaX_lookahead (LexState *ls); +LUAI_FUNC void luaX_lexerror (LexState *ls, const char *msg, int token); +LUAI_FUNC void luaX_syntaxerror (LexState *ls, const char *s); +LUAI_FUNC const char *luaX_token2str (LexState *ls, int token); + + +#endif diff --git a/src/lua-vm/llimits.h b/src/lua-vm/llimits.h new file mode 100644 index 0000000..b03221a --- /dev/null +++ b/src/lua-vm/llimits.h @@ -0,0 +1,128 @@ +/* +** $Id: llimits.h,v 1.69 2005/12/27 17:12:00 roberto Exp $ +** Limits, basic types, and some other `installation-dependent' definitions +** See Copyright Notice in lua.h +*/ + +#ifndef llimits_h +#define llimits_h + + +#include +#include + + +#include "lua.h" + + +typedef LUAI_UINT32 lu_int32; + +typedef LUAI_UMEM lu_mem; + +typedef LUAI_MEM l_mem; + + + +/* chars used as small naturals (so that `char' is reserved for characters) */ +typedef unsigned char lu_byte; + + +#define MAX_SIZET ((size_t)(~(size_t)0)-2) + +#define MAX_LUMEM ((lu_mem)(~(lu_mem)0)-2) + + +#define MAX_INT (INT_MAX-2) /* maximum value of an int (-2 for safety) */ + +/* +** conversion of pointer to integer +** this is for hashing only; there is no problem if the integer +** cannot hold the whole pointer value +*/ +#define IntPoint(p) ((unsigned int)(lu_mem)(p)) + + + +/* type to ensure maximum alignment */ +typedef LUAI_USER_ALIGNMENT_T L_Umaxalign; + + +/* result of a `usual argument conversion' over lua_Number */ +typedef LUAI_UACNUMBER l_uacNumber; + + +/* internal assertions for in-house debugging */ +#ifdef lua_assert + +#define check_exp(c,e) (lua_assert(c), (e)) +#define api_check(l,e) lua_assert(e) + +#else + +#define lua_assert(c) ((void)0) +#define check_exp(c,e) (e) +#define api_check luai_apicheck + +#endif + + +#ifndef UNUSED +#define UNUSED(x) ((void)(x)) /* to avoid warnings */ +#endif + + +#ifndef cast +#define cast(t, exp) ((t)(exp)) +#endif + +#define cast_byte(i) cast(lu_byte, (i)) +#define cast_num(i) cast(lua_Number, (i)) +#define cast_int(i) cast(int, (i)) + + + +/* +** type for virtual-machine instructions +** must be an unsigned with (at least) 4 bytes (see details in lopcodes.h) +*/ +typedef lu_int32 Instruction; + + + +/* maximum stack for a Lua function */ +#define MAXSTACK 250 + + + +/* minimum size for the string table (must be power of 2) */ +#ifndef MINSTRTABSIZE +#define MINSTRTABSIZE 32 +#endif + + +/* minimum size for string buffer */ +#ifndef LUA_MINBUFFER +#define LUA_MINBUFFER 32 +#endif + + +#ifndef lua_lock +#define lua_lock(L) ((void) 0) +#define lua_unlock(L) ((void) 0) +#endif + +#ifndef luai_threadyield +#define luai_threadyield(L) {lua_unlock(L); lua_lock(L);} +#endif + + +/* +** macro to control inclusion of some hard tests on stack reallocation +*/ +#ifndef HARDSTACKTESTS +#define condhardstacktests(x) ((void)0) +#else +#define condhardstacktests(x) x +#endif + +#endif diff --git a/src/lua-vm/lmathlib.c b/src/lua-vm/lmathlib.c new file mode 100644 index 0000000..d181a73 --- /dev/null +++ b/src/lua-vm/lmathlib.c @@ -0,0 +1,263 @@ +/* +** $Id: lmathlib.c,v 1.67 2005/08/26 17:36:32 roberto Exp $ +** Standard mathematical library +** See Copyright Notice in lua.h +*/ + + +#include +#include + +#define lmathlib_c +#define LUA_LIB + +#include "lua.h" + +#include "lauxlib.h" +#include "lualib.h" + + +#undef PI +#define PI (3.14159265358979323846) +#define RADIANS_PER_DEGREE (PI/180.0) + + + +static int math_abs (lua_State *L) { + lua_pushnumber(L, fabs(luaL_checknumber(L, 1))); + return 1; +} + +static int math_sin (lua_State *L) { + lua_pushnumber(L, sin(luaL_checknumber(L, 1))); + return 1; +} + +static int math_sinh (lua_State *L) { + lua_pushnumber(L, sinh(luaL_checknumber(L, 1))); + return 1; +} + +static int math_cos (lua_State *L) { + lua_pushnumber(L, cos(luaL_checknumber(L, 1))); + return 1; +} + +static int math_cosh (lua_State *L) { + lua_pushnumber(L, cosh(luaL_checknumber(L, 1))); + return 1; +} + +static int math_tan (lua_State *L) { + lua_pushnumber(L, tan(luaL_checknumber(L, 1))); + return 1; +} + +static int math_tanh (lua_State *L) { + lua_pushnumber(L, tanh(luaL_checknumber(L, 1))); + return 1; +} + +static int math_asin (lua_State *L) { + lua_pushnumber(L, asin(luaL_checknumber(L, 1))); + return 1; +} + +static int math_acos (lua_State *L) { + lua_pushnumber(L, acos(luaL_checknumber(L, 1))); + return 1; +} + +static int math_atan (lua_State *L) { + lua_pushnumber(L, atan(luaL_checknumber(L, 1))); + return 1; +} + +static int math_atan2 (lua_State *L) { + lua_pushnumber(L, atan2(luaL_checknumber(L, 1), luaL_checknumber(L, 2))); + return 1; +} + +static int math_ceil (lua_State *L) { + lua_pushnumber(L, ceil(luaL_checknumber(L, 1))); + return 1; +} + +static int math_floor (lua_State *L) { + lua_pushnumber(L, floor(luaL_checknumber(L, 1))); + return 1; +} + +static int math_fmod (lua_State *L) { + lua_pushnumber(L, fmod(luaL_checknumber(L, 1), luaL_checknumber(L, 2))); + return 1; +} + +static int math_modf (lua_State *L) { + double ip; + double fp = modf(luaL_checknumber(L, 1), &ip); + lua_pushnumber(L, ip); + lua_pushnumber(L, fp); + return 2; +} + +static int math_sqrt (lua_State *L) { + lua_pushnumber(L, sqrt(luaL_checknumber(L, 1))); + return 1; +} + +static int math_pow (lua_State *L) { + lua_pushnumber(L, pow(luaL_checknumber(L, 1), luaL_checknumber(L, 2))); + return 1; +} + +static int math_log (lua_State *L) { + lua_pushnumber(L, log(luaL_checknumber(L, 1))); + return 1; +} + +static int math_log10 (lua_State *L) { + lua_pushnumber(L, log10(luaL_checknumber(L, 1))); + return 1; +} + +static int math_exp (lua_State *L) { + lua_pushnumber(L, exp(luaL_checknumber(L, 1))); + return 1; +} + +static int math_deg (lua_State *L) { + lua_pushnumber(L, luaL_checknumber(L, 1)/RADIANS_PER_DEGREE); + return 1; +} + +static int math_rad (lua_State *L) { + lua_pushnumber(L, luaL_checknumber(L, 1)*RADIANS_PER_DEGREE); + return 1; +} + +static int math_frexp (lua_State *L) { + int e; + lua_pushnumber(L, frexp(luaL_checknumber(L, 1), &e)); + lua_pushinteger(L, e); + return 2; +} + +static int math_ldexp (lua_State *L) { + lua_pushnumber(L, ldexp(luaL_checknumber(L, 1), luaL_checkint(L, 2))); + return 1; +} + + + +static int math_min (lua_State *L) { + int n = lua_gettop(L); /* number of arguments */ + lua_Number dmin = luaL_checknumber(L, 1); + int i; + for (i=2; i<=n; i++) { + lua_Number d = luaL_checknumber(L, i); + if (d < dmin) + dmin = d; + } + lua_pushnumber(L, dmin); + return 1; +} + + +static int math_max (lua_State *L) { + int n = lua_gettop(L); /* number of arguments */ + lua_Number dmax = luaL_checknumber(L, 1); + int i; + for (i=2; i<=n; i++) { + lua_Number d = luaL_checknumber(L, i); + if (d > dmax) + dmax = d; + } + lua_pushnumber(L, dmax); + return 1; +} + + +static int math_random (lua_State *L) { + /* the `%' avoids the (rare) case of r==1, and is needed also because on + some systems (SunOS!) `rand()' may return a value larger than RAND_MAX */ + lua_Number r = (lua_Number)(rand()%RAND_MAX) / (lua_Number)RAND_MAX; + switch (lua_gettop(L)) { /* check number of arguments */ + case 0: { /* no arguments */ + lua_pushnumber(L, r); /* Number between 0 and 1 */ + break; + } + case 1: { /* only upper limit */ + int u = luaL_checkint(L, 1); + luaL_argcheck(L, 1<=u, 1, "interval is empty"); + lua_pushnumber(L, floor(r*u)+1); /* int between 1 and `u' */ + break; + } + case 2: { /* lower and upper limits */ + int l = luaL_checkint(L, 1); + int u = luaL_checkint(L, 2); + luaL_argcheck(L, l<=u, 2, "interval is empty"); + lua_pushnumber(L, floor(r*(u-l+1))+l); /* int between `l' and `u' */ + break; + } + default: return luaL_error(L, "wrong number of arguments"); + } + return 1; +} + + +static int math_randomseed (lua_State *L) { + srand(luaL_checkint(L, 1)); + return 0; +} + + +static const luaL_Reg mathlib[] = { + {"abs", math_abs}, + {"acos", math_acos}, + {"asin", math_asin}, + {"atan2", math_atan2}, + {"atan", math_atan}, + {"ceil", math_ceil}, + {"cosh", math_cosh}, + {"cos", math_cos}, + {"deg", math_deg}, + {"exp", math_exp}, + {"floor", math_floor}, + {"fmod", math_fmod}, + {"frexp", math_frexp}, + {"ldexp", math_ldexp}, + {"log10", math_log10}, + {"log", math_log}, + {"max", math_max}, + {"min", math_min}, + {"modf", math_modf}, + {"pow", math_pow}, + {"rad", math_rad}, + {"random", math_random}, + {"randomseed", math_randomseed}, + {"sinh", math_sinh}, + {"sin", math_sin}, + {"sqrt", math_sqrt}, + {"tanh", math_tanh}, + {"tan", math_tan}, + {NULL, NULL} +}; + + +/* +** Open math library +*/ +LUALIB_API int luaopen_math (lua_State *L) { + luaL_register(L, LUA_MATHLIBNAME, mathlib); + lua_pushnumber(L, PI); + lua_setfield(L, -2, "pi"); + lua_pushnumber(L, HUGE_VAL); + lua_setfield(L, -2, "huge"); +#if defined(LUA_COMPAT_MOD) + lua_getfield(L, -1, "fmod"); + lua_setfield(L, -2, "mod"); +#endif + return 1; +} + diff --git a/src/lua-vm/lmem.c b/src/lua-vm/lmem.c new file mode 100644 index 0000000..cef2bc5 --- /dev/null +++ b/src/lua-vm/lmem.c @@ -0,0 +1,86 @@ +/* +** $Id: lmem.c,v 1.70 2005/12/26 13:35:47 roberto Exp $ +** Interface to Memory Manager +** See Copyright Notice in lua.h +*/ + + +#include + +#define lmem_c +#define LUA_CORE + +#include "lua.h" + +#include "ldebug.h" +#include "ldo.h" +#include "lmem.h" +#include "lobject.h" +#include "lstate.h" + + + +/* +** About the realloc function: +** void * frealloc (void *ud, void *ptr, size_t osize, size_t nsize); +** (`osize' is the old size, `nsize' is the new size) +** +** Lua ensures that (ptr == NULL) iff (osize == 0). +** +** * frealloc(ud, NULL, 0, x) creates a new block of size `x' +** +** * frealloc(ud, p, x, 0) frees the block `p' +** (in this specific case, frealloc must return NULL). +** particularly, frealloc(ud, NULL, 0, 0) does nothing +** (which is equivalent to free(NULL) in ANSI C) +** +** frealloc returns NULL if it cannot create or reallocate the area +** (any reallocation to an equal or smaller size cannot fail!) +*/ + + + +#define MINSIZEARRAY 4 + + +void *luaM_growaux_ (lua_State *L, void *block, int *size, size_t size_elems, + int limit, const char *errormsg) { + void *newblock; + int newsize; + if (*size >= limit/2) { /* cannot double it? */ + if (*size >= limit) /* cannot grow even a little? */ + luaG_runerror(L, errormsg); + newsize = limit; /* still have at least one free place */ + } + else { + newsize = (*size)*2; + if (newsize < MINSIZEARRAY) + newsize = MINSIZEARRAY; /* minimum size */ + } + newblock = luaM_reallocv(L, block, *size, newsize, size_elems); + *size = newsize; /* update only when everything else is OK */ + return newblock; +} + + +void *luaM_toobig (lua_State *L) { + luaG_runerror(L, "memory allocation error: block too big"); + return NULL; /* to avoid warnings */ +} + + + +/* +** generic allocation routine. +*/ +void *luaM_realloc_ (lua_State *L, void *block, size_t osize, size_t nsize) { + global_State *g = G(L); + lua_assert((osize == 0) == (block == NULL)); + block = (*g->frealloc)(g->ud, block, osize, nsize); + if (block == NULL && nsize > 0) + luaD_throw(L, LUA_ERRMEM); + lua_assert((nsize == 0) == (block == NULL)); + g->totalbytes = (g->totalbytes - osize) + nsize; + return block; +} + diff --git a/src/lua-vm/lmem.h b/src/lua-vm/lmem.h new file mode 100644 index 0000000..19df1fb --- /dev/null +++ b/src/lua-vm/lmem.h @@ -0,0 +1,49 @@ +/* +** $Id: lmem.h,v 1.31 2005/04/25 19:24:10 roberto Exp $ +** Interface to Memory Manager +** See Copyright Notice in lua.h +*/ + +#ifndef lmem_h +#define lmem_h + + +#include + +#include "llimits.h" +#include "lua.h" + +#define MEMERRMSG "not enough memory" + + +#define luaM_reallocv(L,b,on,n,e) \ + ((cast(size_t, (n)+1) <= MAX_SIZET/(e)) ? /* +1 to avoid warnings */ \ + luaM_realloc_(L, (b), (on)*(e), (n)*(e)) : \ + luaM_toobig(L)) + +#define luaM_freemem(L, b, s) luaM_realloc_(L, (b), (s), 0) +#define luaM_free(L, b) luaM_realloc_(L, (b), sizeof(*(b)), 0) +#define luaM_freearray(L, b, n, t) luaM_reallocv(L, (b), n, 0, sizeof(t)) + +#define luaM_malloc(L,t) luaM_realloc_(L, NULL, 0, (t)) +#define luaM_new(L,t) cast(t *, luaM_malloc(L, sizeof(t))) +#define luaM_newvector(L,n,t) \ + cast(t *, luaM_reallocv(L, NULL, 0, n, sizeof(t))) + +#define luaM_growvector(L,v,nelems,size,t,limit,e) \ + if ((nelems)+1 > (size)) \ + ((v)=cast(t *, luaM_growaux_(L,v,&(size),sizeof(t),limit,e))) + +#define luaM_reallocvector(L, v,oldn,n,t) \ + ((v)=cast(t *, luaM_reallocv(L, v, oldn, n, sizeof(t)))) + + +LUAI_FUNC void *luaM_realloc_ (lua_State *L, void *block, size_t oldsize, + size_t size); +LUAI_FUNC void *luaM_toobig (lua_State *L); +LUAI_FUNC void *luaM_growaux_ (lua_State *L, void *block, int *size, + size_t size_elem, int limit, + const char *errormsg); + +#endif + diff --git a/src/lua-vm/loadlib.c b/src/lua-vm/loadlib.c new file mode 100644 index 0000000..523d5e2 --- /dev/null +++ b/src/lua-vm/loadlib.c @@ -0,0 +1,663 @@ +/* +** $Id: loadlib.c,v 1.54a 2006/07/03 20:16:49 roberto Exp $ +** Dynamic library loader for Lua +** See Copyright Notice in lua.h +** +** This module contains an implementation of loadlib for Unix systems +** that have dlfcn, an implementation for Darwin (Mac OS X), an +** implementation for Windows, and a stub for other systems. +*/ + + +#include +#include + + +#define loadlib_c +#define LUA_LIB + +#include "lua.h" + +#include "lauxlib.h" +#include "lualib.h" + + +/* prefix for open functions in C libraries */ +#define LUA_POF "luaopen_" + +/* separator for open functions in C libraries */ +#define LUA_OFSEP "_" + + +#define LIBPREFIX "LOADLIB: " + +#define POF LUA_POF +#define LIB_FAIL "open" + + +/* error codes for ll_loadfunc */ +#define ERRLIB 1 +#define ERRFUNC 2 + +#define setprogdir(L) ((void)0) + + +static void ll_unloadlib (void *lib); +static void *ll_load (lua_State *L, const char *path); +static lua_CFunction ll_sym (lua_State *L, void *lib, const char *sym); + + + +#if defined(LUA_DL_DLOPEN) +/* +** {======================================================================== +** This is an implementation of loadlib based on the dlfcn interface. +** The dlfcn interface is available in Linux, SunOS, Solaris, IRIX, FreeBSD, +** NetBSD, AIX 4.2, HPUX 11, and probably most other Unix flavors, at least +** as an emulation layer on top of native functions. +** ========================================================================= +*/ + +#include + +static void ll_unloadlib (void *lib) { + dlclose(lib); +} + + +static void *ll_load (lua_State *L, const char *path) { + void *lib = dlopen(path, RTLD_NOW); + if (lib == NULL) lua_pushstring(L, dlerror()); + return lib; +} + + +static lua_CFunction ll_sym (lua_State *L, void *lib, const char *sym) { + lua_CFunction f = (lua_CFunction)dlsym(lib, sym); + if (f == NULL) lua_pushstring(L, dlerror()); + return f; +} + +/* }====================================================== */ + + + +#elif defined(LUA_DL_DLL) +/* +** {====================================================================== +** This is an implementation of loadlib for Windows using native functions. +** ======================================================================= +*/ + +#include + + +#undef setprogdir + +static void setprogdir (lua_State *L) { + char buff[MAX_PATH + 1]; + char *lb; + DWORD nsize = sizeof(buff)/sizeof(char); + DWORD n = GetModuleFileNameA(NULL, buff, nsize); + if (n == 0 || n == nsize || (lb = strrchr(buff, '\\')) == NULL) + luaL_error(L, "unable to get ModuleFileName"); + else { + *lb = '\0'; + luaL_gsub(L, lua_tostring(L, -1), LUA_EXECDIR, buff); + lua_remove(L, -2); /* remove original string */ + } +} + + +static void pusherror (lua_State *L) { + int error = GetLastError(); + char buffer[128]; + if (FormatMessageA(FORMAT_MESSAGE_IGNORE_INSERTS | FORMAT_MESSAGE_FROM_SYSTEM, + NULL, error, 0, buffer, sizeof(buffer), NULL)) + lua_pushstring(L, buffer); + else + lua_pushfstring(L, "system error %d\n", error); +} + +static void ll_unloadlib (void *lib) { + FreeLibrary((HINSTANCE)lib); +} + + +static void *ll_load (lua_State *L, const char *path) { + HINSTANCE lib = LoadLibraryA(path); + if (lib == NULL) pusherror(L); + return lib; +} + + +static lua_CFunction ll_sym (lua_State *L, void *lib, const char *sym) { + lua_CFunction f = (lua_CFunction)GetProcAddress((HINSTANCE)lib, sym); + if (f == NULL) pusherror(L); + return f; +} + +/* }====================================================== */ + + + +#elif defined(LUA_DL_DYLD) +/* +** {====================================================================== +** Native Mac OS X / Darwin Implementation +** ======================================================================= +*/ + +#include + + +/* Mac appends a `_' before C function names */ +#undef POF +#define POF "_" LUA_POF + + +static void pusherror (lua_State *L) { + const char *err_str; + const char *err_file; + NSLinkEditErrors err; + int err_num; + NSLinkEditError(&err, &err_num, &err_file, &err_str); + lua_pushstring(L, err_str); +} + + +static const char *errorfromcode (NSObjectFileImageReturnCode ret) { + switch (ret) { + case NSObjectFileImageInappropriateFile: + return "file is not a bundle"; + case NSObjectFileImageArch: + return "library is for wrong CPU type"; + case NSObjectFileImageFormat: + return "bad format"; + case NSObjectFileImageAccess: + return "cannot access file"; + case NSObjectFileImageFailure: + default: + return "unable to load library"; + } +} + + +static void ll_unloadlib (void *lib) { + NSUnLinkModule((NSModule)lib, NSUNLINKMODULE_OPTION_RESET_LAZY_REFERENCES); +} + + +static void *ll_load (lua_State *L, const char *path) { + NSObjectFileImage img; + NSObjectFileImageReturnCode ret; + /* this would be a rare case, but prevents crashing if it happens */ + if(!_dyld_present()) { + lua_pushliteral(L, "dyld not present"); + return NULL; + } + ret = NSCreateObjectFileImageFromFile(path, &img); + if (ret == NSObjectFileImageSuccess) { + NSModule mod = NSLinkModule(img, path, NSLINKMODULE_OPTION_PRIVATE | + NSLINKMODULE_OPTION_RETURN_ON_ERROR); + NSDestroyObjectFileImage(img); + if (mod == NULL) pusherror(L); + return mod; + } + lua_pushstring(L, errorfromcode(ret)); + return NULL; +} + + +static lua_CFunction ll_sym (lua_State *L, void *lib, const char *sym) { + NSSymbol nss = NSLookupSymbolInModule((NSModule)lib, sym); + if (nss == NULL) { + lua_pushfstring(L, "symbol " LUA_QS " not found", sym); + return NULL; + } + return (lua_CFunction)NSAddressOfSymbol(nss); +} + +/* }====================================================== */ + + + +#else +/* +** {====================================================== +** Fallback for other systems +** ======================================================= +*/ + +#undef LIB_FAIL +#define LIB_FAIL "absent" + + +#define DLMSG "dynamic libraries not enabled; check your Lua installation" + + +static void ll_unloadlib (void *lib) { + (void)lib; /* to avoid warnings */ +} + + +static void *ll_load (lua_State *L, const char *path) { + (void)path; /* to avoid warnings */ + lua_pushliteral(L, DLMSG); + return NULL; +} + + +static lua_CFunction ll_sym (lua_State *L, void *lib, const char *sym) { + (void)lib; (void)sym; /* to avoid warnings */ + lua_pushliteral(L, DLMSG); + return NULL; +} + +/* }====================================================== */ +#endif + + + +static void **ll_register (lua_State *L, const char *path) { + void **plib; + lua_pushfstring(L, "%s%s", LIBPREFIX, path); + lua_gettable(L, LUA_REGISTRYINDEX); /* check library in registry? */ + if (!lua_isnil(L, -1)) /* is there an entry? */ + plib = (void **)lua_touserdata(L, -1); + else { /* no entry yet; create one */ + lua_pop(L, 1); + plib = (void **)lua_newuserdata(L, sizeof(const void *)); + *plib = NULL; + luaL_getmetatable(L, "_LOADLIB"); + lua_setmetatable(L, -2); + lua_pushfstring(L, "%s%s", LIBPREFIX, path); + lua_pushvalue(L, -2); + lua_settable(L, LUA_REGISTRYINDEX); + } + return plib; +} + + +/* +** __gc tag method: calls library's `ll_unloadlib' function with the lib +** handle +*/ +static int gctm (lua_State *L) { + void **lib = (void **)luaL_checkudata(L, 1, "_LOADLIB"); + if (*lib) ll_unloadlib(*lib); + *lib = NULL; /* mark library as closed */ + return 0; +} + + +static int ll_loadfunc (lua_State *L, const char *path, const char *sym) { + void **reg = ll_register(L, path); + if (*reg == NULL) *reg = ll_load(L, path); + if (*reg == NULL) + return ERRLIB; /* unable to load library */ + else { + lua_CFunction f = ll_sym(L, *reg, sym); + if (f == NULL) + return ERRFUNC; /* unable to find function */ + lua_pushcfunction(L, f); + return 0; /* return function */ + } +} + + +static int ll_loadlib (lua_State *L) { + const char *path = luaL_checkstring(L, 1); + const char *init = luaL_checkstring(L, 2); + int stat = ll_loadfunc(L, path, init); + if (stat == 0) /* no errors? */ + return 1; /* return the loaded function */ + else { /* error; error message is on stack top */ + lua_pushnil(L); + lua_insert(L, -2); + lua_pushstring(L, (stat == ERRLIB) ? LIB_FAIL : "init"); + return 3; /* return nil, error message, and where */ + } +} + + + +/* +** {====================================================== +** 'require' function +** ======================================================= +*/ + + +static int readable (const char *filename) { + FILE *f = fopen(filename, "r"); /* try to open file */ + if (f == NULL) return 0; /* open failed */ + fclose(f); + return 1; +} + + +static const char *pushnexttemplate (lua_State *L, const char *path) { + const char *l; + while (*path == *LUA_PATHSEP) path++; /* skip separators */ + if (*path == '\0') return NULL; /* no more templates */ + l = strchr(path, *LUA_PATHSEP); /* find next separator */ + if (l == NULL) l = path + strlen(path); + lua_pushlstring(L, path, l - path); /* template */ + return l; +} + + +static const char *findfile (lua_State *L, const char *name, + const char *pname) { + const char *path; + name = luaL_gsub(L, name, ".", LUA_DIRSEP); + lua_getfield(L, LUA_ENVIRONINDEX, pname); + path = lua_tostring(L, -1); + if (path == NULL) + luaL_error(L, LUA_QL("package.%s") " must be a string", pname); + lua_pushliteral(L, ""); /* error accumulator */ + while ((path = pushnexttemplate(L, path)) != NULL) { + const char *filename; + filename = luaL_gsub(L, lua_tostring(L, -1), LUA_PATH_MARK, name); + lua_remove(L, -2); /* remove path template */ + if (readable(filename)) /* does file exist and is readable? */ + return filename; /* return that file name */ + lua_pushfstring(L, "\n\tno file " LUA_QS, filename); + lua_remove(L, -2); /* remove file name */ + lua_concat(L, 2); /* add entry to possible error message */ + } + return NULL; /* not found */ +} + + +static void loaderror (lua_State *L, const char *filename) { + luaL_error(L, "error loading module " LUA_QS " from file " LUA_QS ":\n\t%s", + lua_tostring(L, 1), filename, lua_tostring(L, -1)); +} + + +static int loader_Lua (lua_State *L) { + const char *filename; + const char *name = luaL_checkstring(L, 1); + filename = findfile(L, name, "path"); + if (filename == NULL) return 1; /* library not found in this path */ + if (luaL_loadfile(L, filename) != 0) + loaderror(L, filename); + return 1; /* library loaded successfully */ +} + + +static const char *mkfuncname (lua_State *L, const char *modname) { + const char *funcname; + const char *mark = strchr(modname, *LUA_IGMARK); + if (mark) modname = mark + 1; + funcname = luaL_gsub(L, modname, ".", LUA_OFSEP); + funcname = lua_pushfstring(L, POF"%s", funcname); + lua_remove(L, -2); /* remove 'gsub' result */ + return funcname; +} + + +static int loader_C (lua_State *L) { + const char *funcname; + const char *name = luaL_checkstring(L, 1); + const char *filename = findfile(L, name, "cpath"); + if (filename == NULL) return 1; /* library not found in this path */ + funcname = mkfuncname(L, name); + if (ll_loadfunc(L, filename, funcname) != 0) + loaderror(L, filename); + return 1; /* library loaded successfully */ +} + + +static int loader_Croot (lua_State *L) { + const char *funcname; + const char *filename; + const char *name = luaL_checkstring(L, 1); + const char *p = strchr(name, '.'); + int stat; + if (p == NULL) return 0; /* is root */ + lua_pushlstring(L, name, p - name); + filename = findfile(L, lua_tostring(L, -1), "cpath"); + if (filename == NULL) return 1; /* root not found */ + funcname = mkfuncname(L, name); + if ((stat = ll_loadfunc(L, filename, funcname)) != 0) { + if (stat != ERRFUNC) loaderror(L, filename); /* real error */ + lua_pushfstring(L, "\n\tno module " LUA_QS " in file " LUA_QS, + name, filename); + return 1; /* function not found */ + } + return 1; +} + + +static int loader_preload (lua_State *L) { + const char *name = luaL_checkstring(L, 1); + lua_getfield(L, LUA_ENVIRONINDEX, "preload"); + if (!lua_istable(L, -1)) + luaL_error(L, LUA_QL("package.preload") " must be a table"); + lua_getfield(L, -1, name); + if (lua_isnil(L, -1)) /* not found? */ + lua_pushfstring(L, "\n\tno field package.preload['%s']", name); + return 1; +} + + +static const int sentinel_ = 0; +#define sentinel ((void *)&sentinel_) + + +static int ll_require (lua_State *L) { + const char *name = luaL_checkstring(L, 1); + int i; + lua_settop(L, 1); /* _LOADED table will be at index 2 */ + lua_getfield(L, LUA_REGISTRYINDEX, "_LOADED"); + lua_getfield(L, 2, name); + if (lua_toboolean(L, -1)) { /* is it there? */ + if (lua_touserdata(L, -1) == sentinel) /* check loops */ + luaL_error(L, "loop or previous error loading module " LUA_QS, name); + return 1; /* package is already loaded */ + } + /* else must load it; iterate over available loaders */ + lua_getfield(L, LUA_ENVIRONINDEX, "loaders"); + if (!lua_istable(L, -1)) + luaL_error(L, LUA_QL("package.loaders") " must be a table"); + lua_pushliteral(L, ""); /* error message accumulator */ + for (i=1; ; i++) { + lua_rawgeti(L, -2, i); /* get a loader */ + if (lua_isnil(L, -1)) + luaL_error(L, "module " LUA_QS " not found:%s", + name, lua_tostring(L, -2)); + lua_pushstring(L, name); + lua_call(L, 1, 1); /* call it */ + if (lua_isfunction(L, -1)) /* did it find module? */ + break; /* module loaded successfully */ + else if (lua_isstring(L, -1)) /* loader returned error message? */ + lua_concat(L, 2); /* accumulate it */ + else + lua_pop(L, 1); + } + lua_pushlightuserdata(L, sentinel); + lua_setfield(L, 2, name); /* _LOADED[name] = sentinel */ + lua_pushstring(L, name); /* pass name as argument to module */ + lua_call(L, 1, 1); /* run loaded module */ + if (!lua_isnil(L, -1)) /* non-nil return? */ + lua_setfield(L, 2, name); /* _LOADED[name] = returned value */ + lua_getfield(L, 2, name); + if (lua_touserdata(L, -1) == sentinel) { /* module did not set a value? */ + lua_pushboolean(L, 1); /* use true as result */ + lua_pushvalue(L, -1); /* extra copy to be returned */ + lua_setfield(L, 2, name); /* _LOADED[name] = true */ + } + return 1; +} + +/* }====================================================== */ + + + +/* +** {====================================================== +** 'module' function +** ======================================================= +*/ + + +static void setfenv (lua_State *L) { + lua_Debug ar; + lua_getstack(L, 1, &ar); + lua_getinfo(L, "f", &ar); + lua_pushvalue(L, -2); + lua_setfenv(L, -2); + lua_pop(L, 1); +} + + +static void dooptions (lua_State *L, int n) { + int i; + for (i = 2; i <= n; i++) { + lua_pushvalue(L, i); /* get option (a function) */ + lua_pushvalue(L, -2); /* module */ + lua_call(L, 1, 0); + } +} + + +static void modinit (lua_State *L, const char *modname) { + const char *dot; + lua_pushvalue(L, -1); + lua_setfield(L, -2, "_M"); /* module._M = module */ + lua_pushstring(L, modname); + lua_setfield(L, -2, "_NAME"); + dot = strrchr(modname, '.'); /* look for last dot in module name */ + if (dot == NULL) dot = modname; + else dot++; + /* set _PACKAGE as package name (full module name minus last part) */ + lua_pushlstring(L, modname, dot - modname); + lua_setfield(L, -2, "_PACKAGE"); +} + + +static int ll_module (lua_State *L) { + const char *modname = luaL_checkstring(L, 1); + int loaded = lua_gettop(L) + 1; /* index of _LOADED table */ + lua_getfield(L, LUA_REGISTRYINDEX, "_LOADED"); + lua_getfield(L, loaded, modname); /* get _LOADED[modname] */ + if (!lua_istable(L, -1)) { /* not found? */ + lua_pop(L, 1); /* remove previous result */ + /* try global variable (and create one if it does not exist) */ + if (luaL_findtable(L, LUA_GLOBALSINDEX, modname, 1) != NULL) + return luaL_error(L, "name conflict for module " LUA_QS, modname); + lua_pushvalue(L, -1); + lua_setfield(L, loaded, modname); /* _LOADED[modname] = new table */ + } + /* check whether table already has a _NAME field */ + lua_getfield(L, -1, "_NAME"); + if (!lua_isnil(L, -1)) /* is table an initialized module? */ + lua_pop(L, 1); + else { /* no; initialize it */ + lua_pop(L, 1); + modinit(L, modname); + } + lua_pushvalue(L, -1); + setfenv(L); + dooptions(L, loaded - 1); + return 0; +} + + +static int ll_seeall (lua_State *L) { + luaL_checktype(L, 1, LUA_TTABLE); + if (!lua_getmetatable(L, 1)) { + lua_createtable(L, 0, 1); /* create new metatable */ + lua_pushvalue(L, -1); + lua_setmetatable(L, 1); + } + lua_pushvalue(L, LUA_GLOBALSINDEX); + lua_setfield(L, -2, "__index"); /* mt.__index = _G */ + return 0; +} + + +/* }====================================================== */ + + + +/* auxiliary mark (for internal use) */ +#define AUXMARK "\1" + +static void setpath (lua_State *L, const char *fieldname, const char *envname, + const char *def) { + const char *path = getenv(envname); + if (path == NULL) /* no environment variable? */ + lua_pushstring(L, def); /* use default */ + else { + /* replace ";;" by ";AUXMARK;" and then AUXMARK by default path */ + path = luaL_gsub(L, path, LUA_PATHSEP LUA_PATHSEP, + LUA_PATHSEP AUXMARK LUA_PATHSEP); + luaL_gsub(L, path, AUXMARK, def); + lua_remove(L, -2); + } + setprogdir(L); + lua_setfield(L, -2, fieldname); +} + + +static const luaL_Reg pk_funcs[] = { + {"loadlib", ll_loadlib}, + {"seeall", ll_seeall}, + {NULL, NULL} +}; + + +static const luaL_Reg ll_funcs[] = { + {"module", ll_module}, + {"require", ll_require}, + {NULL, NULL} +}; + + +static const lua_CFunction loaders[] = + {loader_preload, loader_Lua, loader_C, loader_Croot, NULL}; + + +LUALIB_API int luaopen_package (lua_State *L) { + int i; + /* create new type _LOADLIB */ + luaL_newmetatable(L, "_LOADLIB"); + lua_pushcfunction(L, gctm); + lua_setfield(L, -2, "__gc"); + /* create `package' table */ + luaL_register(L, LUA_LOADLIBNAME, pk_funcs); +#if defined(LUA_COMPAT_LOADLIB) + lua_getfield(L, -1, "loadlib"); + lua_setfield(L, LUA_GLOBALSINDEX, "loadlib"); +#endif + lua_pushvalue(L, -1); + lua_replace(L, LUA_ENVIRONINDEX); + /* create `loaders' table */ + lua_createtable(L, 0, sizeof(loaders)/sizeof(loaders[0]) - 1); + /* fill it with pre-defined loaders */ + for (i=0; loaders[i] != NULL; i++) { + lua_pushcfunction(L, loaders[i]); + lua_rawseti(L, -2, i+1); + } + lua_setfield(L, -2, "loaders"); /* put it in field `loaders' */ + setpath(L, "path", LUA_PATH, LUA_PATH_DEFAULT); /* set field `path' */ + setpath(L, "cpath", LUA_CPATH, LUA_CPATH_DEFAULT); /* set field `cpath' */ + /* store config information */ + lua_pushliteral(L, LUA_DIRSEP "\n" LUA_PATHSEP "\n" LUA_PATH_MARK "\n" + LUA_EXECDIR "\n" LUA_IGMARK); + lua_setfield(L, -2, "config"); + /* set field `loaded' */ + luaL_findtable(L, LUA_REGISTRYINDEX, "_LOADED", 2); + lua_setfield(L, -2, "loaded"); + /* set field `preload' */ + lua_newtable(L); + lua_setfield(L, -2, "preload"); + lua_pushvalue(L, LUA_GLOBALSINDEX); + luaL_register(L, NULL, ll_funcs); /* open lib into global table */ + lua_pop(L, 1); + return 1; /* return 'package' table */ +} diff --git a/src/lua-vm/lobject.c b/src/lua-vm/lobject.c new file mode 100644 index 0000000..acde82c --- /dev/null +++ b/src/lua-vm/lobject.c @@ -0,0 +1,214 @@ +/* +** $Id: lobject.c,v 2.22 2006/02/10 17:43:52 roberto Exp $ +** Some generic functions over Lua objects +** See Copyright Notice in lua.h +*/ + +#include +#include +#include +#include +#include + +#define lobject_c +#define LUA_CORE + +#include "lua.h" + +#include "ldo.h" +#include "lmem.h" +#include "lobject.h" +#include "lstate.h" +#include "lstring.h" +#include "lvm.h" + + + +const TValue luaO_nilobject_ = {{NULL}, LUA_TNIL}; + + +/* +** converts an integer to a "floating point byte", represented as +** (eeeeexxx), where the real value is (1xxx) * 2^(eeeee - 1) if +** eeeee != 0 and (xxx) otherwise. +*/ +int luaO_int2fb (unsigned int x) { + int e = 0; /* expoent */ + while (x >= 16) { + x = (x+1) >> 1; + e++; + } + if (x < 8) return x; + else return ((e+1) << 3) | (cast_int(x) - 8); +} + + +/* converts back */ +int luaO_fb2int (int x) { + int e = (x >> 3) & 31; + if (e == 0) return x; + else return ((x & 7)+8) << (e - 1); +} + + +int luaO_log2 (unsigned int x) { + static const lu_byte log_2[256] = { + 0,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5, + 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6, + 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, + 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, + 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8, + 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8, + 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8, + 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8 + }; + int l = -1; + while (x >= 256) { l += 8; x >>= 8; } + return l + log_2[x]; + +} + + +int luaO_rawequalObj (const TValue *t1, const TValue *t2) { + if (ttype(t1) != ttype(t2)) return 0; + else switch (ttype(t1)) { + case LUA_TNIL: + return 1; + case LUA_TNUMBER: + return luai_numeq(nvalue(t1), nvalue(t2)); + case LUA_TBOOLEAN: + return bvalue(t1) == bvalue(t2); /* boolean true must be 1 !! */ + case LUA_TLIGHTUSERDATA: + return pvalue(t1) == pvalue(t2); + default: + lua_assert(iscollectable(t1)); + return gcvalue(t1) == gcvalue(t2); + } +} + + +int luaO_str2d (const char *s, lua_Number *result) { + char *endptr; + *result = lua_str2number(s, &endptr); + if (endptr == s) return 0; /* conversion failed */ + if (*endptr == 'x' || *endptr == 'X') /* maybe an hexadecimal constant? */ + *result = cast_num(strtoul(s, &endptr, 16)); + if (*endptr == '\0') return 1; /* most common case */ + while (isspace(cast(unsigned char, *endptr))) endptr++; + if (*endptr != '\0') return 0; /* invalid trailing characters? */ + return 1; +} + + + +static void pushstr (lua_State *L, const char *str) { + setsvalue2s(L, L->top, luaS_new(L, str)); + incr_top(L); +} + + +/* this function handles only `%d', `%c', %f, %p, and `%s' formats */ +const char *luaO_pushvfstring (lua_State *L, const char *fmt, va_list argp) { + int n = 1; + pushstr(L, ""); + for (;;) { + const char *e = strchr(fmt, '%'); + if (e == NULL) break; + setsvalue2s(L, L->top, luaS_newlstr(L, fmt, e-fmt)); + incr_top(L); + switch (*(e+1)) { + case 's': { + const char *s = va_arg(argp, char *); + if (s == NULL) s = "(null)"; + pushstr(L, s); + break; + } + case 'c': { + char buff[2]; + buff[0] = cast(char, va_arg(argp, int)); + buff[1] = '\0'; + pushstr(L, buff); + break; + } + case 'd': { + setnvalue(L->top, cast_num(va_arg(argp, int))); + incr_top(L); + break; + } + case 'f': { + setnvalue(L->top, cast_num(va_arg(argp, l_uacNumber))); + incr_top(L); + break; + } + case 'p': { + char buff[4*sizeof(void *) + 8]; /* should be enough space for a `%p' */ + sprintf(buff, "%p", va_arg(argp, void *)); + pushstr(L, buff); + break; + } + case '%': { + pushstr(L, "%"); + break; + } + default: { + char buff[3]; + buff[0] = '%'; + buff[1] = *(e+1); + buff[2] = '\0'; + pushstr(L, buff); + break; + } + } + n += 2; + fmt = e+2; + } + pushstr(L, fmt); + luaV_concat(L, n+1, cast_int(L->top - L->base) - 1); + L->top -= n; + return svalue(L->top - 1); +} + + +const char *luaO_pushfstring (lua_State *L, const char *fmt, ...) { + const char *msg; + va_list argp; + va_start(argp, fmt); + msg = luaO_pushvfstring(L, fmt, argp); + va_end(argp); + return msg; +} + + +void luaO_chunkid (char *out, const char *source, size_t bufflen) { + if (*source == '=') { + strncpy(out, source+1, bufflen); /* remove first char */ + out[bufflen-1] = '\0'; /* ensures null termination */ + } + else { /* out = "source", or "...source" */ + if (*source == '@') { + size_t l; + source++; /* skip the `@' */ + bufflen -= sizeof(" '...' "); + l = strlen(source); + strcpy(out, ""); + if (l > bufflen) { + source += (l-bufflen); /* get last part of file name */ + strcat(out, "..."); + } + strcat(out, source); + } + else { /* out = [string "string"] */ + size_t len = strcspn(source, "\n\r"); /* stop at first newline */ + bufflen -= sizeof(" [string \"...\"] "); + if (len > bufflen) len = bufflen; + strcpy(out, "[string \""); + if (source[len] != '\0') { /* must truncate? */ + strncat(out, source, len); + strcat(out, "..."); + } + else + strcat(out, source); + strcat(out, "\"]"); + } + } +} diff --git a/src/lua-vm/lobject.h b/src/lua-vm/lobject.h new file mode 100644 index 0000000..8ce4405 --- /dev/null +++ b/src/lua-vm/lobject.h @@ -0,0 +1,381 @@ +/* +** $Id: lobject.h,v 2.20 2006/01/18 11:37:34 roberto Exp $ +** Type definitions for Lua objects +** See Copyright Notice in lua.h +*/ + + +#ifndef lobject_h +#define lobject_h + + +#include + + +#include "llimits.h" +#include "lua.h" + + +/* tags for values visible from Lua */ +#define LAST_TAG LUA_TTHREAD + +#define NUM_TAGS (LAST_TAG+1) + + +/* +** Extra tags for non-values +*/ +#define LUA_TPROTO (LAST_TAG+1) +#define LUA_TUPVAL (LAST_TAG+2) +#define LUA_TDEADKEY (LAST_TAG+3) + + +/* +** Union of all collectable objects +*/ +typedef union GCObject GCObject; + + +/* +** Common Header for all collectable objects (in macro form, to be +** included in other objects) +*/ +#define CommonHeader GCObject *next; lu_byte tt; lu_byte marked + + +/* +** Common header in struct form +*/ +typedef struct GCheader { + CommonHeader; +} GCheader; + + + + +/* +** Union of all Lua values +*/ +typedef union { + GCObject *gc; + void *p; + lua_Number n; + int b; +} Value; + + +/* +** Tagged Values +*/ + +#define TValuefields Value value; int tt + +typedef struct lua_TValue { + TValuefields; +} TValue; + + +/* Macros to test type */ +#define ttisnil(o) (ttype(o) == LUA_TNIL) +#define ttisnumber(o) (ttype(o) == LUA_TNUMBER) +#define ttisstring(o) (ttype(o) == LUA_TSTRING) +#define ttistable(o) (ttype(o) == LUA_TTABLE) +#define ttisfunction(o) (ttype(o) == LUA_TFUNCTION) +#define ttisboolean(o) (ttype(o) == LUA_TBOOLEAN) +#define ttisuserdata(o) (ttype(o) == LUA_TUSERDATA) +#define ttisthread(o) (ttype(o) == LUA_TTHREAD) +#define ttislightuserdata(o) (ttype(o) == LUA_TLIGHTUSERDATA) + +/* Macros to access values */ +#define ttype(o) ((o)->tt) +#define gcvalue(o) check_exp(iscollectable(o), (o)->value.gc) +#define pvalue(o) check_exp(ttislightuserdata(o), (o)->value.p) +#define nvalue(o) check_exp(ttisnumber(o), (o)->value.n) +#define rawtsvalue(o) check_exp(ttisstring(o), &(o)->value.gc->ts) +#define tsvalue(o) (&rawtsvalue(o)->tsv) +#define rawuvalue(o) check_exp(ttisuserdata(o), &(o)->value.gc->u) +#define uvalue(o) (&rawuvalue(o)->uv) +#define clvalue(o) check_exp(ttisfunction(o), &(o)->value.gc->cl) +#define hvalue(o) check_exp(ttistable(o), &(o)->value.gc->h) +#define bvalue(o) check_exp(ttisboolean(o), (o)->value.b) +#define thvalue(o) check_exp(ttisthread(o), &(o)->value.gc->th) + +#define l_isfalse(o) (ttisnil(o) || (ttisboolean(o) && bvalue(o) == 0)) + +/* +** for internal debug only +*/ +#define checkconsistency(obj) \ + lua_assert(!iscollectable(obj) || (ttype(obj) == (obj)->value.gc->gch.tt)) + +#define checkliveness(g,obj) \ + lua_assert(!iscollectable(obj) || \ + ((ttype(obj) == (obj)->value.gc->gch.tt) && !isdead(g, (obj)->value.gc))) + + +/* Macros to set values */ +#define setnilvalue(obj) ((obj)->tt=LUA_TNIL) + +#define setnvalue(obj,x) \ + { TValue *i_o=(obj); i_o->value.n=(x); i_o->tt=LUA_TNUMBER; } + +#define setpvalue(obj,x) \ + { TValue *i_o=(obj); i_o->value.p=(x); i_o->tt=LUA_TLIGHTUSERDATA; } + +#define setbvalue(obj,x) \ + { TValue *i_o=(obj); i_o->value.b=(x); i_o->tt=LUA_TBOOLEAN; } + +#define setsvalue(L,obj,x) \ + { TValue *i_o=(obj); \ + i_o->value.gc=cast(GCObject *, (x)); i_o->tt=LUA_TSTRING; \ + checkliveness(G(L),i_o); } + +#define setuvalue(L,obj,x) \ + { TValue *i_o=(obj); \ + i_o->value.gc=cast(GCObject *, (x)); i_o->tt=LUA_TUSERDATA; \ + checkliveness(G(L),i_o); } + +#define setthvalue(L,obj,x) \ + { TValue *i_o=(obj); \ + i_o->value.gc=cast(GCObject *, (x)); i_o->tt=LUA_TTHREAD; \ + checkliveness(G(L),i_o); } + +#define setclvalue(L,obj,x) \ + { TValue *i_o=(obj); \ + i_o->value.gc=cast(GCObject *, (x)); i_o->tt=LUA_TFUNCTION; \ + checkliveness(G(L),i_o); } + +#define sethvalue(L,obj,x) \ + { TValue *i_o=(obj); \ + i_o->value.gc=cast(GCObject *, (x)); i_o->tt=LUA_TTABLE; \ + checkliveness(G(L),i_o); } + +#define setptvalue(L,obj,x) \ + { TValue *i_o=(obj); \ + i_o->value.gc=cast(GCObject *, (x)); i_o->tt=LUA_TPROTO; \ + checkliveness(G(L),i_o); } + + + + +#define setobj(L,obj1,obj2) \ + { const TValue *o2=(obj2); TValue *o1=(obj1); \ + o1->value = o2->value; o1->tt=o2->tt; \ + checkliveness(G(L),o1); } + + +/* +** different types of sets, according to destination +*/ + +/* from stack to (same) stack */ +#define setobjs2s setobj +/* to stack (not from same stack) */ +#define setobj2s setobj +#define setsvalue2s setsvalue +#define sethvalue2s sethvalue +#define setptvalue2s setptvalue +/* from table to same table */ +#define setobjt2t setobj +/* to table */ +#define setobj2t setobj +/* to new object */ +#define setobj2n setobj +#define setsvalue2n setsvalue + +#define setttype(obj, tt) (ttype(obj) = (tt)) + + +#define iscollectable(o) (ttype(o) >= LUA_TSTRING) + + + +typedef TValue *StkId; /* index to stack elements */ + + +/* +** String headers for string table +*/ +typedef union TString { + L_Umaxalign dummy; /* ensures maximum alignment for strings */ + struct { + CommonHeader; + lu_byte reserved; + unsigned int hash; + size_t len; + } tsv; +} TString; + + +#define getstr(ts) cast(const char *, (ts) + 1) +#define svalue(o) getstr(tsvalue(o)) + + + +typedef union Udata { + L_Umaxalign dummy; /* ensures maximum alignment for `local' udata */ + struct { + CommonHeader; + struct Table *metatable; + struct Table *env; + size_t len; + } uv; +} Udata; + + + + +/* +** Function Prototypes +*/ +typedef struct Proto { + CommonHeader; + TValue *k; /* constants used by the function */ + Instruction *code; + struct Proto **p; /* functions defined inside the function */ + int *lineinfo; /* map from opcodes to source lines */ + struct LocVar *locvars; /* information about local variables */ + TString **upvalues; /* upvalue names */ + TString *source; + int sizeupvalues; + int sizek; /* size of `k' */ + int sizecode; + int sizelineinfo; + int sizep; /* size of `p' */ + int sizelocvars; + int linedefined; + int lastlinedefined; + GCObject *gclist; + lu_byte nups; /* number of upvalues */ + lu_byte numparams; + lu_byte is_vararg; + lu_byte maxstacksize; +} Proto; + + +/* masks for new-style vararg */ +#define VARARG_HASARG 1 +#define VARARG_ISVARARG 2 +#define VARARG_NEEDSARG 4 + + +typedef struct LocVar { + TString *varname; + int startpc; /* first point where variable is active */ + int endpc; /* first point where variable is dead */ +} LocVar; + + + +/* +** Upvalues +*/ + +typedef struct UpVal { + CommonHeader; + TValue *v; /* points to stack or to its own value */ + union { + TValue value; /* the value (when closed) */ + struct { /* double linked list (when open) */ + struct UpVal *prev; + struct UpVal *next; + } l; + } u; +} UpVal; + + +/* +** Closures +*/ + +#define ClosureHeader \ + CommonHeader; lu_byte isC; lu_byte nupvalues; GCObject *gclist; \ + struct Table *env + +typedef struct CClosure { + ClosureHeader; + lua_CFunction f; + TValue upvalue[1]; +} CClosure; + + +typedef struct LClosure { + ClosureHeader; + struct Proto *p; + UpVal *upvals[1]; +} LClosure; + + +typedef union Closure { + CClosure c; + LClosure l; +} Closure; + + +#define iscfunction(o) (ttype(o) == LUA_TFUNCTION && clvalue(o)->c.isC) +#define isLfunction(o) (ttype(o) == LUA_TFUNCTION && !clvalue(o)->c.isC) + + +/* +** Tables +*/ + +typedef union TKey { + struct { + TValuefields; + struct Node *next; /* for chaining */ + } nk; + TValue tvk; +} TKey; + + +typedef struct Node { + TValue i_val; + TKey i_key; +} Node; + + +typedef struct Table { + CommonHeader; + lu_byte flags; /* 1<

lsizenode)) + + +#define luaO_nilobject (&luaO_nilobject_) + +LUAI_DATA const TValue luaO_nilobject_; + +#define ceillog2(x) (luaO_log2((x)-1) + 1) + +LUAI_FUNC int luaO_log2 (unsigned int x); +LUAI_FUNC int luaO_int2fb (unsigned int x); +LUAI_FUNC int luaO_fb2int (int x); +LUAI_FUNC int luaO_rawequalObj (const TValue *t1, const TValue *t2); +LUAI_FUNC int luaO_str2d (const char *s, lua_Number *result); +LUAI_FUNC const char *luaO_pushvfstring (lua_State *L, const char *fmt, + va_list argp); +LUAI_FUNC const char *luaO_pushfstring (lua_State *L, const char *fmt, ...); +LUAI_FUNC void luaO_chunkid (char *out, const char *source, size_t len); + + +#endif + diff --git a/src/lua-vm/lopcodes.c b/src/lua-vm/lopcodes.c new file mode 100644 index 0000000..bf9cd52 --- /dev/null +++ b/src/lua-vm/lopcodes.c @@ -0,0 +1,102 @@ +/* +** $Id: lopcodes.c,v 1.37 2005/11/08 19:45:36 roberto Exp $ +** See Copyright Notice in lua.h +*/ + + +#define lopcodes_c +#define LUA_CORE + + +#include "lopcodes.h" + + +/* ORDER OP */ + +const char *const luaP_opnames[NUM_OPCODES+1] = { + "MOVE", + "LOADK", + "LOADBOOL", + "LOADNIL", + "GETUPVAL", + "GETGLOBAL", + "GETTABLE", + "SETGLOBAL", + "SETUPVAL", + "SETTABLE", + "NEWTABLE", + "SELF", + "ADD", + "SUB", + "MUL", + "DIV", + "MOD", + "POW", + "UNM", + "NOT", + "LEN", + "CONCAT", + "JMP", + "EQ", + "LT", + "LE", + "TEST", + "TESTSET", + "CALL", + "TAILCALL", + "RETURN", + "FORLOOP", + "FORPREP", + "TFORLOOP", + "SETLIST", + "CLOSE", + "CLOSURE", + "VARARG", + NULL +}; + + +#define opmode(t,a,b,c,m) (((t)<<7) | ((a)<<6) | ((b)<<4) | ((c)<<2) | (m)) + +const lu_byte luaP_opmodes[NUM_OPCODES] = { +/* T A B C mode opcode */ + opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_MOVE */ + ,opmode(0, 1, OpArgK, OpArgN, iABx) /* OP_LOADK */ + ,opmode(0, 1, OpArgU, OpArgU, iABC) /* OP_LOADBOOL */ + ,opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_LOADNIL */ + ,opmode(0, 1, OpArgU, OpArgN, iABC) /* OP_GETUPVAL */ + ,opmode(0, 1, OpArgK, OpArgN, iABx) /* OP_GETGLOBAL */ + ,opmode(0, 1, OpArgR, OpArgK, iABC) /* OP_GETTABLE */ + ,opmode(0, 0, OpArgK, OpArgN, iABx) /* OP_SETGLOBAL */ + ,opmode(0, 0, OpArgU, OpArgN, iABC) /* OP_SETUPVAL */ + ,opmode(0, 0, OpArgK, OpArgK, iABC) /* OP_SETTABLE */ + ,opmode(0, 1, OpArgU, OpArgU, iABC) /* OP_NEWTABLE */ + ,opmode(0, 1, OpArgR, OpArgK, iABC) /* OP_SELF */ + ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_ADD */ + ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_SUB */ + ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_MUL */ + ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_DIV */ + ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_MOD */ + ,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_POW */ + ,opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_UNM */ + ,opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_NOT */ + ,opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_LEN */ + ,opmode(0, 1, OpArgR, OpArgR, iABC) /* OP_CONCAT */ + ,opmode(0, 0, OpArgR, OpArgN, iAsBx) /* OP_JMP */ + ,opmode(1, 0, OpArgK, OpArgK, iABC) /* OP_EQ */ + ,opmode(1, 0, OpArgK, OpArgK, iABC) /* OP_LT */ + ,opmode(1, 0, OpArgK, OpArgK, iABC) /* OP_LE */ + ,opmode(1, 1, OpArgR, OpArgU, iABC) /* OP_TEST */ + ,opmode(1, 1, OpArgR, OpArgU, iABC) /* OP_TESTSET */ + ,opmode(0, 1, OpArgU, OpArgU, iABC) /* OP_CALL */ + ,opmode(0, 1, OpArgU, OpArgU, iABC) /* OP_TAILCALL */ + ,opmode(0, 0, OpArgU, OpArgN, iABC) /* OP_RETURN */ + ,opmode(0, 1, OpArgR, OpArgN, iAsBx) /* OP_FORLOOP */ + ,opmode(0, 1, OpArgR, OpArgN, iAsBx) /* OP_FORPREP */ + ,opmode(1, 0, OpArgN, OpArgU, iABC) /* OP_TFORLOOP */ + ,opmode(0, 0, OpArgU, OpArgU, iABC) /* OP_SETLIST */ + ,opmode(0, 0, OpArgN, OpArgN, iABC) /* OP_CLOSE */ + ,opmode(0, 1, OpArgU, OpArgN, iABx) /* OP_CLOSURE */ + ,opmode(0, 1, OpArgU, OpArgN, iABC) /* OP_VARARG */ +}; + diff --git a/src/lua-vm/lopcodes.h b/src/lua-vm/lopcodes.h new file mode 100644 index 0000000..48105f1 --- /dev/null +++ b/src/lua-vm/lopcodes.h @@ -0,0 +1,268 @@ +/* +** $Id: lopcodes.h,v 1.125 2006/03/14 19:04:44 roberto Exp $ +** Opcodes for Lua virtual machine +** See Copyright Notice in lua.h +*/ + +#ifndef lopcodes_h +#define lopcodes_h + +#include "llimits.h" + + +/*=========================================================================== + We assume that instructions are unsigned numbers. + All instructions have an opcode in the first 6 bits. + Instructions can have the following fields: + `A' : 8 bits + `B' : 9 bits + `C' : 9 bits + `Bx' : 18 bits (`B' and `C' together) + `sBx' : signed Bx + + A signed argument is represented in excess K; that is, the number + value is the unsigned value minus K. K is exactly the maximum value + for that argument (so that -max is represented by 0, and +max is + represented by 2*max), which is half the maximum for the corresponding + unsigned argument. +===========================================================================*/ + + +enum OpMode {iABC, iABx, iAsBx}; /* basic instruction format */ + + +/* +** size and position of opcode arguments. +*/ +#define SIZE_C 9 +#define SIZE_B 9 +#define SIZE_Bx (SIZE_C + SIZE_B) +#define SIZE_A 8 + +#define SIZE_OP 6 + +#define POS_OP 0 +#define POS_A (POS_OP + SIZE_OP) +#define POS_C (POS_A + SIZE_A) +#define POS_B (POS_C + SIZE_C) +#define POS_Bx POS_C + + +/* +** limits for opcode arguments. +** we use (signed) int to manipulate most arguments, +** so they must fit in LUAI_BITSINT-1 bits (-1 for sign) +*/ +#if SIZE_Bx < LUAI_BITSINT-1 +#define MAXARG_Bx ((1<>1) /* `sBx' is signed */ +#else +#define MAXARG_Bx MAX_INT +#define MAXARG_sBx MAX_INT +#endif + + +#define MAXARG_A ((1<>POS_OP) & MASK1(SIZE_OP,0))) +#define SET_OPCODE(i,o) ((i) = (((i)&MASK0(SIZE_OP,POS_OP)) | \ + ((cast(Instruction, o)<>POS_A) & MASK1(SIZE_A,0))) +#define SETARG_A(i,u) ((i) = (((i)&MASK0(SIZE_A,POS_A)) | \ + ((cast(Instruction, u)<>POS_B) & MASK1(SIZE_B,0))) +#define SETARG_B(i,b) ((i) = (((i)&MASK0(SIZE_B,POS_B)) | \ + ((cast(Instruction, b)<>POS_C) & MASK1(SIZE_C,0))) +#define SETARG_C(i,b) ((i) = (((i)&MASK0(SIZE_C,POS_C)) | \ + ((cast(Instruction, b)<>POS_Bx) & MASK1(SIZE_Bx,0))) +#define SETARG_Bx(i,b) ((i) = (((i)&MASK0(SIZE_Bx,POS_Bx)) | \ + ((cast(Instruction, b)< C) then pc++ */ +OP_TESTSET,/* A B C if (R(B) <=> C) then R(A) := R(B) else pc++ */ + +OP_CALL,/* A B C R(A), ... ,R(A+C-2) := R(A)(R(A+1), ... ,R(A+B-1)) */ +OP_TAILCALL,/* A B C return R(A)(R(A+1), ... ,R(A+B-1)) */ +OP_RETURN,/* A B return R(A), ... ,R(A+B-2) (see note) */ + +OP_FORLOOP,/* A sBx R(A)+=R(A+2); + if R(A) =) R(A)*/ +OP_CLOSURE,/* A Bx R(A) := closure(KPROTO[Bx], R(A), ... ,R(A+n)) */ + +OP_VARARG/* A B R(A), R(A+1), ..., R(A+B-1) = vararg */ +} OpCode; + + +#define NUM_OPCODES (cast(int, OP_VARARG) + 1) + + + +/*=========================================================================== + Notes: + (*) In OP_CALL, if (B == 0) then B = top. C is the number of returns - 1, + and can be 0: OP_CALL then sets `top' to last_result+1, so + next open instruction (OP_CALL, OP_RETURN, OP_SETLIST) may use `top'. + + (*) In OP_VARARG, if (B == 0) then use actual number of varargs and + set top (like in OP_CALL with C == 0). + + (*) In OP_RETURN, if (B == 0) then return up to `top' + + (*) In OP_SETLIST, if (B == 0) then B = `top'; + if (C == 0) then next `instruction' is real C + + (*) For comparisons, A specifies what condition the test should accept + (true or false). + + (*) All `skips' (pc++) assume that next instruction is a jump +===========================================================================*/ + + +/* +** masks for instruction properties. The format is: +** bits 0-1: op mode +** bits 2-3: C arg mode +** bits 4-5: B arg mode +** bit 6: instruction set register A +** bit 7: operator is a test +*/ + +enum OpArgMask { + OpArgN, /* argument is not used */ + OpArgU, /* argument is used */ + OpArgR, /* argument is a register or a jump offset */ + OpArgK /* argument is a constant or register/constant */ +}; + +LUAI_DATA const lu_byte luaP_opmodes[NUM_OPCODES]; + +#define getOpMode(m) (cast(enum OpMode, luaP_opmodes[m] & 3)) +#define getBMode(m) (cast(enum OpArgMask, (luaP_opmodes[m] >> 4) & 3)) +#define getCMode(m) (cast(enum OpArgMask, (luaP_opmodes[m] >> 2) & 3)) +#define testAMode(m) (luaP_opmodes[m] & (1 << 6)) +#define testTMode(m) (luaP_opmodes[m] & (1 << 7)) + + +LUAI_DATA const char *const luaP_opnames[NUM_OPCODES+1]; /* opcode names */ + + +/* number of list items to accumulate before a SETLIST instruction */ +#define LFIELDS_PER_FLUSH 50 + + +#endif diff --git a/src/lua-vm/loslib.c b/src/lua-vm/loslib.c new file mode 100644 index 0000000..fdda474 --- /dev/null +++ b/src/lua-vm/loslib.c @@ -0,0 +1,244 @@ +/* +** $Id: loslib.c,v 1.20 2006/09/19 13:57:08 roberto Exp $ +** Standard Operating System library +** See Copyright Notice in lua.h +*/ + + +#include +#include +#include +#include +#include + +#define loslib_c +#define LUA_LIB + +#include "lua.h" + +#include "lauxlib.h" +#include "lualib.h" + + +static int os_pushresult (lua_State *L, int i, const char *filename) { + int en = errno; /* calls to Lua API may change this value */ + if (i) { + lua_pushboolean(L, 1); + return 1; + } + else { + lua_pushnil(L); + lua_pushfstring(L, "%s: %s", filename, strerror(en)); + lua_pushinteger(L, en); + return 3; + } +} + + +static int os_execute (lua_State *L) { + lua_pushinteger(L, system(luaL_optstring(L, 1, NULL))); + return 1; +} + + +static int os_remove (lua_State *L) { + const char *filename = luaL_checkstring(L, 1); + return os_pushresult(L, remove(filename) == 0, filename); +} + + +static int os_rename (lua_State *L) { + const char *fromname = luaL_checkstring(L, 1); + const char *toname = luaL_checkstring(L, 2); + return os_pushresult(L, rename(fromname, toname) == 0, fromname); +} + + +static int os_tmpname (lua_State *L) { + char buff[LUA_TMPNAMBUFSIZE]; + int err; + lua_tmpnam(buff, err); + if (err) + return luaL_error(L, "unable to generate a unique filename"); + lua_pushstring(L, buff); + return 1; +} + + +static int os_getenv (lua_State *L) { + lua_pushstring(L, getenv(luaL_checkstring(L, 1))); /* if NULL push nil */ + return 1; +} + + +static int os_clock (lua_State *L) { + lua_pushnumber(L, ((lua_Number)clock())/(lua_Number)CLOCKS_PER_SEC); + return 1; +} + + +/* +** {====================================================== +** Time/Date operations +** { year=%Y, month=%m, day=%d, hour=%H, min=%M, sec=%S, +** wday=%w+1, yday=%j, isdst=? } +** ======================================================= +*/ + +static void setfield (lua_State *L, const char *key, int value) { + lua_pushinteger(L, value); + lua_setfield(L, -2, key); +} + +static void setboolfield (lua_State *L, const char *key, int value) { + if (value < 0) /* undefined? */ + return; /* does not set field */ + lua_pushboolean(L, value); + lua_setfield(L, -2, key); +} + +static int getboolfield (lua_State *L, const char *key) { + int res; + lua_getfield(L, -1, key); + res = lua_isnil(L, -1) ? -1 : lua_toboolean(L, -1); + lua_pop(L, 1); + return res; +} + + +static int getfield (lua_State *L, const char *key, int d) { + int res; + lua_getfield(L, -1, key); + if (lua_isnumber(L, -1)) + res = (int)lua_tointeger(L, -1); + else { + if (d < 0) + return luaL_error(L, "field " LUA_QS " missing in date table", key); + res = d; + } + lua_pop(L, 1); + return res; +} + + +static int os_date (lua_State *L) { + const char *s = luaL_optstring(L, 1, "%c"); + time_t t = luaL_opt(L, (time_t)luaL_checknumber, 2, time(NULL)); + struct tm *stm; + if (*s == '!') { /* UTC? */ + stm = gmtime(&t); + s++; /* skip `!' */ + } + else + stm = localtime(&t); + if (stm == NULL) /* invalid date? */ + lua_pushnil(L); + else if (strcmp(s, "*t") == 0) { + lua_createtable(L, 0, 9); /* 9 = number of fields */ + setfield(L, "sec", stm->tm_sec); + setfield(L, "min", stm->tm_min); + setfield(L, "hour", stm->tm_hour); + setfield(L, "day", stm->tm_mday); + setfield(L, "month", stm->tm_mon+1); + setfield(L, "year", stm->tm_year+1900); + setfield(L, "wday", stm->tm_wday+1); + setfield(L, "yday", stm->tm_yday+1); + setboolfield(L, "isdst", stm->tm_isdst); + } + else { + char cc[3]; + luaL_Buffer b; + cc[0] = '%'; cc[2] = '\0'; + luaL_buffinit(L, &b); + for (; *s; s++) { + if (*s != '%' || *(s + 1) == '\0') /* no conversion specifier? */ + luaL_addchar(&b, *s); + else { + size_t reslen; + char buff[200]; /* should be big enough for any conversion result */ + cc[1] = *(++s); + reslen = strftime(buff, sizeof(buff), cc, stm); + luaL_addlstring(&b, buff, reslen); + } + } + luaL_pushresult(&b); + } + return 1; +} + + +static int os_time (lua_State *L) { + time_t t; + if (lua_isnoneornil(L, 1)) /* called without args? */ + t = time(NULL); /* get current time */ + else { + struct tm ts; + luaL_checktype(L, 1, LUA_TTABLE); + lua_settop(L, 1); /* make sure table is at the top */ + ts.tm_sec = getfield(L, "sec", 0); + ts.tm_min = getfield(L, "min", 0); + ts.tm_hour = getfield(L, "hour", 12); + ts.tm_mday = getfield(L, "day", -1); + ts.tm_mon = getfield(L, "month", -1) - 1; + ts.tm_year = getfield(L, "year", -1) - 1900; + ts.tm_isdst = getboolfield(L, "isdst"); + t = mktime(&ts); + } + if (t == (time_t)(-1)) + lua_pushnil(L); + else + lua_pushnumber(L, (lua_Number)t); + return 1; +} + + +static int os_difftime (lua_State *L) { + lua_pushnumber(L, difftime((time_t)(luaL_checknumber(L, 1)), + (time_t)(luaL_optnumber(L, 2, 0)))); + return 1; +} + +/* }====================================================== */ + + +static int os_setlocale (lua_State *L) { + static const int cat[] = {LC_ALL, LC_COLLATE, LC_CTYPE, LC_MONETARY, + LC_NUMERIC, LC_TIME}; + static const char *const catnames[] = {"all", "collate", "ctype", "monetary", + "numeric", "time", NULL}; + const char *l = luaL_optstring(L, 1, NULL); + int op = luaL_checkoption(L, 2, "all", catnames); + lua_pushstring(L, setlocale(cat[op], l)); + return 1; +} + + +static int os_exit (lua_State *L) { + exit(luaL_optint(L, 1, EXIT_SUCCESS)); + return 0; /* to avoid warnings */ +} + +static const luaL_Reg syslib[] = { + {"clock", os_clock}, + {"date", os_date}, + {"difftime", os_difftime}, + {"execute", os_execute}, + {"exit", os_exit}, + {"getenv", os_getenv}, + {"remove", os_remove}, + {"rename", os_rename}, + {"setlocale", os_setlocale}, + {"time", os_time}, + {"tmpname", os_tmpname}, + {NULL, NULL} +}; + +/* }====================================================== */ + + + +LUALIB_API int luaopen_os (lua_State *L) { + luaL_register(L, LUA_OSLIBNAME, syslib); + return 1; +} + diff --git a/src/lua-vm/lparser.c b/src/lua-vm/lparser.c new file mode 100644 index 0000000..6c473c4 --- /dev/null +++ b/src/lua-vm/lparser.c @@ -0,0 +1,1337 @@ +/* +** $Id: lparser.c,v 2.42a 2006/06/05 15:57:59 roberto Exp $ +** Lua Parser +** See Copyright Notice in lua.h +*/ + + +#include + +#define lparser_c +#define LUA_CORE + +#include "lua.h" + +#include "lcode.h" +#include "ldebug.h" +#include "ldo.h" +#include "lfunc.h" +#include "llex.h" +#include "lmem.h" +#include "lobject.h" +#include "lopcodes.h" +#include "lparser.h" +#include "lstate.h" +#include "lstring.h" +#include "ltable.h" + + + +#define hasmultret(k) ((k) == VCALL || (k) == VVARARG) + +#define getlocvar(fs, i) ((fs)->f->locvars[(fs)->actvar[i]]) + +#define luaY_checklimit(fs,v,l,m) if ((v)>(l)) errorlimit(fs,l,m) + + +/* +** nodes for block list (list of active blocks) +*/ +typedef struct BlockCnt { + struct BlockCnt *previous; /* chain */ + int breaklist; /* list of jumps out of this loop */ + lu_byte nactvar; /* # active locals outside the breakable structure */ + lu_byte upval; /* true if some variable in the block is an upvalue */ + lu_byte isbreakable; /* true if `block' is a loop */ +} BlockCnt; + + + +/* +** prototypes for recursive non-terminal functions +*/ +static void chunk (LexState *ls); +static void expr (LexState *ls, expdesc *v); + + +static void anchor_token (LexState *ls) { + if (ls->t.token == TK_NAME || ls->t.token == TK_STRING) { + TString *ts = ls->t.seminfo.ts; + luaX_newstring(ls, getstr(ts), ts->tsv.len); + } +} + + +static void error_expected (LexState *ls, int token) { + luaX_syntaxerror(ls, + luaO_pushfstring(ls->L, LUA_QS " expected", luaX_token2str(ls, token))); +} + + +static void errorlimit (FuncState *fs, int limit, const char *what) { + const char *msg = (fs->f->linedefined == 0) ? + luaO_pushfstring(fs->L, "main function has more than %d %s", limit, what) : + luaO_pushfstring(fs->L, "function at line %d has more than %d %s", + fs->f->linedefined, limit, what); + luaX_lexerror(fs->ls, msg, 0); +} + + +static int testnext (LexState *ls, int c) { + if (ls->t.token == c) { + luaX_next(ls); + return 1; + } + else return 0; +} + + +static void check (LexState *ls, int c) { + if (ls->t.token != c) + error_expected(ls, c); +} + +static void checknext (LexState *ls, int c) { + check(ls, c); + luaX_next(ls); +} + + +#define check_condition(ls,c,msg) { if (!(c)) luaX_syntaxerror(ls, msg); } + + + +static void check_match (LexState *ls, int what, int who, int where) { + if (!testnext(ls, what)) { + if (where == ls->linenumber) + error_expected(ls, what); + else { + luaX_syntaxerror(ls, luaO_pushfstring(ls->L, + LUA_QS " expected (to close " LUA_QS " at line %d)", + luaX_token2str(ls, what), luaX_token2str(ls, who), where)); + } + } +} + + +static TString *str_checkname (LexState *ls) { + TString *ts; + check(ls, TK_NAME); + ts = ls->t.seminfo.ts; + luaX_next(ls); + return ts; +} + + +static void init_exp (expdesc *e, expkind k, int i) { + e->f = e->t = NO_JUMP; + e->k = k; + e->u.s.info = i; +} + + +static void codestring (LexState *ls, expdesc *e, TString *s) { + init_exp(e, VK, luaK_stringK(ls->fs, s)); +} + + +static void checkname(LexState *ls, expdesc *e) { + codestring(ls, e, str_checkname(ls)); +} + + +static int registerlocalvar (LexState *ls, TString *varname) { + FuncState *fs = ls->fs; + Proto *f = fs->f; + int oldsize = f->sizelocvars; + luaM_growvector(ls->L, f->locvars, fs->nlocvars, f->sizelocvars, + LocVar, SHRT_MAX, "too many local variables"); + while (oldsize < f->sizelocvars) f->locvars[oldsize++].varname = NULL; + f->locvars[fs->nlocvars].varname = varname; + luaC_objbarrier(ls->L, f, varname); + return fs->nlocvars++; +} + + +#define new_localvarliteral(ls,v,n) \ + new_localvar(ls, luaX_newstring(ls, "" v, (sizeof(v)/sizeof(char))-1), n) + + +static void new_localvar (LexState *ls, TString *name, int n) { + FuncState *fs = ls->fs; + luaY_checklimit(fs, fs->nactvar+n+1, LUAI_MAXVARS, "local variables"); + fs->actvar[fs->nactvar+n] = cast(unsigned short, registerlocalvar(ls, name)); +} + + +static void adjustlocalvars (LexState *ls, int nvars) { + FuncState *fs = ls->fs; + fs->nactvar = cast_byte(fs->nactvar + nvars); + for (; nvars; nvars--) { + getlocvar(fs, fs->nactvar - nvars).startpc = fs->pc; + } +} + + +static void removevars (LexState *ls, int tolevel) { + FuncState *fs = ls->fs; + while (fs->nactvar > tolevel) + getlocvar(fs, --fs->nactvar).endpc = fs->pc; +} + + +static int indexupvalue (FuncState *fs, TString *name, expdesc *v) { + int i; + Proto *f = fs->f; + int oldsize = f->sizeupvalues; + for (i=0; inups; i++) { + if (fs->upvalues[i].k == v->k && fs->upvalues[i].info == v->u.s.info) { + lua_assert(f->upvalues[i] == name); + return i; + } + } + /* new one */ + luaY_checklimit(fs, f->nups + 1, LUAI_MAXUPVALUES, "upvalues"); + luaM_growvector(fs->L, f->upvalues, f->nups, f->sizeupvalues, + TString *, MAX_INT, ""); + while (oldsize < f->sizeupvalues) f->upvalues[oldsize++] = NULL; + f->upvalues[f->nups] = name; + luaC_objbarrier(fs->L, f, name); + lua_assert(v->k == VLOCAL || v->k == VUPVAL); + fs->upvalues[f->nups].k = cast_byte(v->k); + fs->upvalues[f->nups].info = cast_byte(v->u.s.info); + return f->nups++; +} + + +static int searchvar (FuncState *fs, TString *n) { + int i; + for (i=fs->nactvar-1; i >= 0; i--) { + if (n == getlocvar(fs, i).varname) + return i; + } + return -1; /* not found */ +} + + +static void markupval (FuncState *fs, int level) { + BlockCnt *bl = fs->bl; + while (bl && bl->nactvar > level) bl = bl->previous; + if (bl) bl->upval = 1; +} + + +static int singlevaraux (FuncState *fs, TString *n, expdesc *var, int base) { + if (fs == NULL) { /* no more levels? */ + init_exp(var, VGLOBAL, NO_REG); /* default is global variable */ + return VGLOBAL; + } + else { + int v = searchvar(fs, n); /* look up at current level */ + if (v >= 0) { + init_exp(var, VLOCAL, v); + if (!base) + markupval(fs, v); /* local will be used as an upval */ + return VLOCAL; + } + else { /* not found at current level; try upper one */ + if (singlevaraux(fs->prev, n, var, 0) == VGLOBAL) + return VGLOBAL; + var->u.s.info = indexupvalue(fs, n, var); /* else was LOCAL or UPVAL */ + var->k = VUPVAL; /* upvalue in this level */ + return VUPVAL; + } + } +} + + +static void singlevar (LexState *ls, expdesc *var) { + TString *varname = str_checkname(ls); + FuncState *fs = ls->fs; + if (singlevaraux(fs, varname, var, 1) == VGLOBAL) + var->u.s.info = luaK_stringK(fs, varname); /* info points to global name */ +} + + +static void adjust_assign (LexState *ls, int nvars, int nexps, expdesc *e) { + FuncState *fs = ls->fs; + int extra = nvars - nexps; + if (hasmultret(e->k)) { + extra++; /* includes call itself */ + if (extra < 0) extra = 0; + luaK_setreturns(fs, e, extra); /* last exp. provides the difference */ + if (extra > 1) luaK_reserveregs(fs, extra-1); + } + else { + if (e->k != VVOID) luaK_exp2nextreg(fs, e); /* close last expression */ + if (extra > 0) { + int reg = fs->freereg; + luaK_reserveregs(fs, extra); + luaK_nil(fs, reg, extra); + } + } +} + + +static void enterlevel (LexState *ls) { + if (++ls->L->nCcalls > LUAI_MAXCCALLS) + luaX_lexerror(ls, "chunk has too many syntax levels", 0); +} + + +#define leavelevel(ls) ((ls)->L->nCcalls--) + + +static void enterblock (FuncState *fs, BlockCnt *bl, lu_byte isbreakable) { + bl->breaklist = NO_JUMP; + bl->isbreakable = isbreakable; + bl->nactvar = fs->nactvar; + bl->upval = 0; + bl->previous = fs->bl; + fs->bl = bl; + lua_assert(fs->freereg == fs->nactvar); +} + + +static void leaveblock (FuncState *fs) { + BlockCnt *bl = fs->bl; + fs->bl = bl->previous; + removevars(fs->ls, bl->nactvar); + if (bl->upval) + luaK_codeABC(fs, OP_CLOSE, bl->nactvar, 0, 0); + /* a block either controls scope or breaks (never both) */ + lua_assert(!bl->isbreakable || !bl->upval); + lua_assert(bl->nactvar == fs->nactvar); + fs->freereg = fs->nactvar; /* free registers */ + luaK_patchtohere(fs, bl->breaklist); +} + + +static void pushclosure (LexState *ls, FuncState *func, expdesc *v) { + FuncState *fs = ls->fs; + Proto *f = fs->f; + int oldsize = f->sizep; + int i; + luaM_growvector(ls->L, f->p, fs->np, f->sizep, Proto *, + MAXARG_Bx, "constant table overflow"); + while (oldsize < f->sizep) f->p[oldsize++] = NULL; + f->p[fs->np++] = func->f; + luaC_objbarrier(ls->L, f, func->f); + init_exp(v, VRELOCABLE, luaK_codeABx(fs, OP_CLOSURE, 0, fs->np-1)); + for (i=0; if->nups; i++) { + OpCode o = (func->upvalues[i].k == VLOCAL) ? OP_MOVE : OP_GETUPVAL; + luaK_codeABC(fs, o, 0, func->upvalues[i].info, 0); + } +} + + +static void open_func (LexState *ls, FuncState *fs) { + lua_State *L = ls->L; + Proto *f = luaF_newproto(L); + fs->f = f; + fs->prev = ls->fs; /* linked list of funcstates */ + fs->ls = ls; + fs->L = L; + ls->fs = fs; + fs->pc = 0; + fs->lasttarget = -1; + fs->jpc = NO_JUMP; + fs->freereg = 0; + fs->nk = 0; + fs->np = 0; + fs->nlocvars = 0; + fs->nactvar = 0; + fs->bl = NULL; + f->source = ls->source; + f->maxstacksize = 2; /* registers 0/1 are always valid */ + fs->h = luaH_new(L, 0, 0); + /* anchor table of constants and prototype (to avoid being collected) */ + sethvalue2s(L, L->top, fs->h); + incr_top(L); + setptvalue2s(L, L->top, f); + incr_top(L); +} + + +static void close_func (LexState *ls) { + lua_State *L = ls->L; + FuncState *fs = ls->fs; + Proto *f = fs->f; + removevars(ls, 0); + luaK_ret(fs, 0, 0); /* final return */ + luaM_reallocvector(L, f->code, f->sizecode, fs->pc, Instruction); + f->sizecode = fs->pc; + luaM_reallocvector(L, f->lineinfo, f->sizelineinfo, fs->pc, int); + f->sizelineinfo = fs->pc; + luaM_reallocvector(L, f->k, f->sizek, fs->nk, TValue); + f->sizek = fs->nk; + luaM_reallocvector(L, f->p, f->sizep, fs->np, Proto *); + f->sizep = fs->np; + luaM_reallocvector(L, f->locvars, f->sizelocvars, fs->nlocvars, LocVar); + f->sizelocvars = fs->nlocvars; + luaM_reallocvector(L, f->upvalues, f->sizeupvalues, f->nups, TString *); + f->sizeupvalues = f->nups; + lua_assert(luaG_checkcode(f)); + lua_assert(fs->bl == NULL); + ls->fs = fs->prev; + L->top -= 2; /* remove table and prototype from the stack */ + /* last token read was anchored in defunct function; must reanchor it */ + if (fs) anchor_token(ls); +} + + +Proto *luaY_parser (lua_State *L, ZIO *z, Mbuffer *buff, const char *name) { + struct LexState lexstate; + struct FuncState funcstate; + lexstate.buff = buff; + luaX_setinput(L, &lexstate, z, luaS_new(L, name)); + open_func(&lexstate, &funcstate); + funcstate.f->is_vararg = VARARG_ISVARARG; /* main func. is always vararg */ + luaX_next(&lexstate); /* read first token */ + chunk(&lexstate); + check(&lexstate, TK_EOS); + close_func(&lexstate); + lua_assert(funcstate.prev == NULL); + lua_assert(funcstate.f->nups == 0); + lua_assert(lexstate.fs == NULL); + return funcstate.f; +} + + + +/*============================================================*/ +/* GRAMMAR RULES */ +/*============================================================*/ + + +static void field (LexState *ls, expdesc *v) { + /* field -> ['.' | ':'] NAME */ + FuncState *fs = ls->fs; + expdesc key; + luaK_exp2anyreg(fs, v); + luaX_next(ls); /* skip the dot or colon */ + checkname(ls, &key); + luaK_indexed(fs, v, &key); +} + + +static void yindex (LexState *ls, expdesc *v) { + /* index -> '[' expr ']' */ + luaX_next(ls); /* skip the '[' */ + expr(ls, v); + luaK_exp2val(ls->fs, v); + checknext(ls, ']'); +} + + +/* +** {====================================================================== +** Rules for Constructors +** ======================================================================= +*/ + + +struct ConsControl { + expdesc v; /* last list item read */ + expdesc *t; /* table descriptor */ + int nh; /* total number of `record' elements */ + int na; /* total number of array elements */ + int tostore; /* number of array elements pending to be stored */ +}; + + +static void recfield (LexState *ls, struct ConsControl *cc) { + /* recfield -> (NAME | `['exp1`]') = exp1 */ + FuncState *fs = ls->fs; + int reg = ls->fs->freereg; + expdesc key, val; + int rkkey; + if (ls->t.token == TK_NAME) { + luaY_checklimit(fs, cc->nh, MAX_INT, "items in a constructor"); + checkname(ls, &key); + } + else /* ls->t.token == '[' */ + yindex(ls, &key); + cc->nh++; + checknext(ls, '='); + rkkey = luaK_exp2RK(fs, &key); + expr(ls, &val); + luaK_codeABC(fs, OP_SETTABLE, cc->t->u.s.info, rkkey, luaK_exp2RK(fs, &val)); + fs->freereg = reg; /* free registers */ +} + + +static void closelistfield (FuncState *fs, struct ConsControl *cc) { + if (cc->v.k == VVOID) return; /* there is no list item */ + luaK_exp2nextreg(fs, &cc->v); + cc->v.k = VVOID; + if (cc->tostore == LFIELDS_PER_FLUSH) { + luaK_setlist(fs, cc->t->u.s.info, cc->na, cc->tostore); /* flush */ + cc->tostore = 0; /* no more items pending */ + } +} + + +static void lastlistfield (FuncState *fs, struct ConsControl *cc) { + if (cc->tostore == 0) return; + if (hasmultret(cc->v.k)) { + luaK_setmultret(fs, &cc->v); + luaK_setlist(fs, cc->t->u.s.info, cc->na, LUA_MULTRET); + cc->na--; /* do not count last expression (unknown number of elements) */ + } + else { + if (cc->v.k != VVOID) + luaK_exp2nextreg(fs, &cc->v); + luaK_setlist(fs, cc->t->u.s.info, cc->na, cc->tostore); + } +} + + +static void listfield (LexState *ls, struct ConsControl *cc) { + expr(ls, &cc->v); + luaY_checklimit(ls->fs, cc->na, MAX_INT, "items in a constructor"); + cc->na++; + cc->tostore++; +} + + +static void constructor (LexState *ls, expdesc *t) { + /* constructor -> ?? */ + FuncState *fs = ls->fs; + int line = ls->linenumber; + int pc = luaK_codeABC(fs, OP_NEWTABLE, 0, 0, 0); + struct ConsControl cc; + cc.na = cc.nh = cc.tostore = 0; + cc.t = t; + init_exp(t, VRELOCABLE, pc); + init_exp(&cc.v, VVOID, 0); /* no value (yet) */ + luaK_exp2nextreg(ls->fs, t); /* fix it at stack top (for gc) */ + checknext(ls, '{'); + do { + lua_assert(cc.v.k == VVOID || cc.tostore > 0); + if (ls->t.token == '}') break; + closelistfield(fs, &cc); + switch(ls->t.token) { + case TK_NAME: { /* may be listfields or recfields */ + luaX_lookahead(ls); + if (ls->lookahead.token != '=') /* expression? */ + listfield(ls, &cc); + else + recfield(ls, &cc); + break; + } + case '[': { /* constructor_item -> recfield */ + recfield(ls, &cc); + break; + } + default: { /* constructor_part -> listfield */ + listfield(ls, &cc); + break; + } + } + } while (testnext(ls, ',') || testnext(ls, ';')); + check_match(ls, '}', '{', line); + lastlistfield(fs, &cc); + SETARG_B(fs->f->code[pc], luaO_int2fb(cc.na)); /* set initial array size */ + SETARG_C(fs->f->code[pc], luaO_int2fb(cc.nh)); /* set initial table size */ +} + +/* }====================================================================== */ + + + +static void parlist (LexState *ls) { + /* parlist -> [ param { `,' param } ] */ + FuncState *fs = ls->fs; + Proto *f = fs->f; + int nparams = 0; + f->is_vararg = 0; + if (ls->t.token != ')') { /* is `parlist' not empty? */ + do { + switch (ls->t.token) { + case TK_NAME: { /* param -> NAME */ + new_localvar(ls, str_checkname(ls), nparams++); + break; + } + case TK_DOTS: { /* param -> `...' */ + luaX_next(ls); +#if defined(LUA_COMPAT_VARARG) + /* use `arg' as default name */ + new_localvarliteral(ls, "arg", nparams++); + f->is_vararg = VARARG_HASARG | VARARG_NEEDSARG; +#endif + f->is_vararg |= VARARG_ISVARARG; + break; + } + default: luaX_syntaxerror(ls, " or " LUA_QL("...") " expected"); + } + } while (!f->is_vararg && testnext(ls, ',')); + } + adjustlocalvars(ls, nparams); + f->numparams = cast_byte(fs->nactvar - (f->is_vararg & VARARG_HASARG)); + luaK_reserveregs(fs, fs->nactvar); /* reserve register for parameters */ +} + + +static void body (LexState *ls, expdesc *e, int needself, int line) { + /* body -> `(' parlist `)' chunk END */ + FuncState new_fs; + open_func(ls, &new_fs); + new_fs.f->linedefined = line; + checknext(ls, '('); + if (needself) { + new_localvarliteral(ls, "self", 0); + adjustlocalvars(ls, 1); + } + parlist(ls); + checknext(ls, ')'); + chunk(ls); + new_fs.f->lastlinedefined = ls->linenumber; + check_match(ls, TK_END, TK_FUNCTION, line); + close_func(ls); + pushclosure(ls, &new_fs, e); +} + + +static int explist1 (LexState *ls, expdesc *v) { + /* explist1 -> expr { `,' expr } */ + int n = 1; /* at least one expression */ + expr(ls, v); + while (testnext(ls, ',')) { + luaK_exp2nextreg(ls->fs, v); + expr(ls, v); + n++; + } + return n; +} + + +static void funcargs (LexState *ls, expdesc *f) { + FuncState *fs = ls->fs; + expdesc args; + int base, nparams; + int line = ls->linenumber; + switch (ls->t.token) { + case '(': { /* funcargs -> `(' [ explist1 ] `)' */ + if (line != ls->lastline) + luaX_syntaxerror(ls,"ambiguous syntax (function call x new statement)"); + luaX_next(ls); + if (ls->t.token == ')') /* arg list is empty? */ + args.k = VVOID; + else { + explist1(ls, &args); + luaK_setmultret(fs, &args); + } + check_match(ls, ')', '(', line); + break; + } + case '{': { /* funcargs -> constructor */ + constructor(ls, &args); + break; + } + case TK_STRING: { /* funcargs -> STRING */ + codestring(ls, &args, ls->t.seminfo.ts); + luaX_next(ls); /* must use `seminfo' before `next' */ + break; + } + default: { + luaX_syntaxerror(ls, "function arguments expected"); + return; + } + } + lua_assert(f->k == VNONRELOC); + base = f->u.s.info; /* base register for call */ + if (hasmultret(args.k)) + nparams = LUA_MULTRET; /* open call */ + else { + if (args.k != VVOID) + luaK_exp2nextreg(fs, &args); /* close last argument */ + nparams = fs->freereg - (base+1); + } + init_exp(f, VCALL, luaK_codeABC(fs, OP_CALL, base, nparams+1, 2)); + luaK_fixline(fs, line); + fs->freereg = base+1; /* call remove function and arguments and leaves + (unless changed) one result */ +} + + + + +/* +** {====================================================================== +** Expression parsing +** ======================================================================= +*/ + + +static void prefixexp (LexState *ls, expdesc *v) { + /* prefixexp -> NAME | '(' expr ')' */ + switch (ls->t.token) { + case '(': { + int line = ls->linenumber; + luaX_next(ls); + expr(ls, v); + check_match(ls, ')', '(', line); + luaK_dischargevars(ls->fs, v); + return; + } + case TK_NAME: { + singlevar(ls, v); + return; + } + default: { + luaX_syntaxerror(ls, "unexpected symbol"); + return; + } + } +} + + +static void primaryexp (LexState *ls, expdesc *v) { + /* primaryexp -> + prefixexp { `.' NAME | `[' exp `]' | `:' NAME funcargs | funcargs } */ + FuncState *fs = ls->fs; + prefixexp(ls, v); + for (;;) { + switch (ls->t.token) { + case '.': { /* field */ + field(ls, v); + break; + } + case '[': { /* `[' exp1 `]' */ + expdesc key; + luaK_exp2anyreg(fs, v); + yindex(ls, &key); + luaK_indexed(fs, v, &key); + break; + } + case ':': { /* `:' NAME funcargs */ + expdesc key; + luaX_next(ls); + checkname(ls, &key); + luaK_self(fs, v, &key); + funcargs(ls, v); + break; + } + case '(': case TK_STRING: case '{': { /* funcargs */ + luaK_exp2nextreg(fs, v); + funcargs(ls, v); + break; + } + default: return; + } + } +} + + +static void simpleexp (LexState *ls, expdesc *v) { + /* simpleexp -> NUMBER | STRING | NIL | true | false | ... | + constructor | FUNCTION body | primaryexp */ + switch (ls->t.token) { + case TK_NUMBER: { + init_exp(v, VKNUM, 0); + v->u.nval = ls->t.seminfo.r; + break; + } + case TK_STRING: { + codestring(ls, v, ls->t.seminfo.ts); + break; + } + case TK_NIL: { + init_exp(v, VNIL, 0); + break; + } + case TK_TRUE: { + init_exp(v, VTRUE, 0); + break; + } + case TK_FALSE: { + init_exp(v, VFALSE, 0); + break; + } + case TK_DOTS: { /* vararg */ + FuncState *fs = ls->fs; + check_condition(ls, fs->f->is_vararg, + "cannot use " LUA_QL("...") " outside a vararg function"); + fs->f->is_vararg &= ~VARARG_NEEDSARG; /* don't need 'arg' */ + init_exp(v, VVARARG, luaK_codeABC(fs, OP_VARARG, 0, 1, 0)); + break; + } + case '{': { /* constructor */ + constructor(ls, v); + return; + } + case TK_FUNCTION: { + luaX_next(ls); + body(ls, v, 0, ls->linenumber); + return; + } + default: { + primaryexp(ls, v); + return; + } + } + luaX_next(ls); +} + + +static UnOpr getunopr (int op) { + switch (op) { + case TK_NOT: return OPR_NOT; + case '-': return OPR_MINUS; + case '#': return OPR_LEN; + default: return OPR_NOUNOPR; + } +} + + +static BinOpr getbinopr (int op) { + switch (op) { + case '+': return OPR_ADD; + case '-': return OPR_SUB; + case '*': return OPR_MUL; + case '/': return OPR_DIV; + case '%': return OPR_MOD; + case '^': return OPR_POW; + case TK_CONCAT: return OPR_CONCAT; + case TK_NE: return OPR_NE; + case TK_EQ: return OPR_EQ; + case '<': return OPR_LT; + case TK_LE: return OPR_LE; + case '>': return OPR_GT; + case TK_GE: return OPR_GE; + case TK_AND: return OPR_AND; + case TK_OR: return OPR_OR; + default: return OPR_NOBINOPR; + } +} + + +static const struct { + lu_byte left; /* left priority for each binary operator */ + lu_byte right; /* right priority */ +} priority[] = { /* ORDER OPR */ + {6, 6}, {6, 6}, {7, 7}, {7, 7}, {7, 7}, /* `+' `-' `/' `%' */ + {10, 9}, {5, 4}, /* power and concat (right associative) */ + {3, 3}, {3, 3}, /* equality and inequality */ + {3, 3}, {3, 3}, {3, 3}, {3, 3}, /* order */ + {2, 2}, {1, 1} /* logical (and/or) */ +}; + +#define UNARY_PRIORITY 8 /* priority for unary operators */ + + +/* +** subexpr -> (simpleexp | unop subexpr) { binop subexpr } +** where `binop' is any binary operator with a priority higher than `limit' +*/ +static BinOpr subexpr (LexState *ls, expdesc *v, unsigned int limit) { + BinOpr op; + UnOpr uop; + enterlevel(ls); + uop = getunopr(ls->t.token); + if (uop != OPR_NOUNOPR) { + luaX_next(ls); + subexpr(ls, v, UNARY_PRIORITY); + luaK_prefix(ls->fs, uop, v); + } + else simpleexp(ls, v); + /* expand while operators have priorities higher than `limit' */ + op = getbinopr(ls->t.token); + while (op != OPR_NOBINOPR && priority[op].left > limit) { + expdesc v2; + BinOpr nextop; + luaX_next(ls); + luaK_infix(ls->fs, op, v); + /* read sub-expression with higher priority */ + nextop = subexpr(ls, &v2, priority[op].right); + luaK_posfix(ls->fs, op, v, &v2); + op = nextop; + } + leavelevel(ls); + return op; /* return first untreated operator */ +} + + +static void expr (LexState *ls, expdesc *v) { + subexpr(ls, v, 0); +} + +/* }==================================================================== */ + + + +/* +** {====================================================================== +** Rules for Statements +** ======================================================================= +*/ + + +static int block_follow (int token) { + switch (token) { + case TK_ELSE: case TK_ELSEIF: case TK_END: + case TK_UNTIL: case TK_EOS: + return 1; + default: return 0; + } +} + + +static void block (LexState *ls) { + /* block -> chunk */ + FuncState *fs = ls->fs; + BlockCnt bl; + enterblock(fs, &bl, 0); + chunk(ls); + lua_assert(bl.breaklist == NO_JUMP); + leaveblock(fs); +} + + +/* +** structure to chain all variables in the left-hand side of an +** assignment +*/ +struct LHS_assign { + struct LHS_assign *prev; + expdesc v; /* variable (global, local, upvalue, or indexed) */ +}; + + +/* +** check whether, in an assignment to a local variable, the local variable +** is needed in a previous assignment (to a table). If so, save original +** local value in a safe place and use this safe copy in the previous +** assignment. +*/ +static void check_conflict (LexState *ls, struct LHS_assign *lh, expdesc *v) { + FuncState *fs = ls->fs; + int extra = fs->freereg; /* eventual position to save local variable */ + int conflict = 0; + for (; lh; lh = lh->prev) { + if (lh->v.k == VINDEXED) { + if (lh->v.u.s.info == v->u.s.info) { /* conflict? */ + conflict = 1; + lh->v.u.s.info = extra; /* previous assignment will use safe copy */ + } + if (lh->v.u.s.aux == v->u.s.info) { /* conflict? */ + conflict = 1; + lh->v.u.s.aux = extra; /* previous assignment will use safe copy */ + } + } + } + if (conflict) { + luaK_codeABC(fs, OP_MOVE, fs->freereg, v->u.s.info, 0); /* make copy */ + luaK_reserveregs(fs, 1); + } +} + + +static void assignment (LexState *ls, struct LHS_assign *lh, int nvars) { + expdesc e; + check_condition(ls, VLOCAL <= lh->v.k && lh->v.k <= VINDEXED, + "syntax error"); + if (testnext(ls, ',')) { /* assignment -> `,' primaryexp assignment */ + struct LHS_assign nv; + nv.prev = lh; + primaryexp(ls, &nv.v); + if (nv.v.k == VLOCAL) + check_conflict(ls, lh, &nv.v); + assignment(ls, &nv, nvars+1); + } + else { /* assignment -> `=' explist1 */ + int nexps; + checknext(ls, '='); + nexps = explist1(ls, &e); + if (nexps != nvars) { + adjust_assign(ls, nvars, nexps, &e); + if (nexps > nvars) + ls->fs->freereg -= nexps - nvars; /* remove extra values */ + } + else { + luaK_setoneret(ls->fs, &e); /* close last expression */ + luaK_storevar(ls->fs, &lh->v, &e); + return; /* avoid default */ + } + } + init_exp(&e, VNONRELOC, ls->fs->freereg-1); /* default assignment */ + luaK_storevar(ls->fs, &lh->v, &e); +} + + +static int cond (LexState *ls) { + /* cond -> exp */ + expdesc v; + expr(ls, &v); /* read condition */ + if (v.k == VNIL) v.k = VFALSE; /* `falses' are all equal here */ + luaK_goiftrue(ls->fs, &v); + return v.f; +} + + +static void breakstat (LexState *ls) { + FuncState *fs = ls->fs; + BlockCnt *bl = fs->bl; + int upval = 0; + while (bl && !bl->isbreakable) { + upval |= bl->upval; + bl = bl->previous; + } + if (!bl) + luaX_syntaxerror(ls, "no loop to break"); + if (upval) + luaK_codeABC(fs, OP_CLOSE, bl->nactvar, 0, 0); + luaK_concat(fs, &bl->breaklist, luaK_jump(fs)); +} + + +static void whilestat (LexState *ls, int line) { + /* whilestat -> WHILE cond DO block END */ + FuncState *fs = ls->fs; + int whileinit; + int condexit; + BlockCnt bl; + luaX_next(ls); /* skip WHILE */ + whileinit = luaK_getlabel(fs); + condexit = cond(ls); + enterblock(fs, &bl, 1); + checknext(ls, TK_DO); + block(ls); + luaK_patchlist(fs, luaK_jump(fs), whileinit); + check_match(ls, TK_END, TK_WHILE, line); + leaveblock(fs); + luaK_patchtohere(fs, condexit); /* false conditions finish the loop */ +} + + +static void repeatstat (LexState *ls, int line) { + /* repeatstat -> REPEAT block UNTIL cond */ + int condexit; + FuncState *fs = ls->fs; + int repeat_init = luaK_getlabel(fs); + BlockCnt bl1, bl2; + enterblock(fs, &bl1, 1); /* loop block */ + enterblock(fs, &bl2, 0); /* scope block */ + luaX_next(ls); /* skip REPEAT */ + chunk(ls); + check_match(ls, TK_UNTIL, TK_REPEAT, line); + condexit = cond(ls); /* read condition (inside scope block) */ + if (!bl2.upval) { /* no upvalues? */ + leaveblock(fs); /* finish scope */ + luaK_patchlist(ls->fs, condexit, repeat_init); /* close the loop */ + } + else { /* complete semantics when there are upvalues */ + breakstat(ls); /* if condition then break */ + luaK_patchtohere(ls->fs, condexit); /* else... */ + leaveblock(fs); /* finish scope... */ + luaK_patchlist(ls->fs, luaK_jump(fs), repeat_init); /* and repeat */ + } + leaveblock(fs); /* finish loop */ +} + + +static int exp1 (LexState *ls) { + expdesc e; + int k; + expr(ls, &e); + k = e.k; + luaK_exp2nextreg(ls->fs, &e); + return k; +} + + +static void forbody (LexState *ls, int base, int line, int nvars, int isnum) { + /* forbody -> DO block */ + BlockCnt bl; + FuncState *fs = ls->fs; + int prep, endfor; + adjustlocalvars(ls, 3); /* control variables */ + checknext(ls, TK_DO); + prep = isnum ? luaK_codeAsBx(fs, OP_FORPREP, base, NO_JUMP) : luaK_jump(fs); + enterblock(fs, &bl, 0); /* scope for declared variables */ + adjustlocalvars(ls, nvars); + luaK_reserveregs(fs, nvars); + block(ls); + leaveblock(fs); /* end of scope for declared variables */ + luaK_patchtohere(fs, prep); + endfor = (isnum) ? luaK_codeAsBx(fs, OP_FORLOOP, base, NO_JUMP) : + luaK_codeABC(fs, OP_TFORLOOP, base, 0, nvars); + luaK_fixline(fs, line); /* pretend that `OP_FOR' starts the loop */ + luaK_patchlist(fs, (isnum ? endfor : luaK_jump(fs)), prep + 1); +} + + +static void fornum (LexState *ls, TString *varname, int line) { + /* fornum -> NAME = exp1,exp1[,exp1] forbody */ + FuncState *fs = ls->fs; + int base = fs->freereg; + new_localvarliteral(ls, "(for index)", 0); + new_localvarliteral(ls, "(for limit)", 1); + new_localvarliteral(ls, "(for step)", 2); + new_localvar(ls, varname, 3); + checknext(ls, '='); + exp1(ls); /* initial value */ + checknext(ls, ','); + exp1(ls); /* limit */ + if (testnext(ls, ',')) + exp1(ls); /* optional step */ + else { /* default step = 1 */ + luaK_codeABx(fs, OP_LOADK, fs->freereg, luaK_numberK(fs, 1)); + luaK_reserveregs(fs, 1); + } + forbody(ls, base, line, 1, 1); +} + + +static void forlist (LexState *ls, TString *indexname) { + /* forlist -> NAME {,NAME} IN explist1 forbody */ + FuncState *fs = ls->fs; + expdesc e; + int nvars = 0; + int line; + int base = fs->freereg; + /* create control variables */ + new_localvarliteral(ls, "(for generator)", nvars++); + new_localvarliteral(ls, "(for state)", nvars++); + new_localvarliteral(ls, "(for control)", nvars++); + /* create declared variables */ + new_localvar(ls, indexname, nvars++); + while (testnext(ls, ',')) + new_localvar(ls, str_checkname(ls), nvars++); + checknext(ls, TK_IN); + line = ls->linenumber; + adjust_assign(ls, 3, explist1(ls, &e), &e); + luaK_checkstack(fs, 3); /* extra space to call generator */ + forbody(ls, base, line, nvars - 3, 0); +} + + +static void forstat (LexState *ls, int line) { + /* forstat -> FOR (fornum | forlist) END */ + FuncState *fs = ls->fs; + TString *varname; + BlockCnt bl; + enterblock(fs, &bl, 1); /* scope for loop and control variables */ + luaX_next(ls); /* skip `for' */ + varname = str_checkname(ls); /* first variable name */ + switch (ls->t.token) { + case '=': fornum(ls, varname, line); break; + case ',': case TK_IN: forlist(ls, varname); break; + default: luaX_syntaxerror(ls, LUA_QL("=") " or " LUA_QL("in") " expected"); + } + check_match(ls, TK_END, TK_FOR, line); + leaveblock(fs); /* loop scope (`break' jumps to this point) */ +} + + +static int test_then_block (LexState *ls) { + /* test_then_block -> [IF | ELSEIF] cond THEN block */ + int condexit; + luaX_next(ls); /* skip IF or ELSEIF */ + condexit = cond(ls); + checknext(ls, TK_THEN); + block(ls); /* `then' part */ + return condexit; +} + + +static void ifstat (LexState *ls, int line) { + /* ifstat -> IF cond THEN block {ELSEIF cond THEN block} [ELSE block] END */ + FuncState *fs = ls->fs; + int flist; + int escapelist = NO_JUMP; + flist = test_then_block(ls); /* IF cond THEN block */ + while (ls->t.token == TK_ELSEIF) { + luaK_concat(fs, &escapelist, luaK_jump(fs)); + luaK_patchtohere(fs, flist); + flist = test_then_block(ls); /* ELSEIF cond THEN block */ + } + if (ls->t.token == TK_ELSE) { + luaK_concat(fs, &escapelist, luaK_jump(fs)); + luaK_patchtohere(fs, flist); + luaX_next(ls); /* skip ELSE (after patch, for correct line info) */ + block(ls); /* `else' part */ + } + else + luaK_concat(fs, &escapelist, flist); + luaK_patchtohere(fs, escapelist); + check_match(ls, TK_END, TK_IF, line); +} + + +static void localfunc (LexState *ls) { + expdesc v, b; + FuncState *fs = ls->fs; + new_localvar(ls, str_checkname(ls), 0); + init_exp(&v, VLOCAL, fs->freereg); + luaK_reserveregs(fs, 1); + adjustlocalvars(ls, 1); + body(ls, &b, 0, ls->linenumber); + luaK_storevar(fs, &v, &b); + /* debug information will only see the variable after this point! */ + getlocvar(fs, fs->nactvar - 1).startpc = fs->pc; +} + + +static void localstat (LexState *ls) { + /* stat -> LOCAL NAME {`,' NAME} [`=' explist1] */ + int nvars = 0; + int nexps; + expdesc e; + do { + new_localvar(ls, str_checkname(ls), nvars++); + } while (testnext(ls, ',')); + if (testnext(ls, '=')) + nexps = explist1(ls, &e); + else { + e.k = VVOID; + nexps = 0; + } + adjust_assign(ls, nvars, nexps, &e); + adjustlocalvars(ls, nvars); +} + + +static int funcname (LexState *ls, expdesc *v) { + /* funcname -> NAME {field} [`:' NAME] */ + int needself = 0; + singlevar(ls, v); + while (ls->t.token == '.') + field(ls, v); + if (ls->t.token == ':') { + needself = 1; + field(ls, v); + } + return needself; +} + + +static void funcstat (LexState *ls, int line) { + /* funcstat -> FUNCTION funcname body */ + int needself; + expdesc v, b; + luaX_next(ls); /* skip FUNCTION */ + needself = funcname(ls, &v); + body(ls, &b, needself, line); + luaK_storevar(ls->fs, &v, &b); + luaK_fixline(ls->fs, line); /* definition `happens' in the first line */ +} + + +static void exprstat (LexState *ls) { + /* stat -> func | assignment */ + FuncState *fs = ls->fs; + struct LHS_assign v; + primaryexp(ls, &v.v); + if (v.v.k == VCALL) /* stat -> func */ + SETARG_C(getcode(fs, &v.v), 1); /* call statement uses no results */ + else { /* stat -> assignment */ + v.prev = NULL; + assignment(ls, &v, 1); + } +} + + +static void retstat (LexState *ls) { + /* stat -> RETURN explist */ + FuncState *fs = ls->fs; + expdesc e; + int first, nret; /* registers with returned values */ + luaX_next(ls); /* skip RETURN */ + if (block_follow(ls->t.token) || ls->t.token == ';') + first = nret = 0; /* return no values */ + else { + nret = explist1(ls, &e); /* optional return values */ + if (hasmultret(e.k)) { + luaK_setmultret(fs, &e); + if (e.k == VCALL && nret == 1) { /* tail call? */ + SET_OPCODE(getcode(fs,&e), OP_TAILCALL); + lua_assert(GETARG_A(getcode(fs,&e)) == fs->nactvar); + } + first = fs->nactvar; + nret = LUA_MULTRET; /* return all values */ + } + else { + if (nret == 1) /* only one single value? */ + first = luaK_exp2anyreg(fs, &e); + else { + luaK_exp2nextreg(fs, &e); /* values must go to the `stack' */ + first = fs->nactvar; /* return all `active' values */ + lua_assert(nret == fs->freereg - first); + } + } + } + luaK_ret(fs, first, nret); +} + + +static int statement (LexState *ls) { + int line = ls->linenumber; /* may be needed for error messages */ + switch (ls->t.token) { + case TK_IF: { /* stat -> ifstat */ + ifstat(ls, line); + return 0; + } + case TK_WHILE: { /* stat -> whilestat */ + whilestat(ls, line); + return 0; + } + case TK_DO: { /* stat -> DO block END */ + luaX_next(ls); /* skip DO */ + block(ls); + check_match(ls, TK_END, TK_DO, line); + return 0; + } + case TK_FOR: { /* stat -> forstat */ + forstat(ls, line); + return 0; + } + case TK_REPEAT: { /* stat -> repeatstat */ + repeatstat(ls, line); + return 0; + } + case TK_FUNCTION: { + funcstat(ls, line); /* stat -> funcstat */ + return 0; + } + case TK_LOCAL: { /* stat -> localstat */ + luaX_next(ls); /* skip LOCAL */ + if (testnext(ls, TK_FUNCTION)) /* local function? */ + localfunc(ls); + else + localstat(ls); + return 0; + } + case TK_RETURN: { /* stat -> retstat */ + retstat(ls); + return 1; /* must be last statement */ + } + case TK_BREAK: { /* stat -> breakstat */ + luaX_next(ls); /* skip BREAK */ + breakstat(ls); + return 1; /* must be last statement */ + } + default: { + exprstat(ls); + return 0; /* to avoid warnings */ + } + } +} + + +static void chunk (LexState *ls) { + /* chunk -> { stat [`;'] } */ + int islast = 0; + enterlevel(ls); + while (!islast && !block_follow(ls->t.token)) { + islast = statement(ls); + testnext(ls, ';'); + lua_assert(ls->fs->f->maxstacksize >= ls->fs->freereg && + ls->fs->freereg >= ls->fs->nactvar); + ls->fs->freereg = ls->fs->nactvar; /* free registers */ + } + leavelevel(ls); +} + +/* }====================================================================== */ diff --git a/src/lua-vm/lparser.h b/src/lua-vm/lparser.h new file mode 100644 index 0000000..e5b5b57 --- /dev/null +++ b/src/lua-vm/lparser.h @@ -0,0 +1,82 @@ +/* +** $Id: lparser.h,v 1.57 2006/03/09 18:14:31 roberto Exp $ +** Lua Parser +** See Copyright Notice in lua.h +*/ + +#ifndef lparser_h +#define lparser_h + +#include "llimits.h" +#include "lobject.h" +#include "lzio.h" + + +/* +** Expression descriptor +*/ + +typedef enum { + VVOID, /* no value */ + VNIL, + VTRUE, + VFALSE, + VK, /* info = index of constant in `k' */ + VKNUM, /* nval = numerical value */ + VLOCAL, /* info = local register */ + VUPVAL, /* info = index of upvalue in `upvalues' */ + VGLOBAL, /* info = index of table; aux = index of global name in `k' */ + VINDEXED, /* info = table register; aux = index register (or `k') */ + VJMP, /* info = instruction pc */ + VRELOCABLE, /* info = instruction pc */ + VNONRELOC, /* info = result register */ + VCALL, /* info = instruction pc */ + VVARARG /* info = instruction pc */ +} expkind; + +typedef struct expdesc { + expkind k; + union { + struct { int info, aux; } s; + lua_Number nval; + } u; + int t; /* patch list of `exit when true' */ + int f; /* patch list of `exit when false' */ +} expdesc; + + +typedef struct upvaldesc { + lu_byte k; + lu_byte info; +} upvaldesc; + + +struct BlockCnt; /* defined in lparser.c */ + + +/* state needed to generate code for a given function */ +typedef struct FuncState { + Proto *f; /* current function header */ + Table *h; /* table to find (and reuse) elements in `k' */ + struct FuncState *prev; /* enclosing function */ + struct LexState *ls; /* lexical state */ + struct lua_State *L; /* copy of the Lua state */ + struct BlockCnt *bl; /* chain of current blocks */ + int pc; /* next position to code (equivalent to `ncode') */ + int lasttarget; /* `pc' of last `jump target' */ + int jpc; /* list of pending jumps to `pc' */ + int freereg; /* first free register */ + int nk; /* number of elements in `k' */ + int np; /* number of elements in `p' */ + short nlocvars; /* number of elements in `locvars' */ + lu_byte nactvar; /* number of active local variables */ + upvaldesc upvalues[LUAI_MAXUPVALUES]; /* upvalues */ + unsigned short actvar[LUAI_MAXVARS]; /* declared-variable stack */ +} FuncState; + + +LUAI_FUNC Proto *luaY_parser (lua_State *L, ZIO *z, Mbuffer *buff, + const char *name); + + +#endif diff --git a/src/lua-vm/lstate.c b/src/lua-vm/lstate.c new file mode 100644 index 0000000..4bcb759 --- /dev/null +++ b/src/lua-vm/lstate.c @@ -0,0 +1,214 @@ +/* +** $Id: lstate.c,v 2.36 2006/05/24 14:15:50 roberto Exp $ +** Global State +** See Copyright Notice in lua.h +*/ + + +#include + +#define lstate_c +#define LUA_CORE + +#include "lua.h" + +#include "ldebug.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" + + +#define state_size(x) (sizeof(x) + LUAI_EXTRASPACE) +#define fromstate(l) (cast(lu_byte *, (l)) - LUAI_EXTRASPACE) +#define tostate(l) (cast(lua_State *, cast(lu_byte *, l) + LUAI_EXTRASPACE)) + + +/* +** Main thread combines a thread state and the global state +*/ +typedef struct LG { + lua_State l; + global_State g; +} LG; + + + +static void stack_init (lua_State *L1, lua_State *L) { + /* initialize CallInfo array */ + L1->base_ci = luaM_newvector(L, BASIC_CI_SIZE, CallInfo); + L1->ci = L1->base_ci; + L1->size_ci = BASIC_CI_SIZE; + L1->end_ci = L1->base_ci + L1->size_ci - 1; + /* initialize stack array */ + L1->stack = luaM_newvector(L, BASIC_STACK_SIZE + EXTRA_STACK, TValue); + L1->stacksize = BASIC_STACK_SIZE + EXTRA_STACK; + L1->top = L1->stack; + L1->stack_last = L1->stack+(L1->stacksize - EXTRA_STACK)-1; + /* initialize first ci */ + L1->ci->func = L1->top; + setnilvalue(L1->top++); /* `function' entry for this `ci' */ + L1->base = L1->ci->base = L1->top; + L1->ci->top = L1->top + LUA_MINSTACK; +} + + +static void freestack (lua_State *L, lua_State *L1) { + luaM_freearray(L, L1->base_ci, L1->size_ci, CallInfo); + luaM_freearray(L, L1->stack, L1->stacksize, TValue); +} + + +/* +** open parts that may cause memory-allocation errors +*/ +static void f_luaopen (lua_State *L, void *ud) { + global_State *g = G(L); + UNUSED(ud); + stack_init(L, L); /* init stack */ + sethvalue(L, gt(L), luaH_new(L, 0, 2)); /* table of globals */ + sethvalue(L, registry(L), luaH_new(L, 0, 2)); /* registry */ + luaS_resize(L, MINSTRTABSIZE); /* initial size of string table */ + luaT_init(L); + luaX_init(L); + luaS_fix(luaS_newliteral(L, MEMERRMSG)); + g->GCthreshold = 4*g->totalbytes; +} + + +static void preinit_state (lua_State *L, global_State *g) { + G(L) = g; + L->stack = NULL; + L->stacksize = 0; + L->errorJmp = NULL; + L->hook = NULL; + L->hookmask = 0; + L->basehookcount = 0; + L->allowhook = 1; + resethookcount(L); + L->openupval = NULL; + L->size_ci = 0; + L->nCcalls = 0; + L->status = 0; + L->base_ci = L->ci = NULL; + L->savedpc = NULL; + L->errfunc = 0; + setnilvalue(gt(L)); +} + + +static void close_state (lua_State *L) { + global_State *g = G(L); + luaF_close(L, L->stack); /* close all upvalues for this thread */ + luaC_freeall(L); /* collect all objects */ + lua_assert(g->rootgc == obj2gco(L)); + lua_assert(g->strt.nuse == 0); + luaM_freearray(L, G(L)->strt.hash, G(L)->strt.size, TString *); + luaZ_freebuffer(L, &g->buff); + freestack(L, L); + lua_assert(g->totalbytes == sizeof(LG)); + (*g->frealloc)(g->ud, fromstate(L), state_size(LG), 0); +} + + +lua_State *luaE_newthread (lua_State *L) { + lua_State *L1 = tostate(luaM_malloc(L, state_size(lua_State))); + luaC_link(L, obj2gco(L1), LUA_TTHREAD); + preinit_state(L1, G(L)); + stack_init(L1, L); /* init stack */ + setobj2n(L, gt(L1), gt(L)); /* share table of globals */ + L1->hookmask = L->hookmask; + L1->basehookcount = L->basehookcount; + L1->hook = L->hook; + resethookcount(L1); + lua_assert(iswhite(obj2gco(L1))); + return L1; +} + + +void luaE_freethread (lua_State *L, lua_State *L1) { + luaF_close(L1, L1->stack); /* close all upvalues for this thread */ + lua_assert(L1->openupval == NULL); + luai_userstatefree(L1); + freestack(L, L1); + luaM_freemem(L, fromstate(L1), state_size(lua_State)); +} + + +LUA_API lua_State *lua_newstate (lua_Alloc f, void *ud) { + int i; + lua_State *L; + global_State *g; + void *l = (*f)(ud, NULL, 0, state_size(LG)); + if (l == NULL) return NULL; + L = tostate(l); + g = &((LG *)L)->g; + L->next = NULL; + L->tt = LUA_TTHREAD; + g->currentwhite = bit2mask(WHITE0BIT, FIXEDBIT); + L->marked = luaC_white(g); + set2bits(L->marked, FIXEDBIT, SFIXEDBIT); + preinit_state(L, g); + g->frealloc = f; + g->ud = ud; + g->mainthread = L; + g->uvhead.u.l.prev = &g->uvhead; + g->uvhead.u.l.next = &g->uvhead; + g->GCthreshold = 0; /* mark it as unfinished state */ + g->strt.size = 0; + g->strt.nuse = 0; + g->strt.hash = NULL; + setnilvalue(registry(L)); + luaZ_initbuffer(L, &g->buff); + g->panic = NULL; + g->gcstate = GCSpause; + g->rootgc = obj2gco(L); + g->sweepstrgc = 0; + g->sweepgc = &g->rootgc; + g->gray = NULL; + g->grayagain = NULL; + g->weak = NULL; + g->tmudata = NULL; + g->totalbytes = sizeof(LG); + g->gcpause = LUAI_GCPAUSE; + g->gcstepmul = LUAI_GCMUL; + g->gcdept = 0; + for (i=0; imt[i] = NULL; + if (luaD_rawrunprotected(L, f_luaopen, NULL) != 0) { + /* memory allocation error: free partial state */ + close_state(L); + L = NULL; + } + else + luai_userstateopen(L); + return L; +} + + +static void callallgcTM (lua_State *L, void *ud) { + UNUSED(ud); + luaC_callGCTM(L); /* call GC metamethods for all udata */ +} + + +LUA_API void lua_close (lua_State *L) { + L = G(L)->mainthread; /* only the main thread can be closed */ + lua_lock(L); + luaF_close(L, L->stack); /* close all upvalues for this thread */ + luaC_separateudata(L, 1); /* separate udata that have GC metamethods */ + L->errfunc = 0; /* no error function during GC metamethods */ + do { /* repeat until no more errors */ + L->ci = L->base_ci; + L->base = L->top = L->ci->base; + L->nCcalls = 0; + } while (luaD_rawrunprotected(L, callallgcTM, NULL) != 0); + lua_assert(G(L)->tmudata == NULL); + luai_userstateclose(L); + close_state(L); +} + diff --git a/src/lua-vm/lstate.h b/src/lua-vm/lstate.h new file mode 100644 index 0000000..d296a4c --- /dev/null +++ b/src/lua-vm/lstate.h @@ -0,0 +1,168 @@ +/* +** $Id: lstate.h,v 2.24 2006/02/06 18:27:59 roberto Exp $ +** Global State +** See Copyright Notice in lua.h +*/ + +#ifndef lstate_h +#define lstate_h + +#include "lua.h" + +#include "lobject.h" +#include "ltm.h" +#include "lzio.h" + + + +struct lua_longjmp; /* defined in ldo.c */ + + +/* table of globals */ +#define gt(L) (&L->l_gt) + +/* registry */ +#define registry(L) (&G(L)->l_registry) + + +/* extra stack space to handle TM calls and some other extras */ +#define EXTRA_STACK 5 + + +#define BASIC_CI_SIZE 8 + +#define BASIC_STACK_SIZE (2*LUA_MINSTACK) + + + +typedef struct stringtable { + GCObject **hash; + lu_int32 nuse; /* number of elements */ + int size; +} stringtable; + + +/* +** informations about a call +*/ +typedef struct CallInfo { + StkId base; /* base for this function */ + StkId func; /* function index in the stack */ + StkId top; /* top for this function */ + const Instruction *savedpc; + int nresults; /* expected number of results from this function */ + int tailcalls; /* number of tail calls lost under this entry */ +} CallInfo; + + + +#define curr_func(L) (clvalue(L->ci->func)) +#define ci_func(ci) (clvalue((ci)->func)) +#define f_isLua(ci) (!ci_func(ci)->c.isC) +#define isLua(ci) (ttisfunction((ci)->func) && f_isLua(ci)) + + +/* +** `global state', shared by all threads of this state +*/ +typedef struct global_State { + stringtable strt; /* hash table for strings */ + lua_Alloc frealloc; /* function to reallocate memory */ + void *ud; /* auxiliary data to `frealloc' */ + lu_byte currentwhite; + lu_byte gcstate; /* state of garbage collector */ + int sweepstrgc; /* position of sweep in `strt' */ + GCObject *rootgc; /* list of all collectable objects */ + GCObject **sweepgc; /* position of sweep in `rootgc' */ + GCObject *gray; /* list of gray objects */ + GCObject *grayagain; /* list of objects to be traversed atomically */ + GCObject *weak; /* list of weak tables (to be cleared) */ + GCObject *tmudata; /* last element of list of userdata to be GC */ + Mbuffer buff; /* temporary buffer for string concatentation */ + lu_mem GCthreshold; + lu_mem totalbytes; /* number of bytes currently allocated */ + lu_mem estimate; /* an estimate of number of bytes actually in use */ + lu_mem gcdept; /* how much GC is `behind schedule' */ + int gcpause; /* size of pause between successive GCs */ + int gcstepmul; /* GC `granularity' */ + lua_CFunction panic; /* to be called in unprotected errors */ + TValue l_registry; + struct lua_State *mainthread; + UpVal uvhead; /* head of double-linked list of all open upvalues */ + struct Table *mt[NUM_TAGS]; /* metatables for basic types */ + TString *tmname[TM_N]; /* array with tag-method names */ +} global_State; + + +/* +** `per thread' state +*/ +struct lua_State { + CommonHeader; + lu_byte status; + StkId top; /* first free slot in the stack */ + StkId base; /* base of current function */ + global_State *l_G; + CallInfo *ci; /* call info for current function */ + const Instruction *savedpc; /* `savedpc' of current function */ + StkId stack_last; /* last free slot in the stack */ + StkId stack; /* stack base */ + CallInfo *end_ci; /* points after end of ci array*/ + CallInfo *base_ci; /* array of CallInfo's */ + int stacksize; + int size_ci; /* size of array `base_ci' */ + unsigned short nCcalls; /* number of nested C calls */ + lu_byte hookmask; + lu_byte allowhook; + int basehookcount; + int hookcount; + lua_Hook hook; + TValue l_gt; /* table of globals */ + TValue env; /* temporary place for environments */ + GCObject *openupval; /* list of open upvalues in this stack */ + GCObject *gclist; + struct lua_longjmp *errorJmp; /* current error recover point */ + ptrdiff_t errfunc; /* current error handling function (stack index) */ +}; + + +#define G(L) (L->l_G) + + +/* +** Union of all collectable objects +*/ +union GCObject { + GCheader gch; + union TString ts; + union Udata u; + union Closure cl; + struct Table h; + struct Proto p; + struct UpVal uv; + struct lua_State th; /* thread */ +}; + + +/* macros to convert a GCObject into a specific value */ +#define rawgco2ts(o) check_exp((o)->gch.tt == LUA_TSTRING, &((o)->ts)) +#define gco2ts(o) (&rawgco2ts(o)->tsv) +#define rawgco2u(o) check_exp((o)->gch.tt == LUA_TUSERDATA, &((o)->u)) +#define gco2u(o) (&rawgco2u(o)->uv) +#define gco2cl(o) check_exp((o)->gch.tt == LUA_TFUNCTION, &((o)->cl)) +#define gco2h(o) check_exp((o)->gch.tt == LUA_TTABLE, &((o)->h)) +#define gco2p(o) check_exp((o)->gch.tt == LUA_TPROTO, &((o)->p)) +#define gco2uv(o) check_exp((o)->gch.tt == LUA_TUPVAL, &((o)->uv)) +#define ngcotouv(o) \ + check_exp((o) == NULL || (o)->gch.tt == LUA_TUPVAL, &((o)->uv)) +#define gco2th(o) check_exp((o)->gch.tt == LUA_TTHREAD, &((o)->th)) + +/* macro to convert any Lua object into a GCObject */ +#define obj2gco(v) (cast(GCObject *, (v))) + + +LUAI_FUNC lua_State *luaE_newthread (lua_State *L); +LUAI_FUNC void luaE_freethread (lua_State *L, lua_State *L1); + +#endif + diff --git a/src/lua-vm/lstring.c b/src/lua-vm/lstring.c new file mode 100644 index 0000000..4319930 --- /dev/null +++ b/src/lua-vm/lstring.c @@ -0,0 +1,111 @@ +/* +** $Id: lstring.c,v 2.8 2005/12/22 16:19:56 roberto Exp $ +** String table (keeps all strings handled by Lua) +** See Copyright Notice in lua.h +*/ + + +#include + +#define lstring_c +#define LUA_CORE + +#include "lua.h" + +#include "lmem.h" +#include "lobject.h" +#include "lstate.h" +#include "lstring.h" + + + +void luaS_resize (lua_State *L, int newsize) { + GCObject **newhash; + stringtable *tb; + int i; + if (G(L)->gcstate == GCSsweepstring) + return; /* cannot resize during GC traverse */ + newhash = luaM_newvector(L, newsize, GCObject *); + tb = &G(L)->strt; + for (i=0; isize; i++) { + GCObject *p = tb->hash[i]; + while (p) { /* for each node in the list */ + GCObject *next = p->gch.next; /* save next */ + unsigned int h = gco2ts(p)->hash; + int h1 = lmod(h, newsize); /* new position */ + lua_assert(cast_int(h%newsize) == lmod(h, newsize)); + p->gch.next = newhash[h1]; /* chain it */ + newhash[h1] = p; + p = next; + } + } + luaM_freearray(L, tb->hash, tb->size, TString *); + tb->size = newsize; + tb->hash = newhash; +} + + +static TString *newlstr (lua_State *L, const char *str, size_t l, + unsigned int h) { + TString *ts; + stringtable *tb; + if (l+1 > (MAX_SIZET - sizeof(TString))/sizeof(char)) + luaM_toobig(L); + ts = cast(TString *, luaM_malloc(L, (l+1)*sizeof(char)+sizeof(TString))); + ts->tsv.len = l; + ts->tsv.hash = h; + ts->tsv.marked = luaC_white(G(L)); + ts->tsv.tt = LUA_TSTRING; + ts->tsv.reserved = 0; + memcpy(ts+1, str, l*sizeof(char)); + ((char *)(ts+1))[l] = '\0'; /* ending 0 */ + tb = &G(L)->strt; + h = lmod(h, tb->size); + ts->tsv.next = tb->hash[h]; /* chain new entry */ + tb->hash[h] = obj2gco(ts); + tb->nuse++; + if (tb->nuse > cast(lu_int32, tb->size) && tb->size <= MAX_INT/2) + luaS_resize(L, tb->size*2); /* too crowded */ + return ts; +} + + +TString *luaS_newlstr (lua_State *L, const char *str, size_t l) { + GCObject *o; + unsigned int h = cast(unsigned int, l); /* seed */ + size_t step = (l>>5)+1; /* if string is too long, don't hash all its chars */ + size_t l1; + for (l1=l; l1>=step; l1-=step) /* compute hash */ + h = h ^ ((h<<5)+(h>>2)+cast(unsigned char, str[l1-1])); + for (o = G(L)->strt.hash[lmod(h, G(L)->strt.size)]; + o != NULL; + o = o->gch.next) { + TString *ts = rawgco2ts(o); + if (ts->tsv.len == l && (memcmp(str, getstr(ts), l) == 0)) { + /* string may be dead */ + if (isdead(G(L), o)) changewhite(o); + return ts; + } + } + return newlstr(L, str, l, h); /* not found */ +} + + +Udata *luaS_newudata (lua_State *L, size_t s, Table *e) { + Udata *u; + if (s > MAX_SIZET - sizeof(Udata)) + luaM_toobig(L); + u = cast(Udata *, luaM_malloc(L, s + sizeof(Udata))); + u->uv.marked = luaC_white(G(L)); /* is not finalized */ + u->uv.tt = LUA_TUSERDATA; + u->uv.len = s; + u->uv.metatable = NULL; + u->uv.env = e; + /* chain it on udata list (after main thread) */ + u->uv.next = G(L)->mainthread->next; + G(L)->mainthread->next = obj2gco(u); + return u; +} + diff --git a/src/lua-vm/lstring.h b/src/lua-vm/lstring.h new file mode 100644 index 0000000..1d2e91e --- /dev/null +++ b/src/lua-vm/lstring.h @@ -0,0 +1,31 @@ +/* +** $Id: lstring.h,v 1.43 2005/04/25 19:24:10 roberto Exp $ +** String table (keep all strings handled by Lua) +** See Copyright Notice in lua.h +*/ + +#ifndef lstring_h +#define lstring_h + + +#include "lgc.h" +#include "lobject.h" +#include "lstate.h" + + +#define sizestring(s) (sizeof(union TString)+((s)->len+1)*sizeof(char)) + +#define sizeudata(u) (sizeof(union Udata)+(u)->len) + +#define luaS_new(L, s) (luaS_newlstr(L, s, strlen(s))) +#define luaS_newliteral(L, s) (luaS_newlstr(L, "" s, \ + (sizeof(s)/sizeof(char))-1)) + +#define luaS_fix(s) l_setbit((s)->tsv.marked, FIXEDBIT) + +LUAI_FUNC void luaS_resize (lua_State *L, int newsize); +LUAI_FUNC Udata *luaS_newudata (lua_State *L, size_t s, Table *e); +LUAI_FUNC TString *luaS_newlstr (lua_State *L, const char *str, size_t l); + + +#endif diff --git a/src/lua-vm/lstrlib.c b/src/lua-vm/lstrlib.c new file mode 100644 index 0000000..fc7ae48 --- /dev/null +++ b/src/lua-vm/lstrlib.c @@ -0,0 +1,868 @@ +/* +** $Id: lstrlib.c,v 1.132a 2006/04/26 20:41:19 roberto Exp $ +** Standard library for string operations and pattern-matching +** See Copyright Notice in lua.h +*/ + + +#include +#include +#include +#include +#include + +#define lstrlib_c +#define LUA_LIB + +#include "lua.h" + +#include "lauxlib.h" +#include "lualib.h" + + +/* macro to `unsign' a character */ +#define uchar(c) ((unsigned char)(c)) + + + +static int str_len (lua_State *L) { + size_t l; + luaL_checklstring(L, 1, &l); + lua_pushinteger(L, l); + return 1; +} + + +static ptrdiff_t posrelat (ptrdiff_t pos, size_t len) { + /* relative string position: negative means back from end */ + return (pos>=0) ? pos : (ptrdiff_t)len+pos+1; +} + + +static int str_sub (lua_State *L) { + size_t l; + const char *s = luaL_checklstring(L, 1, &l); + ptrdiff_t start = posrelat(luaL_checkinteger(L, 2), l); + ptrdiff_t end = posrelat(luaL_optinteger(L, 3, -1), l); + if (start < 1) start = 1; + if (end > (ptrdiff_t)l) end = (ptrdiff_t)l; + if (start <= end) + lua_pushlstring(L, s+start-1, end-start+1); + else lua_pushliteral(L, ""); + return 1; +} + + +static int str_reverse (lua_State *L) { + size_t l; + luaL_Buffer b; + const char *s = luaL_checklstring(L, 1, &l); + luaL_buffinit(L, &b); + while (l--) luaL_addchar(&b, s[l]); + luaL_pushresult(&b); + return 1; +} + + +static int str_lower (lua_State *L) { + size_t l; + size_t i; + luaL_Buffer b; + const char *s = luaL_checklstring(L, 1, &l); + luaL_buffinit(L, &b); + for (i=0; i 0) + luaL_addlstring(&b, s, l); + luaL_pushresult(&b); + return 1; +} + + +static int str_byte (lua_State *L) { + size_t l; + const char *s = luaL_checklstring(L, 1, &l); + ptrdiff_t posi = posrelat(luaL_optinteger(L, 2, 1), l); + ptrdiff_t pose = posrelat(luaL_optinteger(L, 3, posi), l); + int n, i; + if (posi <= 0) posi = 1; + if ((size_t)pose > l) pose = l; + if (posi > pose) return 0; /* empty interval; return no values */ + n = (int)(pose - posi + 1); + if (posi + n <= pose) /* overflow? */ + luaL_error(L, "string slice too long"); + luaL_checkstack(L, n, "string slice too long"); + for (i=0; i= ms->level || ms->capture[l].len == CAP_UNFINISHED) + return luaL_error(ms->L, "invalid capture index"); + return l; +} + + +static int capture_to_close (MatchState *ms) { + int level = ms->level; + for (level--; level>=0; level--) + if (ms->capture[level].len == CAP_UNFINISHED) return level; + return luaL_error(ms->L, "invalid pattern capture"); +} + + +static const char *classend (MatchState *ms, const char *p) { + switch (*p++) { + case L_ESC: { + if (*p == '\0') + luaL_error(ms->L, "malformed pattern (ends with " LUA_QL("%%") ")"); + return p+1; + } + case '[': { + if (*p == '^') p++; + do { /* look for a `]' */ + if (*p == '\0') + luaL_error(ms->L, "malformed pattern (missing " LUA_QL("]") ")"); + if (*(p++) == L_ESC && *p != '\0') + p++; /* skip escapes (e.g. `%]') */ + } while (*p != ']'); + return p+1; + } + default: { + return p; + } + } +} + + +static int match_class (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 'x' : res = isxdigit(c); break; + case 'z' : res = (c == 0); break; + default: return (cl == c); + } + return (islower(cl) ? res : !res); +} + + +static int matchbracketclass (int c, const char *p, const char *ec) { + int sig = 1; + if (*(p+1) == '^') { + sig = 0; + p++; /* skip the `^' */ + } + while (++p < ec) { + if (*p == L_ESC) { + p++; + if (match_class(c, uchar(*p))) + return sig; + } + else if ((*(p+1) == '-') && (p+2 < ec)) { + p+=2; + if (uchar(*(p-2)) <= c && c <= uchar(*p)) + return sig; + } + else if (uchar(*p) == c) return sig; + } + return !sig; +} + + +static int singlematch (int c, const char *p, const char *ep) { + switch (*p) { + case '.': return 1; /* matches any char */ + case L_ESC: return match_class(c, uchar(*(p+1))); + case '[': return matchbracketclass(c, p, ep-1); + default: return (uchar(*p) == c); + } +} + + +static const char *match (MatchState *ms, const char *s, const char *p); + + +static const char *matchbalance (MatchState *ms, const char *s, + const char *p) { + if (*p == 0 || *(p+1) == 0) + luaL_error(ms->L, "unbalanced pattern"); + if (*s != *p) return NULL; + else { + int b = *p; + int e = *(p+1); + int cont = 1; + while (++s < ms->src_end) { + if (*s == e) { + if (--cont == 0) return s+1; + } + else if (*s == b) cont++; + } + } + return NULL; /* string ends out of balance */ +} + + +static const char *max_expand (MatchState *ms, const char *s, + const char *p, const char *ep) { + ptrdiff_t i = 0; /* counts maximum expand for item */ + while ((s+i)src_end && singlematch(uchar(*(s+i)), p, ep)) + i++; + /* keeps trying to match with the maximum repetitions */ + while (i>=0) { + const char *res = match(ms, (s+i), ep+1); + if (res) return res; + i--; /* else didn't match; reduce 1 repetition to try again */ + } + return NULL; +} + + +static const char *min_expand (MatchState *ms, const char *s, + const char *p, const char *ep) { + for (;;) { + const char *res = match(ms, s, ep+1); + if (res != NULL) + return res; + else if (ssrc_end && singlematch(uchar(*s), p, ep)) + s++; /* try with one more repetition */ + else return NULL; + } +} + + +static const char *start_capture (MatchState *ms, const char *s, + const char *p, int what) { + const char *res; + int level = ms->level; + if (level >= LUA_MAXCAPTURES) luaL_error(ms->L, "too many captures"); + ms->capture[level].init = s; + ms->capture[level].len = what; + ms->level = level+1; + if ((res=match(ms, s, p)) == NULL) /* match failed? */ + ms->level--; /* undo capture */ + return res; +} + + +static const char *end_capture (MatchState *ms, const char *s, + const char *p) { + int l = capture_to_close(ms); + const char *res; + ms->capture[l].len = s - ms->capture[l].init; /* close capture */ + if ((res = match(ms, s, p)) == NULL) /* match failed? */ + ms->capture[l].len = CAP_UNFINISHED; /* undo capture */ + return res; +} + + +static const char *match_capture (MatchState *ms, const char *s, int l) { + size_t len; + l = check_capture(ms, l); + len = ms->capture[l].len; + if ((size_t)(ms->src_end-s) >= len && + memcmp(ms->capture[l].init, s, len) == 0) + return s+len; + else return NULL; +} + + +static const char *match (MatchState *ms, const char *s, const char *p) { + init: /* using goto's to optimize tail recursion */ + switch (*p) { + case '(': { /* start capture */ + if (*(p+1) == ')') /* position capture? */ + return start_capture(ms, s, p+2, CAP_POSITION); + else + return start_capture(ms, s, p+1, CAP_UNFINISHED); + } + case ')': { /* end capture */ + return end_capture(ms, s, p+1); + } + case L_ESC: { + switch (*(p+1)) { + case 'b': { /* balanced string? */ + s = matchbalance(ms, s, p+2); + if (s == NULL) return NULL; + p+=4; goto init; /* else return match(ms, s, p+4); */ + } + case 'f': { /* frontier? */ + const char *ep; char previous; + p += 2; + if (*p != '[') + luaL_error(ms->L, "missing " LUA_QL("[") " after " + LUA_QL("%%f") " in pattern"); + ep = classend(ms, p); /* points to what is next */ + previous = (s == ms->src_init) ? '\0' : *(s-1); + if (matchbracketclass(uchar(previous), p, ep-1) || + !matchbracketclass(uchar(*s), p, ep-1)) return NULL; + p=ep; goto init; /* else return match(ms, s, ep); */ + } + default: { + if (isdigit(uchar(*(p+1)))) { /* capture results (%0-%9)? */ + s = match_capture(ms, s, uchar(*(p+1))); + if (s == NULL) return NULL; + p+=2; goto init; /* else return match(ms, s, p+2) */ + } + goto dflt; /* case default */ + } + } + } + case '\0': { /* end of pattern */ + return s; /* match succeeded */ + } + case '$': { + if (*(p+1) == '\0') /* is the `$' the last char in pattern? */ + return (s == ms->src_end) ? s : NULL; /* check end of string */ + else goto dflt; + } + default: dflt: { /* it is a pattern item */ + const char *ep = classend(ms, p); /* points to what is next */ + int m = ssrc_end && singlematch(uchar(*s), p, ep); + switch (*ep) { + case '?': { /* optional */ + const char *res; + if (m && ((res=match(ms, s+1, ep+1)) != NULL)) + return res; + p=ep+1; goto init; /* else return match(ms, s, ep+1); */ + } + case '*': { /* 0 or more repetitions */ + return max_expand(ms, s, p, ep); + } + case '+': { /* 1 or more repetitions */ + return (m ? max_expand(ms, s+1, p, ep) : NULL); + } + case '-': { /* 0 or more repetitions (minimum) */ + return min_expand(ms, s, p, ep); + } + default: { + if (!m) return NULL; + s++; p=ep; goto init; /* else return match(ms, s+1, ep); */ + } + } + } + } +} + + + +static const char *lmemfind (const char *s1, size_t l1, + const char *s2, size_t l2) { + if (l2 == 0) return s1; /* empty strings are everywhere */ + else if (l2 > l1) return NULL; /* avoids a negative `l1' */ + else { + const char *init; /* to search for a `*s2' inside `s1' */ + l2--; /* 1st char will be checked by `memchr' */ + l1 = l1-l2; /* `s2' cannot be found after that */ + while (l1 > 0 && (init = (const char *)memchr(s1, *s2, l1)) != NULL) { + init++; /* 1st char is already checked */ + if (memcmp(init, s2+1, l2) == 0) + return init-1; + else { /* correct `l1' and `s1' to try again */ + l1 -= init-s1; + s1 = init; + } + } + return NULL; /* not found */ + } +} + + +static void push_onecapture (MatchState *ms, int i, const char *s, + const char *e) { + if (i >= ms->level) { + if (i == 0) /* ms->level == 0, too */ + lua_pushlstring(ms->L, s, e - s); /* add whole match */ + else + luaL_error(ms->L, "invalid capture index"); + } + else { + ptrdiff_t l = ms->capture[i].len; + if (l == CAP_UNFINISHED) luaL_error(ms->L, "unfinished capture"); + if (l == CAP_POSITION) + lua_pushinteger(ms->L, ms->capture[i].init - ms->src_init + 1); + else + lua_pushlstring(ms->L, ms->capture[i].init, l); + } +} + + +static int push_captures (MatchState *ms, const char *s, const char *e) { + int i; + int nlevels = (ms->level == 0 && s) ? 1 : ms->level; + luaL_checkstack(ms->L, nlevels, "too many captures"); + for (i = 0; i < nlevels; i++) + push_onecapture(ms, i, s, e); + return nlevels; /* number of strings pushed */ +} + + +static int str_find_aux (lua_State *L, int find) { + size_t l1, l2; + const char *s = luaL_checklstring(L, 1, &l1); + const char *p = luaL_checklstring(L, 2, &l2); + ptrdiff_t init = posrelat(luaL_optinteger(L, 3, 1), l1) - 1; + if (init < 0) init = 0; + else if ((size_t)(init) > l1) init = (ptrdiff_t)l1; + if (find && (lua_toboolean(L, 4) || /* explicit request? */ + strpbrk(p, SPECIALS) == NULL)) { /* or no special characters? */ + /* do a plain search */ + const char *s2 = lmemfind(s+init, l1-init, p, l2); + if (s2) { + lua_pushinteger(L, s2-s+1); + lua_pushinteger(L, s2-s+l2); + return 2; + } + } + else { + MatchState ms; + int anchor = (*p == '^') ? (p++, 1) : 0; + const char *s1=s+init; + ms.L = L; + ms.src_init = s; + ms.src_end = s+l1; + do { + const char *res; + ms.level = 0; + if ((res=match(&ms, s1, p)) != NULL) { + if (find) { + lua_pushinteger(L, s1-s+1); /* start */ + lua_pushinteger(L, res-s); /* end */ + return push_captures(&ms, NULL, 0) + 2; + } + else + return push_captures(&ms, s1, res); + } + } while (s1++ < ms.src_end && !anchor); + } + lua_pushnil(L); /* not found */ + return 1; +} + + +static int str_find (lua_State *L) { + return str_find_aux(L, 1); +} + + +static int str_match (lua_State *L) { + return str_find_aux(L, 0); +} + + +static int gmatch_aux (lua_State *L) { + MatchState ms; + size_t ls; + const char *s = lua_tolstring(L, lua_upvalueindex(1), &ls); + const char *p = lua_tostring(L, lua_upvalueindex(2)); + const char *src; + ms.L = L; + ms.src_init = s; + ms.src_end = s+ls; + for (src = s + (size_t)lua_tointeger(L, lua_upvalueindex(3)); + src <= ms.src_end; + src++) { + const char *e; + ms.level = 0; + if ((e = match(&ms, src, p)) != NULL) { + lua_Integer newstart = e-s; + if (e == src) newstart++; /* empty match? go at least one position */ + lua_pushinteger(L, newstart); + lua_replace(L, lua_upvalueindex(3)); + return push_captures(&ms, src, e); + } + } + return 0; /* not found */ +} + + +static int gmatch (lua_State *L) { + luaL_checkstring(L, 1); + luaL_checkstring(L, 2); + lua_settop(L, 2); + lua_pushinteger(L, 0); + lua_pushcclosure(L, gmatch_aux, 3); + return 1; +} + + +static int gfind_nodef (lua_State *L) { + return luaL_error(L, LUA_QL("string.gfind") " was renamed to " + LUA_QL("string.gmatch")); +} + + +static void add_s (MatchState *ms, luaL_Buffer *b, const char *s, + const char *e) { + size_t l, i; + const char *news = lua_tolstring(ms->L, 3, &l); + for (i = 0; i < l; i++) { + if (news[i] != L_ESC) + luaL_addchar(b, news[i]); + else { + i++; /* skip ESC */ + if (!isdigit(uchar(news[i]))) + luaL_addchar(b, news[i]); + else if (news[i] == '0') + luaL_addlstring(b, s, e - s); + else { + push_onecapture(ms, news[i] - '1', s, e); + luaL_addvalue(b); /* add capture to accumulated result */ + } + } + } +} + + +static void add_value (MatchState *ms, luaL_Buffer *b, const char *s, + const char *e) { + lua_State *L = ms->L; + switch (lua_type(L, 3)) { + case LUA_TNUMBER: + case LUA_TSTRING: { + add_s(ms, b, s, e); + return; + } + case LUA_TFUNCTION: { + int n; + lua_pushvalue(L, 3); + n = push_captures(ms, s, e); + lua_call(L, n, 1); + break; + } + case LUA_TTABLE: { + push_onecapture(ms, 0, s, e); + lua_gettable(L, 3); + break; + } + default: { + luaL_argerror(L, 3, "string/function/table expected"); + return; + } + } + if (!lua_toboolean(L, -1)) { /* nil or false? */ + lua_pop(L, 1); + lua_pushlstring(L, s, e - s); /* keep original text */ + } + else if (!lua_isstring(L, -1)) + luaL_error(L, "invalid replacement value (a %s)", luaL_typename(L, -1)); + luaL_addvalue(b); /* add result to accumulator */ +} + + +static int str_gsub (lua_State *L) { + size_t srcl; + const char *src = luaL_checklstring(L, 1, &srcl); + const char *p = luaL_checkstring(L, 2); + int max_s = luaL_optint(L, 4, srcl+1); + int anchor = (*p == '^') ? (p++, 1) : 0; + int n = 0; + MatchState ms; + luaL_Buffer b; + luaL_buffinit(L, &b); + ms.L = L; + ms.src_init = src; + ms.src_end = src+srcl; + while (n < max_s) { + const char *e; + ms.level = 0; + e = match(&ms, src, p); + if (e) { + n++; + add_value(&ms, &b, src, e); + } + if (e && e>src) /* non empty match? */ + src = e; /* skip it */ + else if (src < ms.src_end) + luaL_addchar(&b, *src++); + else break; + if (anchor) break; + } + luaL_addlstring(&b, src, ms.src_end-src); + luaL_pushresult(&b); + lua_pushinteger(L, n); /* number of substitutions */ + return 2; +} + +/* }====================================================== */ + + +/* maximum size of each formatted item (> len(format('%99.99f', -1e308))) */ +#define MAX_ITEM 512 +/* valid flags in a format specification */ +#define FLAGS "-+ #0" +/* +** maximum size of each format specification (such as '%-099.99d') +** (+10 accounts for %99.99x plus margin of error) +*/ +#define MAX_FORMAT (sizeof(FLAGS) + sizeof(LUA_INTFRMLEN) + 10) + + +static void addquoted (lua_State *L, luaL_Buffer *b, int arg) { + size_t l; + const char *s = luaL_checklstring(L, arg, &l); + luaL_addchar(b, '"'); + while (l--) { + switch (*s) { + case '"': case '\\': case '\n': { + luaL_addchar(b, '\\'); + luaL_addchar(b, *s); + break; + } + case '\r': { + luaL_addlstring(b, "\\r", 2); + break; + } + case '\0': { + luaL_addlstring(b, "\\000", 4); + break; + } + default: { + luaL_addchar(b, *s); + break; + } + } + s++; + } + luaL_addchar(b, '"'); +} + +static const char *scanformat (lua_State *L, const char *strfrmt, char *form) { + const char *p = strfrmt; + while (*p != '\0' && strchr(FLAGS, *p) != NULL) p++; /* skip flags */ + if ((size_t)(p - strfrmt) >= sizeof(FLAGS)) + luaL_error(L, "invalid format (repeated flags)"); + if (isdigit(uchar(*p))) p++; /* skip width */ + if (isdigit(uchar(*p))) p++; /* (2 digits at most) */ + if (*p == '.') { + p++; + if (isdigit(uchar(*p))) p++; /* skip precision */ + if (isdigit(uchar(*p))) p++; /* (2 digits at most) */ + } + if (isdigit(uchar(*p))) + luaL_error(L, "invalid format (width or precision too long)"); + *(form++) = '%'; + strncpy(form, strfrmt, p - strfrmt + 1); + form += p - strfrmt + 1; + *form = '\0'; + return p; +} + + +static void addintlen (char *form) { + size_t l = strlen(form); + char spec = form[l - 1]; + strcpy(form + l - 1, LUA_INTFRMLEN); + form[l + sizeof(LUA_INTFRMLEN) - 2] = spec; + form[l + sizeof(LUA_INTFRMLEN) - 1] = '\0'; +} + + +static int str_format (lua_State *L) { + int arg = 1; + size_t sfl; + const char *strfrmt = luaL_checklstring(L, arg, &sfl); + const char *strfrmt_end = strfrmt+sfl; + luaL_Buffer b; + luaL_buffinit(L, &b); + while (strfrmt < strfrmt_end) { + if (*strfrmt != L_ESC) + luaL_addchar(&b, *strfrmt++); + else if (*++strfrmt == L_ESC) + luaL_addchar(&b, *strfrmt++); /* %% */ + else { /* format item */ + char form[MAX_FORMAT]; /* to store the format (`%...') */ + char buff[MAX_ITEM]; /* to store the formatted item */ + arg++; + strfrmt = scanformat(L, strfrmt, form); + switch (*strfrmt++) { + case 'c': { + sprintf(buff, form, (int)luaL_checknumber(L, arg)); + break; + } + case 'd': case 'i': { + addintlen(form); + sprintf(buff, form, (LUA_INTFRM_T)luaL_checknumber(L, arg)); + break; + } + case 'o': case 'u': case 'x': case 'X': { + addintlen(form); + sprintf(buff, form, (unsigned LUA_INTFRM_T)luaL_checknumber(L, arg)); + break; + } + case 'e': case 'E': case 'f': + case 'g': case 'G': { + sprintf(buff, form, (double)luaL_checknumber(L, arg)); + break; + } + case 'q': { + addquoted(L, &b, arg); + continue; /* skip the 'addsize' at the end */ + } + case 's': { + size_t l; + const char *s = luaL_checklstring(L, arg, &l); + if (!strchr(form, '.') && l >= 100) { + /* no precision and string is too long to be formatted; + keep original string */ + lua_pushvalue(L, arg); + luaL_addvalue(&b); + continue; /* skip the `addsize' at the end */ + } + else { + sprintf(buff, form, s); + break; + } + } + default: { /* also treat cases `pnLlh' */ + return luaL_error(L, "invalid option " LUA_QL("%%%c") " to " + LUA_QL("format"), *(strfrmt - 1)); + } + } + luaL_addlstring(&b, buff, strlen(buff)); + } + } + luaL_pushresult(&b); + return 1; +} + + +static const luaL_Reg strlib[] = { + {"byte", str_byte}, + {"char", str_char}, + {"dump", str_dump}, + {"find", str_find}, + {"format", str_format}, + {"gfind", gfind_nodef}, + {"gmatch", gmatch}, + {"gsub", str_gsub}, + {"len", str_len}, + {"lower", str_lower}, + {"match", str_match}, + {"rep", str_rep}, + {"reverse", str_reverse}, + {"sub", str_sub}, + {"upper", str_upper}, + {NULL, NULL} +}; + + +static void createmetatable (lua_State *L) { + lua_createtable(L, 0, 1); /* create metatable for strings */ + lua_pushliteral(L, ""); /* dummy string */ + lua_pushvalue(L, -2); + lua_setmetatable(L, -2); /* set string metatable */ + lua_pop(L, 1); /* pop dummy string */ + lua_pushvalue(L, -2); /* string library... */ + lua_setfield(L, -2, "__index"); /* ...is the __index metamethod */ + lua_pop(L, 1); /* pop metatable */ +} + + +/* +** Open string library +*/ +LUALIB_API int luaopen_string (lua_State *L) { + luaL_register(L, LUA_STRLIBNAME, strlib); +#if defined(LUA_COMPAT_GFIND) + lua_getfield(L, -1, "gmatch"); + lua_setfield(L, -2, "gfind"); +#endif + createmetatable(L); + return 1; +} + diff --git a/src/lua-vm/ltable.c b/src/lua-vm/ltable.c new file mode 100644 index 0000000..bc91cac --- /dev/null +++ b/src/lua-vm/ltable.c @@ -0,0 +1,588 @@ +/* +** $Id: ltable.c,v 2.32 2006/01/18 11:49:02 roberto Exp $ +** Lua tables (hash) +** See Copyright Notice in lua.h +*/ + + +/* +** Implementation of tables (aka arrays, objects, or hash tables). +** Tables keep its elements in two parts: an array part and a hash part. +** Non-negative integer keys are all candidates to be kept in the array +** part. The actual size of the array is the largest `n' such that at +** least half the slots between 0 and n are in use. +** Hash uses a mix of chained scatter table with Brent's variation. +** A main invariant of these tables is that, if an element is not +** in its main position (i.e. the `original' position that its hash gives +** to it), then the colliding element is in its own main position. +** Hence even when the load factor reaches 100%, performance remains good. +*/ + +#include +#include + +#define ltable_c +#define LUA_CORE + +#include "lua.h" + +#include "ldebug.h" +#include "ldo.h" +#include "lgc.h" +#include "lmem.h" +#include "lobject.h" +#include "lstate.h" +#include "ltable.h" + + +/* +** max size of array part is 2^MAXBITS +*/ +#if LUAI_BITSINT > 26 +#define MAXBITS 26 +#else +#define MAXBITS (LUAI_BITSINT-2) +#endif + +#define MAXASIZE (1 << MAXBITS) + + +#define hashpow2(t,n) (gnode(t, lmod((n), sizenode(t)))) + +#define hashstr(t,str) hashpow2(t, (str)->tsv.hash) +#define hashboolean(t,p) hashpow2(t, p) + + +/* +** for some types, it is better to avoid modulus by power of 2, as +** they tend to have many 2 factors. +*/ +#define hashmod(t,n) (gnode(t, ((n) % ((sizenode(t)-1)|1)))) + + +#define hashpointer(t,p) hashmod(t, IntPoint(p)) + + +/* +** number of ints inside a lua_Number +*/ +#define numints cast_int(sizeof(lua_Number)/sizeof(int)) + + + +#define dummynode (&dummynode_) + +static const Node dummynode_ = { + {{NULL}, LUA_TNIL}, /* value */ + {{{NULL}, LUA_TNIL, NULL}} /* key */ +}; + + +/* +** hash for lua_Numbers +*/ +static Node *hashnum (const Table *t, lua_Number n) { + unsigned int a[numints]; + int i; + n += 1; /* normalize number (avoid -0) */ + lua_assert(sizeof(a) <= sizeof(n)); + memcpy(a, &n, sizeof(a)); + for (i = 1; i < numints; i++) a[0] += a[i]; + return hashmod(t, a[0]); +} + + + +/* +** returns the `main' position of an element in a table (that is, the index +** of its hash value) +*/ +static Node *mainposition (const Table *t, const TValue *key) { + switch (ttype(key)) { + case LUA_TNUMBER: + return hashnum(t, nvalue(key)); + case LUA_TSTRING: + return hashstr(t, rawtsvalue(key)); + case LUA_TBOOLEAN: + return hashboolean(t, bvalue(key)); + case LUA_TLIGHTUSERDATA: + return hashpointer(t, pvalue(key)); + default: + return hashpointer(t, gcvalue(key)); + } +} + + +/* +** returns the index for `key' if `key' is an appropriate key to live in +** the array part of the table, -1 otherwise. +*/ +static int arrayindex (const TValue *key) { + if (ttisnumber(key)) { + lua_Number n = nvalue(key); + int k; + lua_number2int(k, n); + if (luai_numeq(cast_num(k), n)) + return k; + } + return -1; /* `key' did not match some condition */ +} + + +/* +** returns the index of a `key' for table traversals. First goes all +** elements in the array part, then elements in the hash part. The +** beginning of a traversal is signalled by -1. +*/ +static int findindex (lua_State *L, Table *t, StkId key) { + int i; + if (ttisnil(key)) return -1; /* first iteration */ + i = arrayindex(key); + if (0 < i && i <= t->sizearray) /* is `key' inside array part? */ + return i-1; /* yes; that's the index (corrected to C) */ + else { + Node *n = mainposition(t, key); + do { /* check whether `key' is somewhere in the chain */ + /* key may be dead already, but it is ok to use it in `next' */ + if (luaO_rawequalObj(key2tval(n), key) || + (ttype(gkey(n)) == LUA_TDEADKEY && iscollectable(key) && + gcvalue(gkey(n)) == gcvalue(key))) { + i = cast_int(n - gnode(t, 0)); /* key index in hash table */ + /* hash elements are numbered after array ones */ + return i + t->sizearray; + } + else n = gnext(n); + } while (n); + luaG_runerror(L, "invalid key to " LUA_QL("next")); /* key not found */ + return 0; /* to avoid warnings */ + } +} + + +int luaH_next (lua_State *L, Table *t, StkId key) { + int i = findindex(L, t, key); /* find original element */ + for (i++; i < t->sizearray; i++) { /* try first array part */ + if (!ttisnil(&t->array[i])) { /* a non-nil value? */ + setnvalue(key, cast_num(i+1)); + setobj2s(L, key+1, &t->array[i]); + return 1; + } + } + for (i -= t->sizearray; i < sizenode(t); i++) { /* then hash part */ + if (!ttisnil(gval(gnode(t, i)))) { /* a non-nil value? */ + setobj2s(L, key, key2tval(gnode(t, i))); + setobj2s(L, key+1, gval(gnode(t, i))); + return 1; + } + } + return 0; /* no more elements */ +} + + +/* +** {============================================================= +** Rehash +** ============================================================== +*/ + + +static int computesizes (int nums[], int *narray) { + int i; + int twotoi; /* 2^i */ + int a = 0; /* number of elements smaller than 2^i */ + int na = 0; /* number of elements to go to array part */ + int n = 0; /* optimal size for array part */ + for (i = 0, twotoi = 1; twotoi/2 < *narray; i++, twotoi *= 2) { + if (nums[i] > 0) { + a += nums[i]; + if (a > twotoi/2) { /* more than half elements present? */ + n = twotoi; /* optimal size (till now) */ + na = a; /* all elements smaller than n will go to array part */ + } + } + if (a == *narray) break; /* all elements already counted */ + } + *narray = n; + lua_assert(*narray/2 <= na && na <= *narray); + return na; +} + + +static int countint (const TValue *key, int *nums) { + int k = arrayindex(key); + if (0 < k && k <= MAXASIZE) { /* is `key' an appropriate array index? */ + nums[ceillog2(k)]++; /* count as such */ + return 1; + } + else + return 0; +} + + +static int numusearray (const Table *t, int *nums) { + int lg; + int ttlg; /* 2^lg */ + int ause = 0; /* summation of `nums' */ + int i = 1; /* count to traverse all array keys */ + for (lg=0, ttlg=1; lg<=MAXBITS; lg++, ttlg*=2) { /* for each slice */ + int lc = 0; /* counter */ + int lim = ttlg; + if (lim > t->sizearray) { + lim = t->sizearray; /* adjust upper limit */ + if (i > lim) + break; /* no more elements to count */ + } + /* count elements in range (2^(lg-1), 2^lg] */ + for (; i <= lim; i++) { + if (!ttisnil(&t->array[i-1])) + lc++; + } + nums[lg] += lc; + ause += lc; + } + return ause; +} + + +static int numusehash (const Table *t, int *nums, int *pnasize) { + int totaluse = 0; /* total number of elements */ + int ause = 0; /* summation of `nums' */ + int i = sizenode(t); + while (i--) { + Node *n = &t->node[i]; + if (!ttisnil(gval(n))) { + ause += countint(key2tval(n), nums); + totaluse++; + } + } + *pnasize += ause; + return totaluse; +} + + +static void setarrayvector (lua_State *L, Table *t, int size) { + int i; + luaM_reallocvector(L, t->array, t->sizearray, size, TValue); + for (i=t->sizearray; iarray[i]); + t->sizearray = size; +} + + +static void setnodevector (lua_State *L, Table *t, int size) { + int lsize; + if (size == 0) { /* no elements to hash part? */ + t->node = cast(Node *, dummynode); /* use common `dummynode' */ + lsize = 0; + } + else { + int i; + lsize = ceillog2(size); + if (lsize > MAXBITS) + luaG_runerror(L, "table overflow"); + size = twoto(lsize); + t->node = luaM_newvector(L, size, Node); + for (i=0; ilsizenode = cast_byte(lsize); + t->lastfree = gnode(t, size); /* all positions are free */ +} + + +static void resize (lua_State *L, Table *t, int nasize, int nhsize) { + int i; + int oldasize = t->sizearray; + int oldhsize = t->lsizenode; + Node *nold = t->node; /* save old hash ... */ + if (nasize > oldasize) /* array part must grow? */ + setarrayvector(L, t, nasize); + /* create new hash part with appropriate size */ + setnodevector(L, t, nhsize); + if (nasize < oldasize) { /* array part must shrink? */ + t->sizearray = nasize; + /* re-insert elements from vanishing slice */ + for (i=nasize; iarray[i])) + setobjt2t(L, luaH_setnum(L, t, i+1), &t->array[i]); + } + /* shrink array */ + luaM_reallocvector(L, t->array, oldasize, nasize, TValue); + } + /* re-insert elements from hash part */ + for (i = twoto(oldhsize) - 1; i >= 0; i--) { + Node *old = nold+i; + if (!ttisnil(gval(old))) + setobjt2t(L, luaH_set(L, t, key2tval(old)), gval(old)); + } + if (nold != dummynode) + luaM_freearray(L, nold, twoto(oldhsize), Node); /* free old array */ +} + + +void luaH_resizearray (lua_State *L, Table *t, int nasize) { + int nsize = (t->node == dummynode) ? 0 : sizenode(t); + resize(L, t, nasize, nsize); +} + + +static void rehash (lua_State *L, Table *t, const TValue *ek) { + int nasize, na; + int nums[MAXBITS+1]; /* nums[i] = number of keys between 2^(i-1) and 2^i */ + int i; + int totaluse; + for (i=0; i<=MAXBITS; i++) nums[i] = 0; /* reset counts */ + nasize = numusearray(t, nums); /* count keys in array part */ + totaluse = nasize; /* all those keys are integer keys */ + totaluse += numusehash(t, nums, &nasize); /* count keys in hash part */ + /* count extra key */ + nasize += countint(ek, nums); + totaluse++; + /* compute new size for array part */ + na = computesizes(nums, &nasize); + /* resize the table to new computed sizes */ + resize(L, t, nasize, totaluse - na); +} + + + +/* +** }============================================================= +*/ + + +Table *luaH_new (lua_State *L, int narray, int nhash) { + Table *t = luaM_new(L, Table); + luaC_link(L, obj2gco(t), LUA_TTABLE); + t->metatable = NULL; + t->flags = cast_byte(~0); + /* temporary values (kept only if some malloc fails) */ + t->array = NULL; + t->sizearray = 0; + t->lsizenode = 0; + t->node = cast(Node *, dummynode); + setarrayvector(L, t, narray); + setnodevector(L, t, nhash); + return t; +} + + +void luaH_free (lua_State *L, Table *t) { + if (t->node != dummynode) + luaM_freearray(L, t->node, sizenode(t), Node); + luaM_freearray(L, t->array, t->sizearray, TValue); + luaM_free(L, t); +} + + +static Node *getfreepos (Table *t) { + while (t->lastfree-- > t->node) { + if (ttisnil(gkey(t->lastfree))) + return t->lastfree; + } + return NULL; /* could not find a free place */ +} + + + +/* +** inserts a new key into a hash table; first, check whether key's main +** position is free. If not, check whether colliding node is in its main +** position or not: if it is not, move colliding node to an empty place and +** put new key in its main position; otherwise (colliding node is in its main +** position), new key goes to an empty position. +*/ +static TValue *newkey (lua_State *L, Table *t, const TValue *key) { + Node *mp = mainposition(t, key); + if (!ttisnil(gval(mp)) || mp == dummynode) { + Node *othern; + Node *n = getfreepos(t); /* get a free place */ + if (n == NULL) { /* cannot find a free place? */ + rehash(L, t, key); /* grow table */ + return luaH_set(L, t, key); /* re-insert key into grown table */ + } + lua_assert(n != dummynode); + othern = mainposition(t, key2tval(mp)); + if (othern != mp) { /* is colliding node out of its main position? */ + /* yes; move colliding node into free position */ + while (gnext(othern) != mp) othern = gnext(othern); /* find previous */ + gnext(othern) = n; /* redo the chain with `n' in place of `mp' */ + *n = *mp; /* copy colliding node into free pos. (mp->next also goes) */ + gnext(mp) = NULL; /* now `mp' is free */ + setnilvalue(gval(mp)); + } + else { /* colliding node is in its own main position */ + /* new node will go into free position */ + gnext(n) = gnext(mp); /* chain new position */ + gnext(mp) = n; + mp = n; + } + } + gkey(mp)->value = key->value; gkey(mp)->tt = key->tt; + luaC_barriert(L, t, key); + lua_assert(ttisnil(gval(mp))); + return gval(mp); +} + + +/* +** search function for integers +*/ +const TValue *luaH_getnum (Table *t, int key) { + /* (1 <= key && key <= t->sizearray) */ + if (cast(unsigned int, key-1) < cast(unsigned int, t->sizearray)) + return &t->array[key-1]; + else { + lua_Number nk = cast_num(key); + Node *n = hashnum(t, nk); + do { /* check whether `key' is somewhere in the chain */ + if (ttisnumber(gkey(n)) && luai_numeq(nvalue(gkey(n)), nk)) + return gval(n); /* that's it */ + else n = gnext(n); + } while (n); + return luaO_nilobject; + } +} + + +/* +** search function for strings +*/ +const TValue *luaH_getstr (Table *t, TString *key) { + Node *n = hashstr(t, key); + do { /* check whether `key' is somewhere in the chain */ + if (ttisstring(gkey(n)) && rawtsvalue(gkey(n)) == key) + return gval(n); /* that's it */ + else n = gnext(n); + } while (n); + return luaO_nilobject; +} + + +/* +** main search function +*/ +const TValue *luaH_get (Table *t, const TValue *key) { + switch (ttype(key)) { + case LUA_TNIL: return luaO_nilobject; + case LUA_TSTRING: return luaH_getstr(t, rawtsvalue(key)); + case LUA_TNUMBER: { + int k; + lua_Number n = nvalue(key); + lua_number2int(k, n); + if (luai_numeq(cast_num(k), nvalue(key))) /* index is int? */ + return luaH_getnum(t, k); /* use specialized version */ + /* else go through */ + } + default: { + Node *n = mainposition(t, key); + do { /* check whether `key' is somewhere in the chain */ + if (luaO_rawequalObj(key2tval(n), key)) + return gval(n); /* that's it */ + else n = gnext(n); + } while (n); + return luaO_nilobject; + } + } +} + + +TValue *luaH_set (lua_State *L, Table *t, const TValue *key) { + const TValue *p = luaH_get(t, key); + t->flags = 0; + if (p != luaO_nilobject) + return cast(TValue *, p); + else { + if (ttisnil(key)) luaG_runerror(L, "table index is nil"); + else if (ttisnumber(key) && luai_numisnan(nvalue(key))) + luaG_runerror(L, "table index is NaN"); + return newkey(L, t, key); + } +} + + +TValue *luaH_setnum (lua_State *L, Table *t, int key) { + const TValue *p = luaH_getnum(t, key); + if (p != luaO_nilobject) + return cast(TValue *, p); + else { + TValue k; + setnvalue(&k, cast_num(key)); + return newkey(L, t, &k); + } +} + + +TValue *luaH_setstr (lua_State *L, Table *t, TString *key) { + const TValue *p = luaH_getstr(t, key); + if (p != luaO_nilobject) + return cast(TValue *, p); + else { + TValue k; + setsvalue(L, &k, key); + return newkey(L, t, &k); + } +} + + +static int unbound_search (Table *t, unsigned int j) { + unsigned int i = j; /* i is zero or a present index */ + j++; + /* find `i' and `j' such that i is present and j is not */ + while (!ttisnil(luaH_getnum(t, j))) { + i = j; + j *= 2; + if (j > cast(unsigned int, MAX_INT)) { /* overflow? */ + /* table was built with bad purposes: resort to linear search */ + i = 1; + while (!ttisnil(luaH_getnum(t, i))) i++; + return i - 1; + } + } + /* now do a binary search between them */ + while (j - i > 1) { + unsigned int m = (i+j)/2; + if (ttisnil(luaH_getnum(t, m))) j = m; + else i = m; + } + return i; +} + + +/* +** Try to find a boundary in table `t'. A `boundary' is an integer index +** such that t[i] is non-nil and t[i+1] is nil (and 0 if t[1] is nil). +*/ +int luaH_getn (Table *t) { + unsigned int j = t->sizearray; + if (j > 0 && ttisnil(&t->array[j - 1])) { + /* there is a boundary in the array part: (binary) search for it */ + unsigned int i = 0; + while (j - i > 1) { + unsigned int m = (i+j)/2; + if (ttisnil(&t->array[m - 1])) j = m; + else i = m; + } + return i; + } + /* else must find a boundary in hash part */ + else if (t->node == dummynode) /* hash part is empty? */ + return j; /* that is easy... */ + else return unbound_search(t, j); +} + + + +#if defined(LUA_DEBUG) + +Node *luaH_mainposition (const Table *t, const TValue *key) { + return mainposition(t, key); +} + +int luaH_isdummy (Node *n) { return n == dummynode; } + +#endif diff --git a/src/lua-vm/ltable.h b/src/lua-vm/ltable.h new file mode 100644 index 0000000..09193cd --- /dev/null +++ b/src/lua-vm/ltable.h @@ -0,0 +1,40 @@ +/* +** $Id: ltable.h,v 2.10 2006/01/10 13:13:06 roberto Exp $ +** Lua tables (hash) +** See Copyright Notice in lua.h +*/ + +#ifndef ltable_h +#define ltable_h + +#include "lobject.h" + + +#define gnode(t,i) (&(t)->node[i]) +#define gkey(n) (&(n)->i_key.nk) +#define gval(n) (&(n)->i_val) +#define gnext(n) ((n)->i_key.nk.next) + +#define key2tval(n) (&(n)->i_key.tvk) + + +LUAI_FUNC const TValue *luaH_getnum (Table *t, int key); +LUAI_FUNC TValue *luaH_setnum (lua_State *L, Table *t, int key); +LUAI_FUNC const TValue *luaH_getstr (Table *t, TString *key); +LUAI_FUNC TValue *luaH_setstr (lua_State *L, Table *t, TString *key); +LUAI_FUNC const TValue *luaH_get (Table *t, const TValue *key); +LUAI_FUNC TValue *luaH_set (lua_State *L, Table *t, const TValue *key); +LUAI_FUNC Table *luaH_new (lua_State *L, int narray, int lnhash); +LUAI_FUNC void luaH_resizearray (lua_State *L, Table *t, int nasize); +LUAI_FUNC void luaH_free (lua_State *L, Table *t); +LUAI_FUNC int luaH_next (lua_State *L, Table *t, StkId key); +LUAI_FUNC int luaH_getn (Table *t); + + +#if defined(LUA_DEBUG) +LUAI_FUNC Node *luaH_mainposition (const Table *t, const TValue *key); +LUAI_FUNC int luaH_isdummy (Node *n); +#endif + + +#endif diff --git a/src/lua-vm/ltablib.c b/src/lua-vm/ltablib.c new file mode 100644 index 0000000..453b23b --- /dev/null +++ b/src/lua-vm/ltablib.c @@ -0,0 +1,278 @@ +/* +** $Id: ltablib.c,v 1.38 2005/10/23 17:38:15 roberto Exp $ +** Library for Table Manipulation +** See Copyright Notice in lua.h +*/ + + +#include + +#define ltablib_c +#define LUA_LIB + +#include "lua.h" + +#include "lauxlib.h" +#include "lualib.h" + + +#define aux_getn(L,n) (luaL_checktype(L, n, LUA_TTABLE), luaL_getn(L, n)) + + +static int foreachi (lua_State *L) { + int i; + int n = aux_getn(L, 1); + luaL_checktype(L, 2, LUA_TFUNCTION); + for (i=1; i <= n; i++) { + lua_pushvalue(L, 2); /* function */ + lua_pushinteger(L, i); /* 1st argument */ + lua_rawgeti(L, 1, i); /* 2nd argument */ + lua_call(L, 2, 1); + if (!lua_isnil(L, -1)) + return 1; + lua_pop(L, 1); /* remove nil result */ + } + return 0; +} + + +static int foreach (lua_State *L) { + luaL_checktype(L, 1, LUA_TTABLE); + luaL_checktype(L, 2, LUA_TFUNCTION); + lua_pushnil(L); /* first key */ + while (lua_next(L, 1)) { + lua_pushvalue(L, 2); /* function */ + lua_pushvalue(L, -3); /* key */ + lua_pushvalue(L, -3); /* value */ + lua_call(L, 2, 1); + if (!lua_isnil(L, -1)) + return 1; + lua_pop(L, 2); /* remove value and result */ + } + return 0; +} + + +static int maxn (lua_State *L) { + lua_Number max = 0; + luaL_checktype(L, 1, LUA_TTABLE); + lua_pushnil(L); /* first key */ + while (lua_next(L, 1)) { + lua_pop(L, 1); /* remove value */ + if (lua_type(L, -1) == LUA_TNUMBER) { + lua_Number v = lua_tonumber(L, -1); + if (v > max) max = v; + } + } + lua_pushnumber(L, max); + return 1; +} + + +static int getn (lua_State *L) { + lua_pushinteger(L, aux_getn(L, 1)); + return 1; +} + + +static int setn (lua_State *L) { + luaL_checktype(L, 1, LUA_TTABLE); +#ifndef luaL_setn + luaL_setn(L, 1, luaL_checkint(L, 2)); +#else + luaL_error(L, LUA_QL("setn") " is obsolete"); +#endif + lua_pushvalue(L, 1); + return 1; +} + + +static int tinsert (lua_State *L) { + int e = aux_getn(L, 1) + 1; /* first empty element */ + int pos; /* where to insert new element */ + switch (lua_gettop(L)) { + case 2: { /* called with only 2 arguments */ + pos = e; /* insert new element at the end */ + break; + } + case 3: { + int i; + pos = luaL_checkint(L, 2); /* 2nd argument is the position */ + if (pos > e) e = pos; /* `grow' array if necessary */ + for (i = e; i > pos; i--) { /* move up elements */ + lua_rawgeti(L, 1, i-1); + lua_rawseti(L, 1, i); /* t[i] = t[i-1] */ + } + break; + } + default: { + return luaL_error(L, "wrong number of arguments to " LUA_QL("insert")); + } + } + luaL_setn(L, 1, e); /* new size */ + lua_rawseti(L, 1, pos); /* t[pos] = v */ + return 0; +} + + +static int tremove (lua_State *L) { + int e = aux_getn(L, 1); + int pos = luaL_optint(L, 2, e); + if (e == 0) return 0; /* table is `empty' */ + luaL_setn(L, 1, e - 1); /* t.n = n-1 */ + lua_rawgeti(L, 1, pos); /* result = t[pos] */ + for ( ;pos= P */ + while (lua_rawgeti(L, 1, ++i), sort_comp(L, -1, -2)) { + if (i>u) luaL_error(L, "invalid order function for sorting"); + lua_pop(L, 1); /* remove a[i] */ + } + /* repeat --j until a[j] <= P */ + while (lua_rawgeti(L, 1, --j), sort_comp(L, -3, -1)) { + if (j + +#define ltm_c +#define LUA_CORE + +#include "lua.h" + +#include "lobject.h" +#include "lstate.h" +#include "lstring.h" +#include "ltable.h" +#include "ltm.h" + + + +const char *const luaT_typenames[] = { + "nil", "boolean", "userdata", "number", + "string", "table", "function", "userdata", "thread", + "proto", "upval" +}; + + +void luaT_init (lua_State *L) { + static const char *const luaT_eventname[] = { /* ORDER TM */ + "__index", "__newindex", + "__gc", "__mode", "__eq", + "__add", "__sub", "__mul", "__div", "__mod", + "__pow", "__unm", "__len", "__lt", "__le", + "__concat", "__call" + }; + int i; + for (i=0; itmname[i] = luaS_new(L, luaT_eventname[i]); + luaS_fix(G(L)->tmname[i]); /* never collect these names */ + } +} + + +/* +** function to be used with macro "fasttm": optimized for absence of +** tag methods +*/ +const TValue *luaT_gettm (Table *events, TMS event, TString *ename) { + const TValue *tm = luaH_getstr(events, ename); + lua_assert(event <= TM_EQ); + if (ttisnil(tm)) { /* no tag method? */ + events->flags |= cast_byte(1u<metatable; + break; + case LUA_TUSERDATA: + mt = uvalue(o)->metatable; + break; + default: + mt = G(L)->mt[ttype(o)]; + } + return (mt ? luaH_getstr(mt, G(L)->tmname[event]) : luaO_nilobject); +} + diff --git a/src/lua-vm/ltm.h b/src/lua-vm/ltm.h new file mode 100644 index 0000000..866c796 --- /dev/null +++ b/src/lua-vm/ltm.h @@ -0,0 +1,54 @@ +/* +** $Id: ltm.h,v 2.6 2005/06/06 13:30:25 roberto Exp $ +** Tag methods +** See Copyright Notice in lua.h +*/ + +#ifndef ltm_h +#define ltm_h + + +#include "lobject.h" + + +/* +* WARNING: if you change the order of this enumeration, +* grep "ORDER TM" +*/ +typedef enum { + TM_INDEX, + TM_NEWINDEX, + TM_GC, + TM_MODE, + TM_EQ, /* last tag method with `fast' access */ + TM_ADD, + TM_SUB, + TM_MUL, + TM_DIV, + TM_MOD, + TM_POW, + TM_UNM, + TM_LEN, + TM_LT, + TM_LE, + TM_CONCAT, + TM_CALL, + TM_N /* number of elements in the enum */ +} TMS; + + + +#define gfasttm(g,et,e) ((et) == NULL ? NULL : \ + ((et)->flags & (1u<<(e))) ? NULL : luaT_gettm(et, e, (g)->tmname[e])) + +#define fasttm(l,et,e) gfasttm(G(l), et, e) + +LUAI_DATA const char *const luaT_typenames[]; + + +LUAI_FUNC const TValue *luaT_gettm (Table *events, TMS event, TString *ename); +LUAI_FUNC const TValue *luaT_gettmbyobj (lua_State *L, const TValue *o, + TMS event); +LUAI_FUNC void luaT_init (lua_State *L); + +#endif diff --git a/src/lua-vm/lua.h b/src/lua-vm/lua.h new file mode 100644 index 0000000..8e196f0 --- /dev/null +++ b/src/lua-vm/lua.h @@ -0,0 +1,389 @@ +/* +** $Id: lua.h,v 1.218a 2006/06/02 15:34:00 roberto Exp $ +** Lua - An Extensible Extension Language +** Lua.org, PUC-Rio, Brazil (http://www.lua.org) +** See Copyright Notice at the end of this file +*/ + + +#ifndef lua_h +#define lua_h + +#include +#include + + +#include "luaconf.h" + + +#define LUA_VERSION "Metalua 0.4" +#define LUA_RELEASE "Metalua 0.4" +#define LUA_VERSION_NUM 501 /* Keep binary compatibility with Lua 5.1 */ +#define LUA_COPYRIGHT \ + "Metalua Copyright (C) 2006-2007 Fabien Fleutot \n" \ + "Bitlib Copyright (C) -2007 Reuben Thomas \n" \ + "Lua Copyright (C) 1994-2007 Lua.org, PUC-Rio" +#define LUA_AUTHORS "R. Ierusalimschy, L. H. de Figueiredo & W. Celes" + + +/* mark for precompiled code (`Lua') */ +#define LUA_SIGNATURE "\033Lua" + +/* option for multiple returns in `lua_pcall' and `lua_call' */ +#define LUA_MULTRET (-1) + + +/* +** pseudo-indices +*/ +#define LUA_REGISTRYINDEX (-10000) +#define LUA_ENVIRONINDEX (-10001) +#define LUA_GLOBALSINDEX (-10002) +#define lua_upvalueindex(i) (LUA_GLOBALSINDEX-(i)) + + +/* thread status; 0 is OK */ +#define LUA_YIELD 1 +#define LUA_ERRRUN 2 +#define LUA_ERRSYNTAX 3 +#define LUA_ERRMEM 4 +#define LUA_ERRERR 5 + + +typedef struct lua_State lua_State; + +typedef int (*lua_CFunction) (lua_State *L); + + +/* +** functions that read/write blocks when loading/dumping Lua chunks +*/ +typedef const char * (*lua_Reader) (lua_State *L, void *ud, size_t *sz); + +typedef int (*lua_Writer) (lua_State *L, const void* p, size_t sz, void* ud); + + +/* +** prototype for memory-allocation functions +*/ +typedef void * (*lua_Alloc) (void *ud, void *ptr, size_t osize, size_t nsize); + + +/* +** basic types +*/ +#define LUA_TNONE (-1) + +#define LUA_TNIL 0 +#define LUA_TBOOLEAN 1 +#define LUA_TLIGHTUSERDATA 2 +#define LUA_TNUMBER 3 +#define LUA_TSTRING 4 +#define LUA_TTABLE 5 +#define LUA_TFUNCTION 6 +#define LUA_TUSERDATA 7 +#define LUA_TTHREAD 8 + + + +/* minimum Lua stack available to a C function */ +#define LUA_MINSTACK 20 + + +/* +** generic extra include file +*/ +#if defined(LUA_USER_H) +#include LUA_USER_H +#endif + + +/* type of numbers in Lua */ +typedef LUA_NUMBER lua_Number; + + +/* type for integer functions */ +typedef LUA_INTEGER lua_Integer; + + + +/* +** state manipulation +*/ +LUA_API lua_State *(lua_newstate) (lua_Alloc f, void *ud); +LUA_API void (lua_close) (lua_State *L); +LUA_API lua_State *(lua_newthread) (lua_State *L); + +LUA_API lua_CFunction (lua_atpanic) (lua_State *L, lua_CFunction panicf); + + +/* +** basic stack manipulation +*/ +LUA_API int (lua_gettop) (lua_State *L); +LUA_API void (lua_settop) (lua_State *L, int idx); +LUA_API void (lua_pushvalue) (lua_State *L, int idx); +LUA_API void (lua_remove) (lua_State *L, int idx); +LUA_API void (lua_insert) (lua_State *L, int idx); +LUA_API void (lua_replace) (lua_State *L, int idx); +LUA_API int (lua_checkstack) (lua_State *L, int sz); + +LUA_API void (lua_xmove) (lua_State *from, lua_State *to, int n); + + +/* +** access functions (stack -> C) +*/ + +LUA_API int (lua_isnumber) (lua_State *L, int idx); +LUA_API int (lua_isstring) (lua_State *L, int idx); +LUA_API int (lua_iscfunction) (lua_State *L, int idx); +LUA_API int (lua_isuserdata) (lua_State *L, int idx); +LUA_API int (lua_type) (lua_State *L, int idx); +LUA_API const char *(lua_typename) (lua_State *L, int tp); + +LUA_API int (lua_equal) (lua_State *L, int idx1, int idx2); +LUA_API int (lua_rawequal) (lua_State *L, int idx1, int idx2); +LUA_API int (lua_lessthan) (lua_State *L, int idx1, int idx2); + +LUA_API lua_Number (lua_tonumber) (lua_State *L, int idx); +LUA_API lua_Integer (lua_tointeger) (lua_State *L, int idx); +LUA_API int (lua_toboolean) (lua_State *L, int idx); +LUA_API const char *(lua_tolstring) (lua_State *L, int idx, size_t *len); +LUA_API size_t (lua_objlen) (lua_State *L, int idx); +LUA_API lua_CFunction (lua_tocfunction) (lua_State *L, int idx); +LUA_API void *(lua_touserdata) (lua_State *L, int idx); +LUA_API lua_State *(lua_tothread) (lua_State *L, int idx); +LUA_API const void *(lua_topointer) (lua_State *L, int idx); + + +/* +** push functions (C -> stack) +*/ +LUA_API void (lua_pushnil) (lua_State *L); +LUA_API void (lua_pushnumber) (lua_State *L, lua_Number n); +LUA_API void (lua_pushinteger) (lua_State *L, lua_Integer n); +LUA_API void (lua_pushlstring) (lua_State *L, const char *s, size_t l); +LUA_API void (lua_pushstring) (lua_State *L, const char *s); +LUA_API const char *(lua_pushvfstring) (lua_State *L, const char *fmt, + va_list argp); +LUA_API const char *(lua_pushfstring) (lua_State *L, const char *fmt, ...); +LUA_API void (lua_pushcclosure) (lua_State *L, lua_CFunction fn, int n); +LUA_API void (lua_pushboolean) (lua_State *L, int b); +LUA_API void (lua_pushlightuserdata) (lua_State *L, void *p); +LUA_API int (lua_pushthread) (lua_State *L); + + +/* +** get functions (Lua -> stack) +*/ +LUA_API void (lua_gettable) (lua_State *L, int idx); +LUA_API void (lua_getfield) (lua_State *L, int idx, const char *k); +LUA_API void (lua_rawget) (lua_State *L, int idx); +LUA_API void (lua_rawgeti) (lua_State *L, int idx, int n); +LUA_API void (lua_createtable) (lua_State *L, int narr, int nrec); +LUA_API void *(lua_newuserdata) (lua_State *L, size_t sz); +LUA_API int (lua_getmetatable) (lua_State *L, int objindex); +LUA_API void (lua_getfenv) (lua_State *L, int idx); + + +/* +** set functions (stack -> Lua) +*/ +LUA_API void (lua_settable) (lua_State *L, int idx); +LUA_API void (lua_setfield) (lua_State *L, int idx, const char *k); +LUA_API void (lua_rawset) (lua_State *L, int idx); +LUA_API void (lua_rawseti) (lua_State *L, int idx, int n); +LUA_API int (lua_setmetatable) (lua_State *L, int objindex); +LUA_API int (lua_setfenv) (lua_State *L, int idx); + + +/* +** `load' and `call' functions (load and run Lua code) +*/ +LUA_API void (lua_call) (lua_State *L, int nargs, int nresults); +LUA_API int (lua_pcall) (lua_State *L, int nargs, int nresults, int errfunc); +LUA_API int (lua_cpcall) (lua_State *L, lua_CFunction func, void *ud); +LUA_API int (lua_load) (lua_State *L, lua_Reader reader, void *dt, + const char *chunkname); + +LUA_API int (lua_dump) (lua_State *L, lua_Writer writer, void *data); + + +/* +** coroutine functions +*/ +LUA_API int (lua_yield) (lua_State *L, int nresults); +LUA_API int (lua_resume) (lua_State *L, int narg); +LUA_API int (lua_status) (lua_State *L); + +/* +** garbage-collection function and options +*/ + +#define LUA_GCSTOP 0 +#define LUA_GCRESTART 1 +#define LUA_GCCOLLECT 2 +#define LUA_GCCOUNT 3 +#define LUA_GCCOUNTB 4 +#define LUA_GCSTEP 5 +#define LUA_GCSETPAUSE 6 +#define LUA_GCSETSTEPMUL 7 + +LUA_API int (lua_gc) (lua_State *L, int what, int data); + + +/* +** miscellaneous functions +*/ + +LUA_API int (lua_error) (lua_State *L); + +LUA_API int (lua_next) (lua_State *L, int idx); + +LUA_API void (lua_concat) (lua_State *L, int n); + +LUA_API lua_Alloc (lua_getallocf) (lua_State *L, void **ud); +LUA_API void lua_setallocf (lua_State *L, lua_Alloc f, void *ud); + + + +/* +** =============================================================== +** some useful macros +** =============================================================== +*/ + +#define lua_pop(L,n) lua_settop(L, -(n)-1) + +#define lua_newtable(L) lua_createtable(L, 0, 0) + +#define lua_register(L,n,f) (lua_pushcfunction(L, (f)), lua_setglobal(L, (n))) + +#define lua_pushcfunction(L,f) lua_pushcclosure(L, (f), 0) + +#define lua_strlen(L,i) lua_objlen(L, (i)) + +#define lua_isfunction(L,n) (lua_type(L, (n)) == LUA_TFUNCTION) +#define lua_istable(L,n) (lua_type(L, (n)) == LUA_TTABLE) +#define lua_islightuserdata(L,n) (lua_type(L, (n)) == LUA_TLIGHTUSERDATA) +#define lua_isnil(L,n) (lua_type(L, (n)) == LUA_TNIL) +#define lua_isboolean(L,n) (lua_type(L, (n)) == LUA_TBOOLEAN) +#define lua_isthread(L,n) (lua_type(L, (n)) == LUA_TTHREAD) +#define lua_isnone(L,n) (lua_type(L, (n)) == LUA_TNONE) +#define lua_isnoneornil(L, n) (lua_type(L, (n)) <= 0) + +#define lua_pushliteral(L, s) \ + lua_pushlstring(L, "" s, (sizeof(s)/sizeof(char))-1) + +#define lua_setglobal(L,s) lua_setfield(L, LUA_GLOBALSINDEX, (s)) +#define lua_getglobal(L,s) lua_getfield(L, LUA_GLOBALSINDEX, (s)) + +#define lua_tostring(L,i) lua_tolstring(L, (i), NULL) + + + +/* +** compatibility macros and functions +*/ + +#define lua_open() luaL_newstate() + +#define lua_getregistry(L) lua_pushvalue(L, LUA_REGISTRYINDEX) + +#define lua_getgccount(L) lua_gc(L, LUA_GCCOUNT, 0) + +#define lua_Chunkreader lua_Reader +#define lua_Chunkwriter lua_Writer + + + +/* +** {====================================================================== +** Debug API +** ======================================================================= +*/ + + +/* +** Event codes +*/ +#define LUA_HOOKCALL 0 +#define LUA_HOOKRET 1 +#define LUA_HOOKLINE 2 +#define LUA_HOOKCOUNT 3 +#define LUA_HOOKTAILRET 4 + + +/* +** Event masks +*/ +#define LUA_MASKCALL (1 << LUA_HOOKCALL) +#define LUA_MASKRET (1 << LUA_HOOKRET) +#define LUA_MASKLINE (1 << LUA_HOOKLINE) +#define LUA_MASKCOUNT (1 << LUA_HOOKCOUNT) + +typedef struct lua_Debug lua_Debug; /* activation record */ + + +/* Functions to be called by the debuger in specific events */ +typedef void (*lua_Hook) (lua_State *L, lua_Debug *ar); + + +LUA_API int lua_getstack (lua_State *L, int level, lua_Debug *ar); +LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar); +LUA_API const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n); +LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n); +LUA_API const char *lua_getupvalue (lua_State *L, int funcindex, int n); +LUA_API const char *lua_setupvalue (lua_State *L, int funcindex, int n); + +LUA_API int lua_sethook (lua_State *L, lua_Hook func, int mask, int count); +LUA_API lua_Hook lua_gethook (lua_State *L); +LUA_API int lua_gethookmask (lua_State *L); +LUA_API int lua_gethookcount (lua_State *L); + + +struct lua_Debug { + int event; + const char *name; /* (n) */ + const char *namewhat; /* (n) `global', `local', `field', `method' */ + const char *what; /* (S) `Lua', `C', `main', `tail' */ + const char *source; /* (S) */ + int currentline; /* (l) */ + int nups; /* (u) number of upvalues */ + int linedefined; /* (S) */ + int lastlinedefined; /* (S) */ + char short_src[LUA_IDSIZE]; /* (S) */ + /* private part */ + int i_ci; /* active function */ +}; + +/* }====================================================================== */ + + +/****************************************************************************** +* Copyright (C) 1994-2007 Lua.org, PUC-Rio. All rights reserved. +* +* Permission is hereby granted, free of charge, to any person obtaining +* a copy of this software and associated documentation files (the +* "Software"), to deal in the Software without restriction, including +* without limitation the rights to use, copy, modify, merge, publish, +* distribute, sublicense, and/or sell copies of the Software, and to +* permit persons to whom the Software is furnished to do so, subject to +* the following conditions: +* +* The above copyright notice and this permission notice shall be +* included in all copies or substantial portions of the Software. +* +* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +* IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +* CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +* TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +* SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +******************************************************************************/ + + +#endif diff --git a/src/lua-vm/luac.out b/src/lua-vm/luac.out new file mode 100644 index 0000000000000000000000000000000000000000..53faab78520e94dcb2259c9a41eded36c0b28ed8 GIT binary patch literal 261 zcmYLDK?;LF5R2=S_TUc+J@s6vFVMRn1wXI{@ls1E6+C+J7yVxUVY0F~kWDfJ*_`Xq zKaiN&2^oMg{|@hbx;;lv7st7j@=6?u3uYu_JMd|nwh4|pu$Dl|JfI?$68MvUG^IQwSW1c3zbw_qW~RLUL0oyf^`$Z literal 0 HcmV?d00001 diff --git a/src/lua-vm/luaconf.h b/src/lua-vm/luaconf.h new file mode 100644 index 0000000..0ff55ee --- /dev/null +++ b/src/lua-vm/luaconf.h @@ -0,0 +1,769 @@ +/* +** $Id: luaconf.h,v 1.82a 2006/04/10 18:27:23 roberto Exp $ +** Configuration file for Lua +** See Copyright Notice in lua.h +*/ + + +#ifndef lconfig_h +#define lconfig_h + +#include +#include + + +/* +** ================================================================== +** Search for "@@" to find all configurable definitions. +** =================================================================== +*/ + + +/* +@@ LUA_ANSI controls the use of non-ansi features. +** CHANGE it (define it) if you want Lua to avoid the use of any +** non-ansi feature or library. +*/ +#if defined(__STRICT_ANSI__) +#define LUA_ANSI +#endif + + +#if !defined(LUA_ANSI) && defined(_WIN32) +#define LUA_WIN +#endif + +#if defined(LUA_USE_LINUX) +#define LUA_USE_POSIX +#define LUA_USE_DLOPEN /* needs an extra library: -ldl */ +#define LUA_USE_READLINE /* needs some extra libraries */ +#endif + +#if defined(LUA_USE_MACOSX) +#define LUA_USE_POSIX +#define LUA_DL_DYLD /* does not need extra library */ +#endif + + + +/* +@@ LUA_USE_POSIX includes all functionallity listed as X/Open System +@* Interfaces Extension (XSI). +** CHANGE it (define it) if your system is XSI compatible. +*/ +#if defined(LUA_USE_POSIX) +#define LUA_USE_MKSTEMP +#define LUA_USE_ISATTY +#define LUA_USE_POPEN +#define LUA_USE_ULONGJMP +#endif + +#if 0 /* Metalua sets those variables in path_defaults.h, automatically generated. */ + +/* +@@ LUA_PATH and LUA_CPATH are the names of the environment variables that +@* Lua check to set its paths. +@@ LUA_INIT is the name of the environment variable that Lua +@* checks for initialization code. +** CHANGE them if you want different names. +*/ +#define LUA_PATH "LUA_PATH" +#define LUA_CPATH "LUA_CPATH" +#define LUA_INIT "LUA_INIT" + + +/* +@@ LUA_PATH_DEFAULT is the default path that Lua uses to look for +@* Lua libraries. +@@ LUA_CPATH_DEFAULT is the default path that Lua uses to look for +@* C libraries. +** CHANGE them if your machine has a non-conventional directory +** hierarchy or if you want to install your libraries in +** non-conventional directories. +*/ +#if defined(_WIN32) +/* +** In Windows, any exclamation mark ('!') in the path is replaced by the +** path of the directory of the executable file of the current process. +*/ +#define LUA_LDIR "!\\lua\\" +#define LUA_CDIR "!\\" +#define LUA_PATH_DEFAULT \ + ".\\?.lua;" LUA_LDIR"?.lua;" LUA_LDIR"?\\init.lua;" \ + LUA_CDIR"?.lua;" LUA_CDIR"?\\init.lua" +#define LUA_CPATH_DEFAULT \ + ".\\?.dll;" LUA_CDIR"?.dll;" LUA_CDIR"loadall.dll" + +#else +#define LUA_ROOT "/usr/local/" +#define LUA_LDIR LUA_ROOT "share/lua/5.1/" +#define LUA_CDIR LUA_ROOT "lib/lua/5.1/" +#define LUA_PATH_DEFAULT \ + "./?.lua;" LUA_LDIR"?.lua;" LUA_LDIR"?/init.lua;" \ + LUA_CDIR"?.lua;" LUA_CDIR"?/init.lua" +#define LUA_CPATH_DEFAULT \ + "./?.so;" LUA_CDIR"?.so;" LUA_CDIR"loadall.so" +#endif + +#else /* metalua */ + +#include "path_defaults.h" + +#endif /* metalua */ + + +/* +@@ LUA_DIRSEP is the directory separator (for submodules). +** CHANGE it if your machine does not use "/" as the directory separator +** and is not Windows. (On Windows Lua automatically uses "\".) +*/ +#if defined(_WIN32) +#define LUA_DIRSEP "\\" +#else +#define LUA_DIRSEP "/" +#endif + + +/* +@@ LUA_PATHSEP is the character that separates templates in a path. +@@ LUA_PATH_MARK is the string that marks the substitution points in a +@* template. +@@ LUA_EXECDIR in a Windows path is replaced by the executable's +@* directory. +@@ LUA_IGMARK is a mark to ignore all before it when bulding the +@* luaopen_ function name. +** CHANGE them if for some reason your system cannot use those +** characters. (E.g., if one of those characters is a common character +** in file/directory names.) Probably you do not need to change them. +*/ +#define LUA_PATHSEP ";" +#define LUA_PATH_MARK "?" +#define LUA_EXECDIR "!" +#define LUA_IGMARK "-" + + +/* +@@ LUA_INTEGER is the integral type used by lua_pushinteger/lua_tointeger. +** CHANGE that if ptrdiff_t is not adequate on your machine. (On most +** machines, ptrdiff_t gives a good choice between int or long.) +*/ +#define LUA_INTEGER ptrdiff_t + + +/* +@@ LUA_API is a mark for all core API functions. +@@ LUALIB_API is a mark for all standard library functions. +** CHANGE them if you need to define those functions in some special way. +** For instance, if you want to create one Windows DLL with the core and +** the libraries, you may want to use the following definition (define +** LUA_BUILD_AS_DLL to get it). +*/ +#if defined(LUA_BUILD_AS_DLL) + +#if defined(LUA_CORE) || defined(LUA_LIB) +#define LUA_API __declspec(dllexport) +#else +#define LUA_API __declspec(dllimport) +#endif + +#else + +#define LUA_API extern + +#endif + +/* more often than not the libs go together with the core */ +#define LUALIB_API LUA_API + + +/* +@@ LUAI_FUNC is a mark for all extern functions that are not to be +@* exported to outside modules. +@@ LUAI_DATA is a mark for all extern (const) variables that are not to +@* be exported to outside modules. +** CHANGE them if you need to mark them in some special way. Elf/gcc +** (versions 3.2 and later) mark them as "hidden" to optimize access +** when Lua is compiled as a shared library. +*/ +#if defined(luaall_c) +#define LUAI_FUNC static +#define LUAI_DATA /* empty */ + +#elif defined(__GNUC__) && ((__GNUC__*100 + __GNUC_MINOR__) >= 302) && \ + defined(__ELF__) +#define LUAI_FUNC __attribute__((visibility("hidden"))) extern +#define LUAI_DATA LUAI_FUNC + +#else +#define LUAI_FUNC extern +#define LUAI_DATA extern +#endif + + + +/* +@@ LUA_QL describes how error messages quote program elements. +** CHANGE it if you want a different appearance. +*/ +#define LUA_QL(x) "'" x "'" +#define LUA_QS LUA_QL("%s") + + +/* +@@ LUA_IDSIZE gives the maximum size for the description of the source +@* of a function in debug information. +** CHANGE it if you want a different size. +*/ +#define LUA_IDSIZE 60 + + +/* +** {================================================================== +** Stand-alone configuration +** =================================================================== +*/ + +#if defined(lua_c) || defined(luaall_c) + +/* +@@ lua_stdin_is_tty detects whether the standard input is a 'tty' (that +@* is, whether we're running lua interactively). +** CHANGE it if you have a better definition for non-POSIX/non-Windows +** systems. +*/ +#if defined(LUA_USE_ISATTY) +#include +#define lua_stdin_is_tty() isatty(0) +#elif defined(LUA_WIN) +#include +#include +#define lua_stdin_is_tty() _isatty(_fileno(stdin)) +#else +#define lua_stdin_is_tty() 1 /* assume stdin is a tty */ +#endif + + +/* +@@ LUA_PROMPT is the default prompt used by stand-alone Lua. +@@ LUA_PROMPT2 is the default continuation prompt used by stand-alone Lua. +** CHANGE them if you want different prompts. (You can also change the +** prompts dynamically, assigning to globals _PROMPT/_PROMPT2.) +*/ +#define LUA_PROMPT "> " +#define LUA_PROMPT2 ">> " + + +/* +@@ LUA_PROGNAME is the default name for the stand-alone Lua program. +** CHANGE it if your stand-alone interpreter has a different name and +** your system is not able to detect that name automatically. +*/ +#define LUA_PROGNAME "lua" + + +/* +@@ LUA_MAXINPUT is the maximum length for an input line in the +@* stand-alone interpreter. +** CHANGE it if you need longer lines. +*/ +#define LUA_MAXINPUT 512 + + +/* +@@ lua_readline defines how to show a prompt and then read a line from +@* the standard input. +@@ lua_saveline defines how to "save" a read line in a "history". +@@ lua_freeline defines how to free a line read by lua_readline. +** CHANGE them if you want to improve this functionality (e.g., by using +** GNU readline and history facilities). +*/ +#if defined(LUA_USE_READLINE) +#include +#include +#include +#define lua_readline(L,b,p) ((void)L, ((b)=readline(p)) != NULL) +#define lua_saveline(L,idx) \ + if (lua_strlen(L,idx) > 0) /* non-empty line? */ \ + add_history(lua_tostring(L, idx)); /* add it to history */ +#define lua_freeline(L,b) ((void)L, free(b)) +#else +#define lua_readline(L,b,p) \ + ((void)L, fputs(p, stdout), fflush(stdout), /* show prompt */ \ + fgets(b, LUA_MAXINPUT, stdin) != NULL) /* get line */ +#define lua_saveline(L,idx) { (void)L; (void)idx; } +#define lua_freeline(L,b) { (void)L; (void)b; } +#endif + +#endif + +/* }================================================================== */ + + +/* +@@ LUAI_GCPAUSE defines the default pause between garbage-collector cycles +@* as a percentage. +** CHANGE it if you want the GC to run faster or slower (higher values +** mean larger pauses which mean slower collection.) You can also change +** this value dynamically. +*/ +#define LUAI_GCPAUSE 200 /* 200% (wait memory to double before next GC) */ + + +/* +@@ LUAI_GCMUL defines the default speed of garbage collection relative to +@* memory allocation as a percentage. +** CHANGE it if you want to change the granularity of the garbage +** collection. (Higher values mean coarser collections. 0 represents +** infinity, where each step performs a full collection.) You can also +** change this value dynamically. +*/ +#define LUAI_GCMUL 200 /* GC runs 'twice the speed' of memory allocation */ + + + +/* +@@ LUA_COMPAT_GETN controls compatibility with old getn behavior. +** CHANGE it (define it) if you want exact compatibility with the +** behavior of setn/getn in Lua 5.0. +*/ +#undef LUA_COMPAT_GETN + +/* +@@ LUA_COMPAT_LOADLIB controls compatibility about global loadlib. +** CHANGE it to undefined as soon as you do not need a global 'loadlib' +** function (the function is still available as 'package.loadlib'). +*/ +#undef LUA_COMPAT_LOADLIB + +/* +@@ LUA_COMPAT_VARARG controls compatibility with old vararg feature. +** CHANGE it to undefined as soon as your programs use only '...' to +** access vararg parameters (instead of the old 'arg' table). +*/ +#define LUA_COMPAT_VARARG + +/* +@@ LUA_COMPAT_MOD controls compatibility with old math.mod function. +** CHANGE it to undefined as soon as your programs use 'math.fmod' or +** the new '%' operator instead of 'math.mod'. +*/ +#define LUA_COMPAT_MOD + +/* +@@ LUA_COMPAT_LSTR controls compatibility with old long string nesting +@* facility. +** CHANGE it to 2 if you want the old behaviour, or undefine it to turn +** off the advisory error when nesting [[...]]. +*/ +#define LUA_COMPAT_LSTR 1 + +/* +@@ LUA_COMPAT_GFIND controls compatibility with old 'string.gfind' name. +** CHANGE it to undefined as soon as you rename 'string.gfind' to +** 'string.gmatch'. +*/ +#define LUA_COMPAT_GFIND + +/* +@@ LUA_COMPAT_OPENLIB controls compatibility with old 'luaL_openlib' +@* behavior. +** CHANGE it to undefined as soon as you replace to 'luaL_register' +** your uses of 'luaL_openlib' +*/ +#define LUA_COMPAT_OPENLIB + + + +/* +@@ luai_apicheck is the assert macro used by the Lua-C API. +** CHANGE luai_apicheck if you want Lua to perform some checks in the +** parameters it gets from API calls. This may slow down the interpreter +** a bit, but may be quite useful when debugging C code that interfaces +** with Lua. A useful redefinition is to use assert.h. +*/ +#if defined(LUA_USE_APICHECK) +#include +#define luai_apicheck(L,o) { (void)L; assert(o); } +#else +#define luai_apicheck(L,o) { (void)L; } +#endif + + +/* +@@ LUAI_BITSINT defines the number of bits in an int. +** CHANGE here if Lua cannot automatically detect the number of bits of +** your machine. Probably you do not need to change this. +*/ +/* avoid overflows in comparison */ +#if INT_MAX-20 < 32760 +#define LUAI_BITSINT 16 +#elif INT_MAX > 2147483640L +/* int has at least 32 bits */ +#define LUAI_BITSINT 32 +#else +#error "you must define LUA_BITSINT with number of bits in an integer" +#endif + + +/* +@@ LUAI_UINT32 is an unsigned integer with at least 32 bits. +@@ LUAI_INT32 is an signed integer with at least 32 bits. +@@ LUAI_UMEM is an unsigned integer big enough to count the total +@* memory used by Lua. +@@ LUAI_MEM is a signed integer big enough to count the total memory +@* used by Lua. +** CHANGE here if for some weird reason the default definitions are not +** good enough for your machine. (The definitions in the 'else' +** part always works, but may waste space on machines with 64-bit +** longs.) Probably you do not need to change this. +*/ +#if LUAI_BITSINT >= 32 +#define LUAI_UINT32 unsigned int +#define LUAI_INT32 int +#define LUAI_MAXINT32 INT_MAX +#define LUAI_UMEM size_t +#define LUAI_MEM ptrdiff_t +#else +/* 16-bit ints */ +#define LUAI_UINT32 unsigned long +#define LUAI_INT32 long +#define LUAI_MAXINT32 LONG_MAX +#define LUAI_UMEM unsigned long +#define LUAI_MEM long +#endif + + +/* +@@ LUAI_MAXCALLS limits the number of nested calls. +** CHANGE it if you need really deep recursive calls. This limit is +** arbitrary; its only purpose is to stop infinite recursion before +** exhausting memory. +*/ +#define LUAI_MAXCALLS 20000 + + +/* +@@ LUAI_MAXCSTACK limits the number of Lua stack slots that a C function +@* can use. +** CHANGE it if you need lots of (Lua) stack space for your C +** functions. This limit is arbitrary; its only purpose is to stop C +** functions to consume unlimited stack space. +*/ +#define LUAI_MAXCSTACK 2048 + + + +/* +** {================================================================== +** CHANGE (to smaller values) the following definitions if your system +** has a small C stack. (Or you may want to change them to larger +** values if your system has a large C stack and these limits are +** too rigid for you.) Some of these constants control the size of +** stack-allocated arrays used by the compiler or the interpreter, while +** others limit the maximum number of recursive calls that the compiler +** or the interpreter can perform. Values too large may cause a C stack +** overflow for some forms of deep constructs. +** =================================================================== +*/ + + +/* +@@ LUAI_MAXCCALLS is the maximum depth for nested C calls (short) and +@* syntactical nested non-terminals in a program. +*/ +#define LUAI_MAXCCALLS 200 + + +/* +@@ LUAI_MAXVARS is the maximum number of local variables per function +@* (must be smaller than 250). +*/ +#define LUAI_MAXVARS 200 + + +/* +@@ LUAI_MAXUPVALUES is the maximum number of upvalues per function +@* (must be smaller than 250). +*/ +#define LUAI_MAXUPVALUES 60 + + +/* +@@ LUAL_BUFFERSIZE is the buffer size used by the lauxlib buffer system. +*/ +#define LUAL_BUFFERSIZE BUFSIZ + +/* }================================================================== */ + + + + +/* +** {================================================================== +@@ LUA_NUMBER is the type of numbers in Lua. +** CHANGE the following definitions only if you want to build Lua +** with a number type different from double. You may also need to +** change lua_number2int & lua_number2integer. +** =================================================================== +*/ + +#define LUA_NUMBER_DOUBLE +#define LUA_NUMBER double + +/* +@@ LUAI_UACNUMBER is the result of an 'usual argument conversion' +@* over a number. +*/ +#define LUAI_UACNUMBER double + + +/* +@@ LUA_NUMBER_SCAN is the format for reading numbers. +@@ LUA_NUMBER_FMT is the format for writing numbers. +@@ lua_number2str converts a number to a string. +@@ LUAI_MAXNUMBER2STR is maximum size of previous conversion. +@@ lua_str2number converts a string to a number. +*/ +#define LUA_NUMBER_SCAN "%lf" +#define LUA_NUMBER_FMT "%.14g" +#define lua_number2str(s,n) sprintf((s), LUA_NUMBER_FMT, (n)) +#define LUAI_MAXNUMBER2STR 32 /* 16 digits, sign, point, and \0 */ +#define lua_str2number(s,p) strtod((s), (p)) + + +/* +@@ The luai_num* macros define the primitive operations over numbers. +*/ +#if defined(LUA_CORE) +#include +#define luai_numadd(a,b) ((a)+(b)) +#define luai_numsub(a,b) ((a)-(b)) +#define luai_nummul(a,b) ((a)*(b)) +#define luai_numdiv(a,b) ((a)/(b)) +#define luai_nummod(a,b) ((a) - floor((a)/(b))*(b)) +#define luai_numpow(a,b) (pow(a,b)) +#define luai_numunm(a) (-(a)) +#define luai_numeq(a,b) ((a)==(b)) +#define luai_numlt(a,b) ((a)<(b)) +#define luai_numle(a,b) ((a)<=(b)) +#define luai_numisnan(a) (!luai_numeq((a), (a))) +#endif + + +/* +@@ lua_number2int is a macro to convert lua_Number to int. +@@ lua_number2integer is a macro to convert lua_Number to lua_Integer. +** CHANGE them if you know a faster way to convert a lua_Number to +** int (with any rounding method and without throwing errors) in your +** system. In Pentium machines, a naive typecast from double to int +** in C is extremely slow, so any alternative is worth trying. +*/ + +/* On a Pentium, resort to a trick */ +#if defined(LUA_NUMBER_DOUBLE) && !defined(LUA_ANSI) && !defined(__SSE2__) && \ + (defined(__i386) || defined (_M_IX86) || defined(__i386__)) + +/* On a Microsoft compiler, use assembler */ +#if defined(_MSC_VER) + +#define lua_number2int(i,d) __asm fld d __asm fistp i +#define lua_number2integer(i,n) lua_number2int(i, n) + +/* the next trick should work on any Pentium, but sometimes clashes + with a DirectX idiosyncrasy */ +#else + +union luai_Cast { double l_d; long l_l; }; +#define lua_number2int(i,d) \ + { volatile union luai_Cast u; u.l_d = (d) + 6755399441055744.0; (i) = u.l_l; } +#define lua_number2integer(i,n) lua_number2int(i, n) + +#endif + + +/* this option always works, but may be slow */ +#else +#define lua_number2int(i,d) ((i)=(int)(d)) +#define lua_number2integer(i,d) ((i)=(lua_Integer)(d)) + +#endif + +/* }================================================================== */ + + +/* +@@ LUAI_USER_ALIGNMENT_T is a type that requires maximum alignment. +** CHANGE it if your system requires alignments larger than double. (For +** instance, if your system supports long doubles and they must be +** aligned in 16-byte boundaries, then you should add long double in the +** union.) Probably you do not need to change this. +*/ +#define LUAI_USER_ALIGNMENT_T union { double u; void *s; long l; } + + +/* +@@ LUAI_THROW/LUAI_TRY define how Lua does exception handling. +** CHANGE them if you prefer to use longjmp/setjmp even with C++ +** or if want/don't to use _longjmp/_setjmp instead of regular +** longjmp/setjmp. By default, Lua handles errors with exceptions when +** compiling as C++ code, with _longjmp/_setjmp when asked to use them, +** and with longjmp/setjmp otherwise. +*/ +#if defined(__cplusplus) +/* C++ exceptions */ +#define LUAI_THROW(L,c) throw(c) +#define LUAI_TRY(L,c,a) try { a } catch(...) \ + { if ((c)->status == 0) (c)->status = -1; } +#define luai_jmpbuf int /* dummy variable */ + +#elif defined(LUA_USE_ULONGJMP) +/* in Unix, try _longjmp/_setjmp (more efficient) */ +#define LUAI_THROW(L,c) _longjmp((c)->b, 1) +#define LUAI_TRY(L,c,a) if (_setjmp((c)->b) == 0) { a } +#define luai_jmpbuf jmp_buf + +#else +/* default handling with long jumps */ +#define LUAI_THROW(L,c) longjmp((c)->b, 1) +#define LUAI_TRY(L,c,a) if (setjmp((c)->b) == 0) { a } +#define luai_jmpbuf jmp_buf + +#endif + + +/* +@@ LUA_MAXCAPTURES is the maximum number of captures that a pattern +@* can do during pattern-matching. +** CHANGE it if you need more captures. This limit is arbitrary. +*/ +#define LUA_MAXCAPTURES 32 + + +/* +@@ lua_tmpnam is the function that the OS library uses to create a +@* temporary name. +@@ LUA_TMPNAMBUFSIZE is the maximum size of a name created by lua_tmpnam. +** CHANGE them if you have an alternative to tmpnam (which is considered +** insecure) or if you want the original tmpnam anyway. By default, Lua +** uses tmpnam except when POSIX is available, where it uses mkstemp. +*/ +#if defined(loslib_c) || defined(luaall_c) + +#if defined(LUA_USE_MKSTEMP) +#include +#define LUA_TMPNAMBUFSIZE 32 +#define lua_tmpnam(b,e) { \ + strcpy(b, "/tmp/lua_XXXXXX"); \ + e = mkstemp(b); \ + if (e != -1) close(e); \ + e = (e == -1); } + +#else +#define LUA_TMPNAMBUFSIZE L_tmpnam +#define lua_tmpnam(b,e) { e = (tmpnam(b) == NULL); } +#endif + +#endif + + +/* +@@ lua_popen spawns a new process connected to the current one through +@* the file streams. +** CHANGE it if you have a way to implement it in your system. +*/ +#if defined(LUA_USE_POPEN) + +#define lua_popen(L,c,m) ((void)L, popen(c,m)) +#define lua_pclose(L,file) ((void)L, (pclose(file) != -1)) + +#elif defined(LUA_WIN) + +#define lua_popen(L,c,m) ((void)L, _popen(c,m)) +#define lua_pclose(L,file) ((void)L, (_pclose(file) != -1)) + +#else + +#define lua_popen(L,c,m) ((void)((void)c, m), \ + luaL_error(L, LUA_QL("popen") " not supported"), (FILE*)0) +#define lua_pclose(L,file) ((void)((void)L, file), 0) + +#endif + +/* +@@ LUA_DL_* define which dynamic-library system Lua should use. +** CHANGE here if Lua has problems choosing the appropriate +** dynamic-library system for your platform (either Windows' DLL, Mac's +** dyld, or Unix's dlopen). If your system is some kind of Unix, there +** is a good chance that it has dlopen, so LUA_DL_DLOPEN will work for +** it. To use dlopen you also need to adapt the src/Makefile (probably +** adding -ldl to the linker options), so Lua does not select it +** automatically. (When you change the makefile to add -ldl, you must +** also add -DLUA_USE_DLOPEN.) +** If you do not want any kind of dynamic library, undefine all these +** options. +** By default, _WIN32 gets LUA_DL_DLL and MAC OS X gets LUA_DL_DYLD. +*/ +#if defined(LUA_USE_DLOPEN) +#define LUA_DL_DLOPEN +#endif + +#if defined(LUA_WIN) +#define LUA_DL_DLL +#endif + + +/* +@@ LUAI_EXTRASPACE allows you to add user-specific data in a lua_State +@* (the data goes just *before* the lua_State pointer). +** CHANGE (define) this if you really need that. This value must be +** a multiple of the maximum alignment required for your machine. +*/ +#define LUAI_EXTRASPACE 0 + + +/* +@@ luai_userstate* allow user-specific actions on threads. +** CHANGE them if you defined LUAI_EXTRASPACE and need to do something +** extra when a thread is created/deleted/resumed/yielded. +*/ +#define luai_userstateopen(L) ((void)L) +#define luai_userstateclose(L) ((void)L) +#define luai_userstatethread(L,L1) ((void)L) +#define luai_userstatefree(L) ((void)L) +#define luai_userstateresume(L,n) ((void)L) +#define luai_userstateyield(L,n) ((void)L) + + +/* +@@ LUA_INTFRMLEN is the length modifier for integer conversions +@* in 'string.format'. +@@ LUA_INTFRM_T is the integer type correspoding to the previous length +@* modifier. +** CHANGE them if your system supports long long or does not support long. +*/ + +#if defined(LUA_USELONGLONG) + +#define LUA_INTFRMLEN "ll" +#define LUA_INTFRM_T long long + +#else + +#define LUA_INTFRMLEN "l" +#define LUA_INTFRM_T long + +#endif + + + +/* =================================================================== */ + +/* +** Local configuration. You can use this space to add your redefinitions +** without modifying the main part of the file. +*/ + + + +#endif + diff --git a/src/lua-vm/lualib.h b/src/lua-vm/lualib.h new file mode 100644 index 0000000..25f5ecc --- /dev/null +++ b/src/lua-vm/lualib.h @@ -0,0 +1,56 @@ +/* +** $Id: lualib.h,v 1.36 2005/12/27 17:12:00 roberto Exp $ +** Lua standard libraries +** See Copyright Notice in lua.h +*/ + + +#ifndef lualib_h +#define lualib_h + +#include "lua.h" + + +/* Key to file-handle type */ +#define LUA_FILEHANDLE "FILE*" + + +#define LUA_COLIBNAME "coroutine" +LUALIB_API int (luaopen_base) (lua_State *L); + +#define LUA_TABLIBNAME "table" +LUALIB_API int (luaopen_table) (lua_State *L); + +#define LUA_IOLIBNAME "io" +LUALIB_API int (luaopen_io) (lua_State *L); + +#define LUA_OSLIBNAME "os" +LUALIB_API int (luaopen_os) (lua_State *L); + +#define LUA_STRLIBNAME "string" +LUALIB_API int (luaopen_string) (lua_State *L); + +#define LUA_MATHLIBNAME "math" +LUALIB_API int (luaopen_math) (lua_State *L); + +#define LUA_DBLIBNAME "debug" +LUALIB_API int (luaopen_debug) (lua_State *L); + +#define LUA_LOADLIBNAME "package" +LUALIB_API int (luaopen_package) (lua_State *L); + +#define METALUA_COMPILER "mlc" +LUALIB_API int (luaopen_mlc) (lua_State *L); + + +/* open all previous libraries */ +LUALIB_API void (luaL_openlibs) (lua_State *L); + + + +#ifndef lua_assert +#define lua_assert(x) ((void)0) +#endif + + +#endif diff --git a/src/lua-vm/lundump.c b/src/lua-vm/lundump.c new file mode 100644 index 0000000..7fc635e --- /dev/null +++ b/src/lua-vm/lundump.c @@ -0,0 +1,223 @@ +/* +** $Id: lundump.c,v 1.60 2006/02/16 15:53:49 lhf Exp $ +** load precompiled Lua chunks +** See Copyright Notice in lua.h +*/ + +#include + +#define lundump_c +#define LUA_CORE + +#include "lua.h" + +#include "ldebug.h" +#include "ldo.h" +#include "lfunc.h" +#include "lmem.h" +#include "lobject.h" +#include "lstring.h" +#include "lundump.h" +#include "lzio.h" + +typedef struct { + lua_State* L; + ZIO* Z; + Mbuffer* b; + const char* name; +} LoadState; + +#ifdef LUAC_TRUST_BINARIES +#define IF(c,s) +#else +#define IF(c,s) if (c) error(S,s) + +static void error(LoadState* S, const char* why) +{ + luaO_pushfstring(S->L,"%s: %s in precompiled chunk",S->name,why); + luaD_throw(S->L,LUA_ERRSYNTAX); +} +#endif + +#define LoadMem(S,b,n,size) LoadBlock(S,b,(n)*(size)) +#define LoadByte(S) (lu_byte)LoadChar(S) +#define LoadVar(S,x) LoadMem(S,&x,1,sizeof(x)) +#define LoadVector(S,b,n,size) LoadMem(S,b,n,size) + +static void LoadBlock(LoadState* S, void* b, size_t size) +{ + size_t r=luaZ_read(S->Z,b,size); + IF (r!=0, "unexpected end"); +} + +static int LoadChar(LoadState* S) +{ + char x; + LoadVar(S,x); + return x; +} + +static int LoadInt(LoadState* S) +{ + int x; + LoadVar(S,x); + IF (x<0, "bad integer"); + return x; +} + +static lua_Number LoadNumber(LoadState* S) +{ + lua_Number x; + LoadVar(S,x); + return x; +} + +static TString* LoadString(LoadState* S) +{ + size_t size; + LoadVar(S,size); + if (size==0) + return NULL; + else + { + char* s=luaZ_openspace(S->L,S->b,size); + LoadBlock(S,s,size); + return luaS_newlstr(S->L,s,size-1); /* remove trailing '\0' */ + } +} + +static void LoadCode(LoadState* S, Proto* f) +{ + int n=LoadInt(S); + f->code=luaM_newvector(S->L,n,Instruction); + f->sizecode=n; + LoadVector(S,f->code,n,sizeof(Instruction)); +} + +static Proto* LoadFunction(LoadState* S, TString* p); + +static void LoadConstants(LoadState* S, Proto* f) +{ + int i,n; + n=LoadInt(S); + f->k=luaM_newvector(S->L,n,TValue); + f->sizek=n; + for (i=0; ik[i]); + for (i=0; ik[i]; + int t=LoadChar(S); + switch (t) + { + case LUA_TNIL: + setnilvalue(o); + break; + case LUA_TBOOLEAN: + setbvalue(o,LoadChar(S)); + break; + case LUA_TNUMBER: + setnvalue(o,LoadNumber(S)); + break; + case LUA_TSTRING: + setsvalue2n(S->L,o,LoadString(S)); + break; + default: + IF (1, "bad constant"); + break; + } + } + n=LoadInt(S); + f->p=luaM_newvector(S->L,n,Proto*); + f->sizep=n; + for (i=0; ip[i]=NULL; + for (i=0; ip[i]=LoadFunction(S,f->source); +} + +static void LoadDebug(LoadState* S, Proto* f) +{ + int i,n; + n=LoadInt(S); + f->lineinfo=luaM_newvector(S->L,n,int); + f->sizelineinfo=n; + LoadVector(S,f->lineinfo,n,sizeof(int)); + n=LoadInt(S); + f->locvars=luaM_newvector(S->L,n,LocVar); + f->sizelocvars=n; + for (i=0; ilocvars[i].varname=NULL; + for (i=0; ilocvars[i].varname=LoadString(S); + f->locvars[i].startpc=LoadInt(S); + f->locvars[i].endpc=LoadInt(S); + } + n=LoadInt(S); + f->upvalues=luaM_newvector(S->L,n,TString*); + f->sizeupvalues=n; + for (i=0; iupvalues[i]=NULL; + for (i=0; iupvalues[i]=LoadString(S); +} + +static Proto* LoadFunction(LoadState* S, TString* p) +{ + Proto* f=luaF_newproto(S->L); + setptvalue2s(S->L,S->L->top,f); incr_top(S->L); + f->source=LoadString(S); if (f->source==NULL) f->source=p; + f->linedefined=LoadInt(S); + f->lastlinedefined=LoadInt(S); + f->nups=LoadByte(S); + f->numparams=LoadByte(S); + f->is_vararg=LoadByte(S); + f->maxstacksize=LoadByte(S); + LoadCode(S,f); + LoadConstants(S,f); + LoadDebug(S,f); + IF (!luaG_checkcode(f), "bad code"); + S->L->top--; + return f; +} + +static void LoadHeader(LoadState* S) +{ + char h[LUAC_HEADERSIZE]; + char s[LUAC_HEADERSIZE]; + luaU_header(h); + LoadBlock(S,s,LUAC_HEADERSIZE); + IF (memcmp(h,s,LUAC_HEADERSIZE)!=0, "bad header"); +} + +/* +** load precompiled chunk +*/ +Proto* luaU_undump (lua_State* L, ZIO* Z, Mbuffer* buff, const char* name) +{ + LoadState S; + if (*name=='@' || *name=='=') + S.name=name+1; + else if (*name==LUA_SIGNATURE[0]) + S.name="binary string"; + else + S.name=name; + S.L=L; + S.Z=Z; + S.b=buff; + LoadHeader(&S); + return LoadFunction(&S,luaS_newliteral(L,"=?")); +} + +/* +* make header +*/ +void luaU_header (char* h) +{ + int x=1; + memcpy(h,LUA_SIGNATURE,sizeof(LUA_SIGNATURE)-1); + h+=sizeof(LUA_SIGNATURE)-1; + *h++=(char)LUAC_VERSION; + *h++=(char)LUAC_FORMAT; + *h++=(char)*(char*)&x; /* endianness */ + *h++=(char)sizeof(int); + *h++=(char)sizeof(size_t); + *h++=(char)sizeof(Instruction); + *h++=(char)sizeof(lua_Number); + *h++=(char)(((lua_Number)0.5)==0); /* is lua_Number integral? */ +} diff --git a/src/lua-vm/lundump.h b/src/lua-vm/lundump.h new file mode 100644 index 0000000..58cca5d --- /dev/null +++ b/src/lua-vm/lundump.h @@ -0,0 +1,36 @@ +/* +** $Id: lundump.h,v 1.40 2005/11/11 14:03:13 lhf Exp $ +** load precompiled Lua chunks +** See Copyright Notice in lua.h +*/ + +#ifndef lundump_h +#define lundump_h + +#include "lobject.h" +#include "lzio.h" + +/* load one chunk; from lundump.c */ +LUAI_FUNC Proto* luaU_undump (lua_State* L, ZIO* Z, Mbuffer* buff, const char* name); + +/* make header; from lundump.c */ +LUAI_FUNC void luaU_header (char* h); + +/* dump one chunk; from ldump.c */ +LUAI_FUNC int luaU_dump (lua_State* L, const Proto* f, lua_Writer w, void* data, int strip); + +#ifdef luac_c +/* print one chunk; from print.c */ +LUAI_FUNC void luaU_print (const Proto* f, int full); +#endif + +/* for header of binary files -- this is Lua 5.1 */ +#define LUAC_VERSION 0x51 + +/* for header of binary files -- this is the official format */ +#define LUAC_FORMAT 0 + +/* size of header of binary files */ +#define LUAC_HEADERSIZE 12 + +#endif diff --git a/src/lua-vm/lundumplib.c b/src/lua-vm/lundumplib.c new file mode 100644 index 0000000..ffe471c --- /dev/null +++ b/src/lua-vm/lundumplib.c @@ -0,0 +1,4 @@ +#include "lua.h" +#include "lzio.h" + + diff --git a/src/lua-vm/lvm.c b/src/lua-vm/lvm.c new file mode 100644 index 0000000..08802f4 --- /dev/null +++ b/src/lua-vm/lvm.c @@ -0,0 +1,765 @@ +/* +** $Id: lvm.c,v 2.63a 2006/06/05 15:58:59 roberto Exp $ +** Lua virtual machine +** See Copyright Notice in lua.h +*/ + + +#include +#include +#include + +#define lvm_c +#define LUA_CORE + +#include "lua.h" + +#include "ldebug.h" +#include "ldo.h" +#include "lfunc.h" +#include "lgc.h" +#include "lobject.h" +#include "lopcodes.h" +#include "lstate.h" +#include "lstring.h" +#include "ltable.h" +#include "ltm.h" +#include "lvm.h" + + + +/* limit for table tag-method chains (to avoid loops) */ +#define MAXTAGLOOP 100 + + +const TValue *luaV_tonumber (const TValue *obj, TValue *n) { + lua_Number num; + if (ttisnumber(obj)) return obj; + if (ttisstring(obj) && luaO_str2d(svalue(obj), &num)) { + setnvalue(n, num); + return n; + } + else + return NULL; +} + + +int luaV_tostring (lua_State *L, StkId obj) { + if (!ttisnumber(obj)) + return 0; + else { + char s[LUAI_MAXNUMBER2STR]; + lua_Number n = nvalue(obj); + lua_number2str(s, n); + setsvalue2s(L, obj, luaS_new(L, s)); + return 1; + } +} + + +static void traceexec (lua_State *L, const Instruction *pc) { + lu_byte mask = L->hookmask; + const Instruction *oldpc = L->savedpc; + L->savedpc = pc; + if (mask > LUA_MASKLINE) { /* instruction-hook set? */ + if (L->hookcount == 0) { + resethookcount(L); + luaD_callhook(L, LUA_HOOKCOUNT, -1); + } + } + if (mask & LUA_MASKLINE) { + Proto *p = ci_func(L->ci)->l.p; + int npc = pcRel(pc, p); + int newline = getline(p, npc); + /* call linehook when enter a new function, when jump back (loop), + or when enter a new line */ + if (npc == 0 || pc <= oldpc || newline != getline(p, pcRel(oldpc, p))) + luaD_callhook(L, LUA_HOOKLINE, newline); + } +} + + +static void callTMres (lua_State *L, StkId res, const TValue *f, + const TValue *p1, const TValue *p2) { + ptrdiff_t result = savestack(L, res); + setobj2s(L, L->top, f); /* push function */ + setobj2s(L, L->top+1, p1); /* 1st argument */ + setobj2s(L, L->top+2, p2); /* 2nd argument */ + luaD_checkstack(L, 3); + L->top += 3; + luaD_call(L, L->top - 3, 1); + res = restorestack(L, result); + L->top--; + setobjs2s(L, res, L->top); +} + + + +static void callTM (lua_State *L, const TValue *f, const TValue *p1, + const TValue *p2, const TValue *p3) { + setobj2s(L, L->top, f); /* push function */ + setobj2s(L, L->top+1, p1); /* 1st argument */ + setobj2s(L, L->top+2, p2); /* 2nd argument */ + setobj2s(L, L->top+3, p3); /* 3th argument */ + luaD_checkstack(L, 4); + L->top += 4; + luaD_call(L, L->top - 4, 0); +} + + +void luaV_gettable (lua_State *L, const TValue *t, TValue *key, StkId val) { + int loop; + for (loop = 0; loop < MAXTAGLOOP; loop++) { + const TValue *tm; + if (ttistable(t)) { /* `t' is a table? */ + Table *h = hvalue(t); + const TValue *res = luaH_get(h, key); /* do a primitive get */ + if (!ttisnil(res) || /* result is no nil? */ + (tm = fasttm(L, h->metatable, TM_INDEX)) == NULL) { /* or no TM? */ + setobj2s(L, val, res); + return; + } + /* else will try the tag method */ + } + else if (ttisnil(tm = luaT_gettmbyobj(L, t, TM_INDEX))) + luaG_typeerror(L, t, "index"); + if (ttisfunction(tm)) { + callTMres(L, val, tm, t, key); + return; + } + t = tm; /* else repeat with `tm' */ + } + luaG_runerror(L, "loop in gettable"); +} + + +void luaV_settable (lua_State *L, const TValue *t, TValue *key, StkId val) { + int loop; + for (loop = 0; loop < MAXTAGLOOP; loop++) { + const TValue *tm; + if (ttistable(t)) { /* `t' is a table? */ + Table *h = hvalue(t); + TValue *oldval = luaH_set(L, h, key); /* do a primitive set */ + if (!ttisnil(oldval) || /* result is no nil? */ + (tm = fasttm(L, h->metatable, TM_NEWINDEX)) == NULL) { /* or no TM? */ + setobj2t(L, oldval, val); + luaC_barriert(L, h, val); + return; + } + /* else will try the tag method */ + } + else if (ttisnil(tm = luaT_gettmbyobj(L, t, TM_NEWINDEX))) + luaG_typeerror(L, t, "index"); + if (ttisfunction(tm)) { + callTM(L, tm, t, key, val); + return; + } + t = tm; /* else repeat with `tm' */ + } + luaG_runerror(L, "loop in settable"); +} + + +static int call_binTM (lua_State *L, const TValue *p1, const TValue *p2, + StkId res, TMS event) { + const TValue *tm = luaT_gettmbyobj(L, p1, event); /* try first operand */ + if (ttisnil(tm)) + tm = luaT_gettmbyobj(L, p2, event); /* try second operand */ + if (ttisnil(tm)) return 0; + callTMres(L, res, tm, p1, p2); + return 1; +} + + +static const TValue *get_compTM (lua_State *L, Table *mt1, Table *mt2, + TMS event) { + const TValue *tm1 = fasttm(L, mt1, event); + const TValue *tm2; + if (tm1 == NULL) return NULL; /* no metamethod */ + if (mt1 == mt2) return tm1; /* same metatables => same metamethods */ + tm2 = fasttm(L, mt2, event); + if (tm2 == NULL) return NULL; /* no metamethod */ + if (luaO_rawequalObj(tm1, tm2)) /* same metamethods? */ + return tm1; + return NULL; +} + + +static int call_orderTM (lua_State *L, const TValue *p1, const TValue *p2, + TMS event) { + const TValue *tm1 = luaT_gettmbyobj(L, p1, event); + const TValue *tm2; + if (ttisnil(tm1)) return -1; /* no metamethod? */ + tm2 = luaT_gettmbyobj(L, p2, event); + if (!luaO_rawequalObj(tm1, tm2)) /* different metamethods? */ + return -1; + callTMres(L, L->top, tm1, p1, p2); + return !l_isfalse(L->top); +} + + +static int l_strcmp (const TString *ls, const TString *rs) { + const char *l = getstr(ls); + size_t ll = ls->tsv.len; + const char *r = getstr(rs); + size_t lr = rs->tsv.len; + for (;;) { + int temp = strcoll(l, r); + if (temp != 0) return temp; + else { /* strings are equal up to a `\0' */ + size_t len = strlen(l); /* index of first `\0' in both strings */ + if (len == lr) /* r is finished? */ + return (len == ll) ? 0 : 1; + else if (len == ll) /* l is finished? */ + return -1; /* l is smaller than r (because r is not finished) */ + /* both strings longer than `len'; go on comparing (after the `\0') */ + len++; + l += len; ll -= len; r += len; lr -= len; + } + } +} + + +int luaV_lessthan (lua_State *L, const TValue *l, const TValue *r) { + int res; + if (ttype(l) != ttype(r)) + return luaG_ordererror(L, l, r); + else if (ttisnumber(l)) + return luai_numlt(nvalue(l), nvalue(r)); + else if (ttisstring(l)) + return l_strcmp(rawtsvalue(l), rawtsvalue(r)) < 0; + else if ((res = call_orderTM(L, l, r, TM_LT)) != -1) + return res; + return luaG_ordererror(L, l, r); +} + + +static int lessequal (lua_State *L, const TValue *l, const TValue *r) { + int res; + if (ttype(l) != ttype(r)) + return luaG_ordererror(L, l, r); + else if (ttisnumber(l)) + return luai_numle(nvalue(l), nvalue(r)); + else if (ttisstring(l)) + return l_strcmp(rawtsvalue(l), rawtsvalue(r)) <= 0; + else if ((res = call_orderTM(L, l, r, TM_LE)) != -1) /* first try `le' */ + return res; + else if ((res = call_orderTM(L, r, l, TM_LT)) != -1) /* else try `lt' */ + return !res; + return luaG_ordererror(L, l, r); +} + + +int luaV_equalval (lua_State *L, const TValue *t1, const TValue *t2) { + const TValue *tm; + lua_assert(ttype(t1) == ttype(t2)); + switch (ttype(t1)) { + case LUA_TNIL: return 1; + case LUA_TNUMBER: return luai_numeq(nvalue(t1), nvalue(t2)); + case LUA_TBOOLEAN: return bvalue(t1) == bvalue(t2); /* true must be 1 !! */ + case LUA_TLIGHTUSERDATA: return pvalue(t1) == pvalue(t2); + case LUA_TUSERDATA: { + if (uvalue(t1) == uvalue(t2)) return 1; + tm = get_compTM(L, uvalue(t1)->metatable, uvalue(t2)->metatable, + TM_EQ); + break; /* will try TM */ + } + case LUA_TTABLE: { + if (hvalue(t1) == hvalue(t2)) return 1; + tm = get_compTM(L, hvalue(t1)->metatable, hvalue(t2)->metatable, TM_EQ); + break; /* will try TM */ + } + default: return gcvalue(t1) == gcvalue(t2); + } + if (tm == NULL) return 0; /* no TM? */ + callTMres(L, L->top, tm, t1, t2); /* call TM */ + return !l_isfalse(L->top); +} + + +void luaV_concat (lua_State *L, int total, int last) { + do { + StkId top = L->base + last + 1; + int n = 2; /* number of elements handled in this pass (at least 2) */ + if (!(ttisstring(top-2) || ttisnumber(top-2)) || !tostring(L, top-1)) { + if (!call_binTM(L, top-2, top-1, top-2, TM_CONCAT)) + luaG_concaterror(L, top-2, top-1); + } else if (tsvalue(top-1)->len == 0) /* second op is empty? */ + (void)tostring(L, top - 2); /* result is first op (as string) */ + else { + /* at least two string values; get as many as possible */ + size_t tl = tsvalue(top-1)->len; + char *buffer; + int i; + /* collect total length */ + for (n = 1; n < total && tostring(L, top-n-1); n++) { + size_t l = tsvalue(top-n-1)->len; + if (l >= MAX_SIZET - tl) luaG_runerror(L, "string length overflow"); + tl += l; + } + buffer = luaZ_openspace(L, &G(L)->buff, tl); + tl = 0; + for (i=n; i>0; i--) { /* concat all strings */ + size_t l = tsvalue(top-i)->len; + memcpy(buffer+tl, svalue(top-i), l); + tl += l; + } + setsvalue2s(L, top-n, luaS_newlstr(L, buffer, tl)); + } + total -= n-1; /* got `n' strings to create 1 new */ + last -= n-1; + } while (total > 1); /* repeat until only 1 result left */ +} + + +static void Arith (lua_State *L, StkId ra, const TValue *rb, + const TValue *rc, TMS op) { + TValue tempb, tempc; + const TValue *b, *c; + if ((b = luaV_tonumber(rb, &tempb)) != NULL && + (c = luaV_tonumber(rc, &tempc)) != NULL) { + lua_Number nb = nvalue(b), nc = nvalue(c); + switch (op) { + case TM_ADD: setnvalue(ra, luai_numadd(nb, nc)); break; + case TM_SUB: setnvalue(ra, luai_numsub(nb, nc)); break; + case TM_MUL: setnvalue(ra, luai_nummul(nb, nc)); break; + case TM_DIV: setnvalue(ra, luai_numdiv(nb, nc)); break; + case TM_MOD: setnvalue(ra, luai_nummod(nb, nc)); break; + case TM_POW: setnvalue(ra, luai_numpow(nb, nc)); break; + case TM_UNM: setnvalue(ra, luai_numunm(nb)); break; + default: lua_assert(0); break; + } + } + else if (!call_binTM(L, rb, rc, ra, op)) + luaG_aritherror(L, rb, rc); +} + + + +/* +** some macros for common tasks in `luaV_execute' +*/ + +#define runtime_check(L, c) { if (!(c)) break; } + +#define RA(i) (base+GETARG_A(i)) +/* to be used after possible stack reallocation */ +#define RB(i) check_exp(getBMode(GET_OPCODE(i)) == OpArgR, base+GETARG_B(i)) +#define RC(i) check_exp(getCMode(GET_OPCODE(i)) == OpArgR, base+GETARG_C(i)) +#define RKB(i) check_exp(getBMode(GET_OPCODE(i)) == OpArgK, \ + ISK(GETARG_B(i)) ? k+INDEXK(GETARG_B(i)) : base+GETARG_B(i)) +#define RKC(i) check_exp(getCMode(GET_OPCODE(i)) == OpArgK, \ + ISK(GETARG_C(i)) ? k+INDEXK(GETARG_C(i)) : base+GETARG_C(i)) +#define KBx(i) check_exp(getBMode(GET_OPCODE(i)) == OpArgK, k+GETARG_Bx(i)) + + +#define dojump(L,pc,i) {(pc) += (i); luai_threadyield(L);} + + +#define Protect(x) { L->savedpc = pc; {x;}; base = L->base; } + + +#define arith_op(op,tm) { \ + TValue *rb = RKB(i); \ + TValue *rc = RKC(i); \ + if (ttisnumber(rb) && ttisnumber(rc)) { \ + lua_Number nb = nvalue(rb), nc = nvalue(rc); \ + setnvalue(ra, op(nb, nc)); \ + } \ + else \ + Protect(Arith(L, ra, rb, rc, tm)); \ + } + + + +void luaV_execute (lua_State *L, int nexeccalls) { + LClosure *cl; + StkId base; + TValue *k; + const Instruction *pc; + reentry: /* entry point */ + lua_assert(isLua(L->ci)); + pc = L->savedpc; + cl = &clvalue(L->ci->func)->l; + base = L->base; + k = cl->p->k; + /* main loop of interpreter */ + for (;;) { + const Instruction i = *pc++; + StkId ra; + if ((L->hookmask & (LUA_MASKLINE | LUA_MASKCOUNT)) && + (--L->hookcount == 0 || L->hookmask & LUA_MASKLINE)) { + traceexec(L, pc); + if (L->status == LUA_YIELD) { /* did hook yield? */ + L->savedpc = pc - 1; + return; + } + base = L->base; + } + /* warning!! several calls may realloc the stack and invalidate `ra' */ + ra = RA(i); + lua_assert(base == L->base && L->base == L->ci->base); + lua_assert(base <= L->top && L->top <= L->stack + L->stacksize); + lua_assert(L->top == L->ci->top || luaG_checkopenop(i)); + switch (GET_OPCODE(i)) { + case OP_MOVE: { + setobjs2s(L, ra, RB(i)); + continue; + } + case OP_LOADK: { + setobj2s(L, ra, KBx(i)); + continue; + } + case OP_LOADBOOL: { + setbvalue(ra, GETARG_B(i)); + if (GETARG_C(i)) pc++; /* skip next instruction (if C) */ + continue; + } + case OP_LOADNIL: { + TValue *rb = RB(i); + do { + setnilvalue(rb--); + } while (rb >= ra); + continue; + } + case OP_GETUPVAL: { + int b = GETARG_B(i); + setobj2s(L, ra, cl->upvals[b]->v); + continue; + } + case OP_GETGLOBAL: { + TValue g; + TValue *rb = KBx(i); + sethvalue(L, &g, cl->env); + lua_assert(ttisstring(rb)); + Protect(luaV_gettable(L, &g, rb, ra)); + continue; + } + case OP_GETTABLE: { + Protect(luaV_gettable(L, RB(i), RKC(i), ra)); + continue; + } + case OP_SETGLOBAL: { + TValue g; + sethvalue(L, &g, cl->env); + lua_assert(ttisstring(KBx(i))); + Protect(luaV_settable(L, &g, KBx(i), ra)); + continue; + } + case OP_SETUPVAL: { + UpVal *uv = cl->upvals[GETARG_B(i)]; + setobj(L, uv->v, ra); + luaC_barrier(L, uv, ra); + continue; + } + case OP_SETTABLE: { + Protect(luaV_settable(L, ra, RKB(i), RKC(i))); + continue; + } + case OP_NEWTABLE: { + int b = GETARG_B(i); + int c = GETARG_C(i); + sethvalue(L, ra, luaH_new(L, luaO_fb2int(b), luaO_fb2int(c))); + Protect(luaC_checkGC(L)); + continue; + } + case OP_SELF: { + StkId rb = RB(i); + setobjs2s(L, ra+1, rb); + Protect(luaV_gettable(L, rb, RKC(i), ra)); + continue; + } + case OP_ADD: { + arith_op(luai_numadd, TM_ADD); + continue; + } + case OP_SUB: { + arith_op(luai_numsub, TM_SUB); + continue; + } + case OP_MUL: { + arith_op(luai_nummul, TM_MUL); + continue; + } + case OP_DIV: { + arith_op(luai_numdiv, TM_DIV); + continue; + } + case OP_MOD: { + arith_op(luai_nummod, TM_MOD); + continue; + } + case OP_POW: { + arith_op(luai_numpow, TM_POW); + continue; + } + case OP_UNM: { + TValue *rb = RB(i); + if (ttisnumber(rb)) { + lua_Number nb = nvalue(rb); + setnvalue(ra, luai_numunm(nb)); + } + else { + Protect(Arith(L, ra, rb, rb, TM_UNM)); + } + continue; + } + case OP_NOT: { + int res = l_isfalse(RB(i)); /* next assignment may change this value */ + setbvalue(ra, res); + continue; + } + case OP_LEN: { + const TValue *rb = RB(i); + switch (ttype(rb)) { + case LUA_TTABLE: { + setnvalue(ra, cast_num(luaH_getn(hvalue(rb)))); + break; + } + case LUA_TSTRING: { + setnvalue(ra, cast_num(tsvalue(rb)->len)); + break; + } + default: { /* try metamethod */ + Protect( + if (!call_binTM(L, rb, luaO_nilobject, ra, TM_LEN)) + luaG_typeerror(L, rb, "get length of"); + ) + } + } + continue; + } + case OP_CONCAT: { + int b = GETARG_B(i); + int c = GETARG_C(i); + Protect(luaV_concat(L, c-b+1, c); luaC_checkGC(L)); + setobjs2s(L, RA(i), base+b); + continue; + } + case OP_JMP: { + dojump(L, pc, GETARG_sBx(i)); + continue; + } + case OP_EQ: { + TValue *rb = RKB(i); + TValue *rc = RKC(i); + Protect( + if (equalobj(L, rb, rc) == GETARG_A(i)) + dojump(L, pc, GETARG_sBx(*pc)); + ) + pc++; + continue; + } + case OP_LT: { + Protect( + if (luaV_lessthan(L, RKB(i), RKC(i)) == GETARG_A(i)) + dojump(L, pc, GETARG_sBx(*pc)); + ) + pc++; + continue; + } + case OP_LE: { + Protect( + if (lessequal(L, RKB(i), RKC(i)) == GETARG_A(i)) + dojump(L, pc, GETARG_sBx(*pc)); + ) + pc++; + continue; + } + case OP_TEST: { + if (l_isfalse(ra) != GETARG_C(i)) + dojump(L, pc, GETARG_sBx(*pc)); + pc++; + continue; + } + case OP_TESTSET: { + TValue *rb = RB(i); + if (l_isfalse(rb) != GETARG_C(i)) { + setobjs2s(L, ra, rb); + dojump(L, pc, GETARG_sBx(*pc)); + } + pc++; + continue; + } + case OP_CALL: { + int b = GETARG_B(i); + int nresults = GETARG_C(i) - 1; + if (b != 0) L->top = ra+b; /* else previous instruction set top */ + L->savedpc = pc; + switch (luaD_precall(L, ra, nresults)) { + case PCRLUA: { + nexeccalls++; + goto reentry; /* restart luaV_execute over new Lua function */ + } + case PCRC: { + /* it was a C function (`precall' called it); adjust results */ + if (nresults >= 0) L->top = L->ci->top; + base = L->base; + continue; + } + default: { + return; /* yield */ + } + } + } + case OP_TAILCALL: { + int b = GETARG_B(i); + if (b != 0) L->top = ra+b; /* else previous instruction set top */ + L->savedpc = pc; + lua_assert(GETARG_C(i) - 1 == LUA_MULTRET); + switch (luaD_precall(L, ra, LUA_MULTRET)) { + case PCRLUA: { + /* tail call: put new frame in place of previous one */ + CallInfo *ci = L->ci - 1; /* previous frame */ + int aux; + StkId func = ci->func; + StkId pfunc = (ci+1)->func; /* previous function index */ + if (L->openupval) luaF_close(L, ci->base); + L->base = ci->base = ci->func + ((ci+1)->base - pfunc); + for (aux = 0; pfunc+aux < L->top; aux++) /* move frame down */ + setobjs2s(L, func+aux, pfunc+aux); + ci->top = L->top = func+aux; /* correct top */ + lua_assert(L->top == L->base + clvalue(func)->l.p->maxstacksize); + ci->savedpc = L->savedpc; + ci->tailcalls++; /* one more call lost */ + L->ci--; /* remove new frame */ + goto reentry; + } + case PCRC: { /* it was a C function (`precall' called it) */ + base = L->base; + continue; + } + default: { + return; /* yield */ + } + } + } + case OP_RETURN: { + int b = GETARG_B(i); + if (b != 0) L->top = ra+b-1; + if (L->openupval) luaF_close(L, base); + L->savedpc = pc; + b = luaD_poscall(L, ra); + if (--nexeccalls == 0) /* was previous function running `here'? */ + return; /* no: return */ + else { /* yes: continue its execution */ + if (b) L->top = L->ci->top; + lua_assert(isLua(L->ci)); + lua_assert(GET_OPCODE(*((L->ci)->savedpc - 1)) == OP_CALL); + goto reentry; + } + } + case OP_FORLOOP: { + lua_Number step = nvalue(ra+2); + lua_Number idx = luai_numadd(nvalue(ra), step); /* increment index */ + lua_Number limit = nvalue(ra+1); + if (luai_numlt(0, step) ? luai_numle(idx, limit) + : luai_numle(limit, idx)) { + dojump(L, pc, GETARG_sBx(i)); /* jump back */ + setnvalue(ra, idx); /* update internal index... */ + setnvalue(ra+3, idx); /* ...and external index */ + } + continue; + } + case OP_FORPREP: { + const TValue *init = ra; + const TValue *plimit = ra+1; + const TValue *pstep = ra+2; + L->savedpc = pc; /* next steps may throw errors */ + if (!tonumber(init, ra)) + luaG_runerror(L, LUA_QL("for") " initial value must be a number"); + else if (!tonumber(plimit, ra+1)) + luaG_runerror(L, LUA_QL("for") " limit must be a number"); + else if (!tonumber(pstep, ra+2)) + luaG_runerror(L, LUA_QL("for") " step must be a number"); + setnvalue(ra, luai_numsub(nvalue(ra), nvalue(pstep))); + dojump(L, pc, GETARG_sBx(i)); + continue; + } + case OP_TFORLOOP: { + StkId cb = ra + 3; /* call base */ + setobjs2s(L, cb+2, ra+2); + setobjs2s(L, cb+1, ra+1); + setobjs2s(L, cb, ra); + L->top = cb+3; /* func. + 2 args (state and index) */ + Protect(luaD_call(L, cb, GETARG_C(i))); + L->top = L->ci->top; + cb = RA(i) + 3; /* previous call may change the stack */ + if (!ttisnil(cb)) { /* continue loop? */ + setobjs2s(L, cb-1, cb); /* save control variable */ + dojump(L, pc, GETARG_sBx(*pc)); /* jump back */ + } + pc++; + continue; + } + case OP_SETLIST: { + int n = GETARG_B(i); + int c = GETARG_C(i); + int last; + Table *h; + if (n == 0) { + n = cast_int(L->top - ra) - 1; + L->top = L->ci->top; + } + if (c == 0) c = cast_int(*pc++); + runtime_check(L, ttistable(ra)); + h = hvalue(ra); + last = ((c-1)*LFIELDS_PER_FLUSH) + n; + if (last > h->sizearray) /* needs more space? */ + luaH_resizearray(L, h, last); /* pre-alloc it at once */ + for (; n > 0; n--) { + TValue *val = ra+n; + setobj2t(L, luaH_setnum(L, h, last--), val); + luaC_barriert(L, h, val); + } + continue; + } + case OP_CLOSE: { + luaF_close(L, ra); + continue; + } + case OP_CLOSURE: { + Proto *p; + Closure *ncl; + int nup, j; + p = cl->p->p[GETARG_Bx(i)]; + nup = p->nups; + ncl = luaF_newLclosure(L, nup, cl->env); + ncl->l.p = p; + for (j=0; jl.upvals[j] = cl->upvals[GETARG_B(*pc)]; + else { + lua_assert(GET_OPCODE(*pc) == OP_MOVE); + ncl->l.upvals[j] = luaF_findupval(L, base + GETARG_B(*pc)); + } + } + setclvalue(L, ra, ncl); + Protect(luaC_checkGC(L)); + continue; + } + case OP_VARARG: { + int b = GETARG_B(i) - 1; + int j; + CallInfo *ci = L->ci; + int n = cast_int(ci->base - ci->func) - cl->p->numparams - 1; + if (b == LUA_MULTRET) { + Protect(luaD_checkstack(L, n)); + ra = RA(i); /* previous call may change the stack */ + b = n; + L->top = ra + n; + } + for (j = 0; j < b; j++) { + if (j < n) { + setobjs2s(L, ra + j, ci->base - n + j); + } + else { + setnilvalue(ra + j); + } + } + continue; + } + } + } +} + diff --git a/src/lua-vm/lvm.h b/src/lua-vm/lvm.h new file mode 100644 index 0000000..788423f --- /dev/null +++ b/src/lua-vm/lvm.h @@ -0,0 +1,36 @@ +/* +** $Id: lvm.h,v 2.5 2005/08/22 18:54:49 roberto Exp $ +** Lua virtual machine +** See Copyright Notice in lua.h +*/ + +#ifndef lvm_h +#define lvm_h + + +#include "ldo.h" +#include "lobject.h" +#include "ltm.h" + + +#define tostring(L,o) ((ttype(o) == LUA_TSTRING) || (luaV_tostring(L, o))) + +#define tonumber(o,n) (ttype(o) == LUA_TNUMBER || \ + (((o) = luaV_tonumber(o,n)) != NULL)) + +#define equalobj(L,o1,o2) \ + (ttype(o1) == ttype(o2) && luaV_equalval(L, o1, o2)) + + +LUAI_FUNC int luaV_lessthan (lua_State *L, const TValue *l, const TValue *r); +LUAI_FUNC int luaV_equalval (lua_State *L, const TValue *t1, const TValue *t2); +LUAI_FUNC const TValue *luaV_tonumber (const TValue *obj, TValue *n); +LUAI_FUNC int luaV_tostring (lua_State *L, StkId obj); +LUAI_FUNC void luaV_gettable (lua_State *L, const TValue *t, TValue *key, + StkId val); +LUAI_FUNC void luaV_settable (lua_State *L, const TValue *t, TValue *key, + StkId val); +LUAI_FUNC void luaV_execute (lua_State *L, int nexeccalls); +LUAI_FUNC void luaV_concat (lua_State *L, int total, int last); + +#endif diff --git a/src/lua-vm/lzio.c b/src/lua-vm/lzio.c new file mode 100644 index 0000000..5121ada --- /dev/null +++ b/src/lua-vm/lzio.c @@ -0,0 +1,82 @@ +/* +** $Id: lzio.c,v 1.31 2005/06/03 20:15:29 roberto Exp $ +** a generic input stream interface +** See Copyright Notice in lua.h +*/ + + +#include + +#define lzio_c +#define LUA_CORE + +#include "lua.h" + +#include "llimits.h" +#include "lmem.h" +#include "lstate.h" +#include "lzio.h" + + +int luaZ_fill (ZIO *z) { + size_t size; + lua_State *L = z->L; + const char *buff; + lua_unlock(L); + buff = z->reader(L, z->data, &size); + lua_lock(L); + if (buff == NULL || size == 0) return EOZ; + z->n = size - 1; + z->p = buff; + return char2int(*(z->p++)); +} + + +int luaZ_lookahead (ZIO *z) { + if (z->n == 0) { + if (luaZ_fill(z) == EOZ) + return EOZ; + else { + z->n++; /* luaZ_fill removed first byte; put back it */ + z->p--; + } + } + return char2int(*z->p); +} + + +void luaZ_init (lua_State *L, ZIO *z, lua_Reader reader, void *data) { + z->L = L; + z->reader = reader; + z->data = data; + z->n = 0; + z->p = NULL; +} + + +/* --------------------------------------------------------------- read --- */ +size_t luaZ_read (ZIO *z, void *b, size_t n) { + while (n) { + size_t m; + if (luaZ_lookahead(z) == EOZ) + return n; /* return number of missing bytes */ + m = (n <= z->n) ? n : z->n; /* min. between n and z->n */ + memcpy(b, z->p, m); + z->n -= m; + z->p += m; + b = (char *)b + m; + n -= m; + } + return 0; +} + +/* ------------------------------------------------------------------------ */ +char *luaZ_openspace (lua_State *L, Mbuffer *buff, size_t n) { + if (n > buff->buffsize) { + if (n < LUA_MINBUFFER) n = LUA_MINBUFFER; + luaZ_resizebuffer(L, buff, n); + } + return buff->buffer; +} + + diff --git a/src/lua-vm/lzio.h b/src/lua-vm/lzio.h new file mode 100644 index 0000000..8f403b8 --- /dev/null +++ b/src/lua-vm/lzio.h @@ -0,0 +1,67 @@ +/* +** $Id: lzio.h,v 1.21 2005/05/17 19:49:15 roberto Exp $ +** Buffered streams +** See Copyright Notice in lua.h +*/ + + +#ifndef lzio_h +#define lzio_h + +#include "lua.h" + +#include "lmem.h" + + +#define EOZ (-1) /* end of stream */ + +typedef struct Zio ZIO; + +#define char2int(c) cast(int, cast(unsigned char, (c))) + +#define zgetc(z) (((z)->n--)>0 ? char2int(*(z)->p++) : luaZ_fill(z)) + +typedef struct Mbuffer { + char *buffer; + size_t n; + size_t buffsize; +} Mbuffer; + +#define luaZ_initbuffer(L, buff) ((buff)->buffer = NULL, (buff)->buffsize = 0) + +#define luaZ_buffer(buff) ((buff)->buffer) +#define luaZ_sizebuffer(buff) ((buff)->buffsize) +#define luaZ_bufflen(buff) ((buff)->n) + +#define luaZ_resetbuffer(buff) ((buff)->n = 0) + + +#define luaZ_resizebuffer(L, buff, size) \ + (luaM_reallocvector(L, (buff)->buffer, (buff)->buffsize, size, char), \ + (buff)->buffsize = size) + +#define luaZ_freebuffer(L, buff) luaZ_resizebuffer(L, buff, 0) + + +LUAI_FUNC char *luaZ_openspace (lua_State *L, Mbuffer *buff, size_t n); +LUAI_FUNC void luaZ_init (lua_State *L, ZIO *z, lua_Reader reader, + void *data); +LUAI_FUNC size_t luaZ_read (ZIO* z, void* b, size_t n); /* read next n bytes */ +LUAI_FUNC int luaZ_lookahead (ZIO *z); + + + +/* --------- Private Part ------------------ */ + +struct Zio { + size_t n; /* bytes still unread */ + const char *p; /* current position in buffer */ + lua_Reader reader; + void* data; /* additional data */ + lua_State *L; /* Lua state (for reader) */ +}; + + +LUAI_FUNC int luaZ_fill (ZIO *z); + +#endif diff --git a/src/lua-vm/mlc.c b/src/lua-vm/mlc.c new file mode 100644 index 0000000..2bbc920 --- /dev/null +++ b/src/lua-vm/mlc.c @@ -0,0 +1,246 @@ +/* +** $Id: luac.c,v 1.54 2006/06/02 17:37:11 lhf Exp $ +** Lua compiler (saves bytecodes to files; also list bytecodes) +** See Copyright Notice in lua.h +*/ + +#include +#include +#include +#include + +#define luac_c +#define LUA_CORE + +#include "lua.h" +#include "lauxlib.h" + +#include "ldo.h" +#include "lfunc.h" +#include "lmem.h" +#include "lobject.h" +#include "lopcodes.h" +#include "lstring.h" +#include "lundump.h" +#include "lualib.h" + +#define PROGNAME "mlc" /* default program name */ +#define OUTPUT "metalua.out" /* default output file */ + +/* These global vars are set by doargs(), and used by pmain(). */ +static int listing=0; /* list bytecodes? */ +static int dumping=1; /* dump bytecodes? */ +static int stripping=0; /* strip debug information? */ +static char Output[]={ OUTPUT }; /* default output file name */ +static const char* output=Output; /* actual output file name */ +static const char* progname=PROGNAME; /* actual program name */ +static int showast=0; /* show resulting AST on stdout */ +static int metabugs=0; /* show errors as compile-time crashes + * rather than src syntax errors. */ + +static void fatal(const char* message) +{ + fprintf(stderr,"%s: %s\n",progname,message); + exit(EXIT_FAILURE); +} + +static void cannot(const char* what) +{ + fprintf(stderr,"%s: cannot %s %s: %s\n",progname,what,output,strerror(errno)); + exit(EXIT_FAILURE); +} + +/* Print an error message, followed by the usage summary, then exits the + * program with an error status. + */ +static void usage(const char* message) +{ + if (*message=='-') + fprintf(stderr,"%s: unrecognized option " LUA_QS "\n",progname,message); + else + fprintf(stderr,"%s: %s\n",progname,message); + fprintf(stderr, + "usage: %s [options] [filenames].\n" + "Available options are:\n" + " - process stdin\n" + " -l list\n" + " -o name output to file " LUA_QL("name") " (default is \"%s\")\n" + " -p parse only\n" + " -s strip debug information\n" + " -v show version information\n" + " -- stop handling options\n", + progname,Output); + exit(EXIT_FAILURE); +} + +/* Used by doargs() and by pmain() */ +#define IS(s) (strcmp(argv[i],s)==0) + +/* Parse command line options, returns the index of the first + * non-option command line parameter (normally a filename or NULL. + */ +static int doargs(int argc, char* argv[]) +{ + int i; + int version=0; + if (argv[0]!=NULL && *argv[0]!=0) progname=argv[0]; + for (i=1; itop+(i))->l.p) + if (n==1) + return toproto(L,-1); + else + { + int i,pc; + Proto* f=luaF_newproto(L); + setptvalue2s(L,L->top,f); incr_top(L); + f->source=luaS_newliteral(L,"=(" PROGNAME ")"); + f->maxstacksize=2; + f->is_vararg = VARARG_ISVARARG; + pc=3*n+1; + f->code=luaM_newvector(L,pc,Instruction); + f->sizecode=pc; + f->p=luaM_newvector(L,n,Proto*); + f->sizep=n; + pc=0; + for (i=0; ip[i]=toproto(L,i-n-1); + f->code[pc++]=CREATE_ABx(OP_CLOSURE,0,i); + f->code[pc++]=CREATE_ABx(OP_VARARG,1,0); + f->code[pc++]=CREATE_ABC(OP_CALL,0,0,1); + } + f->code[pc++]=CREATE_ABC(OP_RETURN,0,1,0); + return f; + } +#undef toproto +} + +/* Callback for luaU_dump(), so that bytecode is saved in a file. */ +static int writer(lua_State* L, const void* p, size_t size, void* u) +{ + UNUSED(L); + return (fwrite(p,size,1,(FILE*)u)!=1) && (size!=0); +} + +struct Smain { + int argc; + char** argv; +}; + +/* Called by main(): + * - after option arguments have been removed from argc/argv + * - with a properly setup lua_State + * - in a cpcall(), so that errors are caught properly + * argc & argv are passed on the lua state, in a userdata structure + * kept on the C stack in main()'s frame. + */ +static int pmain(lua_State* L) +{ + struct Smain* s = (struct Smain*)lua_touserdata(L, 1); + int argc=s->argc; + char** argv=s->argv; + const Proto* f; + int i; + + if (!lua_checkstack(L,argc)) fatal("too many input files"); + + for (i=0; i1); + if (dumping) + { + FILE* D= (output==NULL) ? stdout : fopen(output,"wb"); + if (D==NULL) cannot("open"); + lua_lock(L); + luaU_dump(L,f,writer,D,stripping); + lua_unlock(L); + if (ferror(D)) cannot("write"); + if (fclose(D)) cannot("close"); + } + return 0; +} + +int main(int argc, char* argv[]) +{ + lua_State* L; + struct Smain s; + int i=doargs(argc,argv); + argc-=i; argv+=i; + if (argc<=0) usage("no input files given"); + L=lua_open(); + if (L==NULL) fatal("not enough memory for state"); + s.argc=argc; + s.argv=argv; + if (lua_cpcall(L,pmain,&s)!=0) fatal(lua_tostring(L,-1)); + lua_close(L); + return EXIT_SUCCESS; +} diff --git a/src/lua-vm/mlr.c b/src/lua-vm/mlr.c new file mode 100644 index 0000000..68993d1 --- /dev/null +++ b/src/lua-vm/mlr.c @@ -0,0 +1,391 @@ +/* +** $Id: lua.c,v 1.160 2006/06/02 15:34:00 roberto Exp $ +** Lua stand-alone interpreter +** See Copyright Notice in lua.h +*/ + + +#include +#include +#include +#include + +#define lua_c + +#include "lua.h" + +#include "lauxlib.h" +#include "lualib.h" + + + +static lua_State *globalL = NULL; + +static const char *progname = LUA_PROGNAME; + + + +static void lstop (lua_State *L, lua_Debug *ar) { + (void)ar; /* unused arg. */ + lua_sethook(L, NULL, 0, 0); + luaL_error(L, "interrupted!"); +} + + +static void laction (int i) { + signal(i, SIG_DFL); /* if another SIGINT happens before lstop, + terminate process (default action) */ + lua_sethook(globalL, lstop, LUA_MASKCALL | LUA_MASKRET | LUA_MASKCOUNT, 1); +} + + +static void print_usage (void) { + fprintf(stderr, + "usage: %s [options] [script [args]].\n" + "Available options are:\n" + " -e stat execute string " LUA_QL("stat") "\n" + " -l name require library " LUA_QL("name") "\n" + " -i enter interactive mode after executing " LUA_QL("script") "\n" + " -v show version information\n" + " -- stop handling options\n" + " - execute stdin and stop handling options\n" + , + progname); + fflush(stderr); +} + + +static void l_message (const char *pname, const char *msg) { + if (pname) fprintf(stderr, "%s: ", pname); + fprintf(stderr, "%s\n", msg); + fflush(stderr); +} + + +static int report (lua_State *L, int status) { + if (status && !lua_isnil(L, -1)) { + const char *msg = lua_tostring(L, -1); + if (msg == NULL) msg = "(error object is not a string)"; + l_message(progname, msg); + lua_pop(L, 1); + } + return status; +} + + +static int traceback (lua_State *L) { + lua_getfield(L, LUA_GLOBALSINDEX, "debug"); + if (!lua_istable(L, -1)) { + lua_pop(L, 1); + return 1; + } + lua_getfield(L, -1, "traceback"); + if (!lua_isfunction(L, -1)) { + lua_pop(L, 2); + return 1; + } + lua_pushvalue(L, 1); /* pass error message */ + lua_pushinteger(L, 2); /* skip this function and traceback */ + lua_call(L, 2, 1); /* call debug.traceback */ + return 1; +} + + +static int docall (lua_State *L, int narg, int clear) { + int status; + int base = lua_gettop(L) - narg; /* function index */ + lua_pushcfunction(L, traceback); /* push traceback function */ + lua_insert(L, base); /* put it under chunk and args */ + signal(SIGINT, laction); + status = lua_pcall(L, narg, (clear ? 0 : LUA_MULTRET), base); + signal(SIGINT, SIG_DFL); + lua_remove(L, base); /* remove traceback function */ + /* force a complete garbage collection in case of errors */ + if (status != 0) lua_gc(L, LUA_GCCOLLECT, 0); + return status; +} + + +static void print_version (void) { + l_message(NULL, LUA_RELEASE " " LUA_COPYRIGHT); +} + + +static int getargs (lua_State *L, char **argv, int n) { + int narg; + int i; + int argc = 0; + while (argv[argc]) argc++; /* count total number of arguments */ + narg = argc - (n + 1); /* number of arguments to the script */ + luaL_checkstack(L, narg + 3, "too many arguments to script"); + for (i=n+1; i < argc; i++) + lua_pushstring(L, argv[i]); + lua_createtable(L, narg, n + 1); + for (i=0; i < argc; i++) { + lua_pushstring(L, argv[i]); + lua_rawseti(L, -2, i - n); + } + return narg; +} + + +static int dofile (lua_State *L, const char *name) { + int status = luaL_loadfile(L, name) || docall(L, 0, 1); + return report(L, status); +} + + +static int dostring (lua_State *L, const char *s, const char *name) { + int status = luaL_loadstring(L, s) || docall(L, 0, 1); + return report(L, status); +} + + +static int dolibrary (lua_State *L, const char *name) { + lua_getglobal(L, "require"); + lua_pushstring(L, name); + return report(L, lua_pcall(L, 1, 0, 0)); +} + + +static const char *get_prompt (lua_State *L, int firstline) { + const char *p; + lua_getfield(L, LUA_GLOBALSINDEX, firstline ? "_PROMPT" : "_PROMPT2"); + p = lua_tostring(L, -1); + if (p == NULL) p = (firstline ? LUA_PROMPT : LUA_PROMPT2); + lua_pop(L, 1); /* remove global */ + return p; +} + + +static int incomplete (lua_State *L, int status) { + if (status == LUA_ERRSYNTAX) { + size_t lmsg; + const char *msg = lua_tolstring(L, -1, &lmsg); + const char *tp = msg + lmsg - (sizeof(LUA_QL("")) - 1); + if (strstr(msg, LUA_QL("")) == tp) { + lua_pop(L, 1); + return 1; + } + } + return 0; /* else... */ +} + + +static int pushline (lua_State *L, int firstline) { + char buffer[LUA_MAXINPUT]; + char *b = buffer; + size_t l; + const char *prmt = get_prompt(L, firstline); + if (lua_readline(L, b, prmt) == 0) + return 0; /* no input */ + l = strlen(b); + if (l > 0 && b[l-1] == '\n') /* line ends with newline? */ + b[l-1] = '\0'; /* remove it */ + if (firstline && b[0] == '=') /* first line starts with `=' ? */ + lua_pushfstring(L, "return %s", b+1); /* change it to `return' */ + else + lua_pushstring(L, b); + lua_freeline(L, b); + return 1; +} + + +static int loadline (lua_State *L) { + int status; + lua_settop(L, 0); + if (!pushline(L, 1)) + return -1; /* no input */ + for (;;) { /* repeat until gets a complete line */ + status = luaL_loadstring(L, lua_tostring(L, 1)); + if (!incomplete(L, status)) break; /* cannot try to add lines? */ + if (!pushline(L, 0)) /* no more input? */ + return -1; + lua_pushliteral(L, "\n"); /* add a new line... */ + lua_insert(L, -2); /* ...between the two lines */ + lua_concat(L, 3); /* join them */ + } + lua_saveline(L, 1); + lua_remove(L, 1); /* remove line */ + return status; +} + + +/* Execute the interactive loop on the terminal. */ +static void dotty (lua_State *L) { + int status; + const char *oldprogname = progname; + progname = NULL; + while ((status = loadline(L)) != -1) { + if (status == 0) status = docall(L, 0, 0); + report(L, status); + if (status == 0 && lua_gettop(L) > 0) { /* any result to print? */ + lua_getglobal(L, "print"); + lua_insert(L, 1); + if (lua_pcall(L, lua_gettop(L)-1, 0, 0) != 0) + l_message(progname, lua_pushfstring(L, + "error calling " LUA_QL("print") " (%s)", + lua_tostring(L, -1))); + } + } + lua_settop(L, 0); /* clear stack */ + fputs("\n", stdout); + fflush(stdout); + progname = oldprogname; +} + + +static int handle_script (lua_State *L, char **argv, int n) { + int status; + const char *fname; + int narg = getargs(L, argv, n); /* collect arguments */ + lua_setglobal(L, "arg"); + fname = argv[n]; + if (strcmp(fname, "-") == 0 && strcmp(argv[n-1], "--") != 0) + fname = NULL; /* stdin */ + status = luaL_loadfile(L, fname); + lua_insert(L, -(narg+1)); + if (status == 0) + status = docall(L, narg, 0); + else + lua_pop(L, narg); + return report(L, status); +} + + +/* check that argument has no extra characters at the end */ +#define notail(x) {if ((x)[2] != '\0') return -1;} + + +static int collectargs (char **argv, int *pi, int *pv, int *pe) { + int i; + for (i = 1; argv[i] != NULL; i++) { + if (argv[i][0] != '-') /* not an option? */ + return i; + switch (argv[i][1]) { /* option */ + case '-': + notail(argv[i]); + return (argv[i+1] != NULL ? i+1 : 0); + case '\0': + return i; + case 'i': + notail(argv[i]); + *pi = 1; /* go through */ + case 'v': + notail(argv[i]); + *pv = 1; + break; + case 'e': + *pe = 1; /* go through */ + case 'l': + if (argv[i][2] == '\0') { + i++; + if (argv[i] == NULL) return -1; + } + break; + default: return -1; /* invalid option */ + } + } + return 0; +} + + +static int runargs (lua_State *L, char **argv, int n) { + int i; + for (i = 1; i < n; i++) { + if (argv[i] == NULL) continue; + lua_assert(argv[i][0] == '-'); + switch (argv[i][1]) { /* option */ + case 'e': { + const char *chunk = argv[i] + 2; + if (*chunk == '\0') chunk = argv[++i]; + lua_assert(chunk != NULL); + if (dostring(L, chunk, "=(command line)") != 0) + return 1; + break; + } + case 'l': { + const char *filename = argv[i] + 2; + if (*filename == '\0') filename = argv[++i]; + lua_assert(filename != NULL); + if (dolibrary(L, filename)) + return 1; /* stop if file fails */ + break; + } + default: break; + } + } + return 0; +} + + +static int handle_luainit (lua_State *L) { + const char *init = getenv(LUA_INIT); + if (init == NULL) return 0; /* status OK */ + else if (init[0] == '@') + return dofile(L, init+1); + else + return dostring(L, init, "=" LUA_INIT); +} + + +struct Smain { + int argc; + char **argv; + int status; +}; + + +static int pmain (lua_State *L) { + struct Smain *s = (struct Smain *)lua_touserdata(L, 1); + char **argv = s->argv; + int script; + int has_i = 0, has_v = 0, has_e = 0; + globalL = L; + if (argv[0] && argv[0][0]) progname = argv[0]; + lua_gc(L, LUA_GCSTOP, 0); /* stop collector during initialization */ + luaL_openlibs(L); /* open libraries */ + lua_gc(L, LUA_GCRESTART, 0); + s->status = handle_luainit(L); + if (s->status != 0) return 0; + script = collectargs(argv, &has_i, &has_v, &has_e); + if (script < 0) { /* invalid args? */ + print_usage(); + s->status = 1; + return 0; + } + if (has_v) print_version(); + s->status = runargs(L, argv, (script > 0) ? script : s->argc); + if (s->status != 0) return 0; + if (script) + s->status = handle_script(L, argv, script); + if (s->status != 0) return 0; + if (has_i) + dotty(L); + else if (script == 0 && !has_e && !has_v) { + if (lua_stdin_is_tty()) { + print_version(); + dotty(L); + } + else dofile(L, NULL); /* executes stdin as a file */ + } + return 0; +} + + +int main (int argc, char **argv) { + int status; + struct Smain s; + lua_State *L = lua_open(); /* create state */ + if (L == NULL) { + l_message(argv[0], "cannot create state: not enough memory"); + return EXIT_FAILURE; + } + s.argc = argc; + s.argv = argv; + status = lua_cpcall(L, &pmain, &s); + report(L, status); + lua_close(L); + return (status || s.status) ? EXIT_FAILURE : EXIT_SUCCESS; +} + diff --git a/src/lua-vm/path_defaults.h b/src/lua-vm/path_defaults.h new file mode 100644 index 0000000..b35676c --- /dev/null +++ b/src/lua-vm/path_defaults.h @@ -0,0 +1,6 @@ +/* Generated by the Makefile, dont edit manually */ +#define LUA_INIT "METALUA_INIT" +#define LUA_PATH "METALUA_PATH" +#define LUA_CPATH "METALUA_CPATH" +#define LUA_PATH_DEFAULT "./?.lua;/tmp/lua/?.lua;./?.luac;/tmp/lua/?.luac" +#define LUA_CPATH_DEFAULT "/tmp/lua/?.dylib;/tmp/lua/?/linit.dylib" diff --git a/src/lua-vm/print.c b/src/lua-vm/print.c new file mode 100644 index 0000000..e240cfc --- /dev/null +++ b/src/lua-vm/print.c @@ -0,0 +1,227 @@ +/* +** $Id: print.c,v 1.55a 2006/05/31 13:30:05 lhf Exp $ +** print bytecodes +** See Copyright Notice in lua.h +*/ + +#include +#include + +#define luac_c +#define LUA_CORE + +#include "ldebug.h" +#include "lobject.h" +#include "lopcodes.h" +#include "lundump.h" + +#define PrintFunction luaU_print + +#define Sizeof(x) ((int)sizeof(x)) +#define VOID(p) ((const void*)(p)) + +static void PrintString(const TString* ts) +{ + const char* s=getstr(ts); + size_t i,n=ts->tsv.len; + putchar('"'); + for (i=0; ik[i]; + switch (ttype(o)) + { + case LUA_TNIL: + printf("nil"); + break; + case LUA_TBOOLEAN: + printf(bvalue(o) ? "true" : "false"); + break; + case LUA_TNUMBER: + printf(LUA_NUMBER_FMT,nvalue(o)); + break; + case LUA_TSTRING: + PrintString(rawtsvalue(o)); + break; + default: /* cannot happen */ + printf("? type=%d",ttype(o)); + break; + } +} + +static void PrintCode(const Proto* f) +{ + const Instruction* code=f->code; + int pc,n=f->sizecode; + for (pc=0; pc0) printf("[%d]\t",line); else printf("[-]\t"); + printf("%-9s\t",luaP_opnames[o]); + switch (getOpMode(o)) + { + case iABC: + printf("%d",a); + if (getBMode(o)!=OpArgN) printf(" %d",ISK(b) ? (-1-INDEXK(b)) : b); + if (getCMode(o)!=OpArgN) printf(" %d",ISK(c) ? (-1-INDEXK(c)) : c); + break; + case iABx: + if (getBMode(o)==OpArgK) printf("%d %d",a,-1-bx); else printf("%d %d",a,bx); + break; + case iAsBx: + if (o==OP_JMP) printf("%d",sbx); else printf("%d %d",a,sbx); + break; + } + switch (o) + { + case OP_LOADK: + printf("\t; "); PrintConstant(f,bx); + break; + case OP_GETUPVAL: + case OP_SETUPVAL: + printf("\t; %s", (f->sizeupvalues>0) ? getstr(f->upvalues[b]) : "-"); + break; + case OP_GETGLOBAL: + case OP_SETGLOBAL: + printf("\t; %s",svalue(&f->k[bx])); + break; + case OP_GETTABLE: + case OP_SELF: + if (ISK(c)) { printf("\t; "); PrintConstant(f,INDEXK(c)); } + break; + case OP_SETTABLE: + case OP_ADD: + case OP_SUB: + case OP_MUL: + case OP_DIV: + case OP_POW: + case OP_EQ: + case OP_LT: + case OP_LE: + if (ISK(b) || ISK(c)) + { + printf("\t; "); + if (ISK(b)) PrintConstant(f,INDEXK(b)); else printf("-"); + printf(" "); + if (ISK(c)) PrintConstant(f,INDEXK(c)); else printf("-"); + } + break; + case OP_JMP: + case OP_FORLOOP: + case OP_FORPREP: + printf("\t; to %d",sbx+pc+2); + break; + case OP_CLOSURE: + printf("\t; %p",VOID(f->p[bx])); + break; + case OP_SETLIST: + if (c==0) printf("\t; %d",(int)code[++pc]); + else printf("\t; %d",c); + break; + default: + break; + } + printf("\n"); + } +} + +#define SS(x) (x==1)?"":"s" +#define S(x) x,SS(x) + +static void PrintHeader(const Proto* f) +{ + const char* s=getstr(f->source); + if (*s=='@' || *s=='=') + s++; + else if (*s==LUA_SIGNATURE[0]) + s="(bstring)"; + else + s="(string)"; + printf("\n%s <%s:%d,%d> (%d instruction%s, %d bytes at %p)\n", + (f->linedefined==0)?"main":"function",s, + f->linedefined,f->lastlinedefined, + S(f->sizecode),f->sizecode*Sizeof(Instruction),VOID(f)); + printf("%d%s param%s, %d slot%s, %d upvalue%s, ", + f->numparams,f->is_vararg?"+":"",SS(f->numparams), + S(f->maxstacksize),S(f->nups)); + printf("%d local%s, %d constant%s, %d function%s\n", + S(f->sizelocvars),S(f->sizek),S(f->sizep)); +} + +static void PrintConstants(const Proto* f) +{ + int i,n=f->sizek; + printf("constants (%d) for %p:\n",n,VOID(f)); + for (i=0; isizelocvars; + printf("locals (%d) for %p:\n",n,VOID(f)); + for (i=0; ilocvars[i].varname),f->locvars[i].startpc+1,f->locvars[i].endpc+1); + } +} + +static void PrintUpvalues(const Proto* f) +{ + int i,n=f->sizeupvalues; + printf("upvalues (%d) for %p:\n",n,VOID(f)); + if (f->upvalues==NULL) return; + for (i=0; iupvalues[i])); + } +} + +void PrintFunction(const Proto* f, int full) +{ + int i,n=f->sizep; + PrintHeader(f); + PrintCode(f); + if (full) + { + PrintConstants(f); + PrintLocals(f); + PrintUpvalues(f); + } + for (i=0; ip[i],full); +} diff --git a/src/pluto/CHANGELOG b/src/pluto/CHANGELOG new file mode 100644 index 0000000..dd17e64 --- /dev/null +++ b/src/pluto/CHANGELOG @@ -0,0 +1,10 @@ +$Id$ + +This changelog is maintained as of version 2.0alpha1. +Earlier versions are changelogged on the LuaForge site. + +-- 2.0alpha1 -- +* Fixed all outstanding 5.0->5.1 conversion issues +* Made heavier use of size_t in preference to int +* Fixed GC/Upval issue (thanks to Eric Jacobs) + diff --git a/src/pluto/FILEFORMAT b/src/pluto/FILEFORMAT new file mode 100644 index 0000000..6b12639 --- /dev/null +++ b/src/pluto/FILEFORMAT @@ -0,0 +1,150 @@ +$Id$ + +pluto_persist() produces a "hunk" of objects. Here's the file format adhered +to by the function, and expected by pluto_unpersist(). + +As a developer, I feel that where file format information is given it is of +utmost importance that that information precisely and accurately reflects the +actual operation of the application. Therefore, if you find any discrepancy +between this and actual operation, please lambast me thoroughly over email. + +Pseudo-C is used to express the file format. Padding is assumed to be +nonexistent. The keyword "one_of" is used to express a concept similar to +"union", except that its size is the size of the actual datatype chosen. Thus, +objects which contain, directly or indirectly, a one_of, may vary in size. + + +struct Object { + int firstTime; /* Whether this is the first time the object + is being referenced */ + one_of { + RealObject o; /* if firstTime == 1 */ + Reference r; /* if firstTime == 0 */ + }; +}; + +struct Reference { + int ref; /* The index the object was registered with */ +}; + +struct RealObject { + int type; /* The type of the object */ + one_of { + Boolean b; /* If type == LUA_TBOOLEAN */ + LightUserData l; /* If type == LUA_TLIGHTUSERDATA */ + Number n; /* If type == LUA_TNUMBER */ + String s; /* If type == LUA_TSTRING */ + Table t; /* If type == LUA_TTABLE */ + Function f; /* If type == LUA_TFUNCTION */ + Userdata u; /* If type == LUA_TUSERDATA */ + Thread th; /* If type == LUA_TTHREAD */ + Proto p; /* If type == LUA_TPROTO (from lobject.h) */ + Upval uv; /* If type == LUA_TUPVAL (from lobject.h) */ + }; /* The actual object */ +}; + +struct Boolean { + int32 bvalue; /* 0 for false, 1 for true */ +}; + +struct LightUserData { + void* luvalue; /* The actual, literal pointer */ +}; + +struct Number { + lua_Number nvalue; /* The actual number */ +}; + +struct String { + int length; /* The length of the string */ + char str[length]; /* The actual string (not null terminated) */ +}; + +struct Table { + int isspecial; /* 1 if SP is used; 0 otherwise */ + one_of { + Closure c; /* if isspecial == 1; closure to refill the table */ + LiteralTable t; /* if isspecial == 0; literal table info */ + }; +}; + +struct LiteralTable { + Object metatable; /* nil for default metatable */ + Pair p[]; /* key/value pairs */ + Object nil = nil; /* Nil reference to terminate */ +}; + +struct Pair { + Object key; + Object value; +}; + +struct Function { /* Actually a closure */ + lu_byte nups; /* Number of upvalues the function uses */ + Object proto; /* The proto this function uses */ + Object upvals[nups]; /* All upvalues */ + Object fenv; /* The FEnv (nil for the global table) +}; + +struct Upval { + Object obj; /* The object this upval refers to */ +} + +struct Userdata { + int isSpecial; /* 1 for special persistence, 0 for literal + one_of { + LiteralUserdata lu; /* if is_special is 0 */ + SpecialUserdata su; /* if is_special is 1 */ + }; +}; + +struct LiteralUserdata { + Object metatable; /* The metatable (nil for default) */ + int length; /* Size of the data */ + char data[length]; /* The actual data */ +}; + +struct SpecialUserdata { + int length; /* The size of the data */ + Object func; /* The closure used to fill the userdata */ +}; + +struct Thread { + int stacksize; /* The size of the stack filled with objects, + * including the "nil" that is hidden below + * the bottom of the stack visible to C */ + Object stack[stacksize];/* Indices of all stack values, bottom up */ + int callinfosize; /* Number of elements in the CallInfo stack */ + CallInfo callinfostack[callinfosize]; /* The CallInfo stack */ + int base; /* base = L->base - L->stack; */ + int top; /* top = L->top - L->stack; */ + OpenUpval openupvals[]; /* Upvalues to open */ + Object nil = nil; /* To terminate the open upvalues list */ +}; + +struct OpenUpval { + Object upval; /* The upvalue */ + int stackpos; /* The stack position to "reopen" it to */ + +}; + +struct CallInfo { + int base; /* base = ci->base - L->stack; */ + int top; /* top = ci->top - L->stack; */ + int pc; /* pc = ci->pc - proto->code; */ + int state; /* flags used by the CallInfo */ +}; + +struct Proto { + int sizek; /* Number of constants referenced */ + Object k[sizek]; /* Constants referenced */ + int sizep; /* Number of inner Protos referenced */ + Object p[sizep]; /* Inner Protos referenced */ + int sizecode; /* Number of instructions in code */ + Instruction code[sizecode]; /* The proto's code */ + lu_byte nups; /* Number of upvalues used */ + lu_byte numparams; /* Number of parameters taken */ + lu_byte is_vararg; /* 1 if function accepts varargs, 0 otherwise */ + lu_byte maxstacksize; /* Size of stack reserved for the function */ +}; + diff --git a/src/pluto/Makefile b/src/pluto/Makefile new file mode 100644 index 0000000..ac94450 --- /dev/null +++ b/src/pluto/Makefile @@ -0,0 +1,9 @@ +include ../common.mk + +all: pluto.$(LIBEXT) + cp $+ $(TARGET_LUA_CPATH) + +macosx: all + +pluto.$(LIBEXT): pluto.$(OBJEXT) + $(MKLIB) -o $@ $+ diff --git a/src/pluto/README b/src/pluto/README new file mode 100644 index 0000000..7a4dd1e --- /dev/null +++ b/src/pluto/README @@ -0,0 +1,129 @@ +$Id$ + +PLUTO - Heavy duty persistence for Lua + +Pluto is a library which allows users to write arbitrarily large portions +of the "Lua universe" into a flat file, and later read them back into the +same or a different Lua universe. Object references are appropriately +handled, such that the file contains everything needed to recreate the +objects in question. + +Pluto has the following major features: +* Can persist any Lua function +* Can persist threads +* Works with any Lua chunkreader/chunkwriter +* Support for "invariant" permanent objects, of all datatypes +* Can invoke metafunctions for custom persistence of tables and userdata + +Pluto 2.0 requires Lua 5.1 or later. If you need to use Pluto with Lua +5.0, please use version 1.2 of Pluto. + +Pluto may have bugs. Users are advised to define lua_assert in +luaconf.h to something useful when compiling in debug mode, to catch +assertions by Pluto and Lua. + +The Pluto library consists of two public functions. + +int pluto_persist(lua_State *L, lua_Chunkwriter writer, void *ud) + +This function recursively persists the Lua object in stack position 2 +and all other objects which are directly or indirectly referenced by +it, except those referenced in the permanent object table. The data +is written using the chunk-writer given, and that writer is passed +the arbitrary pointer value ud. + +The Lua stack must contain exactly and only these two items, in order: + +1. A table of permanent objects, that should not be persisted. For each +permanent object, the object itself should be the key, and a unique +object of any type should be the value. Likely candidates for this table +include Lua functions (including those in the Lua libraries) that are +loaded at load-time. It must include all non-persistable objects that +are referenced by the object to be persisted. The table is not modified +by the function. Objects in this table are considered "opaque" and are +not examined or descended into. Objects should not appear in the table +multiple times; the result of doing this is undefined (though probably +harmless). NOTE: If you are planning to persist threads, keep in mind +that all yielded threads have coroutine.yield on the tops of their +stacks. Since it's a C function, it should be put here. For complex +permanents, it may be a good idea to use the __index meta-function of +the permanents table to "search" for permanents. + +2. The single object to be persisted. In many cases, this will be the +global table. For more flexibility, however, it may be something like a +table built for the occasion, with various values to keep track of. The +object may not be nil. + + +int pluto_unpersist(lua_State *L, lua_Chunkreader reader, void *ud) + +This function loads in a Lua object and places it on top of the stack. All +objects directly or indirectly referenced by it are also loaded. + +The Lua stack must contain, as its top value, a table of permanent +objects. This table should be like the permanent object table used when +persisting, but with the key and value of each pair reversed. These +objects are used as substitutes for those referenced in their positions +when persisting, and under most circumstances should be identical objects +to those referenced in the permanents table used for persisting. It's +okay for multiple keys to refer to the same object. + + +RUNNING PLUTO FROM LUA: +It is also possible to invoke pluto from a Lua script. The C function +pluto_open() will register pluto.persist and pluto.unpersist, lua functions +which operate on strings. The first takes a permanents table and a root +object, and returns a string; the second takes a permanents table and a +string, and returns the root object. + +An error will be raised if pluto.persist is called from a thread which is +itself referenced by the root object. + +SPECIAL PERSISTENCE: +Tables and userdata have special persistence semantics. These semantics are +keyed to the value of the object's metatable's __persist member, if any. This +member may be any of the following four values: +1. Boolean "true": The table or userdata is persisted literally; tables are +persisted member-by-member, and userdata are written out as literal data. +2. Boolean "false": An error is returned, indicating that the object cannot +be persisted. +3. A function: This function should take one argument, the object in question, +and return one result, a closure. This "fixup closure", in turn, will be +persisted, and during unpersistence will be called. The closure will be +responsible for recreating the object with the appropriate data, based on +its upvalues. +4. Nil, or no metatable. In the case of tables, the table is literally +persisted. In the case of userdata, an error is returned. + +Here's an example of special persistence for a simple 3d vector object: + +vec = { x = 2, y = 1, z = 4 } +setmetatable(vec, { __persist = function(oldtbl) + local x = oldtbl.x + local y = oldtbl.y + local z = oldtbl.z + local mt = getmetatable(oldtbl) + return function() + newtbl = {} + newtbl.x = x + newtbl.y = y + newtbl.z = z + setmetatable(newtbl, mt) + return newtbl + end +end }) + +Note how x, y, z, and the mt are explicitly pulled out of the table. It is +important that the fixup closure returned not reference the original table +directly, as that table would again be persisted as an upvalue, leading to an +infinite loop. Also note that the object's metatable is NOT automatically +persisted; it is necessary for the fixup closure to reset it, if it wants. + +LIMITATIONS/TODO: +* Light userdata are persisted literally, as their pointer values. This +may or may not be what you want. +* Closures of C functions may not be persisted. Once it becomes possible +to specify a C function "proto" as a permanent object, this restriction +will be relaxed. + +BUGS: None known. Emphasis on the 'known'. diff --git a/src/pluto/pluto.c b/src/pluto/pluto.c new file mode 100644 index 0000000..555a634 --- /dev/null +++ b/src/pluto/pluto.c @@ -0,0 +1,1487 @@ +/* $Id$ */ + +/* Pluto - Heavy-duty persistence for Lua + * Copyright (C) 2004 by Ben Sunshine-Hill, and released into the public + * domain. People making use of this software as part of an application + * are politely requested to email the author at sneftel@gmail.com + * with a brief description of the application, primarily to satisfy his + * curiosity. + * + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, + * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF + * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. + * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY + * CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, + * TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE + * SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + */ + +#include "lua.h" +#include "pluto.h" + +#include "lapi.h" +#include "ldo.h" +#include "lfunc.h" +#include "lgc.h" +#include "llimits.h" +#include "lmem.h" +#include "lobject.h" +#include "lopcodes.h" +#include "lstate.h" +#include "lstring.h" +#include "lauxlib.h" + + + + +/* #define PLUTO_DEBUG */ + + + + +#ifdef PLUTO_DEBUG +#include +#endif + +#define PLUTO_TPERMANENT 101 + +#define verify(x) { int v = (int)((x)); lua_assert(v); } + +typedef struct PersistInfo_t { + lua_State *L; + int counter; + lua_Chunkwriter writer; + void *ud; +#ifdef PLUTO_DEBUG + int level; +#endif +} PersistInfo; + +#ifdef PLUTO_DEBUG +void printindent(int indent) +{ + int il; + for(il=0; il 0) { + lua_assert(L->base+stackpos-1 < L->top); + return L->base+stackpos-1; + } else { + lua_assert(L->top-stackpos >= L->base); + return L->top+stackpos; + } +} + +/* Choose whether to do a regular or special persistence based on an object's + * metatable. "default" is whether the object, if it doesn't have a __persist + * entry, is literally persistable or not. + * Pushes the unpersist closure and returns true if special persistence is + * used. */ +static int persistspecialobject(PersistInfo *pi, int defaction) +{ + /* perms reftbl ... obj */ + /* Check whether we should persist literally, or via the __persist + * metafunction */ + if(!lua_getmetatable(pi->L, -1)) { + if(defaction) { + { + int zero = 0; + pi->writer(pi->L, &zero, sizeof(int), pi->ud); + } + return 0; + } else { + lua_pushstring(pi->L, "Type not literally persistable by default"); + lua_error(pi->L); + } + } + /* perms reftbl sptbl ... obj mt */ + lua_pushstring(pi->L, "__persist"); + /* perms reftbl sptbl ... obj mt "__persist" */ + lua_rawget(pi->L, -2); + /* perms reftbl sptbl ... obj mt __persist? */ + if(lua_isnil(pi->L, -1)) { + /* perms reftbl sptbl ... obj mt nil */ + lua_pop(pi->L, 2); + /* perms reftbl sptbl ... obj */ + if(defaction) { + { + int zero = 0; + pi->writer(pi->L, &zero, sizeof(int), pi->ud); + } + return 0; + } else { + lua_pushstring(pi->L, "Type not literally persistable by default"); + lua_error(pi->L); + return 0; /* not reached */ + } + } else if(lua_isboolean(pi->L, -1)) { + /* perms reftbl sptbl ... obj mt bool */ + if(lua_toboolean(pi->L, -1)) { + /* perms reftbl sptbl ... obj mt true */ + lua_pop(pi->L, 2); + /* perms reftbl sptbl ... obj */ + { + int zero = 0; + pi->writer(pi->L, &zero, sizeof(int), pi->ud); + } + return 0; + } else { + lua_pushstring(pi->L, "Metatable forbade persistence"); + lua_error(pi->L); + return 0; /* not reached */ + } + } else if(!lua_isfunction(pi->L, -1)) { + lua_pushstring(pi->L, "__persist not nil, boolean, or function"); + lua_error(pi->L); + } + /* perms reftbl ... obj mt __persist */ + lua_pushvalue(pi->L, -3); + /* perms reftbl ... obj mt __persist obj */ +#ifdef PLUTO_PASS_USERDATA_TO_PERSIST + lua_pushlightuserdata(pi->L, (void*)pi->writer); + lua_pushlightuserdata(pi->L, pi->ud); + /* perms reftbl ... obj mt __persist obj ud */ + lua_call(pi->L, 3, 1); + /* perms reftbl ... obj mt func? */ +#else + lua_call(pi->L, 1, 1); + /* perms reftbl ... obj mt func? */ +#endif + /* perms reftbl ... obj mt func? */ + if(!lua_isfunction(pi->L, -1)) { + lua_pushstring(pi->L, "__persist function did not return a function"); + lua_error(pi->L); + } + /* perms reftbl ... obj mt func */ + { + int one = 1; + pi->writer(pi->L, &one, sizeof(int), pi->ud); + } + persist(pi); + /* perms reftbl ... obj mt func */ + lua_pop(pi->L, 2); + /* perms reftbl ... obj */ + return 1; +} + +static void persisttable(PersistInfo *pi) +{ + /* perms reftbl ... tbl */ + if(persistspecialobject(pi, 1)) { + /* perms reftbl ... tbl */ + return; + } + /* perms reftbl ... tbl */ + /* First, persist the metatable (if any) */ + if(!lua_getmetatable(pi->L, -1)) { + lua_pushnil(pi->L); + } + /* perms reftbl ... tbl mt/nil */ + persist(pi); + lua_pop(pi->L, 1); + /* perms reftbl ... tbl */ + + /* Now, persist all k/v pairs */ + lua_pushnil(pi->L); + /* perms reftbl ... tbl nil */ + while(lua_next(pi->L, -2)) { + /* perms reftbl ... tbl k v */ + lua_pushvalue(pi->L, -2); + /* perms reftbl ... tbl k v k */ + persist(pi); + lua_pop(pi->L, 1); + /* perms reftbl ... tbl k v */ + persist(pi); + lua_pop(pi->L, 1); + /* perms reftbl ... tbl k */ + } + /* perms reftbl ... tbl */ + /* Terminate list */ + lua_pushnil(pi->L); + /* perms reftbl ... tbl nil */ + persist(pi); + lua_pop(pi->L, 1); + /* perms reftbl ... tbl */ +} + +static void persistuserdata(PersistInfo *pi) { + /* perms reftbl ... udata */ + if(persistspecialobject(pi, 0)) { + /* perms reftbl ... udata */ + return; + } else { + /* Use literal persistence */ + size_t length = uvalue(getobject(pi->L, -1))->len; + pi->writer(pi->L, &length, sizeof(size_t), pi->ud); + pi->writer(pi->L, lua_touserdata(pi->L, -1), length, pi->ud); + if(!lua_getmetatable(pi->L, -1)) { + /* perms reftbl ... udata */ + lua_pushnil(pi->L); + /* perms reftbl ... udata mt/nil */ + } + persist(pi); + lua_pop(pi->L, 1); + /* perms reftbl ... udata */ + } +} + + +static Proto *toproto(lua_State *L, int stackpos) +{ + return gco2p(getobject(L, stackpos)->value.gc); +} + +static UpVal *toupval(lua_State *L, int stackpos) +{ + return gco2uv(getobject(L, stackpos)->value.gc); +} + +static void pushproto(lua_State *L, Proto *proto) +{ + TValue o; + setptvalue(L, &o, proto); + luaA_pushobject(L, &o); +} + +#define setuvvalue(L,obj,x) \ + { TValue *i_o=(obj); \ + i_o->value.gc=cast(GCObject *, (x)); i_o->tt=LUA_TUPVAL; \ + checkliveness(G(L),i_o); } + +static void pushupval(lua_State *L, UpVal *upval) +{ + TValue o; + setuvvalue(L, &o, upval); + luaA_pushobject(L, &o); +} + +static void pushclosure(lua_State *L, Closure *closure) +{ + TValue o; + setclvalue(L, &o, closure); + luaA_pushobject(L, &o); +} + +static void persistfunction(PersistInfo *pi) +{ + /* perms reftbl ... func */ + Closure *cl = clvalue(getobject(pi->L, -1)); + if(cl->c.isC) { + /* It's a C function. For now, we aren't going to allow + * persistence of C closures, even if the "C proto" is + * already in the permanents table. */ + lua_pushstring(pi->L, "Attempt to persist a C function"); + lua_error(pi->L); + } else { + /* It's a Lua closure. */ + { + /* We don't really _NEED_ the number of upvals, + * but it'll simplify things a bit */ + pi->writer(pi->L, &cl->l.p->nups, sizeof(lu_byte), pi->ud); + } + /* Persist prototype */ + { + pushproto(pi->L, cl->l.p); + /* perms reftbl ... func proto */ + persist(pi); + lua_pop(pi->L, 1); + /* perms reftbl ... func */ + } + /* Persist upvalue values (not the upvalue objects + * themselves) */ + { + int i; + for(i=0; il.p->nups; i++) { + /* perms reftbl ... func */ + pushupval(pi->L, cl->l.upvals[i]); + /* perms reftbl ... func upval */ + persist(pi); + lua_pop(pi->L, 1); + /* perms reftbl ... func */ + } + /* perms reftbl ... func */ + } + /* Persist function environment */ + { + lua_getfenv(pi->L, -1); + /* perms reftbl ... func fenv */ + if(lua_equal(pi->L, -1, LUA_GLOBALSINDEX)) { + /* Function has the default fenv */ + /* perms reftbl ... func _G */ + lua_pop(pi->L, 1); + /* perms reftbl ... func */ + lua_pushnil(pi->L); + /* perms reftbl ... func nil */ + } + /* perms reftbl ... func fenv/nil */ + persist(pi); + lua_pop(pi->L, 1); + /* perms reftbl ... func */ + } + } +} + + +/* Upvalues are tricky. Here's why. + * + * A particular upvalue may be either "open", in which case its member v + * points into a thread's stack, or "closed" in which case it points to the + * upvalue itself. An upvalue is closed under any of the following conditions: + * -- The function that initially declared the variable "local" returns + * -- The thread in which the closure was created is garbage collected + * + * To make things wackier, just because a thread is reachable by Lua doesn't + * mean it's in our root set. We need to be able to treat an open upvalue + * from an unreachable thread as a closed upvalue. + * + * The solution: + * (a) For the purposes of persisting, don't indicate whether an upvalue is + * closed or not. + * (b) When unpersisting, pretend that all upvalues are closed. + * (c) When persisting, persist all open upvalues referenced by a thread + * that is persisted, and tag each one with the corresponding stack position + * (d) When unpersisting, "reopen" each of these upvalues as the thread is + * unpersisted + */ +static void persistupval(PersistInfo *pi) +{ + /* perms reftbl ... upval */ + UpVal *uv = toupval(pi->L, -1); + + /* We can't permit the upval to linger around on the stack, as Lua + * will bail if its GC finds it. */ + + lua_pop(pi->L, 1); + /* perms reftbl ... */ + luaA_pushobject(pi->L, uv->v); + /* perms reftbl ... obj */ + persist(pi); + /* perms reftbl ... obj */ +} + +static void persistproto(PersistInfo *pi) +{ + /* perms reftbl ... proto */ + Proto *p = toproto(pi->L, -1); + + /* Persist constant refs */ + { + int i; + pi->writer(pi->L, &p->sizek, sizeof(int), pi->ud); + for(i=0; isizek; i++) { + luaA_pushobject(pi->L, &p->k[i]); + /* perms reftbl ... proto const */ + persist(pi); + lua_pop(pi->L, 1); + /* perms reftbl ... proto */ + } + } + /* perms reftbl ... proto */ + + /* serialize inner Proto refs */ + { + int i; + pi->writer(pi->L, &p->sizep, sizeof(int), pi->ud); + for(i=0; isizep; i++) + { + pushproto(pi->L, p->p[i]); + /* perms reftbl ... proto subproto */ + persist(pi); + lua_pop(pi->L, 1); + /* perms reftbl ... proto */ + } + } + /* perms reftbl ... proto */ + /* Serialize code */ + { + pi->writer(pi->L, &p->sizecode, sizeof(int), pi->ud); + pi->writer(pi->L, p->code, sizeof(Instruction) * p->sizecode, pi->ud); + } + /* Serialize misc values */ + { + pi->writer(pi->L, &p->nups, sizeof(lu_byte), pi->ud); + pi->writer(pi->L, &p->numparams, sizeof(lu_byte), pi->ud); + pi->writer(pi->L, &p->is_vararg, sizeof(lu_byte), pi->ud); + pi->writer(pi->L, &p->maxstacksize, sizeof(lu_byte), pi->ud); + } + /* We do not currently persist upvalue names, local variable names, + * variable lifetimes, line info, or source code. */ +} + +/* Copies a stack, but the stack is reversed in the process + */ +static size_t revappendstack(lua_State *from, lua_State *to) +{ + StkId o; + for(o=from->top-1; o>=from->stack; o--) { + setobj2s(L, to->top, o); + to->top++; + } + return from->top - from->stack; +} + +/* Persist all stack members + */ +static void persistthread(PersistInfo *pi) +{ + size_t posremaining; + lua_State *L2; + /* perms reftbl ... thr */ + L2 = lua_tothread(pi->L, -1); + if(pi->L == L2) { + lua_pushstring(pi->L, "Can't persist currently running thread"); + lua_error(pi->L); + return; /* not reached */ + } + + /* Persist the stack */ + posremaining = revappendstack(L2, pi->L); + /* perms reftbl ... thr (rev'ed contents of L2) */ + pi->writer(pi->L, &posremaining, sizeof(size_t), pi->ud); + for(; posremaining > 0; posremaining--) { + persist(pi); + lua_pop(pi->L, 1); + } + /* perms reftbl ... thr */ + /* Now, persist the CallInfo stack. */ + { + size_t i, numframes = (L2->ci - L2->base_ci) + 1; + pi->writer(pi->L, &numframes, sizeof(size_t), pi->ud); + for(i=0; ibase_ci + i; + size_t stackbase = ci->base - L2->stack; + size_t stackfunc = ci->func - L2->stack; + size_t stacktop = ci->top - L2->stack; + size_t savedpc = (ci != L2->base_ci) ? + ci->savedpc - ci_func(ci)->l.p->code : + 0; + pi->writer(pi->L, &stackbase, sizeof(size_t), pi->ud); + pi->writer(pi->L, &stackfunc, sizeof(size_t), pi->ud); + pi->writer(pi->L, &stacktop, sizeof(size_t), pi->ud); + pi->writer(pi->L, &ci->nresults, sizeof(int), pi->ud); + pi->writer(pi->L, &savedpc, sizeof(size_t), pi->ud); + } + } + + /* Serialize the state's other parameters, with the exception of upval stuff */ + { + size_t stackbase = L2->base - L2->stack; + size_t stacktop = L2->top - L2->stack; + lua_assert(L2->savedpc == L2->ci->savedpc); + lua_assert(L2->nCcalls == 0); + pi->writer(pi->L, &L2->status, sizeof(lu_byte), pi->ud); + pi->writer(pi->L, &stackbase, sizeof(size_t), pi->ud); + pi->writer(pi->L, &stacktop, sizeof(size_t), pi->ud); + pi->writer(pi->L, &L2->errfunc, sizeof(ptrdiff_t), pi->ud); + } + + /* Finally, record upvalues which need to be reopened */ + /* See the comment above persistupval() for why we do this */ + { + UpVal *uv; + /* perms reftbl ... thr */ + for(uv = gco2uv(L2->openupval); uv != NULL; uv = gco2uv(uv->next)) { + size_t stackpos; + /* Make sure upvalue is really open */ + lua_assert(uv->v != &uv->value); + pushupval(pi->L, uv); + /* perms reftbl ... thr uv */ + persist(pi); + lua_pop(pi->L, 1); + /* perms reftbl ... thr */ + stackpos = uv->v - L2->stack; + pi->writer(pi->L, &stackpos, sizeof(size_t), pi->ud); + } + /* perms reftbl ... thr */ + lua_pushnil(pi->L); + /* perms reftbl ... thr nil */ + persist(pi); + lua_pop(pi->L, 1); + /* perms reftbl ... thr */ + } + /* perms reftbl ... thr */ +} + +static void persistboolean(PersistInfo *pi) +{ + int b = lua_toboolean(pi->L, -1); + pi->writer(pi->L, &b, sizeof(int), pi->ud); +} + +static void persistlightuserdata(PersistInfo *pi) +{ + void *p = lua_touserdata(pi->L, -1); + pi->writer(pi->L, &p, sizeof(void *), pi->ud); +} + +static void persistnumber(PersistInfo *pi) +{ + lua_Number n = lua_tonumber(pi->L, -1); + pi->writer(pi->L, &n, sizeof(lua_Number), pi->ud); +} + +static void persiststring(PersistInfo *pi) +{ + size_t length = lua_strlen(pi->L, -1); + pi->writer(pi->L, &length, sizeof(size_t), pi->ud); + pi->writer(pi->L, lua_tostring(pi->L, -1), length, pi->ud); +} + +/* Top-level delegating persist function + */ +static void persist(PersistInfo *pi) +{ + /* perms reftbl ... obj */ + /* If the object has already been written, write a reference to it */ + lua_pushvalue(pi->L, -1); + /* perms reftbl ... obj obj */ + lua_rawget(pi->L, 2); + /* perms reftbl ... obj ref? */ + if(!lua_isnil(pi->L, -1)) { + /* perms reftbl ... obj ref */ + int zero = 0; + int ref = (int)lua_touserdata(pi->L, -1); + pi->writer(pi->L, &zero, sizeof(int), pi->ud); + pi->writer(pi->L, &ref, sizeof(int), pi->ud); + lua_pop(pi->L, 1); + /* perms reftbl ... obj ref */ +#ifdef PLUTO_DEBUG + printindent(pi->level); + printf("0 %d\n", ref); +#endif + return; + } + /* perms reftbl ... obj nil */ + lua_pop(pi->L, 1); + /* perms reftbl ... obj */ + /* If the object is nil, write the pseudoreference 0 */ + if(lua_isnil(pi->L, -1)) { + int zero = 0; + /* firsttime */ + pi->writer(pi->L, &zero, sizeof(int), pi->ud); + /* ref */ + pi->writer(pi->L, &zero, sizeof(int), pi->ud); +#ifdef PLUTO_DEBUG + printindent(pi->level); + printf("0 0\n"); +#endif + return; + } + { + /* indicate that it's the first time */ + int one = 1; + pi->writer(pi->L, &one, sizeof(int), pi->ud); + } + lua_pushvalue(pi->L, -1); + /* perms reftbl ... obj obj */ + lua_pushlightuserdata(pi->L, (void*)(++(pi->counter))); + /* perms reftbl ... obj obj ref */ + lua_rawset(pi->L, 2); + /* perms reftbl ... obj */ + + pi->writer(pi->L, &pi->counter, sizeof(int), pi->ud); + + + /* At this point, we'll give the permanents table a chance to play. */ + { + lua_pushvalue(pi->L, -1); + /* perms reftbl ... obj obj */ + lua_gettable(pi->L, 1); + /* perms reftbl ... obj permkey? */ + if(!lua_isnil(pi->L, -1)) { + /* perms reftbl ... obj permkey */ + int type = PLUTO_TPERMANENT; +#ifdef PLUTO_DEBUG + printindent(pi->level); + printf("1 %d PERM\n", pi->counter); + pi->level++; +#endif + pi->writer(pi->L, &type, sizeof(int), pi->ud); + persist(pi); + lua_pop(pi->L, 1); + /* perms reftbl ... obj */ +#ifdef PLUTO_DEBUG + pi->level--; +#endif + return; + } else { + /* perms reftbl ... obj nil */ + lua_pop(pi->L, 1); + /* perms reftbl ... obj */ + } + /* perms reftbl ... obj */ + } + { + int type = lua_type(pi->L, -1); + pi->writer(pi->L, &type, sizeof(int), pi->ud); + +#ifdef PLUTO_DEBUG + printindent(pi->level); + printf("1 %d %d\n", pi->counter, type); + pi->level++; +#endif + } + + switch(lua_type(pi->L, -1)) { + case LUA_TBOOLEAN: + persistboolean(pi); + break; + case LUA_TLIGHTUSERDATA: + persistlightuserdata(pi); + break; + case LUA_TNUMBER: + persistnumber(pi); + break; + case LUA_TSTRING: + persiststring(pi); + break; + case LUA_TTABLE: + persisttable(pi); + break; + case LUA_TFUNCTION: + persistfunction(pi); + break; + case LUA_TTHREAD: + persistthread(pi); + break; + case LUA_TPROTO: + persistproto(pi); + break; + case LUA_TUPVAL: + persistupval(pi); + break; + case LUA_TUSERDATA: + persistuserdata(pi); + break; + default: + lua_assert(0); + } +#ifdef PLUTO_DEBUG + pi->level--; +#endif +} + +void pluto_persist(lua_State *L, lua_Chunkwriter writer, void *ud) +{ + PersistInfo pi; + + pi.counter = 0; + pi.L = L; + pi.writer = writer; + pi.ud = ud; +#ifdef PLUTO_DEBUG + pi.level = 0; +#endif + + /* perms? rootobj? ...? */ + lua_assert(lua_gettop(L) == 2); + /* perms rootobj */ + lua_assert(!lua_isnil(L, 2)); + /* perms rootobj */ + lua_newtable(L); + /* perms rootobj reftbl */ + + /* Now we're going to make the table weakly keyed. This prevents the + * GC from visiting it and trying to mark things it doesn't want to + * mark in tables, e.g. upvalues. All objects in the table are + * a priori reachable, so it doesn't matter that we do this. */ + lua_newtable(L); + /* perms rootobj reftbl mt */ + lua_pushstring(L, "__mode"); + /* perms rootobj reftbl mt "__mode" */ + lua_pushstring(L, "k"); + /* perms rootobj reftbl mt "__mode" "k" */ + lua_settable(L, 4); + /* perms rootobj reftbl mt */ + lua_setmetatable(L, 3); + /* perms rootobj reftbl */ + lua_insert(L, 2); + /* perms reftbl rootobj */ + persist(&pi); + /* perms reftbl rootobj */ + lua_remove(L, 2); + /* perms rootobj */ +} + +typedef struct WriterInfo_t { + char* buf; + size_t buflen; +} WriterInfo; + +static int bufwriter (lua_State *L, const void* p, size_t sz, void* ud) { + WriterInfo *wi = (WriterInfo *)ud; + + luaM_reallocvector(L, wi->buf, wi->buflen, wi->buflen+sz, char); + while(sz) + { + /* how dearly I love ugly C pointer twiddling */ + wi->buf[wi->buflen++] = *((const char*)p)++; + sz--; + } + return 0; +} + +int persist_l(lua_State *L) +{ + /* perms? rootobj? ...? */ + WriterInfo wi; + + wi.buf = NULL; + wi.buflen = 0; + + lua_settop(L, 2); + /* perms? rootobj? */ + luaL_checktype(L, 1, LUA_TTABLE); + /* perms rootobj? */ + luaL_checktype(L, 1, LUA_TTABLE); + /* perms rootobj */ + + pluto_persist(L, bufwriter, &wi); + + lua_settop(L, 0); + /* (empty) */ + lua_pushlstring(L, wi.buf, wi.buflen); + /* str */ + luaM_freearray(L, wi.buf, wi.buflen, char); + return 1; +} + +typedef struct UnpersistInfo_t { + lua_State *L; + ZIO zio; +#ifdef PLUTO_DEBUG + int level; +#endif +} UnpersistInfo; + +static void unpersist(UnpersistInfo *upi); + +/* The object is left on the stack. This is primarily used by unpersist, but + * may be used by GCed objects that may incur cycles in order to preregister + * the object. */ +static void registerobject(int ref, UnpersistInfo *upi) +{ + /* perms reftbl ... obj */ + lua_pushlightuserdata(upi->L, (void*)ref); + /* perms reftbl ... obj ref */ + lua_pushvalue(upi->L, -2); + /* perms reftbl ... obj ref obj */ + lua_settable(upi->L, 2); + /* perms reftbl ... obj */ +} + +static void unpersistboolean(UnpersistInfo *upi) +{ + /* perms reftbl ... */ + int b; + verify(luaZ_read(&upi->zio, &b, sizeof(int)) == 0); + lua_pushboolean(upi->L, b); + /* perms reftbl ... bool */ +} + +static void unpersistlightuserdata(UnpersistInfo *upi) +{ + /* perms reftbl ... */ + void *p; + verify(luaZ_read(&upi->zio, &p, sizeof(void *)) == 0); + lua_pushlightuserdata(upi->L, p); + /* perms reftbl ... ludata */ +} + +static void unpersistnumber(UnpersistInfo *upi) +{ + /* perms reftbl ... */ + lua_Number n; + verify(luaZ_read(&upi->zio, &n, sizeof(lua_Number)) == 0); + lua_pushnumber(upi->L, n); + /* perms reftbl ... num */ +} + +static void unpersiststring(UnpersistInfo *upi) +{ + /* perms reftbl sptbl ref */ + int length; + char* string; + verify(luaZ_read(&upi->zio, &length, sizeof(int)) == 0); + string = luaM_malloc(upi->L, length); + verify(luaZ_read(&upi->zio, string, length) == 0); + lua_pushlstring(upi->L, string, length); + /* perms reftbl sptbl ref str */ + luaM_free(upi->L, string); +} + +static void unpersistspecialtable(int ref, UnpersistInfo *upi) +{ + /* perms reftbl ... */ + unpersist(upi); + /* perms reftbl ... spfunc? */ + lua_assert(lua_isfunction(upi->L, -1)); + /* perms reftbl ... spfunc */ + lua_call(upi->L, 0, 1); + /* perms reftbl ... tbl? */ + lua_assert(lua_istable(upi->L, -1)); + /* perms reftbl ... tbl */ +} + +static void unpersistliteraltable(int ref, UnpersistInfo *upi) +{ + /* perms reftbl ... */ + /* Preregister table for handling of cycles */ + lua_newtable(upi->L); + /* perms reftbl ... tbl */ + registerobject(ref, upi); + /* perms reftbl ... tbl */ + /* Unpersist metatable */ + { + unpersist(upi); + /* perms reftbl ... tbl mt/nil? */ + if(lua_istable(upi->L, -1)) { + /* perms reftbl ... tbl mt */ + lua_setmetatable(upi->L, -2); + /* perms reftbl ... tbl */ + } else { + /* perms reftbl ... tbl nil? */ + lua_assert(lua_isnil(upi->L, -1)); + /* perms reftbl ... tbl nil */ + lua_pop(upi->L, 1); + /* perms reftbl ... tbl */ + } + /* perms reftbl ... tbl */ + } + + while(1) + { + /* perms reftbl ... tbl */ + unpersist(upi); + /* perms reftbl ... tbl key/nil */ + if(lua_isnil(upi->L, -1)) { + /* perms reftbl ... tbl nil */ + lua_pop(upi->L, 1); + /* perms reftbl ... tbl */ + break; + } + /* perms reftbl ... tbl key */ + unpersist(upi); + /* perms reftbl ... tbl key value? */ + lua_assert(!lua_isnil(upi->L, -1)); + /* perms reftbl ... tbl key value */ + lua_settable(upi->L, -3); + /* perms reftbl ... tbl */ + } +} + +static void unpersisttable(int ref, UnpersistInfo *upi) +{ + /* perms reftbl ... */ + { + int isspecial; + verify(luaZ_read(&upi->zio, &isspecial, sizeof(int)) == 0); + if(isspecial) { + unpersistspecialtable(ref, upi); + /* perms reftbl ... tbl */ + } else { + unpersistliteraltable(ref, upi); + /* perms reftbl ... tbl */ + } + /* perms reftbl ... tbl */ + } +} + +static UpVal *makeupval(lua_State *L, int stackpos) +{ + UpVal *uv = luaM_new(L, UpVal); + uv->tt = LUA_TUPVAL; + uv->v = &uv->u.value; + uv->u.l.prev = NULL; + uv->u.l.next = NULL; + setobj(L, uv->v, getobject(L, stackpos)); + luaC_link(L, (GCObject*)uv, LUA_TUPVAL); + return uv; +} + +static Proto *makefakeproto(lua_State *L, lu_byte nups) +{ + Proto *p = luaF_newproto(L); + p->sizelineinfo = 1; + p->lineinfo = luaM_newvector(L, 1, int); + p->lineinfo[0] = 1; + p->sizecode = 1; + p->code = luaM_newvector(L, 1, Instruction); + p->code[0] = CREATE_ABC(OP_RETURN, 0, 1, 0); + p->source = luaS_newlstr(L, "", 0); + p->maxstacksize = 2; + p->nups = nups; + p->sizek = 0; + p->sizep = 0; + + return p; +} + +/* The GC is not fond of finding upvalues in tables. We get around this + * during persistence using a weakly keyed table, so that the GC doesn't + * bother to mark them. This won't work in unpersisting, however, since + * if we make the values weak they'll be collected (since nothing else + * references them). Our solution, during unpersisting, is to represent + * upvalues as dummy functions, each with one upvalue. */ +static void boxupval(lua_State *L) +{ + /* ... upval */ + LClosure *lcl; + UpVal *uv; + + uv = toupval(L, -1); + lua_pop(L, 1); + /* ... */ + lcl = (LClosure*)luaF_newLclosure(L, 1, hvalue(&L->l_gt)); + pushclosure(L, (Closure*)lcl); + /* ... func */ + lcl->p = makefakeproto(L, 1); + lcl->upvals[0] = uv; +} + +static void unboxupval(lua_State *L) +{ + /* ... func */ + LClosure *lcl; + UpVal *uv; + + lcl = (LClosure*)clvalue(getobject(L, -1)); + uv = lcl->upvals[0]; + lua_pop(L, 1); + /* ... */ + pushupval(L, uv); + /* ... upval */ +} + +static void unpersistfunction(int ref, UnpersistInfo *upi) +{ + /* perms reftbl ... */ + LClosure *lcl; + int i; + lu_byte nupvalues; + + verify(luaZ_read(&upi->zio, &nupvalues, sizeof(lu_byte)) == 0); + + lcl = (LClosure*)luaF_newLclosure(upi->L, nupvalues, hvalue(&upi->L->l_gt)); + pushclosure(upi->L, (Closure*)lcl); + + /* perms reftbl ... func */ + /* Put *some* proto in the closure, before the GC can find it */ + lcl->p = makefakeproto(upi->L, nupvalues); + + /* Also, we need to temporarily fill the upvalues */ + lua_pushnil(upi->L); + /* perms reftbl ... func nil */ + for(i=0; iupvals[i] = makeupval(upi->L, -1); + } + lua_pop(upi->L, 1); + /* perms reftbl ... func */ + + /* I can't see offhand how a function would ever get to be self- + * referential, but just in case let's register it early */ + registerobject(ref, upi); + + /* Now that it's safe, we can get the real proto */ + unpersist(upi); + /* perms reftbl ... func proto? */ + lua_assert(lua_type(upi->L, -1) == LUA_TPROTO); + /* perms reftbl ... func proto */ + lcl->p = toproto(upi->L, -1); + lua_pop(upi->L, 1); + /* perms reftbl ... func */ + + for(i=0; iL); + /* perms reftbl ... func upval */ + lcl->upvals[i] = toupval(upi->L, -1); + lua_pop(upi->L, 1); + /* perms reftbl ... func */ + } + /* perms reftbl ... func */ + + /* Finally, the fenv */ + unpersist(upi); + /* perms reftbl ... func fenv/nil? */ + lua_assert(lua_type(upi->L, -1) == LUA_TNIL || + lua_type(upi->L, -1) == LUA_TTABLE); + /* perms reftbl ... func fenv/nil */ + if(!lua_isnil(upi->L, -1)) { + /* perms reftbl ... func fenv */ + lua_setfenv(upi->L, -2); + /* perms reftbl ... func */ + } else { + /* perms reftbl ... func nil */ + lua_pop(upi->L, 1); + /* perms reftbl ... func */ + } + /* perms reftbl ... func */ +} + +static void unpersistupval(int ref, UnpersistInfo *upi) +{ + /* perms reftbl ... */ + UpVal *uv; + + unpersist(upi); + /* perms reftbl ... obj */ + uv = makeupval(upi->L, -1); + lua_pop(upi->L, 1); + /* perms reftbl ... */ + pushupval(upi->L, uv); + /* perms reftbl ... upval */ + boxupval(upi->L); + /* perms reftbl ... func */ +} + +static void unpersistproto(int ref, UnpersistInfo *upi) +{ + /* perms reftbl ... */ + Proto *p; + int i; + int sizep, sizek; + + /* We have to be careful. The GC expects a lot out of protos. In + * particular, we need to give the function a valid string for its + * source, and valid code, even before we actually read in the real + * code. */ + TString *source = luaS_newlstr(upi->L, "", 0); + p = luaF_newproto(upi->L); + p->source = source; + p->sizecode=1; + p->code = luaM_newvector(upi->L, 1, Instruction); + p->code[0] = CREATE_ABC(OP_RETURN, 0, 1, 0); + p->maxstacksize = 2; + p->sizek = 0; + p->sizep = 0; + + + pushproto(upi->L, p); + /* perms reftbl ... proto */ + /* We don't need to register early, since protos can never ever be + * involved in cyclic references */ + + /* Read in constant references */ + { + verify(luaZ_read(&upi->zio, &sizek, sizeof(int)) == 0); + luaM_reallocvector(upi->L, p->k, 0, sizek, TValue); + for(i=0; ik[i], getobject(upi->L, -1)); + p->sizek++; + lua_pop(upi->L, 1); + /* perms reftbl ... proto */ + } + /* perms reftbl ... proto */ + } + /* Read in sub-proto references */ + { + verify(luaZ_read(&upi->zio, &sizep, sizeof(int)) == 0); + luaM_reallocvector(upi->L, p->p, 0, sizep, Proto*); + for(i=0; ip[i] = toproto(upi->L, -1); + p->sizep++; + lua_pop(upi->L, 1); + /* perms reftbl ... proto */ + } + /* perms reftbl ... proto */ + } + + /* Read in code */ + { + verify(luaZ_read(&upi->zio, &p->sizecode, sizeof(int)) == 0); + luaM_reallocvector(upi->L, p->code, 1, p->sizecode, Instruction); + verify(luaZ_read(&upi->zio, p->code, + sizeof(Instruction) * p->sizecode) == 0); + } + + /* Read in misc values */ + { + verify(luaZ_read(&upi->zio, &p->nups, sizeof(lu_byte)) == 0); + verify(luaZ_read(&upi->zio, &p->numparams, sizeof(lu_byte)) == 0); + verify(luaZ_read(&upi->zio, &p->is_vararg, sizeof(lu_byte)) == 0); + verify(luaZ_read(&upi->zio, &p->maxstacksize, sizeof(lu_byte)) == 0); + } +} + + +/* Does basically the opposite of luaC_link(). + * Right now this function is rather inefficient; it requires traversing the + * entire root GC set in order to find one object. If the GC list were doubly + * linked this would be much easier, but there's no reason for Lua to have + * that. */ +static void gcunlink(lua_State *L, GCObject *gco) +{ + GCObject *prevslot; + if(G(L)->rootgc == gco) { + G(L)->rootgc = G(L)->rootgc->gch.next; + return; + } + + prevslot = G(L)->rootgc; + while(prevslot->gch.next != gco) { + lua_assert(prevslot->gch.next != NULL); + prevslot = prevslot->gch.next; + } + + prevslot->gch.next = prevslot->gch.next->gch.next; +} + +/* FIXME __ALL__ field ordering */ +static void unpersistthread(int ref, UnpersistInfo *upi) +{ + /* perms reftbl ... */ + lua_State *L2; + L2 = lua_newthread(upi->L); + /* L1: perms reftbl ... thr */ + /* L2: (empty) */ + registerobject(ref, upi); + + /* First, deserialize the object stack. */ + { + size_t i, stacksize; + verify(luaZ_read(&upi->zio, &stacksize, sizeof(size_t)) == 0); + luaD_growstack(L2, (int)stacksize); + /* Make sure that the first stack element (a nil, representing + * the imaginary top-level C function) is written to the very, + * very bottom of the stack */ + L2->top--; + for(i=0; iL, L2, stacksize); + /* L1: perms reftbl ... thr */ + /* L2: obj* */ + } + /* (hereafter, stacks refer to L1) */ + + /* Now, deserialize the CallInfo stack. */ + { + size_t i, numframes; + verify(luaZ_read(&upi->zio, &numframes, sizeof(size_t)) == 0); + luaD_reallocCI(L2,numframes*2); + for(i=0; ibase_ci + i; + size_t stackbase, stackfunc, stacktop, savedpc; + verify(luaZ_read(&upi->zio, &stackbase, sizeof(size_t)) == 0); + verify(luaZ_read(&upi->zio, &stackfunc, sizeof(size_t)) == 0); + verify(luaZ_read(&upi->zio, &stacktop, sizeof(size_t)) == 0); + verify(luaZ_read(&upi->zio, &ci->nresults, sizeof(int)) == 0); + verify(luaZ_read(&upi->zio, &savedpc, sizeof(size_t)) == 0); + + + ci->base = L2->stack+stackbase; + ci->func = L2->stack+stackfunc; + ci->top = L2->stack+stacktop; + ci->savedpc = (ci != L2->base_ci) ? + ci_func(ci)->l.p->code+savedpc : + 0; + ci->tailcalls = 0; + /* Update the pointer each time, to keep the GC + * happy*/ + L2->ci = ci; + } + } + /* perms reftbl ... thr */ + /* Deserialize the state's other parameters, with the exception of upval stuff */ + { + size_t stackbase, stacktop; + L2->savedpc = L2->ci->savedpc; + verify(luaZ_read(&upi->zio, &L2->status, sizeof(lu_byte)) == 0); + verify(luaZ_read(&upi->zio, &stackbase, sizeof(size_t)) == 0); + verify(luaZ_read(&upi->zio, &stacktop, sizeof(size_t)) == 0); + verify(luaZ_read(&upi->zio, &L2->errfunc, sizeof(ptrdiff_t)) == 0); + L2->base = L2->stack + stackbase; + L2->top = L2->stack + stacktop; + } + /* Finally, "reopen" upvalues (see persistupval() for why) */ + { + UpVal* uv; + GCObject **nextslot = &L2->openupval; + while(1) { + size_t stackpos; + unpersist(upi); + /* perms reftbl ... thr uv/nil */ + if(lua_isnil(upi->L, -1)) { + /* perms reftbl ... thr nil */ + lua_pop(upi->L, 1); + /* perms reftbl ... thr */ + break; + } + /* perms reftbl ... thr boxeduv */ + unboxupval(upi->L); + /* perms reftbl ... thr uv */ + uv = toupval(upi->L, -1); + lua_pop(upi->L, 1); + /* perms reftbl ... thr */ + + verify(luaZ_read(&upi->zio, &stackpos, sizeof(size_t)) == 0); + uv->v = L2->stack + stackpos; + gcunlink(upi->L, (GCObject*)uv); + uv->marked = 1; + *nextslot = (GCObject*)uv; + nextslot = &uv->next; + uv->u.l.prev = &G(L2)->uvhead; + uv->u.l.next = G(L2)->uvhead.u.l.next; + uv->u.l.next->u.l.prev = uv; + G(L2)->uvhead.u.l.next = uv; + lua_assert(uv->u.l.next->u.l.prev == uv && uv->u.l.prev->u.l.next == uv); + } + *nextslot = NULL; + } +} + +static void unpersistuserdata(int ref, UnpersistInfo *upi) +{ + /* perms reftbl ... */ + int isspecial; + verify(luaZ_read(&upi->zio, &isspecial, sizeof(int)) == 0); + if(isspecial) { + unpersist(upi); + /* perms reftbl ... spfunc? */ + lua_assert(lua_isfunction(upi->L, -1)); + /* perms reftbl ... spfunc */ +#ifdef PLUTO_PASS_USERDATA_TO_PERSIST + lua_pushlightuserdata(upi->L, &upi->zio); + lua_call(upi->L, 1, 1); +#else + lua_call(upi->L, 0, 1); +#endif + /* perms reftbl ... udata? */ +/* This assertion might not be necessary; it's conceivable, for + * example, that the SP function might decide to return a table + * with equivalent functionality. For the time being, we'll + * ignore this possibility in favor of stricter and more testable + * requirements. */ + lua_assert(lua_isuserdata(upi->L, -1)); + /* perms reftbl ... udata */ + } else { + size_t length; + verify(luaZ_read(&upi->zio, &length, sizeof(size_t)) == 0); + + lua_newuserdata(upi->L, length); + /* perms reftbl ... udata */ + registerobject(ref, upi); + verify(luaZ_read(&upi->zio, lua_touserdata(upi->L, -1), length) == 0); + + unpersist(upi); + /* perms reftbl ... udata mt/nil? */ + lua_assert(lua_istable(upi->L, -1) || lua_isnil(upi->L, -1)); + /* perms reftbl ... udata mt/nil */ + lua_setmetatable(upi->L, -2); + /* perms reftbl ... udata */ + } + /* perms reftbl ... udata */ +} + +static void unpersistpermanent(int ref, UnpersistInfo *upi) +{ + /* perms reftbl ... */ + unpersist(upi); + /* perms reftbl permkey */ + lua_gettable(upi->L, 1); + /* perms reftbl perm? */ + /* We assume currently that the substituted permanent value + * shouldn't be nil. This may be a bad assumption. Real-life + * experience is needed to evaluate this. */ + lua_assert(!lua_isnil(upi->L, -1)); + /* perms reftbl perm */ +} + +/* For debugging only; not called when lua_assert is empty */ +static int inreftable(lua_State *L, int ref) +{ + int res; + /* perms reftbl ... */ + lua_pushlightuserdata(L, (void*)ref); + /* perms reftbl ... ref */ + lua_gettable(L, 2); + /* perms reftbl ... obj? */ + res = !lua_isnil(L, -1); + lua_pop(L, 1); + /* perms reftbl ... */ + return res; +} + +static void unpersist(UnpersistInfo *upi) +{ + /* perms reftbl ... */ + int firstTime; + int stacksize = lua_gettop(upi->L); /* DEBUG */ + luaZ_read(&upi->zio, &firstTime, sizeof(int)); + if(firstTime) { + int ref; + int type; + luaZ_read(&upi->zio, &ref, sizeof(int)); + lua_assert(!inreftable(upi->L, ref)); + luaZ_read(&upi->zio, &type, sizeof(int)); +#ifdef PLUTO_DEBUG + printindent(upi->level); + printf("1 %d %d\n", ref, type); + upi->level++; +#endif + switch(type) { + case LUA_TBOOLEAN: + unpersistboolean(upi); + break; + case LUA_TLIGHTUSERDATA: + unpersistlightuserdata(upi); + break; + case LUA_TNUMBER: + unpersistnumber(upi); + break; + case LUA_TSTRING: + unpersiststring(upi); + break; + case LUA_TTABLE: + unpersisttable(ref, upi); + break; + case LUA_TFUNCTION: + unpersistfunction(ref, upi); + break; + case LUA_TTHREAD: + unpersistthread(ref, upi); + break; + case LUA_TPROTO: + unpersistproto(ref, upi); + break; + case LUA_TUPVAL: + unpersistupval(ref, upi); + break; + case LUA_TUSERDATA: + unpersistuserdata(ref, upi); + break; + case PLUTO_TPERMANENT: + unpersistpermanent(ref, upi); + break; + default: + lua_assert(0); + } + /* perms reftbl ... obj */ + lua_assert(lua_type(upi->L, -1) == type || + type == PLUTO_TPERMANENT || + /* Remember, upvalues get a special dispensation, as + * described in boxupval */ + (lua_type(upi->L, -1) == LUA_TFUNCTION && + type == LUA_TUPVAL)); + registerobject(ref, upi); + /* perms reftbl ... obj */ +#ifdef PLUTO_DEBUG + upi->level--; +#endif + } else { + int ref; + luaZ_read(&upi->zio, &ref, sizeof(int)); +#ifdef PLUTO_DEBUG + printindent(upi->level); + printf("0 %d\n", ref); +#endif + if(ref == 0) { + lua_pushnil(upi->L); + /* perms reftbl ... nil */ + } else { + lua_pushlightuserdata(upi->L, (void*)ref); + /* perms reftbl ... ref */ + lua_gettable(upi->L, 2); + /* perms reftbl ... obj? */ + lua_assert(!lua_isnil(upi->L, -1)); + } + /* perms reftbl ... obj/nil */ + } + /* perms reftbl ... obj/nil */ + lua_assert(lua_gettop(upi->L) == stacksize + 1); +} + +void pluto_unpersist(lua_State *L, lua_Chunkreader reader, void *ud) +{ + /* We use the graciously provided ZIO (what the heck does the Z stand + * for?) library so that we don't have to deal with the reader directly. + * Letting the reader function decide how much data to return can be + * very unpleasant. + */ + UnpersistInfo upi; + upi.L = L; +#ifdef PLUTO_DEBUG + upi.level = 0; +#endif + + luaZ_init(L, &upi.zio, reader, ud); + + /* perms */ + lua_newtable(L); + /* perms reftbl */ + unpersist(&upi); + /* perms reftbl rootobj */ + lua_replace(L, 2); + /* perms rootobj */ +} + +typedef struct LoadInfo_t { + const char *buf; + size_t size; +} LoadInfo; + + +static const char *bufreader(lua_State *L, void *ud, size_t *sz) { + LoadInfo *li = (LoadInfo *)ud; + if(li->size == 0) { + return NULL; + } + *sz = li->size; + li->size = 0; + return li->buf; +} + +int unpersist_l(lua_State *L) +{ + LoadInfo li; + /* perms? str? ...? */ + lua_settop(L, 2); + /* perms? str? */ + li.buf = luaL_checklstring(L, 2, &li.size); + /* perms? str */ + lua_pop(L, 1); + /* It is conceivable that the buffer might now be collectable, + * which would cause problems in the reader. I can't think of + * any situation where there would be no other reference to the + * buffer, so for now I'll leave it alone, but this is a potential + * bug. */ + /* perms? */ + luaL_checktype(L, 1, LUA_TTABLE); + /* perms */ + pluto_unpersist(L, bufreader, &li); + /* perms rootobj */ + return 1; +} + +static luaL_reg pluto_reg[] = { + { "persist", persist_l }, + { "unpersist", unpersist_l }, + { NULL, NULL } +}; + +int luaopen_pluto(lua_State *L) { + luaL_openlib(L, "pluto", pluto_reg, 0); + return 1; +} + diff --git a/src/pluto/pluto.h b/src/pluto/pluto.h new file mode 100644 index 0000000..8dcbd44 --- /dev/null +++ b/src/pluto/pluto.h @@ -0,0 +1,25 @@ +/* $Id$ */ + +/* Pluto - Heavy-duty persistence for Lua + * Copyright (C) 2004 by Ben Sunshine-Hill, and released into the public + * domain. People making use of this software as part of an application + * are politely requested to email the author at sneftel@gmail.com + * with a brief description of the application, primarily to satisfy his + * curiosity. + * + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, + * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF + * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. + * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY + * CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, + * TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE + * SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + */ + +/* lua.h must be included before this file */ + +void pluto_persist(lua_State *L, lua_Chunkwriter writer, void *ud); + +void pluto_unpersist(lua_State *L, lua_Chunkreader reader, void *ud); + +int pluto_open(lua_State *L); diff --git a/src/pluto/pptest.c b/src/pluto/pptest.c new file mode 100644 index 0000000..f362328 --- /dev/null +++ b/src/pluto/pptest.c @@ -0,0 +1,90 @@ +/* $Id$ */ + +#include +#include + +#include "lua.h" +#include "lualib.h" +#include "lauxlib.h" +#include "pluto.h" + +static int LUAF_createludata(lua_State *L) +{ + lua_pushlightuserdata(L, (void*)321); + return 1; +} + +/* A userdata that may be literally persisted */ +static int LUAF_boxinteger(lua_State *L) +{ + /* num */ + int* ptr = lua_newuserdata(L, sizeof(int)); + /* num udata */ + *ptr = luaL_checkint(L, 1); + lua_newtable(L); + /* num udata mt */ + lua_pushstring(L, "__persist"); + /* num udata mt "__persist" */ + lua_pushboolean(L, 1); + /* num udata mt "__persist" true */ + lua_rawset(L, 3); + /* num udata mt */ + lua_setmetatable(L, 2); + /* num udata */ + return 1; +} + +static int LUAF_boxboolean(lua_State *L) +{ + /* bool */ + char* ptr = lua_newuserdata(L, sizeof(char)); + /* bool udata */ + *ptr = lua_toboolean(L, 1); + lua_newtable(L); + /* num udata mt */ + lua_pushstring(L, "__persist"); + /* num udata mt "__persist" */ + lua_getglobal(L, "booleanpersist"); + /* num udata mt "__persist" booleanpersist */ + lua_rawset(L, 3); + /* num udata mt */ + lua_setmetatable(L, 2); + /* num udata */ + return 1; +} + +static int LUAF_unboxboolean(lua_State *L) +{ + /* udata */ + lua_pushboolean(L, *(char*)lua_touserdata(L, 1)); + /* udata bool */ + return 1; +} + +static int LUAF_onerror(lua_State *L) +{ + const char* str = lua_tostring(L, -1); +} + +int main() +{ + lua_State* L = lua_open(); + + luaL_openlibs(L); + luaopen_pluto(L); + lua_settop(L, 0); + + lua_register(L, "createludata", LUAF_createludata); + lua_register(L, "boxinteger", LUAF_boxinteger); + lua_register(L, "boxboolean", LUAF_boxboolean); + lua_register(L, "unboxboolean", LUAF_unboxboolean); + lua_register(L, "onerror", LUAF_onerror); + + lua_pushcfunction(L, LUAF_onerror); + luaL_loadfile(L, "pptest.lua"); + lua_pcall(L,0,0,1); + + lua_close(L); + + return 0; +} diff --git a/src/pluto/pptest.lua b/src/pluto/pptest.lua new file mode 100644 index 0000000..6a0ead7 --- /dev/null +++ b/src/pluto/pptest.lua @@ -0,0 +1,136 @@ +-- $Id$ + +permtable = { 1234 } + +perms = { [coroutine.yield] = 1, [permtable] = 2 } + +twithmt = {} +setmetatable( twithmt, { __call = function() return 21 end } ) + +function testfenv() + return abc +end + +setfenv(testfenv, { abc = 456 }) + +function fa(i) + local ia = i + 1 + return fb(ia) +end + +function fb(i) + local ib = i + 1 + ib = ib + fc(ib) + return ib +end + +function fc(i) + local ic = i + 1 + coroutine.yield() + return ic*2 +end + +function func() + return 4 +end + +thr = coroutine.create(fa) +coroutine.resume(thr, 2) + +testtbl = { a = 2, [2] = 4 } + +function funcreturningclosure(n) + return function() + return n + end +end + +function nestedfunc(n) + return (function(m) return m+2 end)(n+3) +end + +testloopa = {} +testloopb = { testloopa = testloopa } +testloopa.testloopb = testloopb + +sharedref = {} +refa = {sharedref = sharedref} +refb = {sharedref = sharedref} + +sptable = { a = 3 } + +setmetatable(sptable, { + __persist = function(tbl) + local a = tbl.a + return function() + return { a = a+3 } + end + end +}) + +literaludata = boxinteger(71) + +function booleanpersist(udata) + local b = unboxboolean(udata) + return function() + return boxboolean(b) + end +end + +function makecounter() + local a = 0 + return { + inc = function() a = a + 1 end, + cur = function() return a end + } +end + +function uvinthreadfunc() + local a = 1 + local b = function() + a = a+1 + coroutine.yield() + a = a+1 + end + a = a+1 + b() + a = a+1 + return a +end + +uvinthread = coroutine.create(uvinthreadfunc) +coroutine.resume(uvinthread) + +rootobj = { + testfalse = false, + testtrue = true, + testseven = 7, + testfoobar = "foobar", + testfuncreturnsfour = func, + testnil = nil, + testthread = thr, + testperm = permtable, + testmt = twithmt, + testtbl = testtbl, + testfenv = testfenv, + testclosure = funcreturningclosure(11), + testnilclosure = funcreturningclosure(nil), + testnest = nestedfunc, + testludata = createludata(), + testlooptable = testloopa, + testsharedrefa = refa, + testsharedrefb = refb, + testsptable = sptable, + testliteraludata = literaludata, + testspudata1 = boxboolean(true), + testspudata2 = boxboolean(false), + testsharedupval = makecounter(), + testuvinthread = uvinthread +} + +buf = pluto.persist(perms, rootobj) + +onerror() +outfile = io.open("test.plh", "wb") +outfile:write(buf) +outfile:close() diff --git a/src/pluto/puptest.c b/src/pluto/puptest.c new file mode 100644 index 0000000..88a67f7 --- /dev/null +++ b/src/pluto/puptest.c @@ -0,0 +1,68 @@ +/* $Id$ */ + +#include +#include + +#include "lua.h" +#include "lualib.h" +#include "lauxlib.h" +#include "pluto.h" + +static int LUAF_checkludata(lua_State *L) +{ + lua_pushboolean(L, lua_touserdata(L, -1) == (void*)321); + return 1; +} + +static int LUAF_unboxinteger(lua_State *L) +{ + lua_pushnumber(L, *((int*)lua_touserdata(L, -1))); + return 1; +} + +static int LUAF_unboxboolean(lua_State *L) +{ + /* udata */ + lua_pushboolean(L, *(char*)lua_touserdata(L, 1)); + /* udata bool */ + return 1; +} + +static int LUAF_boxboolean(lua_State *L) +{ + /* bool */ + char* ptr = lua_newuserdata(L, sizeof(char)); + /* bool udata */ + *ptr = lua_toboolean(L, 1); + lua_newtable(L); + /* num udata mt */ + lua_pushstring(L, "__persist"); + /* num udata mt "__persist" */ + lua_getglobal(L, "booleanpersist"); + /* num udata mt "__persist" booleanpersist */ + lua_rawset(L, 3); + /* num udata mt */ + lua_setmetatable(L, 2); + /* num udata */ + return 1; +} + +int main() +{ + lua_State* L = lua_open(); + + luaL_openlibs(L); + luaopen_pluto(L); + lua_settop(L, 0); + + lua_register(L, "checkludata", LUAF_checkludata); + lua_register(L, "unboxinteger", LUAF_unboxinteger); + lua_register(L, "boxboolean", LUAF_boxboolean); + lua_register(L, "unboxboolean", LUAF_unboxboolean); + + luaL_dofile(L, "puptest.lua"); + + lua_close(L); + + return 0; +} diff --git a/src/pluto/puptest.lua b/src/pluto/puptest.lua new file mode 100644 index 0000000..122860e --- /dev/null +++ b/src/pluto/puptest.lua @@ -0,0 +1,85 @@ +-- $Id$ + +permtable = { 1234 } + +perms = { [1] = coroutine.yield, [2] = permtable } + +function testcounter(counter) + local a = counter.cur() + counter.inc() + return counter.cur() == a+1 +end + +function testuvinthread(func) + local success, result = coroutine.resume(func) + return success and result == 5 +end + +function test(rootobj) + local passed = 0 + local total = 0 + local dotest = function(name,cond) + total = total+1 + if cond then + print(name, " PASSED") + passed = passed + 1 + else + print(name, "* FAILED") + end + end + + dotest("Boolean FALSE ", rootobj.testfalse == false) + dotest("Boolean TRUE ", rootobj.testtrue == true) + dotest("Number 7 ", rootobj.testseven == 7) + dotest("String 'foobar' ", rootobj.testfoobar == "foobar") + dotest("Func returning 4 ", rootobj.testfuncreturnsfour() == 4) + dotest("Nil value ", rootobj.testnil == nil) + dotest("Thread resume ", coroutine.resume(rootobj.testthread) == true,14) + dotest("Table ", rootobj.testtbl.a == 2 and rootobj.testtbl[2] == 4); + dotest("Permanent table ", rootobj.testperm == permtable) + dotest("Table metatable ", rootobj.testmt() == 21) + dotest("Function env ", rootobj.testfenv() == 456) + dotest("Lua closure ", rootobj.testclosure() == 11) + dotest("Nil in closure ", rootobj.testnilclosure() == nil) + dotest("Nested func ", rootobj.testnest(1) == 6) + dotest("Light userdata ", checkludata(rootobj.testludata)) + dotest("Looped tables ", + rootobj.testlooptable.testloopb.testloopa == + rootobj.testlooptable) + dotest("Shared reference ", rootobj.testsharedrefa.sharedref == + rootobj.testsharedrefb.sharedref) + dotest("Identical tables ", rootobj.testsharedrefa ~= + rootobj.testsharedrefb) + dotest("Table special persist", rootobj.testsptable.a == 6) + dotest("Udata literal persist", + unboxinteger(rootobj.testliteraludata) == 71) + dotest("Udata special persist", + unboxboolean(rootobj.testspudata1) == true and + unboxboolean(rootobj.testspudata2) == false) + dotest("Shared upvalues ", + testcounter(rootobj.testsharedupval)) + dotest("Open upvalues ", + testuvinthread(rootobj.testuvinthread)) + print() + if passed == total then + print("All tests passed.") + else + print(passed .. "/" .. total .. " tests passed.") + end +end + +infile, err = io.open("test.plh", "rb") +if infile == nil then + error("While opening: " .. (err or "no error")) +end + +buf, err = infile:read("*a") +if buf == nil then + error("While reading: " .. (err or "no error")) +end + +infile:close() + +rootobj = pluto.unpersist(perms, buf) + +test(rootobj) diff --git a/src/rings/Makefile b/src/rings/Makefile new file mode 100644 index 0000000..dee0bef --- /dev/null +++ b/src/rings/Makefile @@ -0,0 +1,6 @@ +include ../common.mk + +all: rings.o stable.lua + $(MKLIB) -o rings.$(LIBEXT) rings.$(OBJEXT) + cp rings.$(LIBEXT) $(TARGET_LUA_CPATH)/ + cp stable.lua $(TARGET_LUA_PATH)/ diff --git a/src/rings/README b/src/rings/README new file mode 100644 index 0000000..f3a480c --- /dev/null +++ b/src/rings/README @@ -0,0 +1,36 @@ +Rings 1.1 - Multiple Lua States +(http://www.keplerproject.org/rings/) + +Overview + +Rings is a library which provides a way to create new Lua states from within Lua. It also offers a simple way to communicate between the creator (master) and the created (slave) states. + +Rings is free software and uses the same license as Lua 5.1. + +Download + +Rings can be downloaded in source code from its LuaForge page. If you are using LuaBinaries, a Windows precompiled version of Rings can also be found at the same LuaForge page: +http://luaforge.net/projects/rings/files + +Installation + +The compiled binary file should be copied to a directory in your C path. +The file stable.lua should be copied to a directory in your Lua path. + + +History + +Version 1.1 [11/Jun/2007] + Adapted to work with Lua 5.1. +Version 1.0 [10/Mar/2006] + First public version, works with Lua 5.0. + +Credits + +Rings was designed by Roberto Ierusalimschy and Tomás Guisasola as part of the Kepler Project. The implementation was coded by Tomás Guisasola. + +Rings development was sponsored by Fábrica Digital. + +For more information please contact us (info at keplerproject dot org). Comments are welcome! + +You can also reach other Kepler developers and users on the Kepler Project mailing list. \ No newline at end of file diff --git a/src/rings/doc/.DS_Store b/src/rings/doc/.DS_Store new file mode 100644 index 0000000000000000000000000000000000000000..2972e0f6d9a3faefeb63e6f2212ab2a64280c7b9 GIT binary patch literal 6148 zcmeH~Jr2S!425mzfW*>~F$)La1`&c2Z~+7zkr*oW9G&MM1`0E((6eNJu^X%H8=6`~ zbpIH3BE5*L;6~Y6n3y78$V0|qyxuPN`^^ezi=>s{y-cpZ_K{S83Qz$mKn1A4d=$u| ze6^m>Bk@V702P>t0``39EI3<=Oi2dR9MY)z%FT`gVl3p8zCw6mQ^exL#}l)?^E!0^^T>%fLVdeyYF|j%yG_ literal 0 HcmV?d00001 diff --git a/src/rings/doc/us/index.html b/src/rings/doc/us/index.html new file mode 100644 index 0000000..06f9af2 --- /dev/null +++ b/src/rings/doc/us/index.html @@ -0,0 +1,128 @@ + + + + Rings: Multiple Lua States + + + + + +

+ +
+ +
Rings
+
Multiple Lua States
+
+ +
+ + + +
+ +

Overview

+ +

Rings is a library which provides a way to create new Lua states from within +Lua. It also offers a simple way to communicate between the creator (master) and +the created (slave) states.

+ +

Rings is free software and uses the same license +as Lua 5.1.

+ +

Status

+ +

+Rings version 1.1.0 +is now available for download.

+ +

Download

+ +

Rings can be downloaded in source code from its +LuaForge +page. If you are using +LuaBinaries, +a Windows precompiled version of Rings can also be found at the same +LuaForge page.

+ +

History

+ +
+
Version 1.1 [11/Jun/2007]
+
Adapted to work with Lua 5.1.
+
Version 1.0 [10/Mar/2006]
+
First public version, works with Lua 5.0.
+
+ +

Credits

+ +

Rings was designed by Roberto Ierusalimschy and Tomás Guisasola +as part of the Kepler Project. +The implementation was coded by Tomás Guisasola.

+ +

Rings development was sponsored by +Fábrica Digital.

+ +

Contact us

+ +

For more information please +contact us. +Comments are welcome!

+ +

You can also reach other Kepler developers and users on the Kepler Project +mailing list.

+ +
+ +
+ +
+

+ Valid XHTML 1.0!

+

$Id: index.html,v 1.12 2007/06/11 23:36:37 carregal Exp $

+
+ +
+ + + diff --git a/src/rings/doc/us/license.html b/src/rings/doc/us/license.html new file mode 100644 index 0000000..e054cfc --- /dev/null +++ b/src/rings/doc/us/license.html @@ -0,0 +1,118 @@ + + + + Rings License + + + + + +
+ +
+ +
Rings
+
Multiple Lua States
+
+ +
+ + +
+ +

License

+ +

Rings is free software: it can be used for both academic and commercial +purposes at absolutely no cost. There are no royalties or GNU-like "copyleft" +restrictions. Rings qualifies as +Open Source +software. +Its licenses are compatible with +GPL. +Rings is not in the public domain and the +Kepler Project +keeps its copyright. The legal details are below.

+ +

The spirit of the license is that +you are free to use Rings for any purpose at no cost without having to ask us. +The only requirement is that if you do use Rings, +then you should give us credit by including the appropriate copyright notice +somewhere in your product or its documentation.

+ +

The Rings library is designed and implemented by Roberto Ierusalimschy +and Tomás Guisasola. +The implementation is not derived from licensed software.

+ +
+

Copyright © 2006-2007 Kepler Project.

+ +

Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions:

+ +

The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software.

+ +

+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE.

+ +
+
+ +
+

Valid XHTML 1.0!

+

+$Id: license.html,v 1.7 2007/05/09 22:38:53 carregal Exp $ +

+
+ +
+ + diff --git a/src/rings/doc/us/manual.html b/src/rings/doc/us/manual.html new file mode 100644 index 0000000..2190cdf --- /dev/null +++ b/src/rings/doc/us/manual.html @@ -0,0 +1,251 @@ + + + + Rings: Multiple Lua States + + + + + +
+ +
+ +
Rings
+
Multiple Lua States
+
+ +
+ + + +
+ +

Introduction

+ +

Rings is a library which provides a way to create new Lua states from within +Lua. It also offers a simple way to communicate between the creator (master) and +the created (slave) states.

+ +

Rings is free software and uses the same license +as Lua 5.1.

+ +

Rings also offers Stable, +a very simple API to manage a shared table at the master state.

+ + +

Building

+ +

+Rings version 1.1.0 is for Lua 5.1 only. In order to build it +the language library and header files for the desired Lua version must be +installed properly. +

+

+Rings comprises a single C source file. +The distribution provides a +Makefile +prepared to compile the library and install it. +The file +config +should be edited to suit the particularities of the target platform +before running +make. +This file has some definitions like paths to the external libraries, +compiler options and the like. +One important definition is the Lua version, +which is not obtained from the installed software. +

+ +

Installation

+ +

+The compiled binary file should be copied to a directory in your +C +path. +

+ +

+Windows users can use the precompiled versions of Rings available at +LuaForge

+ +

+The file stable.lua should be copied to a directory in your +Lua +path. +

+ + +

Reference

+ +

Master functions

+ +

Rings offers a single function which creates a new Lua state and returns +an object representing it. The state which creates other states is called +the master and the created ones are called slaves. +The master can execute code in any of its slaves but each slave only has +direct access to its master (or its own slaves).

+ +

All standard Lua libraries are opened automatically in a new state; +other libraries have to be loaded explicitly.

+ +

The object representing a slave state has a method (dostring) +which can execute Lua code in the corresponding state. +This method can receive arguments (only numbers, strings, booleans and userdata, +which are converted to lightuserdata) and always returns a boolean indicating +whether the code executed correctly or not, followed by eventual return values +or an error message.

+ +
+
rings.new ()
+
Returns a newly created Lua state.
+ +
state:close ()
+
Closes the state.
+ +
state:dostring (string, ...)
+
Executes a string in the slave state. + The arguments could be accessed exactly as in a + vararg + function: + in Lua 5.0, they are stored into the arg table; + in Lua 5.1, the expression ... represents all arguments. + Valid types of arguments and return values are: + number, string, boolean, nil and userdata (which are converted + to lightuserdata). +
+ Returns a boolean indicating the status of the operation, + followed by the returned values or an error message in case of error. +
+
+ +

Slave function

+ +

The following function is registered in the newly created slave state.

+ +
+ +
remotedostring (string, ...)
+
Executes a string in the master state. + Behaves exactly as the method dostring + except that it acts in the master state. +
+
+ +

Stable

+ +

Stable is a simple API which provides a way for a slave state to store +and retrieve data to and from its master state. +This library is not opened automatically in a slave state.

+ +
+ +
stable.get (key)
+
Returns the value of a given key.
+ +
stable.set (key, value)
+
Stores a value associated to a key. + Returns nothing.
+ +
+ + +

Examples

+ +

The following sample shows how to execute code in another state passing +arguments and returning values:

+ +
+require"rings"
+S = rings.new ()
+
+data = { 12, 13, 14, }
+print (S:dostring ([[
+aux = {}
+for i, v in ipairs (arg) do
+	table.insert (aux, 1, v)
+end
+return unpack (aux)]], unpack (data))) -- true, 14, 13, 12
+
+S:close ()
+
+ +

The following example uses Stable to store a value in the master state:

+ +
+require"rings"
+
+local init_cmd = [[
+require"stable"]]
+
+local count_cmd = [[
+count = stable.get"shared_counter" or 0
+stable.set ("shared_counter", count + 1)
+return count
+]]
+
+S = rings.new () -- new state
+assert(S:dostring (init_cmd))
+print (S:dostring (count_cmd)) -- true, 0
+print (S:dostring (count_cmd)) -- true, 1
+S:close ()
+
+S = rings.new () -- another new state
+assert (S:dostring (init_cmd))
+print (S:dostring (count_cmd)) -- true, 2
+S:close ()
+
+ +
+ +
+ +
+

+ Valid XHTML 1.0!

+

$Id: manual.html,v 1.14 2007/06/11 23:36:37 carregal Exp $

+
+ +
+ + + diff --git a/src/rings/doc/us/rings.png b/src/rings/doc/us/rings.png new file mode 100644 index 0000000000000000000000000000000000000000..efac64df49d456c4bbedd18867d993cda359ec4d GIT binary patch literal 7448 zcmX|`bzD>5|HlUcBHhYpM7ldvIz?K#yFnU(0RyC4N zijgW73Yf zV2fuj;Cb@bQU0|w=j!Y4(hrO1mypDKkg3!|26TmohlhoM7#J9ol}9wfY-~A-OG|ft zm%bsvB8^o@Rrzi`6qk}hB7_ukU-@@%kPfp2Cn}XpyDrvaL;pH z&B}V3qdsiiP(tCBsI4mONPKpSmo?b4e!eC6|w8ijM3=t5NF;VFesINcbv97Lej=H_S z|5fU9WzqkJ5Wi`n$NA2}f&m0tTU)z1u(PwXZV>0@PUyEJ!NqzLG3WSwX{p&F9^=#(%fDB2Q+@cAFPUZQp3@%!tXcZHTpq_zp@!>iY3$A zUhV3v&q;9Kzke?vAW)%P*wS)&x;5hF=4Qw(Dl9B4B0|~HvPX*hQNNa(n`49NlSQZB z?;?2)7P7U31T#vI>{O1B1Mo05hvHRPbc~FawnmZ-strlOU{11FdT9uE)@XiSUS57a zDi~s8vvqm2yt=ZY^qf^*Ufz^9Yh;VZyvuMsFuS}-_oe@_6H)m>@zaK-a79HfQ&XjC zXTNu03d~DQ4wHYHUG{t=K_C*Wot+)k(%*?RV*B4Xv1B_KA|fKtmq#;i{zOkqXb|AY zmrN%tCl)c;1qW-m9lha#ntf-#-5hFF-p^AGp)Z_s&QL2oZZ+k74C-52GP-(-)gO2U z_x1ICFHT#k6Nub~?e9C|LT}LMI`eKd)^zPdvJ?bjW3WUy*}ToOsCA(}JM_jW*0-G) z)VDL5Cm(&B?Bh@20>YBj{PME>{nkeX<{V)s9b@Cq`c-MjEs~N10?hI?OR~Z=<8=T zHJweDC{q&*7c0icC~V%LuYk3s%918mWZ3MSk?&3WggJF(!9Q8OtVMtpCjxo6)JvVk z>2nj7l$1oyrUBgH-u*AzMkEsX@gvS1C~wF*>f=W$Dk@1SDL#vyu9_OR6JS`Eha7x- z1!5lNwzezFBVpQ7AiGTmEMRHTw7V`b z6ff7Rn1pblPEJnF%{RbA@{tTVn6G)0$*roYy42xYRaaN1&g$*u)o4*>Ea&F-)L8b_ z2U})#9|{oE(#Pk!PUTClZIz%PDG-R1l$4ta_^*leX%%%zQh;+?qQxd#>chmoHx~Fa0bmEX;I;+*icGiJ1ij zy?#f=e0+7-_*4kgtpx;SxAQBbgNTQp-*YIA5|BC&2occr`7;=p*hN~uXJ&lOu(?UF zeEs4~OcW;z;<2DbYvz^eWtpRMAdt9(Rem1g%a;jr^NH|q3Y>`j-CgG(&04L(sr!Fg zoNux0?AQoowTz666cwY6PpXZY;1l`y&_d%HUUqg8yeQxccXxN-nctp{Ff6%Vj^zj? z%9F$oIX8p-`h>(QDk=iBjbL@P?sZiM#|P<52`m}=6qJhbiTV64`Z98u`RXlY8Ov>_ z3*>C{fAUa3f(g1}4Y@rfh=|vp58L10|MlzF?5v(-zPXuM$nHdbU!M$XdhFoF{du`` z{_7A)K0c45Kh1!~ox#VsI5?gV5?&yYV0uhkC_IbWyyuf?*P@}}_4mfc@eb?7b-p^_ zcC=5eua4E2Nok($7UWPj*urRfdTM_@dP4BEFcsBNSTX#xrV@jeX!jO%282JIO%n$M zf))ZgE|4>JeI1Yws0$1Rd++OO*6d746z$^bnh+Bs)3#l#?-C#1&ZhB_o7Y{ts@d^{ zIWZMJuVLRxeR#%aaGdSXHT><`ElRow>HPZPd1z>3zhXS))ZCmeARv1)<&*hR2L9O4 zLMRl|EC^UI1NKd)0l`4zH8dt7pOCLX&~A~04W_lPLvBucLf(y!%dsFu$!OK@{*|;< zSHs{2Ty}yPbtmSjD(+hc*4AAvE@DfP#6T#pv9Tc#h^wecXzIw;`*u^o99jyB^S}KO zfW-Fnyav)n2A6?gjyg-fv+$q1ygxB95xHU(4VuS~K!`)5hiC?Ke0=oA^=Y*IH*jpE zMZ4gi%Y_;X=^mmX&FI7Jh;y8!nTQpHD|e2PilJ)Y9MI9|F0b zn$ohh-3H`7_0!!iwfh#gA=Z(fe$QDy`u&yhlEYlJjYQpsBM=dSIluN1cXzAec{LLg ztlz+wqkO#z^d#XjF>!HZcu}n$>-tr5!r-Iw0toW-6!!Dyl*lPBFYom9v~#m0FR%Mb z+k3b?c|2w4{n-Wa>o$9cKa9x7pZM;4<|IFVGZL#KJ$<7uQr&N0t3k|zc{N%9US1$r zT0=D-x_FS3f1Ck7}g@mi%~81H~guxRL<~h};0IArlP( zeQ&vJS}MOhsS{++GUR5J4uwInV>-TXxc>QZ1J4b#$8t3$3_0B#YWLpt6kkE^jFK87 z*)u-#nAF-kNP}y*6=MC@6D1%o#|tHNI7J@rPhLDGT9I#*e9N-wcbwN55>$;!nwsDF z*VEGjg+c)(7#kZyAUw|otQ)LhX=g89Ode*Xil$^g3)uTDMG?1gi#lFynS9-81T2ZK zj|HB2P8TD3@7&x2+Sm?Fv=)g|V75QSPx5YD+hFSY zj#k#wn{9GH2+`wH^zEK$=7}?r;HKa{r4qeI#*1*VIi40gNGuN%T2YOPiHOYpwSF%k zCe5Iom6?{-=s3-6DDV|8jIrX|H%=fU-Cm#8|8M%CFMF5M0%!n{9m^lBf0YL)*6`DZ z+uZ||O9w>2%QUhuJq+uHw#rHlQBkT`1mG+7WsH`dnvx8Nt;_WtdYg=#!G zXBf=3=VIPOMWgd*%}her_6| zkMz~qKNZ_4+Tg>lmUyhcQpV_()BF1mCZDRXkVOwVxwz1%f_4J?8f=K^%x^LD#+Q8T z{aNc6B+o&Y?}>?%0Z)7|o|!1Ci{adSIl@3^af<Ok!H&d=jOe~iuWiip-Pc8c?7)(SoTvm;szXgnt6tL2SDD*D=1D;#N^u&X|C#;>2tX0X z%F#07Ni<_cd%F<}8TC3;8VOCZaEF;*5$a!JG|2gUN^jMd9_1|~3m3!6I3RZ=fZ-UU4)|-_) zCS@V_flye}z9b_qCs)utjBTODQ&r1i{SKZBf!nRDuA@d~W5t#fTIS~TU@)G`73wxnnjfC3_AW5c7kGg{ZSACHrnr*PHk=tXkBd^q9)LZ~ zTX1cTE+EN3{zxh>XRF4fZM$-zi-?HpmmN*$7-waGTyZcm_HFz8GG(ita~1&;lJ%Mo z-j&_qGgBBB1V6)eY&PyTAs31ns>mplW^U1A^~Tex)B}P3dLrnW<%+^HP@xGtFtKtF zb84HT&d6eGT~}s^vMO{@0rt{ z{XM<(3WeDs5gY?Cq_GIt zLc5xX`J8h3_J@Fkc@*~SQqQYP#0Evku}gD`7W>gY*_%?%JETa4+OJ6qFpU(3Rkli! z2YZGZ309)iY$y-*^>y3fiiD;^y(mB9ddm?w@v^3T*WF^ho0r!@S&{BFq)Ta`kQ{fB zuO~ZE95qodD40VKJxHCrXGM{cn~O#;-M$Wz0a5GQbEkZvua&y4n3JQXb_l)R=z-uo zl9iEctV}n4% z^a%l`TGEvY?xu;`;`=In>|t_6*(*x?eZO_tlQwq?XhQF)?Q_M%7p*-Srl;rG7|Na? z&(8tHsu$%TXKh1Ww-sh;CV`>{v9PtpJidI+C-j(=ruFyN(IQdDCy)hFS&Hg&jBGIf z`^_J*8{Pg9BV=!l4-tr~(2xz`b%nyfSV{e?H^P6?^!jsL_LMg1_V zId1#<`obSQ1^|a+S1kds%pk)ckYy8fC@ywe8;RdxcDoaKypoWa9U5(?_YJ#bU&8yZ zCbTOUMFwoNHObAeorMg!UdAp07$_@O%%JylSUTtS>RhF5T|>j}{aw`~+f&X{dPFsPj^iAB z%a!FRS9H!7%0cHuNF7KfLt@x2h!_4WJ12)440cBHc45XS6!-RqzQOOpF!$uo7$;JA zK|U_eyrJyu@YB{>CvC4$sieD6HSn@}J;6*GDKVZveXsI|;fxWy9T^=BWDV)Ej}%hlF+W8<513l!?O zGs+vDC%Txh+7-Az!Z5ODM=&K-e0AZwT5t8M!RBLp!b}{gjAVIV%%Z`9=clV{FICCJodNS>7W)e z&v8BrxRbv1Jh{IkD%ByUKSr$u37o;PF+iT1KS~m5j6fh^Q9S17#CwBGWDVov%RXFL z;6zdB-ky4dlgTnDHHMJ*N?ns!^9}xxwE%N!o;vHk-t|#y2Kw?HA;HhY-VM)fm0$4j z8O!IPcQ?LbVy$g$;wF?~v>9sTl)j7G3(T$tecQ0LogEiK(WY|%!`xmEnspu{0+tgg zL7+Y;_E>T8&agw>#q3@jMost; zq}ljrV=$VUKuJw4j#^-pVrqH0N{jvW_SW)+iSdoKbyC9HTwfDUuYp$|zH=~RLe4qJ zV!gb*0eZNxv0FFr|F19^M^1J_Z_Ba@SZT1q@d^}Po%@GCB7xI!a&gJ)JgGMv z+nb?=K&XQGY`Nu2+PC5M#hcg;;#7}E?3;kxU+`M-`}xVyk=OlgK?2>t!v-Ts{q6)0 z-D^>i2nA-@wI<_g5P(vx260%v==zLhZxp0A{XAZeQpm9x`E5T*q`=IPHJVKS%Gkst zp5NAm^An8k__GxXS@9|;EoC%Wr04#_@&24j?~$3YF@Woln9jr{#vst^8}^AsntcZ7 zq;&GbVUrOqK5fBdU1g=JhKAC;ol-7Ep?(!9q#FaP|KU10(yTLuS2&5Z=O*rMp?5+y z8*N;3xnL1Wh>tH1I9M8o0e}`@VKNB`ky}wP;r^PaU2WWnJKEh;qM;@7{wsq-pJ+B$ zG#vf=SE$8a&oD`y^j5_3=6nwTnX+peVT^5%yH8aH21#GU0`v;C@^~#E4x^b)nY>qM z6w2rmIxG||wUfBmYald?~WdS&~H5!ZE{-sD~LYnC66P`UsaW=-yU9#VN! zRpixfTBMZ%n>Vaj?_O?szg0&__)7m}JnzQFmyx7WRu(Md|D`O+kQ-sDc(W!PNXRV9 zptUV+vv@rE)0^qR%xWkm!|6+fxr)U1kft@RCa##Ap zIXe#zVQjLQ&4&*ki5MWB+dm_|d|~3ER|X6lfUtC1U31`DHao^e073LWHkAVinMUgi zR(7t!nwleEUx$H#F`CIE@AYGi1uv?jqGE3w_UHF+eZ!GFs_+q;Mc3iaBI$yH%&r#9 zw6NO&<|z+oM@I*+KwiCkxfZxf_vY~s&iSQUov9NiuY0?1)f|;S1wB2BXl`oWnEG2n zp)J9mObKcXj1+ihXJ>3GbqK!a(r?D4qcI zl8u3=f0>*?+{*GKdgkV9Gh5e7nZCkeV$uN!O8}d2aBx&CI0emuGSmPgxv;iI&%hw< zGG9IIlBM(n7s^8Rr20hTpk9~!>zuQTvoiqBfwBU?M^oE2eHlrxI4JP8b2(cq%Liim zE!Tq2#_Q|rX~f(YU;EL&!@}&ZF=+)bt*G0dNNWcvGNR*1Uk`@ooTPYBl$4Yg7Z<`{ z9^m@?{8L1v-k#p3CMKgBo|~JShv~*=E8Rh@RaGu~ze@oY>=&O9;nElXlne_wld*7U|aO(kMT=- z1_0etQ~%E+tPb!PCoo|@>)Y}2SnZgbnJJle{Aue26dn-iL~5mE@k7@9&$fn*OQs3_ zYk;2sNFhM9tQ*e#O-xLhjd}7l7@p6h3XncYkNmH(Q^WxmuC3*LBz1Cl=vt%|1HeXc zTB`U}fR^_#;ztb(MiV~*$uOq^zYNbHiU=Q2eyweLI1f7e-rO7u0DQS30PZ>ay1G{P za8}GY7is;2!{OW8+lW+3?od7K+ur_K`PzkN|6lWaz`V(R=$yx<1&Umtmp+PyKJp%J zZg%cIAVyU;D+fD92RnB=FDoBATSn_ZMnzpMMrB72Zy#?PFDFkQMs`~}KPMZzSDx-} ZURM4bco{Q#&A@p;s)`y4wQ`ow{{thmTIB!$ literal 0 HcmV?d00001 diff --git a/src/rings/rings.c b/src/rings/rings.c new file mode 100644 index 0000000..e6a55cb --- /dev/null +++ b/src/rings/rings.c @@ -0,0 +1,278 @@ +/* +** Rings: Multiple Lua States +** $Id: rings.c,v 1.7 2007/06/11 23:36:37 carregal Exp $ +** See Copyright Notice in license.html +*/ + +#include "string.h" + +#include "lua.h" +#include "lualib.h" +#include "lauxlib.h" + + +#define RINGS_TABLENAME "rings" +#define RINGS_CACHE "rings cache" +#define STATE_METATABLE "state metatable" + + +typedef struct { + lua_State *L; +} state_data; + + +int luaopen_rings (lua_State *L); + + +/* +** Get a State object from the first call stack position. +*/ +static state_data *getstate (lua_State *L) { + state_data *s = (state_data *)luaL_checkudata (L, 1, STATE_METATABLE); + luaL_argcheck (L, s != NULL, 1, "not a Lua State"); + luaL_argcheck (L, s->L, 1, "already closed state"); + return s; +} + + +/* +** +*/ +static int state_tostring (lua_State *L) { + state_data *s = (state_data *)luaL_checkudata (L, 1, STATE_METATABLE); + lua_pushfstring (L, "Lua State (%p)", s); + return 1; +} + + +/* +** Copies values from State src to State dst. +*/ +static void copy_values (lua_State *dst, lua_State *src, int i, int top) { + for (; i <= top; i++) { + switch (lua_type (src, i)) { + case LUA_TNUMBER: + lua_pushnumber (dst, lua_tonumber (src, i)); + break; + case LUA_TBOOLEAN: + lua_pushboolean (dst, lua_toboolean (src, i)); + break; + case LUA_TSTRING: { + const char *string = lua_tostring (src, i); + size_t length = lua_strlen (src, i); + lua_pushlstring (dst, string, length); + break; + } + case LUA_TUSERDATA: + case LUA_TLIGHTUSERDATA: { + lua_pushlightuserdata (dst, lua_touserdata (src, i)); + break; + } + case LUA_TNIL: + default: + lua_pushnil (dst); + break; + } + } +} + + +/* +** Obtains a function which is the compiled string in the given state. +** It also caches the resulting function to optimize future uses. +** Leaves the compiled function on top of the stack or the error message +** produced by luaL_loadbuffer. +*/ +static int compile_string (lua_State *L, const char *str) { + lua_pushliteral (L, RINGS_CACHE); + lua_gettable (L, LUA_REGISTRYINDEX); /* push cache table */ + lua_pushstring (L, str); + lua_gettable (L, -2); /* cache[str] */ + if (!lua_isfunction (L, -1)) { + int status; + lua_pop (L, 1); /* remove cache[str] (= nil) from top of the stack */ + status = luaL_loadbuffer (L, str, strlen(str), str); /* Compile */ + if (status != 0) { /* error? */ + lua_remove (L, -2); /* removes cache table; leaves the error message */ + return status; + } + /* Stores the produced function at cache[str] */ + lua_pushstring (L, str); + lua_pushvalue (L, -2); + lua_settable (L, -4); /* cache[str] = func */ + } + lua_remove (L, -2); /* removes cache table; leaves the function */ + return 0; +} + + +/* +** Executes a string of code from State src into State dst. +** idx is the index of the string of code. +*/ +static int dostring (lua_State *dst, lua_State *src, int idx) { + const char *str = luaL_checkstring (src, idx); + int base = lua_gettop (dst); + idx++; /* ignore first argument (string of code) */ + if (compile_string (dst, str) == 0) { /* Compile OK? => push function */ + int arg_top = lua_gettop (src); + copy_values (dst, src, idx, arg_top); /* Push arguments to dst stack */ + if (lua_pcall (dst, arg_top-idx+1, LUA_MULTRET, 0) == 0) { /* run OK? */ + int ret_top = lua_gettop (dst); + lua_pushboolean (src, 1); /* Push status = OK */ + copy_values (src, dst, base+1, ret_top); /* Return values to src */ + lua_pop (dst, ret_top-base); + return 1+(ret_top-base); /* Return true (success) plus return values */ + } + } + lua_pushboolean (src, 0); /* Push status = ERR */ + lua_pushstring (src, lua_tostring (dst, -1)); + lua_pop (dst, 1); /* pops result from dst state */ + return 2; +} + + +/* +** Executes a string of Lua code in the master state. +*/ +static int master_dostring (lua_State *S) { + lua_State *M = (lua_State *)lua_touserdata (S, lua_upvalueindex (1)); + return dostring (M, S, 1); +} + + +/* +** Executes a string of Lua code in a given slave state. +*/ +static int slave_dostring (lua_State *M) { + state_data *s = getstate (M); /* S == s->L */ + return dostring (s->L, M, 2); +} + + +/* +** Creates a weak table in the registry. +*/ +static void create_cache (lua_State *L) { + lua_pushliteral (L, RINGS_CACHE); + lua_newtable (L); + lua_newtable (L); /* cache metatable */ + lua_pushliteral (L, "__mode"); + lua_pushliteral (L, "kv"); + lua_settable (L, -3); /* metatable.__mode = "kv" */ + lua_setmetatable (L, -2); + lua_settable (L, LUA_REGISTRYINDEX); +} + + +/* +** Creates a new Lua State and returns an userdata that represents it. +*/ +static int state_new (lua_State *L) { + state_data *s = (state_data *)lua_newuserdata (L, sizeof (state_data)); + s->L = NULL; + luaL_getmetatable (L, STATE_METATABLE); + lua_setmetatable (L, -2); + s->L = lua_open (); + + /* load base libraries */ + luaL_openlibs(s->L); + + /* define dostring function (which runs strings on the master state) */ + lua_pushliteral (s->L, "remotedostring"); + lua_pushlightuserdata (s->L, L); + lua_pushcclosure (s->L, master_dostring, 1); + lua_settable (s->L, LUA_GLOBALSINDEX); + + create_cache (s->L); + + return 1; +} + + +/* +** Closes a Lua State. +** Returns `true' in case of success; `nil' when the state was already closed. +*/ +static int slave_close (lua_State *L) { + state_data *s = (state_data *)luaL_checkudata (L, 1, STATE_METATABLE); + luaL_argcheck (L, s != NULL, 1, "not a Lua State"); + if (s->L == NULL) + return 0; + lua_close (s->L); + s->L = NULL; + lua_pushboolean (L, 1); + return 1; +} + + +/* +** Creates the metatable for the state on top of the stack. +*/ +static int state_createmetatable (lua_State *L) { + /* State methods */ + struct luaL_reg methods[] = { + {"close", slave_close}, + {"dostring", slave_dostring}, + {NULL, NULL}, + }; + /* State metatable */ + if (!luaL_newmetatable (L, STATE_METATABLE)) { + return 0; + } + /* define methods */ + luaL_openlib (L, NULL, methods, 0); + /* define metamethods */ + lua_pushliteral (L, "__gc"); + lua_pushcfunction (L, slave_close); + lua_settable (L, -3); + + lua_pushliteral (L, "__index"); + lua_pushvalue (L, -2); + lua_settable (L, -3); + + lua_pushliteral (L, "__tostring"); + lua_pushcfunction (L, state_tostring); + lua_settable (L, -3); + + lua_pushliteral (L, "__metatable"); + lua_pushliteral (L, "You're not allowed to get the metatable of a Lua State"); + lua_settable (L, -3); + return 1; +} + + +/* +** +*/ +static void set_info (lua_State *L) { + lua_pushliteral (L, "_COPYRIGHT"); + lua_pushliteral (L, "Copyright (C) 2006-2007 Kepler Project"); + lua_settable (L, -3); + lua_pushliteral (L, "_DESCRIPTION"); + lua_pushliteral (L, "Rings: Multiple Lua States"); + lua_settable (L, -3); lua_pushliteral (L, "_VERSION"); + lua_pushliteral (L, "Rings 1.1.0"); + lua_settable (L, -3); +} + + +/* +** Opens library. +*/ +int luaopen_rings (lua_State *L) { + /* Library functions */ + struct luaL_reg rings[] = { + {"new", state_new}, + {NULL, NULL}, + }; + if (!state_createmetatable (L)) + return 0; + lua_pop (L, 1); + /* define library functions */ + luaL_openlib (L, RINGS_TABLENAME, rings, 0); + create_cache (L); + set_info (L); + + return 1; +} diff --git a/src/rings/stable.lua b/src/rings/stable.lua new file mode 100644 index 0000000..efeb62c --- /dev/null +++ b/src/rings/stable.lua @@ -0,0 +1,28 @@ +---------------------------------------------------------------------------- +-- Stable: State persistent table for Rings. +-- +-- Copyright (c) 2006-2007 Kepler Project +-- $Id: stable.lua,v 1.6 2007/06/11 23:36:37 carregal Exp $ +---------------------------------------------------------------------------- + +local remotedostring = assert (remotedostring, "There is no `remotedostring'. Probably not in a slave state") +-- creating persistent table at master state. +assert (remotedostring[[_state_persistent_table_ = _state_persistent_table_ or {}]]) + +module"stable" + +---------------------------------------------------------------------------- +_COPYRIGHT = "Copyright (C) 2006-2007 Kepler Project" +_DESCRIPTION = "State persistent table" +_VERSION = "Stable 1.0" + +---------------------------------------------------------------------------- +function get (i) + local ok, value = remotedostring ("return _state_persistent_table_[...]", i) + return value +end + +---------------------------------------------------------------------------- +function set (i, v) + remotedostring ("_state_persistent_table_[select(1,...)] = select(2,...)", i, v) +end diff --git a/src/samples/hello_world.lua b/src/samples/hello_world.lua new file mode 100644 index 0000000..4aa1bca --- /dev/null +++ b/src/samples/hello_world.lua @@ -0,0 +1,7 @@ +-- The message numbered (1) will display at compilation, i.e. before +-- (2) is displayed (supposing that compilation and execution are +-- both requested) + +print "(2) This is a runtime message: Hello world!" +-{ print "(1) This is a compile-time message: Hello world!" } + diff --git a/src/setup.sh b/src/setup.sh new file mode 100755 index 0000000..691efc7 --- /dev/null +++ b/src/setup.sh @@ -0,0 +1,4 @@ +#!/bin/bash +export METALUA_INIT="require [[std]]" +export METALUA_PATH="./?.lua;/tmp/lua/?.lua;./?.luac;/tmp/lua/?.luac" +export METALUA_CPATH="/tmp/lua/?.dylib;/tmp/lua/?/linit.dylib" -- 2.44.0