Compare commits

...

156 Commits

Author SHA1 Message Date
Roberto Ierusalimschy
981fddea02 module to load bytecodes from files. 1998-01-14 13:49:01 -02:00
Roberto Ierusalimschy
81b953f27e details 1998-01-14 11:49:44 -02:00
Roberto Ierusalimschy
b9acf4b4af "strcoll" may not exist in ond ansi machines 1998-01-14 11:49:15 -02:00
Roberto Ierusalimschy
44ace0aefd we don't need a type "Word". 1998-01-14 11:48:28 -02:00
Roberto Ierusalimschy
5981161360 small optimizations (?) 1998-01-13 16:06:27 -02:00
Roberto Ierusalimschy
763c64be9b details 1998-01-13 13:42:43 -02:00
Roberto Ierusalimschy
f0dffaa209 new way to hanlde arg information 1998-01-12 11:35:37 -02:00
Roberto Ierusalimschy
77a6836fef we don't need a type "Word". 1998-01-12 11:00:51 -02:00
Roberto Ierusalimschy
9f043e8017 luaL_arg_check now is inlined 1998-01-09 13:09:53 -02:00
Roberto Ierusalimschy
6ac047afc4 details 1998-01-09 12:57:43 -02:00
Roberto Ierusalimschy
0e1058cfdd small optimizations in switch order 1998-01-09 12:44:55 -02:00
Roberto Ierusalimschy
26679b1a48 back to upavalues as extra arguments for C closures; this way it's
trivial to make currying.
1998-01-07 14:26:48 -02:00
Roberto Ierusalimschy
e04c2b9aa8 details 1998-01-06 17:17:31 -02:00
Roberto Ierusalimschy
0c031dcc8b details 1998-01-05 15:12:54 -02:00
Roberto Ierusalimschy
c332c4e927 reference manual of the Lua language 1998-01-02 16:34:00 -02:00
Roberto Ierusalimschy
964c503a63 LUA_COMPAT2.5 may use #ifdef instead of #if 1998-01-02 15:46:32 -02:00
Roberto Ierusalimschy
90d87e3a78 details 1997-12-30 17:15:52 -02:00
Roberto Ierusalimschy
f76bca23ef variants for "ARGS". 1997-12-30 17:08:23 -02:00
Roberto Ierusalimschy
a5fd7d722c opctional "base" in "tonumber" convertion. 1997-12-30 15:57:45 -02:00
Roberto Ierusalimschy
4e0bf95622 variant opcodes for PUSHSELF 1997-12-29 15:35:46 -02:00
Roberto Ierusalimschy
498a934abf new syntax possibilities: f(x).x, etc; on the other hand,
"function ... (x)" now is more restricted.
1997-12-29 15:28:45 -02:00
Roberto Ierusalimschy
ce53872684 new syntax: f´s´ for f(´s´). 1997-12-28 20:48:15 -02:00
Roberto Ierusalimschy
da96eb2cce some details related to OLD_ANSI 1997-12-26 16:38:16 -02:00
Roberto Ierusalimschy
fada8efd01 "rand()", in SunOS, may return values bigger than "RAND_MAX"... 1997-12-26 16:36:31 -02:00
Roberto Ierusalimschy
d916487d7c auxlib split in two parts (lauxlib and lbuffer) 1997-12-23 17:24:36 -02:00
Roberto Ierusalimschy
1bf762ba38 Generic buffer facilities for Lua (and libraries) 1997-12-23 17:24:36 -02:00
Roberto Ierusalimschy
541e722360 details 1997-12-23 17:24:19 -02:00
Roberto Ierusalimschy
807ba6301c error method *always* gets a string (otherwise it is not called at all) 1997-12-23 10:50:49 -02:00
Roberto Ierusalimschy
03f3f9e707 "zio" now keeps its "name". 1997-12-22 18:57:18 -02:00
Roberto Ierusalimschy
a78eecee48 details (aborts with invalid arguments) 1997-12-22 18:03:50 -02:00
Roberto Ierusalimschy
43461d267f help message 1997-12-22 16:05:23 -02:00
Roberto Ierusalimschy
fae0b52825 small bugs in error report 1997-12-22 15:52:20 -02:00
Roberto Ierusalimschy
22439a7511 new syntax for constructors (a={n=3;1,2,3}). 1997-12-22 15:24:11 -02:00
Roberto Ierusalimschy
7ecc3ce827 new command line options 1997-12-19 16:34:23 -02:00
Roberto Ierusalimschy
4e91384e14 sorting the includes... 1997-12-18 17:11:43 -02:00
Roberto Ierusalimschy
de79e7fc58 back to "lua_upvalue"... (seems better choice) 1997-12-18 16:32:39 -02:00
Roberto Ierusalimschy
8b5b42563c "lua_dobuffer" (is not official, but its there...) 1997-12-17 18:57:20 -02:00
Roberto Ierusalimschy
502343b402 new scheme for buffers, centralized in auxlib. 1997-12-17 18:48:58 -02:00
Roberto Ierusalimschy
82d09fbf0d new structure for closures, without static variables. 1997-12-15 15:58:49 -02:00
Roberto Ierusalimschy
9be85d1648 new year 1997-12-15 15:47:55 -02:00
Roberto Ierusalimschy
45e533599f optimization: closures without upvalues don't need to be closures 1997-12-15 14:17:20 -02:00
Roberto Ierusalimschy
94144a7821 otimization: closures without upvalues don't need to be closures 1997-12-15 14:17:20 -02:00
Roberto Ierusalimschy
4daae2165d new API function and built-in "lua_copytagmethods" 1997-12-11 15:21:11 -02:00
Roberto Ierusalimschy
cdd261f332 new option "-q" (quiet), and multi-line commands (ending with '\') 1997-12-11 15:00:21 -02:00
Roberto Ierusalimschy
034f16892e better treatment of MARKs and DEBUG cases. 1997-12-11 12:48:46 -02:00
Roberto Ierusalimschy
c759520bc8 safer way to put #defines in error messages... 1997-12-09 14:01:08 -02:00
Roberto Ierusalimschy
80b3d28f4a details (mainly error messages) 1997-12-09 11:50:08 -02:00
Roberto Ierusalimschy
69d97712ec arguments "var=value" doesn't need quotes for value 1997-12-03 17:57:54 -02:00
Roberto Ierusalimschy
5d89dad9b8 bug log 1997-12-02 10:46:15 -02:00
Roberto Ierusalimschy
525a91fed3 BUG: "lastline" was not reset on function entry, so debug information
started only in the 2nd line of a function.
1997-12-02 10:43:54 -02:00
Roberto Ierusalimschy
868d16dee0 comments 1997-12-02 10:43:44 -02:00
Roberto Ierusalimschy
3393fd7f25 first version of "lua_close" 1997-12-01 18:31:25 -02:00
Roberto Ierusalimschy
00c122cc29 other distribution of memory debug information. 1997-12-01 18:30:44 -02:00
Roberto Ierusalimschy
03160920cf store "functofind" in stack top, so doesn't need this field in
global state.
1997-11-28 14:56:05 -02:00
Roberto Ierusalimschy
b42cc6a4d2 no more protected global variables; using upvalues to store tags. 1997-11-28 10:40:37 -02:00
Roberto Ierusalimschy
a6ad644bf2 no more protected global variables 1997-11-28 10:39:45 -02:00
Roberto Ierusalimschy
39fd5bb9b0 details 1997-11-28 10:39:22 -02:00
Roberto Ierusalimschy
5482992dec other access method for C upvalues (as arguments) 1997-11-27 16:25:14 -02:00
Roberto Ierusalimschy
024528e0c2 global variables starting with '.' are protected in Lua (temporarily at
least...)
1997-11-27 13:59:44 -02:00
Roberto Ierusalimschy
ef37c87e93 no more 'globalbag' 1997-11-27 13:59:25 -02:00
Roberto Ierusalimschy
9e029f98b9 details 1997-11-26 18:44:52 -02:00
Roberto Ierusalimschy
e962330df9 "stacklimit" is not necessary. 1997-11-26 18:28:22 -02:00
Roberto Ierusalimschy
b291e50006 extra argument for "assert" 1997-11-26 17:40:27 -02:00
Roberto Ierusalimschy
9ae0c082a3 small details by lint. 1997-11-26 16:53:45 -02:00
Roberto Ierusalimschy
accd7bc253 small modifications (format, small optimizations, etc) 1997-11-21 17:00:46 -02:00
Roberto Ierusalimschy
6153200bc2 make sure there is no mem problems, using %.ns instead of %s for luaV_error. 1997-11-19 16:16:33 -02:00
Roberto Ierusalimschy
2e7595522d allows '\r' at the end of pragmas, so one can mix Windows and Unix files 1997-11-19 15:35:47 -02:00
Roberto Ierusalimschy
b79ffdc4ce global state for Lua interpreter 1997-11-19 15:31:19 -02:00
Roberto Ierusalimschy
592a3f289b first implementation of centralized global state. 1997-11-19 15:29:23 -02:00
Roberto Ierusalimschy
9cdeb275e7 details 1997-11-10 15:47:01 -02:00
Roberto Ierusalimschy
c957b270d2 "call" now handles errors (instead of "dostring") 1997-11-07 16:19:13 -02:00
Roberto Ierusalimschy
92791b9dd6 small details 1997-11-07 13:09:49 -02:00
Roberto Ierusalimschy
45cad43c3f "lua_open": now lua has an explicit open operation. 1997-11-04 13:27:53 -02:00
Roberto Ierusalimschy
dad5a01fb0 trigonometric mode stored in a Lua global variable. 1997-11-03 19:11:44 -02:00
Roberto Ierusalimschy
66713181c1 no need of "emergency error"... 1997-11-03 19:00:23 -02:00
Roberto Ierusalimschy
7135803cc8 "global" version of a nil object. 1997-11-03 18:45:23 -02:00
Roberto Ierusalimschy
b7567b6673 "read" & "write" may receive a file handler as first argument 1997-10-30 18:29:09 -02:00
Roberto Ierusalimschy
f8c95fa9e8 new "block" syntax (DO ... END) 1997-10-30 16:47:19 -02:00
Roberto Ierusalimschy
9c965d0ffb more precise error messages for compiler limits. 1997-10-28 15:26:53 -02:00
Roberto Ierusalimschy
6103dca8ee small bug. 1997-10-27 14:14:37 -02:00
Roberto Ierusalimschy
18cd7adac6 optimization to handle <a.x> (new opcode). 1997-10-24 16:40:29 -02:00
Roberto Ierusalimschy
41223a01ec definition of "PI" and modes for angles. 1997-10-24 15:44:22 -02:00
Roberto Ierusalimschy
e78cf96c97 first version of Cclosures. 1997-10-24 15:17:24 -02:00
Roberto Ierusalimschy
0cb3843956 "foreach" and "foreachvar" more robust (to survive GCs), and with
termination test.
1997-10-23 14:28:48 -02:00
Roberto Ierusalimschy
907368ead5 GC now considers an "estimate" of object size, instead of just the number
of objects.
1997-10-23 14:26:37 -02:00
Roberto Ierusalimschy
81489beea1 functions may use many upvalues, to keep global values. 1997-10-18 14:46:39 -02:00
Roberto Ierusalimschy
ac30aad09b new functions "foreach" and "foreachvar" 1997-10-18 14:33:36 -02:00
Roberto Ierusalimschy
2c89651fc6 macro "val" should live together with macro "ref". 1997-10-18 14:29:15 -02:00
Roberto Ierusalimschy
3a89c973ff details 1997-10-16 19:14:47 -02:00
Roberto Ierusalimschy
52d5e8032c better identification of types which are tags 1997-10-16 18:07:40 -02:00
Roberto Ierusalimschy
19c178fa14 new (smaller) prompt 1997-10-16 16:35:59 -02:00
Roberto Ierusalimschy
45ccb0e881 "nupvalues" is kept in Closure, not in prototype (as a preparation
for C closures...)
1997-10-16 08:59:34 -02:00
Roberto Ierusalimschy
4be18fa889 details 1997-10-15 18:16:00 -02:00
Roberto Ierusalimschy
7c261a13b5 more uniform treatment to opcode variants. 1997-10-13 20:12:04 -02:00
Roberto Ierusalimschy
2bb94d9e22 using bison instead of yacc; lparser.c renamed to lstx.c (to
avoid confusion with lparser.h...)
1997-10-13 20:10:45 -02:00
Roberto Ierusalimschy
a3235ad270 prompt for interactive mode 1997-10-06 12:51:32 -02:00
Roberto Ierusalimschy
f6a9cc9a67 jumps are relative to next instruction 1997-10-06 12:51:11 -02:00
Roberto Ierusalimschy
28d47a0aaa all jumps have byte variants; WHILE optimization 1997-10-01 17:05:34 -03:00
Roberto Ierusalimschy
eb617df2d8 better way to traverse GCnode lists. 1997-09-26 13:46:20 -03:00
Roberto Ierusalimschy
a580480b07 new implementation for globals: Global value is stored in TaggedString 1997-09-26 12:02:26 -03:00
Roberto Ierusalimschy
0dd6d1080e new opcode variants. 1997-09-24 16:43:11 -03:00
Roberto Ierusalimschy
3c820d622e better control over closed files 1997-09-23 11:12:44 -03:00
Roberto Ierusalimschy
d6c867ea50 better way to cope with opcode variants 1997-09-22 17:53:20 -03:00
Roberto Ierusalimschy
2079cfe8fa new way to code globals, using const table instead of putting global
index inside the opcode.
1997-09-19 18:17:52 -03:00
Roberto Ierusalimschy
dfe03c7abe small optimizations (bit scrubbing) 1997-09-19 15:40:32 -03:00
Roberto Ierusalimschy
8cd67ac676 Syntax analizer and code generator 1997-09-16 16:33:21 -03:00
Roberto Ierusalimschy
9828893f7e Makefile 1997-09-16 16:33:21 -03:00
Roberto Ierusalimschy
6990da0057 Lua virtual machine 1997-09-16 16:25:59 -03:00
Roberto Ierusalimschy
d985dc0629 Opcodes for Lua virtual machine 1997-09-16 16:25:59 -03:00
Roberto Ierusalimschy
451124005b Standard I/O (and system) library 1997-09-16 16:25:59 -03:00
Roberto Ierusalimschy
2f1fa3d427 Type definitions for Lua objects 1997-09-16 16:25:59 -03:00
Roberto Ierusalimschy
189d64409b Garbage Collector 1997-09-16 16:25:59 -03:00
Roberto Ierusalimschy
60cc473bcf Lexical Analizer 1997-09-16 16:25:59 -03:00
Roberto Ierusalimschy
43a2ee6ea1 Stack and Call structure of Lua 1997-09-16 16:25:59 -03:00
Roberto Ierusalimschy
4b91e9cde6 Tag methods 1997-09-16 16:25:59 -03:00
Roberto Ierusalimschy
26c5f56ad1 Built-in functions 1997-09-16 16:25:59 -03:00
Roberto Ierusalimschy
daa858ef27 String table (keep all strings handled by Lua) 1997-09-16 16:25:59 -03:00
Roberto Ierusalimschy
ea169d2083 auxiliar functions from Lua API 1997-09-16 16:25:59 -03:00
Roberto Ierusalimschy
c31aa863ac Auxiliar functions for building Lua libraries 1997-09-16 16:25:59 -03:00
Roberto Ierusalimschy
ff08b0f406 Lua Function structures 1997-09-16 16:25:59 -03:00
Roberto Ierusalimschy
c1801e623f Some generic functions over Lua objects 1997-09-16 16:25:59 -03:00
Roberto Ierusalimschy
a404f6e0e6 Lua tables (hash) 1997-09-16 16:25:59 -03:00
Roberto Ierusalimschy
2d2440a753 Lua stand-alone interpreter 1997-09-16 16:25:59 -03:00
Roberto Ierusalimschy
0c4ed2b3dc main header file 1997-09-16 16:25:59 -03:00
Roberto Ierusalimschy
b945fae40e Lua standard mathematical library 1997-09-16 16:25:59 -03:00
Roberto Ierusalimschy
dadba4d6ed Interface to Memory Manager 1997-09-16 16:25:59 -03:00
Roberto Ierusalimschy
d600a6b5b3 a generic input stream interface 1997-09-16 16:25:59 -03:00
Roberto Ierusalimschy
75ac0d2172 Standard library for strings and pattern-matching 1997-09-16 16:25:59 -03:00
Roberto Ierusalimschy
9f3785a2f3 Lua standard libraries 1997-09-16 16:25:59 -03:00
Roberto Ierusalimschy
84e92e0976 Debuging API 1997-09-16 16:25:59 -03:00
Roberto Ierusalimschy
b8a049abed Global variables 1997-09-16 16:25:59 -03:00
Roberto Ierusalimschy
e18f681333 very small corrections... 1997-09-16 16:01:10 -03:00
Roberto Ierusalimschy
dd1aa28390 small optimization in opcodes for "and" and "or" 1997-08-04 16:15:05 -03:00
Roberto Ierusalimschy
abbf14cd32 small optimizations; try to find previous use when coding a real constant. 1997-07-31 17:46:59 -03:00
Roberto Ierusalimschy
e8292f076d new dependencies 1997-07-31 17:45:25 -03:00
Roberto Ierusalimschy
3037dccaf6 prime numbers spread better. 1997-07-31 17:44:46 -03:00
Roberto Ierusalimschy
a7793468aa correct support for changing real to double (optional) 1997-07-31 16:37:37 -03:00
Roberto Ierusalimschy
caa987faad "random" accepts an 'n' to return between 1 and 'n'. 1997-07-30 19:15:18 -03:00
Roberto Ierusalimschy
0892f0e5b7 BIG CHANGE: functions have their own "constant table". 1997-07-30 19:00:50 -03:00
Roberto Ierusalimschy
1d7857bc63 free(b) is equivalent to realloc(b, 0) 1997-07-30 15:29:08 -03:00
Roberto Ierusalimschy
72a1d81b51 bug: lua_getlocal breaks when called with a CFunction. 1997-07-29 18:11:10 -03:00
Roberto Ierusalimschy
2c580a0afb new way to handle global state during compilation. 1997-07-29 17:38:45 -03:00
Roberto Ierusalimschy
05e8b0ae80 new opcode, ENDCODE, to signal end of code vector. 1997-07-29 17:38:06 -03:00
Roberto Ierusalimschy
16dd77e8d9 unused field "size" in struct TFunc. 1997-07-29 16:44:02 -03:00
Roberto Ierusalimschy
0600f968c3 BUG: LUA_COMPAT2_5 written wrong... 1997-07-29 10:35:06 -03:00
Roberto Ierusalimschy
971b1d557d bug log. Most of the log is done automatically by RCS, and not in
the file itself :-)
1997-07-29 10:34:15 -03:00
Roberto Ierusalimschy
11d97c34d5 skipping of '#' in first line is done by lex.c. 1997-07-29 10:33:15 -03:00
Roberto Ierusalimschy
66be42549e BUG: files starting with '#' get wrong line numbers 1997-07-07 18:05:51 -03:00
Roberto Ierusalimschy
067db30d71 "next" & "nextvar" check if argument is a result of previous calls 1997-07-07 13:44:26 -03:00
Roberto Ierusalimschy
da4dbe65b2 new functionality for "format": "%d$...". 1997-07-04 19:35:38 -03:00
Roberto Ierusalimschy
4321fde2a7 error inside an error method could break the stack. 1997-07-04 11:55:37 -03:00
Roberto Ierusalimschy
8f3df1d471 small details. 1997-07-02 15:50:18 -03:00
Roberto Ierusalimschy
1a17211707 auxliar support for "locale" (to avoid portability problems) 1997-07-02 15:45:09 -03:00
Roberto Ierusalimschy
d56e3a6481 "locale" support + better uniformity in formating 1997-07-02 14:09:48 -03:00
Roberto Ierusalimschy
7820a47184 LOCALE support 1997-07-01 16:32:41 -03:00
Roberto Ierusalimschy
88b185ada1 more uniform source (more macros...) 1997-07-01 14:41:34 -03:00
73 changed files with 7834 additions and 6829 deletions

View File

@@ -1,81 +0,0 @@
char *rcs_auxlib="$Id: auxlib.c,v 1.4 1997/04/07 14:48:53 roberto Exp roberto $";
#include <stdio.h>
#include <stdarg.h>
#include <string.h>
#include "lua.h"
#include "auxlib.h"
#include "luadebug.h"
int luaI_findstring (char *name, char *list[])
{
int i;
for (i=0; list[i]; i++)
if (strcmp(list[i], name) == 0)
return i;
return -1; /* name not found */
}
void luaL_arg_check(int cond, int numarg, char *extramsg)
{
if (!cond) {
char *funcname;
lua_getobjname(lua_stackedfunction(0), &funcname);
if (funcname == NULL)
funcname = "???";
if (extramsg == NULL)
luaL_verror("bad argument #%d to function `%s'", numarg, funcname);
else
luaL_verror("bad argument #%d to function `%s' (%s)",
numarg, funcname, extramsg);
}
}
char *luaL_check_string (int numArg)
{
lua_Object o = lua_getparam(numArg);
luaL_arg_check(lua_isstring(o), numArg, "string expected");
return lua_getstring(o);
}
char *luaL_opt_string (int numArg, char *def)
{
return (lua_getparam(numArg) == LUA_NOOBJECT) ? def :
luaL_check_string(numArg);
}
double luaL_check_number (int numArg)
{
lua_Object o = lua_getparam(numArg);
luaL_arg_check(lua_isnumber(o), numArg, "number expected");
return lua_getnumber(o);
}
double luaL_opt_number (int numArg, double def)
{
return (lua_getparam(numArg) == LUA_NOOBJECT) ? def :
luaL_check_number(numArg);
}
void luaL_openlib (struct luaL_reg *l, int n)
{
int i;
for (i=0; i<n; i++)
lua_register(l[i].name, l[i].func);
}
void luaL_verror (char *fmt, ...)
{
char buff[1000];
va_list argp;
va_start(argp, fmt);
vsprintf(buff, fmt, argp);
va_end(argp);
lua_error(buff);
}

View File

@@ -1,30 +0,0 @@
/*
** $Id: auxlib.h,v 1.2 1997/04/06 14:08:08 roberto Exp roberto $
*/
#ifndef auxlib_h
#define auxlib_h
#include "lua.h"
struct luaL_reg {
char *name;
lua_CFunction func;
};
void luaL_openlib (struct luaL_reg *l, int n);
void luaL_arg_check(int cond, int numarg, char *extramsg);
char *luaL_check_string (int numArg);
char *luaL_opt_string (int numArg, char *def);
double luaL_check_number (int numArg);
double luaL_opt_number (int numArg, double def);
void luaL_verror (char *fmt, ...);
/* -- private part (only for Lua modules */
int luaI_findstring (char *name, char *list[]);
#endif

4
bugs Normal file
View File

@@ -0,0 +1,4 @@
** lua.stx / llex.c
Tue Dec 2 10:45:48 EDT 1997
>> BUG: "lastline" was not reset on function entry, so debug information
>> started only in the 2nd line of a function.

View File

@@ -1,368 +0,0 @@
/*
** fallback.c
** TecCGraf - PUC-Rio
*/
char *rcs_fallback="$Id: fallback.c,v 2.8 1997/06/17 17:27:07 roberto Exp roberto $";
#include <stdio.h>
#include <string.h>
#include "auxlib.h"
#include "luamem.h"
#include "fallback.h"
#include "opcode.h"
#include "lua.h"
#include "table.h"
#include "tree.h"
#include "hash.h"
/* -------------------------------------------
** Reference routines
*/
static struct ref {
TObject o;
enum {LOCK, HOLD, FREE, COLLECTED} status;
} *refArray = NULL;
static int refSize = 0;
int luaI_ref (TObject *object, int lock)
{
int i;
int oldSize;
if (ttype(object) == LUA_T_NIL)
return -1; /* special ref for nil */
for (i=0; i<refSize; i++)
if (refArray[i].status == FREE)
goto found;
/* no more empty spaces */
oldSize = refSize;
refSize = growvector(&refArray, refSize, struct ref, refEM, MAX_WORD);
for (i=oldSize; i<refSize; i++)
refArray[i].status = FREE;
i = oldSize;
found:
refArray[i].o = *object;
refArray[i].status = lock ? LOCK : HOLD;
return i;
}
void lua_unref (int ref)
{
if (ref >= 0 && ref < refSize)
refArray[ref].status = FREE;
}
TObject *luaI_getref (int ref)
{
static TObject nul = {LUA_T_NIL, {0}};
if (ref == -1)
return &nul;
if (ref >= 0 && ref < refSize &&
(refArray[ref].status == LOCK || refArray[ref].status == HOLD))
return &refArray[ref].o;
else
return NULL;
}
void luaI_travlock (int (*fn)(TObject *))
{
int i;
for (i=0; i<refSize; i++)
if (refArray[i].status == LOCK)
fn(&refArray[i].o);
}
void luaI_invalidaterefs (void)
{
int i;
for (i=0; i<refSize; i++)
if (refArray[i].status == HOLD && !luaI_ismarked(&refArray[i].o))
refArray[i].status = COLLECTED;
}
/* -------------------------------------------
* Internal Methods
*/
char *luaI_eventname[] = { /* ORDER IM */
"gettable", "settable", "index", "getglobal", "setglobal", "add",
"sub", "mul", "div", "pow", "unm", "lt", "le", "gt", "ge",
"concat", "gc", "function",
NULL
};
static int luaI_checkevent (char *name, char *list[])
{
int e = luaI_findstring(name, list);
if (e < 0)
luaL_verror("`%s' is not a valid event name", name);
return e;
}
struct IM *luaI_IMtable = NULL;
static int IMtable_size = 0;
static int last_tag = LUA_T_NIL; /* ORDER LUA_T */
/* events in LUA_T_LINE are all allowed, since this is used as a
* 'placeholder' for "default" fallbacks
*/
static char validevents[NUM_TYPES][IM_N] = { /* ORDER LUA_T, ORDER IM */
{1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1}, /* LUA_T_USERDATA */
{1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}, /* LUA_T_LINE */
{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, /* LUA_T_CMARK */
{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, /* LUA_T_MARK */
{1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0}, /* LUA_T_CFUNCTION */
{1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0}, /* LUA_T_FUNCTION */
{0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}, /* LUA_T_ARRAY */
{1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, /* LUA_T_STRING */
{1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1}, /* LUA_T_NUMBER */
{1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1} /* LUA_T_NIL */
};
static int validevent (lua_Type t, int e)
{ /* ORDER LUA_T */
return (t < LUA_T_NIL) ? 1 : validevents[-t][e];
}
static void init_entry (int tag)
{
int i;
for (i=0; i<IM_N; i++)
ttype(luaI_getim(tag, i)) = LUA_T_NIL;
}
void luaI_initfallbacks (void)
{
if (luaI_IMtable == NULL) {
int i;
IMtable_size = NUM_TYPES+10;
luaI_IMtable = newvector(IMtable_size, struct IM);
for (i=LUA_T_NIL; i<=LUA_T_USERDATA; i++)
init_entry(i);
}
}
int lua_newtag (void)
{
--last_tag;
if ((-last_tag) >= IMtable_size) {
luaI_initfallbacks();
IMtable_size = growvector(&luaI_IMtable, IMtable_size,
struct IM, memEM, MAX_INT);
}
init_entry(last_tag);
return last_tag;
}
static void checktag (int tag)
{
if (!(last_tag <= tag && tag <= 0))
luaL_verror("%d is not a valid tag", tag);
}
void luaI_realtag (int tag)
{
if (!(last_tag <= tag && tag < LUA_T_NIL))
luaL_verror("tag %d is not result of `newtag'", tag);
}
void luaI_settag (int tag, TObject *o)
{
luaI_realtag(tag);
switch (ttype(o)) {
case LUA_T_ARRAY:
o->value.a->htag = tag;
break;
case LUA_T_USERDATA:
o->value.ts->tag = tag;
break;
default:
luaL_verror("cannot change the tag of a %s", luaI_typenames[-ttype(o)]);
}
}
int luaI_efectivetag (TObject *o)
{
lua_Type t = ttype(o);
if (t == LUA_T_USERDATA) {
int tag = o->value.ts->tag;
return (tag >= 0) ? LUA_T_USERDATA : tag;
}
else if (t == LUA_T_ARRAY)
return o->value.a->htag;
else return t;
}
void luaI_gettagmethod (void)
{
int t = (int)luaL_check_number(1);
int e = luaI_checkevent(luaL_check_string(2), luaI_eventname);
checktag(t);
if (validevent(t, e))
luaI_pushobject(luaI_getim(t,e));
}
void luaI_settagmethod (void)
{
int t = (int)luaL_check_number(1);
int e = luaI_checkevent(luaL_check_string(2), luaI_eventname);
lua_Object func = lua_getparam(3);
checktag(t);
if (!validevent(t, e))
luaL_verror("cannot change internal method `%s' for tag %d",
luaI_eventname[e], t);
luaL_arg_check(lua_isnil(func) || lua_isfunction(func),
3, "function expected");
luaI_pushobject(luaI_getim(t,e));
*luaI_getim(t, e) = *luaI_Address(func);
}
static void stderrorim (void)
{
lua_Object s = lua_getparam(1);
if (lua_isstring(s))
fprintf(stderr, "lua: %s\n", lua_getstring(s));
}
static TObject errorim = {LUA_T_CFUNCTION, {stderrorim}};
TObject *luaI_geterrorim (void)
{
return &errorim;
}
void luaI_seterrormethod (void)
{
lua_Object func = lua_getparam(1);
luaL_arg_check(lua_isnil(func) || lua_isfunction(func),
1, "function expected");
luaI_pushobject(&errorim);
errorim = *luaI_Address(func);
}
char *luaI_travfallbacks (int (*fn)(TObject *))
{
int e;
if (fn(&errorim))
return "error";
for (e=IM_GETTABLE; e<=IM_FUNCTION; e++) { /* ORDER IM */
int t;
for (t=0; t>=last_tag; t--)
if (fn(luaI_getim(t,e)))
return luaI_eventname[e];
}
return NULL;
}
/*
* ===================================================================
* compatibility with old fallback system
*/
#if LUA_COMPAT2_5
static void errorFB (void)
{
lua_Object o = lua_getparam(1);
if (lua_isstring(o))
fprintf (stderr, "lua: %s\n", lua_getstring(o));
else
fprintf(stderr, "lua: unknown error\n");
}
static void nilFB (void) { }
static void typeFB (void)
{
lua_error("unexpected type");
}
static void fillvalids (IMS e, TObject *func)
{
int t;
for (t=LUA_T_NIL; t<=LUA_T_USERDATA; t++)
if (validevent(t, e))
*luaI_getim(t, e) = *func;
}
void luaI_setfallback (void)
{
static char *oldnames [] = {"error", "getglobal", "arith", "order", NULL};
TObject oldfunc;
lua_CFunction replace;
char *name = luaL_check_string(1);
lua_Object func = lua_getparam(2);
luaI_initfallbacks();
luaL_arg_check(lua_isfunction(func), 2, "function expected");
switch (luaI_findstring(name, oldnames)) {
case 0: /* old error fallback */
oldfunc = errorim;
errorim = *luaI_Address(func);
replace = errorFB;
break;
case 1: /* old getglobal fallback */
oldfunc = *luaI_getim(LUA_T_NIL, IM_GETGLOBAL);
*luaI_getim(LUA_T_NIL, IM_GETGLOBAL) = *luaI_Address(func);
replace = nilFB;
break;
case 2: { /* old arith fallback */
int i;
oldfunc = *luaI_getim(LUA_T_NUMBER, IM_POW);
for (i=IM_ADD; i<=IM_UNM; i++) /* ORDER IM */
fillvalids(i, luaI_Address(func));
replace = typeFB;
break;
}
case 3: { /* old order fallback */
int i;
oldfunc = *luaI_getim(LUA_T_LINE, IM_LT);
for (i=IM_LT; i<=IM_GE; i++) /* ORDER IM */
fillvalids(i, luaI_Address(func));
replace = typeFB;
break;
}
default: {
int e;
if ((e = luaI_findstring(name, luaI_eventname)) >= 0) {
oldfunc = *luaI_getim(LUA_T_LINE, e);
fillvalids(e, luaI_Address(func));
replace = (e == IM_GC || e == IM_INDEX) ? nilFB : typeFB;
}
else {
luaL_verror("`%s' is not a valid fallback name", name);
replace = NULL; /* to avoid warnings */
}
}
}
if (oldfunc.ttype != LUA_T_NIL)
luaI_pushobject(&oldfunc);
else
lua_pushcfunction(replace);
}
#endif

View File

@@ -1,65 +0,0 @@
/*
** $Id: fallback.h,v 1.22 1997/04/04 22:24:51 roberto Exp roberto $
*/
#ifndef fallback_h
#define fallback_h
#include "lua.h"
#include "opcode.h"
/*
* WARNING: if you change the order of this enumeration,
* grep "ORDER IM"
*/
typedef enum {
IM_GETTABLE = 0,
IM_SETTABLE,
IM_INDEX,
IM_GETGLOBAL,
IM_SETGLOBAL,
IM_ADD,
IM_SUB,
IM_MUL,
IM_DIV,
IM_POW,
IM_UNM,
IM_LT,
IM_LE,
IM_GT,
IM_GE,
IM_CONCAT,
IM_GC,
IM_FUNCTION
} IMS;
#define IM_N 18
extern struct IM {
TObject int_method[IM_N];
} *luaI_IMtable;
extern char *luaI_eventname[];
#define luaI_getim(tag,event) (&luaI_IMtable[-(tag)].int_method[event])
#define luaI_getimbyObj(o,e) (luaI_getim(luaI_efectivetag(o),(e)))
void luaI_setfallback (void);
int luaI_ref (TObject *object, int lock);
TObject *luaI_getref (int ref);
void luaI_travlock (int (*fn)(TObject *));
void luaI_invalidaterefs (void);
char *luaI_travfallbacks (int (*fn)(TObject *));
void luaI_settag (int tag, TObject *o);
void luaI_realtag (int tag);
TObject *luaI_geterrorim (void);
int luaI_efectivetag (TObject *o);
void luaI_settagmethod (void);
void luaI_gettagmethod (void);
void luaI_seterrormethod (void);
void luaI_initfallbacks (void);
#endif

166
func.c
View File

@@ -1,166 +0,0 @@
#include <string.h>
#include "luadebug.h"
#include "table.h"
#include "luamem.h"
#include "func.h"
#include "opcode.h"
#include "inout.h"
static TFunc *function_root = NULL;
static LocVar *currvars = NULL;
static int numcurrvars = 0;
static int maxcurrvars = 0;
/*
** Initialize TFunc struct
*/
void luaI_initTFunc (TFunc *f)
{
f->next = NULL;
f->marked = 0;
f->size = 0;
f->code = NULL;
f->lineDefined = 0;
f->fileName = lua_parsedfile;
f->locvars = NULL;
}
/*
** Insert function in list for GC
*/
void luaI_insertfunction (TFunc *f)
{
lua_pack();
f->next = function_root;
function_root = f;
f->marked = 0;
}
/*
** Free function
*/
void luaI_freefunc (TFunc *f)
{
luaI_free (f->code);
luaI_free (f->locvars);
luaI_free (f);
}
void luaI_funcfree (TFunc *l)
{
while (l) {
TFunc *next = l->next;
luaI_freefunc(l);
l = next;
}
}
/*
** Garbage collection function.
*/
TFunc *luaI_funccollector (long *acum)
{
TFunc *curr = function_root;
TFunc *prev = NULL;
TFunc *frees = NULL;
long counter = 0;
while (curr) {
TFunc *next = curr->next;
if (!curr->marked) {
if (prev == NULL)
function_root = next;
else
prev->next = next;
curr->next = frees;
frees = curr;
++counter;
}
else {
curr->marked = 0;
prev = curr;
}
curr = next;
}
*acum += counter;
return frees;
}
void lua_funcinfo (lua_Object func, char **filename, int *linedefined)
{
TObject *f = luaI_Address(func);
if (f->ttype == LUA_T_MARK || f->ttype == LUA_T_FUNCTION)
{
*filename = f->value.tf->fileName;
*linedefined = f->value.tf->lineDefined;
}
else if (f->ttype == LUA_T_CMARK || f->ttype == LUA_T_CFUNCTION)
{
*filename = "(C)";
*linedefined = -1;
}
}
/*
** Stores information to know that variable has been declared in given line
*/
void luaI_registerlocalvar (TaggedString *varname, int line)
{
if (numcurrvars >= maxcurrvars)
maxcurrvars = growvector(&currvars, maxcurrvars, LocVar, "", MAX_WORD);
currvars[numcurrvars].varname = varname;
currvars[numcurrvars].line = line;
numcurrvars++;
}
/*
** Stores information to know that variable has been out of scope in given line
*/
void luaI_unregisterlocalvar (int line)
{
luaI_registerlocalvar(NULL, line);
}
/*
** Copies "currvars" into a new area and store it in function header.
** The values (varname = NULL, line = -1) signal the end of vector.
*/
void luaI_closelocalvars (TFunc *func)
{
func->locvars = newvector (numcurrvars+1, LocVar);
memcpy (func->locvars, currvars, numcurrvars*sizeof(LocVar));
func->locvars[numcurrvars].varname = NULL;
func->locvars[numcurrvars].line = -1;
numcurrvars = 0; /* prepares for next function */
}
/*
** Look for n-esim local variable at line "line" in function "func".
** Returns NULL if not found.
*/
char *luaI_getlocalname (TFunc *func, int local_number, int line)
{
int count = 0;
char *varname = NULL;
LocVar *lv = func->locvars;
if (lv == NULL)
return NULL;
for (; lv->line != -1 && lv->line < line; lv++)
{
if (lv->varname) /* register */
{
if (++count == local_number)
varname = lv->varname->str;
}
else /* unregister */
if (--count < local_number)
varname = NULL;
}
return varname;
}

45
func.h
View File

@@ -1,45 +0,0 @@
/*
** $Id: func.h,v 1.8 1996/03/14 15:54:20 roberto Exp roberto $
*/
#ifndef func_h
#define func_h
#include "types.h"
#include "lua.h"
#include "tree.h"
typedef struct LocVar
{
TaggedString *varname; /* NULL signals end of scope */
int line;
} LocVar;
/*
** Function Headers
*/
typedef struct TFunc
{
struct TFunc *next;
int marked;
int size;
Byte *code;
int lineDefined;
char *fileName;
LocVar *locvars;
} TFunc;
TFunc *luaI_funccollector (long *cont);
void luaI_funcfree (TFunc *l);
void luaI_insertfunction (TFunc *f);
void luaI_initTFunc (TFunc *f);
void luaI_freefunc (TFunc *f);
void luaI_registerlocalvar (TaggedString *varname, int line);
void luaI_unregisterlocalvar (int line);
void luaI_closelocalvars (TFunc *func);
char *luaI_getlocalname (TFunc *func, int local_number, int line);
#endif

332
hash.c
View File

@@ -1,332 +0,0 @@
/*
** hash.c
** hash manager for lua
*/
char *rcs_hash="$Id: hash.c,v 2.42 1997/05/08 20:43:30 roberto Exp roberto $";
#include "luamem.h"
#include "opcode.h"
#include "hash.h"
#include "table.h"
#include "lua.h"
#include "auxlib.h"
#define nhash(t) ((t)->nhash)
#define nuse(t) ((t)->nuse)
#define markarray(t) ((t)->mark)
#define nodevector(t) ((t)->node)
#define node(t,i) (&(t)->node[i])
#define ref(n) (&(n)->ref)
#define val(n) (&(n)->val)
#define REHASH_LIMIT 0.70 /* avoid more than this % full */
#define TagDefault LUA_T_ARRAY;
static Hash *listhead = NULL;
/* hash dimensions values */
static Long dimensions[] =
{5L, 11L, 23L, 47L, 97L, 197L, 397L, 797L, 1597L, 3203L, 6421L,
12853L, 25717L, 51437L, 102811L, 205619L, 411233L, 822433L,
1644817L, 3289613L, 6579211L, 13158023L, MAX_INT};
int luaI_redimension (int nhash)
{
int i;
for (i=0; dimensions[i]<MAX_INT; i++)
{
if (dimensions[i] > nhash)
return dimensions[i];
}
lua_error("table overflow");
return 0; /* to avoid warnings */
}
int lua_equalObj (TObject *t1, TObject *t2)
{
if (ttype(t1) != ttype(t2)) return 0;
switch (ttype(t1))
{
case LUA_T_NIL: return 1;
case LUA_T_NUMBER: return nvalue(t1) == nvalue(t2);
case LUA_T_STRING: case LUA_T_USERDATA: return svalue(t1) == svalue(t2);
case LUA_T_ARRAY: return avalue(t1) == avalue(t2);
case LUA_T_FUNCTION: return t1->value.tf == t2->value.tf;
case LUA_T_CFUNCTION: return fvalue(t1) == fvalue(t2);
default:
lua_error("internal error in `lua_equalObj'");
return 0; /* UNREACHEABLE */
}
}
static long int hashindex (TObject *ref)
{
long int h;
switch (ttype(ref)) {
case LUA_T_NUMBER:
h = (long int)nvalue(ref); break;
case LUA_T_STRING: case LUA_T_USERDATA:
h = tsvalue(ref)->hash; break;
case LUA_T_FUNCTION:
h = (IntPoint)ref->value.tf; break;
case LUA_T_CFUNCTION:
h = (IntPoint)fvalue(ref); break;
case LUA_T_ARRAY:
h = (IntPoint)avalue(ref); break;
default:
lua_error ("unexpected type to index table");
h = 0; /* UNREACHEABLE */
}
if (h < 0) h = -h;
return h;
}
static int present (Hash *t, TObject *key)
{
long int h = hashindex(key);
int tsize = nhash(t);
int h1 = h%tsize;
TObject *rf = ref(node(t, h1));
if (ttype(rf) != LUA_T_NIL && !lua_equalObj(key, rf)) {
int h2 = h%(tsize-2) + 1;
do {
h1 = (h1+h2)%tsize;
rf = ref(node(t, h1));
} while (ttype(rf) != LUA_T_NIL && !lua_equalObj(key, rf));
}
return h1;
}
/*
** Alloc a vector node
*/
static Node *hashnodecreate (int nhash)
{
int i;
Node *v = newvector (nhash, Node);
for (i=0; i<nhash; i++)
ttype(ref(&v[i])) = LUA_T_NIL;
return v;
}
/*
** Create a new hash. Return the hash pointer or NULL on error.
*/
static Hash *hashcreate (int nhash)
{
Hash *t = new(Hash);
nhash = luaI_redimension((int)((float)nhash/REHASH_LIMIT));
nodevector(t) = hashnodecreate(nhash);
nhash(t) = nhash;
nuse(t) = 0;
markarray(t) = 0;
t->htag = TagDefault;
return t;
}
/*
** Delete a hash
*/
static void hashdelete (Hash *t)
{
luaI_free (nodevector(t));
luaI_free(t);
}
/*
** Mark a hash and check its elements
*/
void lua_hashmark (Hash *h)
{
if (markarray(h) == 0)
{
int i;
markarray(h) = 1;
for (i=0; i<nhash(h); i++)
{
Node *n = node(h,i);
if (ttype(ref(n)) != LUA_T_NIL)
{
lua_markobject(&n->ref);
lua_markobject(&n->val);
}
}
}
}
void luaI_hashcallIM (Hash *l)
{
TObject t;
ttype(&t) = LUA_T_ARRAY;
for (; l; l=l->next) {
avalue(&t) = l;
luaI_gcIM(&t);
}
}
void luaI_hashfree (Hash *frees)
{
while (frees) {
Hash *next = frees->next;
hashdelete(frees);
frees = next;
}
}
Hash *luaI_hashcollector (long *acum)
{
Hash *curr_array = listhead, *prev = NULL, *frees = NULL;
long counter = 0;
while (curr_array != NULL) {
Hash *next = curr_array->next;
if (markarray(curr_array) != 1) {
if (prev == NULL)
listhead = next;
else
prev->next = next;
curr_array->next = frees;
frees = curr_array;
++counter;
}
else {
markarray(curr_array) = 0;
prev = curr_array;
}
curr_array = next;
}
*acum += counter;
return frees;
}
/*
** Create a new array
** This function inserts the new array in the array list. It also
** executes garbage collection if the number of arrays created
** exceed a pre-defined range.
*/
Hash *lua_createarray (int nhash)
{
Hash *array;
lua_pack();
array = hashcreate(nhash);
array->next = listhead;
listhead = array;
return array;
}
/*
** Rehash:
** Check if table has deleted slots. It it has, it does not need to
** grow, since rehash will reuse them.
*/
static int emptyslots (Hash *t)
{
int i;
for (i=nhash(t)-1; i>=0; i--) {
Node *n = node(t, i);
if (ttype(ref(n)) != LUA_T_NIL && ttype(val(n)) == LUA_T_NIL)
return 1;
}
return 0;
}
static void rehash (Hash *t)
{
int nold = nhash(t);
Node *vold = nodevector(t);
int i;
if (!emptyslots(t))
nhash(t) = luaI_redimension(nhash(t));
nodevector(t) = hashnodecreate(nhash(t));
for (i=0; i<nold; i++) {
Node *n = vold+i;
if (ttype(ref(n)) != LUA_T_NIL && ttype(val(n)) != LUA_T_NIL)
*node(t, present(t, ref(n))) = *n; /* copy old node to new hash */
}
luaI_free(vold);
}
/*
** If the hash node is present, return its pointer, otherwise return
** null.
*/
TObject *lua_hashget (Hash *t, TObject *ref)
{
int h = present(t, ref);
if (ttype(ref(node(t, h))) != LUA_T_NIL) return val(node(t, h));
else return NULL;
}
/*
** If the hash node is present, return its pointer, otherwise create a new
** node for the given reference and also return its pointer.
*/
TObject *lua_hashdefine (Hash *t, TObject *ref)
{
Node *n = node(t, present(t, ref));
if (ttype(ref(n)) == LUA_T_NIL) {
nuse(t)++;
if ((float)nuse(t) > (float)nhash(t)*REHASH_LIMIT) {
rehash(t);
n = node(t, present(t, ref));
}
*ref(n) = *ref;
ttype(val(n)) = LUA_T_NIL;
}
return (val(n));
}
/*
** Internal function to manipulate arrays.
** Given an array object and a reference value, return the next element
** in the hash.
** This function pushs the element value and its reference to the stack.
*/
static void hashnext (Hash *t, int i)
{
Node *n;
int tsize = nhash(t);
if (i >= tsize)
return;
n = node(t, i);
while (ttype(ref(n)) == LUA_T_NIL || ttype(val(n)) == LUA_T_NIL) {
if (++i >= tsize)
return;
n = node(t, i);
}
luaI_pushobject(ref(node(t,i)));
luaI_pushobject(val(node(t,i)));
}
void lua_next (void)
{
Hash *t;
lua_Object o = lua_getparam(1);
lua_Object r = lua_getparam(2);
luaL_arg_check(lua_istable(o), 1, "table expected");
luaL_arg_check(r != LUA_NOOBJECT, 2, "value expected");
t = avalue(luaI_Address(o));
if (lua_isnil(r))
hashnext(t, 0);
else
hashnext(t, present(t, luaI_Address(r))+1);
}

39
hash.h
View File

@@ -1,39 +0,0 @@
/*
** hash.h
** hash manager for lua
** $Id: hash.h,v 2.15 1997/03/31 14:02:58 roberto Exp roberto $
*/
#ifndef hash_h
#define hash_h
#include "types.h"
#include "opcode.h"
typedef struct node {
TObject ref;
TObject val;
} Node;
typedef struct Hash {
struct Hash *next;
Node *node;
int nhash;
int nuse;
int htag;
char mark;
} Hash;
int lua_equalObj (TObject *t1, TObject *t2);
int luaI_redimension (int nhash);
Hash *lua_createarray (int nhash);
void lua_hashmark (Hash *h);
Hash *luaI_hashcollector (long *count);
void luaI_hashcallIM (Hash *l);
void luaI_hashfree (Hash *frees);
TObject *lua_hashget (Hash *t, TObject *ref);
TObject *lua_hashdefine (Hash *t, TObject *ref);
void lua_next (void);
#endif

408
inout.c
View File

@@ -1,408 +0,0 @@
/*
** inout.c
** Provide function to realise the input/output function and debugger
** facilities.
** Also provides some predefined lua functions.
*/
char *rcs_inout="$Id: inout.c,v 2.68 1997/06/26 20:47:43 roberto Exp roberto $";
#include <stdio.h>
#include <string.h>
#include "auxlib.h"
#include "fallback.h"
#include "hash.h"
#include "inout.h"
#include "lex.h"
#include "lua.h"
#include "luamem.h"
#include "luamem.h"
#include "opcode.h"
#include "table.h"
#include "tree.h"
#include "undump.h"
#include "zio.h"
/* Exported variables */
Word lua_linenumber;
char *lua_parsedfile;
char *luaI_typenames[] = { /* ORDER LUA_T */
"userdata", "line", "cmark", "mark", "function",
"function", "table", "string", "number", "nil",
NULL
};
void luaI_setparsedfile (char *name)
{
lua_parsedfile = luaI_createfixedstring(name)->str;
}
int lua_doFILE (FILE *f, int bin)
{
ZIO z;
luaZ_Fopen(&z, f);
if (bin)
return luaI_undump(&z);
else {
lua_setinput(&z);
return lua_domain();
}
}
int lua_dofile (char *filename)
{
int status;
int c;
FILE *f = (filename == NULL) ? stdin : fopen(filename, "r");
if (f == NULL)
return 2;
luaI_setparsedfile(filename?filename:"(stdin)");
c = fgetc(f);
ungetc(c, f);
if (c == ID_CHUNK) {
f = freopen(filename, "rb", f); /* set binary mode */
status = lua_doFILE(f, 1);
}
else {
if (c == '#')
while ((c=fgetc(f)) != '\n') /* skip first line */;
status = lua_doFILE(f, 0);
}
if (f != stdin)
fclose(f);
return status;
}
#define SIZE_PREF 20 /* size of string prefix to appear in error messages */
int lua_dobuffer (char *buff, int size)
{
int status;
ZIO z;
luaI_setparsedfile("(buffer)");
luaZ_mopen(&z, buff, size);
status = luaI_undump(&z);
return status;
}
int lua_dostring (char *str)
{
int status;
char buff[SIZE_PREF+25];
char *temp;
ZIO z;
if (str == NULL) return 1;
sprintf(buff, "(dostring) >> %.20s", str);
temp = strchr(buff, '\n');
if (temp) *temp = 0; /* end string after first line */
luaI_setparsedfile(buff);
luaZ_sopen(&z, str);
lua_setinput(&z);
status = lua_domain();
return status;
}
static int passresults (void)
{
int arg = 0;
lua_Object obj;
while ((obj = lua_getresult(++arg)) != LUA_NOOBJECT)
lua_pushobject(obj);
return arg-1;
}
static void packresults (void)
{
int arg = 0;
lua_Object obj;
lua_Object table = lua_createtable();
while ((obj = lua_getresult(++arg)) != LUA_NOOBJECT) {
lua_pushobject(table);
lua_pushnumber(arg);
lua_pushobject(obj);
lua_rawsettable();
}
lua_pushobject(table);
lua_pushstring("n");
lua_pushnumber(arg-1);
lua_rawsettable();
lua_pushobject(table); /* final result */
}
/*
** Internal function: do a string
*/
static void lua_internaldostring (void)
{
lua_Object err = lua_getparam(2);
if (err != LUA_NOOBJECT) { /* set new error method */
luaL_arg_check(lua_isnil(err) || lua_isfunction(err), 2,
"must be a valid error handler");
lua_pushobject(err);
err = lua_seterrormethod();
}
if (lua_dostring(luaL_check_string(1)) == 0)
if (passresults() == 0)
lua_pushuserdata(NULL); /* at least one result to signal no errors */
if (err != LUA_NOOBJECT) { /* restore old error method */
lua_pushobject(err);
lua_seterrormethod();
}
}
/*
** Internal function: do a file
*/
static void lua_internaldofile (void)
{
char *fname = luaL_opt_string(1, NULL);
if (lua_dofile(fname) == 0)
if (passresults() == 0)
lua_pushuserdata(NULL); /* at least one result to signal no errors */
}
static char *tostring (lua_Object obj)
{
TObject *o = luaI_Address(obj);
switch (ttype(o)) {
case LUA_T_NUMBER: case LUA_T_STRING:
return lua_getstring(obj);
case LUA_T_ARRAY: case LUA_T_FUNCTION:
case LUA_T_CFUNCTION: case LUA_T_NIL:
return luaI_typenames[-ttype(o)];
case LUA_T_USERDATA: {
char *buff = luaI_buffer(30);
sprintf(buff, "userdata: %p", o->value.ts->u.v);
return buff;
}
default: return "<unknown object>";
}
}
static void luaI_tostring (void)
{
lua_pushstring(tostring(lua_getparam(1)));
}
static void luaI_print (void)
{
int i = 1;
lua_Object obj;
while ((obj = lua_getparam(i++)) != LUA_NOOBJECT)
printf("%s\n", tostring(obj));
}
static void luaI_type (void)
{
lua_Object o = lua_getparam(1);
luaL_arg_check(o != LUA_NOOBJECT, 1, "no argument");
lua_pushstring(luaI_typenames[-ttype(luaI_Address(o))]);
lua_pushnumber(lua_tag(o));
}
/*
** Internal function: convert an object to a number
*/
static void lua_obj2number (void)
{
lua_Object o = lua_getparam(1);
if (lua_isnumber(o))
lua_pushnumber(lua_getnumber(o));
}
static void luaI_error (void)
{
char *s = lua_getstring(lua_getparam(1));
if (s == NULL) s = "(no message)";
lua_error(s);
}
static void luaI_assert (void)
{
lua_Object p = lua_getparam(1);
if (p == LUA_NOOBJECT || lua_isnil(p))
lua_error("assertion failed!");
}
static void luaI_setglobal (void)
{
lua_Object value = lua_getparam(2);
luaL_arg_check(value != LUA_NOOBJECT, 2, NULL);
lua_pushobject(value);
lua_setglobal(luaL_check_string(1));
lua_pushobject(value); /* return given value */
}
static void luaI_rawsetglobal (void)
{
lua_Object value = lua_getparam(2);
luaL_arg_check(value != LUA_NOOBJECT, 2, NULL);
lua_pushobject(value);
lua_rawsetglobal(luaL_check_string(1));
lua_pushobject(value); /* return given value */
}
static void luaI_getglobal (void)
{
lua_pushobject(lua_getglobal(luaL_check_string(1)));
}
static void luaI_rawgetglobal (void)
{
lua_pushobject(lua_rawgetglobal(luaL_check_string(1)));
}
static void luatag (void)
{
lua_pushnumber(lua_tag(lua_getparam(1)));
}
static int getnarg (lua_Object table)
{
lua_Object temp;
/* temp = table.n */
lua_pushobject(table); lua_pushstring("n"); temp = lua_gettable();
return (lua_isnumber(temp) ? lua_getnumber(temp) : MAX_WORD);
}
static void luaI_call (void)
{
lua_Object f = lua_getparam(1);
lua_Object arg = lua_getparam(2);
int withtable = (strcmp(luaL_opt_string(3, ""), "pack") == 0);
int narg, i;
luaL_arg_check(lua_isfunction(f), 1, "function expected");
luaL_arg_check(lua_istable(arg), 2, "table expected");
narg = getnarg(arg);
/* push arg[1...n] */
for (i=0; i<narg; i++) {
lua_Object temp;
/* temp = arg[i+1] */
lua_pushobject(arg); lua_pushnumber(i+1); temp = lua_gettable();
if (narg == MAX_WORD && lua_isnil(temp))
break;
lua_pushobject(temp);
}
if (lua_callfunction(f))
lua_error(NULL);
else if (withtable)
packresults();
else
passresults();
}
static void luaIl_settag (void)
{
lua_Object o = lua_getparam(1);
luaL_arg_check(lua_istable(o), 1, "table expected");
lua_pushobject(o);
lua_settag(luaL_check_number(2));
}
static void luaIl_newtag (void)
{
lua_pushnumber(lua_newtag());
}
static void rawgettable (void)
{
lua_Object t = lua_getparam(1);
lua_Object i = lua_getparam(2);
luaL_arg_check(t != LUA_NOOBJECT, 1, NULL);
luaL_arg_check(i != LUA_NOOBJECT, 2, NULL);
lua_pushobject(t);
lua_pushobject(i);
lua_pushobject(lua_rawgettable());
}
static void rawsettable (void)
{
lua_Object t = lua_getparam(1);
lua_Object i = lua_getparam(2);
lua_Object v = lua_getparam(3);
luaL_arg_check(t != LUA_NOOBJECT && i != LUA_NOOBJECT && v != LUA_NOOBJECT,
0, NULL);
lua_pushobject(t);
lua_pushobject(i);
lua_pushobject(v);
lua_rawsettable();
}
static void luaI_collectgarbage (void)
{
lua_pushnumber(lua_collectgarbage(luaL_opt_number(1, 0)));
}
/*
** Internal functions
*/
static struct {
char *name;
lua_CFunction func;
} int_funcs[] = {
{"assert", luaI_assert},
{"call", luaI_call},
{"collectgarbage", luaI_collectgarbage},
{"dofile", lua_internaldofile},
{"dostring", lua_internaldostring},
{"error", luaI_error},
{"getglobal", luaI_getglobal},
{"newtag", luaIl_newtag},
{"next", lua_next},
{"nextvar", luaI_nextvar},
{"print", luaI_print},
{"rawgetglobal", luaI_rawgetglobal},
{"rawgettable", rawgettable},
{"rawsetglobal", luaI_rawsetglobal},
{"rawsettable", rawsettable},
{"seterrormethod", luaI_seterrormethod},
#if LUA_COMPAT2_5
{"setfallback", luaI_setfallback},
#endif
{"setglobal", luaI_setglobal},
{"settagmethod", luaI_settagmethod},
{"gettagmethod", luaI_gettagmethod},
{"settag", luaIl_settag},
{"tonumber", lua_obj2number},
{"tostring", luaI_tostring},
{"tag", luatag},
{"type", luaI_type}
};
#define INTFUNCSIZE (sizeof(int_funcs)/sizeof(int_funcs[0]))
void luaI_predefine (void)
{
int i;
Word n;
for (i=0; i<INTFUNCSIZE; i++) {
n = luaI_findsymbolbyname(int_funcs[i].name);
s_ttype(n) = LUA_T_CFUNCTION; s_fvalue(n) = int_funcs[i].func;
}
n = luaI_findsymbolbyname("_VERSION");
s_ttype(n) = LUA_T_STRING; s_tsvalue(n) = lua_createstring(LUA_VERSION);
}

25
inout.h
View File

@@ -1,25 +0,0 @@
/*
** $Id: inout.h,v 1.19 1997/06/18 20:35:49 roberto Exp roberto $
*/
#ifndef inout_h
#define inout_h
#include "types.h"
#include <stdio.h>
extern Word lua_linenumber;
extern Word lua_debugline;
extern char *lua_parsedfile;
void luaI_setparsedfile (char *name);
void luaI_predefine (void);
int lua_dobuffer (char *buff, int size);
int lua_doFILE (FILE *f, int bin);
#endif

596
lapi.c Normal file
View File

@@ -0,0 +1,596 @@
/*
** $Id: lapi.c,v 1.18 1998/01/07 16:26:48 roberto Exp roberto $
** Lua API
** See Copyright Notice in lua.h
*/
#include <stdlib.h>
#include <string.h>
#include "lapi.h"
#include "lauxlib.h"
#include "ldo.h"
#include "lfunc.h"
#include "lgc.h"
#include "lmem.h"
#include "lobject.h"
#include "lstate.h"
#include "lstring.h"
#include "ltable.h"
#include "ltm.h"
#include "lua.h"
#include "luadebug.h"
#include "lvm.h"
char lua_ident[] = "$Lua: " LUA_VERSION " " LUA_COPYRIGHT " $\n"
"$Autores: " LUA_AUTHORS " $";
TObject *luaA_Address (lua_Object o)
{
return Address(o);
}
static int normalized_type (TObject *o)
{
int t = ttype(o);
switch (t) {
case LUA_T_PMARK:
return LUA_T_PROTO;
case LUA_T_CMARK:
return LUA_T_CPROTO;
case LUA_T_CLMARK:
return LUA_T_CLOSURE;
default:
return t;
}
}
static void set_normalized (TObject *d, TObject *s)
{
d->value = s->value;
d->ttype = normalized_type(s);
}
static TObject *luaA_protovalue (TObject *o)
{
return (normalized_type(o) == LUA_T_CLOSURE) ? protovalue(o) : o;
}
void luaA_packresults (void)
{
luaV_pack(L->Cstack.lua2C, L->Cstack.num, L->stack.top);
incr_top;
}
int luaA_passresults (void)
{
luaD_checkstack(L->Cstack.num);
memcpy(L->stack.top, L->Cstack.lua2C+L->stack.stack,
L->Cstack.num*sizeof(TObject));
L->stack.top += L->Cstack.num;
return L->Cstack.num;
}
static void checkCparams (int nParams)
{
if (L->stack.top-L->stack.stack < L->Cstack.base+nParams)
lua_error("API error - wrong number of arguments in C2lua stack");
}
static lua_Object put_luaObject (TObject *o)
{
luaD_openstack((L->stack.top-L->stack.stack)-L->Cstack.base);
L->stack.stack[L->Cstack.base++] = *o;
return L->Cstack.base; /* this is +1 real position (see Ref) */
}
static lua_Object put_luaObjectonTop (void)
{
luaD_openstack((L->stack.top-L->stack.stack)-L->Cstack.base);
L->stack.stack[L->Cstack.base++] = *(--L->stack.top);
return L->Cstack.base; /* this is +1 real position (see Ref) */
}
lua_Object lua_pop (void)
{
checkCparams(1);
return put_luaObjectonTop();
}
/*
** Get a parameter, returning the object handle or LUA_NOOBJECT on error.
** 'number' must be 1 to get the first parameter.
*/
lua_Object lua_lua2C (int number)
{
if (number <= 0 || number > L->Cstack.num) return LUA_NOOBJECT;
/* Ref(L->stack.stack+(L->Cstack.lua2C+number-1)) ==
L->stack.stack+(L->Cstack.lua2C+number-1)-L->stack.stack+1 == */
return L->Cstack.lua2C+number;
}
int lua_callfunction (lua_Object function)
{
if (function == LUA_NOOBJECT)
return 1;
else {
luaD_openstack((L->stack.top-L->stack.stack)-L->Cstack.base);
set_normalized(L->stack.stack+L->Cstack.base, Address(function));
return luaD_protectedrun(MULT_RET);
}
}
lua_Object lua_gettagmethod (int tag, char *event)
{
return put_luaObject(luaT_gettagmethod(tag, event));
}
lua_Object lua_settagmethod (int tag, char *event)
{
checkCparams(1);
luaT_settagmethod(tag, event, L->stack.top-1);
return put_luaObjectonTop();
}
lua_Object lua_seterrormethod (void)
{
TObject temp = L->errorim;
checkCparams(1);
L->errorim = *(--L->stack.top);
return put_luaObject(&temp);
}
lua_Object lua_gettable (void)
{
checkCparams(2);
luaV_gettable();
return put_luaObjectonTop();
}
lua_Object lua_rawgettable (void)
{
checkCparams(2);
if (ttype(L->stack.top-2) != LUA_T_ARRAY)
lua_error("indexed expression not a table in rawgettable");
else {
TObject *h = luaH_get(avalue(L->stack.top-2), L->stack.top-1);
--L->stack.top;
if (h != NULL)
*(L->stack.top-1) = *h;
else
ttype(L->stack.top-1) = LUA_T_NIL;
}
return put_luaObjectonTop();
}
void lua_settable (void)
{
checkCparams(3);
luaV_settable(L->stack.top-3, 1);
}
void lua_rawsettable (void)
{
checkCparams(3);
luaV_settable(L->stack.top-3, 0);
}
lua_Object lua_createtable (void)
{
TObject o;
luaC_checkGC();
avalue(&o) = luaH_new(0);
ttype(&o) = LUA_T_ARRAY;
return put_luaObject(&o);
}
lua_Object lua_getglobal (char *name)
{
luaD_checkstack(2); /* may need that to call T.M. */
luaV_getglobal(luaS_new(name));
return put_luaObjectonTop();
}
lua_Object lua_rawgetglobal (char *name)
{
TaggedString *ts = luaS_new(name);
return put_luaObject(&ts->u.globalval);
}
void lua_setglobal (char *name)
{
checkCparams(1);
luaD_checkstack(2); /* may need that to call T.M. */
luaV_setglobal(luaS_new(name));
}
void lua_rawsetglobal (char *name)
{
TaggedString *ts = luaS_new(name);
checkCparams(1);
luaS_rawsetglobal(ts, --L->stack.top);
}
int lua_isnil (lua_Object o)
{
return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_NIL);
}
int lua_istable (lua_Object o)
{
return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_ARRAY);
}
int lua_isuserdata (lua_Object o)
{
return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_USERDATA);
}
int lua_iscfunction (lua_Object o)
{
return (lua_tag(o) == LUA_T_CPROTO);
}
int lua_isnumber (lua_Object o)
{
return (o!= LUA_NOOBJECT) && (tonumber(Address(o)) == 0);
}
int lua_isstring (lua_Object o)
{
int t = lua_tag(o);
return (t == LUA_T_STRING) || (t == LUA_T_NUMBER);
}
int lua_isfunction (lua_Object o)
{
int t = lua_tag(o);
return (t == LUA_T_PROTO) || (t == LUA_T_CPROTO);
}
double lua_getnumber (lua_Object object)
{
if (object == LUA_NOOBJECT) return 0.0;
if (tonumber(Address(object))) return 0.0;
else return (nvalue(Address(object)));
}
char *lua_getstring (lua_Object object)
{
if (object == LUA_NOOBJECT || tostring(Address(object)))
return NULL;
else return (svalue(Address(object)));
}
void *lua_getuserdata (lua_Object object)
{
if (object == LUA_NOOBJECT || ttype(Address(object)) != LUA_T_USERDATA)
return NULL;
else return tsvalue(Address(object))->u.d.v;
}
lua_CFunction lua_getcfunction (lua_Object object)
{
if (!lua_iscfunction(object))
return NULL;
else return fvalue(luaA_protovalue(Address(object)));
}
void lua_pushnil (void)
{
ttype(L->stack.top) = LUA_T_NIL;
incr_top;
}
void lua_pushnumber (double n)
{
ttype(L->stack.top) = LUA_T_NUMBER;
nvalue(L->stack.top) = n;
incr_top;
}
void lua_pushstring (char *s)
{
if (s == NULL)
ttype(L->stack.top) = LUA_T_NIL;
else {
tsvalue(L->stack.top) = luaS_new(s);
ttype(L->stack.top) = LUA_T_STRING;
}
incr_top;
luaC_checkGC();
}
void lua_pushCclosure (lua_CFunction fn, int n)
{
if (fn == NULL)
lua_error("API error - attempt to push a NULL Cfunction");
checkCparams(n);
ttype(L->stack.top) = LUA_T_CPROTO;
fvalue(L->stack.top) = fn;
incr_top;
luaV_closure(n);
}
void lua_pushusertag (void *u, int tag)
{
if (tag < 0 && tag != LUA_ANYTAG)
luaT_realtag(tag); /* error if tag is not valid */
tsvalue(L->stack.top) = luaS_createudata(u, tag);
ttype(L->stack.top) = LUA_T_USERDATA;
incr_top;
luaC_checkGC();
}
void luaA_pushobject (TObject *o)
{
*L->stack.top = *o;
incr_top;
}
void lua_pushobject (lua_Object o)
{
if (o == LUA_NOOBJECT)
lua_error("API error - attempt to push a NOOBJECT");
else {
set_normalized(L->stack.top, Address(o));
incr_top;
}
}
int lua_tag (lua_Object lo)
{
if (lo == LUA_NOOBJECT)
return LUA_T_NIL;
else {
TObject *o = Address(lo);
int t;
switch (t = ttype(o)) {
case LUA_T_USERDATA:
return o->value.ts->u.d.tag;
case LUA_T_ARRAY:
return o->value.a->htag;
case LUA_T_PMARK:
return LUA_T_PROTO;
case LUA_T_CMARK:
return LUA_T_CPROTO;
case LUA_T_CLOSURE: case LUA_T_CLMARK:
return o->value.cl->consts[0].ttype;
#ifdef DEBUG
case LUA_T_LINE:
lua_error("internal error");
#endif
default:
return t;
}
}
}
void lua_settag (int tag)
{
checkCparams(1);
luaT_realtag(tag);
switch (ttype(L->stack.top-1)) {
case LUA_T_ARRAY:
(L->stack.top-1)->value.a->htag = tag;
break;
case LUA_T_USERDATA:
(L->stack.top-1)->value.ts->u.d.tag = tag;
break;
default:
luaL_verror("cannot change the tag of a %.20s",
luaO_typenames[-ttype((L->stack.top-1))]);
}
L->stack.top--;
}
/*
** =======================================================
** Debug interface
** =======================================================
*/
/* Hooks */
lua_CHFunction lua_callhook = NULL;
lua_LHFunction lua_linehook = NULL;
lua_Function lua_stackedfunction (int level)
{
StkId i;
for (i = (L->stack.top-1)-L->stack.stack; i>=0; i--) {
int t = L->stack.stack[i].ttype;
if (t == LUA_T_CLMARK || t == LUA_T_PMARK || t == LUA_T_CMARK)
if (level-- == 0)
return Ref(L->stack.stack+i);
}
return LUA_NOOBJECT;
}
int lua_currentline (lua_Function func)
{
TObject *f = Address(func);
return (f+1 < L->stack.top && (f+1)->ttype == LUA_T_LINE) ?
(f+1)->value.i : -1;
}
lua_Object lua_getlocal (lua_Function func, int local_number, char **name)
{
/* check whether func is a Lua function */
if (lua_tag(func) != LUA_T_PROTO)
return LUA_NOOBJECT;
else {
TObject *f = Address(func);
TProtoFunc *fp = luaA_protovalue(f)->value.tf;
*name = luaF_getlocalname(fp, local_number, lua_currentline(func));
if (*name) {
/* if "*name", there must be a LUA_T_LINE */
/* therefore, f+2 points to function base */
return Ref((f+2)+(local_number-1));
}
else
return LUA_NOOBJECT;
}
}
int lua_setlocal (lua_Function func, int local_number)
{
/* check whether func is a Lua function */
if (lua_tag(func) != LUA_T_PROTO)
return 0;
else {
TObject *f = Address(func);
TProtoFunc *fp = luaA_protovalue(f)->value.tf;
char *name = luaF_getlocalname(fp, local_number, lua_currentline(func));
checkCparams(1);
--L->stack.top;
if (name) {
/* if "name", there must be a LUA_T_LINE */
/* therefore, f+2 points to function base */
*((f+2)+(local_number-1)) = *L->stack.top;
return 1;
}
else
return 0;
}
}
void lua_funcinfo (lua_Object func, char **filename, int *linedefined)
{
if (!lua_isfunction(func))
lua_error("API - `funcinfo' called with a non-function value");
else {
TObject *f = luaA_protovalue(Address(func));
if (normalized_type(f) == LUA_T_PROTO) {
*filename = tfvalue(f)->fileName->str;
*linedefined = tfvalue(f)->lineDefined;
}
else {
*filename = "(C)";
*linedefined = -1;
}
}
}
static int checkfunc (TObject *o)
{
return luaO_equalObj(o, L->stack.top);
}
char *lua_getobjname (lua_Object o, char **name)
{ /* try to find a name for given function */
set_normalized(L->stack.top, Address(o)); /* to be accessed by "checkfunc */
if ((*name = luaT_travtagmethods(checkfunc)) != NULL)
return "tag-method";
else if ((*name = luaS_travsymbol(checkfunc)) != NULL)
return "global";
else return "";
}
/*
** =======================================================
** BLOCK mechanism
** =======================================================
*/
void lua_beginblock (void)
{
if (L->numCblocks >= MAX_C_BLOCKS)
lua_error("too many nested blocks");
L->Cblocks[L->numCblocks] = L->Cstack;
L->numCblocks++;
}
void lua_endblock (void)
{
--L->numCblocks;
L->Cstack = L->Cblocks[L->numCblocks];
luaD_adjusttop(L->Cstack.base);
}
int lua_ref (int lock)
{
int ref;
checkCparams(1);
ref = luaC_ref(L->stack.top-1, lock);
L->stack.top--;
return ref;
}
lua_Object lua_getref (int ref)
{
TObject *o = luaC_getref(ref);
return (o ? put_luaObject(o) : LUA_NOOBJECT);
}
#ifdef LUA_COMPAT2_5
/*
** API: set a function as a fallback
*/
static void do_unprotectedrun (lua_CFunction f, int nParams, int nResults)
{
StkId base = (L->stack.top-L->stack.stack)-nParams;
luaD_openstack(nParams);
L->stack.stack[base].ttype = LUA_T_CPROTO;
L->stack.stack[base].value.f = f;
luaD_call(base+1, nResults);
}
lua_Object lua_setfallback (char *name, lua_CFunction fallback)
{
lua_pushstring(name);
lua_pushcfunction(fallback);
do_unprotectedrun(luaT_setfallback, 2, 1);
return put_luaObjectonTop();
}
#endif

20
lapi.h Normal file
View File

@@ -0,0 +1,20 @@
/*
** $Id: $
** auxiliar functions from Lua API
** See Copyright Notice in lua.h
*/
#ifndef lapi_h
#define lapi_h
#include "lua.h"
#include "lobject.h"
TObject *luaA_Address (lua_Object o);
void luaA_pushobject (TObject *o);
void luaA_packresults (void);
int luaA_passresults (void);
#endif

101
lauxlib.c Normal file
View File

@@ -0,0 +1,101 @@
/*
** $Id: lauxlib.c,v 1.8 1998/01/09 15:06:07 roberto Exp $
** Auxiliar functions for building Lua libraries
** See Copyright Notice in lua.h
*/
#include <stdarg.h>
#include <stdio.h>
/* Please Notice: This file uses only the oficial API of Lua
** Any function declared here could be written as an application
** function. With care, these functions can be used by other libraries.
*/
#include "lauxlib.h"
#include "lua.h"
#include "luadebug.h"
void luaL_argerror (int numarg, char *extramsg)
{
char *funcname;
lua_getobjname(lua_stackedfunction(0), &funcname);
if (funcname == NULL)
funcname = "???";
if (extramsg == NULL)
luaL_verror("bad argument #%d to function `%.50s'", numarg, funcname);
else
luaL_verror("bad argument #%d to function `%.50s' (%.100s)",
numarg, funcname, extramsg);
}
char *luaL_check_string (int numArg)
{
lua_Object o = lua_getparam(numArg);
luaL_arg_check(lua_isstring(o), numArg, "string expected");
return lua_getstring(o);
}
char *luaL_opt_string (int numArg, char *def)
{
return (lua_getparam(numArg) == LUA_NOOBJECT) ? def :
luaL_check_string(numArg);
}
double luaL_check_number (int numArg)
{
lua_Object o = lua_getparam(numArg);
luaL_arg_check(lua_isnumber(o), numArg, "number expected");
return lua_getnumber(o);
}
double luaL_opt_number (int numArg, double def)
{
return (lua_getparam(numArg) == LUA_NOOBJECT) ? def :
luaL_check_number(numArg);
}
lua_Object luaL_tablearg (int arg)
{
lua_Object o = lua_getparam(arg);
luaL_arg_check(lua_istable(o), arg, "table expected");
return o;
}
lua_Object luaL_functionarg (int arg)
{
lua_Object o = lua_getparam(arg);
luaL_arg_check(lua_isfunction(o), arg, "function expected");
return o;
}
lua_Object luaL_nonnullarg (int numArg)
{
lua_Object o = lua_getparam(numArg);
luaL_arg_check(o != LUA_NOOBJECT, numArg, "value expected");
return o;
}
void luaL_openlib (struct luaL_reg *l, int n)
{
int i;
lua_open(); /* make sure lua is already open */
for (i=0; i<n; i++)
lua_register(l[i].name, l[i].func);
}
void luaL_verror (char *fmt, ...)
{
char buff[500];
va_list argp;
va_start(argp, fmt);
vsprintf(buff, fmt, argp);
va_end(argp);
lua_error(buff);
}

43
lauxlib.h Normal file
View File

@@ -0,0 +1,43 @@
/*
** $Id: lauxlib.h,v 1.5 1997/12/17 20:48:58 roberto Exp roberto $
** Auxiliar functions for building Lua libraries
** See Copyright Notice in lua.h
*/
#ifndef auxlib_h
#define auxlib_h
#include "lua.h"
struct luaL_reg {
char *name;
lua_CFunction func;
};
#define luaL_arg_check(cond,numarg,extramsg) if (!(cond)) \
luaL_argerror(numarg,extramsg)
void luaL_openlib (struct luaL_reg *l, int n);
void luaL_argerror (int numarg, char *extramsg);
char *luaL_check_string (int numArg);
char *luaL_opt_string (int numArg, char *def);
double luaL_check_number (int numArg);
double luaL_opt_number (int numArg, double def);
lua_Object luaL_functionarg (int arg);
lua_Object luaL_tablearg (int arg);
lua_Object luaL_nonnullarg (int numArg);
void luaL_verror (char *fmt, ...);
char *luaL_openspace (int size);
void luaL_resetbuffer (void);
void luaL_addchar (int c);
void luaL_addsize (int n);
int luaL_newbuffer (int size);
void luaL_oldbuffer (int old);
char *luaL_buffer (void);
#endif

81
lbuffer.c Normal file
View File

@@ -0,0 +1,81 @@
/*
** $Id: $
** Auxiliar functions for building Lua libraries
** See Copyright Notice in lua.h
*/
#include <stdio.h>
#include "lauxlib.h"
#include "lmem.h"
#include "lstate.h"
/*-------------------------------------------------------
** Auxiliar buffer
-------------------------------------------------------*/
#define BUFF_STEP 32
#define openspace(size) if (L->Mbuffnext+(size) > L->Mbuffsize) Openspace(size)
static void Openspace (int size)
{
LState *l = L; /* to optimize */
int base = l->Mbuffbase-l->Mbuffer;
l->Mbuffsize *= 2;
if (l->Mbuffnext+size > l->Mbuffsize) /* still not big enough? */
l->Mbuffsize = l->Mbuffnext+size;
l->Mbuffer = luaM_realloc(l->Mbuffer, l->Mbuffsize);
l->Mbuffbase = l->Mbuffer+base;
}
char *luaL_openspace (int size)
{
openspace(size);
return L->Mbuffer+L->Mbuffnext;
}
void luaL_addchar (int c)
{
openspace(BUFF_STEP);
L->Mbuffer[L->Mbuffnext++] = c;
}
void luaL_resetbuffer (void)
{
L->Mbuffnext = L->Mbuffbase-L->Mbuffer;
}
void luaL_addsize (int n)
{
L->Mbuffnext += n;
}
int luaL_newbuffer (int size)
{
int old = L->Mbuffbase-L->Mbuffer;
openspace(size);
L->Mbuffbase = L->Mbuffer+L->Mbuffnext;
return old;
}
void luaL_oldbuffer (int old)
{
L->Mbuffnext = L->Mbuffbase-L->Mbuffer;
L->Mbuffbase = L->Mbuffer+old;
}
char *luaL_buffer (void)
{
return L->Mbuffbase;
}

516
lbuiltin.c Normal file
View File

@@ -0,0 +1,516 @@
/*
** $Id: lbuiltin.c,v 1.21 1998/01/02 17:46:32 roberto Exp roberto $
** Built-in functions
** See Copyright Notice in lua.h
*/
#include <ctype.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "lapi.h"
#include "lauxlib.h"
#include "lbuiltin.h"
#include "ldo.h"
#include "lfunc.h"
#include "lmem.h"
#include "lobject.h"
#include "lstate.h"
#include "lstring.h"
#include "ltable.h"
#include "ltm.h"
#include "lua.h"
static void pushstring (TaggedString *s)
{
TObject o;
o.ttype = LUA_T_STRING;
o.value.ts = s;
luaA_pushobject(&o);
}
static void nextvar (void)
{
TObject *o = luaA_Address(luaL_nonnullarg(1));
TaggedString *g;
if (ttype(o) == LUA_T_NIL)
g = (TaggedString *)L->rootglobal.next;
else {
luaL_arg_check(ttype(o) == LUA_T_STRING, 1, "variable name expected");
g = tsvalue(o);
/* check whether name is in global var list */
luaL_arg_check((GCnode *)g != g->head.next, 1, "variable name expected");
g = (TaggedString *)g->head.next;
}
while (g && g->u.globalval.ttype == LUA_T_NIL) /* skip globals with nil */
g = (TaggedString *)g->head.next;
if (g) {
pushstring(g);
luaA_pushobject(&g->u.globalval);
}
}
static void foreachvar (void)
{
TObject f = *luaA_Address(luaL_functionarg(1));
GCnode *g;
StkId name = L->Cstack.base++; /* place to keep var name (to avoid GC) */
ttype(L->stack.stack+name) = LUA_T_NIL;
L->stack.top++;
for (g = L->rootglobal.next; g; g = g->next) {
TaggedString *s = (TaggedString *)g;
if (s->u.globalval.ttype != LUA_T_NIL) {
ttype(L->stack.stack+name) = LUA_T_STRING;
tsvalue(L->stack.stack+name) = s; /* keep s on stack to avoid GC */
luaA_pushobject(&f);
pushstring(s);
luaA_pushobject(&s->u.globalval);
luaD_call((L->stack.top-L->stack.stack)-2, 1);
if (ttype(L->stack.top-1) != LUA_T_NIL)
return;
L->stack.top--;
}
}
}
static void next (void)
{
lua_Object o = luaL_tablearg(1);
lua_Object r = luaL_nonnullarg(2);
Node *n = luaH_next(luaA_Address(o), luaA_Address(r));
if (n) {
luaA_pushobject(&n->ref);
luaA_pushobject(&n->val);
}
}
static void foreach (void)
{
TObject t = *luaA_Address(luaL_tablearg(1));
TObject f = *luaA_Address(luaL_functionarg(2));
int i;
for (i=0; i<avalue(&t)->nhash; i++) {
Node *nd = &(avalue(&t)->node[i]);
if (ttype(ref(nd)) != LUA_T_NIL && ttype(val(nd)) != LUA_T_NIL) {
luaA_pushobject(&f);
luaA_pushobject(ref(nd));
luaA_pushobject(val(nd));
luaD_call((L->stack.top-L->stack.stack)-2, 1);
if (ttype(L->stack.top-1) != LUA_T_NIL)
return;
L->stack.top--;
}
}
}
static void internaldostring (void)
{
if (lua_getparam(2) != LUA_NOOBJECT)
lua_error("invalid 2nd argument (probably obsolete code)");
if (lua_dostring(luaL_check_string(1)) == 0)
if (luaA_passresults() == 0)
lua_pushuserdata(NULL); /* at least one result to signal no errors */
}
static void internaldofile (void)
{
char *fname = luaL_opt_string(1, NULL);
if (lua_dofile(fname) == 0)
if (luaA_passresults() == 0)
lua_pushuserdata(NULL); /* at least one result to signal no errors */
}
static char *to_string (lua_Object obj)
{
char *buff = luaL_openspace(30);
TObject *o = luaA_Address(obj);
switch (ttype(o)) {
case LUA_T_NUMBER: case LUA_T_STRING:
return lua_getstring(obj);
case LUA_T_ARRAY: {
sprintf(buff, "table: %p", (void *)o->value.a);
return buff;
}
case LUA_T_CLOSURE: {
sprintf(buff, "function: %p", (void *)o->value.cl);
return buff;
}
case LUA_T_PROTO: {
sprintf(buff, "function: %p", (void *)o->value.tf);
return buff;
}
case LUA_T_CPROTO: {
sprintf(buff, "function: %p", (void *)o->value.f);
return buff;
}
case LUA_T_USERDATA: {
sprintf(buff, "userdata: %p", o->value.ts->u.d.v);
return buff;
}
case LUA_T_NIL:
return "nil";
default:
lua_error("internal error");
return NULL; /* to avoid warnings */
}
}
static void bi_tostring (void)
{
lua_pushstring(to_string(lua_getparam(1)));
}
static void luaI_print (void)
{
int i = 1;
lua_Object obj;
while ((obj = lua_getparam(i++)) != LUA_NOOBJECT)
printf("%s\t", to_string(obj));
printf("\n");
}
static void luaI_type (void)
{
lua_Object o = luaL_nonnullarg(1);
lua_pushstring(luaO_typenames[-ttype(luaA_Address(o))]);
lua_pushnumber(lua_tag(o));
}
static void tonumber (void)
{
int base = luaL_opt_number(2, 10);
if (base == 10) { /* standard convertion */
lua_Object o = lua_getparam(1);
if (lua_isnumber(o))
lua_pushnumber(lua_getnumber(o));
}
else {
char *s = luaL_check_string(1);
unsigned long n;
luaL_arg_check(0 <= base && base <= 36, 2, "base out of range");
n = strtol(s, &s, base);
while (isspace(*s)) s++; /* skip trailing spaces */
if (*s) return; /* invalid format: return nil */
lua_pushnumber(n);
}
}
static void luaI_error (void)
{
lua_error(lua_getstring(lua_getparam(1)));
}
static void luaI_assert (void)
{
lua_Object p = lua_getparam(1);
if (p == LUA_NOOBJECT || lua_isnil(p))
luaL_verror("assertion failed! %.100s", luaL_opt_string(2, ""));
}
static void setglobal (void)
{
char *n = luaL_check_string(1);
lua_Object value = luaL_nonnullarg(2);
lua_pushobject(value);
lua_setglobal(n);
lua_pushobject(value); /* return given value */
}
static void rawsetglobal (void)
{
char *n = luaL_check_string(1);
lua_Object value = luaL_nonnullarg(2);
lua_pushobject(value);
lua_rawsetglobal(n);
lua_pushobject(value); /* return given value */
}
static void getglobal (void)
{
lua_pushobject(lua_getglobal(luaL_check_string(1)));
}
static void rawgetglobal (void)
{
lua_pushobject(lua_rawgetglobal(luaL_check_string(1)));
}
static void luatag (void)
{
lua_pushnumber(lua_tag(lua_getparam(1)));
}
static int getnarg (lua_Object table)
{
lua_Object temp;
/* temp = table.n */
lua_pushobject(table); lua_pushstring("n"); temp = lua_rawgettable();
return (lua_isnumber(temp) ? lua_getnumber(temp) : MAX_WORD);
}
static void luaI_call (void)
{
lua_Object f = luaL_nonnullarg(1);
lua_Object arg = luaL_tablearg(2);
char *options = luaL_opt_string(3, "");
lua_Object err = lua_getparam(4);
int narg = getnarg(arg);
int i, status;
if (err != LUA_NOOBJECT) { /* set new error method */
lua_pushobject(err);
err = lua_seterrormethod();
}
/* push arg[1...n] */
for (i=0; i<narg; i++) {
lua_Object temp;
/* temp = arg[i+1] */
lua_pushobject(arg); lua_pushnumber(i+1); temp = lua_rawgettable();
if (narg == MAX_WORD && lua_isnil(temp))
break;
lua_pushobject(temp);
}
status = lua_callfunction(f);
if (err != LUA_NOOBJECT) { /* restore old error method */
lua_pushobject(err);
lua_seterrormethod();
}
if (status != 0) { /* error in call? */
if (strchr(options, 'x'))
return; /* return nil to signal the error */
else
lua_error(NULL);
}
else { /* no errors */
if (strchr(options, 'p'))
luaA_packresults();
else
luaA_passresults();
}
}
static void settag (void)
{
lua_Object o = luaL_tablearg(1);
lua_pushobject(o);
lua_settag(luaL_check_number(2));
}
static void newtag (void)
{
lua_pushnumber(lua_newtag());
}
static void copytagmethods (void)
{
lua_pushnumber(lua_copytagmethods(luaL_check_number(1),
luaL_check_number(2)));
}
static void rawgettable (void)
{
lua_Object t = luaL_nonnullarg(1);
lua_Object i = luaL_nonnullarg(2);
lua_pushobject(t);
lua_pushobject(i);
lua_pushobject(lua_rawgettable());
}
static void rawsettable (void)
{
lua_Object t = luaL_nonnullarg(1);
lua_Object i = luaL_nonnullarg(2);
lua_Object v = luaL_nonnullarg(3);
lua_pushobject(t);
lua_pushobject(i);
lua_pushobject(v);
lua_rawsettable();
}
static void settagmethod (void)
{
lua_Object nf = luaL_nonnullarg(3);
lua_pushobject(nf);
lua_pushobject(lua_settagmethod((int)luaL_check_number(1),
luaL_check_string(2)));
}
static void gettagmethod (void)
{
lua_pushobject(lua_gettagmethod((int)luaL_check_number(1),
luaL_check_string(2)));
}
static void seterrormethod (void)
{
lua_Object nf = luaL_functionarg(1);
lua_pushobject(nf);
lua_pushobject(lua_seterrormethod());
}
static void luaI_collectgarbage (void)
{
lua_pushnumber(lua_collectgarbage(luaL_opt_number(1, 0)));
}
/*
** =======================================================
** some DEBUG functions
** =======================================================
*/
#ifdef DEBUG
static void mem_query (void)
{
lua_pushnumber(totalmem);
lua_pushnumber(numblocks);
}
static void countlist (void)
{
char *s = luaL_check_string(1);
GCnode *l = (s[0]=='t') ? L->roottable.next : (s[0]=='c') ? L->rootcl.next :
(s[0]=='p') ? L->rootproto.next : L->rootglobal.next;
int i=0;
while (l) {
i++;
l = l->next;
}
lua_pushnumber(i);
}
static void testC (void)
{
#define getnum(s) ((*s++) - '0')
#define getname(s) (nome[0] = *s++, nome)
static int locks[10];
lua_Object reg[10];
char nome[2];
char *s = luaL_check_string(1);
nome[1] = 0;
while (1) {
switch (*s++) {
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
lua_pushnumber(*(s-1) - '0');
break;
case 'c': reg[getnum(s)] = lua_createtable(); break;
case 'C': { lua_CFunction f = lua_getcfunction(lua_getglobal(getname(s)));
lua_pushCclosure(f, getnum(s));
break;
}
case 'P': reg[getnum(s)] = lua_pop(); break;
case 'g': { int n=getnum(s); reg[n]=lua_getglobal(getname(s)); break; }
case 'G': { int n = getnum(s);
reg[n] = lua_rawgetglobal(getname(s));
break;
}
case 'l': locks[getnum(s)] = lua_ref(1); break;
case 'L': locks[getnum(s)] = lua_ref(0); break;
case 'r': { int n=getnum(s); reg[n]=lua_getref(locks[getnum(s)]); break; }
case 'u': lua_unref(locks[getnum(s)]); break;
case 'p': { int n = getnum(s); reg[n] = lua_getparam(getnum(s)); break; }
case '=': lua_setglobal(getname(s)); break;
case 's': lua_pushstring(getname(s)); break;
case 'o': lua_pushobject(reg[getnum(s)]); break;
case 'f': lua_call(getname(s)); break;
case 'i': reg[getnum(s)] = lua_gettable(); break;
case 'I': reg[getnum(s)] = lua_rawgettable(); break;
case 't': lua_settable(); break;
case 'T': lua_rawsettable(); break;
default: luaL_verror("unknown command in `testC': %c", *(s-1));
}
if (*s == 0) return;
if (*s++ != ' ') lua_error("missing ` ' between commands in `testC'");
}
}
#endif
/*
** Internal functions
*/
static struct luaL_reg int_funcs[] = {
#ifdef LUA_COMPAT2_5
{"setfallback", luaT_setfallback},
#endif
#ifdef DEBUG
{"testC", testC},
{"totalmem", mem_query},
{"count", countlist},
#endif
{"assert", luaI_assert},
{"call", luaI_call},
{"collectgarbage", luaI_collectgarbage},
{"dofile", internaldofile},
{"copytagmethods", copytagmethods},
{"dostring", internaldostring},
{"error", luaI_error},
{"foreach", foreach},
{"foreachvar", foreachvar},
{"getglobal", getglobal},
{"newtag", newtag},
{"next", next},
{"nextvar", nextvar},
{"print", luaI_print},
{"rawgetglobal", rawgetglobal},
{"rawgettable", rawgettable},
{"rawsetglobal", rawsetglobal},
{"rawsettable", rawsettable},
{"seterrormethod", seterrormethod},
{"setglobal", setglobal},
{"settagmethod", settagmethod},
{"gettagmethod", gettagmethod},
{"settag", settag},
{"tonumber", tonumber},
{"tostring", bi_tostring},
{"tag", luatag},
{"type", luaI_type}
};
#define INTFUNCSIZE (sizeof(int_funcs)/sizeof(int_funcs[0]))
void luaB_predefine (void)
{
/* pre-register mem error messages, to avoid loop when error arises */
luaS_newfixedstring(tableEM);
luaS_newfixedstring(memEM);
luaL_openlib(int_funcs, (sizeof(int_funcs)/sizeof(int_funcs[0])));
lua_pushstring(LUA_VERSION);
lua_setglobal("_VERSION");
}

14
lbuiltin.h Normal file
View File

@@ -0,0 +1,14 @@
/*
** $Id: $
** Built-in functions
** See Copyright Notice in lua.h
*/
#ifndef lbuiltin_h
#define lbuiltin_h
void luaB_predefine (void);
#endif

420
ldo.c Normal file
View File

@@ -0,0 +1,420 @@
/*
** $Id: ldo.c,v 1.20 1997/12/26 18:38:16 roberto Exp roberto $
** Stack and Call structure of Lua
** See Copyright Notice in lua.h
*/
#include <setjmp.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "ldo.h"
#include "lfunc.h"
#include "lgc.h"
#include "lmem.h"
#include "lobject.h"
#include "lparser.h"
#include "lstate.h"
#include "ltm.h"
#include "lua.h"
#include "luadebug.h"
#include "lundump.h"
#include "lvm.h"
#include "lzio.h"
#ifndef STACK_LIMIT
#define STACK_LIMIT 6000
#endif
/*
** Error messages
*/
static void stderrorim (void)
{
fprintf(stderr, "lua error: %s\n", lua_getstring(lua_getparam(1)));
}
#define STACK_UNIT 128
void luaD_init (void)
{
L->stack.stack = luaM_newvector(STACK_UNIT, TObject);
L->stack.top = L->stack.stack;
L->stack.last = L->stack.stack+(STACK_UNIT-1);
ttype(&L->errorim) = LUA_T_CPROTO;
fvalue(&L->errorim) = stderrorim;
}
void luaD_checkstack (int n)
{
struct Stack *S = &L->stack;
if (S->last-S->top <= n) {
StkId top = S->top-S->stack;
int stacksize = (S->last-S->stack)+1+STACK_UNIT+n;
S->stack = luaM_reallocvector(S->stack, stacksize, TObject);
S->last = S->stack+(stacksize-1);
S->top = S->stack + top;
if (stacksize >= STACK_LIMIT) { /* stack overflow? */
if (lua_stackedfunction(100) == LUA_NOOBJECT) /* 100 funcs on stack? */
lua_error("Lua2C - C2Lua overflow"); /* doesn't look like a rec. loop */
else
lua_error("stack size overflow");
}
}
}
/*
** Adjust stack. Set top to the given value, pushing NILs if needed.
*/
void luaD_adjusttop (StkId newtop)
{
int diff = newtop-(L->stack.top-L->stack.stack);
if (diff <= 0)
L->stack.top += diff;
else {
luaD_checkstack(diff);
while (diff--)
ttype(L->stack.top++) = LUA_T_NIL;
}
}
/*
** Open a hole below "nelems" from the L->stack.top.
*/
void luaD_openstack (int nelems)
{
luaO_memup(L->stack.top-nelems+1, L->stack.top-nelems,
nelems*sizeof(TObject));
incr_top;
}
void luaD_lineHook (int line)
{
struct C_Lua_Stack oldCLS = L->Cstack;
StkId old_top = L->Cstack.lua2C = L->Cstack.base = L->stack.top-L->stack.stack;
L->Cstack.num = 0;
(*lua_linehook)(line);
L->stack.top = L->stack.stack+old_top;
L->Cstack = oldCLS;
}
void luaD_callHook (StkId base, TProtoFunc *tf, int isreturn)
{
struct C_Lua_Stack oldCLS = L->Cstack;
StkId old_top = L->Cstack.lua2C = L->Cstack.base = L->stack.top-L->stack.stack;
L->Cstack.num = 0;
if (isreturn)
(*lua_callhook)(LUA_NOOBJECT, "(return)", 0);
else {
TObject *f = L->stack.stack+base-1;
if (tf)
(*lua_callhook)(Ref(f), tf->fileName->str, tf->lineDefined);
else
(*lua_callhook)(Ref(f), "(C)", -1);
}
L->stack.top = L->stack.stack+old_top;
L->Cstack = oldCLS;
}
/*
** Call a C function.
** Cstack.num is the number of arguments; Cstack.lua2C points to the
** first argument. Returns an index to the first result from C.
*/
static StkId callC (lua_CFunction f, StkId base)
{
struct C_Lua_Stack *CS = &L->Cstack;
struct C_Lua_Stack oldCLS = *CS;
StkId firstResult;
int numarg = (L->stack.top-L->stack.stack) - base;
CS->num = numarg;
CS->lua2C = base;
CS->base = base+numarg; /* == top-stack */
if (lua_callhook)
luaD_callHook(base, NULL, 0);
(*f)(); /* do the actual call */
if (lua_callhook) /* func may have changed lua_callhook */
luaD_callHook(base, NULL, 1);
firstResult = CS->base;
*CS = oldCLS;
return firstResult;
}
static StkId callCclosure (struct Closure *cl, lua_CFunction f, StkId base)
{
TObject *pbase;
int nup = cl->nelems; /* number of upvalues */
luaD_checkstack(nup);
pbase = L->stack.stack+base; /* care: previous call may change this */
/* open space for upvalues as extra arguments */
luaO_memup(pbase+nup, pbase, (L->stack.top-pbase)*sizeof(TObject));
/* copy upvalues into stack */
memcpy(pbase, cl->consts+1, nup*sizeof(TObject));
L->stack.top += nup;
return callC(f, base);
}
void luaD_callTM (TObject *f, int nParams, int nResults)
{
luaD_openstack(nParams);
*(L->stack.top-nParams-1) = *f;
luaD_call((L->stack.top-L->stack.stack)-nParams, nResults);
}
/*
** Call a function (C or Lua). The parameters must be on the L->stack.stack,
** between [L->stack.stack+base,L->stack.top). The function to be called is at L->stack.stack+base-1.
** When returns, the results are on the L->stack.stack, between [L->stack.stack+base-1,L->stack.top).
** The number of results is nResults, unless nResults=MULT_RET.
*/
void luaD_call (StkId base, int nResults)
{
StkId firstResult;
TObject *func = L->stack.stack+base-1;
int i;
switch (ttype(func)) {
case LUA_T_CPROTO:
ttype(func) = LUA_T_CMARK;
firstResult = callC(fvalue(func), base);
break;
case LUA_T_PROTO:
ttype(func) = LUA_T_PMARK;
firstResult = luaV_execute(NULL, tfvalue(func), base);
break;
case LUA_T_CLOSURE: {
Closure *c = clvalue(func);
TObject *proto = &(c->consts[0]);
ttype(func) = LUA_T_CLMARK;
firstResult = (ttype(proto) == LUA_T_CPROTO) ?
callCclosure(c, fvalue(proto), base) :
luaV_execute(c, tfvalue(proto), base);
break;
}
default: { /* func is not a function */
/* Check the tag method for invalid functions */
TObject *im = luaT_getimbyObj(func, IM_FUNCTION);
if (ttype(im) == LUA_T_NIL)
lua_error("call expression not a function");
luaD_callTM(im, (L->stack.top-L->stack.stack)-(base-1), nResults);
return;
}
}
/* adjust the number of results */
if (nResults != MULT_RET)
luaD_adjusttop(firstResult+nResults);
/* move results to base-1 (to erase parameters and function) */
base--;
nResults = L->stack.top - (L->stack.stack+firstResult); /* actual number of results */
for (i=0; i<nResults; i++)
*(L->stack.stack+base+i) = *(L->stack.stack+firstResult+i);
L->stack.top -= firstResult-base;
}
/*
** Traverse all objects on L->stack.stack
*/
void luaD_travstack (int (*fn)(TObject *))
{
StkId i;
for (i = (L->stack.top-1)-L->stack.stack; i>=0; i--)
fn(L->stack.stack+i);
}
static void message (char *s)
{
TObject im = L->errorim;
if (ttype(&im) != LUA_T_NIL) {
lua_pushstring(s);
luaD_callTM(&im, 1, 0);
}
}
/*
** Reports an error, and jumps up to the available recover label
*/
void lua_error (char *s)
{
if (s) message(s);
if (L->errorJmp)
longjmp(*((jmp_buf *)L->errorJmp), 1);
else {
fprintf (stderr, "lua: exit(1). Unable to recover\n");
exit(1);
}
}
/*
** Call the function at L->Cstack.base, and incorporate results on
** the Lua2C structure.
*/
static void do_callinc (int nResults)
{
StkId base = L->Cstack.base;
luaD_call(base+1, nResults);
L->Cstack.lua2C = base; /* position of the luaM_new results */
L->Cstack.num = (L->stack.top-L->stack.stack) - base; /* number of results */
L->Cstack.base = base + L->Cstack.num; /* incorporate results on L->stack.stack */
}
/*
** Execute a protected call. Assumes that function is at L->Cstack.base and
** parameters are on top of it. Leave nResults on the stack.
*/
int luaD_protectedrun (int nResults)
{
jmp_buf myErrorJmp;
int status;
struct C_Lua_Stack oldCLS = L->Cstack;
jmp_buf *oldErr = L->errorJmp;
L->errorJmp = &myErrorJmp;
if (setjmp(myErrorJmp) == 0) {
do_callinc(nResults);
status = 0;
}
else { /* an error occurred: restore L->Cstack and L->stack.top */
L->Cstack = oldCLS;
L->stack.top = L->stack.stack+L->Cstack.base;
status = 1;
}
L->errorJmp = oldErr;
return status;
}
/*
** returns 0 = chunk loaded; 1 = error; 2 = no more chunks to load
*/
static int protectedparser (ZIO *z, int bin)
{
int status;
TProtoFunc *tf;
jmp_buf myErrorJmp;
jmp_buf *oldErr = L->errorJmp;
L->errorJmp = &myErrorJmp;
if (setjmp(myErrorJmp) == 0) {
tf = bin ? luaU_undump1(z) : luaY_parser(z);
status = 0;
}
else {
tf = NULL;
status = 1;
}
L->errorJmp = oldErr;
if (status) return 1; /* error code */
if (tf == NULL) return 2; /* 'natural' end */
luaD_adjusttop(L->Cstack.base+1); /* one slot for the pseudo-function */
L->stack.stack[L->Cstack.base].ttype = LUA_T_PROTO;
L->stack.stack[L->Cstack.base].value.tf = tf;
luaV_closure(0);
return 0;
}
static int do_main (ZIO *z, int bin)
{
int status;
do {
long old_blocks = (luaC_checkGC(), L->nblocks);
status = protectedparser(z, bin);
if (status == 1) return 1; /* error */
else if (status == 2) return 0; /* 'natural' end */
else {
unsigned long newelems2 = 2*(L->nblocks-old_blocks);
L->GCthreshold += newelems2;
status = luaD_protectedrun(MULT_RET);
L->GCthreshold -= newelems2;
}
} while (bin && status == 0);
return status;
}
void luaD_gcIM (TObject *o)
{
TObject *im = luaT_getimbyObj(o, IM_GC);
if (ttype(im) != LUA_T_NIL) {
*L->stack.top = *o;
incr_top;
luaD_callTM(im, 1, 0);
}
}
int lua_dofile (char *filename)
{
ZIO z;
int status;
int c;
int bin;
FILE *f = (filename == NULL) ? stdin : fopen(filename, "r");
if (f == NULL)
return 2;
if (filename == NULL)
filename = "(stdin)";
c = fgetc(f);
ungetc(c, f);
bin = (c == ID_CHUNK);
if (bin)
f = freopen(filename, "rb", f); /* set binary mode */
luaZ_Fopen(&z, f, filename);
status = do_main(&z, bin);
if (f != stdin)
fclose(f);
return status;
}
#define SIZE_PREF 20 /* size of string prefix to appear in error messages */
#define SSIZE_PREF "20"
int lua_dostring (char *str)
{
int status;
char name[SIZE_PREF+25];
char *temp;
ZIO z;
if (str == NULL) return 1;
sprintf(name, "(dostring) >> %." SSIZE_PREF "s", str);
temp = strchr(name, '\n');
if (temp) *temp = 0; /* end string after first line */
luaZ_sopen(&z, str, name);
status = do_main(&z, 0);
return status;
}
#if 0
int lua_dobuffer (char *buff, int size)
{
int status;
ZIO z;
luaZ_mopen(&z, buff, size, "(buffer)");
status = do_main(&z, 1);
return status;
}
#endif

46
ldo.h Normal file
View File

@@ -0,0 +1,46 @@
/*
** $Id: ldo.h,v 1.3 1997/11/19 17:29:23 roberto Exp roberto $
** Stack and Call structure of Lua
** See Copyright Notice in lua.h
*/
#ifndef ldo_h
#define ldo_h
#include "lobject.h"
#include "lstate.h"
#define MULT_RET 255
/*
** macro to increment stack top.
** There must be always an empty slot at the L->stack.top
*/
#define incr_top { if (L->stack.top >= L->stack.last) luaD_checkstack(1); \
L->stack.top++; }
/* macros to convert from lua_Object to (TObject *) and back */
#define Address(lo) ((lo)+L->stack.stack-1)
#define Ref(st) ((st)-L->stack.stack+1)
void luaD_init (void);
void luaD_adjusttop (StkId newtop);
void luaD_openstack (int nelems);
void luaD_lineHook (int line);
void luaD_callHook (StkId base, TProtoFunc *tf, int isreturn);
void luaD_call (StkId base, int nResults);
void luaD_callTM (TObject *f, int nParams, int nResults);
int luaD_protectedrun (int nResults);
void luaD_gcIM (TObject *o);
void luaD_travstack (int (*fn)(TObject *));
void luaD_checkstack (int n);
#endif

470
lex.c
View File

@@ -1,470 +0,0 @@
char *rcs_lex = "$Id: lex.c,v 3.4 1997/06/11 18:56:02 roberto Exp roberto $";
#include <ctype.h>
#include <string.h>
#include "auxlib.h"
#include "luamem.h"
#include "tree.h"
#include "table.h"
#include "lex.h"
#include "inout.h"
#include "luadebug.h"
#include "parser.h"
#define MINBUFF 250
static int current; /* look ahead character */
static ZIO *lex_z;
#define next() (current = zgetc(lex_z))
#define save(x) (yytext[tokensize++] = (x))
#define save_and_next() (save(current), next())
#define MAX_IFS 5
/* "ifstate" keeps the state of each nested $if the lexical is dealing with. */
static struct {
int elsepart; /* true if its in the $else part */
int condition; /* true if $if condition is true */
int skip; /* true if part must be skiped */
} ifstate[MAX_IFS];
static int iflevel; /* level of nested $if's */
void lua_setinput (ZIO *z)
{
current = '\n';
lua_linenumber = 0;
iflevel = 0;
ifstate[0].skip = 0;
ifstate[0].elsepart = 1; /* to avoid a free $else */
lex_z = z;
}
static void luaI_auxsyntaxerror (char *s)
{
luaL_verror("%s;\n> at line %d in file %s",
s, lua_linenumber, lua_parsedfile);
}
static void luaI_auxsynterrbf (char *s, char *token)
{
if (token[0] == 0)
token = "<eof>";
luaL_verror("%s;\n> last token read: \"%s\" at line %d in file %s",
s, token, lua_linenumber, lua_parsedfile);
}
void luaI_syntaxerror (char *s)
{
luaI_auxsynterrbf(s, luaI_buffer(1));
}
static struct
{
char *name;
int token;
} reserved [] = {
{"and", AND},
{"do", DO},
{"else", ELSE},
{"elseif", ELSEIF},
{"end", END},
{"function", FUNCTION},
{"if", IF},
{"local", LOCAL},
{"nil", NIL},
{"not", NOT},
{"or", OR},
{"repeat", REPEAT},
{"return", RETURN},
{"then", THEN},
{"until", UNTIL},
{"while", WHILE} };
#define RESERVEDSIZE (sizeof(reserved)/sizeof(reserved[0]))
void luaI_addReserved (void)
{
int i;
for (i=0; i<RESERVEDSIZE; i++)
{
TaggedString *ts = lua_createstring(reserved[i].name);
ts->marked = reserved[i].token; /* reserved word (always > 255) */
}
}
/*
** Pragma handling
*/
#define PRAGMASIZE 20
static void skipspace (void)
{
while (current == ' ' || current == '\t') next();
}
static int checkcond (char *buff)
{
static char *opts[] = {"nil", "1"};
int i = luaI_findstring(buff, opts);
if (i >= 0) return i;
else if (isalpha((unsigned char)buff[0]) || buff[0] == '_')
return luaI_globaldefined(buff);
else {
luaI_auxsynterrbf("invalid $if condition", buff);
return 0; /* to avoid warnings */
}
}
static void readname (char *buff)
{
int i = 0;
skipspace();
while (isalnum((unsigned char)current) || current == '_') {
if (i >= PRAGMASIZE) {
buff[PRAGMASIZE] = 0;
luaI_auxsynterrbf("pragma too long", buff);
}
buff[i++] = current;
next();
}
buff[i] = 0;
}
static void inclinenumber (void);
static void ifskip (void)
{
while (ifstate[iflevel].skip) {
if (current == '\n')
inclinenumber();
else if (current == EOZ)
luaI_auxsyntaxerror("input ends inside a $if");
else next();
}
}
static void inclinenumber (void)
{
static char *pragmas [] =
{"debug", "nodebug", "endinput", "end", "ifnot", "if", "else", NULL};
next(); /* skip '\n' */
++lua_linenumber;
if (current == '$') { /* is a pragma? */
char buff[PRAGMASIZE+1];
int ifnot = 0;
int skip = ifstate[iflevel].skip;
next(); /* skip $ */
readname(buff);
switch (luaI_findstring(buff, pragmas)) {
case 0: /* debug */
if (!skip) lua_debug = 1;
break;
case 1: /* nodebug */
if (!skip) lua_debug = 0;
break;
case 2: /* endinput */
if (!skip) {
current = EOZ;
iflevel = 0; /* to allow $endinput inside a $if */
}
break;
case 3: /* end */
if (iflevel-- == 0)
luaI_auxsyntaxerror("unmatched $endif");
break;
case 4: /* ifnot */
ifnot = 1;
/* go through */
case 5: /* if */
if (iflevel == MAX_IFS-1)
luaI_auxsyntaxerror("too many nested `$ifs'");
readname(buff);
iflevel++;
ifstate[iflevel].elsepart = 0;
ifstate[iflevel].condition = checkcond(buff) ? !ifnot : ifnot;
ifstate[iflevel].skip = skip || !ifstate[iflevel].condition;
break;
case 6: /* else */
if (ifstate[iflevel].elsepart)
luaI_auxsyntaxerror("unmatched $else");
ifstate[iflevel].elsepart = 1;
ifstate[iflevel].skip =
ifstate[iflevel-1].skip || ifstate[iflevel].condition;
break;
default:
luaI_auxsynterrbf("invalid pragma", buff);
}
skipspace();
if (current == '\n') /* pragma must end with a '\n' ... */
inclinenumber();
else if (current != EOZ) /* or eof */
luaI_auxsyntaxerror("invalid pragma format");
ifskip();
}
}
static int read_long_string (char *yytext, int buffsize)
{
int cont = 0;
int tokensize = 2; /* '[[' already stored */
while (1)
{
if (buffsize-tokensize <= 2) /* may read more than 1 char in one cicle */
yytext = luaI_buffer(buffsize *= 2);
switch (current)
{
case EOZ:
save(0);
return WRONGTOKEN;
case '[':
save_and_next();
if (current == '[')
{
cont++;
save_and_next();
}
continue;
case ']':
save_and_next();
if (current == ']')
{
if (cont == 0) goto endloop;
cont--;
save_and_next();
}
continue;
case '\n':
save('\n');
inclinenumber();
continue;
default:
save_and_next();
}
} endloop:
save_and_next(); /* pass the second ']' */
yytext[tokensize-2] = 0; /* erases ']]' */
luaY_lval.vWord = luaI_findconstantbyname(yytext+2);
yytext[tokensize-2] = ']'; /* restores ']]' */
save(0);
return STRING;
}
int luaY_lex (void)
{
static int linelasttoken = 0;
double a;
int buffsize = MINBUFF;
char *yytext = luaI_buffer(buffsize);
yytext[1] = yytext[2] = yytext[3] = 0;
if (lua_debug)
luaI_codedebugline(linelasttoken);
linelasttoken = lua_linenumber;
while (1)
{
int tokensize = 0;
switch (current)
{
case '\n':
inclinenumber();
linelasttoken = lua_linenumber;
continue;
case ' ': case '\t': case '\r': /* CR: to avoid problems with DOS */
next();
continue;
case '-':
save_and_next();
if (current != '-') return '-';
do { next(); } while (current != '\n' && current != EOZ);
continue;
case '[':
save_and_next();
if (current != '[') return '[';
else
{
save_and_next(); /* pass the second '[' */
return read_long_string(yytext, buffsize);
}
case '=':
save_and_next();
if (current != '=') return '=';
else { save_and_next(); return EQ; }
case '<':
save_and_next();
if (current != '=') return '<';
else { save_and_next(); return LE; }
case '>':
save_and_next();
if (current != '=') return '>';
else { save_and_next(); return GE; }
case '~':
save_and_next();
if (current != '=') return '~';
else { save_and_next(); return NE; }
case '"':
case '\'':
{
int del = current;
save_and_next();
while (current != del)
{
if (buffsize-tokensize <= 2) /* may read more than 1 char in one cicle */
yytext = luaI_buffer(buffsize *= 2);
switch (current)
{
case EOZ:
case '\n':
save(0);
return WRONGTOKEN;
case '\\':
next(); /* do not save the '\' */
switch (current)
{
case 'n': save('\n'); next(); break;
case 't': save('\t'); next(); break;
case 'r': save('\r'); next(); break;
case '\n': save('\n'); inclinenumber(); break;
default : save_and_next(); break;
}
break;
default:
save_and_next();
}
}
next(); /* skip delimiter */
save(0);
luaY_lval.vWord = luaI_findconstantbyname(yytext+1);
tokensize--;
save(del); save(0); /* restore delimiter */
return STRING;
}
case 'a': case 'b': case 'c': case 'd': case 'e':
case 'f': case 'g': case 'h': case 'i': case 'j':
case 'k': case 'l': case 'm': case 'n': case 'o':
case 'p': case 'q': case 'r': case 's': case 't':
case 'u': case 'v': case 'w': case 'x': case 'y':
case 'z':
case 'A': case 'B': case 'C': case 'D': case 'E':
case 'F': case 'G': case 'H': case 'I': case 'J':
case 'K': case 'L': case 'M': case 'N': case 'O':
case 'P': case 'Q': case 'R': case 'S': case 'T':
case 'U': case 'V': case 'W': case 'X': case 'Y':
case 'Z':
case '_':
{
TaggedString *ts;
do {
save_and_next();
} while (isalnum((unsigned char)current) || current == '_');
save(0);
ts = lua_createstring(yytext);
if (ts->marked > 2)
return ts->marked; /* reserved word */
luaY_lval.pTStr = ts;
ts->marked = 2; /* avoid GC */
return NAME;
}
case '.':
save_and_next();
if (current == '.')
{
save_and_next();
if (current == '.')
{
save_and_next();
return DOTS; /* ... */
}
else return CONC; /* .. */
}
else if (!isdigit((unsigned char)current)) return '.';
/* current is a digit: goes through to number */
a=0.0;
goto fraction;
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
a=0.0;
do {
a=10.0*a+(current-'0');
save_and_next();
} while (isdigit((unsigned char)current));
if (current == '.') {
save_and_next();
if (current == '.')
luaI_syntaxerror(
"ambiguous syntax (decimal point x string concatenation)");
}
fraction:
{ double da=0.1;
while (isdigit((unsigned char)current))
{
a+=(current-'0')*da;
da/=10.0;
save_and_next();
}
if (current == 'e' || current == 'E')
{
int e=0;
int neg;
double ea;
save_and_next();
neg=(current=='-');
if (current == '+' || current == '-') save_and_next();
if (!isdigit((unsigned char)current)) {
save(0); return WRONGTOKEN; }
do {
e=10.0*e+(current-'0');
save_and_next();
} while (isdigit((unsigned char)current));
for (ea=neg?0.1:10.0; e>0; e>>=1)
{
if (e & 1) a*=ea;
ea*=ea;
}
}
luaY_lval.vFloat = a;
save(0);
return NUMBER;
}
case EOZ:
save(0);
if (iflevel > 0)
luaI_syntaxerror("missing $endif");
return 0;
default:
save_and_next();
return yytext[0];
}
}
}

18
lex.h
View File

@@ -1,18 +0,0 @@
/*
** lex.h
** TecCGraf - PUC-Rio
** $Id: lex.h,v 1.3 1996/11/08 12:49:35 roberto Exp roberto $
*/
#ifndef lex_h
#define lex_h
#include "zio.h"
void lua_setinput (ZIO *z);
void luaI_syntaxerror (char *s);
int luaY_lex (void);
void luaI_addReserved (void);
#endif

98
lfunc.c Normal file
View File

@@ -0,0 +1,98 @@
/*
** $Id: lfunc.c,v 1.7 1997/12/09 13:35:19 roberto Exp roberto $
** Auxiliar functions to manipulate prototypes and closures
** See Copyright Notice in lua.h
*/
#include <stdlib.h>
#include "lfunc.h"
#include "lmem.h"
#include "lstate.h"
#define gcsizeproto(p) 5 /* approximate "weight" for a prototype */
#define gcsizeclosure(c) 1 /* approximate "weight" for a closure */
Closure *luaF_newclosure (int nelems)
{
Closure *c = (Closure *)luaM_malloc(sizeof(Closure)+nelems*sizeof(TObject));
luaO_insertlist(&(L->rootcl), (GCnode *)c);
L->nblocks += gcsizeclosure(c);
c->nelems = nelems;
return c;
}
TProtoFunc *luaF_newproto (void)
{
TProtoFunc *f = luaM_new(TProtoFunc);
f->code = NULL;
f->lineDefined = 0;
f->fileName = NULL;
f->consts = NULL;
f->nconsts = 0;
f->locvars = NULL;
luaO_insertlist(&(L->rootproto), (GCnode *)f);
L->nblocks += gcsizeproto(f);
return f;
}
static void freefunc (TProtoFunc *f)
{
luaM_free(f->code);
luaM_free(f->locvars);
luaM_free(f->consts);
luaM_free(f);
}
void luaF_freeproto (TProtoFunc *l)
{
while (l) {
TProtoFunc *next = (TProtoFunc *)l->head.next;
L->nblocks -= gcsizeproto(l);
freefunc(l);
l = next;
}
}
void luaF_freeclosure (Closure *l)
{
while (l) {
Closure *next = (Closure *)l->head.next;
L->nblocks -= gcsizeclosure(l);
luaM_free(l);
l = next;
}
}
/*
** Look for n-th local variable at line "line" in function "func".
** Returns NULL if not found.
*/
char *luaF_getlocalname (TProtoFunc *func, int local_number, int line)
{
int count = 0;
char *varname = NULL;
LocVar *lv = func->locvars;
if (lv == NULL)
return NULL;
for (; lv->line != -1 && lv->line < line; lv++) {
if (lv->varname) { /* register */
if (++count == local_number)
varname = lv->varname->str;
}
else /* unregister */
if (--count < local_number)
varname = NULL;
}
return varname;
}

23
lfunc.h Normal file
View File

@@ -0,0 +1,23 @@
/*
** $Id: lfunc.h,v 1.4 1997/11/19 17:29:23 roberto Exp roberto $
** Lua Function structures
** See Copyright Notice in lua.h
*/
#ifndef lfunc_h
#define lfunc_h
#include "lobject.h"
TProtoFunc *luaF_newproto (void);
Closure *luaF_newclosure (int nelems);
void luaF_freeproto (TProtoFunc *l);
void luaF_freeclosure (Closure *l);
char *luaF_getlocalname (TProtoFunc *func, int local_number, int line);
#endif

286
lgc.c Normal file
View File

@@ -0,0 +1,286 @@
/*
** $Id: lgc.c,v 1.14 1997/12/17 20:48:58 roberto Exp roberto $
** Garbage Collector
** See Copyright Notice in lua.h
*/
#include "ldo.h"
#include "lfunc.h"
#include "lgc.h"
#include "lmem.h"
#include "lobject.h"
#include "lstate.h"
#include "lstring.h"
#include "ltable.h"
#include "ltm.h"
#include "lua.h"
static int markobject (TObject *o);
/*
** =======================================================
** REF mechanism
** =======================================================
*/
int luaC_ref (TObject *o, int lock)
{
int ref;
if (ttype(o) == LUA_T_NIL)
ref = -1; /* special ref for nil */
else {
for (ref=0; ref<L->refSize; ref++)
if (L->refArray[ref].status == FREE)
goto found;
/* no more empty spaces */ {
int oldSize = L->refSize;
L->refSize = luaM_growvector(&L->refArray, L->refSize, struct ref,
refEM, MAX_WORD);
for (ref=oldSize; ref<L->refSize; ref++)
L->refArray[ref].status = FREE;
ref = oldSize;
} found:
L->refArray[ref].o = *o;
L->refArray[ref].status = lock ? LOCK : HOLD;
}
return ref;
}
void lua_unref (int ref)
{
if (ref >= 0 && ref < L->refSize)
L->refArray[ref].status = FREE;
}
TObject* luaC_getref (int ref)
{
if (ref == -1)
return &luaO_nilobject;
if (ref >= 0 && ref < L->refSize &&
(L->refArray[ref].status == LOCK || L->refArray[ref].status == HOLD))
return &L->refArray[ref].o;
else
return NULL;
}
static void travlock (void)
{
int i;
for (i=0; i<L->refSize; i++)
if (L->refArray[i].status == LOCK)
markobject(&L->refArray[i].o);
}
static int ismarked (TObject *o)
{
/* valid only for locked objects */
switch (o->ttype) {
case LUA_T_STRING: case LUA_T_USERDATA:
return o->value.ts->head.marked;
case LUA_T_ARRAY:
return o->value.a->head.marked;
case LUA_T_CLOSURE:
return o->value.cl->head.marked;
case LUA_T_PROTO:
return o->value.tf->head.marked;
#ifdef DEBUG
case LUA_T_LINE: case LUA_T_CLMARK:
case LUA_T_CMARK: case LUA_T_PMARK:
lua_error("internal error");
#endif
default: /* nil, number or cproto */
return 1;
}
}
static void invalidaterefs (void)
{
int i;
for (i=0; i<L->refSize; i++)
if (L->refArray[i].status == HOLD && !ismarked(&L->refArray[i].o))
L->refArray[i].status = COLLECTED;
}
void luaC_hashcallIM (Hash *l)
{
TObject t;
ttype(&t) = LUA_T_ARRAY;
for (; l; l=(Hash *)l->head.next) {
avalue(&t) = l;
luaD_gcIM(&t);
}
}
void luaC_strcallIM (TaggedString *l)
{
TObject o;
ttype(&o) = LUA_T_USERDATA;
for (; l; l=(TaggedString *)l->head.next)
if (l->constindex == -1) { /* is userdata? */
tsvalue(&o) = l;
luaD_gcIM(&o);
}
}
static GCnode *listcollect (GCnode *l)
{
GCnode *frees = NULL;
while (l) {
GCnode *next = l->next;
l->marked = 0;
while (next && !next->marked) {
l->next = next->next;
next->next = frees;
frees = next;
next = l->next;
}
l = next;
}
return frees;
}
static void strmark (TaggedString *s)
{
if (!s->head.marked)
s->head.marked = 1;
}
static void protomark (TProtoFunc *f)
{
if (!f->head.marked) {
LocVar *v = f->locvars;
int i;
f->head.marked = 1;
if (f->fileName)
strmark(f->fileName);
for (i=0; i<f->nconsts; i++)
markobject(&f->consts[i]);
if (v) {
for (; v->line != -1; v++)
if (v->varname)
strmark(v->varname);
}
}
}
static void closuremark (Closure *f)
{
if (!f->head.marked) {
int i;
f->head.marked = 1;
for (i=f->nelems; i>=0; i--)
markobject(&f->consts[i]);
}
}
static void hashmark (Hash *h)
{
if (!h->head.marked) {
int i;
h->head.marked = 1;
for (i=0; i<nhash(h); i++) {
Node *n = node(h,i);
if (ttype(ref(n)) != LUA_T_NIL) {
markobject(&n->ref);
markobject(&n->val);
}
}
}
}
static void globalmark (void)
{
TaggedString *g;
for (g=(TaggedString *)L->rootglobal.next; g; g=(TaggedString *)g->head.next)
if (g->u.globalval.ttype != LUA_T_NIL) {
markobject(&g->u.globalval);
strmark(g); /* cannot collect non nil global variables */
}
}
static int markobject (TObject *o)
{
switch (ttype(o)) {
case LUA_T_USERDATA: case LUA_T_STRING:
strmark(tsvalue(o));
break;
case LUA_T_ARRAY:
hashmark(avalue(o));
break;
case LUA_T_CLOSURE: case LUA_T_CLMARK:
closuremark(o->value.cl);
break;
case LUA_T_PROTO: case LUA_T_PMARK:
protomark(o->value.tf);
break;
default: break; /* numbers, cprotos, etc */
}
return 0;
}
static void markall (void)
{
luaD_travstack(markobject); /* mark stack objects */
globalmark(); /* mark global variable values and names */
travlock(); /* mark locked objects */
luaT_travtagmethods(markobject); /* mark fallbacks */
}
long lua_collectgarbage (long limit)
{
unsigned long recovered = L->nblocks; /* to subtract nblocks after gc */
Hash *freetable;
TaggedString *freestr;
TProtoFunc *freefunc;
Closure *freeclos;
markall();
invalidaterefs();
freestr = luaS_collector();
freetable = (Hash *)listcollect(&(L->roottable));
freefunc = (TProtoFunc *)listcollect(&(L->rootproto));
freeclos = (Closure *)listcollect(&(L->rootcl));
L->GCthreshold *= 4; /* to avoid GC during GC */
luaC_hashcallIM(freetable); /* GC tag methods for tables */
luaC_strcallIM(freestr); /* GC tag methods for userdata */
luaD_gcIM(&luaO_nilobject); /* GC tag method for nil (signal end of GC) */
luaH_free(freetable);
luaS_free(freestr);
luaF_freeproto(freefunc);
luaF_freeclosure(freeclos);
recovered = recovered-L->nblocks;
L->GCthreshold = (limit == 0) ? 2*L->nblocks : L->nblocks+limit;
return recovered;
}
void luaC_checkGC (void)
{
if (L->nblocks >= L->GCthreshold)
lua_collectgarbage(0);
}

21
lgc.h Normal file
View File

@@ -0,0 +1,21 @@
/*
** $Id: lgc.h,v 1.3 1997/11/19 17:29:23 roberto Exp roberto $
** Garbage Collector
** See Copyright Notice in lua.h
*/
#ifndef lgc_h
#define lgc_h
#include "lobject.h"
void luaC_checkGC (void);
TObject* luaC_getref (int ref);
int luaC_ref (TObject *o, int lock);
void luaC_hashcallIM (Hash *l);
void luaC_strcallIM (TaggedString *l);
#endif

View File

@@ -1,16 +1,43 @@
/*
** $Id: liolib.c,v 1.13 1997/12/26 18:38:16 roberto Exp roberto $
** Standard I/O (and system) library
** See Copyright Notice in lua.h
*/
#include <errno.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#include <stdlib.h>
#include <errno.h>
#include "lauxlib.h"
#include "lua.h"
#include "auxlib.h"
#include "luadebug.h"
#include "lualib.h"
int lua_tagio;
#ifndef OLD_ANSI
#include <locale.h>
#else
#define setlocale(a,b) 0
#define LC_ALL 0
#define LC_COLLATE 0
#define LC_CTYPE 0
#define LC_MONETARY 0
#define LC_NUMERIC 0
#define LC_TIME 0
#define strerror(e) "(no error message provided by operating system)"
#endif
#define CLOSEDTAG 2
#define IOTAG 1
#define FIRSTARG 3 /* 1st and 2nd are upvalues */
#define FINPUT "_INPUT"
#define FOUTPUT "_OUTPUT"
#ifdef POPEN
@@ -22,104 +49,130 @@ int pclose();
#endif
static int gettag (int i)
{
return lua_getnumber(lua_getparam(i));
}
static void pushresult (int i)
{
if (i)
lua_pushuserdata(NULL);
else {
lua_pushnil();
#ifndef NOSTRERROR
lua_pushstring(strerror(errno));
#else
lua_pushstring("O.S. unable to define the error");
#endif
}
}
static int ishandler (lua_Object f)
{
if (lua_isuserdata(f)) {
if (lua_tag(f) == gettag(CLOSEDTAG))
lua_error("cannot access a closed file");
return lua_tag(f) == gettag(IOTAG);
}
else return 0;
}
static FILE *getfile (char *name)
{
lua_Object f = lua_getglobal(name);
if (!lua_isuserdata(f) || lua_tag(f) != lua_tagio)
luaL_verror("global variable %s is not a file handle", name);
if (!ishandler(f))
luaL_verror("global variable `%.50s' is not a file handle", name);
return lua_getuserdata(f);
}
static FILE *getfileparam (char *name, int *arg)
{
lua_Object f = lua_getparam(*arg);
if (ishandler(f)) {
(*arg)++;
return lua_getuserdata(f);
}
else
return getfile(name);
}
static void closefile (char *name)
{
FILE *f = getfile(name);
if (f == stdin || f == stdout) return;
if (pclose(f) == -1)
fclose(f);
lua_pushobject(lua_getglobal(name));
lua_settag(gettag(CLOSEDTAG));
}
static void setfile (FILE *f, char *name)
static void setfile (FILE *f, char *name, int tag)
{
lua_pushusertag(f, lua_tagio);
lua_pushusertag(f, tag);
lua_setglobal(name);
}
static void setreturn (FILE *f, char *name)
{
setfile(f, name);
lua_pushusertag(f, lua_tagio);
int tag = gettag(IOTAG);
setfile(f, name, tag);
lua_pushusertag(f, tag);
}
static void io_readfrom (void)
{
FILE *current;
lua_Object f = lua_getparam(1);
lua_Object f = lua_getparam(FIRSTARG);
if (f == LUA_NOOBJECT) {
closefile("_INPUT");
closefile(FINPUT);
current = stdin;
}
else if (lua_tag(f) == lua_tagio)
else if (lua_tag(f) == gettag(IOTAG))
current = lua_getuserdata(f);
else {
char *s = luaL_check_string(1);
char *s = luaL_check_string(FIRSTARG);
current = (*s == '|') ? popen(s+1, "r") : fopen(s, "r");
if (current == NULL) {
pushresult(0);
return;
}
}
setreturn(current, "_INPUT");
setreturn(current, FINPUT);
}
static void io_writeto (void)
{
FILE *current;
lua_Object f = lua_getparam(1);
lua_Object f = lua_getparam(FIRSTARG);
if (f == LUA_NOOBJECT) {
closefile("_OUTPUT");
closefile(FOUTPUT);
current = stdout;
}
else if (lua_tag(f) == lua_tagio)
else if (lua_tag(f) == gettag(IOTAG))
current = lua_getuserdata(f);
else {
char *s = luaL_check_string(1);
char *s = luaL_check_string(FIRSTARG);
current = (*s == '|') ? popen(s+1,"w") : fopen(s,"w");
if (current == NULL) {
pushresult(0);
return;
}
}
setreturn(current, "_OUTPUT");
setreturn(current, FOUTPUT);
}
static void io_appendto (void)
{
char *s = luaL_check_string(1);
char *s = luaL_check_string(FIRSTARG);
FILE *fp = fopen (s, "a");
if (fp != NULL)
setreturn(fp, "_OUTPUT");
setreturn(fp, FOUTPUT);
else
pushresult(0);
}
@@ -129,12 +182,13 @@ static void io_appendto (void)
static void io_read (void)
{
FILE *f = getfile("_INPUT");
int arg = FIRSTARG;
FILE *f = getfileparam(FINPUT, &arg);
char *buff;
char *p = luaL_opt_string(1, "[^\n]*{\n}");
char *p = luaL_opt_string(arg, "[^\n]*{\n}");
int inskip = 0; /* to control {skips} */
int c = NEED_OTHER;
luaI_emptybuff();
luaL_resetbuffer();
while (*p) {
if (*p == '{') {
inskip++;
@@ -147,12 +201,12 @@ static void io_read (void)
p++;
}
else {
char *ep = luaL_item_end(p); /* get what is next */
char *ep; /* get what is next */
int m; /* match result */
if (c == NEED_OTHER) c = getc(f);
m = (c == EOF) ? 0 : luaL_singlematch((char)c, p);
m = luaI_singlematch((c == EOF) ? 0 : (char)c, p, &ep);
if (m) {
if (inskip == 0) luaI_addchar(c);
if (inskip == 0) luaL_addchar(c);
c = NEED_OTHER;
}
switch (*ep) {
@@ -171,7 +225,8 @@ static void io_read (void)
} break_while:
if (c >= 0) /* not EOF nor NEED_OTHER? */
ungetc(c, f);
buff = luaI_addchar(0);
luaL_addchar(0);
buff = luaL_buffer();
if (*buff != 0 || *p == 0) /* read something or did not fail? */
lua_pushstring(buff);
}
@@ -179,8 +234,8 @@ static void io_read (void)
static void io_write (void)
{
FILE *f = getfile("_OUTPUT");
int arg = 1;
int arg = FIRSTARG;
FILE *f = getfileparam(FOUTPUT, &arg);
int status = 1;
char *s;
while ((s = luaL_opt_string(arg++, NULL)) != NULL)
@@ -217,7 +272,7 @@ static void io_tmpname (void)
static void io_getenv (void)
{
lua_pushstring(getenv(luaL_check_string(1))); /* if NULL push nil */
lua_pushstring(getenv(luaL_check_string(1))); /* if NULL push nil */
}
@@ -233,7 +288,17 @@ static void io_date (void)
else
lua_error("invalid `date' format");
}
static void setloc (void)
{
static int cat[] = {LC_ALL, LC_COLLATE, LC_CTYPE, LC_MONETARY, LC_NUMERIC,
LC_TIME};
int op = (int)luaL_opt_number(2, 0);
luaL_arg_check(0 <= op && op <= 5, 2, "invalid option");
lua_pushstring(setlocale(cat[op], luaL_check_string(1)));
}
static void io_exit (void)
{
@@ -300,11 +365,7 @@ static void errorfb (void)
static struct luaL_reg iolib[] = {
{"readfrom", io_readfrom},
{"writeto", io_writeto},
{"appendto", io_appendto},
{"read", io_read},
{"write", io_write},
{"setlocale", setloc},
{"execute", io_execute},
{"remove", io_remove},
{"rename", io_rename},
@@ -316,15 +377,37 @@ static struct luaL_reg iolib[] = {
{"print_stack", errorfb}
};
void iolib_open (void)
static struct luaL_reg iolibtag[] = {
{"readfrom", io_readfrom},
{"writeto", io_writeto},
{"appendto", io_appendto},
{"read", io_read},
{"write", io_write}
};
static void openwithtags (void)
{
int iotag = lua_newtag();
int closedtag = lua_newtag();
int i;
for (i=0; i<sizeof(iolibtag)/sizeof(iolibtag[0]); i++) {
/* put both tags as upvalues for these functions */
lua_pushnumber(iotag);
lua_pushnumber(closedtag);
lua_pushCclosure(iolibtag[i].func, 2);
lua_setglobal(iolibtag[i].name);
}
setfile(stdin, FINPUT, iotag);
setfile(stdout, FOUTPUT, iotag);
setfile(stdin, "_STDIN", iotag);
setfile(stdout, "_STDOUT", iotag);
setfile(stderr, "_STDERR", iotag);
}
void lua_iolibopen (void)
{
lua_tagio = lua_newtag();
setfile(stdin, "_INPUT");
setfile(stdout, "_OUTPUT");
setfile(stdin, "_STDIN");
setfile(stdout, "_STDOUT");
setfile(stderr, "_STDERR");
luaL_openlib(iolib, (sizeof(iolib)/sizeof(iolib[0])));
openwithtags();
lua_pushcfunction(errorfb);
lua_seterrormethod();
}

437
llex.c Normal file
View File

@@ -0,0 +1,437 @@
/*
** $Id: llex.c,v 1.12 1997/12/22 17:52:20 roberto Exp roberto $
** Lexical Analizer
** See Copyright Notice in lua.h
*/
#include <ctype.h>
#include <string.h>
#include "lauxlib.h"
#include "llex.h"
#include "lmem.h"
#include "lobject.h"
#include "lparser.h"
#include "lstate.h"
#include "lstring.h"
#include "lstx.h"
#include "luadebug.h"
#include "lzio.h"
int lua_debug=0;
#define next(LS) (LS->current = zgetc(LS->lex_z))
static struct {
char *name;
int token;
} reserved [] = {
{"and", AND}, {"do", DO}, {"else", ELSE}, {"elseif", ELSEIF},
{"end", END}, {"function", FUNCTION}, {"if", IF}, {"local", LOCAL},
{"nil", NIL}, {"not", NOT}, {"or", OR}, {"repeat", REPEAT},
{"return", RETURN}, {"then", THEN}, {"until", UNTIL}, {"while", WHILE}
};
void luaX_init (void)
{
int i;
for (i=0; i<(sizeof(reserved)/sizeof(reserved[0])); i++) {
TaggedString *ts = luaS_new(reserved[i].name);
ts->head.marked = reserved[i].token; /* reserved word (always > 255) */
}
}
static void firstline (LexState *LS)
{
int c = zgetc(LS->lex_z);
if (c == '#') {
LS->linenumber++;
while ((c=zgetc(LS->lex_z)) != '\n' && c != EOZ) /* skip first line */;
}
zungetc(LS->lex_z);
}
void luaX_setinput (ZIO *z)
{
LexState *LS = L->lexstate;
LS->current = '\n';
LS->linelasttoken = 0;
LS->linenumber = 0;
LS->iflevel = 0;
LS->ifstate[0].skip = 0;
LS->ifstate[0].elsepart = 1; /* to avoid a free $else */
LS->lex_z = z;
firstline(LS);
luaL_resetbuffer();
}
/*
** =======================================================
** PRAGMAS
** =======================================================
*/
#define PRAGMASIZE 20
static void skipspace (LexState *LS)
{
while (LS->current == ' ' || LS->current == '\t' || LS->current == '\r')
next(LS);
}
static int checkcond (char *buff)
{
static char *opts[] = {"nil", "1", NULL};
int i = luaO_findstring(buff, opts);
if (i >= 0) return i;
else if (isalpha((unsigned char)buff[0]) || buff[0] == '_')
return luaS_globaldefined(buff);
else {
luaY_syntaxerror("invalid $if condition", buff);
return 0; /* to avoid warnings */
}
}
static void readname (LexState *LS, char *buff)
{
int i = 0;
skipspace(LS);
while (isalnum(LS->current) || LS->current == '_') {
if (i >= PRAGMASIZE) {
buff[PRAGMASIZE] = 0;
luaY_syntaxerror("pragma too long", buff);
}
buff[i++] = LS->current;
next(LS);
}
buff[i] = 0;
}
static void inclinenumber (LexState *LS);
static void ifskip (LexState *LS)
{
while (LS->ifstate[LS->iflevel].skip) {
if (LS->current == '\n')
inclinenumber(LS);
else if (LS->current == EOZ)
luaY_syntaxerror("input ends inside a $if", "");
else next(LS);
}
}
static void inclinenumber (LexState *LS)
{
static char *pragmas [] =
{"debug", "nodebug", "endinput", "end", "ifnot", "if", "else", NULL};
next(LS); /* skip '\n' */
++LS->linenumber;
if (LS->current == '$') { /* is a pragma? */
char buff[PRAGMASIZE+1];
int ifnot = 0;
int skip = LS->ifstate[LS->iflevel].skip;
next(LS); /* skip $ */
readname(LS, buff);
switch (luaO_findstring(buff, pragmas)) {
case 0: /* debug */
if (!skip) lua_debug = 1;
break;
case 1: /* nodebug */
if (!skip) lua_debug = 0;
break;
case 2: /* endinput */
if (!skip) {
LS->current = EOZ;
LS->iflevel = 0; /* to allow $endinput inside a $if */
}
break;
case 3: /* end */
if (LS->iflevel-- == 0)
luaY_syntaxerror("unmatched $end", "$end");
break;
case 4: /* ifnot */
ifnot = 1;
/* go through */
case 5: /* if */
if (LS->iflevel == MAX_IFS-1)
luaY_syntaxerror("too many nested $ifs", "$if");
readname(LS, buff);
LS->iflevel++;
LS->ifstate[LS->iflevel].elsepart = 0;
LS->ifstate[LS->iflevel].condition = checkcond(buff) ? !ifnot : ifnot;
LS->ifstate[LS->iflevel].skip = skip || !LS->ifstate[LS->iflevel].condition;
break;
case 6: /* else */
if (LS->ifstate[LS->iflevel].elsepart)
luaY_syntaxerror("unmatched $else", "$else");
LS->ifstate[LS->iflevel].elsepart = 1;
LS->ifstate[LS->iflevel].skip = LS->ifstate[LS->iflevel-1].skip ||
LS->ifstate[LS->iflevel].condition;
break;
default:
luaY_syntaxerror("unknown pragma", buff);
}
skipspace(LS);
if (LS->current == '\n') /* pragma must end with a '\n' ... */
inclinenumber(LS);
else if (LS->current != EOZ) /* or eof */
luaY_syntaxerror("invalid pragma format", buff);
ifskip(LS);
}
}
/*
** =======================================================
** LEXICAL ANALIZER
** =======================================================
*/
#define save(c) luaL_addchar(c)
#define save_and_next(LS) (save(LS->current), next(LS))
char *luaX_lasttoken (void)
{
save(0);
return luaL_buffer();
}
static int read_long_string (LexState *LS, YYSTYPE *l)
{
int cont = 0;
while (1) {
switch (LS->current) {
case EOZ:
save(0);
return WRONGTOKEN;
case '[':
save_and_next(LS);
if (LS->current == '[') {
cont++;
save_and_next(LS);
}
continue;
case ']':
save_and_next(LS);
if (LS->current == ']') {
if (cont == 0) goto endloop;
cont--;
save_and_next(LS);
}
continue;
case '\n':
save('\n');
inclinenumber(LS);
continue;
default:
save_and_next(LS);
}
} endloop:
save_and_next(LS); /* pass the second ']' */
L->Mbuffer[L->Mbuffnext-2] = 0; /* erases ']]' */
l->pTStr = luaS_new(L->Mbuffbase+2);
L->Mbuffer[L->Mbuffnext-2] = ']'; /* restores ']]' */
return STRING;
}
/* to avoid warnings; this declaration cannot be public since YYSTYPE
** cannot be visible in llex.h (otherwise there is an error, since
** the parser body redefines it!)
*/
int luaY_lex (YYSTYPE *l);
int luaY_lex (YYSTYPE *l)
{
LexState *LS = L->lexstate;
double a;
luaL_resetbuffer();
if (lua_debug)
luaY_codedebugline(LS->linelasttoken);
LS->linelasttoken = LS->linenumber;
while (1) {
switch (LS->current) {
case ' ': case '\t': case '\r': /* CR: to avoid problems with DOS */
next(LS);
continue;
case '\n':
inclinenumber(LS);
LS->linelasttoken = LS->linenumber;
continue;
case '-':
save_and_next(LS);
if (LS->current != '-') return '-';
do { next(LS); } while (LS->current != '\n' && LS->current != EOZ);
luaL_resetbuffer();
continue;
case '[':
save_and_next(LS);
if (LS->current != '[') return '[';
else {
save_and_next(LS); /* pass the second '[' */
return read_long_string(LS, l);
}
case '=':
save_and_next(LS);
if (LS->current != '=') return '=';
else { save_and_next(LS); return EQ; }
case '<':
save_and_next(LS);
if (LS->current != '=') return '<';
else { save_and_next(LS); return LE; }
case '>':
save_and_next(LS);
if (LS->current != '=') return '>';
else { save_and_next(LS); return GE; }
case '~':
save_and_next(LS);
if (LS->current != '=') return '~';
else { save_and_next(LS); return NE; }
case '"':
case '\'': {
int del = LS->current;
save_and_next(LS);
while (LS->current != del) {
switch (LS->current) {
case EOZ:
case '\n':
save(0);
return WRONGTOKEN;
case '\\':
next(LS); /* do not save the '\' */
switch (LS->current) {
case 'n': save('\n'); next(LS); break;
case 't': save('\t'); next(LS); break;
case 'r': save('\r'); next(LS); break;
case '\n': save('\n'); inclinenumber(LS); break;
default : save_and_next(LS); break;
}
break;
default:
save_and_next(LS);
}
}
next(LS); /* skip delimiter */
save(0);
l->pTStr = luaS_new(L->Mbuffbase+1);
L->Mbuffer[L->Mbuffnext-1] = del; /* restore delimiter */
return STRING;
}
case '.':
save_and_next(LS);
if (LS->current == '.')
{
save_and_next(LS);
if (LS->current == '.')
{
save_and_next(LS);
return DOTS; /* ... */
}
else return CONC; /* .. */
}
else if (!isdigit(LS->current)) return '.';
/* LS->current is a digit: goes through to number */
a=0.0;
goto fraction;
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
a=0.0;
do {
a=10.0*a+(LS->current-'0');
save_and_next(LS);
} while (isdigit(LS->current));
if (LS->current == '.') {
save_and_next(LS);
if (LS->current == '.') {
save(0);
luaY_error(
"ambiguous syntax (decimal point x string concatenation)");
}
}
fraction:
{ double da=0.1;
while (isdigit(LS->current))
{
a+=(LS->current-'0')*da;
da/=10.0;
save_and_next(LS);
}
if (toupper(LS->current) == 'E') {
int e=0;
int neg;
double ea;
save_and_next(LS);
neg=(LS->current=='-');
if (LS->current == '+' || LS->current == '-') save_and_next(LS);
if (!isdigit(LS->current)) {
save(0); return WRONGTOKEN; }
do {
e=10.0*e+(LS->current-'0');
save_and_next(LS);
} while (isdigit(LS->current));
for (ea=neg?0.1:10.0; e>0; e>>=1)
{
if (e & 1) a*=ea;
ea*=ea;
}
}
l->vReal = a;
return NUMBER;
}
case EOZ:
save(0);
if (LS->iflevel > 0)
luaY_syntaxerror("input ends inside a $if", "");
return 0;
default:
if (LS->current != '_' && !isalpha(LS->current)) {
int c = LS->current;
save_and_next(LS);
return c;
}
else { /* identifier or reserved word */
TaggedString *ts;
do {
save_and_next(LS);
} while (isalnum(LS->current) || LS->current == '_');
save(0);
ts = luaS_new(L->Mbuffbase);
if (ts->head.marked > 255)
return ts->head.marked; /* reserved word */
l->pTStr = ts;
return NAME;
}
}
}
}

41
llex.h Normal file
View File

@@ -0,0 +1,41 @@
/*
** $Id: llex.h,v 1.6 1997/12/17 20:48:58 roberto Exp roberto $
** Lexical Analizer
** See Copyright Notice in lua.h
*/
#ifndef llex_h
#define llex_h
#include "lobject.h"
#include "lzio.h"
#define MAX_IFS 5
/* "ifstate" keeps the state of each nested $if the lexical is dealing with. */
struct ifState {
int elsepart; /* true if its in the $else part */
int condition; /* true if $if condition is true */
int skip; /* true if part must be skiped */
};
typedef struct LexState {
int current; /* look ahead character */
struct zio *lex_z; /* input stream */
int linenumber; /* input line counter */
int linelasttoken; /* line where last token was read */
int lastline; /* last line wherein a SETLINE was generated */
int iflevel; /* level of nested $if's (for lexical analysis) */
struct ifState ifstate[MAX_IFS];
} LexState;
void luaX_init (void);
void luaX_setinput (ZIO *z);
char *luaX_lasttoken (void);
#endif

201
lmathlib.c Normal file
View File

@@ -0,0 +1,201 @@
/*
** $Id: lmathlib.c,v 1.7 1997/12/09 13:35:19 roberto Exp roberto $
** Lua standard mathematical library
** See Copyright Notice in lua.h
*/
#include <stdlib.h>
#include <math.h>
#include "lauxlib.h"
#include "lua.h"
#include "lualib.h"
#ifdef M_PI
#define PI M_PI
#else
#define PI ((double)3.14159265358979323846)
#endif
#define FROMRAD(a) ((a)*(180.0/PI))
#define TORAD(a) ((a)*(PI/180.0))
static void math_abs (void)
{
double d = luaL_check_number(1);
if (d < 0) d = -d;
lua_pushnumber(d);
}
static void math_sin (void)
{
lua_pushnumber(sin(TORAD(luaL_check_number(1))));
}
static void math_cos (void)
{
lua_pushnumber(cos(TORAD(luaL_check_number(1))));
}
static void math_tan (void)
{
lua_pushnumber(tan(TORAD(luaL_check_number(1))));
}
static void math_asin (void)
{
lua_pushnumber(FROMRAD(asin(luaL_check_number(1))));
}
static void math_acos (void)
{
lua_pushnumber(FROMRAD(acos(luaL_check_number(1))));
}
static void math_atan (void)
{
lua_pushnumber(FROMRAD(atan(luaL_check_number(1))));
}
static void math_atan2 (void)
{
lua_pushnumber(FROMRAD(atan2(luaL_check_number(1), luaL_check_number(2))));
}
static void math_ceil (void)
{
lua_pushnumber(ceil(luaL_check_number(1)));
}
static void math_floor (void)
{
lua_pushnumber(floor(luaL_check_number(1)));
}
static void math_mod (void)
{
lua_pushnumber(fmod(luaL_check_number(1), luaL_check_number(2)));
}
static void math_sqrt (void)
{
lua_pushnumber(sqrt(luaL_check_number(1)));
}
static void math_pow (void)
{
lua_pushnumber(pow(luaL_check_number(1), luaL_check_number(2)));
}
static void math_log (void)
{
lua_pushnumber(log(luaL_check_number(1)));
}
static void math_log10 (void)
{
lua_pushnumber(log10(luaL_check_number(1)));
}
static void math_exp (void)
{
lua_pushnumber(exp(luaL_check_number(1)));
}
static void math_deg (void)
{
lua_pushnumber(luaL_check_number(1)*(180.0/PI));
}
static void math_rad (void)
{
lua_pushnumber(luaL_check_number(1)*(PI/180.0));
}
static void math_min (void)
{
int i = 1;
double dmin = luaL_check_number(i);
while (lua_getparam(++i) != LUA_NOOBJECT) {
double d = luaL_check_number(i);
if (d < dmin)
dmin = d;
}
lua_pushnumber(dmin);
}
static void math_max (void)
{
int i = 1;
double dmax = luaL_check_number(i);
while (lua_getparam(++i) != LUA_NOOBJECT) {
double d = luaL_check_number(i);
if (d > dmax)
dmax = d;
}
lua_pushnumber(dmax);
}
static void math_random (void)
{
/* the '%' is needed because on some sistems (SunOS!) "rand()" may */
/* return a value bigger than RAND_MAX... */
double r = (double)(rand()%RAND_MAX) / (double)RAND_MAX;
double l = luaL_opt_number(1, 0);
if (l == 0)
lua_pushnumber(r);
else
lua_pushnumber((int)(r*l)+1);
}
static void math_randomseed (void)
{
srand(luaL_check_number(1));
}
static struct luaL_reg mathlib[] = {
{"abs", math_abs},
{"sin", math_sin},
{"cos", math_cos},
{"tan", math_tan},
{"asin", math_asin},
{"acos", math_acos},
{"atan", math_atan},
{"atan2", math_atan2},
{"ceil", math_ceil},
{"floor", math_floor},
{"mod", math_mod},
{"sqrt", math_sqrt},
{"min", math_min},
{"max", math_max},
{"log", math_log},
{"log10", math_log10},
{"exp", math_exp},
{"deg", math_deg},
{"rad", math_rad},
{"random", math_random},
{"randomseed", math_randomseed}
};
/*
** Open math library
*/
void lua_mathlibopen (void)
{
luaL_openlib(mathlib, (sizeof(mathlib)/sizeof(mathlib[0])));
lua_pushstring("deg"); lua_setglobal("_TRIGMODE");
lua_pushcfunction(math_pow);
lua_pushnumber(0); /* to get its tag */
lua_settagmethod(lua_tag(lua_pop()), "pow");
lua_pushnumber(PI); lua_setglobal("PI");
}

110
lmem.c Normal file
View File

@@ -0,0 +1,110 @@
/*
** $Id: lmem.c,v 1.3 1997/12/01 20:30:44 roberto Exp roberto $
** Interface to Memory Manager
** See Copyright Notice in lua.h
*/
#include <stdlib.h>
#include "lmem.h"
#include "lstate.h"
#include "lua.h"
int luaM_growaux (void **block, unsigned long nelems, int size,
char *errormsg, unsigned long limit)
{
if (nelems >= limit)
lua_error(errormsg);
nelems = (nelems == 0) ? 32 : nelems*2;
if (nelems > limit)
nelems = limit;
*block = luaM_realloc(*block, nelems*size);
return (int)nelems;
}
#ifndef DEBUG
/*
** generic allocation routine.
** real ANSI systems do not need some of these tests,
** since realloc(NULL, s)==malloc(s) and realloc(b, 0)==free(b).
** But some systems (e.g. Sun OS) are not that ANSI...
*/
void *luaM_realloc (void *block, unsigned long size)
{
size_t s = (size_t)size;
if (s != size)
lua_error("Allocation Error: Block too big");
if (size == 0) {
if (block) {
free(block);
}
return NULL;
}
block = block ? realloc(block, s) : malloc(s);
if (block == NULL)
lua_error(memEM);
return block;
}
#else
/* DEBUG */
#include <assert.h>
#include <string.h>
#define MARK 55
unsigned long numblocks = 0;
unsigned long totalmem = 0;
static void *checkblock (void *block)
{
unsigned long *b = (unsigned long *)block - 1;
unsigned long size = *b;
assert(*(((char *)b)+size+sizeof(unsigned long)) == MARK);
numblocks--;
totalmem -= size;
return b;
}
void *luaM_realloc (void *block, unsigned long size)
{
unsigned long realsize = sizeof(unsigned long)+size+sizeof(char);
if (realsize != (size_t)realsize)
lua_error("Allocation Error: Block too big");
if (size == 0) { /* ANSI doen't need this, but some machines... */
if (block) {
memset(block, -1, *((unsigned long *)block-1)); /* erase block */
block = checkblock(block);
free(block);
}
return NULL;
}
if (block) {
block = checkblock(block);
block = (unsigned long *)realloc(block, realsize);
}
else
block = (unsigned long *)malloc(realsize);
if (block == NULL)
lua_error(memEM);
totalmem += size;
numblocks++;
*(unsigned long *)block = size;
*(((char *)block)+size+sizeof(unsigned long)) = MARK;
return (unsigned long *)block+1;
}
#endif

43
lmem.h Normal file
View File

@@ -0,0 +1,43 @@
/*
** $Id: lmem.h,v 1.4 1997/12/01 20:30:44 roberto Exp roberto $
** Interface to Memory Manager
** See Copyright Notice in lua.h
*/
#ifndef lmem_h
#define lmem_h
#ifndef NULL
#define NULL 0
#endif
/* memory error messages */
#define codeEM "code size overflow"
#define constantEM "constant table overflow"
#define refEM "reference table overflow"
#define tableEM "table overflow"
#define memEM "not enough memory"
void *luaM_realloc (void *oldblock, unsigned long size);
int luaM_growaux (void **block, unsigned long nelems, int size,
char *errormsg, unsigned long limit);
#define luaM_free(b) luaM_realloc((b), 0)
#define luaM_malloc(t) luaM_realloc(NULL, (t))
#define luaM_new(t) ((t *)luaM_malloc(sizeof(t)))
#define luaM_newvector(n,t) ((t *)luaM_malloc((n)*sizeof(t)))
#define luaM_growvector(old,n,t,e,l) \
(luaM_growaux((void**)old,n,sizeof(t),e,l))
#define luaM_reallocvector(v,n,t) ((t *)luaM_realloc(v,(n)*sizeof(t)))
#ifdef DEBUG
extern unsigned long numblocks;
extern unsigned long totalmem;
#endif
#endif

94
lobject.c Normal file
View File

@@ -0,0 +1,94 @@
/*
** $Id: lobject.c,v 1.9 1997/12/26 18:38:16 roberto Exp roberto $
** Some generic functions over Lua objects
** See Copyright Notice in lua.h
*/
#include <stdlib.h>
#include <string.h>
#include "lobject.h"
#include "lua.h"
char *luaO_typenames[] = { /* ORDER LUA_T */
"userdata", "number", "string", "table", "function", "function",
"nil", "function", "mark", "mark", "mark", "line", NULL
};
TObject luaO_nilobject = {LUA_T_NIL, {NULL}};
/* hash dimensions values */
static long dimensions[] =
{5L, 11L, 23L, 47L, 97L, 197L, 397L, 797L, 1597L, 3203L, 6421L,
12853L, 25717L, 51437L, 102811L, 205619L, 411233L, 822433L,
1644817L, 3289613L, 6579211L, 13158023L, MAX_INT};
int luaO_redimension (int oldsize)
{
int i;
for (i=0; dimensions[i]<MAX_INT; i++) {
if (dimensions[i] > oldsize)
return dimensions[i];
}
lua_error("table overflow");
return 0; /* to avoid warnings */
}
int luaO_equalObj (TObject *t1, TObject *t2)
{
if (ttype(t1) != ttype(t2)) return 0;
switch (ttype(t1)) {
case LUA_T_NIL: return 1;
case LUA_T_NUMBER: return nvalue(t1) == nvalue(t2);
case LUA_T_STRING: case LUA_T_USERDATA: return svalue(t1) == svalue(t2);
case LUA_T_ARRAY: return avalue(t1) == avalue(t2);
case LUA_T_PROTO: return tfvalue(t1) == tfvalue(t2);
case LUA_T_CPROTO: return fvalue(t1) == fvalue(t2);
case LUA_T_CLOSURE: return t1->value.cl == t2->value.cl;
default:
lua_error("internal error in `lua_equalObj'");
return 0; /* UNREACHEABLE */
}
}
int luaO_findstring (char *name, char *list[])
{
int i;
for (i=0; list[i]; i++)
if (strcmp(list[i], name) == 0)
return i;
return -1; /* name not found */
}
void luaO_insertlist (GCnode *root, GCnode *node)
{
node->next = root->next;
root->next = node;
node->marked = 0;
}
#ifdef OLD_ANSI
void luaO_memup (void *dest, void *src, int size)
{
char *d = dest;
char *s = src;
while (size--) d[size]=s[size];
}
void luaO_memdown (void *dest, void *src, int size)
{
char *d = dest;
char *s = src;
int i;
for (i=0; i<size; i++) d[i]=s[i];
}
#endif

184
lobject.h Normal file
View File

@@ -0,0 +1,184 @@
/*
** $Id: lobject.h,v 1.15 1998/01/13 13:27:25 roberto Exp $
** Type definitions for Lua objects
** See Copyright Notice in lua.h
*/
#ifndef lobject_h
#define lobject_h
#include <limits.h>
#include "lua.h"
/*
** "real" is the type "number" of Lua
** GREP LUA_NUMBER to change that
*/
#ifndef real
#define real float
#endif
#define Byte lua_Byte /* some systems have Byte as a predefined type */
typedef unsigned char Byte; /* unsigned 8 bits */
#define MAX_WORD (65534U) /* maximum value of a word (-2 for safety) */
#define MAX_INT (INT_MAX-2) /* maximum value of a int (-2 for safety) */
typedef unsigned int IntPoint; /* unsigned with same size as a pointer (for hashing) */
/*
** Lua TYPES
** WARNING: if you change the order of this enumeration,
** grep "ORDER LUA_T"
*/
typedef enum {
LUA_T_USERDATA = 0, /* tag default for userdata */
LUA_T_NUMBER = -1, /* fixed tag for numbers */
LUA_T_STRING = -2, /* fixed tag for strings */
LUA_T_ARRAY = -3, /* tag default for tables (or arrays) */
LUA_T_PROTO = -4, /* fixed tag for functions */
LUA_T_CPROTO = -5, /* fixed tag for Cfunctions */
LUA_T_NIL = -6, /* last "pre-defined" tag */
LUA_T_CLOSURE = -7,
LUA_T_CLMARK = -8, /* mark for closures */
LUA_T_PMARK = -9, /* mark for Lua prototypes */
LUA_T_CMARK = -10, /* mark for C prototypes */
LUA_T_LINE = -11
} lua_Type;
#define NUM_TYPES 11
#define NUM_TAGS 7
typedef union {
lua_CFunction f; /* LUA_T_CPROTO, LUA_T_CMARK */
real n; /* LUA_T_NUMBER */
struct TaggedString *ts; /* LUA_T_STRING, LUA_T_USERDATA */
struct TProtoFunc *tf; /* LUA_T_PROTO, LUA_T_PMARK */
struct Closure *cl; /* LUA_T_CLOSURE, LUA_T_CLMARK */
struct Hash *a; /* LUA_T_ARRAY */
int i; /* LUA_T_LINE */
} Value;
typedef struct TObject {
lua_Type ttype;
Value value;
} TObject;
/*
** generic header for garbage collector lists
*/
typedef struct GCnode {
struct GCnode *next;
int marked;
} GCnode;
/*
** String headers for string table
*/
typedef struct TaggedString {
GCnode head;
int constindex; /* hint to reuse constants (= -1 if this is a userdata) */
unsigned long hash;
union {
TObject globalval;
struct {
int tag;
void *v; /* if this is a userdata, here is its value */
} d;
} u;
char str[1]; /* \0 byte already reserved */
} TaggedString;
/*
** Function Prototypes
*/
typedef struct TProtoFunc {
GCnode head;
struct TObject *consts;
int nconsts;
Byte *code; /* ends with opcode ENDCODE */
int lineDefined;
TaggedString *fileName;
struct LocVar *locvars; /* ends with line = -1 */
} TProtoFunc;
typedef struct LocVar {
TaggedString *varname; /* NULL signals end of scope */
int line;
} LocVar;
/* Macros to access structure members */
#define ttype(o) ((o)->ttype)
#define nvalue(o) ((o)->value.n)
#define svalue(o) ((o)->value.ts->str)
#define tsvalue(o) ((o)->value.ts)
#define clvalue(o) ((o)->value.cl)
#define avalue(o) ((o)->value.a)
#define fvalue(o) ((o)->value.f)
#define tfvalue(o) ((o)->value.tf)
#define protovalue(o) ((o)->value.cl->consts)
/*
** Closures
*/
typedef struct Closure {
GCnode head;
int nelems; /* not included the first one (always the prototype) */
TObject consts[1]; /* at least one for prototype */
} Closure;
typedef struct node {
TObject ref;
TObject val;
} Node;
typedef struct Hash {
GCnode head;
Node *node;
int nhash;
int nuse;
int htag;
} Hash;
extern char *luaO_typenames[];
extern TObject luaO_nilobject;
int luaO_equalObj (TObject *t1, TObject *t2);
int luaO_redimension (int oldsize);
int luaO_findstring (char *name, char *list[]);
void luaO_insertlist (GCnode *root, GCnode *node);
#ifdef OLD_ANSI
void luaO_memup (void *dest, void *src, int size);
void luaO_memdown (void *dest, void *src, int size);
#else
#include <string.h>
#define luaO_memup(d,s,n) memmove(d,s,n)
#define luaO_memdown(d,s,n) memmove(d,s,n)
#endif
#endif

182
lopcodes.h Normal file
View File

@@ -0,0 +1,182 @@
/*
** $Id: lopcodes.h,v 1.14 1997/12/30 19:08:23 roberto Exp roberto $
** Opcodes for Lua virtual machine
** See Copyright Notice in lua.h
*/
#ifndef lopcodes_h
#define lopcodes_h
/*
** NOTICE: variants of the same opcode must be consecutive: First, those
** with byte parameter, then with built-in parameters, and last with
** word parameter.
*/
typedef enum {
/* name parm before after side effect
-----------------------------------------------------------------------------*/
ENDCODE,/* - - - */
PUSHNIL,/* b - nil_0...nil_b */
PUSHNIL0,/* - - nil */
PUSHNUMBER,/* b - (float)b */
PUSHNUMBER0,/* - - 0.0 */
PUSHNUMBER1,/* - - 1.0 */
PUSHNUMBER2,/* - - 2.0 */
PUSHNUMBERW,/* w - (float)w */
PUSHCONSTANT,/* b - CNST[b] */
PUSHCONSTANT0,/*- - CNST[0] */
PUSHCONSTANT1,/*- - CNST[1] */
PUSHCONSTANT2,/*- - CNST[2] */
PUSHCONSTANT3,/*- - CNST[3] */
PUSHCONSTANT4,/*- - CNST[4] */
PUSHCONSTANT5,/*- - CNST[5] */
PUSHCONSTANT6,/*- - CNST[6] */
PUSHCONSTANT7,/*- - CNST[7] */
PUSHCONSTANTW,/*w - CNST[w] */
PUSHUPVALUE,/* b - Closure[b] */
PUSHUPVALUE0,/* - - Closure[0] */
PUSHUPVALUE1,/* - - Closure[1] */
PUSHLOCAL,/* b - LOC[b] */
PUSHLOCAL0,/* - - LOC[0] */
PUSHLOCAL1,/* - - LOC[1] */
PUSHLOCAL2,/* - - LOC[2] */
PUSHLOCAL3,/* - - LOC[3] */
PUSHLOCAL4,/* - - LOC[4] */
PUSHLOCAL5,/* - - LOC[5] */
PUSHLOCAL6,/* - - LOC[6] */
PUSHLOCAL7,/* - - LOC[7] */
GETGLOBAL,/* b - VAR[CNST[b]] */
GETGLOBAL0,/* - - VAR[CNST[0]] */
GETGLOBAL1,/* - - VAR[CNST[1]] */
GETGLOBAL2,/* - - VAR[CNST[2]] */
GETGLOBAL3,/* - - VAR[CNST[3]] */
GETGLOBAL4,/* - - VAR[CNST[4]] */
GETGLOBAL5,/* - - VAR[CNST[5]] */
GETGLOBAL6,/* - - VAR[CNST[6]] */
GETGLOBAL7,/* - - VAR[CNST[7]] */
GETGLOBALW,/* w - VAR[CNST[w]] */
GETTABLE,/* - i t t[i] */
GETDOTTED,/* b t t[CONST[b]] */
GETDOTTED0,/* - t t[CONST[0]] */
GETDOTTED1,/* - t t[CONST[1]] */
GETDOTTED2,/* - t t[CONST[2]] */
GETDOTTED3,/* - t t[CONST[3]] */
GETDOTTED4,/* - t t[CONST[4]] */
GETDOTTED5,/* - t t[CONST[5]] */
GETDOTTED6,/* - t t[CONST[6]] */
GETDOTTED7,/* - t t[CONST[7]] */
GETDOTTEDW,/* w t t[CONST[w]] */
PUSHSELF,/* b t t t[CNST[b]] */
PUSHSELF0,/* - t t t[CNST[0]] */
PUSHSELF1,/* - t t t[CNST[1]] */
PUSHSELF2,/* - t t t[CNST[2]] */
PUSHSELF3,/* - t t t[CNST[3]] */
PUSHSELF4,/* - t t t[CNST[4]] */
PUSHSELF5,/* - t t t[CNST[5]] */
PUSHSELF6,/* - t t t[CNST[6]] */
PUSHSELF7,/* - t t t[CNST[7]] */
PUSHSELFW,/* w t t t[CNST[w]] */
CREATEARRAY,/* b - newarray(size = b) */
CREATEARRAY0,/* - - newarray(size = 0) */
CREATEARRAY1,/* - - newarray(size = 1) */
CREATEARRAYW,/* w - newarray(size = w) */
SETLOCAL,/* b x - LOC[b]=x */
SETLOCAL0,/* - x - LOC[0]=x */
SETLOCAL1,/* - x - LOC[1]=x */
SETLOCAL2,/* - x - LOC[2]=x */
SETLOCAL3,/* - x - LOC[3]=x */
SETLOCAL4,/* - x - LOC[4]=x */
SETLOCAL5,/* - x - LOC[5]=x */
SETLOCAL6,/* - x - LOC[6]=x */
SETLOCAL7,/* - x - LOC[7]=x */
SETGLOBAL,/* b x - VAR[CNST[b]]=x */
SETGLOBAL0,/* - x - VAR[CNST[0]]=x */
SETGLOBAL1,/* - x - VAR[CNST[1]]=x */
SETGLOBAL2,/* - x - VAR[CNST[2]]=x */
SETGLOBAL3,/* - x - VAR[CNST[3]]=x */
SETGLOBAL4,/* - x - VAR[CNST[4]]=x */
SETGLOBAL5,/* - x - VAR[CNST[5]]=x */
SETGLOBAL6,/* - x - VAR[CNST[6]]=x */
SETGLOBAL7,/* - x - VAR[CNST[7]]=x */
SETGLOBALW,/* w x - VAR[CNST[w]]=x */
SETTABLE0,/* - v i t - t[i]=v */
SETTABLE,/* b v a_b...a_1 i t a_b...a_1 i t t[i]=v */
SETLIST,/* b c v_b...v_1 t - t[i+c*FPF]=v_i */
SETLIST0,/* b v_b...v_1 t - t[i]=v_i */
SETLISTW,/* w c v_b...v_1 t - t[i+c*FPF]=v_i */
SETMAP,/* b v_b k_b ...v_0 k_0 t t t[k_i]=v_i */
SETMAP0,/* - v_0 k_0 t t t[k_0]=v_0 */
EQOP,/* - y x (x==y)? 1 : nil */
NEQOP,/* - y x (x~=y)? 1 : nil */
LTOP,/* - y x (x<y)? 1 : nil */
LEOP,/* - y x (x<y)? 1 : nil */
GTOP,/* - y x (x>y)? 1 : nil */
GEOP,/* - y x (x>=y)? 1 : nil */
ADDOP,/* - y x x+y */
SUBOP,/* - y x x-y */
MULTOP,/* - y x x*y */
DIVOP,/* - y x x/y */
POWOP,/* - y x x^y */
CONCOP,/* - y x x..y */
MINUSOP,/* - x -x */
NOTOP,/* - x (x==nil)? 1 : nil */
ONTJMP,/* b x (x!=nil)? x : - (x!=nil)? PC+=b */
ONTJMPW,/* w x (x!=nil)? x : - (x!=nil)? PC+=w */
ONFJMP,/* b x (x==nil)? x : - (x==nil)? PC+=b */
ONFJMPW,/* w x (x==nil)? x : - (x==nil)? PC+=w */
JMP,/* b - - PC+=b */
JMPW,/* w - - PC+=w */
IFFJMP,/* b x - (x==nil)? PC+=b */
IFFJMPW,/* w x - (x==nil)? PC+=w */
IFTUPJMP,/* b x - (x!=nil)? PC-=b */
IFTUPJMPW,/* w x - (x!=nil)? PC-=w */
IFFUPJMP,/* b x - (x==nil)? PC-=b */
IFFUPJMPW,/* w x - (x==nil)? PC-=w */
CLOSURE,/* b proto v_b...v_1 c(proto) */
CLOSURE0,/* - proto c(proto) */
CLOSURE1,/* - proto v_1 c(proto) */
CALLFUNC,/* b c v_c...v_1 f r_b...r_1 f(v1,...,v_c) */
CALLFUNC0,/* b v_b...v_1 f - f(v1,...,v_b) */
CALLFUNC1,/* b v_b...v_1 f r_1 f(v1,...,v_b) */
RETCODE,/* b - - */
SETLINE,/* b - - LINE=b */
SETLINEW,/* w - - LINE=w */
POP,/* b - - TOP-=(b+1) */
POP0,/* - - - TOP-=1 */
POP1/* - - - TOP-=2 */
} OpCode;
#define RFIELDS_PER_FLUSH 32 /* records (SETMAP) */
#define LFIELDS_PER_FLUSH 64 /* lists (SETLIST) */
#define ZEROVARARG 64
#endif

20
lparser.h Normal file
View File

@@ -0,0 +1,20 @@
/*
** $Id: lparser.h,v 1.1 1997/09/16 19:25:59 roberto Exp roberto $
** Syntax analizer and code generator
** See Copyright Notice in lua.h
*/
#ifndef lparser_h
#define lparser_h
#include "lobject.h"
#include "lzio.h"
void luaY_codedebugline (int line);
TProtoFunc *luaY_parser (ZIO *z);
void luaY_error (char *s);
void luaY_syntaxerror (char *s, char *token);
#endif

78
lstate.c Normal file
View File

@@ -0,0 +1,78 @@
/*
** $Id: lstate.c,v 1.4 1997/12/11 14:48:46 roberto Exp roberto $
** Global State
** See Copyright Notice in lua.h
*/
#include "lbuiltin.h"
#include "ldo.h"
#include "lfunc.h"
#include "lgc.h"
#include "llex.h"
#include "lmem.h"
#include "lstate.h"
#include "lstring.h"
#include "ltable.h"
#include "ltm.h"
LState *lua_state = NULL;
void lua_open (void)
{
if (lua_state) return;
lua_state = luaM_new(LState);
L->numCblocks = 0;
L->Cstack.base = 0;
L->Cstack.lua2C = 0;
L->Cstack.num = 0;
L->errorJmp = NULL;
L->rootproto.next = NULL;
L->rootproto.marked = 0;
L->rootcl.next = NULL;
L->rootcl.marked = 0;
L->rootglobal.next = NULL;
L->rootglobal.marked = 0;
L->roottable.next = NULL;
L->roottable.marked = 0;
L->refArray = NULL;
L->refSize = 0;
L->Mbuffsize = 0;
L->Mbuffnext = 0;
L->Mbuffbase = NULL;
L->Mbuffer = NULL;
L->GCthreshold = GARBAGE_BLOCK;
L->nblocks = 0;
luaD_init();
luaS_init();
luaX_init();
luaT_init();
luaB_predefine();
}
void lua_close (void)
{
TaggedString *alludata = luaS_collectudata();
L->GCthreshold = MAX_INT; /* to avoid GC during GC */
luaC_hashcallIM((Hash *)L->roottable.next); /* GC t.methods for tables */
luaC_strcallIM(alludata); /* GC tag methods for userdata */
luaD_gcIM(&luaO_nilobject); /* GC tag method for nil (signal end of GC) */
luaH_free((Hash *)L->roottable.next);
luaF_freeproto((TProtoFunc *)L->rootproto.next);
luaF_freeclosure((Closure *)L->rootcl.next);
luaS_free(alludata);
luaS_freeall();
luaM_free(L->stack.stack);
luaM_free(L->IMtable);
luaM_free(L->refArray);
luaM_free(L->Mbuffer);
luaM_free(L);
L = NULL;
#ifdef DEBUG
printf("total de blocos: %ld\n", numblocks);
printf("total de memoria: %ld\n", totalmem);
#endif
}

81
lstate.h Normal file
View File

@@ -0,0 +1,81 @@
/*
** $Id: lstate.h,v 1.6 1997/12/17 20:48:58 roberto Exp roberto $
** Global State
** See Copyright Notice in lua.h
*/
#ifndef lstate_h
#define lstate_h
#include "lobject.h"
#define MAX_C_BLOCKS 10
#define GARBAGE_BLOCK 150
typedef int StkId; /* index to stack elements */
struct Stack {
TObject *top;
TObject *stack;
TObject *last;
};
struct C_Lua_Stack {
StkId base; /* when Lua calls C or C calls Lua, points to */
/* the first slot after the last parameter. */
StkId lua2C; /* points to first element of "array" lua2C */
int num; /* size of "array" lua2C */
};
typedef struct {
int size;
int nuse; /* number of elements (including EMPTYs) */
TaggedString **hash;
} stringtable;
struct ref {
TObject o;
enum {LOCK, HOLD, FREE, COLLECTED} status;
};
typedef struct LState {
struct Stack stack; /* Lua stack */
struct C_Lua_Stack Cstack; /* C2lua struct */
void *errorJmp; /* current error recover point */
TObject errorim; /* error tag method */
GCnode rootproto; /* list of all prototypes */
GCnode rootcl; /* list of all closures */
GCnode roottable; /* list of all tables */
GCnode rootglobal; /* list of strings with global values */
stringtable *string_root; /* array of hash tables for strings and udata */
struct IM *IMtable; /* table for tag methods */
int IMtable_size; /* size of IMtable */
int last_tag; /* last used tag in IMtable */
struct FuncState *mainState, *currState; /* point to local structs in yacc */
struct LexState *lexstate; /* point to local struct in yacc */
struct ref *refArray; /* locked objects */
int refSize; /* size of refArray */
unsigned long GCthreshold;
unsigned long nblocks; /* number of 'blocks' currently allocated */
char *Mbuffer; /* global buffer */
char *Mbuffbase; /* current first position of Mbuffer */
int Mbuffsize; /* size of Mbuffer */
int Mbuffnext; /* next position to fill in Mbuffer */
struct C_Lua_Stack Cblocks[MAX_C_BLOCKS];
int numCblocks; /* number of nested Cblocks */
} LState;
extern LState *lua_state;
#define L lua_state
#endif

262
lstring.c Normal file
View File

@@ -0,0 +1,262 @@
/*
** $Id: lstring.c,v 1.9 1997/12/30 19:15:52 roberto Exp roberto $
** String table (keeps all strings handled by Lua)
** See Copyright Notice in lua.h
*/
#include <string.h>
#include "lmem.h"
#include "lobject.h"
#include "lstate.h"
#include "lstring.h"
#include "lua.h"
#define NUM_HASHS 61
#define gcsizestring(l) (1+(l/64)) /* "weight" for a string with length 'l' */
static TaggedString EMPTY = {{NULL, 2}, 0, 0L, {{LUA_T_NIL, {NULL}}}, {0}};
void luaS_init (void)
{
int i;
L->string_root = luaM_newvector(NUM_HASHS, stringtable);
for (i=0; i<NUM_HASHS; i++) {
L->string_root[i].size = 0;
L->string_root[i].nuse = 0;
L->string_root[i].hash = NULL;
}
}
static unsigned long hash (char *s, int tag)
{
unsigned long h;
if (tag != LUA_T_STRING)
h = (unsigned long)s;
else {
h = 0;
while (*s)
h = ((h<<5)-h)^(unsigned char)*(s++);
}
return h;
}
static void grow (stringtable *tb)
{
int newsize = luaO_redimension(tb->size);
TaggedString **newhash = luaM_newvector(newsize, TaggedString *);
int i;
for (i=0; i<newsize; i++)
newhash[i] = NULL;
/* rehash */
tb->nuse = 0;
for (i=0; i<tb->size; i++) {
if (tb->hash[i] != NULL && tb->hash[i] != &EMPTY) {
int h = tb->hash[i]->hash%newsize;
while (newhash[h])
h = (h+1)%newsize;
newhash[h] = tb->hash[i];
tb->nuse++;
}
}
luaM_free(tb->hash);
tb->size = newsize;
tb->hash = newhash;
}
static TaggedString *newone (char *buff, int tag, unsigned long h)
{
TaggedString *ts;
if (tag == LUA_T_STRING) {
long l = strlen(buff);
ts = (TaggedString *)luaM_malloc(sizeof(TaggedString)+l);
strcpy(ts->str, buff);
ts->u.globalval.ttype = LUA_T_NIL; /* initialize global value */
ts->constindex = 0;
L->nblocks += gcsizestring(l);
}
else {
ts = (TaggedString *)luaM_malloc(sizeof(TaggedString));
ts->u.d.v = buff;
ts->u.d.tag = tag == LUA_ANYTAG ? 0 : tag;
ts->constindex = -1; /* tag -> this is a userdata */
L->nblocks++;
}
ts->head.marked = 0;
ts->head.next = (GCnode *)ts; /* signal it is in no list */
ts->hash = h;
return ts;
}
static TaggedString *insert (char *buff, int tag, stringtable *tb)
{
TaggedString *ts;
unsigned long h = hash(buff, tag);
int size = tb->size;
int i;
int j = -1;
if ((long)tb->nuse*3 >= (long)size*2) {
grow(tb);
size = tb->size;
}
for (i = h%size; (ts = tb->hash[i]) != NULL; ) {
if (ts == &EMPTY)
j = i;
else if ((ts->constindex >= 0) ? /* is a string? */
(tag == LUA_T_STRING && (strcmp(buff, ts->str) == 0)) :
((tag == ts->u.d.tag || tag == LUA_ANYTAG) && buff == ts->u.d.v))
return ts;
if (++i == size) i=0;
}
/* not found */
if (j != -1) /* is there an EMPTY space? */
i = j;
else
tb->nuse++;
ts = tb->hash[i] = newone(buff, tag, h);
return ts;
}
TaggedString *luaS_createudata (void *udata, int tag)
{
return insert(udata, tag, &L->string_root[(unsigned)udata%NUM_HASHS]);
}
TaggedString *luaS_new (char *str)
{
return insert(str, LUA_T_STRING, &L->string_root[(unsigned)str[0]%NUM_HASHS]);
}
TaggedString *luaS_newfixedstring (char *str)
{
TaggedString *ts = luaS_new(str);
if (ts->head.marked == 0)
ts->head.marked = 2; /* avoid GC */
return ts;
}
void luaS_free (TaggedString *l)
{
while (l) {
TaggedString *next = (TaggedString *)l->head.next;
L->nblocks -= (l->constindex == -1) ? 1 : gcsizestring(strlen(l->str));
luaM_free(l);
l = next;
}
}
/*
** Garbage collection functions.
*/
static void remove_from_list (GCnode *l)
{
while (l) {
GCnode *next = l->next;
while (next && !next->marked)
next = l->next = next->next;
l = next;
}
}
TaggedString *luaS_collector (void)
{
TaggedString *frees = NULL;
int i;
remove_from_list(&(L->rootglobal));
for (i=0; i<NUM_HASHS; i++) {
stringtable *tb = &L->string_root[i];
int j;
for (j=0; j<tb->size; j++) {
TaggedString *t = tb->hash[j];
if (t == NULL) continue;
if (t->head.marked == 1)
t->head.marked = 0;
else if (!t->head.marked) {
t->head.next = (GCnode *)frees;
frees = t;
tb->hash[j] = &EMPTY;
}
}
}
return frees;
}
TaggedString *luaS_collectudata (void)
{
TaggedString *frees = NULL;
int i;
L->rootglobal.next = NULL; /* empty list of globals */
for (i=0; i<NUM_HASHS; i++) {
stringtable *tb = &L->string_root[i];
int j;
for (j=0; j<tb->size; j++) {
TaggedString *t = tb->hash[j];
if (t == NULL || t == &EMPTY || t->constindex != -1)
continue; /* get only user datas */
t->head.next = (GCnode *)frees;
frees = t;
tb->hash[j] = &EMPTY;
}
}
return frees;
}
void luaS_freeall (void)
{
int i;
for (i=0; i<NUM_HASHS; i++) {
stringtable *tb = &L->string_root[i];
int j;
for (j=0; j<tb->size; j++) {
TaggedString *t = tb->hash[j];
if (t == &EMPTY) continue;
luaM_free(t);
}
luaM_free(tb->hash);
}
luaM_free(L->string_root);
}
void luaS_rawsetglobal (TaggedString *ts, TObject *newval)
{
ts->u.globalval = *newval;
if (ts->head.next == (GCnode *)ts) { /* is not in list? */
ts->head.next = L->rootglobal.next;
L->rootglobal.next = (GCnode *)ts;
}
}
char *luaS_travsymbol (int (*fn)(TObject *))
{
TaggedString *g;
for (g=(TaggedString *)L->rootglobal.next; g; g=(TaggedString *)g->head.next)
if (fn(&g->u.globalval))
return g->str;
return NULL;
}
int luaS_globaldefined (char *name)
{
TaggedString *ts = luaS_new(name);
return ts->u.globalval.ttype != LUA_T_NIL;
}

27
lstring.h Normal file
View File

@@ -0,0 +1,27 @@
/*
** $Id: lstring.h,v 1.5 1997/11/26 18:53:45 roberto Exp roberto $
** String table (keep all strings handled by Lua)
** See Copyright Notice in lua.h
*/
#ifndef lstring_h
#define lstring_h
#include "lobject.h"
void luaS_init (void);
TaggedString *luaS_createudata (void *udata, int tag);
TaggedString *luaS_collector (void);
void luaS_free (TaggedString *l);
TaggedString *luaS_new (char *str);
TaggedString *luaS_newfixedstring (char *str);
void luaS_rawsetglobal (TaggedString *ts, TObject *newval);
char *luaS_travsymbol (int (*fn)(TObject *));
int luaS_globaldefined (char *name);
TaggedString *luaS_collectudata (void);
void luaS_freeall (void);
#endif

509
lstrlib.c Normal file
View File

@@ -0,0 +1,509 @@
/*
** $Id: lstrlib.c,v 1.6 1998/01/09 14:44:55 roberto Exp $
** Standard library for strings and pattern-matching
** See Copyright Notice in lua.h
*/
#include <ctype.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "lauxlib.h"
#include "lua.h"
#include "lualib.h"
static void addnchar (char *s, int n)
{
char *b = luaL_openspace(n);
strncpy(b, s, n);
luaL_addsize(n);
}
static void addstr (char *s)
{
addnchar(s, strlen(s));
}
static void str_len (void)
{
lua_pushnumber(strlen(luaL_check_string(1)));
}
static void closeandpush (void)
{
luaL_addchar(0);
lua_pushstring(luaL_buffer());
}
static void str_sub (void)
{
char *s = luaL_check_string(1);
long l = strlen(s);
long start = (long)luaL_check_number(2);
long end = (long)luaL_opt_number(3, -1);
if (start < 0) start = l+start+1;
if (end < 0) end = l+end+1;
if (1 <= start && start <= end && end <= l) {
luaL_resetbuffer();
addnchar(s+start-1, end-start+1);
closeandpush();
}
else lua_pushstring("");
}
static void str_lower (void)
{
char *s;
luaL_resetbuffer();
for (s = luaL_check_string(1); *s; s++)
luaL_addchar(tolower((unsigned char)*s));
closeandpush();
}
static void str_upper (void)
{
char *s;
luaL_resetbuffer();
for (s = luaL_check_string(1); *s; s++)
luaL_addchar(toupper((unsigned char)*s));
closeandpush();
}
static void str_rep (void)
{
char *s = luaL_check_string(1);
int n = (int)luaL_check_number(2);
luaL_resetbuffer();
while (n-- > 0)
addstr(s);
closeandpush();
}
static void str_ascii (void)
{
char *s = luaL_check_string(1);
long pos = (long)luaL_opt_number(2, 1) - 1;
luaL_arg_check(0<=pos && pos<strlen(s), 2, "out of range");
lua_pushnumber((unsigned char)s[pos]);
}
/*
** =======================================================
** PATTERN MATCHING
** =======================================================
*/
#define MAX_CAPT 9
struct Capture {
int level; /* total number of captures (finished or unfinished) */
struct {
char *init;
int len; /* -1 signals unfinished capture */
} capture[MAX_CAPT];
};
#define ESC '%'
#define SPECIALS "^$*?.([%-"
static void push_captures (struct Capture *cap)
{
int i;
for (i=0; i<cap->level; i++) {
int l = cap->capture[i].len;
char *buff = luaL_openspace(l+1);
if (l == -1) lua_error("unfinished capture");
strncpy(buff, cap->capture[i].init, l);
buff[l] = 0;
lua_pushstring(buff);
}
}
static int check_cap (int l, struct Capture *cap)
{
l -= '1';
if (!(0 <= l && l < cap->level && cap->capture[l].len != -1))
lua_error("invalid capture index");
return l;
}
static int capture_to_close (struct Capture *cap)
{
int level = cap->level;
for (level--; level>=0; level--)
if (cap->capture[level].len == -1) return level;
lua_error("invalid pattern capture");
return 0; /* to avoid warnings */
}
static char *bracket_end (char *p)
{
return (*p == 0) ? NULL : strchr((*p=='^') ? p+2 : p+1, ']');
}
static int matchclass (int c, int cl)
{
int res;
if (c == 0) return 0;
switch (tolower((unsigned char)cl)) {
case 'w' : res = isalnum((unsigned char)c); break;
case 'd' : res = isdigit((unsigned char)c); break;
case 's' : res = isspace((unsigned char)c); break;
case 'a' : res = isalpha((unsigned char)c); break;
case 'p' : res = ispunct((unsigned char)c); break;
case 'l' : res = islower((unsigned char)c); break;
case 'u' : res = isupper((unsigned char)c); break;
case 'c' : res = iscntrl((unsigned char)c); break;
default: return (cl == c);
}
return (islower((unsigned char)cl) ? res : !res);
}
int luaI_singlematch (int c, char *p, char **ep)
{
switch (*p) {
case '.':
*ep = p+1;
return (c != 0);
case '\0':
*ep = p;
return 0;
case ESC:
if (*(++p) == '\0')
luaL_verror("incorrect pattern (ends with `%c')", ESC);
*ep = p+1;
return matchclass(c, *p);
case '[': {
char *end = bracket_end(p+1);
int sig = *(p+1) == '^' ? (p++, 0) : 1;
if (end == NULL) lua_error("incorrect pattern (missing `]')");
*ep = end+1;
if (c == 0) return 0;
while (++p < end) {
if (*p == ESC) {
if (((p+1) < end) && matchclass(c, *++p)) return sig;
}
else if ((*(p+1) == '-') && (p+2 < end)) {
p+=2;
if (*(p-2) <= c && c <= *p) return sig;
}
else if (*p == c) return sig;
}
return !sig;
}
default:
*ep = p+1;
return (*p == c);
}
}
static char *matchbalance (char *s, int b, int e)
{
if (*s != b) return NULL;
else {
int cont = 1;
while (*(++s)) {
if (*s == e) {
if (--cont == 0) return s+1;
}
else if (*s == b) cont++;
}
}
return NULL; /* string ends out of balance */
}
static char *matchitem (char *s, char *p, struct Capture *cap, char **ep)
{
if (*p == ESC) {
p++;
if (isdigit((unsigned char)*p)) { /* capture */
int l = check_cap(*p, cap);
*ep = p+1;
if (strncmp(cap->capture[l].init, s, cap->capture[l].len) == 0)
return s+cap->capture[l].len;
else return NULL;
}
else if (*p == 'b') { /* balanced string */
p++;
if (*p == 0 || *(p+1) == 0)
lua_error("unbalanced pattern");
*ep = p+2;
return matchbalance(s, *p, *(p+1));
}
else p--; /* and go through */
}
return (luaI_singlematch(*s, p, ep) ? s+1 : NULL);
}
static char *match (char *s, char *p, struct Capture *cap)
{
init: /* using goto's to optimize tail recursion */
switch (*p) {
case '(': { /* start capture */
char *res;
if (cap->level >= MAX_CAPT) lua_error("too many captures");
cap->capture[cap->level].init = s;
cap->capture[cap->level].len = -1;
cap->level++;
if ((res=match(s, p+1, cap)) == NULL) /* match failed? */
cap->level--; /* undo capture */
return res;
}
case ')': { /* end capture */
int l = capture_to_close(cap);
char *res;
cap->capture[l].len = s - cap->capture[l].init; /* close capture */
if ((res = match(s, p+1, cap)) == NULL) /* match failed? */
cap->capture[l].len = -1; /* undo capture */
return res;
}
case '\0': case '$': /* (possibly) end of pattern */
if (*p == 0 || (*(p+1) == 0 && *s == 0))
return s;
/* else go through */
default: { /* it is a pattern item */
char *ep; /* get what is next */
char *s1 = matchitem(s, p, cap, &ep);
switch (*ep) {
case '*': { /* repetition */
char *res;
if (s1 && (res = match(s1, p, cap)))
return res;
p=ep+1; goto init; /* else return match(s, ep+1, cap); */
}
case '?': { /* optional */
char *res;
if (s1 && (res = match(s1, ep+1, cap)))
return res;
p=ep+1; goto init; /* else return match(s, ep+1, cap); */
}
case '-': { /* repetition */
char *res;
if ((res = match(s, ep+1, cap)) != 0)
return res;
else if (s1) {
s = s1;
goto init; /* return match(s1, p, cap); */
}
else
return NULL;
}
default:
if (s1) { s=s1; p=ep; goto init; } /* return match(s1, ep, cap); */
else return NULL;
}
}
}
}
static void str_find (void)
{
char *s = luaL_check_string(1);
char *p = luaL_check_string(2);
long init = (long)luaL_opt_number(3, 1) - 1;
luaL_arg_check(0 <= init && init <= strlen(s), 3, "out of range");
if (lua_getparam(4) != LUA_NOOBJECT ||
strpbrk(p, SPECIALS) == NULL) { /* no special caracters? */
char *s2 = strstr(s+init, p);
if (s2) {
lua_pushnumber(s2-s+1);
lua_pushnumber(s2-s+strlen(p));
}
}
else {
int anchor = (*p == '^') ? (p++, 1) : 0;
char *s1=s+init;
do {
struct Capture cap;
char *res;
cap.level = 0;
if ((res=match(s1, p, &cap)) != NULL) {
lua_pushnumber(s1-s+1); /* start */
lua_pushnumber(res-s); /* end */
push_captures(&cap);
return;
}
} while (*s1++ && !anchor);
}
}
static void add_s (lua_Object newp, struct Capture *cap)
{
if (lua_isstring(newp)) {
char *news = lua_getstring(newp);
while (*news) {
if (*news != ESC || !isdigit((unsigned char)*++news))
luaL_addchar(*news++);
else {
int l = check_cap(*news++, cap);
addnchar(cap->capture[l].init, cap->capture[l].len);
}
}
}
else if (lua_isfunction(newp)) {
lua_Object res;
int status;
int oldbuff;
lua_beginblock();
push_captures(cap);
/* function may use buffer, so save it and create a new one */
oldbuff = luaL_newbuffer(0);
status = lua_callfunction(newp);
/* restore old buffer */
luaL_oldbuffer(oldbuff);
if (status != 0) {
lua_endblock();
lua_error(NULL);
}
res = lua_getresult(1);
addstr(lua_isstring(res) ? lua_getstring(res) : "");
lua_endblock();
}
else luaL_arg_check(0, 3, "string or function expected");
}
static void str_gsub (void)
{
char *src = luaL_check_string(1);
char *p = luaL_check_string(2);
lua_Object newp = lua_getparam(3);
int max_s = (int)luaL_opt_number(4, strlen(src)+1);
int anchor = (*p == '^') ? (p++, 1) : 0;
int n = 0;
luaL_resetbuffer();
while (n < max_s) {
struct Capture cap;
char *e;
cap.level = 0;
e = match(src, p, &cap);
if (e) {
n++;
add_s(newp, &cap);
}
if (e && e>src) /* non empty match? */
src = e; /* skip it */
else if (*src)
luaL_addchar(*src++);
else break;
if (anchor) break;
}
addstr(src);
closeandpush();
lua_pushnumber(n); /* number of substitutions */
}
static void luaI_addquoted (char *s)
{
luaL_addchar('"');
for (; *s; s++) {
if (strchr("\"\\\n", *s))
luaL_addchar('\\');
luaL_addchar(*s);
}
luaL_addchar('"');
}
#define MAX_FORMAT 200
static void str_format (void)
{
int arg = 1;
char *strfrmt = luaL_check_string(arg);
luaL_resetbuffer();
while (*strfrmt) {
if (*strfrmt != '%')
luaL_addchar(*strfrmt++);
else if (*++strfrmt == '%')
luaL_addchar(*strfrmt++); /* %% */
else { /* format item */
char form[MAX_FORMAT]; /* store the format ('%...') */
struct Capture cap;
char *buff;
char *initf = strfrmt;
form[0] = '%';
cap.level = 0;
strfrmt = match(strfrmt, "%d?%$?[-+ #]*(%d*)%.?(%d*)", &cap);
if (cap.capture[0].len > 3 || cap.capture[1].len > 3) /* < 1000? */
lua_error("invalid format (width or precision too long)");
if (isdigit((unsigned char)initf[0]) && initf[1] == '$') {
arg = initf[0] - '0';
initf += 2; /* skip the 'n$' */
}
arg++;
strncpy(form+1, initf, strfrmt-initf+1); /* +1 to include convertion */
form[strfrmt-initf+2] = 0;
buff = luaL_openspace(1000); /* to store the formatted value */
switch (*strfrmt++) {
case 'q':
luaI_addquoted(luaL_check_string(arg));
continue;
case 's': {
char *s = luaL_check_string(arg);
buff = luaL_openspace(strlen(s));
sprintf(buff, form, s);
break;
}
case 'c': case 'd': case 'i': case 'o':
case 'u': case 'x': case 'X':
sprintf(buff, form, (int)luaL_check_number(arg));
break;
case 'e': case 'E': case 'f': case 'g': case 'G':
sprintf(buff, form, luaL_check_number(arg));
break;
default: /* also treat cases 'pnLlh' */
lua_error("invalid option in `format'");
}
luaL_addsize(strlen(buff));
}
}
closeandpush(); /* push the result */
}
static struct luaL_reg strlib[] = {
{"strlen", str_len},
{"strsub", str_sub},
{"strlower", str_lower},
{"strupper", str_upper},
{"strrep", str_rep},
{"ascii", str_ascii},
{"format", str_format},
{"strfind", str_find},
{"gsub", str_gsub}
};
/*
** Open string library
*/
void strlib_open (void)
{
luaL_openlib(strlib, (sizeof(strlib)/sizeof(strlib[0])));
}

216
ltable.c Normal file
View File

@@ -0,0 +1,216 @@
/*
** $Id: ltable.c,v 1.10 1998/01/09 14:44:55 roberto Exp roberto $
** Lua tables (hash)
** See Copyright Notice in lua.h
*/
#include <stdlib.h>
#include "lauxlib.h"
#include "lmem.h"
#include "lobject.h"
#include "lstate.h"
#include "ltable.h"
#include "lua.h"
#define gcsize(n) (1+(n/16))
#define nuse(t) ((t)->nuse)
#define nodevector(t) ((t)->node)
#define REHASH_LIMIT 0.70 /* avoid more than this % full */
#define TagDefault LUA_T_ARRAY;
static long int hashindex (TObject *ref)
{
long int h;
switch (ttype(ref)) {
case LUA_T_NUMBER:
h = (long int)nvalue(ref);
break;
case LUA_T_STRING: case LUA_T_USERDATA:
h = (IntPoint)tsvalue(ref);
break;
case LUA_T_ARRAY:
h = (IntPoint)avalue(ref);
break;
case LUA_T_PROTO:
h = (IntPoint)tfvalue(ref);
break;
case LUA_T_CPROTO:
h = (IntPoint)fvalue(ref);
break;
case LUA_T_CLOSURE:
h = (IntPoint)clvalue(ref);
break;
default:
lua_error("unexpected type to index table");
h = 0; /* to avoid warnings */
}
return (h >= 0 ? h : -(h+1));
}
static int present (Hash *t, TObject *key)
{
int tsize = nhash(t);
long int h = hashindex(key);
int h1 = h%tsize;
TObject *rf = ref(node(t, h1));
if (ttype(rf) != LUA_T_NIL && !luaO_equalObj(key, rf)) {
int h2 = h%(tsize-2) + 1;
do {
h1 += h2;
if (h1 >= tsize) h1 -= tsize;
rf = ref(node(t, h1));
} while (ttype(rf) != LUA_T_NIL && !luaO_equalObj(key, rf));
}
return h1;
}
/*
** Alloc a vector node
*/
static Node *hashnodecreate (int nhash)
{
Node *v = luaM_newvector(nhash, Node);
int i;
for (i=0; i<nhash; i++)
ttype(ref(&v[i])) = LUA_T_NIL;
return v;
}
/*
** Delete a hash
*/
static void hashdelete (Hash *t)
{
luaM_free(nodevector(t));
luaM_free(t);
}
void luaH_free (Hash *frees)
{
while (frees) {
Hash *next = (Hash *)frees->head.next;
L->nblocks -= gcsize(frees->nhash);
hashdelete(frees);
frees = next;
}
}
Hash *luaH_new (int nhash)
{
Hash *t = luaM_new(Hash);
nhash = luaO_redimension((int)((float)nhash/REHASH_LIMIT));
nodevector(t) = hashnodecreate(nhash);
nhash(t) = nhash;
nuse(t) = 0;
t->htag = TagDefault;
luaO_insertlist(&(L->roottable), (GCnode *)t);
L->nblocks += gcsize(nhash);
return t;
}
/*
** Rehash:
** Check if table has deleted slots. It it has, it does not need to
** grow, since rehash will reuse them.
*/
static int emptyslots (Hash *t)
{
int i;
for (i=nhash(t)-1; i>=0; i--) {
Node *n = node(t, i);
if (ttype(ref(n)) != LUA_T_NIL && ttype(val(n)) == LUA_T_NIL)
return 1;
}
return 0;
}
static void rehash (Hash *t)
{
int nold = nhash(t);
Node *vold = nodevector(t);
int i;
if (!emptyslots(t))
nhash(t) = luaO_redimension(nhash(t));
nodevector(t) = hashnodecreate(nhash(t));
for (i=0; i<nold; i++) {
Node *n = vold+i;
if (ttype(ref(n)) != LUA_T_NIL && ttype(val(n)) != LUA_T_NIL)
*node(t, present(t, ref(n))) = *n; /* copy old node to luaM_new hash */
}
L->nblocks += gcsize(t->nhash)-gcsize(nold);
luaM_free(vold);
}
/*
** If the hash node is present, return its pointer, otherwise return
** null.
*/
TObject *luaH_get (Hash *t, TObject *ref)
{
int h = present(t, ref);
if (ttype(ref(node(t, h))) != LUA_T_NIL) return val(node(t, h));
else return NULL;
}
/*
** If the hash node is present, return its pointer, otherwise create a luaM_new
** node for the given reference and also return its pointer.
*/
TObject *luaH_set (Hash *t, TObject *ref)
{
Node *n = node(t, present(t, ref));
if (ttype(ref(n)) == LUA_T_NIL) {
nuse(t)++;
if ((float)nuse(t) > (float)nhash(t)*REHASH_LIMIT) {
rehash(t);
n = node(t, present(t, ref));
}
*ref(n) = *ref;
ttype(val(n)) = LUA_T_NIL;
}
return (val(n));
}
static Node *hashnext (Hash *t, int i)
{
Node *n;
int tsize = nhash(t);
if (i >= tsize)
return NULL;
n = node(t, i);
while (ttype(ref(n)) == LUA_T_NIL || ttype(val(n)) == LUA_T_NIL) {
if (++i >= tsize)
return NULL;
n = node(t, i);
}
return node(t, i);
}
Node *luaH_next (TObject *o, TObject *r)
{
Hash *t = avalue(o);
if (ttype(r) == LUA_T_NIL)
return hashnext(t, 0);
else {
int i = present(t, r);
Node *n = node(t, i);
luaL_arg_check(ttype(ref(n))!=LUA_T_NIL && ttype(val(n))!=LUA_T_NIL,
2, "key not found");
return hashnext(t, i+1);
}
}

24
ltable.h Normal file
View File

@@ -0,0 +1,24 @@
/*
** $Id: ltable.h,v 1.4 1997/11/19 17:29:23 roberto Exp roberto $
** Lua tables (hash)
** See Copyright Notice in lua.h
*/
#ifndef ltable_h
#define ltable_h
#include "lobject.h"
#define node(t,i) (&(t)->node[i])
#define ref(n) (&(n)->ref)
#define val(n) (&(n)->val)
#define nhash(t) ((t)->nhash)
Hash *luaH_new (int nhash);
void luaH_free (Hash *frees);
TObject *luaH_get (Hash *t, TObject *ref);
TObject *luaH_set (Hash *t, TObject *ref);
Node *luaH_next (TObject *o, TObject *r);
#endif

263
ltm.c Normal file
View File

@@ -0,0 +1,263 @@
/*
** $Id: ltm.c,v 1.12 1997/12/15 16:17:20 roberto Exp roberto $
** Tag methods
** See Copyright Notice in lua.h
*/
#include <stdio.h>
#include <string.h>
#include "lauxlib.h"
#include "lmem.h"
#include "lobject.h"
#include "lstate.h"
#include "ltm.h"
char *luaT_eventname[] = { /* ORDER IM */
"gettable", "settable", "index", "getglobal", "setglobal", "add",
"sub", "mul", "div", "pow", "unm", "lt", "le", "gt", "ge",
"concat", "gc", "function", NULL
};
static int luaI_checkevent (char *name, char *list[])
{
int e = luaO_findstring(name, list);
if (e < 0)
luaL_verror("`%.50s' is not a valid event name", name);
return e;
}
/* events in LUA_T_NIL are all allowed, since this is used as a
* 'placeholder' for "default" fallbacks
*/
static char validevents[NUM_TAGS][IM_N] = { /* ORDER LUA_T, ORDER IM */
{1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1}, /* LUA_T_USERDATA */
{1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1}, /* LUA_T_NUMBER */
{1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, /* LUA_T_STRING */
{0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}, /* LUA_T_ARRAY */
{1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0}, /* LUA_T_PROTO */
{1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0}, /* LUA_T_CPROTO */
{1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1} /* LUA_T_NIL */
};
static int validevent (int t, int e)
{ /* ORDER LUA_T */
return (t < LUA_T_NIL) ? 1 : validevents[-t][e];
}
static void init_entry (int tag)
{
int i;
for (i=0; i<IM_N; i++)
ttype(luaT_getim(tag, i)) = LUA_T_NIL;
}
void luaT_init (void)
{
int t;
L->IMtable_size = NUM_TAGS*2;
L->last_tag = -(NUM_TAGS-1);
L->IMtable = luaM_newvector(L->IMtable_size, struct IM);
for (t=L->last_tag; t<=0; t++)
init_entry(t);
}
int lua_newtag (void)
{
--L->last_tag;
if ((-L->last_tag) >= L->IMtable_size)
L->IMtable_size = luaM_growvector(&L->IMtable, L->IMtable_size,
struct IM, memEM, MAX_INT);
init_entry(L->last_tag);
return L->last_tag;
}
static void checktag (int tag)
{
if (!(L->last_tag <= tag && tag <= 0))
luaL_verror("%d is not a valid tag", tag);
}
void luaT_realtag (int tag)
{
if (!(L->last_tag <= tag && tag < LUA_T_NIL))
luaL_verror("tag %d is not result of `newtag'", tag);
}
int lua_copytagmethods (int tagto, int tagfrom)
{
int e;
checktag(tagto);
checktag(tagfrom);
for (e=0; e<IM_N; e++) {
if (validevent(tagto, e))
*luaT_getim(tagto, e) = *luaT_getim(tagfrom, e);
}
return tagto;
}
int luaT_efectivetag (TObject *o)
{
int t;
switch (t = ttype(o)) {
case LUA_T_ARRAY:
return o->value.a->htag;
case LUA_T_USERDATA: {
int tag = o->value.ts->u.d.tag;
return (tag >= 0) ? LUA_T_USERDATA : tag;
}
case LUA_T_CLOSURE:
return o->value.cl->consts[0].ttype;
#ifdef DEBUG
case LUA_T_PMARK: case LUA_T_CMARK:
case LUA_T_CLMARK: case LUA_T_LINE:
lua_error("internal error");
#endif
default:
return t;
}
}
TObject *luaT_gettagmethod (int t, char *event)
{
int e = luaI_checkevent(event, luaT_eventname);
checktag(t);
if (validevent(t, e))
return luaT_getim(t,e);
else
return &luaO_nilobject;
}
void luaT_settagmethod (int t, char *event, TObject *func)
{
TObject temp = *func;
int e = luaI_checkevent(event, luaT_eventname);
checktag(t);
if (!validevent(t, e))
luaL_verror("settagmethod: cannot change internal method `%.20s' for tag %d",
luaT_eventname[e], t);
*func = *luaT_getim(t,e);
*luaT_getim(t, e) = temp;
}
char *luaT_travtagmethods (int (*fn)(TObject *))
{
int e;
if (fn(&L->errorim))
return "error";
for (e=IM_GETTABLE; e<=IM_FUNCTION; e++) { /* ORDER IM */
int t;
for (t=0; t>=L->last_tag; t--)
if (fn(luaT_getim(t,e)))
return luaT_eventname[e];
}
return NULL;
}
/*
* ===================================================================
* compatibility with old fallback system
*/
#ifdef LUA_COMPAT2_5
#include "lapi.h"
static void errorFB (void)
{
lua_Object o = lua_getparam(1);
if (lua_isstring(o))
fprintf(stderr, "lua: %s\n", lua_getstring(o));
else
fprintf(stderr, "lua: unknown error\n");
}
static void nilFB (void) { }
static void typeFB (void)
{
lua_error("unexpected type");
}
static void fillvalids (IMS e, TObject *func)
{
int t;
for (t=LUA_T_NIL; t<=LUA_T_USERDATA; t++)
if (validevent(t, e))
*luaT_getim(t, e) = *func;
}
void luaT_setfallback (void)
{
static char *oldnames [] = {"error", "getglobal", "arith", "order", NULL};
TObject oldfunc;
lua_CFunction replace;
char *name = luaL_check_string(1);
lua_Object func = lua_getparam(2);
luaL_arg_check(lua_isfunction(func), 2, "function expected");
switch (luaO_findstring(name, oldnames)) {
case 0: /* old error fallback */
oldfunc = L->errorim;
L->errorim = *luaA_Address(func);
replace = errorFB;
break;
case 1: /* old getglobal fallback */
oldfunc = *luaT_getim(LUA_T_NIL, IM_GETGLOBAL);
*luaT_getim(LUA_T_NIL, IM_GETGLOBAL) = *luaA_Address(func);
replace = nilFB;
break;
case 2: { /* old arith fallback */
int i;
oldfunc = *luaT_getim(LUA_T_NUMBER, IM_POW);
for (i=IM_ADD; i<=IM_UNM; i++) /* ORDER IM */
fillvalids(i, luaA_Address(func));
replace = typeFB;
break;
}
case 3: { /* old order fallback */
int i;
oldfunc = *luaT_getim(LUA_T_NIL, IM_LT);
for (i=IM_LT; i<=IM_GE; i++) /* ORDER IM */
fillvalids(i, luaA_Address(func));
replace = typeFB;
break;
}
default: {
int e;
if ((e = luaO_findstring(name, luaT_eventname)) >= 0) {
oldfunc = *luaT_getim(LUA_T_NIL, e);
fillvalids(e, luaA_Address(func));
replace = (e == IM_GC || e == IM_INDEX) ? nilFB : typeFB;
}
else {
luaL_verror("`%.50s' is not a valid fallback name", name);
replace = NULL; /* to avoid warnings */
}
}
}
if (oldfunc.ttype != LUA_T_NIL)
luaA_pushobject(&oldfunc);
else
lua_pushcfunction(replace);
}
#endif

62
ltm.h Normal file
View File

@@ -0,0 +1,62 @@
/*
** $Id: ltm.h,v 1.3 1997/11/19 17:29:23 roberto Exp roberto $
** Tag methods
** See Copyright Notice in lua.h
*/
#ifndef ltm_h
#define ltm_h
#include "lobject.h"
#include "lstate.h"
/*
* WARNING: if you change the order of this enumeration,
* grep "ORDER IM"
*/
typedef enum {
IM_GETTABLE = 0,
IM_SETTABLE,
IM_INDEX,
IM_GETGLOBAL,
IM_SETGLOBAL,
IM_ADD,
IM_SUB,
IM_MUL,
IM_DIV,
IM_POW,
IM_UNM,
IM_LT,
IM_LE,
IM_GT,
IM_GE,
IM_CONCAT,
IM_GC,
IM_FUNCTION
} IMS;
#define IM_N 18
struct IM {
TObject int_method[IM_N];
};
#define luaT_getim(tag,event) (&L->IMtable[-(tag)].int_method[event])
#define luaT_getimbyObj(o,e) (luaT_getim(luaT_efectivetag(o),(e)))
extern char *luaT_eventname[];
void luaT_init (void);
void luaT_realtag (int tag);
int luaT_efectivetag (TObject *o);
void luaT_settagmethod (int t, char *event, TObject *func);
TObject *luaT_gettagmethod (int t, char *event);
char *luaT_travtagmethods (int (*fn)(TObject *));
void luaT_setfallback (void); /* only if LUA_COMPAT2_5 */
#endif

212
lua.c
View File

@@ -1,18 +1,24 @@
/*
** lua.c
** Linguagem para Usuarios de Aplicacao
** $Id: lua.c,v 1.11 1997/12/22 18:05:23 roberto Exp roberto $
** Lua stand-alone interpreter
** See Copyright Notice in lua.h
*/
char *rcs_lua="$Id: lua.c,v 1.17 1997/06/18 21:20:45 roberto Exp roberto $";
#include <stdio.h>
#include <string.h>
#include "lua.h"
#include "auxlib.h"
#include "luadebug.h"
#include "lualib.h"
#ifndef OLD_ANSI
#include <locale.h>
#else
#define setlocale(a,b) 0
#endif
#ifdef _POSIX_SOURCE
#include <unistd.h>
#else
@@ -20,122 +26,134 @@ char *rcs_lua="$Id: lua.c,v 1.17 1997/06/18 21:20:45 roberto Exp roberto $";
#endif
#define DEBUG 0
static void testC (void)
static void print_message (void)
{
#if DEBUG
#define getnum(s) ((*s++) - '0')
#define getname(s) (nome[0] = *s++, nome)
static int locks[10];
lua_Object reg[10];
char nome[2];
char *s = luaL_check_string(1);
nome[1] = 0;
while (1) {
switch (*s++) {
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
lua_pushnumber(*(s-1) - '0');
break;
case 'c': reg[getnum(s)] = lua_createtable(); break;
case 'P': reg[getnum(s)] = lua_pop(); break;
case 'g': { int n = getnum(s); reg[n] = lua_getglobal(getname(s)); break; }
case 'G': { int n = getnum(s);
reg[n] = lua_rawgetglobal(getname(s));
break;
}
case 'l': locks[getnum(s)] = lua_ref(1); break;
case 'L': locks[getnum(s)] = lua_ref(0); break;
case 'r': { int n = getnum(s); reg[n] = lua_getref(locks[getnum(s)]); break; }
case 'u': lua_unref(locks[getnum(s)]); break;
case 'p': { int n = getnum(s); reg[n] = lua_getparam(getnum(s)); break; }
case '=': lua_setglobal(getname(s)); break;
case 's': lua_pushstring(getname(s)); break;
case 'o': lua_pushobject(reg[getnum(s)]); break;
case 'f': lua_call(getname(s)); break;
case 'i': reg[getnum(s)] = lua_gettable(); break;
case 'I': reg[getnum(s)] = lua_rawgettable(); break;
case 't': lua_settable(); break;
case 'T': lua_rawsettable(); break;
default: luaL_verror("unknown command in `testC': %c", *(s-1));
}
if (*s == 0) return;
if (*s++ != ' ') lua_error("missing ` ' between commands in `testC'");
}
#else
lua_error("`testC' not active");
#endif
fprintf(stderr,
"Lua: command line options:\n"
" -v print version information\n"
" -d turn debug on\n"
" -e stat dostring `stat'\n"
" -q interactive mode without prompt\n"
" -i interactive mode with prompt\n"
" - executes stdin as a file\n"
" a=b sets global `a' with string `b'\n"
" name dofile `name'\n\n");
}
static void manual_input (void)
static void assign (char *arg)
{
if (isatty(0)) {
char buffer[250];
while (fgets(buffer, sizeof(buffer), stdin) != 0) {
lua_beginblock();
lua_dostring(buffer);
lua_endblock();
}
if (strlen(arg) >= 500)
fprintf(stderr, "lua: shell argument too long");
else {
char buffer[500];
char *eq = strchr(arg, '=');
lua_pushstring(eq+1);
strncpy(buffer, arg, eq-arg);
buffer[eq-arg] = 0;
lua_setglobal(buffer);
}
else
lua_dofile(NULL); /* executes stdin as a file */
}
#define BUF_SIZE 512
static void manual_input (int prompt)
{
int cont = 1;
while (cont) {
char buffer[BUF_SIZE];
int i = 0;
lua_beginblock();
if (prompt)
printf("%s", lua_getstring(lua_getglobal("_PROMPT")));
for(;;) {
int c = getchar();
if (c == EOF) {
cont = 0;
break;
}
else if (c == '\n') {
if (i>0 && buffer[i-1] == '\\')
buffer[i-1] = '\n';
else break;
}
else if (i >= BUF_SIZE-1) {
fprintf(stderr, "lua: argument line too long\n");
break;
}
else buffer[i++] = c;
}
buffer[i] = 0;
lua_dostring(buffer);
lua_endblock();
}
printf("\n");
}
int main (int argc, char *argv[])
{
int i;
int result = 0;
iolib_open ();
strlib_open ();
mathlib_open ();
lua_register("testC", testC);
if (argc < 2)
manual_input();
setlocale(LC_ALL, "");
lua_iolibopen();
lua_strlibopen();
lua_mathlibopen();
lua_pushstring("> "); lua_setglobal("_PROMPT");
if (argc < 2) { /* no arguments? */
if (isatty(0)) {
printf("%s %s\n", LUA_VERSION, LUA_COPYRIGHT);
manual_input(1);
}
else
lua_dofile(NULL); /* executes stdin as a file */
}
else for (i=1; i<argc; i++) {
if (strcmp(argv[i], "-") == 0)
manual_input();
else if (strcmp(argv[i], "-v") == 0)
printf("%s %s\n(written by %s)\n\n",
LUA_VERSION, LUA_COPYRIGHT, LUA_AUTHORS);
else if ((strcmp(argv[i], "-e") == 0 && i++) || strchr(argv[i], '=')) {
if (lua_dostring(argv[i]) != 0) {
fprintf(stderr, "lua: error running argument `%s'\n", argv[i]);
return 1;
if (argv[i][0] == '-') { /* option? */
switch (argv[i][1]) {
case 0:
lua_dofile(NULL); /* executes stdin as a file */
break;
case 'i':
manual_input(1);
break;
case 'q':
manual_input(0);
break;
case 'd':
lua_debug = 1;
break;
case 'v':
printf("%s %s\n(written by %s)\n\n",
LUA_VERSION, LUA_COPYRIGHT, LUA_AUTHORS);
break;
case 'e':
i++;
if (lua_dostring(argv[i]) != 0) {
fprintf(stderr, "lua: error running argument `%s'\n", argv[i]);
return 1;
}
break;
default:
print_message();
exit(1);
}
}
else if (strchr(argv[i], '='))
assign(argv[i]);
else {
result = lua_dofile (argv[i]);
int result = lua_dofile(argv[i]);
if (result) {
if (result == 2) {
fprintf(stderr, "lua: cannot execute file ");
perror(argv[i]);
}
return 1;
exit(1);
}
}
}
return result;
#ifdef DEBUG
lua_close();
#endif
return 0;
}

69
lua.h
View File

@@ -1,16 +1,50 @@
/*
** LUA - An Extensible Extension Language
** $Id: lua.h,v 1.13 1998/01/02 17:46:32 roberto Exp roberto $
** Lua - An Extensible Extension Language
** TeCGraf: Grupo de Tecnologia em Computacao Grafica, PUC-Rio, Brazil
** e-mail: lua@tecgraf.puc-rio.br
** $Id: lua.h,v 4.10 1997/06/19 18:03:04 roberto Exp roberto $
** www: http://www.tecgraf.puc-rio.br/lua/
*/
/*********************************************************************
* Copyright (c) 1994-1998 TeCGraf, PUC-Rio.
* Written by Waldemar Celes Filho, Roberto Ierusalimschy and
* Luiz Henrique de Figueiredo.
* All rights reserved.
*
* Permission is hereby granted, without written agreement and with­
* out license or royalty fees, to use, copy, modify, and distribute
* this software and its documentation for any purpose, subject to
* the following conditions:
*
* The above copyright notice and this permission notice shall ap­
* pear in all copies or substantial portions of this software.
*
* The name "Lua" cannot be used for any modified form of this soft­
* ware that does not originate from the authors. Nevertheless, the
* name "Lua" may and should be used to designate the language im­
* plemented and described in this package, even if embedded in any
* other system, as long as its syntax and semantics remain un­
* changed.
*
* The authors specifically disclaim any warranties, including, but
* not limited to, the implied warranties of merchantability and
* fitness for a particular purpose. The software provided hereunder
* is on an "as is" basis, and the authors have no obligation to
* provide maintenance, support, updates, enhancements, or modifica­
* tions. In no event shall TeCGraf, PUC-Rio, or the authors be li­
* able to any party for direct, indirect, special, incidental, or
* consequential damages arising out of the use of this software and
* its documentation.
*********************************************************************/
#ifndef lua_h
#define lua_h
#define LUA_VERSION "Lua 3.0"
#define LUA_COPYRIGHT "Copyright (C) 1994-1997 TeCGraf"
#define LUA_VERSION "Lua 3.1 (alpha)"
#define LUA_COPYRIGHT "Copyright (C) 1994-1998 TeCGraf"
#define LUA_AUTHORS "W. Celes, R. Ierusalimschy & L. H. de Figueiredo"
@@ -21,11 +55,16 @@
typedef void (*lua_CFunction) (void);
typedef unsigned int lua_Object;
lua_Object lua_settagmethod (int tag, char *event); /* In: new method */
void lua_open (void);
void lua_close (void);
lua_Object lua_settagmethod (int tag, char *event); /* In: new method */
lua_Object lua_gettagmethod (int tag, char *event);
lua_Object lua_seterrormethod (void); /* In: new method */
int lua_newtag (void);
int lua_copytagmethods (int tagto, int tagfrom);
void lua_settag (int tag); /* In: object */
void lua_error (char *s);
@@ -49,16 +88,16 @@ int lua_isnumber (lua_Object object);
int lua_isstring (lua_Object object);
int lua_isfunction (lua_Object object);
float lua_getnumber (lua_Object object);
double lua_getnumber (lua_Object object);
char *lua_getstring (lua_Object object);
lua_CFunction lua_getcfunction (lua_Object object);
void *lua_getuserdata (lua_Object object);
void lua_pushnil (void);
void lua_pushnumber (float n);
void lua_pushnumber (double n);
void lua_pushstring (char *s);
void lua_pushcfunction (lua_CFunction fn);
void lua_pushCclosure (lua_CFunction fn, int n);
void lua_pushusertag (void *u, int tag);
void lua_pushobject (lua_Object object);
@@ -99,20 +138,18 @@ long lua_collectgarbage (long limit);
#define lua_pushuserdata(u) lua_pushusertag(u, 0)
#define lua_pushcfunction(f) lua_pushCclosure(f, 0)
#define lua_clonetag(t) lua_copytagmethods(lua_newtag(), (t))
/* ==========================================================================
/* ==========================================================================
** for compatibility with old versions. Avoid using these macros/functions
** If your program does not use any of these, define LUA_COMPAT2_5 to 0
** If your program does need any of these, define LUA_COMPAT2_5
*/
#ifndef LUA_COMPAT2_5
#define LUA_COMPAT2_5 1
#endif
#if LUA_COMPAT2_5
#ifdef LUA_COMPAT2_5
lua_Object lua_setfallback (char *event, lua_CFunction fallback);

1268
lua.stx

File diff suppressed because it is too large Load Diff

View File

@@ -1,14 +1,14 @@
/*
** LUA - Linguagem para Usuarios de Aplicacao
** Grupo de Tecnologia em Computacao Grafica
** TeCGraf - PUC-Rio
** $Id: luadebug.h,v 1.5 1996/02/08 17:03:20 roberto Exp roberto $
** $Id: $
** Debuging API
** See Copyright Notice in lua.h
*/
#ifndef luadebug_h
#define luadebug_h
#include "lua.h"
typedef lua_Object lua_Function;
@@ -24,8 +24,10 @@ char *lua_getobjname (lua_Object o, char **name);
lua_Object lua_getlocal (lua_Function func, int local_number, char **name);
int lua_setlocal (lua_Function func, int local_number);
extern lua_LHFunction lua_linehook;
extern lua_CHFunction lua_callhook;
extern int lua_debug;
#endif

View File

@@ -1,29 +1,34 @@
/*
** Libraries to be used in LUA programs
** Grupo de Tecnologia em Computacao Grafica
** TeCGraf - PUC-Rio
** $Id: lualib.h,v 1.12 1997/03/18 15:30:50 roberto Exp roberto $
** $Id: lualib.h,v 1.2 1997/11/26 18:53:45 roberto Exp roberto $
** Lua standard libraries
** See Copyright Notice in lua.h
*/
#ifndef lualib_h
#define lualib_h
#include "lua.h"
void iolib_open (void);
void strlib_open (void);
void mathlib_open (void);
void lua_iolibopen (void);
void lua_strlibopen (void);
void lua_mathlibopen (void);
/* To keep compatibility with old versions */
#define iolib_open lua_iolibopen
#define strlib_open lua_strlibopen
#define mathlib_open lua_mathlibopen
/* auxiliar functions (private) */
char *luaI_addchar (int c);
void luaI_emptybuff (void);
void luaI_addquoted (char *s);
char *luaL_item_end (char *p);
int luaL_singlematch (int c, char *p);
int luaI_singlematch (int c, char *p, char **ep);
#endif

159
luamem.c
View File

@@ -1,159 +0,0 @@
/*
** mem.c
** TecCGraf - PUC-Rio
*/
char *rcs_luamem = "$Id: luamem.c,v 1.15 1997/03/31 14:17:09 roberto Exp roberto $";
#include <stdlib.h>
#include "luamem.h"
#include "lua.h"
#define DEBUG 0
#if !DEBUG
void luaI_free (void *block)
{
if (block)
{
*((char *)block) = -1; /* to catch errors */
free(block);
}
}
void *luaI_realloc (void *oldblock, unsigned long size)
{
void *block;
size_t s = (size_t)size;
if (s != size)
lua_error("Allocation Error: Block too big");
block = oldblock ? realloc(oldblock, s) : malloc(s);
if (block == NULL)
lua_error(memEM);
return block;
}
int luaI_growvector (void **block, unsigned long nelems, int size,
char *errormsg, unsigned long limit)
{
if (nelems >= limit)
lua_error(errormsg);
nelems = (nelems == 0) ? 20 : nelems*2;
if (nelems > limit)
nelems = limit;
*block = luaI_realloc(*block, nelems*size);
return (int)nelems;
}
void* luaI_buffer (unsigned long size)
{
static unsigned long buffsize = 0;
static char* buffer = NULL;
if (size > buffsize)
buffer = luaI_realloc(buffer, buffsize=size);
return buffer;
}
#else
/* DEBUG */
#include <stdio.h>
# define assert(ex) {if (!(ex)){(void)fprintf(stderr, \
"Assertion failed: file \"%s\", line %d\n", __FILE__, __LINE__);exit(1);}}
#define MARK 55
static unsigned long numblocks = 0;
static unsigned long totalmem = 0;
static void message (void)
{
#define inrange(x,y) ((x) < (((y)*3)/2) && (x) > (((y)*2)/3))
static int count = 0;
static unsigned long lastnumblocks = 0;
static unsigned long lasttotalmem = 0;
if (!inrange(numblocks, lastnumblocks) || !inrange(totalmem, lasttotalmem)
|| count++ >= 5000)
{
fprintf(stderr,"blocks = %lu mem = %luK\n", numblocks, totalmem/1000);
count = 0;
lastnumblocks = numblocks;
lasttotalmem = totalmem;
}
}
void luaI_free (void *block)
{
if (block)
{
unsigned long *b = (unsigned long *)block - 1;
unsigned long size = *b;
assert(*(((char *)b)+size+sizeof(unsigned long)) == MARK);
numblocks--;
totalmem -= size;
free(b);
message();
}
}
void *luaI_realloc (void *oldblock, unsigned long size)
{
unsigned long *block;
unsigned long realsize = sizeof(unsigned long)+size+sizeof(char);
if (realsize != (size_t)realsize)
lua_error("Allocation Error: Block too big");
if (oldblock)
{
unsigned long *b = (unsigned long *)oldblock - 1;
unsigned long oldsize = *b;
assert(*(((char *)b)+oldsize+sizeof(unsigned long)) == MARK);
totalmem -= oldsize;
numblocks--;
block = (unsigned long *)realloc(b, realsize);
}
else
block = (unsigned long *)malloc(realsize);
if (block == NULL)
lua_error("not enough memory");
totalmem += size;
numblocks++;
*block = size;
*(((char *)block)+size+sizeof(unsigned long)) = MARK;
message();
return block+1;
}
int luaI_growvector (void **block, unsigned long nelems, int size,
char *errormsg, unsigned long limit)
{
if (nelems >= limit)
lua_error(errormsg);
nelems = (nelems == 0) ? 20 : nelems*2;
if (nelems > limit)
nelems = limit;
*block = luaI_realloc(*block, nelems*size);
return (int)nelems;
}
void* luaI_buffer (unsigned long size)
{
static unsigned long buffsize = 0;
static char* buffer = NULL;
if (size > buffsize)
buffer = luaI_realloc(buffer, buffsize=size);
return buffer;
}
#endif

View File

@@ -1,39 +0,0 @@
/*
** mem.c
** memory manager for lua
** $Id: luamem.h,v 1.8 1996/05/24 14:31:10 roberto Exp roberto $
*/
#ifndef luamem_h
#define luamem_h
#ifndef NULL
#define NULL 0
#endif
/* memory error messages */
#define codeEM "code size overflow"
#define symbolEM "symbol table overflow"
#define constantEM "constant table overflow"
#define stackEM "stack size overflow"
#define lexEM "lex buffer overflow"
#define refEM "reference table overflow"
#define tableEM "table overflow"
#define memEM "not enough memory"
void luaI_free (void *block);
void *luaI_realloc (void *oldblock, unsigned long size);
void *luaI_buffer (unsigned long size);
int luaI_growvector (void **block, unsigned long nelems, int size,
char *errormsg, unsigned long limit);
#define luaI_malloc(s) luaI_realloc(NULL, (s))
#define new(s) ((s *)luaI_malloc(sizeof(s)))
#define newvector(n,s) ((s *)luaI_malloc((n)*sizeof(s)))
#define growvector(old,n,s,e,l) \
(luaI_growvector((void**)old,n,sizeof(s),e,l))
#endif

272
lundump.c Normal file
View File

@@ -0,0 +1,272 @@
/*
** $Id: lundump.c,v 1.4 1998/01/13 20:05:24 lhf Exp $
** load bytecodes from files
** See Copyright Notice in lua.h
*/
#include <stdio.h>
#include "lauxlib.h"
#include "lfunc.h"
#include "lmem.h"
#include "lstring.h"
#include "lundump.h"
typedef struct {
ZIO* Z;
int SwapNumber;
int LoadFloat;
} Sundump;
static void unexpectedEOZ(ZIO* Z)
{
luaL_verror("unexpected end of binary file %s",Z->name);
}
static int ezgetc(ZIO* Z)
{
int c=zgetc(Z);
if (c==EOZ) unexpectedEOZ(Z);
return c;
}
static int ezread(ZIO* Z, void* b, int n)
{
int r=zread(Z,b,n);
if (r!=0) unexpectedEOZ(Z);
return r;
}
static int LoadWord(ZIO* Z)
{
int hi=ezgetc(Z);
int lo=ezgetc(Z);
return (hi<<8)|lo;
}
static void* LoadBlock(int size, ZIO* Z)
{
void* b=luaM_malloc(size);
ezread(Z,b,size);
return b;
}
static int LoadSize(ZIO* Z)
{
int hi=LoadWord(Z);
int lo=LoadWord(Z);
int s=(hi<<16)|lo;
if (hi!=0 && s==lo)
luaL_verror("code too long (%ld bytes)",(hi<<16)|(long)lo);
return s;
}
static char* LoadString(ZIO* Z)
{
int size=LoadWord(Z);
if (size==0)
return NULL;
else
{
char* b=luaL_openspace(size);
ezread(Z,b,size);
return b;
}
}
static TaggedString* LoadTString(ZIO* Z)
{
char* s=LoadString(Z);
return (s==NULL) ? NULL : luaS_new(s);
}
static void SwapFloat(float* f)
{
Byte* p=(Byte*)f;
Byte* q=p+sizeof(float)-1;
Byte t;
t=*p; *p++=*q; *q--=t;
t=*p; *p++=*q; *q--=t;
}
static void SwapDouble(double* f)
{
Byte* p=(Byte*)f;
Byte* q=p+sizeof(double)-1;
Byte t;
t=*p; *p++=*q; *q--=t;
t=*p; *p++=*q; *q--=t;
t=*p; *p++=*q; *q--=t;
t=*p; *p++=*q; *q--=t;
}
static real LoadNumber(Sundump* S)
{
if (S->LoadFloat)
{
float f;
ezread(S->Z,&f,sizeof(f));
if (S->SwapNumber) SwapFloat(&f);
return f;
}
else
{
double f;
ezread(S->Z,&f,sizeof(f));
if (S->SwapNumber) SwapDouble(&f);
return f;
}
}
static void LoadLocals(TProtoFunc* tf, ZIO* Z)
{
int i,n=LoadWord(Z);
if (n==0) return;
tf->locvars=luaM_newvector(n+1,LocVar);
for (i=0; i<n; i++)
{
tf->locvars[i].line=LoadWord(Z);
tf->locvars[i].varname=LoadTString(Z);
}
tf->locvars[i].line=-1; /* flag end of vector */
tf->locvars[i].varname=NULL;
}
static void LoadConstants(TProtoFunc* tf, Sundump* S)
{
int i,n=LoadWord(S->Z);
tf->nconsts=n;
if (n==0) return;
tf->consts=luaM_newvector(n,TObject);
for (i=0; i<n; i++)
{
TObject* o=tf->consts+i;
int c=ezgetc(S->Z);
switch (c)
{
case ID_NUM:
ttype(o)=LUA_T_NUMBER;
nvalue(o)=LoadNumber(S);
break;
case ID_STR:
ttype(o)=LUA_T_STRING;
tsvalue(o)=LoadTString(S->Z);
break;
case ID_FUN:
ttype(o)=LUA_T_PROTO;
tfvalue(o)=NULL;
break;
#ifdef DEBUG
default: /* cannot happen */
luaL_verror("internal error in LoadConstants: "
"bad constant #%d type=%d ('%c')\n",i,c,c);
break;
#endif
}
}
}
static TProtoFunc* LoadFunction(Sundump* S);
static void LoadFunctions(TProtoFunc* tf, Sundump* S)
{
while (zgetc(S->Z)==ID_FUNCTION)
{
int i=LoadWord(S->Z);
TProtoFunc* t=LoadFunction(S);
TObject* o=tf->consts+i;
tfvalue(o)=t;
}
}
static TProtoFunc* LoadFunction(Sundump* S)
{
ZIO* Z=S->Z;
TProtoFunc* tf=luaF_newproto();
tf->lineDefined=LoadWord(Z);
tf->fileName=LoadTString(Z);
tf->code=LoadBlock(LoadSize(Z),Z);
LoadConstants(tf,S);
LoadLocals(tf,Z);
LoadFunctions(tf,S);
return tf;
}
static void LoadSignature(ZIO* Z)
{
char* s=SIGNATURE;
while (*s!=0 && ezgetc(Z)==*s)
++s;
if (*s!=0) luaL_verror("bad signature in binary file %s",Z->name);
}
static void LoadHeader(Sundump* S)
{
ZIO* Z=S->Z;
int version,sizeofR;
LoadSignature(Z);
version=ezgetc(Z);
if (version>VERSION)
luaL_verror(
"binary file %s too new: version=0x%02x; expected at most 0x%02x",
Z->name,version,VERSION);
if (version<0x31) /* major change in 3.1 */
luaL_verror(
"binary file %s too old: version=0x%02x; expected at least 0x%02x",
Z->name,version,0x31);
sizeofR=ezgetc(Z); /* test float representation */
if (sizeofR==sizeof(float))
{
float f,tf=TEST_FLOAT;
ezread(Z,&f,sizeof(f));
if (f!=tf)
{
SwapFloat(&f);
if (f!=tf)
luaL_verror("unknown float representation in binary file %s",Z->name);
S->SwapNumber=1;
}
S->LoadFloat=1;
}
else if (sizeofR==sizeof(double))
{
double f,tf=TEST_FLOAT;
ezread(Z,&f,sizeof(f));
if (f!=tf)
{
SwapDouble(&f);
if (f!=tf)
luaL_verror("unknown float representation in binary file %s",Z->name);
S->SwapNumber=1;
}
S->LoadFloat=0;
}
else
luaL_verror(
"floats in binary file %s have %d bytes; "
"expected %d (float) or %d (double)",
Z->name,sizeofR,sizeof(float),sizeof(double));
}
static TProtoFunc* LoadChunk(Sundump* S)
{
LoadHeader(S);
return LoadFunction(S);
}
/*
** load one chunk from a file or buffer
** return main if ok and NULL at EOF
*/
TProtoFunc* luaU_undump1(ZIO* Z)
{
int c=zgetc(Z);
Sundump S;
S.Z=Z;
S.SwapNumber=0;
S.LoadFloat=1;
if (c==ID_CHUNK)
return LoadChunk(&S);
else if (c!=EOZ)
luaL_verror("%s is not a lua binary file",Z->name);
return NULL;
}

27
lundump.h Normal file
View File

@@ -0,0 +1,27 @@
/*
** $Id: lundump.h,v 1.4 1998/01/13 20:05:24 lhf Exp $
** load pre-compiled Lua chunks
** See Copyright Notice in lua.h
*/
#ifndef lundump_h
#define lundump_h
#include "lobject.h"
#include "lzio.h"
#define ID_CHUNK 27 /* ESC */
#define ID_FUNCTION '#'
#define ID_END '$'
#define ID_NUM 'N'
#define ID_STR 'S'
#define ID_FUN 'F'
#define SIGNATURE "Lua"
#define VERSION 0x31 /* last format change was in 3.1 */
#define TEST_FLOAT 0.123456789e-23 /* a float for testing representation */
#define IsMain(f) (f->lineDefined==0)
TProtoFunc* luaU_undump1(ZIO* Z); /* load one chunk */
#endif

717
lvm.c Normal file
View File

@@ -0,0 +1,717 @@
/*
** $Id: lvm.c,v 1.22 1998/01/12 13:35:37 roberto Exp roberto $
** Lua virtual machine
** See Copyright Notice in lua.h
*/
#include <stdio.h>
#include <string.h>
#include "lauxlib.h"
#include "ldo.h"
#include "lfunc.h"
#include "lgc.h"
#include "lmem.h"
#include "lopcodes.h"
#include "lstate.h"
#include "lstring.h"
#include "ltable.h"
#include "ltm.h"
#include "luadebug.h"
#include "lvm.h"
#ifdef OLD_ANSI
#define strcoll(a,b) strcmp(a,b)
#endif
#define skip_word(pc) (pc+=2)
#define get_word(pc) (*(pc)+(*((pc)+1)<<8))
#define next_word(pc) (pc+=2, get_word(pc-2))
/* Extra stack size to run a function: LUA_T_LINE(1), TM calls(2), ... */
#define EXTRA_STACK 5
static TaggedString *strconc (char *l, char *r)
{
size_t nl = strlen(l);
char *buffer = luaL_openspace(nl+strlen(r)+1);
strcpy(buffer, l);
strcpy(buffer+nl, r);
return luaS_new(buffer);
}
int luaV_tonumber (TObject *obj)
{ /* LUA_NUMBER */
double t;
char c;
if (ttype(obj) != LUA_T_STRING)
return 1;
else if (sscanf(svalue(obj), "%lf %c",&t, &c) == 1) {
nvalue(obj) = (real)t;
ttype(obj) = LUA_T_NUMBER;
return 0;
}
else
return 2;
}
int luaV_tostring (TObject *obj)
{ /* LUA_NUMBER */
if (ttype(obj) != LUA_T_NUMBER)
return 1;
else {
char s[60];
real f = nvalue(obj);
int i;
if ((real)(-MAX_INT) <= f && f <= (real)MAX_INT && (real)(i=(int)f) == f)
sprintf (s, "%d", i);
else
sprintf (s, "%g", (double)nvalue(obj));
tsvalue(obj) = luaS_new(s);
ttype(obj) = LUA_T_STRING;
return 0;
}
}
void luaV_closure (int nelems)
{
if (nelems > 0) {
struct Stack *S = &L->stack;
Closure *c = luaF_newclosure(nelems);
c->consts[0] = *(S->top-1);
memcpy(&c->consts[1], S->top-(nelems+1), nelems*sizeof(TObject));
S->top -= nelems;
ttype(S->top-1) = LUA_T_CLOSURE;
(S->top-1)->value.cl = c;
}
}
/*
** Function to index a table.
** Receives the table at top-2 and the index at top-1.
*/
void luaV_gettable (void)
{
struct Stack *S = &L->stack;
TObject *im;
if (ttype(S->top-2) != LUA_T_ARRAY) /* not a table, get "gettable" method */
im = luaT_getimbyObj(S->top-2, IM_GETTABLE);
else { /* object is a table... */
int tg = (S->top-2)->value.a->htag;
im = luaT_getim(tg, IM_GETTABLE);
if (ttype(im) == LUA_T_NIL) { /* and does not have a "gettable" method */
TObject *h = luaH_get(avalue(S->top-2), S->top-1);
if (h != NULL && ttype(h) != LUA_T_NIL) {
--S->top;
*(S->top-1) = *h;
}
else if (ttype(im=luaT_getim(tg, IM_INDEX)) != LUA_T_NIL)
luaD_callTM(im, 2, 1);
else {
--S->top;
ttype(S->top-1) = LUA_T_NIL;
}
return;
}
/* else it has a "gettable" method, go through to next command */
}
/* object is not a table, or it has a "gettable" method */
if (ttype(im) != LUA_T_NIL)
luaD_callTM(im, 2, 1);
else
lua_error("indexed expression not a table");
}
/*
** Function to store indexed based on values at the stack.top
** mode = 0: raw store (without internal methods)
** mode = 1: normal store (with internal methods)
** mode = 2: "deep L->stack.stack" store (with internal methods)
*/
void luaV_settable (TObject *t, int mode)
{
struct Stack *S = &L->stack;
TObject *im = (mode == 0) ? NULL : luaT_getimbyObj(t, IM_SETTABLE);
if (ttype(t) == LUA_T_ARRAY && (im == NULL || ttype(im) == LUA_T_NIL)) {
TObject *h = luaH_set(avalue(t), t+1);
*h = *(S->top-1);
S->top -= (mode == 2) ? 1 : 3;
}
else { /* object is not a table, and/or has a specific "settable" method */
if (im && ttype(im) != LUA_T_NIL) {
if (mode == 2) {
*(S->top+1) = *(L->stack.top-1);
*(S->top) = *(t+1);
*(S->top-1) = *t;
S->top += 2; /* WARNING: caller must assure stack space */
}
luaD_callTM(im, 3, 0);
}
else
lua_error("indexed expression not a table");
}
}
void luaV_getglobal (TaggedString *ts)
{
/* WARNING: caller must assure stack space */
TObject *value = &ts->u.globalval;
TObject *im = luaT_getimbyObj(value, IM_GETGLOBAL);
if (ttype(im) == LUA_T_NIL) { /* default behavior */
*L->stack.top++ = *value;
}
else {
struct Stack *S = &L->stack;
ttype(S->top) = LUA_T_STRING;
tsvalue(S->top) = ts;
S->top++;
*S->top++ = *value;
luaD_callTM(im, 2, 1);
}
}
void luaV_setglobal (TaggedString *ts)
{
TObject *oldvalue = &ts->u.globalval;
TObject *im = luaT_getimbyObj(oldvalue, IM_SETGLOBAL);
if (ttype(im) == LUA_T_NIL) /* default behavior */
luaS_rawsetglobal(ts, --L->stack.top);
else {
/* WARNING: caller must assure stack space */
struct Stack *S = &L->stack;
TObject newvalue = *(S->top-1);
ttype(S->top-1) = LUA_T_STRING;
tsvalue(S->top-1) = ts;
*S->top++ = *oldvalue;
*S->top++ = newvalue;
luaD_callTM(im, 3, 0);
}
}
static void call_binTM (IMS event, char *msg)
{
TObject *im = luaT_getimbyObj(L->stack.top-2, event);/* try first operand */
if (ttype(im) == LUA_T_NIL) {
im = luaT_getimbyObj(L->stack.top-1, event); /* try second operand */
if (ttype(im) == LUA_T_NIL) {
im = luaT_getim(0, event); /* try a 'global' i.m. */
if (ttype(im) == LUA_T_NIL)
lua_error(msg);
}
}
lua_pushstring(luaT_eventname[event]);
luaD_callTM(im, 3, 1);
}
static void call_arith (IMS event)
{
call_binTM(event, "unexpected type in arithmetic operation");
}
static void comparison (lua_Type ttype_less, lua_Type ttype_equal,
lua_Type ttype_great, IMS op)
{
struct Stack *S = &L->stack;
TObject *l = S->top-2;
TObject *r = S->top-1;
int result;
if (ttype(l) == LUA_T_NUMBER && ttype(r) == LUA_T_NUMBER)
result = (nvalue(l) < nvalue(r)) ? -1 : (nvalue(l) == nvalue(r)) ? 0 : 1;
else if (ttype(l) == LUA_T_STRING && ttype(r) == LUA_T_STRING)
result = strcoll(svalue(l), svalue(r));
else {
call_binTM(op, "unexpected type in comparison");
return;
}
S->top--;
nvalue(S->top-1) = 1;
ttype(S->top-1) = (result < 0) ? ttype_less :
(result == 0) ? ttype_equal : ttype_great;
}
void luaV_pack (StkId firstel, int nvararg, TObject *tab)
{
TObject *firstelem = L->stack.stack+firstel;
int i;
if (nvararg < 0) nvararg = 0;
avalue(tab) = luaH_new(nvararg+1); /* +1 for field 'n' */
ttype(tab) = LUA_T_ARRAY;
for (i=0; i<nvararg; i++) {
TObject index;
ttype(&index) = LUA_T_NUMBER;
nvalue(&index) = i+1;
*(luaH_set(avalue(tab), &index)) = *(firstelem+i);
}
/* store counter in field "n" */ {
TObject index, extra;
ttype(&index) = LUA_T_STRING;
tsvalue(&index) = luaS_new("n");
ttype(&extra) = LUA_T_NUMBER;
nvalue(&extra) = nvararg;
*(luaH_set(avalue(tab), &index)) = extra;
}
}
static void adjust_varargs (StkId first_extra_arg)
{
TObject arg;
luaV_pack(first_extra_arg,
(L->stack.top-L->stack.stack)-first_extra_arg, &arg);
luaD_adjusttop(first_extra_arg);
*L->stack.top++ = arg;
}
/*
** Execute the given opcode, until a RET. Parameters are between
** [stack+base,top). Returns n such that the the results are between
** [stack+n,top).
*/
StkId luaV_execute (Closure *cl, TProtoFunc *tf, StkId base)
{
struct Stack *S = &L->stack; /* to optimize */
Byte *pc = tf->code;
TObject *consts = tf->consts;
if (lua_callhook)
luaD_callHook(base, tf, 0);
luaD_checkstack((*pc++)+EXTRA_STACK);
if (*pc < ZEROVARARG)
luaD_adjusttop(base+*(pc++));
else { /* varargs */
luaC_checkGC();
adjust_varargs(base+(*pc++)-ZEROVARARG);
}
while (1) {
int aux;
switch ((OpCode)(aux = *pc++)) {
case PUSHNIL0:
ttype(S->top++) = LUA_T_NIL;
break;
case PUSHNIL:
aux = *pc++;
do {
ttype(S->top++) = LUA_T_NIL;
} while (aux--);
break;
case PUSHNUMBER:
aux = *pc++; goto pushnumber;
case PUSHNUMBERW:
aux = next_word(pc); goto pushnumber;
case PUSHNUMBER0: case PUSHNUMBER1: case PUSHNUMBER2:
aux -= PUSHNUMBER0;
pushnumber:
ttype(S->top) = LUA_T_NUMBER;
nvalue(S->top) = aux;
S->top++;
break;
case PUSHLOCAL:
aux = *pc++; goto pushlocal;
case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2: case PUSHLOCAL3:
case PUSHLOCAL4: case PUSHLOCAL5: case PUSHLOCAL6: case PUSHLOCAL7:
aux -= PUSHLOCAL0;
pushlocal:
*S->top++ = *((S->stack+base) + aux);
break;
case GETGLOBALW:
aux = next_word(pc); goto getglobal;
case GETGLOBAL:
aux = *pc++; goto getglobal;
case GETGLOBAL0: case GETGLOBAL1: case GETGLOBAL2: case GETGLOBAL3:
case GETGLOBAL4: case GETGLOBAL5: case GETGLOBAL6: case GETGLOBAL7:
aux -= GETGLOBAL0;
getglobal:
luaV_getglobal(tsvalue(&consts[aux]));
break;
case GETTABLE:
luaV_gettable();
break;
case GETDOTTEDW:
aux = next_word(pc); goto getdotted;
case GETDOTTED:
aux = *pc++; goto getdotted;
case GETDOTTED0: case GETDOTTED1: case GETDOTTED2: case GETDOTTED3:
case GETDOTTED4: case GETDOTTED5: case GETDOTTED6: case GETDOTTED7:
aux -= GETDOTTED0;
getdotted:
*S->top++ = consts[aux];
luaV_gettable();
break;
case PUSHSELFW:
aux = next_word(pc); goto pushself;
case PUSHSELF:
aux = *pc++; goto pushself;
case PUSHSELF0: case PUSHSELF1: case PUSHSELF2: case PUSHSELF3:
case PUSHSELF4: case PUSHSELF5: case PUSHSELF6: case PUSHSELF7:
aux -= PUSHSELF0;
pushself: {
TObject receiver = *(S->top-1);
*S->top++ = consts[aux];
luaV_gettable();
*S->top++ = receiver;
break;
}
case PUSHCONSTANTW:
aux = next_word(pc); goto pushconstant;
case PUSHCONSTANT:
aux = *pc++; goto pushconstant;
case PUSHCONSTANT0: case PUSHCONSTANT1: case PUSHCONSTANT2:
case PUSHCONSTANT3: case PUSHCONSTANT4: case PUSHCONSTANT5:
case PUSHCONSTANT6: case PUSHCONSTANT7:
aux -= PUSHCONSTANT0;
pushconstant:
*S->top++ = consts[aux];
break;
case PUSHUPVALUE:
aux = *pc++; goto pushupvalue;
case PUSHUPVALUE0: case PUSHUPVALUE1:
aux -= PUSHUPVALUE0;
pushupvalue:
*S->top++ = cl->consts[aux+1];
break;
case SETLOCAL:
aux = *pc++; goto setlocal;
case SETLOCAL0: case SETLOCAL1: case SETLOCAL2: case SETLOCAL3:
case SETLOCAL4: case SETLOCAL5: case SETLOCAL6: case SETLOCAL7:
aux -= SETLOCAL0;
setlocal:
*((S->stack+base) + aux) = *(--S->top);
break;
case SETGLOBALW:
aux = next_word(pc); goto setglobal;
case SETGLOBAL:
aux = *pc++; goto setglobal;
case SETGLOBAL0: case SETGLOBAL1: case SETGLOBAL2: case SETGLOBAL3:
case SETGLOBAL4: case SETGLOBAL5: case SETGLOBAL6: case SETGLOBAL7:
aux -= SETGLOBAL0;
setglobal:
luaV_setglobal(tsvalue(&consts[aux]));
break;
case SETTABLE0:
luaV_settable(S->top-3, 1);
break;
case SETTABLE:
luaV_settable(S->top-3-(*pc++), 2);
break;
case SETLISTW:
aux = next_word(pc); aux *= LFIELDS_PER_FLUSH; goto setlist;
case SETLIST:
aux = *(pc++) * LFIELDS_PER_FLUSH; goto setlist;
case SETLIST0:
aux = 0;
setlist: {
int n = *(pc++);
TObject *arr = S->top-n-1;
for (; n; n--) {
ttype(S->top) = LUA_T_NUMBER;
nvalue(S->top) = n+aux;
*(luaH_set(avalue(arr), S->top)) = *(S->top-1);
S->top--;
}
break;
}
case SETMAP0:
aux = 0; goto setmap;
case SETMAP:
aux = *pc++;
setmap: {
TObject *arr = S->top-(2*aux)-3;
do {
*(luaH_set(avalue(arr), S->top-2)) = *(S->top-1);
S->top-=2;
} while (aux--);
break;
}
case POP:
aux = *pc++; goto pop;
case POP0: case POP1:
aux -= POP0;
pop:
S->top -= (aux+1);
break;
case CREATEARRAYW:
aux = next_word(pc); goto createarray;
case CREATEARRAY0: case CREATEARRAY1:
aux -= CREATEARRAY0; goto createarray;
case CREATEARRAY:
aux = *pc++;
createarray:
luaC_checkGC();
avalue(S->top) = luaH_new(aux);
ttype(S->top) = LUA_T_ARRAY;
S->top++;
break;
case EQOP: case NEQOP: {
int res = luaO_equalObj(S->top-2, S->top-1);
S->top--;
if (aux == NEQOP) res = !res;
ttype(S->top-1) = res ? LUA_T_NUMBER : LUA_T_NIL;
nvalue(S->top-1) = 1;
break;
}
case LTOP:
comparison(LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, IM_LT);
break;
case LEOP:
comparison(LUA_T_NUMBER, LUA_T_NUMBER, LUA_T_NIL, IM_LE);
break;
case GTOP:
comparison(LUA_T_NIL, LUA_T_NIL, LUA_T_NUMBER, IM_GT);
break;
case GEOP:
comparison(LUA_T_NIL, LUA_T_NUMBER, LUA_T_NUMBER, IM_GE);
break;
case ADDOP: {
TObject *l = S->top-2;
TObject *r = S->top-1;
if (tonumber(r) || tonumber(l))
call_arith(IM_ADD);
else {
nvalue(l) += nvalue(r);
--S->top;
}
break;
}
case SUBOP: {
TObject *l = S->top-2;
TObject *r = S->top-1;
if (tonumber(r) || tonumber(l))
call_arith(IM_SUB);
else {
nvalue(l) -= nvalue(r);
--S->top;
}
break;
}
case MULTOP: {
TObject *l = S->top-2;
TObject *r = S->top-1;
if (tonumber(r) || tonumber(l))
call_arith(IM_MUL);
else {
nvalue(l) *= nvalue(r);
--S->top;
}
break;
}
case DIVOP: {
TObject *l = S->top-2;
TObject *r = S->top-1;
if (tonumber(r) || tonumber(l))
call_arith(IM_DIV);
else {
nvalue(l) /= nvalue(r);
--S->top;
}
break;
}
case POWOP:
call_arith(IM_POW);
break;
case CONCOP: {
TObject *l = S->top-2;
TObject *r = S->top-1;
if (tostring(l) || tostring(r))
call_binTM(IM_CONCAT, "unexpected type for concatenation");
else {
tsvalue(l) = strconc(svalue(l), svalue(r));
--S->top;
}
luaC_checkGC();
break;
}
case MINUSOP:
if (tonumber(S->top-1)) {
ttype(S->top) = LUA_T_NIL;
S->top++;
call_arith(IM_UNM);
}
else
nvalue(S->top-1) = - nvalue(S->top-1);
break;
case NOTOP:
ttype(S->top-1) =
(ttype(S->top-1) == LUA_T_NIL) ? LUA_T_NUMBER : LUA_T_NIL;
nvalue(S->top-1) = 1;
break;
case ONTJMPW:
aux = next_word(pc); goto ontjmp;
case ONTJMP:
aux = *pc++;
ontjmp:
if (ttype(S->top-1) != LUA_T_NIL) pc += aux;
else S->top--;
break;
case ONFJMPW:
aux = next_word(pc); goto onfjmp;
case ONFJMP:
aux = *pc++;
onfjmp:
if (ttype(S->top-1) == LUA_T_NIL) pc += aux;
else S->top--;
break;
case JMPW:
aux = next_word(pc); goto jmp;
case JMP:
aux = *pc++;
jmp:
pc += aux;
break;
case IFFJMPW:
aux = next_word(pc); goto iffjmp;
case IFFJMP:
aux = *pc++;
iffjmp:
if (ttype(--S->top) == LUA_T_NIL) pc += aux;
break;
case IFTUPJMPW:
aux = next_word(pc); goto iftupjmp;
case IFTUPJMP:
aux = *pc++;
iftupjmp:
if (ttype(--S->top) != LUA_T_NIL) pc -= aux;
break;
case IFFUPJMPW:
aux = next_word(pc); goto iffupjmp;
case IFFUPJMP:
aux = *pc++;
iffupjmp:
if (ttype(--S->top) == LUA_T_NIL) pc -= aux;
break;
case CLOSURE:
aux = *pc++; goto closure;
case CLOSURE0: case CLOSURE1:
aux -= CLOSURE0;
closure:
luaV_closure(aux);
luaC_checkGC();
break;
case CALLFUNC:
aux = *pc++; goto callfunc;
case CALLFUNC0: case CALLFUNC1:
aux -= CALLFUNC0;
callfunc: {
StkId newBase = (S->top-S->stack)-(*pc++);
luaD_call(newBase, aux);
break;
}
case ENDCODE:
S->top = S->stack + base;
/* goes through */
case RETCODE:
if (lua_callhook)
luaD_callHook(base, NULL, 1);
return (base + ((aux==RETCODE) ? *pc : 0));
case SETLINEW:
aux = next_word(pc); goto setline;
case SETLINE:
aux = *pc++;
setline:
if ((S->stack+base-1)->ttype != LUA_T_LINE) {
/* open space for LINE value */
luaD_openstack((S->top-S->stack)-base);
base++;
(S->stack+base-1)->ttype = LUA_T_LINE;
}
(S->stack+base-1)->value.i = aux;
if (lua_linehook)
luaD_lineHook(aux);
break;
#ifdef DEBUG
default:
lua_error("internal error - opcode doesn't match");
#endif
}
}
}

29
lvm.h Normal file
View File

@@ -0,0 +1,29 @@
/*
** $Id: lvm.h,v 1.3 1997/10/16 10:59:34 roberto Exp roberto $
** Lua virtual machine
** See Copyright Notice in lua.h
*/
#ifndef lvm_h
#define lvm_h
#include "ldo.h"
#include "lobject.h"
#define tonumber(o) ((ttype(o) != LUA_T_NUMBER) && (luaV_tonumber(o) != 0))
#define tostring(o) ((ttype(o) != LUA_T_STRING) && (luaV_tostring(o) != 0))
void luaV_pack (StkId firstel, int nvararg, TObject *tab);
int luaV_tonumber (TObject *obj);
int luaV_tostring (TObject *obj);
void luaV_gettable (void);
void luaV_settable (TObject *t, int mode);
void luaV_getglobal (TaggedString *ts);
void luaV_setglobal (TaggedString *ts);
StkId luaV_execute (Closure *cl, TProtoFunc *tf, StkId base);
void luaV_closure (int nelems);
#endif

View File

@@ -1,43 +1,47 @@
/*
* zio.c
* a generic input stream interface
* $Id: zio.c,v 1.1 1997/06/16 16:50:22 roberto Exp roberto $
** $Id: lzio.c,v 1.2 1997/11/21 19:00:46 roberto Exp roberto $
** a generic input stream interface
** See Copyright Notice in lua.h
*/
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "zio.h"
#include "lzio.h"
/* ----------------------------------------------------- memory buffers --- */
static int zmfilbuf(ZIO* z)
static int zmfilbuf (ZIO* z)
{
return EOZ;
}
ZIO* zmopen(ZIO* z, char* b, int size)
ZIO* zmopen (ZIO* z, char* b, int size, char *name)
{
if (b==NULL) return NULL;
z->n=size;
z->p= (unsigned char *)b;
z->filbuf=zmfilbuf;
z->u=NULL;
z->name=name;
return z;
}
/* ------------------------------------------------------------ strings --- */
ZIO* zsopen(ZIO* z, char* s)
ZIO* zsopen (ZIO* z, char* s, char *name)
{
if (s==NULL) return NULL;
return zmopen(z,s,strlen(s));
return zmopen(z,s,strlen(s),name);
}
/* -------------------------------------------------------------- FILEs --- */
static int zffilbuf(ZIO* z)
static int zffilbuf (ZIO* z)
{
int n=fread(z->buffer,1,ZBSIZE,z->u);
if (n==0) return EOZ;
@@ -47,19 +51,20 @@ static int zffilbuf(ZIO* z)
}
ZIO* zFopen(ZIO* z, FILE* f)
ZIO* zFopen (ZIO* z, FILE* f, char *name)
{
if (f==NULL) return NULL;
z->n=0;
z->p=z->buffer;
z->filbuf=zffilbuf;
z->u=f;
z->name=name;
return z;
}
/* --------------------------------------------------------------- read --- */
int zread(ZIO *z, void *b, int n)
int zread (ZIO *z, void *b, int n)
{
while (n) {
int m;

View File

@@ -1,11 +1,12 @@
/*
* zio.h
* a generic input stream interface
* $Id: zio.h,v 1.4 1997/06/19 18:55:28 roberto Exp roberto $
** $Id: lzio.h,v 1.3 1997/12/22 20:57:18 roberto Exp roberto $
** Buffered streams
** See Copyright Notice in lua.h
*/
#ifndef zio_h
#define zio_h
#ifndef lzio_h
#define lzio_h
#include <stdio.h>
@@ -21,15 +22,15 @@
typedef struct zio ZIO;
ZIO* zFopen(ZIO* z, FILE* f); /* open FILEs */
ZIO* zsopen(ZIO* z, char* s); /* string */
ZIO* zmopen(ZIO* z, char* b, int size); /* memory */
ZIO* zFopen (ZIO* z, FILE* f, char *name); /* open FILEs */
ZIO* zsopen (ZIO* z, char* s, char *name); /* string */
ZIO* zmopen (ZIO* z, char* b, int size, char *name); /* memory */
int zread(ZIO* z, void* b, int n); /* read next n bytes */
int zread (ZIO* z, void* b, int n); /* read next n bytes */
#define zgetc(z) (--(z)->n>=0 ? ((int)*(z)->p++): (z)->filbuf(z))
#define zungetc(z) (++(z)->n,--(z)->p)
#define zname(z) ((z)->name)
/* --------- Private Part ------------------ */
@@ -41,6 +42,7 @@ struct zio {
unsigned char* p; /* current position in buffer */
int (*filbuf)(ZIO* z);
void* u; /* additional data */
char *name;
unsigned char buffer[ZBSIZE]; /* buffer */
};

140
makefile
View File

@@ -1,21 +1,32 @@
# $Id: makefile,v 1.35 1997/06/16 16:50:22 roberto Exp roberto $
#
## $Id: makefile,v 1.9 1998/01/02 17:46:32 roberto Exp roberto $
## Makefile
## See Copyright Notice in lua.h
#
#configuration
#CONFIGURATION
# define (undefine) POPEN if your system (does not) support piped I/O
#
# define (undefine) _POSIX_SOURCE if your system is (not) POSIX compliant
#define (undefine) NOSTRERROR if your system does NOT have function "strerror"
# (although this is ANSI, SunOS does not comply; so, add "-DNOSTRERROR" on SunOS)
# define LUA_COMPAT2_5=0 if yous system does not need to be compatible with
#
# define (undefine) OLD_ANSI if your system does NOT have some new ANSI
# facilities (e.g. strerror, locale.h, memmove). Although they are ANSI,
# SunOS does not comply; so, add "-DOLD_ANSI" on SunOS
#
# define LUA_COMPAT2_5 if yous system does need to be compatible with
# version 2.5 (or older)
CONFIG = -DPOPEN -D_POSIX_SOURCE
#CONFIG = -DLUA_COMPAT2_5 -DOLD_ANSI -DDEBUG
# Compilation parameters
CC = gcc
CWARNS = -Wall -Wmissing-prototypes -Wshadow -pedantic -Wpointer-arith -Wcast-align -Waggregate-return
CFLAGS = $(CONFIG) $(CWARNS) -ansi -O2 -fomit-frame-pointer
CFLAGS = $(CONFIG) $(CWARNS) -ansi -O2
#CC = acc
#CFLAGS = -fast -I/usr/5include
AR = ar
ARFLAGS = rvl
@@ -23,24 +34,29 @@ ARFLAGS = rvl
# Aplication modules
LUAOBJS = \
parser.o \
lex.o \
opcode.o \
hash.o \
table.o \
inout.o \
tree.o \
fallback.o \
luamem.o \
func.o \
undump.o \
auxlib.o \
zio.o
lapi.o \
lauxlib.o \
lbuffer.o \
lbuiltin.o \
ldo.o \
lfunc.o \
lgc.o \
llex.o \
lmem.o \
lobject.o \
lstate.o \
lstx.o \
lstring.o \
ltable.o \
ltm.o \
lvm.o \
lundump.o \
lzio.o
LIBOBJS = \
iolib.o \
mathlib.o \
strlib.o
liolib.o \
lmathlib.o \
lstrlib.o
lua : lua.o liblua.a liblualib.a
@@ -57,19 +73,16 @@ liblualib.a : $(LIBOBJS)
liblua.so.1.0 : lua.o
ld -o liblua.so.1.0 $(LUAOBJS)
y.tab.c y.tab.h : lua.stx
yacc -d lua.stx
parser.c : y.tab.c
sed -e 's/yy/luaY_/g' -e 's/malloc\.h/stdlib\.h/g' y.tab.c > parser.c
parser.h : y.tab.h
sed -e 's/yy/luaY_/g' y.tab.h > parser.h
lstx.c lstx.h : lua.stx
bison -o lstx.c -p luaY_ -d lua.stx
# yacc -d lua.stx
# sed -e 's/yy/luaY_/g' -e 's/malloc\.h/stdlib\.h/g' y.tab.c > lstx.c
# sed -e 's/yy/luaY_/g' y.tab.h > lstx.h
clear :
rcsclean
rm -f *.o
rm -f parser.c parser.h y.tab.c y.tab.h
rm -f lstx.c lstx.h
co lua.h lualib.h luadebug.h
@@ -79,33 +92,34 @@ clear :
%.c : RCS/%.c,v
co $@
auxlib.o: auxlib.c lua.h auxlib.h luadebug.h
fallback.o: fallback.c auxlib.h lua.h luamem.h fallback.h opcode.h \
types.h tree.h func.h table.h hash.h
func.o: func.c luadebug.h lua.h table.h tree.h types.h opcode.h func.h \
luamem.h
hash.o: hash.c luamem.h opcode.h lua.h types.h tree.h func.h hash.h \
table.h auxlib.h
inout.o: inout.c auxlib.h lua.h fallback.h opcode.h types.h tree.h \
func.h hash.h inout.h lex.h zio.h luamem.h table.h undump.h
iolib.o: iolib.c lua.h auxlib.h luadebug.h lualib.h
lex.o: lex.c auxlib.h lua.h luamem.h tree.h types.h table.h opcode.h \
func.h lex.h zio.h inout.h luadebug.h parser.h
lua.o: lua.c lua.h auxlib.h lualib.h
luamem.o: luamem.c luamem.h lua.h
mathlib.o: mathlib.c lualib.h lua.h auxlib.h
opcode.o: opcode.c luadebug.h lua.h luamem.h opcode.h types.h tree.h \
func.h hash.h inout.h table.h fallback.h auxlib.h lex.h zio.h
parser.o: parser.c luadebug.h lua.h luamem.h lex.h zio.h opcode.h \
types.h tree.h func.h hash.h inout.h table.h
strlib.o: strlib.c lua.h auxlib.h lualib.h
table.o: table.c luamem.h auxlib.h lua.h func.h types.h tree.h \
opcode.h hash.h table.h inout.h fallback.h luadebug.h
tree.o: tree.c luamem.h lua.h tree.h types.h lex.h zio.h hash.h \
opcode.h func.h table.h fallback.h
undump.o: undump.c auxlib.h lua.h opcode.h types.h tree.h func.h \
luamem.h table.h undump.h zio.h
y.tab.o: y.tab.c luadebug.h lua.h luamem.h lex.h zio.h opcode.h \
types.h tree.h func.h hash.h inout.h table.h
zio.o: zio.c zio.h
lapi.o: lapi.c lapi.h lua.h lobject.h lauxlib.h ldo.h lstate.h lfunc.h \
lgc.h lmem.h lstring.h ltable.h ltm.h luadebug.h lvm.h
lauxlib.o: lauxlib.c lauxlib.h lua.h luadebug.h
lbuffer.o: lbuffer.c lauxlib.h lua.h lmem.h lstate.h lobject.h
lbuiltin.o: lbuiltin.c lapi.h lua.h lobject.h lauxlib.h lbuiltin.h \
ldo.h lstate.h lfunc.h lmem.h lstring.h ltable.h ltm.h
ldo.o: ldo.c ldo.h lobject.h lua.h lstate.h lfunc.h lgc.h lmem.h \
lparser.h lzio.h ltm.h luadebug.h lundump.h lvm.h
lfunc.o: lfunc.c lfunc.h lobject.h lua.h lmem.h lstate.h
lgc.o: lgc.c ldo.h lobject.h lua.h lstate.h lfunc.h lgc.h lmem.h \
lstring.h ltable.h ltm.h
liolib.o: liolib.c lauxlib.h lua.h luadebug.h lualib.h
llex.o: llex.c lauxlib.h lua.h llex.h lobject.h lzio.h lmem.h \
lparser.h lstate.h lstring.h lstx.h luadebug.h
lmathlib.o: lmathlib.c lauxlib.h lua.h lualib.h
lmem.o: lmem.c lmem.h lstate.h lobject.h lua.h
lobject.o: lobject.c lobject.h lua.h
lstate.o: lstate.c lbuiltin.h ldo.h lobject.h lua.h lstate.h lfunc.h \
lgc.h llex.h lzio.h lmem.h lstring.h ltable.h ltm.h
lstring.o: lstring.c lmem.h lobject.h lua.h lstate.h lstring.h
lstrlib.o: lstrlib.c lauxlib.h lua.h lualib.h
lstx.o: lstx.c lauxlib.h lua.h ldo.h lobject.h lstate.h lfunc.h llex.h \
lzio.h lmem.h lopcodes.h lparser.h lstring.h luadebug.h
ltable.o: ltable.c lauxlib.h lua.h lmem.h lobject.h lstate.h ltable.h
ltm.o: ltm.c lauxlib.h lua.h lmem.h lobject.h lstate.h ltm.h lapi.h
lua.o: lua.c lua.h luadebug.h lualib.h
lundump.o: lundump.c lauxlib.h lua.h lfunc.h lobject.h lmem.h \
lstring.h lundump.h lzio.h
lvm.o: lvm.c lauxlib.h lua.h ldo.h lobject.h lstate.h lfunc.h lgc.h \
lmem.h lopcodes.h lstring.h ltable.h ltm.h luadebug.h lvm.h
lzio.o: lzio.c lzio.h

File diff suppressed because it is too large Load Diff

217
mathlib.c
View File

@@ -1,217 +0,0 @@
/*
** mathlib.c
** Mathematics library to LUA
*/
char *rcs_mathlib="$Id: mathlib.c,v 1.24 1997/06/09 17:30:10 roberto Exp roberto $";
#include <stdlib.h>
#include <math.h>
#include "lualib.h"
#include "auxlib.h"
#include "lua.h"
#ifndef PI
#define PI 3.14159265358979323846
#endif
#define TODEGREE(a) ((a)*180.0/PI)
#define TORAD(a) ((a)*PI/180.0)
static void math_abs (void)
{
double d = luaL_check_number(1);
if (d < 0) d = -d;
lua_pushnumber (d);
}
static void math_sin (void)
{
double d = luaL_check_number(1);
lua_pushnumber (sin(TORAD(d)));
}
static void math_cos (void)
{
double d = luaL_check_number(1);
lua_pushnumber (cos(TORAD(d)));
}
static void math_tan (void)
{
double d = luaL_check_number(1);
lua_pushnumber (tan(TORAD(d)));
}
static void math_asin (void)
{
double d = luaL_check_number(1);
lua_pushnumber (TODEGREE(asin(d)));
}
static void math_acos (void)
{
double d = luaL_check_number(1);
lua_pushnumber (TODEGREE(acos(d)));
}
static void math_atan (void)
{
double d = luaL_check_number(1);
lua_pushnumber (TODEGREE(atan(d)));
}
static void math_atan2 (void)
{
double d1 = luaL_check_number(1);
double d2 = luaL_check_number(2);
lua_pushnumber (TODEGREE(atan2(d1, d2)));
}
static void math_ceil (void)
{
double d = luaL_check_number(1);
lua_pushnumber (ceil(d));
}
static void math_floor (void)
{
double d = luaL_check_number(1);
lua_pushnumber (floor(d));
}
static void math_mod (void)
{
float x = luaL_check_number(1);
float y = luaL_check_number(2);
lua_pushnumber(fmod(x, y));
}
static void math_sqrt (void)
{
double d = luaL_check_number(1);
lua_pushnumber (sqrt(d));
}
static void math_pow (void)
{
double d1 = luaL_check_number(1);
double d2 = luaL_check_number(2);
lua_pushnumber(pow(d1,d2));
}
static void math_min (void)
{
int i=1;
double dmin = luaL_check_number(i);
while (lua_getparam(++i) != LUA_NOOBJECT)
{
double d = luaL_check_number(i);
if (d < dmin) dmin = d;
}
lua_pushnumber (dmin);
}
static void math_max (void)
{
int i=1;
double dmax = luaL_check_number(i);
while (lua_getparam(++i) != LUA_NOOBJECT)
{
double d = luaL_check_number(i);
if (d > dmax) dmax = d;
}
lua_pushnumber (dmax);
}
static void math_log (void)
{
double d = luaL_check_number(1);
lua_pushnumber (log(d));
}
static void math_log10 (void)
{
double d = luaL_check_number(1);
lua_pushnumber (log10(d));
}
static void math_exp (void)
{
double d = luaL_check_number(1);
lua_pushnumber (exp(d));
}
static void math_deg (void)
{
float d = luaL_check_number(1);
lua_pushnumber (d*180./PI);
}
static void math_rad (void)
{
float d = luaL_check_number(1);
lua_pushnumber (d/180.*PI);
}
static void math_random (void)
{
lua_pushnumber((double)(rand()%RAND_MAX) / (double)RAND_MAX);
}
static void math_randomseed (void)
{
srand(luaL_check_number(1));
}
static struct luaL_reg mathlib[] = {
{"abs", math_abs},
{"sin", math_sin},
{"cos", math_cos},
{"tan", math_tan},
{"asin", math_asin},
{"acos", math_acos},
{"atan", math_atan},
{"atan2", math_atan2},
{"ceil", math_ceil},
{"floor", math_floor},
{"mod", math_mod},
{"sqrt", math_sqrt},
{"min", math_min},
{"max", math_max},
{"log", math_log},
{"log10", math_log10},
{"exp", math_exp},
{"deg", math_deg},
{"rad", math_rad},
{"random", math_random},
{"randomseed", math_randomseed}
};
/*
** Open math library
*/
void mathlib_open (void)
{
luaL_openlib(mathlib, (sizeof(mathlib)/sizeof(mathlib[0])));
lua_pushcfunction(math_pow);
lua_pushnumber(0); /* to get its tag */
lua_settagmethod(lua_tag(lua_pop()), "pow");
}

View File

@@ -1,13 +0,0 @@
/*
** Math library to LUA
** TeCGraf - PUC-Rio
** $Id: $
*/
#ifndef strlib_h
void mathlib_open (void);
#endif

1478
opcode.c

File diff suppressed because it is too large Load Diff

171
opcode.h
View File

@@ -1,171 +0,0 @@
/*
** TeCGraf - PUC-Rio
** $Id: opcode.h,v 3.33 1997/04/11 21:34:53 roberto Exp roberto $
*/
#ifndef opcode_h
#define opcode_h
#include "lua.h"
#include "types.h"
#include "tree.h"
#include "func.h"
#define FIELDS_PER_FLUSH 40
/*
* WARNING: if you change the order of this enumeration,
* grep "ORDER LUA_T"
*/
typedef enum
{
LUA_T_NIL = -9,
LUA_T_NUMBER = -8,
LUA_T_STRING = -7,
LUA_T_ARRAY = -6, /* array==table */
LUA_T_FUNCTION = -5,
LUA_T_CFUNCTION= -4,
LUA_T_MARK = -3,
LUA_T_CMARK = -2,
LUA_T_LINE = -1,
LUA_T_USERDATA = 0
} lua_Type;
#define NUM_TYPES 10
extern char *luaI_typenames[];
typedef enum {
/* name parm before after side effect
-----------------------------------------------------------------------------*/
PUSHNIL,/* - nil */
PUSH0,/* - 0.0 */
PUSH1,/* - 1.0 */
PUSH2,/* - 2.0 */
PUSHBYTE,/* b - (float)b */
PUSHWORD,/* w - (float)w */
PUSHFLOAT,/* f - f */
PUSHSTRING,/* w - STR[w] */
PUSHFUNCTION,/* p - FUN(p) */
PUSHLOCAL0,/* - LOC[0] */
PUSHLOCAL1,/* - LOC[1] */
PUSHLOCAL2,/* - LOC[2] */
PUSHLOCAL3,/* - LOC[3] */
PUSHLOCAL4,/* - LOC[4] */
PUSHLOCAL5,/* - LOC[5] */
PUSHLOCAL6,/* - LOC[6] */
PUSHLOCAL7,/* - LOC[7] */
PUSHLOCAL8,/* - LOC[8] */
PUSHLOCAL9,/* - LOC[9] */
PUSHLOCAL,/* b - LOC[b] */
PUSHGLOBAL,/* w - VAR[w] */
PUSHINDEXED,/* i t t[i] */
PUSHSELF,/* w t t t[STR[w]] */
STORELOCAL0,/* x - LOC[0]=x */
STORELOCAL1,/* x - LOC[1]=x */
STORELOCAL2,/* x - LOC[2]=x */
STORELOCAL3,/* x - LOC[3]=x */
STORELOCAL4,/* x - LOC[4]=x */
STORELOCAL5,/* x - LOC[5]=x */
STORELOCAL6,/* x - LOC[6]=x */
STORELOCAL7,/* x - LOC[7]=x */
STORELOCAL8,/* x - LOC[8]=x */
STORELOCAL9,/* x - LOC[9]=x */
STORELOCAL,/* b x - LOC[b]=x */
STOREGLOBAL,/* w x - VAR[w]=x */
STOREINDEXED0,/* v i t - t[i]=v */
STOREINDEXED,/* b v a_b...a_1 i t a_b...a_1 i t t[i]=v */
STORELIST0,/* b v_b...v_1 t - t[i]=v_i */
STORELIST,/* b c v_b...v_1 t - t[i+c*FPF]=v_i */
STORERECORD,/* b
w_b...w_1 v_b...v_1 t - t[STR[w_i]]=v_i */
ADJUST0,/* - - TOP=BASE */
ADJUST,/* b - - TOP=BASE+b */
CREATEARRAY,/* w - newarray(size = w) */
EQOP,/* y x (x==y)? 1 : nil */
LTOP,/* y x (x<y)? 1 : nil */
LEOP,/* y x (x<y)? 1 : nil */
GTOP,/* y x (x>y)? 1 : nil */
GEOP,/* y x (x>=y)? 1 : nil */
ADDOP,/* y x x+y */
SUBOP,/* y x x-y */
MULTOP,/* y x x*y */
DIVOP,/* y x x/y */
POWOP,/* y x x^y */
CONCOP,/* y x x..y */
MINUSOP,/* x -x */
NOTOP,/* x (x==nil)? 1 : nil */
ONTJMP,/* w x - (x!=nil)? PC+=w */
ONFJMP,/* w x - (x==nil)? PC+=w */
JMP,/* w - - PC+=w */
UPJMP,/* w - - PC-=w */
IFFJMP,/* w x - (x==nil)? PC+=w */
IFFUPJMP,/* w x - (x==nil)? PC-=w */
POP,/* x - */
CALLFUNC,/* b c v_b...v_1 f r_c...r_1 f(v1,...,v_b) */
RETCODE0,
RETCODE,/* b - - */
SETLINE,/* w - - LINE=w */
VARARGS,/* b v_b...v_1 {v_1...v_b;n=b} */
STOREMAP/* b v_b k_b ...v_1 k_1 t - t[k_i]=v_i */
} OpCode;
#define MULT_RET 255
typedef union
{
lua_CFunction f;
real n;
TaggedString *ts;
TFunc *tf;
struct Hash *a;
int i;
} Value;
typedef struct TObject
{
lua_Type ttype;
Value value;
} TObject;
/* Macros to access structure members */
#define ttype(o) ((o)->ttype)
#define nvalue(o) ((o)->value.n)
#define svalue(o) ((o)->value.ts->str)
#define tsvalue(o) ((o)->value.ts)
#define avalue(o) ((o)->value.a)
#define fvalue(o) ((o)->value.f)
/* Macros to access symbol table */
#define s_object(i) (lua_table[i].object)
#define s_ttype(i) (ttype(&s_object(i)))
#define s_nvalue(i) (nvalue(&s_object(i)))
#define s_svalue(i) (svalue(&s_object(i)))
#define s_tsvalue(i) (tsvalue(&s_object(i)))
#define s_avalue(i) (avalue(&s_object(i)))
#define s_fvalue(i) (fvalue(&s_object(i)))
#define s_uvalue(i) (uvalue(&s_object(i)))
#define get_word(code,pc) {memcpy(&code, pc, sizeof(Word)); pc+=sizeof(Word);}
#define get_float(code,pc){memcpy(&code, pc, sizeof(real)); pc+=sizeof(real);}
#define get_code(code,pc) {memcpy(&code, pc, sizeof(TFunc *)); \
pc+=sizeof(TFunc *);}
/* Exported functions */
void lua_parse (TFunc *tf); /* from "lua.stx" module */
void luaI_codedebugline (int line); /* from "lua.stx" module */
void lua_travstack (int (*fn)(TObject *));
TObject *luaI_Address (lua_Object o);
void luaI_pushobject (TObject *o);
void luaI_gcIM (TObject *o);
int luaI_dorun (TFunc *tf);
int lua_domain (void);
#endif

535
strlib.c
View File

@@ -1,535 +0,0 @@
/*
** strlib.c
** String library to LUA
*/
char *rcs_strlib="$Id: strlib.c,v 1.45 1997/06/19 17:45:28 roberto Exp roberto $";
#include <string.h>
#include <stdio.h>
#include <stdlib.h>
#include <ctype.h>
#include "lua.h"
#include "auxlib.h"
#include "lualib.h"
struct lbuff {
char *b;
size_t max;
size_t size;
};
static struct lbuff lbuffer = {NULL, 0, 0};
static char *strbuffer (unsigned long size)
{
if (size > lbuffer.max) {
/* ANSI "realloc" doesn't need this test, but some machines (Sun!)
don't follow ANSI */
lbuffer.b = (lbuffer.b) ? realloc(lbuffer.b, lbuffer.max=size) :
malloc(lbuffer.max=size);
if (lbuffer.b == NULL)
lua_error("memory overflow");
}
return lbuffer.b;
}
static char *openspace (unsigned long size)
{
char *buff = strbuffer(lbuffer.size+size);
return buff+lbuffer.size;
}
char *luaI_addchar (int c)
{
if (lbuffer.size >= lbuffer.max)
strbuffer(lbuffer.max == 0 ? 100 : lbuffer.max*2);
lbuffer.b[lbuffer.size++] = c;
return lbuffer.b;
}
void luaI_emptybuff (void)
{
lbuffer.size = 0; /* prepare for next string */
}
static void addnchar (char *s, int n)
{
char *b = openspace(n);
strncpy(b, s, n);
lbuffer.size += n;
}
static void addstr (char *s)
{
addnchar(s, strlen(s));
}
/*
** Return the string length
*/
static void str_len (void)
{
lua_pushnumber(strlen(luaL_check_string(1)));
}
/*
** Return the substring of a string
*/
static void str_sub (void)
{
char *s = luaL_check_string(1);
long l = strlen(s);
long start = (long)luaL_check_number(2);
long end = (long)luaL_opt_number(3, -1);
if (start < 0) start = l+start+1;
if (end < 0) end = l+end+1;
if (1 <= start && start <= end && end <= l) {
luaI_emptybuff();
addnchar(s+start-1, end-start+1);
lua_pushstring(luaI_addchar(0));
}
else lua_pushstring("");
}
/*
** Convert a string to lower case.
*/
static void str_lower (void)
{
char *s;
luaI_emptybuff();
for (s = luaL_check_string(1); *s; s++)
luaI_addchar(tolower((unsigned char)*s));
lua_pushstring(luaI_addchar(0));
}
/*
** Convert a string to upper case.
*/
static void str_upper (void)
{
char *s;
luaI_emptybuff();
for (s = luaL_check_string(1); *s; s++)
luaI_addchar(toupper((unsigned char)*s));
lua_pushstring(luaI_addchar(0));
}
static void str_rep (void)
{
char *s = luaL_check_string(1);
int n = (int)luaL_check_number(2);
luaI_emptybuff();
while (n-- > 0)
addstr(s);
lua_pushstring(luaI_addchar(0));
}
/*
** get ascii value of a character in a string
*/
static void str_ascii (void)
{
char *s = luaL_check_string(1);
long pos = (long)luaL_opt_number(2, 1) - 1;
luaL_arg_check(0<=pos && pos<strlen(s), 2, "out of range");
lua_pushnumber((unsigned char)s[pos]);
}
/* pattern matching */
#define ESC '%'
#define SPECIALS "^$*?.([%-"
static char *bracket_end (char *p)
{
return (*p == 0) ? NULL : strchr((*p=='^') ? p+2 : p+1, ']');
}
char *luaL_item_end (char *p)
{
switch (*p++) {
case '\0': return p-1;
case ESC:
if (*p == 0) luaL_verror("incorrect pattern (ends with `%c')", ESC);
return p+1;
case '[': {
char *end = bracket_end(p);
if (end == NULL) lua_error("incorrect pattern (missing `]')");
return end+1;
}
default:
return p;
}
}
static int matchclass (int c, int cl)
{
int res;
switch (tolower((unsigned char)cl)) {
case 'a' : res = isalpha((unsigned char)c); break;
case 'c' : res = iscntrl((unsigned char)c); break;
case 'd' : res = isdigit((unsigned char)c); break;
case 'l' : res = islower((unsigned char)c); break;
case 'p' : res = ispunct((unsigned char)c); break;
case 's' : res = isspace((unsigned char)c); break;
case 'u' : res = isupper((unsigned char)c); break;
case 'w' : res = isalnum((unsigned char)c); break;
default: return (cl == c);
}
return (islower((unsigned char)cl) ? res : !res);
}
int luaL_singlematch (int c, char *p)
{
if (c == 0) return 0;
switch (*p) {
case '.': return 1;
case ESC: return matchclass(c, *(p+1));
case '[': {
char *end = bracket_end(p+1);
int sig = *(p+1) == '^' ? (p++, 0) : 1;
while (++p < end) {
if (*p == ESC) {
if (((p+1) < end) && matchclass(c, *++p)) return sig;
}
else if ((*(p+1) == '-') && (p+2 < end)) {
p+=2;
if (*(p-2) <= c && c <= *p) return sig;
}
else if (*p == c) return sig;
}
return !sig;
}
default: return (*p == c);
}
}
#define MAX_CAPT 9
static struct {
char *init;
int len; /* -1 signals unfinished capture */
} capture[MAX_CAPT];
static int num_captures; /* only valid after a sucessful call to match */
static void push_captures (void)
{
int i;
for (i=0; i<num_captures; i++) {
int l = capture[i].len;
char *buff = openspace(l+1);
if (l == -1) lua_error("unfinished capture");
strncpy(buff, capture[i].init, l);
buff[l] = 0;
lua_pushstring(buff);
}
}
static int check_cap (int l, int level)
{
l -= '1';
if (!(0 <= l && l < level && capture[l].len != -1))
lua_error("invalid capture index");
return l;
}
static int capture_to_close (int level)
{
for (level--; level>=0; level--)
if (capture[level].len == -1) return level;
lua_error("invalid pattern capture");
return 0; /* to avoid warnings */
}
static char *matchbalance (char *s, int b, int e)
{
if (*s != b) return NULL;
else {
int cont = 1;
while (*(++s)) {
if (*s == e) {
if (--cont == 0) return s+1;
}
else if (*s == b) cont++;
}
}
return NULL; /* string ends out of balance */
}
static char *match (char *s, char *p, int level)
{
init: /* using goto's to optimize tail recursion */
switch (*p) {
case '(': /* start capture */
if (level >= MAX_CAPT) lua_error("too many captures");
capture[level].init = s;
capture[level].len = -1;
level++; p++; goto init; /* return match(s, p+1, level); */
case ')': { /* end capture */
int l = capture_to_close(level);
char *res;
capture[l].len = s - capture[l].init; /* close capture */
if ((res = match(s, p+1, level)) == NULL) /* match failed? */
capture[l].len = -1; /* undo capture */
return res;
}
case ESC:
if (isdigit((unsigned char)(*(p+1)))) { /* capture */
int l = check_cap(*(p+1), level);
if (strncmp(capture[l].init, s, capture[l].len) == 0) {
/* return match(p+2, s+capture[l].len, level); */
p+=2; s+=capture[l].len; goto init;
}
else return NULL;
}
else if (*(p+1) == 'b') { /* balanced string */
if (*(p+2) == 0 || *(p+3) == 0)
lua_error("bad balanced pattern specification");
s = matchbalance(s, *(p+2), *(p+3));
if (s == NULL) return NULL;
else { /* return match(p+4, s, level); */
p+=4; goto init;
}
}
else goto dflt;
case '\0': case '$': /* (possibly) end of pattern */
if (*p == 0 || (*(p+1) == 0 && *s == 0)) {
num_captures = level;
return s;
}
else goto dflt;
default: dflt: { /* it is a pattern item */
int m = luaL_singlematch(*s, p);
char *ep = luaL_item_end(p); /* get what is next */
switch (*ep) {
case '*': { /* repetition */
char *res;
if (m && (res = match(s+1, p, level)))
return res;
p=ep+1; goto init; /* else return match(s, ep+1, level); */
}
case '-': { /* repetition */
char *res;
if ((res = match(s, ep+1, level)) != 0)
return res;
else if (m) {
s++;
goto init; /* return match(s+1, p, level); */
}
else
return NULL;
}
case '?': { /* optional */
char *res;
if (m && (res = match(s+1, ep+1, level)))
return res;
p=ep+1; goto init; /* else return match(s, ep+1, level); */
}
default:
if (m) { s++; p=ep; goto init; } /* return match(s+1, ep, level); */
else return NULL;
}
}
}
}
static void str_find (void)
{
char *s = luaL_check_string(1);
char *p = luaL_check_string(2);
long init = (long)luaL_opt_number(3, 1) - 1;
luaL_arg_check(0 <= init && init <= strlen(s), 3, "out of range");
if (lua_getparam(4) != LUA_NOOBJECT ||
strpbrk(p, SPECIALS) == NULL) { /* no special caracters? */
char *s2 = strstr(s+init, p);
if (s2) {
lua_pushnumber(s2-s+1);
lua_pushnumber(s2-s+strlen(p));
}
}
else {
int anchor = (*p == '^') ? (p++, 1) : 0;
char *s1=s+init;
do {
char *res;
if ((res=match(s1, p, 0)) != NULL) {
lua_pushnumber(s1-s+1); /* start */
lua_pushnumber(res-s); /* end */
push_captures();
return;
}
} while (*s1++ && !anchor);
}
}
static void add_s (lua_Object newp, lua_Object table, int n)
{
if (lua_isstring(newp)) {
char *news = lua_getstring(newp);
while (*news) {
if (*news != ESC || !isdigit((unsigned char)*++news))
luaI_addchar(*news++);
else {
int l = check_cap(*news++, num_captures);
addnchar(capture[l].init, capture[l].len);
}
}
}
else if (lua_isfunction(newp)) {
lua_Object res;
struct lbuff oldbuff;
int status;
lua_beginblock();
if (lua_istable(table)) {
lua_pushobject(table);
lua_pushnumber(n);
}
push_captures();
/* function may use lbuffer, so save it and create a new one */
oldbuff = lbuffer;
lbuffer.b = NULL; lbuffer.max = lbuffer.size = 0;
status = lua_callfunction(newp);
/* restore old buffer */
free(lbuffer.b);
lbuffer = oldbuff;
if (status != 0)
lua_error(NULL);
res = lua_getresult(1);
addstr(lua_isstring(res) ? lua_getstring(res) : "");
lua_endblock();
}
else luaL_arg_check(0, 3, NULL);
}
static void str_gsub (void)
{
char *src = luaL_check_string(1);
char *p = luaL_check_string(2);
lua_Object newp = lua_getparam(3);
lua_Object table = lua_getparam(4);
int max_s = (int)luaL_opt_number(lua_istable(table)?5:4, strlen(src)+1);
int anchor = (*p == '^') ? (p++, 1) : 0;
int n = 0;
luaI_emptybuff();
while (n < max_s) {
char *e = match(src, p, 0);
if (e) {
n++;
add_s(newp, table, n);
}
if (e && e>src) /* non empty match? */
src = e; /* skip it */
else if (*src)
luaI_addchar(*src++);
else break;
if (anchor) break;
}
addstr(src);
lua_pushstring(luaI_addchar(0));
lua_pushnumber(n); /* number of substitutions */
}
static void str_set (void)
{
char *item = luaL_check_string(1);
int i;
luaL_arg_check(*luaL_item_end(item) == 0, 1, "wrong format");
luaI_emptybuff();
for (i=1; i<256; i++) /* 0 cannot be part of a set */
if (luaL_singlematch(i, item))
luaI_addchar(i);
lua_pushstring(luaI_addchar(0));
}
void luaI_addquoted (char *s)
{
luaI_addchar('"');
for (; *s; s++) {
if (strchr("\"\\\n", *s))
luaI_addchar('\\');
luaI_addchar(*s);
}
luaI_addchar('"');
}
#define MAX_FORMAT 200
static void str_format (void)
{
int arg = 1;
char *strfrmt = luaL_check_string(arg++);
luaI_emptybuff(); /* initialize */
while (*strfrmt) {
if (*strfrmt != '%')
luaI_addchar(*strfrmt++);
else if (*++strfrmt == '%')
luaI_addchar(*strfrmt++); /* %% */
else { /* format item */
char form[MAX_FORMAT]; /* store the format ('%...') */
char *buff;
char *initf = strfrmt-1; /* -1 to include % */
strfrmt = match(strfrmt, "[-+ #]*(%d*)%.?(%d*)", 0);
if (capture[0].len > 3 || capture[1].len > 3) /* < 1000? */
lua_error("invalid format (width or precision too long)");
strncpy(form, initf, strfrmt-initf+1); /* +1 to include convertion */
form[strfrmt-initf+1] = 0;
buff = openspace(1000); /* to store the formated value */
switch (*strfrmt++) {
case 'q':
luaI_addquoted(luaL_check_string(arg++));
continue;
case 's': {
char *s = luaL_check_string(arg++);
buff = openspace(strlen(s));
sprintf(buff, form, s);
break;
}
case 'c': case 'd': case 'i': case 'o':
case 'u': case 'x': case 'X':
sprintf(buff, form, (int)luaL_check_number(arg++));
break;
case 'e': case 'E': case 'f': case 'g':
sprintf(buff, form, luaL_check_number(arg++));
break;
default: /* also treat cases 'pnLlh' */
lua_error("invalid format option in function `format'");
}
lbuffer.size += strlen(buff);
}
}
lua_pushstring(luaI_addchar(0)); /* push the result */
}
static struct luaL_reg strlib[] = {
{"strlen", str_len},
{"strsub", str_sub},
{"strset", str_set},
{"strlower", str_lower},
{"strupper", str_upper},
{"strrep", str_rep},
{"ascii", str_ascii},
{"format", str_format},
{"strfind", str_find},
{"gsub", str_gsub}
};
/*
** Open string library
*/
void strlib_open (void)
{
luaL_openlib(strlib, (sizeof(strlib)/sizeof(strlib[0])));
}

View File

@@ -1,13 +0,0 @@
/*
** String library to LUA
** TeCGraf - PUC-Rio
** $Id: $
*/
#ifndef strlib_h
void strlib_open (void);
#endif

266
table.c
View File

@@ -1,266 +0,0 @@
/*
** table.c
** Module to control static tables
*/
char *rcs_table="$Id: table.c,v 2.71 1997/06/09 17:28:14 roberto Exp roberto $";
#include "luamem.h"
#include "auxlib.h"
#include "func.h"
#include "opcode.h"
#include "tree.h"
#include "hash.h"
#include "table.h"
#include "inout.h"
#include "lua.h"
#include "fallback.h"
#include "luadebug.h"
#define BUFFER_BLOCK 256
Symbol *lua_table = NULL;
Word lua_ntable = 0;
static Long lua_maxsymbol = 0;
TaggedString **lua_constant = NULL;
Word lua_nconstant = 0;
static Long lua_maxconstant = 0;
#define GARBAGE_BLOCK 100
void luaI_initsymbol (void)
{
lua_maxsymbol = BUFFER_BLOCK;
lua_table = newvector(lua_maxsymbol, Symbol);
luaI_predefine();
}
/*
** Initialise constant table with pre-defined constants
*/
void luaI_initconstant (void)
{
lua_maxconstant = BUFFER_BLOCK;
lua_constant = newvector(lua_maxconstant, TaggedString *);
/* pre-register mem error messages, to avoid loop when error arises */
luaI_findconstantbyname(tableEM);
luaI_findconstantbyname(memEM);
}
/*
** Given a name, search it at symbol table and return its index. If not
** found, allocate it.
*/
Word luaI_findsymbol (TaggedString *t)
{
if (t->u.s.varindex == NOT_USED)
{
if (lua_ntable == lua_maxsymbol)
lua_maxsymbol = growvector(&lua_table, lua_maxsymbol, Symbol,
symbolEM, MAX_WORD);
t->u.s.varindex = lua_ntable;
lua_table[lua_ntable].varname = t;
s_ttype(lua_ntable) = LUA_T_NIL;
lua_ntable++;
}
return t->u.s.varindex;
}
Word luaI_findsymbolbyname (char *name)
{
return luaI_findsymbol(luaI_createfixedstring(name));
}
/*
** Given a tree node, check it is has a correspondent constant index. If not,
** allocate it.
*/
Word luaI_findconstant (TaggedString *t)
{
if (t->u.s.constindex == NOT_USED)
{
if (lua_nconstant == lua_maxconstant)
lua_maxconstant = growvector(&lua_constant, lua_maxconstant, TaggedString *,
constantEM, MAX_WORD);
t->u.s.constindex = lua_nconstant;
lua_constant[lua_nconstant] = t;
lua_nconstant++;
}
return t->u.s.constindex;
}
Word luaI_findconstantbyname (char *name)
{
return luaI_findconstant(luaI_createfixedstring(name));
}
TaggedString *luaI_createfixedstring (char *name)
{
TaggedString *ts = lua_createstring(name);
if (!ts->marked)
ts->marked = 2; /* avoid GC */
return ts;
}
int luaI_globaldefined (char *name)
{
return ttype(&lua_table[luaI_findsymbolbyname(name)].object) != LUA_T_NIL;
}
/*
** Traverse symbol table objects
*/
static char *lua_travsymbol (int (*fn)(TObject *))
{
Word i;
for (i=0; i<lua_ntable; i++)
if (fn(&s_object(i)))
return lua_table[i].varname->str;
return NULL;
}
/*
** Mark an object if it is a string or a unmarked array.
*/
int lua_markobject (TObject *o)
{/* if already marked, does not change mark value */
if (ttype(o) == LUA_T_USERDATA ||
(ttype(o) == LUA_T_STRING && !tsvalue(o)->marked))
tsvalue(o)->marked = 1;
else if (ttype(o) == LUA_T_ARRAY)
lua_hashmark (avalue(o));
else if ((o->ttype == LUA_T_FUNCTION || o->ttype == LUA_T_MARK)
&& !o->value.tf->marked)
o->value.tf->marked = 1;
return 0;
}
/*
* returns 0 if the object is going to be (garbage) collected
*/
int luaI_ismarked (TObject *o)
{
switch (o->ttype)
{
case LUA_T_STRING: case LUA_T_USERDATA:
return o->value.ts->marked;
case LUA_T_FUNCTION:
return o->value.tf->marked;
case LUA_T_ARRAY:
return o->value.a->mark;
default: /* nil, number, cfunction, or user data */
return 1;
}
}
static void call_nilIM (void)
{ /* signals end of garbage collection */
TObject t;
ttype(&t) = LUA_T_NIL;
luaI_gcIM(&t); /* end of list */
}
/*
** Garbage collection.
** Delete all unused strings and arrays.
*/
static long gc_block = GARBAGE_BLOCK;
static long gc_nentity = 0; /* total of strings, arrays, etc */
static void markall (void)
{
lua_travstack(lua_markobject); /* mark stack objects */
lua_travsymbol(lua_markobject); /* mark symbol table objects */
luaI_travlock(lua_markobject); /* mark locked objects */
luaI_travfallbacks(lua_markobject); /* mark fallbacks */
}
long lua_collectgarbage (long limit)
{
long recovered = 0;
Hash *freetable;
TaggedString *freestr;
TFunc *freefunc;
markall();
luaI_invalidaterefs();
freetable = luaI_hashcollector(&recovered);
freestr = luaI_strcollector(&recovered);
freefunc = luaI_funccollector(&recovered);
gc_nentity -= recovered;
gc_block = (limit == 0) ? 2*(gc_block-recovered) : gc_nentity+limit;
luaI_hashcallIM(freetable);
luaI_strcallIM(freestr);
call_nilIM();
luaI_hashfree(freetable);
luaI_strfree(freestr);
luaI_funcfree(freefunc);
return recovered;
}
void lua_pack (void)
{
if (++gc_nentity >= gc_block)
lua_collectgarbage(0);
}
/*
** Internal function: return next global variable
*/
void luaI_nextvar (void)
{
Word next;
if (lua_isnil(lua_getparam(1)))
next = 0;
else
next = luaI_findsymbolbyname(luaL_check_string(1)) + 1;
while (next < lua_ntable && s_ttype(next) == LUA_T_NIL)
next++;
if (next < lua_ntable) {
lua_pushstring(lua_table[next].varname->str);
luaI_pushobject(&s_object(next));
}
}
static TObject *functofind;
static int checkfunc (TObject *o)
{
if (o->ttype == LUA_T_FUNCTION)
return
((functofind->ttype == LUA_T_FUNCTION || functofind->ttype == LUA_T_MARK)
&& (functofind->value.tf == o->value.tf));
if (o->ttype == LUA_T_CFUNCTION)
return
((functofind->ttype == LUA_T_CFUNCTION ||
functofind->ttype == LUA_T_CMARK) &&
(functofind->value.f == o->value.f));
return 0;
}
char *lua_getobjname (lua_Object o, char **name)
{ /* try to find a name for given function */
functofind = luaI_Address(o);
if ((*name = luaI_travfallbacks(checkfunc)) != NULL)
return "tag-method";
else if ((*name = lua_travsymbol(checkfunc)) != NULL)
return "global";
else return "";
}

39
table.h
View File

@@ -1,39 +0,0 @@
/*
** Module to control static tables
** TeCGraf - PUC-Rio
** $Id: table.h,v 2.24 1997/04/07 14:48:53 roberto Exp roberto $
*/
#ifndef table_h
#define table_h
#include "tree.h"
#include "opcode.h"
typedef struct
{
TObject object;
TaggedString *varname;
} Symbol;
extern Symbol *lua_table;
extern Word lua_ntable;
extern TaggedString **lua_constant;
extern Word lua_nconstant;
void luaI_initsymbol (void);
void luaI_initconstant (void);
Word luaI_findsymbolbyname (char *name);
Word luaI_findsymbol (TaggedString *t);
Word luaI_findconstant (TaggedString *t);
Word luaI_findconstantbyname (char *name);
int luaI_globaldefined (char *name);
void luaI_nextvar (void);
TaggedString *luaI_createfixedstring (char *str);
int lua_markobject (TObject *o);
int luaI_ismarked (TObject *o);
void lua_pack (void);
#endif

211
tree.c
View File

@@ -1,211 +0,0 @@
/*
** tree.c
** TecCGraf - PUC-Rio
*/
char *rcs_tree="$Id: tree.c,v 1.27 1997/06/09 17:28:14 roberto Exp roberto $";
#include <string.h>
#include "luamem.h"
#include "lua.h"
#include "tree.h"
#include "lex.h"
#include "hash.h"
#include "table.h"
#include "fallback.h"
#define NUM_HASHS 64
typedef struct {
int size;
int nuse; /* number of elements (including EMPTYs) */
TaggedString **hash;
} stringtable;
static int initialized = 0;
static stringtable string_root[NUM_HASHS];
static TaggedString EMPTY = {LUA_T_STRING, NULL, {{NOT_USED, NOT_USED}},
0, 2, {0}};
static unsigned long hash (char *s, int tag)
{
unsigned long h;
if (tag != LUA_T_STRING)
h = (unsigned long)s;
else {
h = 0;
while (*s)
h = ((h<<5)-h)^(unsigned char)*(s++);
}
return h;
}
static void luaI_inittree (void)
{
int i;
for (i=0; i<NUM_HASHS; i++) {
string_root[i].size = 0;
string_root[i].nuse = 0;
string_root[i].hash = NULL;
}
}
static void initialize (void)
{
initialized = 1;
luaI_inittree();
luaI_addReserved();
luaI_initsymbol();
luaI_initconstant();
luaI_initfallbacks();
}
static void grow (stringtable *tb)
{
int newsize = luaI_redimension(tb->size);
TaggedString **newhash = newvector(newsize, TaggedString *);
int i;
for (i=0; i<newsize; i++)
newhash[i] = NULL;
/* rehash */
tb->nuse = 0;
for (i=0; i<tb->size; i++)
if (tb->hash[i] != NULL && tb->hash[i] != &EMPTY) {
int h = tb->hash[i]->hash%newsize;
while (newhash[h])
h = (h+1)%newsize;
newhash[h] = tb->hash[i];
tb->nuse++;
}
luaI_free(tb->hash);
tb->size = newsize;
tb->hash = newhash;
}
static TaggedString *newone(char *buff, int tag, unsigned long h)
{
TaggedString *ts;
if (tag == LUA_T_STRING) {
ts = (TaggedString *)luaI_malloc(sizeof(TaggedString)+strlen(buff));
strcpy(ts->str, buff);
ts->u.s.varindex = ts->u.s.constindex = NOT_USED;
ts->tag = LUA_T_STRING;
}
else {
ts = (TaggedString *)luaI_malloc(sizeof(TaggedString));
ts->u.v = buff;
ts->tag = tag == LUA_ANYTAG ? 0 : tag;
}
ts->marked = 0;
ts->hash = h;
return ts;
}
static TaggedString *insert (char *buff, int tag, stringtable *tb)
{
TaggedString *ts;
unsigned long h = hash(buff, tag);
int i;
int j = -1;
if ((Long)tb->nuse*3 >= (Long)tb->size*2)
{
if (!initialized)
initialize();
grow(tb);
}
i = h%tb->size;
while ((ts = tb->hash[i]) != NULL)
{
if (ts == &EMPTY)
j = i;
else if ((ts->tag == LUA_T_STRING) ?
(tag == LUA_T_STRING && (strcmp(buff, ts->str) == 0)) :
((tag == ts->tag || tag == LUA_ANYTAG) && buff == ts->u.v))
return ts;
i = (i+1)%tb->size;
}
/* not found */
lua_pack();
if (j != -1) /* is there an EMPTY space? */
i = j;
else
tb->nuse++;
ts = tb->hash[i] = newone(buff, tag, h);
return ts;
}
TaggedString *luaI_createudata (void *udata, int tag)
{
return insert(udata, tag, &string_root[(unsigned)udata%NUM_HASHS]);
}
TaggedString *lua_createstring (char *str)
{
return insert(str, LUA_T_STRING, &string_root[(unsigned)str[0]%NUM_HASHS]);
}
void luaI_strcallIM (TaggedString *l)
{
TObject o;
ttype(&o) = LUA_T_USERDATA;
for (; l; l=l->next) {
tsvalue(&o) = l;
luaI_gcIM(&o);
}
}
void luaI_strfree (TaggedString *l)
{
while (l) {
TaggedString *next = l->next;
luaI_free(l);
l = next;
}
}
/*
** Garbage collection function.
*/
TaggedString *luaI_strcollector (long *acum)
{
Long counter = 0;
TaggedString *frees = NULL;
int i;
for (i=0; i<NUM_HASHS; i++)
{
stringtable *tb = &string_root[i];
int j;
for (j=0; j<tb->size; j++)
{
TaggedString *t = tb->hash[j];
if (t != NULL && t->marked <= 1)
{
if (t->marked)
t->marked = 0;
else
{
t->next = frees;
frees = t;
tb->hash[j] = &EMPTY;
counter++;
}
}
}
}
*acum += counter;
return frees;
}

38
tree.h
View File

@@ -1,38 +0,0 @@
/*
** tree.h
** TecCGraf - PUC-Rio
** $Id: tree.h,v 1.17 1997/05/14 18:38:29 roberto Exp roberto $
*/
#ifndef tree_h
#define tree_h
#include "types.h"
#define NOT_USED 0xFFFE
typedef struct TaggedString
{
int tag; /* if != LUA_T_STRING, this is a userdata */
struct TaggedString *next;
union {
struct {
Word varindex; /* != NOT_USED if this is a symbol */
Word constindex; /* != NOT_USED if this is a constant */
} s;
void *v; /* if this is a userdata, here is its value */
} u;
unsigned long hash; /* 0 if not initialized */
int marked; /* for garbage collection; never collect (nor change) if > 1 */
char str[1]; /* \0 byte already reserved */
} TaggedString;
TaggedString *lua_createstring (char *str);
TaggedString *luaI_createudata (void *udata, int tag);
TaggedString *luaI_strcollector (long *cont);
void luaI_strfree (TaggedString *l);
void luaI_strcallIM (TaggedString *l);
#endif

29
types.h
View File

@@ -1,29 +0,0 @@
/*
** TeCGraf - PUC-Rio
** $Id: types.h,v 1.3 1995/02/06 19:32:43 roberto Exp roberto $
*/
#ifndef types_h
#define types_h
#include <limits.h>
#ifndef real
#define real float
#endif
#define Byte lua_Byte /* some systems have Byte as a predefined type */
typedef unsigned char Byte; /* unsigned 8 bits */
#define Word lua_Word /* some systems have Word as a predefined type */
typedef unsigned short Word; /* unsigned 16 bits */
#define MAX_WORD (USHRT_MAX-2) /* maximum value of a word (-2 for safety) */
#define MAX_INT (INT_MAX-2) /* maximum value of a int (-2 for safety) */
#define Long lua_Long /* some systems have Long as a predefined type */
typedef signed long Long; /* 32 bits */
typedef unsigned int IntPoint; /* unsigned with same size as a pointer (for hashing) */
#endif

330
undump.c
View File

@@ -1,330 +0,0 @@
/*
** undump.c
** load bytecodes from files
*/
char* rcs_undump="$Id: undump.c,v 1.23 1997/06/16 16:50:22 roberto Exp roberto $";
#include <stdio.h>
#include <string.h>
#include "auxlib.h"
#include "opcode.h"
#include "luamem.h"
#include "table.h"
#include "undump.h"
#include "zio.h"
static int swapword=0;
static int swapfloat=0;
static TFunc* Main=NULL; /* functions in a chunk */
static TFunc* lastF=NULL;
static void FixCode(Byte* code, Byte* end) /* swap words */
{
Byte* p;
for (p=code; p!=end;)
{
int op=*p;
switch (op)
{
case PUSHNIL:
case PUSH0:
case PUSH1:
case PUSH2:
case PUSHLOCAL0:
case PUSHLOCAL1:
case PUSHLOCAL2:
case PUSHLOCAL3:
case PUSHLOCAL4:
case PUSHLOCAL5:
case PUSHLOCAL6:
case PUSHLOCAL7:
case PUSHLOCAL8:
case PUSHLOCAL9:
case PUSHINDEXED:
case STORELOCAL0:
case STORELOCAL1:
case STORELOCAL2:
case STORELOCAL3:
case STORELOCAL4:
case STORELOCAL5:
case STORELOCAL6:
case STORELOCAL7:
case STORELOCAL8:
case STORELOCAL9:
case STOREINDEXED0:
case ADJUST0:
case EQOP:
case LTOP:
case LEOP:
case GTOP:
case GEOP:
case ADDOP:
case SUBOP:
case MULTOP:
case DIVOP:
case POWOP:
case CONCOP:
case MINUSOP:
case NOTOP:
case POP:
case RETCODE0:
p++;
break;
case PUSHBYTE:
case PUSHLOCAL:
case STORELOCAL:
case STOREINDEXED:
case STORELIST0:
case ADJUST:
case RETCODE:
case VARARGS:
case STOREMAP:
p+=2;
break;
case STORELIST:
case CALLFUNC:
p+=3;
break;
case PUSHFUNCTION:
p+=5; /* TODO: use sizeof(TFunc*) or old? */
break;
case PUSHWORD:
case PUSHSELF:
case CREATEARRAY:
case ONTJMP:
case ONFJMP:
case JMP:
case UPJMP:
case IFFJMP:
case IFFUPJMP:
case SETLINE:
case PUSHSTRING:
case PUSHGLOBAL:
case STOREGLOBAL:
{
Byte t;
t=p[1]; p[1]=p[2]; p[2]=t;
p+=3;
break;
}
case PUSHFLOAT: /* assumes sizeof(float)==4 */
{
Byte t;
t=p[1]; p[1]=p[4]; p[4]=t;
t=p[2]; p[2]=p[3]; p[3]=t;
p+=5;
break;
}
case STORERECORD:
{
int n=*++p;
p++;
while (n--)
{
Byte t;
t=p[0]; p[0]=p[1]; p[1]=t;
p+=2;
}
break;
}
default:
luaL_verror("corrupt binary file: bad opcode %d at %d\n",
op,(int)(p-code));
break;
}
}
}
static void Unthread(Byte* code, int i, int v)
{
while (i!=0)
{
Word w;
Byte* p=code+i;
memcpy(&w,p,sizeof(w));
i=w; w=v;
memcpy(p,&w,sizeof(w));
}
}
static int LoadWord(ZIO* Z)
{
Word w;
zread(Z,&w,sizeof(w));
if (swapword)
{
Byte* p=(Byte*)&w;
Byte t;
t=p[0]; p[0]=p[1]; p[1]=t;
}
return w;
}
static int LoadSize(ZIO* Z)
{
Word hi=LoadWord(Z);
Word lo=LoadWord(Z);
int s=(hi<<16)|lo;
if ((Word)s != s) lua_error("code too long");
return s;
}
static void* LoadBlock(int size, ZIO* Z)
{
void* b=luaI_malloc(size);
zread(Z,b,size);
return b;
}
static char* LoadString(ZIO* Z)
{
int size=LoadWord(Z);
char *b=luaI_buffer(size);
zread(Z,b,size);
return b;
}
static char* LoadNewString(ZIO* Z)
{
return LoadBlock(LoadWord(Z),Z);
}
static void LoadFunction(ZIO* Z)
{
TFunc* tf=new(TFunc);
tf->next=NULL;
tf->locvars=NULL;
tf->size=LoadSize(Z);
tf->lineDefined=LoadWord(Z);
if (IsMain(tf)) /* new main */
{
tf->fileName=LoadNewString(Z);
Main=lastF=tf;
}
else /* fix PUSHFUNCTION */
{
tf->marked=LoadWord(Z);
tf->fileName=Main->fileName;
memcpy(Main->code+tf->marked,&tf,sizeof(tf));
lastF=lastF->next=tf;
}
tf->code=LoadBlock(tf->size,Z);
if (swapword || swapfloat) FixCode(tf->code,tf->code+tf->size);
while (1) /* unthread */
{
int c=zgetc(Z);
if (c==ID_VAR) /* global var */
{
int i=LoadWord(Z);
char* s=LoadString(Z);
int v=luaI_findsymbolbyname(s);
Unthread(tf->code,i,v);
}
else if (c==ID_STR) /* constant string */
{
int i=LoadWord(Z);
char* s=LoadString(Z);
int v=luaI_findconstantbyname(s);
Unthread(tf->code,i,v);
}
else
{
zungetc(Z);
break;
}
}
}
static void LoadSignature(ZIO* Z)
{
char* s=SIGNATURE;
while (*s!=0 && zgetc(Z)==*s)
++s;
if (*s!=0) lua_error("cannot load binary file: bad signature");
}
static void LoadHeader(ZIO* Z)
{
Word w,tw=TEST_WORD;
float f,tf=TEST_FLOAT;
int version;
LoadSignature(Z);
version=zgetc(Z);
if (version>0x23) /* after 2.5 */
{
int oldsizeofW=zgetc(Z);
int oldsizeofF=zgetc(Z);
int oldsizeofP=zgetc(Z);
if (oldsizeofW!=2)
luaL_verror(
"cannot load binary file created on machine with sizeof(Word)=%d; "
"expected 2",oldsizeofW);
if (oldsizeofF!=4)
luaL_verror(
"cannot load binary file created on machine with sizeof(float)=%d; "
"expected 4\nnot an IEEE machine?",oldsizeofF);
if (oldsizeofP!=sizeof(TFunc*)) /* TODO: pack? */
luaL_verror(
"cannot load binary file created on machine with sizeof(TFunc*)=%d; "
"expected %d",oldsizeofP,(int)sizeof(TFunc*));
}
zread(Z,&w,sizeof(w)); /* test word */
if (w!=tw)
{
swapword=1;
}
zread(Z,&f,sizeof(f)); /* test float */
if (f!=tf)
{
Byte* p=(Byte*)&f;
Byte t;
swapfloat=1;
t=p[0]; p[0]=p[3]; p[3]=t;
t=p[1]; p[1]=p[2]; p[2]=t;
if (f!=tf) /* TODO: try another perm? */
lua_error("cannot load binary file: unknown float representation");
}
}
static void LoadChunk(ZIO* Z)
{
LoadHeader(Z);
while (1)
{
int c=zgetc(Z);
if (c==ID_FUN) LoadFunction(Z); else { zungetc(Z); break; }
}
}
/*
** load one chunk from a file.
** return list of functions found, headed by main, or NULL at EOF.
*/
TFunc* luaI_undump1(ZIO* Z)
{
int c=zgetc(Z);
if (c==ID_CHUNK)
{
LoadChunk(Z);
return Main;
}
else if (c!=EOZ)
lua_error("not a lua binary file");
return NULL;
}
/*
** load and run all chunks in a file
*/
int luaI_undump(ZIO* Z)
{
TFunc* m;
while ((m=luaI_undump1(Z)))
{
int status=luaI_dorun(m);
luaI_freefunc(m);
if (status!=0) return status;
}
return 0;
}

View File

@@ -1,30 +0,0 @@
/*
** undump.h
** definitions for lua decompiler
** $Id: undump.h,v 1.5 1997/06/16 16:50:22 roberto Exp roberto $
*/
#ifndef undump_h
#define undump_h
#include "func.h"
#include "zio.h"
#define IsMain(f) (f->lineDefined==0)
/* definitions for chunk headers */
#define ID_CHUNK 27 /* ESC */
#define ID_FUN 'F'
#define ID_VAR 'V'
#define ID_STR 'S'
#define SIGNATURE "Lua"
#define VERSION 0x25 /* last format change was in 2.5 */
#define TEST_WORD 0x1234 /* a word for testing byte ordering */
#define TEST_FLOAT 0.123456789e-23 /* a float for testing representation */
TFunc* luaI_undump1(ZIO* Z);
int luaI_undump(ZIO* Z); /* load all chunks */
#endif