mirror of
https://github.com/lua/lua.git
synced 2026-07-26 16:09:07 +00:00
Compare commits
432 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
dcb1a08906 | ||
|
|
1788501eed | ||
|
|
bee1a5aeb2 | ||
|
|
994aba062b | ||
|
|
e869d17eb1 | ||
|
|
9a0221ef58 | ||
|
|
07008b5d45 | ||
|
|
8f31eda649 | ||
|
|
da94130160 | ||
|
|
468fbdbde7 | ||
|
|
eb45f8b631 | ||
|
|
df0df08bc5 | ||
|
|
9618aaf07d | ||
|
|
bec9bc4154 | ||
|
|
955a811aa1 | ||
|
|
c9902be294 | ||
|
|
112c9d53ab | ||
|
|
0789451458 | ||
|
|
d97af0de26 | ||
|
|
1917149fdd | ||
|
|
0845e73b6a | ||
|
|
7dfa952091 | ||
|
|
02134b4a87 | ||
|
|
bdb1db4d37 | ||
|
|
02a6891939 | ||
|
|
741c6f5006 | ||
|
|
6152973f9c | ||
|
|
243a808067 | ||
|
|
62c36a6056 | ||
|
|
74719afc33 | ||
|
|
7e59a8901d | ||
|
|
abc6eac404 | ||
|
|
054e0b888a | ||
|
|
da252eeff7 | ||
|
|
9890bedaab | ||
|
|
0a0c9593b8 | ||
|
|
d470792517 | ||
|
|
439236773b | ||
|
|
2a2b64d6ac | ||
|
|
daa937c043 | ||
|
|
21455162b5 | ||
|
|
99cc4b20f2 | ||
|
|
0969a971cd | ||
|
|
be6d215f67 | ||
|
|
e74817f8aa | ||
|
|
043c2ac258 | ||
|
|
88a2023c32 | ||
|
|
5ef1989c4b | ||
|
|
f380d627f8 | ||
|
|
aafa106d10 | ||
|
|
29b7b8e52c | ||
|
|
a9dd2c6717 | ||
|
|
aee3f97acb | ||
|
|
46968b8ffa | ||
|
|
6cdf0d8768 | ||
|
|
07ff251a17 | ||
|
|
b3b7cf7335 | ||
|
|
8622dc18bf | ||
|
|
d22e2644dd | ||
|
|
f529a22ca5 | ||
|
|
783ba75129 | ||
|
|
d49e4dd752 | ||
|
|
981fddea02 | ||
|
|
81b953f27e | ||
|
|
b9acf4b4af | ||
|
|
44ace0aefd | ||
|
|
5981161360 | ||
|
|
763c64be9b | ||
|
|
f0dffaa209 | ||
|
|
77a6836fef | ||
|
|
9f043e8017 | ||
|
|
6ac047afc4 | ||
|
|
0e1058cfdd | ||
|
|
26679b1a48 | ||
|
|
e04c2b9aa8 | ||
|
|
0c031dcc8b | ||
|
|
c332c4e927 | ||
|
|
964c503a63 | ||
|
|
90d87e3a78 | ||
|
|
f76bca23ef | ||
|
|
a5fd7d722c | ||
|
|
4e0bf95622 | ||
|
|
498a934abf | ||
|
|
ce53872684 | ||
|
|
da96eb2cce | ||
|
|
fada8efd01 | ||
|
|
d916487d7c | ||
|
|
1bf762ba38 | ||
|
|
541e722360 | ||
|
|
807ba6301c | ||
|
|
03f3f9e707 | ||
|
|
a78eecee48 | ||
|
|
43461d267f | ||
|
|
fae0b52825 | ||
|
|
22439a7511 | ||
|
|
7ecc3ce827 | ||
|
|
4e91384e14 | ||
|
|
de79e7fc58 | ||
|
|
8b5b42563c | ||
|
|
502343b402 | ||
|
|
82d09fbf0d | ||
|
|
9be85d1648 | ||
|
|
45e533599f | ||
|
|
94144a7821 | ||
|
|
4daae2165d | ||
|
|
cdd261f332 | ||
|
|
034f16892e | ||
|
|
c759520bc8 | ||
|
|
80b3d28f4a | ||
|
|
69d97712ec | ||
|
|
5d89dad9b8 | ||
|
|
525a91fed3 | ||
|
|
868d16dee0 | ||
|
|
3393fd7f25 | ||
|
|
00c122cc29 | ||
|
|
03160920cf | ||
|
|
b42cc6a4d2 | ||
|
|
a6ad644bf2 | ||
|
|
39fd5bb9b0 | ||
|
|
5482992dec | ||
|
|
024528e0c2 | ||
|
|
ef37c87e93 | ||
|
|
9e029f98b9 | ||
|
|
e962330df9 | ||
|
|
b291e50006 | ||
|
|
9ae0c082a3 | ||
|
|
accd7bc253 | ||
|
|
6153200bc2 | ||
|
|
2e7595522d | ||
|
|
b79ffdc4ce | ||
|
|
592a3f289b | ||
|
|
9cdeb275e7 | ||
|
|
c957b270d2 | ||
|
|
92791b9dd6 | ||
|
|
45cad43c3f | ||
|
|
dad5a01fb0 | ||
|
|
66713181c1 | ||
|
|
7135803cc8 | ||
|
|
b7567b6673 | ||
|
|
f8c95fa9e8 | ||
|
|
9c965d0ffb | ||
|
|
6103dca8ee | ||
|
|
18cd7adac6 | ||
|
|
41223a01ec | ||
|
|
e78cf96c97 | ||
|
|
0cb3843956 | ||
|
|
907368ead5 | ||
|
|
81489beea1 | ||
|
|
ac30aad09b | ||
|
|
2c89651fc6 | ||
|
|
3a89c973ff | ||
|
|
52d5e8032c | ||
|
|
19c178fa14 | ||
|
|
45ccb0e881 | ||
|
|
4be18fa889 | ||
|
|
7c261a13b5 | ||
|
|
2bb94d9e22 | ||
|
|
a3235ad270 | ||
|
|
f6a9cc9a67 | ||
|
|
28d47a0aaa | ||
|
|
eb617df2d8 | ||
|
|
a580480b07 | ||
|
|
0dd6d1080e | ||
|
|
3c820d622e | ||
|
|
d6c867ea50 | ||
|
|
2079cfe8fa | ||
|
|
dfe03c7abe | ||
|
|
8cd67ac676 | ||
|
|
9828893f7e | ||
|
|
6990da0057 | ||
|
|
d985dc0629 | ||
|
|
451124005b | ||
|
|
2f1fa3d427 | ||
|
|
189d64409b | ||
|
|
60cc473bcf | ||
|
|
43a2ee6ea1 | ||
|
|
4b91e9cde6 | ||
|
|
26c5f56ad1 | ||
|
|
daa858ef27 | ||
|
|
ea169d2083 | ||
|
|
c31aa863ac | ||
|
|
ff08b0f406 | ||
|
|
c1801e623f | ||
|
|
a404f6e0e6 | ||
|
|
2d2440a753 | ||
|
|
0c4ed2b3dc | ||
|
|
b945fae40e | ||
|
|
dadba4d6ed | ||
|
|
d600a6b5b3 | ||
|
|
75ac0d2172 | ||
|
|
9f3785a2f3 | ||
|
|
84e92e0976 | ||
|
|
b8a049abed | ||
|
|
e18f681333 | ||
|
|
dd1aa28390 | ||
|
|
abbf14cd32 | ||
|
|
e8292f076d | ||
|
|
3037dccaf6 | ||
|
|
a7793468aa | ||
|
|
caa987faad | ||
|
|
0892f0e5b7 | ||
|
|
1d7857bc63 | ||
|
|
72a1d81b51 | ||
|
|
2c580a0afb | ||
|
|
05e8b0ae80 | ||
|
|
16dd77e8d9 | ||
|
|
0600f968c3 | ||
|
|
971b1d557d | ||
|
|
11d97c34d5 | ||
|
|
66be42549e | ||
|
|
067db30d71 | ||
|
|
da4dbe65b2 | ||
|
|
4321fde2a7 | ||
|
|
8f3df1d471 | ||
|
|
1a17211707 | ||
|
|
d56e3a6481 | ||
|
|
7820a47184 | ||
|
|
88b185ada1 | ||
|
|
ef3c45d523 | ||
|
|
20a48a818f | ||
|
|
c9e6ed1d9f | ||
|
|
56fdab67d8 | ||
|
|
3a98c8670d | ||
|
|
da585783e3 | ||
|
|
e81f184164 | ||
|
|
3e43275308 | ||
|
|
f97307b548 | ||
|
|
6402bfb1f8 | ||
|
|
27b6bbdcf3 | ||
|
|
5a198de3c1 | ||
|
|
c5d7ba7347 | ||
|
|
f84c2ebc4a | ||
|
|
c8897f2b08 | ||
|
|
6bb2cac3db | ||
|
|
88f020b626 | ||
|
|
a38f093f05 | ||
|
|
b6adfdd01b | ||
|
|
b90b4bbd3a | ||
|
|
f6d95140ae | ||
|
|
eca17b24ea | ||
|
|
6b61582e47 | ||
|
|
60bdc370d9 | ||
|
|
b9e31f73ee | ||
|
|
ea98620d98 | ||
|
|
6b78040840 | ||
|
|
e931c7c0f6 | ||
|
|
70160320b1 | ||
|
|
bfbf56f15a | ||
|
|
732ef82c72 | ||
|
|
2a1da64872 | ||
|
|
3c5d71cf77 | ||
|
|
1848bcc15b | ||
|
|
4d2de484f6 | ||
|
|
312f78d925 | ||
|
|
e4b69d6c9c | ||
|
|
c9a2dfeb2c | ||
|
|
9fe5be3acf | ||
|
|
611680af08 | ||
|
|
cb1d8f0fa0 | ||
|
|
33f4fef410 | ||
|
|
e77534c08f | ||
|
|
a22b54bbb6 | ||
|
|
414ebe8ce1 | ||
|
|
33ace03b5a | ||
|
|
085181a08a | ||
|
|
dd22ea4da5 | ||
|
|
5fdcfeb353 | ||
|
|
d68d8287aa | ||
|
|
e1249970c2 | ||
|
|
9d6f4e48a6 | ||
|
|
b546a042e8 | ||
|
|
bd9e68cfcd | ||
|
|
9747f3c87a | ||
|
|
12d9731a49 | ||
|
|
4aade854bb | ||
|
|
369dd65318 | ||
|
|
209602ac31 | ||
|
|
6251d889ca | ||
|
|
faec0b0824 | ||
|
|
64d93e7cf9 | ||
|
|
d73c5bcfe7 | ||
|
|
e78c1c54aa | ||
|
|
42049b42f1 | ||
|
|
a8cd072c76 | ||
|
|
83e9897cf0 | ||
|
|
f93704728f | ||
|
|
c9e3d32182 | ||
|
|
00050b8a6b | ||
|
|
19a1e19ae1 | ||
|
|
3a9516ffc8 | ||
|
|
42fa305649 | ||
|
|
9319735744 | ||
|
|
1ea6e8064c | ||
|
|
c1746340c3 | ||
|
|
d0339e7b72 | ||
|
|
075b7918c3 | ||
|
|
7c99149a76 | ||
|
|
27d95f1880 | ||
|
|
f0d523887d | ||
|
|
f29fbf2bf6 | ||
|
|
4355e1afcd | ||
|
|
cae1eff901 | ||
|
|
f83bc86e51 | ||
|
|
59744f0311 | ||
|
|
bb2e2bec18 | ||
|
|
efaaf99c42 | ||
|
|
f8a571ee35 | ||
|
|
397e32399b | ||
|
|
373363cb69 | ||
|
|
ad5574c4c9 | ||
|
|
264f8c5e7b | ||
|
|
9e9e2ea287 | ||
|
|
03d917f229 | ||
|
|
c3488f5115 | ||
|
|
6fef372fb8 | ||
|
|
052a1cc46c | ||
|
|
ae067dcddd | ||
|
|
5d60470508 | ||
|
|
88d7ffb0d0 | ||
|
|
47527d2d3c | ||
|
|
1444d28476 | ||
|
|
2de803c250 | ||
|
|
fa08b42dd8 | ||
|
|
eea734aa88 | ||
|
|
b6d91e24e2 | ||
|
|
a82ab0852e | ||
|
|
b8af9c56c9 | ||
|
|
c3c0b52a1f | ||
|
|
ec422ec7d0 | ||
|
|
a8a15ff1bd | ||
|
|
131d66efd2 | ||
|
|
bbf1b3060a | ||
|
|
8b7f271ea2 | ||
|
|
bc323435ee | ||
|
|
6769f34817 | ||
|
|
0b110f7922 | ||
|
|
205ee1ec84 | ||
|
|
b48847c5fa | ||
|
|
1143bf9286 | ||
|
|
d9ecc13545 | ||
|
|
f00d692445 | ||
|
|
d8b0bbb2ad | ||
|
|
1f4ee4a4d2 | ||
|
|
6a9efa8b8e | ||
|
|
65459e7938 | ||
|
|
42359b8b13 | ||
|
|
169870e37d | ||
|
|
78e454d864 | ||
|
|
dbfe28e199 | ||
|
|
d59c52753f | ||
|
|
62e1a4c84d | ||
|
|
81411e8913 | ||
|
|
62aa717f7e | ||
|
|
a5614eae3c | ||
|
|
536bae5871 | ||
|
|
679eddf296 | ||
|
|
d991def36c | ||
|
|
8b195533d2 | ||
|
|
3ccdd57c26 | ||
|
|
a103455dda | ||
|
|
60242e1930 | ||
|
|
a0e9bfbb48 | ||
|
|
2f19e0ba16 | ||
|
|
ab7fdcbbed | ||
|
|
48cf1de356 | ||
|
|
8d50122af0 | ||
|
|
fd379b38f7 | ||
|
|
aa4d865077 | ||
|
|
3e94febfc1 | ||
|
|
243b3a1a47 | ||
|
|
389e808c60 | ||
|
|
450465c4d4 | ||
|
|
2f44cc9f4d | ||
|
|
d106f3f43c | ||
|
|
bf3091d94f | ||
|
|
4dbf7285a8 | ||
|
|
a1e41e3a12 | ||
|
|
9d0044ce53 | ||
|
|
37bf74efb7 | ||
|
|
8c37d3b9d6 | ||
|
|
0af581f0bf | ||
|
|
2a506ea9d2 | ||
|
|
e5ec547eb3 | ||
|
|
6d383202dc | ||
|
|
7b8166d7b3 | ||
|
|
3636bbad3a | ||
|
|
82f9f3e552 | ||
|
|
c96ad1c945 | ||
|
|
5b9fbfa006 | ||
|
|
f0cc2d5506 | ||
|
|
d289ac81d3 | ||
|
|
15791f93fe | ||
|
|
d763b69740 | ||
|
|
36dd1af92d | ||
|
|
25b6dae7c0 | ||
|
|
1630c2533a | ||
|
|
1d373d77de | ||
|
|
f025b0d160 | ||
|
|
cc02b4729b | ||
|
|
2bb3830fc1 | ||
|
|
7a38bdd4b3 | ||
|
|
7614b17e85 | ||
|
|
6dfdb76538 | ||
|
|
9a3c51cff1 | ||
|
|
6336d2f9e1 | ||
|
|
ec6677e551 | ||
|
|
20cbca699a | ||
|
|
3211a9648a | ||
|
|
0baa915343 | ||
|
|
5cddb264d4 | ||
|
|
9863223fbf | ||
|
|
9a1948e67d | ||
|
|
f9deeac632 | ||
|
|
29f0021837 | ||
|
|
7acddb871d | ||
|
|
a7ca46405d | ||
|
|
0e2297afaa | ||
|
|
0a1891f6a0 | ||
|
|
1936a9e53b | ||
|
|
820ec63bdf | ||
|
|
01ea523b80 | ||
|
|
88cf0836fc | ||
|
|
3ec9ee0d0f | ||
|
|
21c9ebf4a9 | ||
|
|
4fb77c4308 | ||
|
|
bced00ab9e | ||
|
|
25116a3065 | ||
|
|
eadbb9cff4 | ||
|
|
42b947296b | ||
|
|
f37e65d1cb | ||
|
|
0ef5cf2289 | ||
|
|
fed9408ab5 |
43
bugs
Normal file
43
bugs
Normal file
@@ -0,0 +1,43 @@
|
||||
** 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.
|
||||
|
||||
|
||||
--- Version 3.1 alpha
|
||||
|
||||
** lua.c
|
||||
Thu Jan 15 14:34:58 EDT 1998
|
||||
>> must include "stdlib.h" (for "exit()").
|
||||
|
||||
** lbuiltin.c / lobject.h
|
||||
Thu Jan 15 14:34:58 EDT 1998
|
||||
>> MAX_WORD may be bigger than MAX_INT
|
||||
|
||||
|
||||
** llex.c
|
||||
Mon Jan 19 18:17:18 EDT 1998
|
||||
>> wrong line number (+1) in error report when file starts with "#..."
|
||||
|
||||
** lstrlib.c
|
||||
Tue Jan 27 15:27:49 EDT 1998
|
||||
>> formats like "%020d" were considered too big (3 digits); moreover,
|
||||
>> some sistems limit printf to at most 500 chars, so we can limit sizes
|
||||
>> to 2 digits (99).
|
||||
|
||||
** lapi.c
|
||||
Tue Jan 27 17:12:36 EDT 1998
|
||||
>> "lua_getstring" may create a new string, so should check GC
|
||||
|
||||
** lstring.c / ltable.c
|
||||
Wed Jan 28 14:48:12 EDT 1998
|
||||
>> tables can become full of "emptys" slots, and keep growing without limits.
|
||||
|
||||
** lstrlib.c
|
||||
Mon Mar 9 15:26:09 EST 1998
|
||||
>> gsub('a', '(b?)%1*' ...) loops (because the capture is empty).
|
||||
|
||||
** lstrlib.c
|
||||
Mon May 18 19:20:00 EST 1998
|
||||
>> arguments for "format" 'x', 'X', 'o' and 'u' must be unsigned int.
|
||||
|
||||
175
fallback.c
175
fallback.c
@@ -1,175 +0,0 @@
|
||||
/*
|
||||
** fallback.c
|
||||
** TecCGraf - PUC-Rio
|
||||
*/
|
||||
|
||||
char *rcs_fallback="$Id: fallback.c,v 1.22 1996/03/19 22:28:37 roberto Exp roberto $";
|
||||
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
|
||||
#include "mem.h"
|
||||
#include "fallback.h"
|
||||
#include "opcode.h"
|
||||
#include "lua.h"
|
||||
|
||||
|
||||
static void errorFB (void);
|
||||
static void indexFB (void);
|
||||
static void gettableFB (void);
|
||||
static void arithFB (void);
|
||||
static void concatFB (void);
|
||||
static void orderFB (void);
|
||||
static void GDFB (void);
|
||||
static void funcFB (void);
|
||||
|
||||
|
||||
/*
|
||||
** Warning: This list must be in the same order as the #define's
|
||||
*/
|
||||
struct FB luaI_fallBacks[] = {
|
||||
{"error", {LUA_T_CFUNCTION, {errorFB}}, 1, 0},
|
||||
{"index", {LUA_T_CFUNCTION, {indexFB}}, 2, 1},
|
||||
{"gettable", {LUA_T_CFUNCTION, {gettableFB}}, 2, 1},
|
||||
{"arith", {LUA_T_CFUNCTION, {arithFB}}, 3, 1},
|
||||
{"order", {LUA_T_CFUNCTION, {orderFB}}, 3, 1},
|
||||
{"concat", {LUA_T_CFUNCTION, {concatFB}}, 2, 1},
|
||||
{"settable", {LUA_T_CFUNCTION, {gettableFB}}, 3, 0},
|
||||
{"gc", {LUA_T_CFUNCTION, {GDFB}}, 1, 0},
|
||||
{"function", {LUA_T_CFUNCTION, {funcFB}}, -1, -1},
|
||||
/* no fixed number of params or results */
|
||||
{"getglobal", {LUA_T_CFUNCTION, {indexFB}}, 1, 1}
|
||||
/* same default behavior of index FB */
|
||||
};
|
||||
|
||||
#define N_FB (sizeof(luaI_fallBacks)/sizeof(struct FB))
|
||||
|
||||
void luaI_setfallback (void)
|
||||
{
|
||||
int i;
|
||||
char *name = lua_getstring(lua_getparam(1));
|
||||
lua_Object func = lua_getparam(2);
|
||||
if (name == NULL || !lua_isfunction(func))
|
||||
lua_error("incorrect argument to function `setfallback'");
|
||||
for (i=0; i<N_FB; i++)
|
||||
{
|
||||
if (strcmp(luaI_fallBacks[i].kind, name) == 0)
|
||||
{
|
||||
luaI_pushobject(&luaI_fallBacks[i].function);
|
||||
luaI_fallBacks[i].function = *luaI_Address(func);
|
||||
return;
|
||||
}
|
||||
}
|
||||
/* name not found */
|
||||
lua_error("incorrect argument to function `setfallback'");
|
||||
}
|
||||
|
||||
|
||||
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 indexFB (void)
|
||||
{
|
||||
lua_pushnil();
|
||||
}
|
||||
|
||||
|
||||
static void gettableFB (void)
|
||||
{
|
||||
lua_error("indexed expression not a table");
|
||||
}
|
||||
|
||||
|
||||
static void arithFB (void)
|
||||
{
|
||||
lua_error("unexpected type at conversion to number");
|
||||
}
|
||||
|
||||
static void concatFB (void)
|
||||
{
|
||||
lua_error("unexpected type at conversion to string");
|
||||
}
|
||||
|
||||
|
||||
static void orderFB (void)
|
||||
{
|
||||
lua_error("unexpected type at comparison");
|
||||
}
|
||||
|
||||
static void GDFB (void) { }
|
||||
|
||||
static void funcFB (void)
|
||||
{
|
||||
lua_error("call expression not a function");
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Lock routines
|
||||
*/
|
||||
|
||||
static Object *lockArray = NULL;
|
||||
static int lockSize = 0;
|
||||
|
||||
int luaI_lock (Object *object)
|
||||
{
|
||||
int i;
|
||||
int oldSize;
|
||||
if (tag(object) == LUA_T_NIL)
|
||||
return -1; /* special lock ref for nil */
|
||||
for (i=0; i<lockSize; i++)
|
||||
if (tag(&lockArray[i]) == LUA_T_NIL)
|
||||
{
|
||||
lockArray[i] = *object;
|
||||
return i;
|
||||
}
|
||||
/* no more empty spaces */
|
||||
oldSize = lockSize;
|
||||
lockSize = growvector(&lockArray, lockSize, Object, lockEM, MAX_WORD);
|
||||
for (i=oldSize; i<lockSize; i++)
|
||||
tag(&lockArray[i]) = LUA_T_NIL;
|
||||
lockArray[oldSize] = *object;
|
||||
return oldSize;
|
||||
}
|
||||
|
||||
|
||||
void lua_unlock (int ref)
|
||||
{
|
||||
if (ref >= 0 && ref < lockSize)
|
||||
tag(&lockArray[ref]) = LUA_T_NIL;
|
||||
}
|
||||
|
||||
|
||||
Object *luaI_getlocked (int ref)
|
||||
{
|
||||
static Object nul = {LUA_T_NIL, {0}};
|
||||
if (ref >= 0 && ref < lockSize)
|
||||
return &lockArray[ref];
|
||||
else
|
||||
return &nul;
|
||||
}
|
||||
|
||||
|
||||
void luaI_travlock (int (*fn)(Object *))
|
||||
{
|
||||
int i;
|
||||
for (i=0; i<lockSize; i++)
|
||||
fn(&lockArray[i]);
|
||||
}
|
||||
|
||||
|
||||
char *luaI_travfallbacks (int (*fn)(Object *))
|
||||
{
|
||||
int i;
|
||||
for (i=0; i<N_FB; i++)
|
||||
if (fn(&luaI_fallBacks[i].function))
|
||||
return luaI_fallBacks[i].kind;
|
||||
return NULL;
|
||||
}
|
||||
35
fallback.h
35
fallback.h
@@ -1,35 +0,0 @@
|
||||
/*
|
||||
** $Id: fallback.h,v 1.10 1995/10/17 11:52:38 roberto Exp roberto $
|
||||
*/
|
||||
|
||||
#ifndef fallback_h
|
||||
#define fallback_h
|
||||
|
||||
#include "opcode.h"
|
||||
|
||||
extern struct FB {
|
||||
char *kind;
|
||||
Object function;
|
||||
int nParams;
|
||||
int nResults;
|
||||
} luaI_fallBacks[];
|
||||
|
||||
#define FB_ERROR 0
|
||||
#define FB_INDEX 1
|
||||
#define FB_GETTABLE 2
|
||||
#define FB_ARITH 3
|
||||
#define FB_ORDER 4
|
||||
#define FB_CONCAT 5
|
||||
#define FB_SETTABLE 6
|
||||
#define FB_GC 7
|
||||
#define FB_FUNCTION 8
|
||||
#define FB_GETGLOBAL 9
|
||||
|
||||
void luaI_setfallback (void);
|
||||
int luaI_lock (Object *object);
|
||||
Object *luaI_getlocked (int ref);
|
||||
void luaI_travlock (int (*fn)(Object *));
|
||||
char *luaI_travfallbacks (int (*fn)(Object *));
|
||||
|
||||
#endif
|
||||
|
||||
156
func.c
156
func.c
@@ -1,156 +0,0 @@
|
||||
#include <stdlib.h>
|
||||
|
||||
#include "luadebug.h"
|
||||
#include "table.h"
|
||||
#include "mem.h"
|
||||
#include "func.h"
|
||||
#include "opcode.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 = NULL;
|
||||
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);
|
||||
}
|
||||
|
||||
/*
|
||||
** Garbage collection function.
|
||||
** This function traverse the function list freeing unindexed functions
|
||||
*/
|
||||
Long luaI_funccollector (void)
|
||||
{
|
||||
TFunc *curr = function_root;
|
||||
TFunc *prev = NULL;
|
||||
Long counter = 0;
|
||||
while (curr)
|
||||
{
|
||||
TFunc *next = curr->next;
|
||||
if (!curr->marked)
|
||||
{
|
||||
if (prev == NULL)
|
||||
function_root = next;
|
||||
else
|
||||
prev->next = next;
|
||||
luaI_freefunc (curr);
|
||||
++counter;
|
||||
}
|
||||
else
|
||||
{
|
||||
curr->marked = 0;
|
||||
prev = curr;
|
||||
}
|
||||
curr = next;
|
||||
}
|
||||
return counter;
|
||||
}
|
||||
|
||||
|
||||
void lua_funcinfo (lua_Object func, char **filename, int *linedefined)
|
||||
{
|
||||
Object *f = luaI_Address(func);
|
||||
if (f->tag == LUA_T_MARK || f->tag == LUA_T_FUNCTION)
|
||||
{
|
||||
*filename = f->value.tf->fileName;
|
||||
*linedefined = f->value.tf->lineDefined;
|
||||
}
|
||||
else if (f->tag == LUA_T_CMARK || f->tag == 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;
|
||||
}
|
||||
|
||||
44
func.h
44
func.h
@@ -1,44 +0,0 @@
|
||||
/*
|
||||
** $Id: func.h,v 1.7 1996/03/08 12:04:04 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;
|
||||
|
||||
Long luaI_funccollector (void);
|
||||
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
|
||||
322
hash.c
322
hash.c
@@ -1,322 +0,0 @@
|
||||
/*
|
||||
** hash.c
|
||||
** hash manager for lua
|
||||
*/
|
||||
|
||||
char *rcs_hash="$Id: hash.c,v 2.28 1996/02/12 18:32:40 roberto Exp roberto $";
|
||||
|
||||
|
||||
#include "mem.h"
|
||||
#include "opcode.h"
|
||||
#include "hash.h"
|
||||
#include "table.h"
|
||||
#include "lua.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 */
|
||||
|
||||
|
||||
static Hash *listhead = NULL;
|
||||
|
||||
|
||||
/* hash dimensions values */
|
||||
static Word dimensions[] =
|
||||
{3, 5, 7, 11, 23, 47, 97, 197, 397, 797, 1597, 3203, 6421,
|
||||
12853, 25717, 51437, 65521, 0}; /* 65521 == last prime < MAX_WORD */
|
||||
|
||||
Word luaI_redimension (Word nhash)
|
||||
{
|
||||
Word i;
|
||||
for (i=0; dimensions[i]!=0; i++)
|
||||
{
|
||||
if (dimensions[i] > nhash)
|
||||
return dimensions[i];
|
||||
}
|
||||
lua_error("table overflow");
|
||||
return 0; /* to avoid warnings */
|
||||
}
|
||||
|
||||
static Word hashindex (Hash *t, Object *ref) /* hash function */
|
||||
{
|
||||
switch (tag(ref))
|
||||
{
|
||||
case LUA_T_NIL:
|
||||
lua_error ("unexpected type to index table");
|
||||
return -1; /* UNREACHEABLE */
|
||||
case LUA_T_NUMBER:
|
||||
return (((Word)nvalue(ref))%nhash(t));
|
||||
case LUA_T_STRING:
|
||||
return (Word)((tsvalue(ref)->hash)%nhash(t)); /* make it a valid index */
|
||||
case LUA_T_FUNCTION:
|
||||
return (((IntPoint)ref->value.tf)%nhash(t));
|
||||
case LUA_T_CFUNCTION:
|
||||
return (((IntPoint)fvalue(ref))%nhash(t));
|
||||
case LUA_T_ARRAY:
|
||||
return (((IntPoint)avalue(ref))%nhash(t));
|
||||
default: /* user data */
|
||||
return (((IntPoint)uvalue(ref))%nhash(t));
|
||||
}
|
||||
}
|
||||
|
||||
int lua_equalObj (Object *t1, Object *t2)
|
||||
{
|
||||
if (tag(t1) != tag(t2)) return 0;
|
||||
switch (tag(t1))
|
||||
{
|
||||
case LUA_T_NIL: return 1;
|
||||
case LUA_T_NUMBER: return nvalue(t1) == nvalue(t2);
|
||||
case LUA_T_STRING: 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: return uvalue(t1) == uvalue(t2);
|
||||
}
|
||||
}
|
||||
|
||||
static Word present (Hash *t, Object *ref)
|
||||
{
|
||||
Word h = hashindex(t, ref);
|
||||
while (tag(ref(node(t, h))) != LUA_T_NIL)
|
||||
{
|
||||
if (lua_equalObj(ref, ref(node(t, h))))
|
||||
return h;
|
||||
h = (h+1) % nhash(t);
|
||||
}
|
||||
return h;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Alloc a vector node
|
||||
*/
|
||||
static Node *hashnodecreate (Word nhash)
|
||||
{
|
||||
Word i;
|
||||
Node *v = newvector (nhash, Node);
|
||||
for (i=0; i<nhash; i++)
|
||||
tag(ref(&v[i])) = LUA_T_NIL;
|
||||
return v;
|
||||
}
|
||||
|
||||
/*
|
||||
** Create a new hash. Return the hash pointer or NULL on error.
|
||||
*/
|
||||
static Hash *hashcreate (Word nhash)
|
||||
{
|
||||
Hash *t = new(Hash);
|
||||
nhash = luaI_redimension((Word)((float)nhash/REHASH_LIMIT));
|
||||
nodevector(t) = hashnodecreate(nhash);
|
||||
nhash(t) = nhash;
|
||||
nuse(t) = 0;
|
||||
markarray(t) = 0;
|
||||
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)
|
||||
{
|
||||
Word i;
|
||||
markarray(h) = 1;
|
||||
for (i=0; i<nhash(h); i++)
|
||||
{
|
||||
Node *n = node(h,i);
|
||||
if (tag(ref(n)) != LUA_T_NIL)
|
||||
{
|
||||
lua_markobject(&n->ref);
|
||||
lua_markobject(&n->val);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void call_fallbacks (void)
|
||||
{
|
||||
Hash *curr_array;
|
||||
Object t;
|
||||
tag(&t) = LUA_T_ARRAY;
|
||||
for (curr_array = listhead; curr_array; curr_array = curr_array->next)
|
||||
if (markarray(curr_array) != 1)
|
||||
{
|
||||
avalue(&t) = curr_array;
|
||||
luaI_gcFB(&t);
|
||||
}
|
||||
tag(&t) = LUA_T_NIL;
|
||||
luaI_gcFB(&t); /* end of list */
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Garbage collection to arrays
|
||||
** Delete all unmarked arrays.
|
||||
*/
|
||||
Long lua_hashcollector (void)
|
||||
{
|
||||
Hash *curr_array = listhead, *prev = NULL;
|
||||
Long counter = 0;
|
||||
call_fallbacks();
|
||||
while (curr_array != NULL)
|
||||
{
|
||||
Hash *next = curr_array->next;
|
||||
if (markarray(curr_array) != 1)
|
||||
{
|
||||
if (prev == NULL) listhead = next;
|
||||
else prev->next = next;
|
||||
hashdelete(curr_array);
|
||||
++counter;
|
||||
}
|
||||
else
|
||||
{
|
||||
markarray(curr_array) = 0;
|
||||
prev = curr_array;
|
||||
}
|
||||
curr_array = next;
|
||||
}
|
||||
return counter;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** 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 (Word nhash)
|
||||
{
|
||||
Hash *array;
|
||||
lua_pack();
|
||||
array = hashcreate(nhash);
|
||||
array->next = listhead;
|
||||
listhead = array;
|
||||
return array;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Re-hash
|
||||
*/
|
||||
static void rehash (Hash *t)
|
||||
{
|
||||
Word i;
|
||||
Word nold = nhash(t);
|
||||
Node *vold = nodevector(t);
|
||||
nhash(t) = luaI_redimension(nhash(t));
|
||||
nodevector(t) = hashnodecreate(nhash(t));
|
||||
for (i=0; i<nold; i++)
|
||||
{
|
||||
Node *n = vold+i;
|
||||
if (tag(ref(n)) != LUA_T_NIL && tag(val(n)) != LUA_T_NIL)
|
||||
*node(t, present(t, ref(n))) = *n; /* copy old node to new hahs */
|
||||
}
|
||||
luaI_free(vold);
|
||||
}
|
||||
|
||||
/*
|
||||
** If the hash node is present, return its pointer, otherwise return
|
||||
** null.
|
||||
*/
|
||||
Object *lua_hashget (Hash *t, Object *ref)
|
||||
{
|
||||
Word h = present(t, ref);
|
||||
if (tag(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.
|
||||
*/
|
||||
Object *lua_hashdefine (Hash *t, Object *ref)
|
||||
{
|
||||
Word h;
|
||||
Node *n;
|
||||
h = present(t, ref);
|
||||
n = node(t, h);
|
||||
if (tag(ref(n)) == LUA_T_NIL)
|
||||
{
|
||||
nuse(t)++;
|
||||
if ((float)nuse(t) > (float)nhash(t)*REHASH_LIMIT)
|
||||
{
|
||||
rehash(t);
|
||||
h = present(t, ref);
|
||||
n = node(t, h);
|
||||
}
|
||||
*ref(n) = *ref;
|
||||
tag(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, Word i)
|
||||
{
|
||||
if (i >= nhash(t))
|
||||
{
|
||||
lua_pushnil(); lua_pushnil();
|
||||
return;
|
||||
}
|
||||
while (tag(ref(node(t,i))) == LUA_T_NIL || tag(val(node(t,i))) == LUA_T_NIL)
|
||||
{
|
||||
if (++i >= nhash(t))
|
||||
{
|
||||
lua_pushnil(); lua_pushnil();
|
||||
return;
|
||||
}
|
||||
}
|
||||
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);
|
||||
if (o == LUA_NOOBJECT || r == LUA_NOOBJECT)
|
||||
lua_error ("too few arguments to function `next'");
|
||||
if (lua_getparam(3) != LUA_NOOBJECT)
|
||||
lua_error ("too many arguments to function `next'");
|
||||
if (!lua_istable(o))
|
||||
lua_error ("first argument of function `next' is not a table");
|
||||
t = avalue(luaI_Address(o));
|
||||
if (lua_isnil(r))
|
||||
{
|
||||
hashnext(t, 0);
|
||||
}
|
||||
else
|
||||
{
|
||||
Word h = present (t, luaI_Address(r));
|
||||
hashnext(t, h+1);
|
||||
}
|
||||
}
|
||||
38
hash.h
38
hash.h
@@ -1,38 +0,0 @@
|
||||
/*
|
||||
** hash.h
|
||||
** hash manager for lua
|
||||
** $Id: hash.h,v 2.10 1996/02/12 18:32:40 roberto Exp roberto $
|
||||
*/
|
||||
|
||||
#ifndef hash_h
|
||||
#define hash_h
|
||||
|
||||
#include "types.h"
|
||||
#include "opcode.h"
|
||||
|
||||
typedef struct node
|
||||
{
|
||||
Object ref;
|
||||
Object val;
|
||||
} Node;
|
||||
|
||||
typedef struct Hash
|
||||
{
|
||||
struct Hash *next;
|
||||
char mark;
|
||||
Word nhash;
|
||||
Word nuse;
|
||||
Node *node;
|
||||
} Hash;
|
||||
|
||||
|
||||
int lua_equalObj (Object *t1, Object *t2);
|
||||
Word luaI_redimension (Word nhash);
|
||||
Hash *lua_createarray (Word nhash);
|
||||
void lua_hashmark (Hash *h);
|
||||
Long lua_hashcollector (void);
|
||||
Object *lua_hashget (Hash *t, Object *ref);
|
||||
Object *lua_hashdefine (Hash *t, Object *ref);
|
||||
void lua_next (void);
|
||||
|
||||
#endif
|
||||
246
inout.c
246
inout.c
@@ -1,246 +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.35 1996/03/19 16:50:24 roberto Exp roberto $";
|
||||
|
||||
#include <stdio.h>
|
||||
|
||||
#include "lex.h"
|
||||
#include "opcode.h"
|
||||
#include "inout.h"
|
||||
#include "table.h"
|
||||
#include "tree.h"
|
||||
#include "lua.h"
|
||||
#include "mem.h"
|
||||
|
||||
|
||||
/* Exported variables */
|
||||
Word lua_linenumber;
|
||||
char *lua_parsedfile;
|
||||
|
||||
|
||||
static FILE *fp;
|
||||
static char *st;
|
||||
|
||||
/*
|
||||
** Function to get the next character from the input file
|
||||
*/
|
||||
static int fileinput (void)
|
||||
{
|
||||
return fgetc (fp);
|
||||
}
|
||||
|
||||
/*
|
||||
** Function to get the next character from the input string
|
||||
*/
|
||||
static int stringinput (void)
|
||||
{
|
||||
return *st++;
|
||||
}
|
||||
|
||||
/*
|
||||
** Function to open a file to be input unit.
|
||||
** Return the file.
|
||||
*/
|
||||
FILE *lua_openfile (char *fn)
|
||||
{
|
||||
lua_setinput (fileinput);
|
||||
if (fn == NULL)
|
||||
{
|
||||
fp = stdin;
|
||||
fn = "(stdin)";
|
||||
}
|
||||
else
|
||||
fp = fopen (fn, "r");
|
||||
if (fp == NULL)
|
||||
return NULL;
|
||||
lua_linenumber = 1;
|
||||
lua_parsedfile = luaI_createfixedstring(fn)->str;
|
||||
return fp;
|
||||
}
|
||||
|
||||
/*
|
||||
** Function to close an opened file
|
||||
*/
|
||||
void lua_closefile (void)
|
||||
{
|
||||
if (fp != NULL && fp != stdin)
|
||||
{
|
||||
fclose (fp);
|
||||
fp = NULL;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
** Function to open a string to be input unit
|
||||
*/
|
||||
void lua_openstring (char *s)
|
||||
{
|
||||
lua_setinput (stringinput);
|
||||
st = s;
|
||||
lua_linenumber = 1;
|
||||
lua_parsedfile = luaI_createfixedstring("(string)")->str;
|
||||
}
|
||||
|
||||
/*
|
||||
** Function to close an opened string
|
||||
*/
|
||||
void lua_closestring (void)
|
||||
{
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Internal function: do a string
|
||||
*/
|
||||
void lua_internaldostring (void)
|
||||
{
|
||||
lua_Object obj = lua_getparam (1);
|
||||
if (lua_isstring(obj) && !lua_dostring(lua_getstring(obj)))
|
||||
lua_pushnumber(1);
|
||||
else
|
||||
lua_pushnil();
|
||||
}
|
||||
|
||||
/*
|
||||
** Internal function: do a file
|
||||
*/
|
||||
void lua_internaldofile (void)
|
||||
{
|
||||
lua_Object obj = lua_getparam (1);
|
||||
char *fname = NULL;
|
||||
if (lua_isstring(obj))
|
||||
fname = lua_getstring(obj);
|
||||
else if (obj != LUA_NOOBJECT)
|
||||
lua_error("invalid argument to function `dofile'");
|
||||
/* else fname = NULL */
|
||||
if (!lua_dofile(fname))
|
||||
lua_pushnumber(1);
|
||||
else
|
||||
lua_pushnil();
|
||||
}
|
||||
|
||||
|
||||
static char *tostring (lua_Object obj)
|
||||
{
|
||||
char *buff = luaI_buffer(20);
|
||||
if (lua_isstring(obj)) /* get strings and numbers */
|
||||
return lua_getstring(obj);
|
||||
else switch(lua_type(obj))
|
||||
{
|
||||
case LUA_T_FUNCTION:
|
||||
sprintf(buff, "function: %p", (luaI_Address(obj))->value.tf);
|
||||
break;
|
||||
case LUA_T_CFUNCTION:
|
||||
sprintf(buff, "cfunction: %p", lua_getcfunction(obj));
|
||||
break;
|
||||
case LUA_T_ARRAY:
|
||||
sprintf(buff, "table: %p", avalue(luaI_Address(obj)));
|
||||
break;
|
||||
case LUA_T_NIL:
|
||||
sprintf(buff, "nil");
|
||||
break;
|
||||
default:
|
||||
sprintf(buff, "userdata: %p", lua_getuserdata(obj));
|
||||
break;
|
||||
}
|
||||
return buff;
|
||||
}
|
||||
|
||||
void luaI_tostring (void)
|
||||
{
|
||||
lua_pushstring(tostring(lua_getparam(1)));
|
||||
}
|
||||
|
||||
void luaI_print (void)
|
||||
{
|
||||
int i = 1;
|
||||
lua_Object obj;
|
||||
while ((obj = lua_getparam(i++)) != LUA_NOOBJECT)
|
||||
printf("%s\n", tostring(obj));
|
||||
}
|
||||
|
||||
/*
|
||||
** Internal function: return an object type.
|
||||
*/
|
||||
void luaI_type (void)
|
||||
{
|
||||
lua_Object o = lua_getparam(1);
|
||||
int t;
|
||||
if (o == LUA_NOOBJECT)
|
||||
lua_error("no parameter to function 'type'");
|
||||
t = lua_type(o);
|
||||
switch (t)
|
||||
{
|
||||
case LUA_T_NIL :
|
||||
lua_pushliteral("nil");
|
||||
break;
|
||||
case LUA_T_NUMBER :
|
||||
lua_pushliteral("number");
|
||||
break;
|
||||
case LUA_T_STRING :
|
||||
lua_pushliteral("string");
|
||||
break;
|
||||
case LUA_T_ARRAY :
|
||||
lua_pushliteral("table");
|
||||
break;
|
||||
case LUA_T_FUNCTION :
|
||||
case LUA_T_CFUNCTION :
|
||||
lua_pushliteral("function");
|
||||
break;
|
||||
default :
|
||||
lua_pushliteral("userdata");
|
||||
break;
|
||||
}
|
||||
lua_pushnumber(t);
|
||||
}
|
||||
|
||||
/*
|
||||
** Internal function: convert an object to a number
|
||||
*/
|
||||
void lua_obj2number (void)
|
||||
{
|
||||
lua_Object o = lua_getparam(1);
|
||||
if (lua_isnumber(o))
|
||||
lua_pushnumber(lua_getnumber(o));
|
||||
else
|
||||
lua_pushnil();
|
||||
}
|
||||
|
||||
|
||||
void luaI_error (void)
|
||||
{
|
||||
char *s = lua_getstring(lua_getparam(1));
|
||||
if (s == NULL) s = "(no message)";
|
||||
lua_error(s);
|
||||
}
|
||||
|
||||
void luaI_assert (void)
|
||||
{
|
||||
lua_Object p = lua_getparam(1);
|
||||
if (p == LUA_NOOBJECT || lua_isnil(p))
|
||||
lua_error("assertion failed!");
|
||||
}
|
||||
|
||||
void luaI_setglobal (void)
|
||||
{
|
||||
lua_Object name = lua_getparam(1);
|
||||
lua_Object value = lua_getparam(2);
|
||||
if (!lua_isstring(name))
|
||||
lua_error("incorrect argument to function `setglobal'");
|
||||
lua_pushobject(value);
|
||||
lua_storeglobal(lua_getstring(name));
|
||||
lua_pushobject(value); /* return given value */
|
||||
}
|
||||
|
||||
void luaI_getglobal (void)
|
||||
{
|
||||
lua_Object name = lua_getparam(1);
|
||||
if (!lua_isstring(name))
|
||||
lua_error("incorrect argument to function `getglobal'");
|
||||
lua_pushobject(lua_getglobal(lua_getstring(name)));
|
||||
}
|
||||
33
inout.h
33
inout.h
@@ -1,33 +0,0 @@
|
||||
/*
|
||||
** $Id: inout.h,v 1.14 1996/03/15 13:13:13 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;
|
||||
|
||||
FILE *lua_openfile (char *fn);
|
||||
void lua_closefile (void);
|
||||
void lua_openstring (char *s);
|
||||
void lua_closestring (void);
|
||||
|
||||
void lua_internaldofile (void);
|
||||
void lua_internaldostring (void);
|
||||
void luaI_tostring (void);
|
||||
void luaI_print (void);
|
||||
void luaI_type (void);
|
||||
void lua_obj2number (void);
|
||||
void luaI_error (void);
|
||||
void luaI_assert (void);
|
||||
void luaI_setglobal (void);
|
||||
void luaI_getglobal (void);
|
||||
|
||||
#endif
|
||||
624
iolib.c
624
iolib.c
@@ -1,624 +0,0 @@
|
||||
/*
|
||||
** iolib.c
|
||||
** Input/output library to LUA
|
||||
*/
|
||||
|
||||
char *rcs_iolib="$Id: iolib.c,v 1.39 1996/03/14 15:55:18 roberto Exp roberto $";
|
||||
|
||||
#include <stdio.h>
|
||||
#include <ctype.h>
|
||||
#include <sys/types.h>
|
||||
#include <sys/stat.h>
|
||||
#include <string.h>
|
||||
#include <time.h>
|
||||
#include <stdlib.h>
|
||||
#include <errno.h>
|
||||
|
||||
#include "lua.h"
|
||||
#include "luadebug.h"
|
||||
#include "lualib.h"
|
||||
|
||||
static FILE *in=stdin, *out=stdout;
|
||||
|
||||
|
||||
#ifdef POPEN
|
||||
FILE *popen();
|
||||
int pclose();
|
||||
#else
|
||||
#define popen(x,y) NULL /* that is, popen always fails */
|
||||
#define pclose(x) (-1)
|
||||
#endif
|
||||
|
||||
|
||||
static void pushresult (int i)
|
||||
{
|
||||
if (i)
|
||||
lua_pushnumber (1);
|
||||
else
|
||||
lua_pushnil();
|
||||
}
|
||||
|
||||
static void closeread (void)
|
||||
{
|
||||
if (in != stdin)
|
||||
{
|
||||
if (pclose(in) == -1)
|
||||
fclose(in);
|
||||
in = stdin;
|
||||
}
|
||||
}
|
||||
|
||||
static void closewrite (void)
|
||||
{
|
||||
if (out != stdout)
|
||||
{
|
||||
if (pclose(out) == -1)
|
||||
fclose(out);
|
||||
out = stdout;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
** Open a file to read.
|
||||
** LUA interface:
|
||||
** status = readfrom (filename)
|
||||
** where:
|
||||
** status = 1 -> success
|
||||
** status = nil -> error
|
||||
*/
|
||||
static void io_readfrom (void)
|
||||
{
|
||||
if (lua_getparam (1) == LUA_NOOBJECT)
|
||||
{ /* restore standart input */
|
||||
closeread();
|
||||
lua_pushnumber (1);
|
||||
}
|
||||
else
|
||||
{
|
||||
char *s = lua_check_string(1, "readfrom");
|
||||
FILE *fp = (*s == '|') ? popen(s+1, "r") : fopen(s, "r");
|
||||
if (fp == NULL)
|
||||
lua_pushnil();
|
||||
else
|
||||
{
|
||||
closeread();
|
||||
in = fp;
|
||||
lua_pushnumber (1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Open a file to write.
|
||||
** LUA interface:
|
||||
** status = writeto (filename)
|
||||
** where:
|
||||
** status = 1 -> success
|
||||
** status = nil -> error
|
||||
*/
|
||||
static void io_writeto (void)
|
||||
{
|
||||
if (lua_getparam (1) == LUA_NOOBJECT) /* restore standart output */
|
||||
{
|
||||
closewrite();
|
||||
lua_pushnumber (1);
|
||||
}
|
||||
else
|
||||
{
|
||||
char *s = lua_check_string(1, "writeto");
|
||||
FILE *fp = (*s == '|') ? popen(s+1,"w") : fopen(s,"w");
|
||||
if (fp == NULL)
|
||||
lua_pushnil();
|
||||
else
|
||||
{
|
||||
closewrite();
|
||||
out = fp;
|
||||
lua_pushnumber (1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Open a file to write appended.
|
||||
** LUA interface:
|
||||
** status = appendto (filename)
|
||||
** where:
|
||||
** status = 2 -> success (already exist)
|
||||
** status = 1 -> success (new file)
|
||||
** status = nil -> error
|
||||
*/
|
||||
static void io_appendto (void)
|
||||
{
|
||||
char *s = lua_check_string(1, "appendto");
|
||||
struct stat st;
|
||||
int r = (stat(s, &st) == -1) ? 1 : 2;
|
||||
FILE *fp = fopen (s, "a");
|
||||
if (fp == NULL)
|
||||
lua_pushnil();
|
||||
else
|
||||
{
|
||||
if (out != stdout) fclose (out);
|
||||
out = fp;
|
||||
lua_pushnumber (r);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static char getformat (char *f, int *just, int *m, int *n)
|
||||
{
|
||||
int t;
|
||||
switch (*f++)
|
||||
{
|
||||
case 'q': case 'Q':
|
||||
case 's': case 'S':
|
||||
case 'i': case 'I':
|
||||
t = tolower(*(f-1));
|
||||
break;
|
||||
case 'f': case 'F': case 'g': case 'G': case 'e': case 'E':
|
||||
t = 'f';
|
||||
break;
|
||||
default:
|
||||
t = 0; /* to avoid compiler warnings */
|
||||
lua_arg_error("read/write (format)");
|
||||
}
|
||||
*just = (*f == '<' || *f == '>' || *f == '|') ? *f++ : '>';
|
||||
if (isdigit(*f))
|
||||
{
|
||||
*m = 0;
|
||||
while (isdigit(*f))
|
||||
*m = *m*10 + (*f++ - '0');
|
||||
}
|
||||
else
|
||||
*m = -1;
|
||||
if (*f == '.')
|
||||
{
|
||||
f++; /* skip point */
|
||||
*n = 0;
|
||||
while (isdigit(*f))
|
||||
*n = *n*10 + (*f++ - '0');
|
||||
}
|
||||
else
|
||||
*n = -1;
|
||||
return t;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Read a variable. On error put nil on stack.
|
||||
** LUA interface:
|
||||
** variable = read ([format])
|
||||
**
|
||||
** O formato pode ter um dos seguintes especificadores:
|
||||
**
|
||||
** s ou S -> para string
|
||||
** f ou F, g ou G, e ou E -> para reais
|
||||
** i ou I -> para inteiros
|
||||
**
|
||||
** Estes especificadores podem vir seguidos de numero que representa
|
||||
** o numero de campos a serem lidos.
|
||||
*/
|
||||
|
||||
static int read_until_char (int del)
|
||||
{
|
||||
int c;
|
||||
while((c = fgetc(in)) != EOF && c != del)
|
||||
luaI_addchar(c);
|
||||
return c;
|
||||
}
|
||||
|
||||
static void read_until_blank (void)
|
||||
{
|
||||
int c;
|
||||
while((c = fgetc(in)) != EOF && !isspace(c))
|
||||
luaI_addchar(c);
|
||||
if (c != EOF) ungetc(c,in);
|
||||
}
|
||||
|
||||
static void read_m (int m)
|
||||
{
|
||||
int c;
|
||||
while (m-- && (c = fgetc(in)) != EOF)
|
||||
luaI_addchar(c);
|
||||
}
|
||||
|
||||
|
||||
static void read_free (void)
|
||||
{
|
||||
int c;
|
||||
while (isspace(c=fgetc(in)))
|
||||
;
|
||||
if (c == EOF)
|
||||
{
|
||||
lua_pushnil();
|
||||
return;
|
||||
}
|
||||
if (c == '\"' || c == '\'')
|
||||
{ /* string */
|
||||
c = read_until_char(c);
|
||||
if (c == EOF)
|
||||
lua_pushnil();
|
||||
else
|
||||
lua_pushstring(luaI_addchar(0));
|
||||
}
|
||||
else
|
||||
{
|
||||
double d;
|
||||
char dummy;
|
||||
char *s;
|
||||
luaI_addchar(c);
|
||||
read_until_blank();
|
||||
s = luaI_addchar(0);
|
||||
if (sscanf(s, "%lf %c", &d, &dummy) == 1)
|
||||
lua_pushnumber(d);
|
||||
else
|
||||
lua_pushstring(s);
|
||||
}
|
||||
}
|
||||
|
||||
static void io_read (void)
|
||||
{
|
||||
lua_Object o = lua_getparam (1);
|
||||
luaI_addchar(0); /* initialize buffer */
|
||||
if (o == LUA_NOOBJECT) /* free format */
|
||||
read_free();
|
||||
else /* formatted */
|
||||
{
|
||||
int m, dummy1, dummy2;
|
||||
switch (getformat(lua_check_string(1, "read"), &dummy1, &m, &dummy2))
|
||||
{
|
||||
case 's':
|
||||
{
|
||||
char *s;
|
||||
if (m < 0)
|
||||
read_until_blank();
|
||||
else
|
||||
read_m(m);
|
||||
s = luaI_addchar(0);
|
||||
if ((m >= 0 && strlen(s) == m) || (m < 0 && strlen(s) > 0))
|
||||
lua_pushstring(s);
|
||||
else
|
||||
lua_pushnil();
|
||||
break;
|
||||
}
|
||||
|
||||
case 'i': /* can read as float, since it makes no difference to Lua */
|
||||
case 'f':
|
||||
{
|
||||
double d;
|
||||
int result;
|
||||
if (m < 0)
|
||||
result = fscanf(in, "%lf", &d);
|
||||
else
|
||||
{
|
||||
read_m(m);
|
||||
result = sscanf(luaI_addchar(0), "%lf", &d);
|
||||
}
|
||||
if (result == 1)
|
||||
lua_pushnumber(d);
|
||||
else
|
||||
lua_pushnil();
|
||||
break;
|
||||
}
|
||||
default:
|
||||
lua_arg_error("read (format)");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Read characters until a given one. The delimiter is not read.
|
||||
*/
|
||||
static void io_readuntil (void)
|
||||
{
|
||||
int del, c;
|
||||
lua_Object p = lua_getparam(1);
|
||||
luaI_addchar(0); /* initialize buffer */
|
||||
if (p == LUA_NOOBJECT || lua_isnil(p))
|
||||
del = EOF;
|
||||
else
|
||||
del = *lua_check_string(1, "readuntil");
|
||||
c = read_until_char(del);
|
||||
if (c != EOF) ungetc(c,in);
|
||||
lua_pushstring(luaI_addchar(0));
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Write a variable. On error put 0 on stack, otherwise put 1.
|
||||
** LUA interface:
|
||||
** status = write (variable [,format])
|
||||
**
|
||||
** O formato pode ter um dos seguintes especificadores:
|
||||
**
|
||||
** s ou S -> para string
|
||||
** f ou F, g ou G, e ou E -> para reais
|
||||
** i ou I -> para inteiros
|
||||
**
|
||||
** Estes especificadores podem vir seguidos de:
|
||||
**
|
||||
** [?][m][.n]
|
||||
**
|
||||
** onde:
|
||||
** ? -> indica justificacao
|
||||
** < = esquerda
|
||||
** | = centro
|
||||
** > = direita (default)
|
||||
** m -> numero maximo de campos (se exceder estoura)
|
||||
** n -> indica precisao para
|
||||
** reais -> numero de casas decimais
|
||||
** inteiros -> numero minimo de digitos
|
||||
** string -> nao se aplica
|
||||
*/
|
||||
|
||||
static int write_fill (int n, int c)
|
||||
{
|
||||
while (n--)
|
||||
if (fputc(c, out) == EOF)
|
||||
return 0;
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int write_string (char *s, int just, int m)
|
||||
{
|
||||
int status;
|
||||
int l = strlen(s);
|
||||
int pre; /* number of blanks before string */
|
||||
if (m < 0) m = l;
|
||||
else if (l > m)
|
||||
{
|
||||
write_fill(m, '*');
|
||||
return 0;
|
||||
}
|
||||
pre = (just == '<') ? 0 : (just == '>') ? m-l : (m-l)/2;
|
||||
status = write_fill(pre, ' ');
|
||||
status = status && fprintf(out, "%s", s) >= 0;
|
||||
status = status && write_fill(m-(l+pre), ' ');
|
||||
return status;
|
||||
}
|
||||
|
||||
static int write_quoted (int just, int m)
|
||||
{
|
||||
luaI_addchar(0);
|
||||
luaI_addquoted(lua_check_string(1, "write"));
|
||||
return write_string(luaI_addchar(0), just, m);
|
||||
}
|
||||
|
||||
static int write_float (int just, int m, int n)
|
||||
{
|
||||
char buffer[100];
|
||||
lua_Object p = lua_getparam(1);
|
||||
float number;
|
||||
if (!lua_isnumber(p)) return 0;
|
||||
number = lua_getnumber(p);
|
||||
if (n >= 0)
|
||||
sprintf(buffer, "%.*f", n, number);
|
||||
else
|
||||
sprintf(buffer, "%g", number);
|
||||
return write_string(buffer, just, m);
|
||||
}
|
||||
|
||||
|
||||
static int write_int (int just, int m, int n)
|
||||
{
|
||||
char buffer[100];
|
||||
lua_Object p = lua_getparam(1);
|
||||
int number;
|
||||
if (!lua_isnumber(p)) return 0;
|
||||
number = (int)lua_getnumber(p);
|
||||
if (n >= 0)
|
||||
sprintf(buffer, "%.*d", n, number);
|
||||
else
|
||||
sprintf(buffer, "%d", number);
|
||||
return write_string(buffer, just, m);
|
||||
}
|
||||
|
||||
|
||||
static void io_write (void)
|
||||
{
|
||||
int status = 0;
|
||||
if (lua_getparam (2) == LUA_NOOBJECT) /* free format */
|
||||
{
|
||||
lua_Object o1 = lua_getparam(1);
|
||||
int t = lua_type(o1);
|
||||
if (t == LUA_T_NUMBER)
|
||||
status = fprintf (out, "%g", lua_getnumber(o1)) >= 0;
|
||||
else if (t == LUA_T_STRING)
|
||||
status = fprintf (out, "%s", lua_getstring(o1)) >= 0;
|
||||
}
|
||||
else /* formated */
|
||||
{
|
||||
int just, m, n;
|
||||
switch (getformat(lua_check_string(2, "write"), &just, &m, &n))
|
||||
{
|
||||
case 's':
|
||||
{
|
||||
lua_Object p = lua_getparam(1);
|
||||
if (lua_isstring(p))
|
||||
status = write_string(lua_getstring(p), just, m);
|
||||
else
|
||||
status = 0;
|
||||
break;
|
||||
}
|
||||
case 'q':
|
||||
status = write_quoted(just, m);
|
||||
break;
|
||||
case 'f':
|
||||
status = write_float(just, m, n);
|
||||
break;
|
||||
case 'i':
|
||||
status = write_int(just, m, n);
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (status)
|
||||
lua_pushnumber(status);
|
||||
else
|
||||
lua_pushnil();
|
||||
}
|
||||
|
||||
/*
|
||||
** Execute a executable program using "system".
|
||||
** Return the result of execution.
|
||||
*/
|
||||
static void io_execute (void)
|
||||
{
|
||||
lua_pushnumber(system(lua_check_string(1, "execute")));
|
||||
}
|
||||
|
||||
/*
|
||||
** Remove a file. On error return nil.
|
||||
*/
|
||||
static void io_remove (void)
|
||||
{
|
||||
pushresult(remove(lua_check_string(1, "remove")) == 0);
|
||||
}
|
||||
|
||||
static void io_rename (void)
|
||||
{
|
||||
char *f1 = lua_check_string(1, "rename");
|
||||
char *f2 = lua_check_string(2, "rename");
|
||||
pushresult(rename(f1, f2) == 0);
|
||||
}
|
||||
|
||||
static void io_tmpname (void)
|
||||
{
|
||||
lua_pushstring(tmpnam(NULL));
|
||||
}
|
||||
|
||||
static void io_errorno (void)
|
||||
{
|
||||
/* lua_pushstring(strerror(errno));*/
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** To get a environment variable
|
||||
*/
|
||||
static void io_getenv (void)
|
||||
{
|
||||
char *env = getenv(lua_check_string(1, "getenv"));
|
||||
lua_pushstring(env); /* if NULL push nil */
|
||||
}
|
||||
|
||||
/*
|
||||
** Return user formatted time stamp
|
||||
*/
|
||||
static void io_date (void)
|
||||
{
|
||||
time_t t;
|
||||
struct tm *tm;
|
||||
char *s;
|
||||
char b[BUFSIZ];
|
||||
if (lua_getparam(1) == LUA_NOOBJECT)
|
||||
s = "%c";
|
||||
else
|
||||
s = lua_check_string(1, "date");
|
||||
time(&t); tm = localtime(&t);
|
||||
if (strftime(b,sizeof(b),s,tm))
|
||||
lua_pushstring(b);
|
||||
else
|
||||
lua_error("invalid `date' format");
|
||||
}
|
||||
|
||||
/*
|
||||
** To exit
|
||||
*/
|
||||
static void io_exit (void)
|
||||
{
|
||||
lua_Object o = lua_getparam(1);
|
||||
if (lua_isstring(o))
|
||||
fprintf(stderr, "%s\n", lua_getstring(o));
|
||||
exit(1);
|
||||
}
|
||||
|
||||
/*
|
||||
** To debug a lua program. Start a dialog with the user, interpreting
|
||||
lua commands until an 'cont'.
|
||||
*/
|
||||
static void io_debug (void)
|
||||
{
|
||||
while (1)
|
||||
{
|
||||
char buffer[250];
|
||||
fprintf(stderr, "lua_debug> ");
|
||||
if (fgets(buffer, sizeof(buffer), stdin) == 0) return;
|
||||
if (strcmp(buffer, "cont") == 0) return;
|
||||
lua_dostring(buffer);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
void lua_printstack (FILE *f)
|
||||
{
|
||||
int level = 0;
|
||||
lua_Object func;
|
||||
fprintf(f, "Active Stack:\n");
|
||||
while ((func = lua_stackedfunction(level++)) != LUA_NOOBJECT)
|
||||
{
|
||||
char *name;
|
||||
int currentline;
|
||||
fprintf(f, "\t");
|
||||
switch (*lua_getobjname(func, &name))
|
||||
{
|
||||
case 'g':
|
||||
fprintf(f, "function %s", name);
|
||||
break;
|
||||
case 'f':
|
||||
fprintf(f, "`%s' fallback", name);
|
||||
break;
|
||||
default:
|
||||
{
|
||||
char *filename;
|
||||
int linedefined;
|
||||
lua_funcinfo(func, &filename, &linedefined);
|
||||
if (linedefined == 0)
|
||||
fprintf(f, "main of %s", filename);
|
||||
else if (linedefined < 0)
|
||||
fprintf(f, "%s", filename);
|
||||
else
|
||||
fprintf(f, "function (%s:%d)", filename, linedefined);
|
||||
}
|
||||
}
|
||||
if ((currentline = lua_currentline(func)) > 0)
|
||||
fprintf(f, " at line %d", currentline);
|
||||
fprintf(f, "\n");
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void errorfb (void)
|
||||
{
|
||||
lua_Object o = lua_getparam(1);
|
||||
char *s = lua_isstring(o) ? lua_getstring(o) : "(no messsage)";
|
||||
fprintf(stderr, "lua: %s\n", s);
|
||||
lua_printstack(stderr);
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Open io library
|
||||
*/
|
||||
void iolib_open (void)
|
||||
{
|
||||
lua_register ("readfrom", io_readfrom);
|
||||
lua_register ("writeto", io_writeto);
|
||||
lua_register ("appendto", io_appendto);
|
||||
lua_register ("read", io_read);
|
||||
lua_register ("readuntil",io_readuntil);
|
||||
lua_register ("write", io_write);
|
||||
lua_register ("execute", io_execute);
|
||||
lua_register ("remove", io_remove);
|
||||
lua_register ("rename", io_rename);
|
||||
lua_register ("tmpname", io_tmpname);
|
||||
lua_register ("ioerror", io_errorno);
|
||||
lua_register ("getenv", io_getenv);
|
||||
lua_register ("date", io_date);
|
||||
lua_register ("exit", io_exit);
|
||||
lua_register ("debug", io_debug);
|
||||
lua_register ("print_stack", errorfb);
|
||||
lua_setfallback("error", errorfb);
|
||||
}
|
||||
|
||||
631
lapi.c
Normal file
631
lapi.c
Normal file
@@ -0,0 +1,631 @@
|
||||
/*
|
||||
** $Id: lapi.c,v 1.24 1998/03/09 21:49:52 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.s.globalval);
|
||||
}
|
||||
|
||||
|
||||
void lua_setglobal (char *name)
|
||||
{
|
||||
checkCparams(1);
|
||||
luaD_checkstack(2); /* may need that to call T.M. */
|
||||
luaV_setglobal(luaS_new(name));
|
||||
}
|
||||
|
||||
|
||||
void lua_rawsetglobal (char *name)
|
||||
{
|
||||
TaggedString *ts = luaS_new(name);
|
||||
checkCparams(1);
|
||||
luaS_rawsetglobal(ts, --L->stack.top);
|
||||
}
|
||||
|
||||
|
||||
|
||||
int lua_isnil (lua_Object o)
|
||||
{
|
||||
return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_NIL);
|
||||
}
|
||||
|
||||
int lua_istable (lua_Object o)
|
||||
{
|
||||
return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_ARRAY);
|
||||
}
|
||||
|
||||
int lua_isuserdata (lua_Object o)
|
||||
{
|
||||
return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_USERDATA);
|
||||
}
|
||||
|
||||
int lua_iscfunction (lua_Object o)
|
||||
{
|
||||
return (lua_tag(o) == LUA_T_CPROTO);
|
||||
}
|
||||
|
||||
int lua_isnumber (lua_Object o)
|
||||
{
|
||||
return (o!= LUA_NOOBJECT) && (tonumber(Address(o)) == 0);
|
||||
}
|
||||
|
||||
int lua_isstring (lua_Object o)
|
||||
{
|
||||
int t = lua_tag(o);
|
||||
return (t == LUA_T_STRING) || (t == LUA_T_NUMBER);
|
||||
}
|
||||
|
||||
int lua_isfunction (lua_Object o)
|
||||
{
|
||||
int t = lua_tag(o);
|
||||
return (t == LUA_T_PROTO) || (t == LUA_T_CPROTO);
|
||||
}
|
||||
|
||||
|
||||
double lua_getnumber (lua_Object object)
|
||||
{
|
||||
if (object == LUA_NOOBJECT) return 0.0;
|
||||
if (tonumber(Address(object))) return 0.0;
|
||||
else return (nvalue(Address(object)));
|
||||
}
|
||||
|
||||
char *lua_getstring (lua_Object object)
|
||||
{
|
||||
luaC_checkGC(); /* "tostring" may create a new string */
|
||||
if (object == LUA_NOOBJECT || tostring(Address(object)))
|
||||
return NULL;
|
||||
else return (svalue(Address(object)));
|
||||
}
|
||||
|
||||
long lua_strlen (lua_Object object)
|
||||
{
|
||||
luaC_checkGC(); /* "tostring" may create a new string */
|
||||
if (object == LUA_NOOBJECT || tostring(Address(object)))
|
||||
return 0L;
|
||||
else return (tsvalue(Address(object))->u.s.len);
|
||||
}
|
||||
|
||||
void *lua_getuserdata (lua_Object object)
|
||||
{
|
||||
if (object == LUA_NOOBJECT || ttype(Address(object)) != LUA_T_USERDATA)
|
||||
return NULL;
|
||||
else return tsvalue(Address(object))->u.d.v;
|
||||
}
|
||||
|
||||
lua_CFunction lua_getcfunction (lua_Object object)
|
||||
{
|
||||
if (!lua_iscfunction(object))
|
||||
return NULL;
|
||||
else return fvalue(luaA_protovalue(Address(object)));
|
||||
}
|
||||
|
||||
|
||||
void lua_pushnil (void)
|
||||
{
|
||||
ttype(L->stack.top) = LUA_T_NIL;
|
||||
incr_top;
|
||||
}
|
||||
|
||||
void lua_pushnumber (double n)
|
||||
{
|
||||
ttype(L->stack.top) = LUA_T_NUMBER;
|
||||
nvalue(L->stack.top) = n;
|
||||
incr_top;
|
||||
}
|
||||
|
||||
void lua_pushlstring (char *s, long len)
|
||||
{
|
||||
tsvalue(L->stack.top) = luaS_newlstr(s, len);
|
||||
ttype(L->stack.top) = LUA_T_STRING;
|
||||
incr_top;
|
||||
luaC_checkGC();
|
||||
}
|
||||
|
||||
void lua_pushstring (char *s)
|
||||
{
|
||||
if (s == NULL)
|
||||
lua_pushnil();
|
||||
else
|
||||
lua_pushlstring(s, strlen(s));
|
||||
}
|
||||
|
||||
void lua_pushcclosure (lua_CFunction fn, int n)
|
||||
{
|
||||
if (fn == NULL)
|
||||
lua_error("API error - attempt to push a NULL Cfunction");
|
||||
checkCparams(n);
|
||||
ttype(L->stack.top) = LUA_T_CPROTO;
|
||||
fvalue(L->stack.top) = fn;
|
||||
incr_top;
|
||||
luaV_closure(n);
|
||||
luaC_checkGC();
|
||||
}
|
||||
|
||||
void lua_pushusertag (void *u, int tag)
|
||||
{
|
||||
if (tag < 0 && tag != LUA_ANYTAG)
|
||||
luaT_realtag(tag); /* error if tag is not valid */
|
||||
tsvalue(L->stack.top) = luaS_createudata(u, tag);
|
||||
ttype(L->stack.top) = LUA_T_USERDATA;
|
||||
incr_top;
|
||||
luaC_checkGC();
|
||||
}
|
||||
|
||||
void luaA_pushobject (TObject *o)
|
||||
{
|
||||
*L->stack.top = *o;
|
||||
incr_top;
|
||||
}
|
||||
|
||||
void lua_pushobject (lua_Object o)
|
||||
{
|
||||
if (o == LUA_NOOBJECT)
|
||||
lua_error("API error - attempt to push a NOOBJECT");
|
||||
else {
|
||||
set_normalized(L->stack.top, Address(o));
|
||||
incr_top;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
int lua_tag (lua_Object lo)
|
||||
{
|
||||
if (lo == LUA_NOOBJECT)
|
||||
return LUA_T_NIL;
|
||||
else {
|
||||
TObject *o = Address(lo);
|
||||
int t;
|
||||
switch (t = ttype(o)) {
|
||||
case LUA_T_USERDATA:
|
||||
return o->value.ts->u.d.tag;
|
||||
case LUA_T_ARRAY:
|
||||
return o->value.a->htag;
|
||||
case LUA_T_PMARK:
|
||||
return LUA_T_PROTO;
|
||||
case LUA_T_CMARK:
|
||||
return LUA_T_CPROTO;
|
||||
case LUA_T_CLOSURE: case LUA_T_CLMARK:
|
||||
return o->value.cl->consts[0].ttype;
|
||||
#ifdef DEBUG
|
||||
case LUA_T_LINE:
|
||||
LUA_INTERNALERROR("invalid type");
|
||||
#endif
|
||||
default:
|
||||
return t;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
void lua_settag (int tag)
|
||||
{
|
||||
checkCparams(1);
|
||||
luaT_realtag(tag);
|
||||
switch (ttype(L->stack.top-1)) {
|
||||
case LUA_T_ARRAY:
|
||||
(L->stack.top-1)->value.a->htag = tag;
|
||||
break;
|
||||
case LUA_T_USERDATA:
|
||||
(L->stack.top-1)->value.ts->u.d.tag = tag;
|
||||
break;
|
||||
default:
|
||||
luaL_verror("cannot change the tag of a %.20s",
|
||||
luaO_typenames[-ttype((L->stack.top-1))]);
|
||||
}
|
||||
L->stack.top--;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** =======================================================
|
||||
** Debug interface
|
||||
** =======================================================
|
||||
*/
|
||||
|
||||
|
||||
/* Hooks */
|
||||
lua_CHFunction lua_callhook = NULL;
|
||||
lua_LHFunction lua_linehook = NULL;
|
||||
|
||||
|
||||
lua_Function lua_stackedfunction (int level)
|
||||
{
|
||||
StkId i;
|
||||
for (i = (L->stack.top-1)-L->stack.stack; i>=0; i--) {
|
||||
int t = L->stack.stack[i].ttype;
|
||||
if (t == LUA_T_CLMARK || t == LUA_T_PMARK || t == LUA_T_CMARK)
|
||||
if (level-- == 0)
|
||||
return Ref(L->stack.stack+i);
|
||||
}
|
||||
return LUA_NOOBJECT;
|
||||
}
|
||||
|
||||
|
||||
int lua_currentline (lua_Function func)
|
||||
{
|
||||
TObject *f = Address(func);
|
||||
return (f+1 < L->stack.top && (f+1)->ttype == LUA_T_LINE) ?
|
||||
(f+1)->value.i : -1;
|
||||
}
|
||||
|
||||
|
||||
lua_Object lua_getlocal (lua_Function func, int local_number, char **name)
|
||||
{
|
||||
/* check whether func is a Lua function */
|
||||
if (lua_tag(func) != LUA_T_PROTO)
|
||||
return LUA_NOOBJECT;
|
||||
else {
|
||||
TObject *f = Address(func);
|
||||
TProtoFunc *fp = luaA_protovalue(f)->value.tf;
|
||||
*name = luaF_getlocalname(fp, local_number, lua_currentline(func));
|
||||
if (*name) {
|
||||
/* if "*name", there must be a LUA_T_LINE */
|
||||
/* therefore, f+2 points to function base */
|
||||
return Ref((f+2)+(local_number-1));
|
||||
}
|
||||
else
|
||||
return LUA_NOOBJECT;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
int lua_setlocal (lua_Function func, int local_number)
|
||||
{
|
||||
/* check whether func is a Lua function */
|
||||
if (lua_tag(func) != LUA_T_PROTO)
|
||||
return 0;
|
||||
else {
|
||||
TObject *f = Address(func);
|
||||
TProtoFunc *fp = luaA_protovalue(f)->value.tf;
|
||||
char *name = luaF_getlocalname(fp, local_number, lua_currentline(func));
|
||||
checkCparams(1);
|
||||
--L->stack.top;
|
||||
if (name) {
|
||||
/* if "name", there must be a LUA_T_LINE */
|
||||
/* therefore, f+2 points to function base */
|
||||
*((f+2)+(local_number-1)) = *L->stack.top;
|
||||
return 1;
|
||||
}
|
||||
else
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
void lua_funcinfo (lua_Object func, char **filename, int *linedefined)
|
||||
{
|
||||
if (!lua_isfunction(func))
|
||||
lua_error("API - `funcinfo' called with a non-function value");
|
||||
else {
|
||||
TObject *f = luaA_protovalue(Address(func));
|
||||
if (normalized_type(f) == LUA_T_PROTO) {
|
||||
*filename = tfvalue(f)->fileName->str;
|
||||
*linedefined = tfvalue(f)->lineDefined;
|
||||
}
|
||||
else {
|
||||
*filename = "(C)";
|
||||
*linedefined = -1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static int checkfunc (TObject *o)
|
||||
{
|
||||
return luaO_equalObj(o, L->stack.top);
|
||||
}
|
||||
|
||||
|
||||
char *lua_getobjname (lua_Object o, char **name)
|
||||
{ /* try to find a name for given function */
|
||||
set_normalized(L->stack.top, Address(o)); /* to be accessed by "checkfunc */
|
||||
if ((*name = luaT_travtagmethods(checkfunc)) != NULL)
|
||||
return "tag-method";
|
||||
else if ((*name = luaS_travsymbol(checkfunc)) != NULL)
|
||||
return "global";
|
||||
else return "";
|
||||
}
|
||||
|
||||
/*
|
||||
** =======================================================
|
||||
** BLOCK mechanism
|
||||
** =======================================================
|
||||
*/
|
||||
|
||||
|
||||
void lua_beginblock (void)
|
||||
{
|
||||
if (L->numCblocks >= MAX_C_BLOCKS)
|
||||
lua_error("too many nested blocks");
|
||||
L->Cblocks[L->numCblocks] = L->Cstack;
|
||||
L->numCblocks++;
|
||||
}
|
||||
|
||||
void lua_endblock (void)
|
||||
{
|
||||
--L->numCblocks;
|
||||
L->Cstack = L->Cblocks[L->numCblocks];
|
||||
luaD_adjusttop(L->Cstack.base);
|
||||
}
|
||||
|
||||
|
||||
|
||||
int lua_ref (int lock)
|
||||
{
|
||||
int ref;
|
||||
checkCparams(1);
|
||||
ref = luaC_ref(L->stack.top-1, lock);
|
||||
L->stack.top--;
|
||||
return ref;
|
||||
}
|
||||
|
||||
|
||||
|
||||
lua_Object lua_getref (int ref)
|
||||
{
|
||||
TObject *o = luaC_getref(ref);
|
||||
return (o ? put_luaObject(o) : LUA_NOOBJECT);
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** =======================================================
|
||||
** Derived functions
|
||||
** =======================================================
|
||||
*/
|
||||
int (lua_call) (char *name) { return lua_call(name); }
|
||||
|
||||
void (lua_pushref) (int ref) { lua_pushref(ref); }
|
||||
|
||||
int (lua_refobject) (lua_Object o, int l) { return lua_refobject(o, l); }
|
||||
|
||||
void (lua_register) (char *n, lua_CFunction f) { lua_register(n, f); }
|
||||
|
||||
void (lua_pushuserdata) (void *u) { lua_pushuserdata(u); }
|
||||
|
||||
void (lua_pushcfunction) (lua_CFunction f) { lua_pushcfunction(f); }
|
||||
|
||||
int (lua_clonetag) (int t) { return lua_clonetag(t); }
|
||||
|
||||
|
||||
|
||||
|
||||
#ifdef LUA_COMPAT2_5
|
||||
/*
|
||||
** API: set a function as a fallback
|
||||
*/
|
||||
|
||||
static void do_unprotectedrun (lua_CFunction f, int nParams, int nResults)
|
||||
{
|
||||
StkId base = (L->stack.top-L->stack.stack)-nParams;
|
||||
luaD_openstack(nParams);
|
||||
L->stack.stack[base].ttype = LUA_T_CPROTO;
|
||||
L->stack.stack[base].value.f = f;
|
||||
luaD_call(base+1, nResults);
|
||||
}
|
||||
|
||||
lua_Object lua_setfallback (char *name, lua_CFunction fallback)
|
||||
{
|
||||
lua_pushstring(name);
|
||||
lua_pushcfunction(fallback);
|
||||
do_unprotectedrun(luaT_setfallback, 2, 1);
|
||||
return put_luaObjectonTop();
|
||||
}
|
||||
#endif
|
||||
|
||||
20
lapi.h
Normal file
20
lapi.h
Normal file
@@ -0,0 +1,20 @@
|
||||
/*
|
||||
** $Id: lapi.h,v 1.1 1997/09/16 19:25:59 roberto Exp roberto $
|
||||
** Auxiliary functions from Lua API
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
#ifndef lapi_h
|
||||
#define lapi_h
|
||||
|
||||
|
||||
#include "lua.h"
|
||||
#include "lobject.h"
|
||||
|
||||
|
||||
TObject *luaA_Address (lua_Object o);
|
||||
void luaA_pushobject (TObject *o);
|
||||
void luaA_packresults (void);
|
||||
int luaA_passresults (void);
|
||||
|
||||
#endif
|
||||
111
lauxlib.c
Normal file
111
lauxlib.c
Normal file
@@ -0,0 +1,111 @@
|
||||
/*
|
||||
** $Id: lauxlib.c,v 1.11 1998/06/18 16:57:03 roberto Exp roberto $
|
||||
** Auxiliary functions for building Lua libraries
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
#include <stdarg.h>
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
|
||||
/* Please Notice: This file uses only the official API of Lua
|
||||
** Any function declared here could be written as an application
|
||||
** function. With care, these functions can be used by other libraries.
|
||||
*/
|
||||
#include "lauxlib.h"
|
||||
#include "lua.h"
|
||||
#include "luadebug.h"
|
||||
|
||||
|
||||
|
||||
int luaL_findstring (char *name, char *list[]) {
|
||||
int i;
|
||||
for (i=0; list[i]; i++)
|
||||
if (strcmp(list[i], name) == 0)
|
||||
return i;
|
||||
return -1; /* name not found */
|
||||
}
|
||||
|
||||
void luaL_argerror (int numarg, char *extramsg)
|
||||
{
|
||||
char *funcname;
|
||||
lua_getobjname(lua_stackedfunction(0), &funcname);
|
||||
if (funcname == NULL)
|
||||
funcname = "???";
|
||||
if (extramsg == NULL)
|
||||
luaL_verror("bad argument #%d to function `%.50s'", numarg, funcname);
|
||||
else
|
||||
luaL_verror("bad argument #%d to function `%.50s' (%.100s)",
|
||||
numarg, funcname, extramsg);
|
||||
}
|
||||
|
||||
char *luaL_check_lstr (int numArg, long *len)
|
||||
{
|
||||
lua_Object o = lua_getparam(numArg);
|
||||
luaL_arg_check(lua_isstring(o), numArg, "string expected");
|
||||
if (len) *len = lua_strlen(o);
|
||||
return lua_getstring(o);
|
||||
}
|
||||
|
||||
char *luaL_opt_lstr (int numArg, char *def, long *len)
|
||||
{
|
||||
return (lua_getparam(numArg) == LUA_NOOBJECT) ? def :
|
||||
luaL_check_lstr(numArg, len);
|
||||
}
|
||||
|
||||
double luaL_check_number (int numArg)
|
||||
{
|
||||
lua_Object o = lua_getparam(numArg);
|
||||
luaL_arg_check(lua_isnumber(o), numArg, "number expected");
|
||||
return lua_getnumber(o);
|
||||
}
|
||||
|
||||
|
||||
double luaL_opt_number (int numArg, double def)
|
||||
{
|
||||
return (lua_getparam(numArg) == LUA_NOOBJECT) ? def :
|
||||
luaL_check_number(numArg);
|
||||
}
|
||||
|
||||
|
||||
lua_Object luaL_tablearg (int arg)
|
||||
{
|
||||
lua_Object o = lua_getparam(arg);
|
||||
luaL_arg_check(lua_istable(o), arg, "table expected");
|
||||
return o;
|
||||
}
|
||||
|
||||
lua_Object luaL_functionarg (int arg)
|
||||
{
|
||||
lua_Object o = lua_getparam(arg);
|
||||
luaL_arg_check(lua_isfunction(o), arg, "function expected");
|
||||
return o;
|
||||
}
|
||||
|
||||
lua_Object luaL_nonnullarg (int numArg)
|
||||
{
|
||||
lua_Object o = lua_getparam(numArg);
|
||||
luaL_arg_check(o != LUA_NOOBJECT, numArg, "value expected");
|
||||
return o;
|
||||
}
|
||||
|
||||
void luaL_openlib (struct luaL_reg *l, int n)
|
||||
{
|
||||
int i;
|
||||
lua_open(); /* make sure lua is already open */
|
||||
for (i=0; i<n; i++)
|
||||
lua_register(l[i].name, l[i].func);
|
||||
}
|
||||
|
||||
|
||||
void luaL_verror (char *fmt, ...)
|
||||
{
|
||||
char buff[500];
|
||||
va_list argp;
|
||||
va_start(argp, fmt);
|
||||
vsprintf(buff, fmt, argp);
|
||||
va_end(argp);
|
||||
lua_error(buff);
|
||||
}
|
||||
|
||||
47
lauxlib.h
Normal file
47
lauxlib.h
Normal file
@@ -0,0 +1,47 @@
|
||||
/*
|
||||
** $Id: lauxlib.h,v 1.8 1998/06/18 16:57:03 roberto Exp roberto $
|
||||
** Auxiliary 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);
|
||||
#define luaL_check_string(n) (luaL_check_lstr((n), NULL))
|
||||
char *luaL_check_lstr (int numArg, long *len);
|
||||
#define luaL_opt_string(n, d) (luaL_opt_lstr((n), (d), NULL))
|
||||
char *luaL_opt_lstr (int numArg, char *def, long *len);
|
||||
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);
|
||||
int luaL_getsize (void);
|
||||
void luaL_addsize (int n);
|
||||
int luaL_newbuffer (int size);
|
||||
void luaL_oldbuffer (int old);
|
||||
char *luaL_buffer (void);
|
||||
int luaL_findstring (char *name, char *list[]);
|
||||
|
||||
|
||||
#endif
|
||||
85
lbuffer.c
Normal file
85
lbuffer.c
Normal file
@@ -0,0 +1,85 @@
|
||||
/*
|
||||
** $Id: lbuffer.c,v 1.3 1998/06/02 20:37:04 roberto Exp roberto $
|
||||
** Auxiliary functions for building Lua libraries
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
#include <stdio.h>
|
||||
|
||||
#include "lauxlib.h"
|
||||
#include "lmem.h"
|
||||
#include "lstate.h"
|
||||
|
||||
|
||||
/*-------------------------------------------------------
|
||||
** Auxiliary buffer
|
||||
-------------------------------------------------------*/
|
||||
|
||||
#define BUFF_STEP 32
|
||||
|
||||
#define openspace(size) if (L->Mbuffnext+(size) > L->Mbuffsize) Openspace(size)
|
||||
|
||||
static void Openspace (int size)
|
||||
{
|
||||
lua_State *l = L; /* to optimize */
|
||||
int base = l->Mbuffbase-l->Mbuffer;
|
||||
l->Mbuffsize *= 2;
|
||||
if (l->Mbuffnext+size > l->Mbuffsize) /* still not big enough? */
|
||||
l->Mbuffsize = l->Mbuffnext+size;
|
||||
l->Mbuffer = luaM_realloc(l->Mbuffer, l->Mbuffsize);
|
||||
l->Mbuffbase = l->Mbuffer+base;
|
||||
}
|
||||
|
||||
|
||||
char *luaL_openspace (int size)
|
||||
{
|
||||
openspace(size);
|
||||
return L->Mbuffer+L->Mbuffnext;
|
||||
}
|
||||
|
||||
|
||||
void luaL_addchar (int c)
|
||||
{
|
||||
openspace(BUFF_STEP);
|
||||
L->Mbuffer[L->Mbuffnext++] = c;
|
||||
}
|
||||
|
||||
|
||||
void luaL_resetbuffer (void)
|
||||
{
|
||||
L->Mbuffnext = L->Mbuffbase-L->Mbuffer;
|
||||
}
|
||||
|
||||
|
||||
void luaL_addsize (int n)
|
||||
{
|
||||
L->Mbuffnext += n;
|
||||
}
|
||||
|
||||
int luaL_getsize (void)
|
||||
{
|
||||
return L->Mbuffnext-(L->Mbuffbase-L->Mbuffer);
|
||||
}
|
||||
|
||||
int luaL_newbuffer (int size)
|
||||
{
|
||||
int old = L->Mbuffbase-L->Mbuffer;
|
||||
openspace(size);
|
||||
L->Mbuffbase = L->Mbuffer+L->Mbuffnext;
|
||||
return old;
|
||||
}
|
||||
|
||||
|
||||
void luaL_oldbuffer (int old)
|
||||
{
|
||||
L->Mbuffnext = L->Mbuffbase-L->Mbuffer;
|
||||
L->Mbuffbase = L->Mbuffer+old;
|
||||
}
|
||||
|
||||
|
||||
char *luaL_buffer (void)
|
||||
{
|
||||
return L->Mbuffbase;
|
||||
}
|
||||
|
||||
526
lbuiltin.c
Normal file
526
lbuiltin.c
Normal file
@@ -0,0 +1,526 @@
|
||||
/*
|
||||
** $Id: lbuiltin.c,v 1.31 1998/06/19 18:47:06 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"
|
||||
#include "lundump.h"
|
||||
|
||||
|
||||
|
||||
static void pushstring (TaggedString *s)
|
||||
{
|
||||
TObject o;
|
||||
o.ttype = LUA_T_STRING;
|
||||
o.value.ts = s;
|
||||
luaA_pushobject(&o);
|
||||
}
|
||||
|
||||
|
||||
static void nextvar (void)
|
||||
{
|
||||
TObject *o = luaA_Address(luaL_nonnullarg(1));
|
||||
TaggedString *g;
|
||||
if (ttype(o) == LUA_T_NIL)
|
||||
g = (TaggedString *)L->rootglobal.next;
|
||||
else {
|
||||
luaL_arg_check(ttype(o) == LUA_T_STRING, 1, "variable name expected");
|
||||
g = tsvalue(o);
|
||||
/* check whether name is in global var list */
|
||||
luaL_arg_check((GCnode *)g != g->head.next, 1, "variable name expected");
|
||||
g = (TaggedString *)g->head.next;
|
||||
}
|
||||
while (g && g->u.s.globalval.ttype == LUA_T_NIL) /* skip globals with nil */
|
||||
g = (TaggedString *)g->head.next;
|
||||
if (g) {
|
||||
pushstring(g);
|
||||
luaA_pushobject(&g->u.s.globalval);
|
||||
}
|
||||
else lua_pushnil();
|
||||
}
|
||||
|
||||
|
||||
static void foreachvar (void)
|
||||
{
|
||||
TObject f = *luaA_Address(luaL_functionarg(1));
|
||||
GCnode *g;
|
||||
StkId name = L->Cstack.base++; /* place to keep var name (to avoid GC) */
|
||||
ttype(L->stack.stack+name) = LUA_T_NIL;
|
||||
L->stack.top++;
|
||||
for (g = L->rootglobal.next; g; g = g->next) {
|
||||
TaggedString *s = (TaggedString *)g;
|
||||
if (s->u.s.globalval.ttype != LUA_T_NIL) {
|
||||
ttype(L->stack.stack+name) = LUA_T_STRING;
|
||||
tsvalue(L->stack.stack+name) = s; /* keep s on stack to avoid GC */
|
||||
luaA_pushobject(&f);
|
||||
pushstring(s);
|
||||
luaA_pushobject(&s->u.s.globalval);
|
||||
luaD_call((L->stack.top-L->stack.stack)-2, 1);
|
||||
if (ttype(L->stack.top-1) != LUA_T_NIL)
|
||||
return;
|
||||
L->stack.top--;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void next (void)
|
||||
{
|
||||
lua_Object o = luaL_tablearg(1);
|
||||
lua_Object r = luaL_nonnullarg(2);
|
||||
Node *n = luaH_next(luaA_Address(o), luaA_Address(r));
|
||||
if (n) {
|
||||
luaA_pushobject(&n->ref);
|
||||
luaA_pushobject(&n->val);
|
||||
}
|
||||
else lua_pushnil();
|
||||
}
|
||||
|
||||
|
||||
static void foreach (void)
|
||||
{
|
||||
TObject t = *luaA_Address(luaL_tablearg(1));
|
||||
TObject f = *luaA_Address(luaL_functionarg(2));
|
||||
int i;
|
||||
for (i=0; i<avalue(&t)->nhash; i++) {
|
||||
Node *nd = &(avalue(&t)->node[i]);
|
||||
if (ttype(ref(nd)) != LUA_T_NIL && ttype(val(nd)) != LUA_T_NIL) {
|
||||
luaA_pushobject(&f);
|
||||
luaA_pushobject(ref(nd));
|
||||
luaA_pushobject(val(nd));
|
||||
luaD_call((L->stack.top-L->stack.stack)-2, 1);
|
||||
if (ttype(L->stack.top-1) != LUA_T_NIL)
|
||||
return;
|
||||
L->stack.top--;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void internaldostring (void)
|
||||
{
|
||||
long l;
|
||||
char *s = luaL_check_lstr(1, &l);
|
||||
if (*s == ID_CHUNK)
|
||||
lua_error("`dostring' cannot run pre-compiled code");
|
||||
if (lua_dobuffer(s, l, luaL_opt_string(2, NULL)) == 0)
|
||||
if (luaA_passresults() == 0)
|
||||
lua_pushuserdata(NULL); /* at least one result to signal no errors */
|
||||
}
|
||||
|
||||
|
||||
static void internaldofile (void)
|
||||
{
|
||||
char *fname = luaL_opt_string(1, NULL);
|
||||
if (lua_dofile(fname) == 0)
|
||||
if (luaA_passresults() == 0)
|
||||
lua_pushuserdata(NULL); /* at least one result to signal no errors */
|
||||
}
|
||||
|
||||
|
||||
static void to_string (void) {
|
||||
lua_Object obj = lua_getparam(1);
|
||||
char *buff = luaL_openspace(30);
|
||||
TObject *o = luaA_Address(obj);
|
||||
switch (ttype(o)) {
|
||||
case LUA_T_NUMBER:
|
||||
lua_pushstring(lua_getstring(obj));
|
||||
return;
|
||||
case LUA_T_STRING:
|
||||
lua_pushobject(obj);
|
||||
return;
|
||||
case LUA_T_ARRAY: {
|
||||
sprintf(buff, "table: %p", (void *)o->value.a);
|
||||
break;
|
||||
}
|
||||
case LUA_T_CLOSURE: {
|
||||
sprintf(buff, "function: %p", (void *)o->value.cl);
|
||||
break;
|
||||
}
|
||||
case LUA_T_PROTO: {
|
||||
sprintf(buff, "function: %p", (void *)o->value.tf);
|
||||
break;
|
||||
}
|
||||
case LUA_T_CPROTO: {
|
||||
sprintf(buff, "function: %p", (void *)o->value.f);
|
||||
break;
|
||||
}
|
||||
case LUA_T_USERDATA: {
|
||||
sprintf(buff, "userdata: %p", o->value.ts->u.d.v);
|
||||
break;
|
||||
}
|
||||
case LUA_T_NIL:
|
||||
lua_pushstring("nil");
|
||||
return;
|
||||
default:
|
||||
LUA_INTERNALERROR("invalid type");
|
||||
}
|
||||
lua_pushstring(buff);
|
||||
}
|
||||
|
||||
|
||||
static void luaI_print (void) {
|
||||
TaggedString *ts = luaS_new("tostring");
|
||||
lua_Object obj;
|
||||
int i = 1;
|
||||
while ((obj = lua_getparam(i++)) != LUA_NOOBJECT) {
|
||||
luaA_pushobject(&ts->u.s.globalval);
|
||||
lua_pushobject(obj);
|
||||
luaD_call((L->stack.top-L->stack.stack)-1, 1);
|
||||
if (ttype(L->stack.top-1) != LUA_T_STRING)
|
||||
lua_error("`tostring' must return a string to `print'");
|
||||
printf("%s\t", svalue(L->stack.top-1));
|
||||
L->stack.top--;
|
||||
}
|
||||
printf("\n");
|
||||
}
|
||||
|
||||
|
||||
static void luaI_type (void)
|
||||
{
|
||||
lua_Object o = luaL_nonnullarg(1);
|
||||
lua_pushstring(luaO_typenames[-ttype(luaA_Address(o))]);
|
||||
lua_pushnumber(lua_tag(o));
|
||||
}
|
||||
|
||||
|
||||
static void tonumber (void)
|
||||
{
|
||||
int base = luaL_opt_number(2, 10);
|
||||
if (base == 10) { /* standard conversion */
|
||||
lua_Object o = lua_getparam(1);
|
||||
if (lua_isnumber(o))
|
||||
lua_pushnumber(lua_getnumber(o));
|
||||
}
|
||||
else {
|
||||
char *s = luaL_check_string(1);
|
||||
unsigned long n;
|
||||
luaL_arg_check(0 <= base && base <= 36, 2, "base out of range");
|
||||
n = strtol(s, &s, base);
|
||||
while (isspace(*s)) s++; /* skip trailing spaces */
|
||||
if (*s) lua_pushnil(); /* invalid format: return nil */
|
||||
else lua_pushnumber(n);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void luaI_error (void)
|
||||
{
|
||||
lua_error(lua_getstring(lua_getparam(1)));
|
||||
}
|
||||
|
||||
|
||||
static void luaI_assert (void)
|
||||
{
|
||||
lua_Object p = lua_getparam(1);
|
||||
if (p == LUA_NOOBJECT || lua_isnil(p))
|
||||
luaL_verror("assertion failed! %.100s", luaL_opt_string(2, ""));
|
||||
}
|
||||
|
||||
|
||||
static void setglobal (void)
|
||||
{
|
||||
char *n = luaL_check_string(1);
|
||||
lua_Object value = luaL_nonnullarg(2);
|
||||
lua_pushobject(value);
|
||||
lua_setglobal(n);
|
||||
lua_pushobject(value); /* return given value */
|
||||
}
|
||||
|
||||
static void rawsetglobal (void)
|
||||
{
|
||||
char *n = luaL_check_string(1);
|
||||
lua_Object value = luaL_nonnullarg(2);
|
||||
lua_pushobject(value);
|
||||
lua_rawsetglobal(n);
|
||||
lua_pushobject(value); /* return given value */
|
||||
}
|
||||
|
||||
static void getglobal (void)
|
||||
{
|
||||
lua_pushobject(lua_getglobal(luaL_check_string(1)));
|
||||
}
|
||||
|
||||
static void rawgetglobal (void)
|
||||
{
|
||||
lua_pushobject(lua_rawgetglobal(luaL_check_string(1)));
|
||||
}
|
||||
|
||||
static void luatag (void)
|
||||
{
|
||||
lua_pushnumber(lua_tag(lua_getparam(1)));
|
||||
}
|
||||
|
||||
|
||||
static int getnarg (lua_Object table)
|
||||
{
|
||||
lua_Object temp;
|
||||
/* temp = table.n */
|
||||
lua_pushobject(table); lua_pushstring("n"); temp = lua_rawgettable();
|
||||
return (lua_isnumber(temp) ? lua_getnumber(temp) : MAX_INT);
|
||||
}
|
||||
|
||||
static void luaI_call (void)
|
||||
{
|
||||
lua_Object f = luaL_nonnullarg(1);
|
||||
lua_Object arg = luaL_tablearg(2);
|
||||
char *options = luaL_opt_string(3, "");
|
||||
lua_Object err = lua_getparam(4);
|
||||
int narg = getnarg(arg);
|
||||
int i, status;
|
||||
if (err != LUA_NOOBJECT) { /* set new error method */
|
||||
lua_pushobject(err);
|
||||
err = lua_seterrormethod();
|
||||
}
|
||||
/* push arg[1...n] */
|
||||
for (i=0; i<narg; i++) {
|
||||
lua_Object temp;
|
||||
/* temp = arg[i+1] */
|
||||
lua_pushobject(arg); lua_pushnumber(i+1); temp = lua_rawgettable();
|
||||
if (narg == MAX_INT && lua_isnil(temp))
|
||||
break;
|
||||
lua_pushobject(temp);
|
||||
}
|
||||
status = lua_callfunction(f);
|
||||
if (err != LUA_NOOBJECT) { /* restore old error method */
|
||||
lua_pushobject(err);
|
||||
lua_seterrormethod();
|
||||
}
|
||||
if (status != 0) { /* error in call? */
|
||||
if (strchr(options, 'x')) {
|
||||
lua_pushnil();
|
||||
return; /* return nil to signal the error */
|
||||
}
|
||||
else
|
||||
lua_error(NULL);
|
||||
}
|
||||
else { /* no errors */
|
||||
if (strchr(options, 'p'))
|
||||
luaA_packresults();
|
||||
else
|
||||
luaA_passresults();
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void settag (void)
|
||||
{
|
||||
lua_Object o = luaL_tablearg(1);
|
||||
lua_pushobject(o);
|
||||
lua_settag(luaL_check_number(2));
|
||||
lua_pushobject(o); /* returns first argument */
|
||||
}
|
||||
|
||||
|
||||
static void newtag (void)
|
||||
{
|
||||
lua_pushnumber(lua_newtag());
|
||||
}
|
||||
|
||||
|
||||
static void copytagmethods (void)
|
||||
{
|
||||
lua_pushnumber(lua_copytagmethods(luaL_check_number(1),
|
||||
luaL_check_number(2)));
|
||||
}
|
||||
|
||||
|
||||
static void rawgettable (void)
|
||||
{
|
||||
lua_pushobject(luaL_nonnullarg(1));
|
||||
lua_pushobject(luaL_nonnullarg(2));
|
||||
lua_pushobject(lua_rawgettable());
|
||||
}
|
||||
|
||||
|
||||
static void rawsettable (void)
|
||||
{
|
||||
lua_pushobject(luaL_nonnullarg(1));
|
||||
lua_pushobject(luaL_nonnullarg(2));
|
||||
lua_pushobject(luaL_nonnullarg(3));
|
||||
lua_rawsettable();
|
||||
}
|
||||
|
||||
|
||||
static void settagmethod (void)
|
||||
{
|
||||
lua_Object nf = luaL_nonnullarg(3);
|
||||
lua_pushobject(nf);
|
||||
lua_pushobject(lua_settagmethod((int)luaL_check_number(1),
|
||||
luaL_check_string(2)));
|
||||
}
|
||||
|
||||
|
||||
static void gettagmethod (void)
|
||||
{
|
||||
lua_pushobject(lua_gettagmethod((int)luaL_check_number(1),
|
||||
luaL_check_string(2)));
|
||||
}
|
||||
|
||||
|
||||
static void seterrormethod (void)
|
||||
{
|
||||
lua_Object nf = luaL_functionarg(1);
|
||||
lua_pushobject(nf);
|
||||
lua_pushobject(lua_seterrormethod());
|
||||
}
|
||||
|
||||
|
||||
static void luaI_collectgarbage (void)
|
||||
{
|
||||
lua_pushnumber(lua_collectgarbage(luaL_opt_number(1, 0)));
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** =======================================================
|
||||
** some DEBUG functions
|
||||
** =======================================================
|
||||
*/
|
||||
#ifdef DEBUG
|
||||
|
||||
static void mem_query (void)
|
||||
{
|
||||
lua_pushnumber(totalmem);
|
||||
lua_pushnumber(numblocks);
|
||||
}
|
||||
|
||||
|
||||
static void countlist (void)
|
||||
{
|
||||
char *s = luaL_check_string(1);
|
||||
GCnode *l = (s[0]=='t') ? L->roottable.next : (s[0]=='c') ? L->rootcl.next :
|
||||
(s[0]=='p') ? L->rootproto.next : L->rootglobal.next;
|
||||
int i=0;
|
||||
while (l) {
|
||||
i++;
|
||||
l = l->next;
|
||||
}
|
||||
lua_pushnumber(i);
|
||||
}
|
||||
|
||||
|
||||
static void testC (void)
|
||||
{
|
||||
#define getnum(s) ((*s++) - '0')
|
||||
#define getname(s) (nome[0] = *s++, nome)
|
||||
|
||||
static int locks[10];
|
||||
lua_Object reg[10];
|
||||
char nome[2];
|
||||
char *s = luaL_check_string(1);
|
||||
nome[1] = 0;
|
||||
while (1) {
|
||||
switch (*s++) {
|
||||
case '0': case '1': case '2': case '3': case '4':
|
||||
case '5': case '6': case '7': case '8': case '9':
|
||||
lua_pushnumber(*(s-1) - '0');
|
||||
break;
|
||||
|
||||
case 'c': reg[getnum(s)] = lua_createtable(); break;
|
||||
case 'C': { lua_CFunction f = lua_getcfunction(lua_getglobal(getname(s)));
|
||||
lua_pushcclosure(f, getnum(s));
|
||||
break;
|
||||
}
|
||||
case 'P': reg[getnum(s)] = lua_pop(); break;
|
||||
case 'g': { int n=getnum(s); reg[n]=lua_getglobal(getname(s)); break; }
|
||||
case 'G': { int n = getnum(s);
|
||||
reg[n] = lua_rawgetglobal(getname(s));
|
||||
break;
|
||||
}
|
||||
case 'l': locks[getnum(s)] = lua_ref(1); break;
|
||||
case 'L': locks[getnum(s)] = lua_ref(0); break;
|
||||
case 'r': { int n=getnum(s); reg[n]=lua_getref(locks[getnum(s)]); break; }
|
||||
case 'u': lua_unref(locks[getnum(s)]); break;
|
||||
case 'p': { int n = getnum(s); reg[n] = lua_getparam(getnum(s)); break; }
|
||||
case '=': lua_setglobal(getname(s)); break;
|
||||
case 's': lua_pushstring(getname(s)); break;
|
||||
case 'o': lua_pushobject(reg[getnum(s)]); break;
|
||||
case 'f': (lua_call)(getname(s)); break;
|
||||
case 'i': reg[getnum(s)] = lua_gettable(); break;
|
||||
case 'I': reg[getnum(s)] = lua_rawgettable(); break;
|
||||
case 't': lua_settable(); break;
|
||||
case 'T': lua_rawsettable(); break;
|
||||
default: luaL_verror("unknown command in `testC': %c", *(s-1));
|
||||
}
|
||||
if (*s == 0) return;
|
||||
if (*s++ != ' ') lua_error("missing ` ' between commands in `testC'");
|
||||
}
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
|
||||
/*
|
||||
** Internal functions
|
||||
*/
|
||||
static struct luaL_reg int_funcs[] = {
|
||||
#ifdef LUA_COMPAT2_5
|
||||
{"setfallback", luaT_setfallback},
|
||||
#endif
|
||||
#ifdef DEBUG
|
||||
{"testC", testC},
|
||||
{"totalmem", mem_query},
|
||||
{"count", countlist},
|
||||
#endif
|
||||
{"assert", luaI_assert},
|
||||
{"call", luaI_call},
|
||||
{"collectgarbage", luaI_collectgarbage},
|
||||
{"dofile", internaldofile},
|
||||
{"copytagmethods", copytagmethods},
|
||||
{"dostring", internaldostring},
|
||||
{"error", luaI_error},
|
||||
{"foreach", foreach},
|
||||
{"foreachvar", foreachvar},
|
||||
{"getglobal", getglobal},
|
||||
{"newtag", newtag},
|
||||
{"next", next},
|
||||
{"nextvar", nextvar},
|
||||
{"print", luaI_print},
|
||||
{"rawgetglobal", rawgetglobal},
|
||||
{"rawgettable", rawgettable},
|
||||
{"rawsetglobal", rawsetglobal},
|
||||
{"rawsettable", rawsettable},
|
||||
{"seterrormethod", seterrormethod},
|
||||
{"setglobal", setglobal},
|
||||
{"settagmethod", settagmethod},
|
||||
{"gettagmethod", gettagmethod},
|
||||
{"settag", settag},
|
||||
{"tonumber", tonumber},
|
||||
{"tostring", to_string},
|
||||
{"tag", luatag},
|
||||
{"type", luaI_type}
|
||||
};
|
||||
|
||||
|
||||
#define INTFUNCSIZE (sizeof(int_funcs)/sizeof(int_funcs[0]))
|
||||
|
||||
|
||||
void luaB_predefine (void)
|
||||
{
|
||||
/* pre-register mem error messages, to avoid loop when error arises */
|
||||
luaS_newfixedstring(tableEM);
|
||||
luaS_newfixedstring(memEM);
|
||||
luaL_openlib(int_funcs, (sizeof(int_funcs)/sizeof(int_funcs[0])));
|
||||
lua_pushstring(LUA_VERSION);
|
||||
lua_setglobal("_VERSION");
|
||||
}
|
||||
|
||||
14
lbuiltin.h
Normal file
14
lbuiltin.h
Normal 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
|
||||
427
ldo.c
Normal file
427
ldo.c
Normal file
@@ -0,0 +1,427 @@
|
||||
/*
|
||||
** $Id: ldo.c,v 1.26 1998/06/15 21:34:14 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;
|
||||
volatile struct C_Lua_Stack oldCLS = L->Cstack;
|
||||
jmp_buf *volatile oldErr = L->errorJmp;
|
||||
L->errorJmp = &myErrorJmp;
|
||||
if (setjmp(myErrorJmp) == 0) {
|
||||
do_callinc(nResults);
|
||||
status = 0;
|
||||
}
|
||||
else { /* an error occurred: restore L->Cstack and L->stack.top */
|
||||
L->Cstack = oldCLS;
|
||||
L->stack.top = L->stack.stack+L->Cstack.base;
|
||||
status = 1;
|
||||
}
|
||||
L->errorJmp = oldErr;
|
||||
return status;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** returns 0 = chunk loaded; 1 = error; 2 = no more chunks to load
|
||||
*/
|
||||
static int protectedparser (ZIO *z, int bin)
|
||||
{
|
||||
volatile int status;
|
||||
TProtoFunc *volatile tf;
|
||||
jmp_buf myErrorJmp;
|
||||
jmp_buf *volatile oldErr = L->errorJmp;
|
||||
L->errorJmp = &myErrorJmp;
|
||||
if (setjmp(myErrorJmp) == 0) {
|
||||
tf = bin ? luaU_undump1(z) : luaY_parser(z);
|
||||
status = 0;
|
||||
}
|
||||
else {
|
||||
tf = NULL;
|
||||
status = 1;
|
||||
}
|
||||
L->errorJmp = oldErr;
|
||||
if (status) return 1; /* error code */
|
||||
if (tf == NULL) return 2; /* 'natural' end */
|
||||
luaD_adjusttop(L->Cstack.base+1); /* one slot for the pseudo-function */
|
||||
L->stack.stack[L->Cstack.base].ttype = LUA_T_PROTO;
|
||||
L->stack.stack[L->Cstack.base].value.tf = tf;
|
||||
luaV_closure(0);
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
static int do_main (ZIO *z, int bin)
|
||||
{
|
||||
int status;
|
||||
do {
|
||||
long old_blocks = (luaC_checkGC(), L->nblocks);
|
||||
status = protectedparser(z, bin);
|
||||
if (status == 1) return 1; /* error */
|
||||
else if (status == 2) return 0; /* 'natural' end */
|
||||
else {
|
||||
unsigned long newelems2 = 2*(L->nblocks-old_blocks);
|
||||
L->GCthreshold += newelems2;
|
||||
status = luaD_protectedrun(MULT_RET);
|
||||
L->GCthreshold -= newelems2;
|
||||
}
|
||||
} while (bin && status == 0);
|
||||
return status;
|
||||
}
|
||||
|
||||
|
||||
void luaD_gcIM (TObject *o)
|
||||
{
|
||||
TObject *im = luaT_getimbyObj(o, IM_GC);
|
||||
if (ttype(im) != LUA_T_NIL) {
|
||||
*L->stack.top = *o;
|
||||
incr_top;
|
||||
luaD_callTM(im, 1, 0);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
int lua_dofile (char *filename)
|
||||
{
|
||||
ZIO z;
|
||||
int status;
|
||||
int c;
|
||||
int bin;
|
||||
FILE *f = (filename == NULL) ? stdin : fopen(filename, "r");
|
||||
if (f == NULL)
|
||||
return 2;
|
||||
if (filename == NULL)
|
||||
filename = "(stdin)";
|
||||
c = fgetc(f);
|
||||
ungetc(c, f);
|
||||
bin = (c == ID_CHUNK);
|
||||
if (bin)
|
||||
f = freopen(filename, "rb", f); /* set binary mode */
|
||||
luaZ_Fopen(&z, f, filename);
|
||||
status = do_main(&z, bin);
|
||||
if (f != stdin)
|
||||
fclose(f);
|
||||
return status;
|
||||
}
|
||||
|
||||
|
||||
#define SIZE_PREF 20 /* size of string prefix to appear in error messages */
|
||||
#define SSIZE_PREF "20"
|
||||
|
||||
|
||||
static void build_name (char *str, char *name) {
|
||||
if (str == NULL || *str == ID_CHUNK)
|
||||
strcpy(name, "(buffer)");
|
||||
else {
|
||||
char *temp;
|
||||
sprintf(name, "(dostring) >> \"%." SSIZE_PREF "s\"", str);
|
||||
temp = strchr(name, '\n');
|
||||
if (temp) { /* end string after first line */
|
||||
*temp = '"';
|
||||
*(temp+1) = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
int lua_dostring (char *str) {
|
||||
return lua_dobuffer(str, strlen(str), NULL);
|
||||
}
|
||||
|
||||
|
||||
int lua_dobuffer (char *buff, int size, char *name) {
|
||||
char newname[SIZE_PREF+25];
|
||||
ZIO z;
|
||||
int status;
|
||||
if (name==NULL) {
|
||||
build_name(buff, newname);
|
||||
name = newname;
|
||||
}
|
||||
luaZ_mopen(&z, buff, size, name);
|
||||
status = do_main(&z, buff[0]==ID_CHUNK);
|
||||
return status;
|
||||
}
|
||||
|
||||
46
ldo.h
Normal file
46
ldo.h
Normal 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
|
||||
326
lex.c
326
lex.c
@@ -1,326 +0,0 @@
|
||||
char *rcs_lex = "$Id: lex.c,v 2.31 1996/03/19 16:50:24 roberto Exp roberto $";
|
||||
|
||||
|
||||
#include <ctype.h>
|
||||
#include <string.h>
|
||||
|
||||
#include "mem.h"
|
||||
#include "tree.h"
|
||||
#include "table.h"
|
||||
#include "lex.h"
|
||||
#include "inout.h"
|
||||
#include "luadebug.h"
|
||||
#include "parser.h"
|
||||
|
||||
#define MINBUFF 260
|
||||
|
||||
#define next() { current = input(); }
|
||||
#define save(x) { *yytextLast++ = (x); }
|
||||
#define save_and_next() { save(current); next(); }
|
||||
|
||||
static int current;
|
||||
static char *yytext = NULL;
|
||||
static int textsize = 0;
|
||||
static char *yytextLast;
|
||||
|
||||
static Input input;
|
||||
|
||||
void lua_setinput (Input fn)
|
||||
{
|
||||
current = ' ';
|
||||
input = fn;
|
||||
if (yytext == NULL)
|
||||
{
|
||||
textsize = MINBUFF;
|
||||
yytext = newvector(textsize, char);
|
||||
}
|
||||
}
|
||||
|
||||
char *lua_lasttext (void)
|
||||
{
|
||||
*yytextLast = 0;
|
||||
return yytext;
|
||||
}
|
||||
|
||||
|
||||
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) */
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void growtext (void)
|
||||
{
|
||||
int size = yytextLast - yytext;
|
||||
textsize = growvector(&yytext, textsize, char, lexEM, MAX_WORD);
|
||||
yytextLast = yytext + size;
|
||||
}
|
||||
|
||||
|
||||
static int read_long_string (void)
|
||||
{
|
||||
int cont = 0;
|
||||
int spaceleft = textsize - (yytextLast - yytext);
|
||||
while (1)
|
||||
{
|
||||
if (spaceleft <= 2) /* may read more than 1 char in one cicle */
|
||||
{
|
||||
growtext();
|
||||
spaceleft = textsize - (yytextLast - yytext);
|
||||
}
|
||||
switch (current)
|
||||
{
|
||||
case EOF:
|
||||
case 0:
|
||||
return WRONGTOKEN;
|
||||
case '[':
|
||||
save_and_next(); spaceleft--;
|
||||
if (current == '[')
|
||||
{
|
||||
cont++;
|
||||
save_and_next(); spaceleft--;
|
||||
}
|
||||
continue;
|
||||
case ']':
|
||||
save_and_next(); spaceleft--;
|
||||
if (current == ']')
|
||||
{
|
||||
if (cont == 0) return STRING;
|
||||
cont--;
|
||||
save_and_next(); spaceleft--;
|
||||
}
|
||||
continue;
|
||||
case '\n':
|
||||
lua_linenumber++; /* goes through */
|
||||
default:
|
||||
save_and_next(); spaceleft--;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
int luaY_lex (void)
|
||||
{
|
||||
double a;
|
||||
static int linelasttoken = 0;
|
||||
if (lua_debug)
|
||||
luaI_codedebugline(linelasttoken);
|
||||
linelasttoken = lua_linenumber;
|
||||
while (1)
|
||||
{
|
||||
yytextLast = yytext;
|
||||
switch (current)
|
||||
{
|
||||
case EOF:
|
||||
case 0:
|
||||
return 0;
|
||||
case '\n': linelasttoken = ++lua_linenumber;
|
||||
case ' ':
|
||||
case '\r': /* CR: to avoid problems with DOS/Windows */
|
||||
case '\t':
|
||||
next();
|
||||
continue;
|
||||
|
||||
case '$':
|
||||
next();
|
||||
while (isalnum(current) || current == '_')
|
||||
save_and_next();
|
||||
*yytextLast = 0;
|
||||
if (strcmp(yytext, "debug") == 0)
|
||||
{
|
||||
luaY_lval.vInt = 1;
|
||||
return DEBUG;
|
||||
}
|
||||
else if (strcmp(yytext, "nodebug") == 0)
|
||||
{
|
||||
luaY_lval.vInt = 0;
|
||||
return DEBUG;
|
||||
}
|
||||
return WRONGTOKEN;
|
||||
|
||||
case '-':
|
||||
save_and_next();
|
||||
if (current != '-') return '-';
|
||||
do { next(); } while (current != '\n' && current != 0);
|
||||
continue;
|
||||
|
||||
case '[':
|
||||
save_and_next();
|
||||
if (current != '[') return '[';
|
||||
else
|
||||
{
|
||||
save_and_next(); /* pass the second '[' */
|
||||
if (read_long_string() == WRONGTOKEN)
|
||||
return WRONGTOKEN;
|
||||
save_and_next(); /* pass the second ']' */
|
||||
*(yytextLast-2) = 0; /* erases ']]' */
|
||||
luaY_lval.vWord = luaI_findconstantbyname(yytext+2);
|
||||
return STRING;
|
||||
}
|
||||
|
||||
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;
|
||||
int spaceleft = textsize - (yytextLast - yytext);
|
||||
next(); /* skip the delimiter */
|
||||
while (current != del)
|
||||
{
|
||||
if (spaceleft <= 2) /* may read more than 1 char in one cicle */
|
||||
{
|
||||
growtext();
|
||||
spaceleft = textsize - (yytextLast - yytext);
|
||||
}
|
||||
spaceleft--;
|
||||
switch (current)
|
||||
{
|
||||
case EOF:
|
||||
case 0:
|
||||
case '\n':
|
||||
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': lua_linenumber++; /* goes through */
|
||||
default : save(current); next(); break;
|
||||
}
|
||||
break;
|
||||
default:
|
||||
save_and_next();
|
||||
}
|
||||
}
|
||||
next(); /* skip the delimiter */
|
||||
*yytextLast = 0;
|
||||
luaY_lval.vWord = luaI_findconstantbyname(yytext);
|
||||
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(current) || current == '_');
|
||||
*yytextLast = 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();
|
||||
return CONC;
|
||||
}
|
||||
else if (!isdigit(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(current));
|
||||
if (current == '.') save_and_next();
|
||||
fraction:
|
||||
{ double da=0.1;
|
||||
while (isdigit(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(current)) return WRONGTOKEN;
|
||||
do { e=10.0*e+(current-'0'); save_and_next(); } while (isdigit(current));
|
||||
for (ea=neg?0.1:10.0; e>0; e>>=1)
|
||||
{
|
||||
if (e & 1) a*=ea;
|
||||
ea*=ea;
|
||||
}
|
||||
}
|
||||
luaY_lval.vFloat = a;
|
||||
return NUMBER;
|
||||
}
|
||||
|
||||
default: /* also end of file */
|
||||
{
|
||||
save_and_next();
|
||||
return yytext[0];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
19
lex.h
19
lex.h
@@ -1,19 +0,0 @@
|
||||
/*
|
||||
** lex.h
|
||||
** TecCGraf - PUC-Rio
|
||||
** $Id: lex.h,v 1.1 1996/02/13 17:30:39 roberto Exp roberto $
|
||||
*/
|
||||
|
||||
#ifndef lex_h
|
||||
#define lex_h
|
||||
|
||||
|
||||
typedef int (*Input) (void);
|
||||
|
||||
void lua_setinput (Input fn);
|
||||
char *lua_lasttext (void);
|
||||
int luaY_lex (void);
|
||||
void luaI_addReserved (void);
|
||||
|
||||
|
||||
#endif
|
||||
98
lfunc.c
Normal file
98
lfunc.c
Normal file
@@ -0,0 +1,98 @@
|
||||
/*
|
||||
** $Id: lfunc.c,v 1.8 1997/12/15 16:17:20 roberto Exp roberto $
|
||||
** Auxiliary functions to manipulate prototypes and closures
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
#include <stdlib.h>
|
||||
|
||||
#include "lfunc.h"
|
||||
#include "lmem.h"
|
||||
#include "lstate.h"
|
||||
|
||||
#define gcsizeproto(p) 5 /* approximate "weight" for a prototype */
|
||||
#define gcsizeclosure(c) 1 /* approximate "weight" for a closure */
|
||||
|
||||
|
||||
|
||||
Closure *luaF_newclosure (int nelems)
|
||||
{
|
||||
Closure *c = (Closure *)luaM_malloc(sizeof(Closure)+nelems*sizeof(TObject));
|
||||
luaO_insertlist(&(L->rootcl), (GCnode *)c);
|
||||
L->nblocks += gcsizeclosure(c);
|
||||
c->nelems = nelems;
|
||||
return c;
|
||||
}
|
||||
|
||||
|
||||
TProtoFunc *luaF_newproto (void)
|
||||
{
|
||||
TProtoFunc *f = luaM_new(TProtoFunc);
|
||||
f->code = NULL;
|
||||
f->lineDefined = 0;
|
||||
f->fileName = NULL;
|
||||
f->consts = NULL;
|
||||
f->nconsts = 0;
|
||||
f->locvars = NULL;
|
||||
luaO_insertlist(&(L->rootproto), (GCnode *)f);
|
||||
L->nblocks += gcsizeproto(f);
|
||||
return f;
|
||||
}
|
||||
|
||||
|
||||
|
||||
static void freefunc (TProtoFunc *f)
|
||||
{
|
||||
luaM_free(f->code);
|
||||
luaM_free(f->locvars);
|
||||
luaM_free(f->consts);
|
||||
luaM_free(f);
|
||||
}
|
||||
|
||||
|
||||
void luaF_freeproto (TProtoFunc *l)
|
||||
{
|
||||
while (l) {
|
||||
TProtoFunc *next = (TProtoFunc *)l->head.next;
|
||||
L->nblocks -= gcsizeproto(l);
|
||||
freefunc(l);
|
||||
l = next;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
void luaF_freeclosure (Closure *l)
|
||||
{
|
||||
while (l) {
|
||||
Closure *next = (Closure *)l->head.next;
|
||||
L->nblocks -= gcsizeclosure(l);
|
||||
luaM_free(l);
|
||||
l = next;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Look for n-th local variable at line "line" in function "func".
|
||||
** Returns NULL if not found.
|
||||
*/
|
||||
char *luaF_getlocalname (TProtoFunc *func, int local_number, int line)
|
||||
{
|
||||
int count = 0;
|
||||
char *varname = NULL;
|
||||
LocVar *lv = func->locvars;
|
||||
if (lv == NULL)
|
||||
return NULL;
|
||||
for (; lv->line != -1 && lv->line < line; lv++) {
|
||||
if (lv->varname) { /* register */
|
||||
if (++count == local_number)
|
||||
varname = lv->varname->str;
|
||||
}
|
||||
else /* unregister */
|
||||
if (--count < local_number)
|
||||
varname = NULL;
|
||||
}
|
||||
return varname;
|
||||
}
|
||||
|
||||
23
lfunc.h
Normal file
23
lfunc.h
Normal 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
|
||||
288
lgc.c
Normal file
288
lgc.c
Normal file
@@ -0,0 +1,288 @@
|
||||
/*
|
||||
** $Id: lgc.c,v 1.17 1998/03/06 16:54:42 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_INT);
|
||||
for (ref=oldSize; ref<L->refSize; ref++)
|
||||
L->refArray[ref].status = FREE;
|
||||
ref = oldSize;
|
||||
} found:
|
||||
L->refArray[ref].o = *o;
|
||||
L->refArray[ref].status = lock ? LOCK : HOLD;
|
||||
}
|
||||
return ref;
|
||||
}
|
||||
|
||||
|
||||
void lua_unref (int ref)
|
||||
{
|
||||
if (ref >= 0 && ref < L->refSize)
|
||||
L->refArray[ref].status = FREE;
|
||||
}
|
||||
|
||||
|
||||
TObject* luaC_getref (int ref)
|
||||
{
|
||||
if (ref == -1)
|
||||
return &luaO_nilobject;
|
||||
if (ref >= 0 && ref < L->refSize &&
|
||||
(L->refArray[ref].status == LOCK || L->refArray[ref].status == HOLD))
|
||||
return &L->refArray[ref].o;
|
||||
else
|
||||
return NULL;
|
||||
}
|
||||
|
||||
|
||||
static void travlock (void)
|
||||
{
|
||||
int i;
|
||||
for (i=0; i<L->refSize; i++)
|
||||
if (L->refArray[i].status == LOCK)
|
||||
markobject(&L->refArray[i].o);
|
||||
}
|
||||
|
||||
|
||||
static int ismarked (TObject *o)
|
||||
{
|
||||
/* valid only for locked objects */
|
||||
switch (o->ttype) {
|
||||
case LUA_T_STRING: case LUA_T_USERDATA:
|
||||
return o->value.ts->head.marked;
|
||||
case LUA_T_ARRAY:
|
||||
return o->value.a->head.marked;
|
||||
case LUA_T_CLOSURE:
|
||||
return o->value.cl->head.marked;
|
||||
case LUA_T_PROTO:
|
||||
return o->value.tf->head.marked;
|
||||
#ifdef DEBUG
|
||||
case LUA_T_LINE: case LUA_T_CLMARK:
|
||||
case LUA_T_CMARK: case LUA_T_PMARK:
|
||||
LUA_INTERNALERROR("invalid type");
|
||||
#endif
|
||||
default: /* nil, number or cproto */
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void invalidaterefs (void)
|
||||
{
|
||||
int i;
|
||||
for (i=0; i<L->refSize; i++)
|
||||
if (L->refArray[i].status == HOLD && !ismarked(&L->refArray[i].o))
|
||||
L->refArray[i].status = COLLECTED;
|
||||
}
|
||||
|
||||
|
||||
|
||||
void luaC_hashcallIM (Hash *l)
|
||||
{
|
||||
TObject t;
|
||||
ttype(&t) = LUA_T_ARRAY;
|
||||
for (; l; l=(Hash *)l->head.next) {
|
||||
avalue(&t) = l;
|
||||
luaD_gcIM(&t);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
void luaC_strcallIM (TaggedString *l)
|
||||
{
|
||||
TObject o;
|
||||
ttype(&o) = LUA_T_USERDATA;
|
||||
for (; l; l=(TaggedString *)l->head.next)
|
||||
if (l->constindex == -1) { /* is userdata? */
|
||||
tsvalue(&o) = l;
|
||||
luaD_gcIM(&o);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
static GCnode *listcollect (GCnode *l)
|
||||
{
|
||||
GCnode *frees = NULL;
|
||||
while (l) {
|
||||
GCnode *next = l->next;
|
||||
l->marked = 0;
|
||||
while (next && !next->marked) {
|
||||
l->next = next->next;
|
||||
next->next = frees;
|
||||
frees = next;
|
||||
next = l->next;
|
||||
}
|
||||
l = next;
|
||||
}
|
||||
return frees;
|
||||
}
|
||||
|
||||
|
||||
static void strmark (TaggedString *s)
|
||||
{
|
||||
if (!s->head.marked)
|
||||
s->head.marked = 1;
|
||||
}
|
||||
|
||||
|
||||
static void protomark (TProtoFunc *f)
|
||||
{
|
||||
if (!f->head.marked) {
|
||||
LocVar *v = f->locvars;
|
||||
int i;
|
||||
f->head.marked = 1;
|
||||
if (f->fileName)
|
||||
strmark(f->fileName);
|
||||
for (i=0; i<f->nconsts; i++)
|
||||
markobject(&f->consts[i]);
|
||||
if (v) {
|
||||
for (; v->line != -1; v++)
|
||||
if (v->varname)
|
||||
strmark(v->varname);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void closuremark (Closure *f)
|
||||
{
|
||||
if (!f->head.marked) {
|
||||
int i;
|
||||
f->head.marked = 1;
|
||||
for (i=f->nelems; i>=0; i--)
|
||||
markobject(&f->consts[i]);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void hashmark (Hash *h)
|
||||
{
|
||||
if (!h->head.marked) {
|
||||
int i;
|
||||
h->head.marked = 1;
|
||||
for (i=0; i<nhash(h); i++) {
|
||||
Node *n = node(h,i);
|
||||
if (ttype(ref(n)) != LUA_T_NIL) {
|
||||
markobject(&n->ref);
|
||||
markobject(&n->val);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void globalmark (void)
|
||||
{
|
||||
TaggedString *g;
|
||||
for (g=(TaggedString *)L->rootglobal.next; g; g=(TaggedString *)g->head.next){
|
||||
LUA_ASSERT(g->constindex >= 0, "userdata in global list");
|
||||
if (g->u.s.globalval.ttype != LUA_T_NIL) {
|
||||
markobject(&g->u.s.globalval);
|
||||
strmark(g); /* cannot collect non nil global variables */
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static int markobject (TObject *o)
|
||||
{
|
||||
switch (ttype(o)) {
|
||||
case LUA_T_USERDATA: case LUA_T_STRING:
|
||||
strmark(tsvalue(o));
|
||||
break;
|
||||
case LUA_T_ARRAY:
|
||||
hashmark(avalue(o));
|
||||
break;
|
||||
case LUA_T_CLOSURE: case LUA_T_CLMARK:
|
||||
closuremark(o->value.cl);
|
||||
break;
|
||||
case LUA_T_PROTO: case LUA_T_PMARK:
|
||||
protomark(o->value.tf);
|
||||
break;
|
||||
default: break; /* numbers, cprotos, etc */
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
|
||||
static void markall (void)
|
||||
{
|
||||
luaD_travstack(markobject); /* mark stack objects */
|
||||
globalmark(); /* mark global variable values and names */
|
||||
travlock(); /* mark locked objects */
|
||||
luaT_travtagmethods(markobject); /* mark fallbacks */
|
||||
}
|
||||
|
||||
|
||||
long lua_collectgarbage (long limit)
|
||||
{
|
||||
unsigned long recovered = L->nblocks; /* to subtract nblocks after gc */
|
||||
Hash *freetable;
|
||||
TaggedString *freestr;
|
||||
TProtoFunc *freefunc;
|
||||
Closure *freeclos;
|
||||
markall();
|
||||
invalidaterefs();
|
||||
freestr = luaS_collector();
|
||||
freetable = (Hash *)listcollect(&(L->roottable));
|
||||
freefunc = (TProtoFunc *)listcollect(&(L->rootproto));
|
||||
freeclos = (Closure *)listcollect(&(L->rootcl));
|
||||
L->GCthreshold *= 4; /* to avoid GC during GC */
|
||||
luaC_hashcallIM(freetable); /* GC tag methods for tables */
|
||||
luaC_strcallIM(freestr); /* GC tag methods for userdata */
|
||||
luaD_gcIM(&luaO_nilobject); /* GC tag method for nil (signal end of GC) */
|
||||
luaH_free(freetable);
|
||||
luaS_free(freestr);
|
||||
luaF_freeproto(freefunc);
|
||||
luaF_freeclosure(freeclos);
|
||||
recovered = recovered-L->nblocks;
|
||||
L->GCthreshold = (limit == 0) ? 2*L->nblocks : L->nblocks+limit;
|
||||
return recovered;
|
||||
}
|
||||
|
||||
|
||||
void luaC_checkGC (void)
|
||||
{
|
||||
if (L->nblocks >= L->GCthreshold)
|
||||
lua_collectgarbage(0);
|
||||
}
|
||||
|
||||
21
lgc.h
Normal file
21
lgc.h
Normal 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
|
||||
448
liolib.c
Normal file
448
liolib.c
Normal file
@@ -0,0 +1,448 @@
|
||||
/*
|
||||
** $Id: liolib.c,v 1.20 1998/06/05 22:17:44 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 "lauxlib.h"
|
||||
#include "lua.h"
|
||||
#include "luadebug.h"
|
||||
#include "lualib.h"
|
||||
|
||||
|
||||
#ifndef OLD_ANSI
|
||||
#include <locale.h>
|
||||
#else
|
||||
#define setlocale(a,b) 0
|
||||
#define LC_ALL 0
|
||||
#define LC_COLLATE 0
|
||||
#define LC_CTYPE 0
|
||||
#define LC_MONETARY 0
|
||||
#define LC_NUMERIC 0
|
||||
#define LC_TIME 0
|
||||
#define strerror(e) "(no error message provided by operating system)"
|
||||
#endif
|
||||
|
||||
|
||||
#define CLOSEDTAG 2
|
||||
#define IOTAG 1
|
||||
|
||||
#define FIRSTARG 3 /* 1st and 2nd are upvalues */
|
||||
|
||||
#define FINPUT "_INPUT"
|
||||
#define FOUTPUT "_OUTPUT"
|
||||
|
||||
|
||||
#ifdef POPEN
|
||||
FILE *popen();
|
||||
int pclose();
|
||||
#else
|
||||
#define popen(x,y) NULL /* that is, popen always fails */
|
||||
#define pclose(x) (-1)
|
||||
#endif
|
||||
|
||||
|
||||
static int gettag (int i)
|
||||
{
|
||||
return lua_getnumber(lua_getparam(i));
|
||||
}
|
||||
|
||||
|
||||
static void pushresult (int i)
|
||||
{
|
||||
if (i)
|
||||
lua_pushuserdata(NULL);
|
||||
else {
|
||||
lua_pushnil();
|
||||
lua_pushstring(strerror(errno));
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static int ishandler (lua_Object f)
|
||||
{
|
||||
if (lua_isuserdata(f)) {
|
||||
if (lua_tag(f) == gettag(CLOSEDTAG))
|
||||
lua_error("cannot access a closed file");
|
||||
return lua_tag(f) == gettag(IOTAG);
|
||||
}
|
||||
else return 0;
|
||||
}
|
||||
|
||||
static FILE *getfile (char *name)
|
||||
{
|
||||
lua_Object f = lua_getglobal(name);
|
||||
if (!ishandler(f))
|
||||
luaL_verror("global variable `%.50s' is not a file handle", name);
|
||||
return lua_getuserdata(f);
|
||||
}
|
||||
|
||||
|
||||
static FILE *getfileparam (char *name, int *arg)
|
||||
{
|
||||
lua_Object f = lua_getparam(*arg);
|
||||
if (ishandler(f)) {
|
||||
(*arg)++;
|
||||
return lua_getuserdata(f);
|
||||
}
|
||||
else
|
||||
return getfile(name);
|
||||
}
|
||||
|
||||
|
||||
static void closefile (char *name)
|
||||
{
|
||||
FILE *f = getfile(name);
|
||||
if (f == stdin || f == stdout) return;
|
||||
if (pclose(f) == -1)
|
||||
fclose(f);
|
||||
lua_pushobject(lua_getglobal(name));
|
||||
lua_settag(gettag(CLOSEDTAG));
|
||||
}
|
||||
|
||||
|
||||
static void setfile (FILE *f, char *name, int tag)
|
||||
{
|
||||
lua_pushusertag(f, tag);
|
||||
lua_setglobal(name);
|
||||
}
|
||||
|
||||
|
||||
static void setreturn (FILE *f, char *name)
|
||||
{
|
||||
int tag = gettag(IOTAG);
|
||||
setfile(f, name, tag);
|
||||
lua_pushusertag(f, tag);
|
||||
}
|
||||
|
||||
|
||||
static void io_readfrom (void)
|
||||
{
|
||||
FILE *current;
|
||||
lua_Object f = lua_getparam(FIRSTARG);
|
||||
if (f == LUA_NOOBJECT) {
|
||||
closefile(FINPUT);
|
||||
current = stdin;
|
||||
}
|
||||
else if (lua_tag(f) == gettag(IOTAG))
|
||||
current = lua_getuserdata(f);
|
||||
else {
|
||||
char *s = luaL_check_string(FIRSTARG);
|
||||
current = (*s == '|') ? popen(s+1, "r") : fopen(s, "r");
|
||||
if (current == NULL) {
|
||||
pushresult(0);
|
||||
return;
|
||||
}
|
||||
}
|
||||
setreturn(current, FINPUT);
|
||||
}
|
||||
|
||||
|
||||
static void io_writeto (void)
|
||||
{
|
||||
FILE *current;
|
||||
lua_Object f = lua_getparam(FIRSTARG);
|
||||
if (f == LUA_NOOBJECT) {
|
||||
closefile(FOUTPUT);
|
||||
current = stdout;
|
||||
}
|
||||
else if (lua_tag(f) == gettag(IOTAG))
|
||||
current = lua_getuserdata(f);
|
||||
else {
|
||||
char *s = luaL_check_string(FIRSTARG);
|
||||
current = (*s == '|') ? popen(s+1,"w") : fopen(s,"w");
|
||||
if (current == NULL) {
|
||||
pushresult(0);
|
||||
return;
|
||||
}
|
||||
}
|
||||
setreturn(current, FOUTPUT);
|
||||
}
|
||||
|
||||
|
||||
static void io_appendto (void)
|
||||
{
|
||||
char *s = luaL_check_string(FIRSTARG);
|
||||
FILE *fp = fopen (s, "a");
|
||||
if (fp != NULL)
|
||||
setreturn(fp, FOUTPUT);
|
||||
else
|
||||
pushresult(0);
|
||||
}
|
||||
|
||||
|
||||
#define NEED_OTHER (EOF-1) /* just some flag different from EOF */
|
||||
|
||||
|
||||
static void read_until (FILE *f, int lim) {
|
||||
int l = 0;
|
||||
int c;
|
||||
for (c = getc(f); c != EOF && c != lim; c = getc(f)) {
|
||||
luaL_addchar(c);
|
||||
l++;
|
||||
}
|
||||
if (l > 0 || c == lim) /* read anything? */
|
||||
lua_pushlstring(luaL_buffer(), l);
|
||||
}
|
||||
|
||||
static void io_read (void) {
|
||||
int arg = FIRSTARG;
|
||||
FILE *f = getfileparam(FINPUT, &arg);
|
||||
char *p = luaL_opt_string(arg, NULL);
|
||||
luaL_resetbuffer();
|
||||
if (p == NULL) /* default: read a line */
|
||||
read_until(f, '\n');
|
||||
else if (p[0] == '.' && p[1] == '*' && p[2] == 0) /* p = ".*" */
|
||||
read_until(f, EOF);
|
||||
else {
|
||||
int l = 0; /* number of chars read in buffer */
|
||||
int inskip = 0; /* to control {skips} */
|
||||
int c = NEED_OTHER;
|
||||
while (*p) {
|
||||
switch (*p) {
|
||||
case '{':
|
||||
inskip++;
|
||||
p++;
|
||||
continue;
|
||||
case '}':
|
||||
if (inskip == 0)
|
||||
lua_error("unbalanced braces in read pattern");
|
||||
inskip--;
|
||||
p++;
|
||||
continue;
|
||||
default: {
|
||||
char *ep; /* get what is next */
|
||||
int m; /* match result */
|
||||
if (c == NEED_OTHER) c = getc(f);
|
||||
if (c == EOF) {
|
||||
luaI_singlematch(0, p, &ep); /* to set "ep" */
|
||||
m = 0;
|
||||
}
|
||||
else {
|
||||
m = luaI_singlematch(c, p, &ep);
|
||||
if (m) {
|
||||
if (inskip == 0) {
|
||||
luaL_addchar(c);
|
||||
l++;
|
||||
}
|
||||
c = NEED_OTHER;
|
||||
}
|
||||
}
|
||||
switch (*ep) {
|
||||
case '*': /* repetition */
|
||||
if (!m) p = ep+1; /* else stay in (repeat) the same item */
|
||||
continue;
|
||||
case '?': /* optional */
|
||||
p = ep+1; /* continues reading the pattern */
|
||||
continue;
|
||||
default:
|
||||
if (m) p = ep; /* continues reading the pattern */
|
||||
else
|
||||
goto break_while; /* pattern fails */
|
||||
}
|
||||
}
|
||||
}
|
||||
} break_while:
|
||||
if (c >= 0) /* not EOF nor NEED_OTHER? */
|
||||
ungetc(c, f);
|
||||
if (l > 0 || *p == 0) /* read something or did not fail? */
|
||||
lua_pushlstring(luaL_buffer(), l);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void io_write (void)
|
||||
{
|
||||
int arg = FIRSTARG;
|
||||
FILE *f = getfileparam(FOUTPUT, &arg);
|
||||
int status = 1;
|
||||
char *s;
|
||||
long l;
|
||||
while ((s = luaL_opt_lstr(arg++, NULL, &l)) != NULL)
|
||||
status = status && (fwrite(s, 1, l, f) == l);
|
||||
pushresult(status);
|
||||
}
|
||||
|
||||
|
||||
static void io_execute (void)
|
||||
{
|
||||
lua_pushnumber(system(luaL_check_string(1)));
|
||||
}
|
||||
|
||||
|
||||
static void io_remove (void)
|
||||
{
|
||||
pushresult(remove(luaL_check_string(1)) == 0);
|
||||
}
|
||||
|
||||
|
||||
static void io_rename (void)
|
||||
{
|
||||
pushresult(rename(luaL_check_string(1),
|
||||
luaL_check_string(2)) == 0);
|
||||
}
|
||||
|
||||
|
||||
static void io_tmpname (void)
|
||||
{
|
||||
lua_pushstring(tmpnam(NULL));
|
||||
}
|
||||
|
||||
|
||||
|
||||
static void io_getenv (void)
|
||||
{
|
||||
lua_pushstring(getenv(luaL_check_string(1))); /* if NULL push nil */
|
||||
}
|
||||
|
||||
|
||||
static void io_clock (void) {
|
||||
lua_pushnumber(((double)clock())/CLOCKS_PER_SEC);
|
||||
}
|
||||
|
||||
|
||||
static void io_date (void)
|
||||
{
|
||||
time_t t;
|
||||
struct tm *tm;
|
||||
char *s = luaL_opt_string(1, "%c");
|
||||
char b[BUFSIZ];
|
||||
time(&t); tm = localtime(&t);
|
||||
if (strftime(b,sizeof(b),s,tm))
|
||||
lua_pushstring(b);
|
||||
else
|
||||
lua_error("invalid `date' format");
|
||||
}
|
||||
|
||||
|
||||
static void setloc (void)
|
||||
{
|
||||
static int cat[] = {LC_ALL, LC_COLLATE, LC_CTYPE, LC_MONETARY, LC_NUMERIC,
|
||||
LC_TIME};
|
||||
static char *catnames[] = {"all", "collate", "ctype", "monetary",
|
||||
"numeric", "time", NULL};
|
||||
int op = luaL_findstring(luaL_opt_string(2, "all"), catnames);
|
||||
luaL_arg_check(op != -1, 2, "invalid option");
|
||||
lua_pushstring(setlocale(cat[op], luaL_check_string(1)));
|
||||
}
|
||||
|
||||
|
||||
static void io_exit (void)
|
||||
{
|
||||
lua_Object o = lua_getparam(1);
|
||||
exit(lua_isnumber(o) ? (int)lua_getnumber(o) : 1);
|
||||
}
|
||||
|
||||
|
||||
static void io_debug (void)
|
||||
{
|
||||
while (1) {
|
||||
char buffer[250];
|
||||
fprintf(stderr, "lua_debug> ");
|
||||
if (fgets(buffer, sizeof(buffer), stdin) == 0) return;
|
||||
if (strcmp(buffer, "cont\n") == 0) return;
|
||||
lua_dostring(buffer);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void lua_printstack (FILE *f)
|
||||
{
|
||||
int level = 1; /* skip level 0 (it's this function) */
|
||||
lua_Object func;
|
||||
while ((func = lua_stackedfunction(level++)) != LUA_NOOBJECT) {
|
||||
char *name;
|
||||
int currentline;
|
||||
char *filename;
|
||||
int linedefined;
|
||||
lua_funcinfo(func, &filename, &linedefined);
|
||||
fprintf(f, (level==2) ? "Active Stack:\n\t" : "\t");
|
||||
switch (*lua_getobjname(func, &name)) {
|
||||
case 'g':
|
||||
fprintf(f, "function %s", name);
|
||||
break;
|
||||
case 't':
|
||||
fprintf(f, "`%s' tag method", name);
|
||||
break;
|
||||
default: {
|
||||
if (linedefined == 0)
|
||||
fprintf(f, "main of %s", filename);
|
||||
else if (linedefined < 0)
|
||||
fprintf(f, "%s", filename);
|
||||
else
|
||||
fprintf(f, "function (%s:%d)", filename, linedefined);
|
||||
filename = NULL;
|
||||
}
|
||||
}
|
||||
if ((currentline = lua_currentline(func)) > 0)
|
||||
fprintf(f, " at line %d", currentline);
|
||||
if (filename)
|
||||
fprintf(f, " [in file %s]", filename);
|
||||
fprintf(f, "\n");
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void errorfb (void)
|
||||
{
|
||||
fprintf(stderr, "lua: %s\n", lua_getstring(lua_getparam(1)));
|
||||
lua_printstack(stderr);
|
||||
}
|
||||
|
||||
|
||||
|
||||
static struct luaL_reg iolib[] = {
|
||||
{"setlocale", setloc},
|
||||
{"execute", io_execute},
|
||||
{"remove", io_remove},
|
||||
{"rename", io_rename},
|
||||
{"tmpname", io_tmpname},
|
||||
{"getenv", io_getenv},
|
||||
{"date", io_date},
|
||||
{"clock", io_clock},
|
||||
{"exit", io_exit},
|
||||
{"debug", io_debug},
|
||||
{"print_stack", errorfb}
|
||||
};
|
||||
|
||||
static struct luaL_reg iolibtag[] = {
|
||||
{"readfrom", io_readfrom},
|
||||
{"writeto", io_writeto},
|
||||
{"appendto", io_appendto},
|
||||
{"read", io_read},
|
||||
{"write", io_write}
|
||||
};
|
||||
|
||||
static void openwithtags (void)
|
||||
{
|
||||
int iotag = lua_newtag();
|
||||
int closedtag = lua_newtag();
|
||||
int i;
|
||||
for (i=0; i<sizeof(iolibtag)/sizeof(iolibtag[0]); i++) {
|
||||
/* put both tags as upvalues for these functions */
|
||||
lua_pushnumber(iotag);
|
||||
lua_pushnumber(closedtag);
|
||||
lua_pushcclosure(iolibtag[i].func, 2);
|
||||
lua_setglobal(iolibtag[i].name);
|
||||
}
|
||||
setfile(stdin, FINPUT, iotag);
|
||||
setfile(stdout, FOUTPUT, iotag);
|
||||
setfile(stdin, "_STDIN", iotag);
|
||||
setfile(stdout, "_STDOUT", iotag);
|
||||
setfile(stderr, "_STDERR", iotag);
|
||||
}
|
||||
|
||||
void lua_iolibopen (void)
|
||||
{
|
||||
luaL_openlib(iolib, (sizeof(iolib)/sizeof(iolib[0])));
|
||||
openwithtags();
|
||||
lua_pushcfunction(errorfb);
|
||||
lua_seterrormethod();
|
||||
}
|
||||
463
llex.c
Normal file
463
llex.c
Normal file
@@ -0,0 +1,463 @@
|
||||
/*
|
||||
** $Id: llex.c,v 1.22 1998/06/19 18:47:06 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 "luadebug.h"
|
||||
#include "lzio.h"
|
||||
|
||||
|
||||
|
||||
int lua_debug=0;
|
||||
|
||||
|
||||
#define next(LS) (LS->current = zgetc(LS->lex_z))
|
||||
|
||||
|
||||
#define save(c) luaL_addchar(c)
|
||||
#define save_and_next(LS) (save(LS->current), next(LS))
|
||||
|
||||
|
||||
char *reserved [] = {"and", "do", "else", "elseif", "end", "function",
|
||||
"if", "local", "nil", "not", "or", "repeat", "return", "then",
|
||||
"until", "while"};
|
||||
|
||||
|
||||
void luaX_init (void)
|
||||
{
|
||||
int i;
|
||||
for (i=0; i<(sizeof(reserved)/sizeof(reserved[0])); i++) {
|
||||
TaggedString *ts = luaS_new(reserved[i]);
|
||||
ts->head.marked = FIRST_RESERVED+i; /* reserved word (always > 255) */
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
void luaX_syntaxerror (LexState *ls, char *s, char *token) {
|
||||
if (token[0] == 0)
|
||||
token = "<eof>";
|
||||
luaL_verror("%.100s;\n last token read: `%.50s' at line %d in chunk `%.50s'",
|
||||
s, token, ls->linenumber, zname(ls->lex_z));
|
||||
}
|
||||
|
||||
|
||||
void luaX_error (LexState *ls, char *s) {
|
||||
save(0);
|
||||
luaX_syntaxerror(ls, s, luaL_buffer());
|
||||
}
|
||||
|
||||
|
||||
void luaX_token2str (LexState *ls, int token, char *s) {
|
||||
if (token < 255) {
|
||||
s[0] = token;
|
||||
s[1] = 0;
|
||||
}
|
||||
else
|
||||
strcpy(s, reserved[token-FIRST_RESERVED]);
|
||||
}
|
||||
|
||||
|
||||
static void luaX_invalidchar (LexState *ls, int c) {
|
||||
char buff[10];
|
||||
sprintf(buff, "0x%X", c);
|
||||
luaX_syntaxerror(ls, "invalid control char", buff);
|
||||
}
|
||||
|
||||
|
||||
static void firstline (LexState *LS)
|
||||
{
|
||||
int c = zgetc(LS->lex_z);
|
||||
if (c == '#')
|
||||
while ((c=zgetc(LS->lex_z)) != '\n' && c != EOZ) /* skip first line */;
|
||||
zungetc(LS->lex_z);
|
||||
}
|
||||
|
||||
|
||||
void luaX_setinput (LexState *LS, ZIO *z)
|
||||
{
|
||||
LS->current = '\n';
|
||||
LS->linenumber = 0;
|
||||
LS->iflevel = 0;
|
||||
LS->ifstate[0].skip = 0;
|
||||
LS->ifstate[0].elsepart = 1; /* to avoid a free $else */
|
||||
LS->lex_z = z;
|
||||
LS->fs = NULL;
|
||||
firstline(LS);
|
||||
luaL_resetbuffer();
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** =======================================================
|
||||
** PRAGMAS
|
||||
** =======================================================
|
||||
*/
|
||||
|
||||
#define PRAGMASIZE 20
|
||||
|
||||
static void skipspace (LexState *LS)
|
||||
{
|
||||
while (LS->current == ' ' || LS->current == '\t' || LS->current == '\r')
|
||||
next(LS);
|
||||
}
|
||||
|
||||
|
||||
static int checkcond (LexState *LS, char *buff)
|
||||
{
|
||||
static char *opts[] = {"nil", "1", NULL};
|
||||
int i = luaL_findstring(buff, opts);
|
||||
if (i >= 0) return i;
|
||||
else if (isalpha((unsigned char)buff[0]) || buff[0] == '_')
|
||||
return luaS_globaldefined(buff);
|
||||
else {
|
||||
luaX_syntaxerror(LS, "invalid $if condition", buff);
|
||||
return 0; /* to avoid warnings */
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void readname (LexState *LS, char *buff)
|
||||
{
|
||||
int i = 0;
|
||||
skipspace(LS);
|
||||
while (isalnum(LS->current) || LS->current == '_') {
|
||||
if (i >= PRAGMASIZE) {
|
||||
buff[PRAGMASIZE] = 0;
|
||||
luaX_syntaxerror(LS, "pragma too long", buff);
|
||||
}
|
||||
buff[i++] = LS->current;
|
||||
next(LS);
|
||||
}
|
||||
buff[i] = 0;
|
||||
}
|
||||
|
||||
|
||||
static void inclinenumber (LexState *LS);
|
||||
|
||||
|
||||
static void ifskip (LexState *LS)
|
||||
{
|
||||
while (LS->ifstate[LS->iflevel].skip) {
|
||||
if (LS->current == '\n')
|
||||
inclinenumber(LS);
|
||||
else if (LS->current == EOZ)
|
||||
luaX_error(LS, "input ends inside a $if");
|
||||
else next(LS);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void inclinenumber (LexState *LS)
|
||||
{
|
||||
static char *pragmas [] =
|
||||
{"debug", "nodebug", "endinput", "end", "ifnot", "if", "else", NULL};
|
||||
next(LS); /* skip '\n' */
|
||||
++LS->linenumber;
|
||||
if (LS->current == '$') { /* is a pragma? */
|
||||
char buff[PRAGMASIZE+1];
|
||||
int ifnot = 0;
|
||||
int skip = LS->ifstate[LS->iflevel].skip;
|
||||
next(LS); /* skip $ */
|
||||
readname(LS, buff);
|
||||
switch (luaL_findstring(buff, pragmas)) {
|
||||
case 0: /* debug */
|
||||
if (!skip) lua_debug = 1;
|
||||
break;
|
||||
case 1: /* nodebug */
|
||||
if (!skip) lua_debug = 0;
|
||||
break;
|
||||
case 2: /* endinput */
|
||||
if (!skip) {
|
||||
LS->current = EOZ;
|
||||
LS->iflevel = 0; /* to allow $endinput inside a $if */
|
||||
}
|
||||
break;
|
||||
case 3: /* end */
|
||||
if (LS->iflevel-- == 0)
|
||||
luaX_syntaxerror(LS, "unmatched $end", "$end");
|
||||
break;
|
||||
case 4: /* ifnot */
|
||||
ifnot = 1;
|
||||
/* go through */
|
||||
case 5: /* if */
|
||||
if (LS->iflevel == MAX_IFS-1)
|
||||
luaX_syntaxerror(LS, "too many nested $ifs", "$if");
|
||||
readname(LS, buff);
|
||||
LS->iflevel++;
|
||||
LS->ifstate[LS->iflevel].elsepart = 0;
|
||||
LS->ifstate[LS->iflevel].condition = checkcond(LS, buff) ? !ifnot : ifnot;
|
||||
LS->ifstate[LS->iflevel].skip = skip || !LS->ifstate[LS->iflevel].condition;
|
||||
break;
|
||||
case 6: /* else */
|
||||
if (LS->ifstate[LS->iflevel].elsepart)
|
||||
luaX_syntaxerror(LS, "unmatched $else", "$else");
|
||||
LS->ifstate[LS->iflevel].elsepart = 1;
|
||||
LS->ifstate[LS->iflevel].skip = LS->ifstate[LS->iflevel-1].skip ||
|
||||
LS->ifstate[LS->iflevel].condition;
|
||||
break;
|
||||
default:
|
||||
luaX_syntaxerror(LS, "unknown pragma", buff);
|
||||
}
|
||||
skipspace(LS);
|
||||
if (LS->current == '\n') /* pragma must end with a '\n' ... */
|
||||
inclinenumber(LS);
|
||||
else if (LS->current != EOZ) /* or eof */
|
||||
luaX_syntaxerror(LS, "invalid pragma format", buff);
|
||||
ifskip(LS);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** =======================================================
|
||||
** LEXICAL ANALIZER
|
||||
** =======================================================
|
||||
*/
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
static int read_long_string (LexState *LS)
|
||||
{
|
||||
int cont = 0;
|
||||
while (1) {
|
||||
switch (LS->current) {
|
||||
case EOZ:
|
||||
luaX_error(LS, "unfinished long string");
|
||||
return EOS; /* to avoid warnings */
|
||||
case '[':
|
||||
save_and_next(LS);
|
||||
if (LS->current == '[') {
|
||||
cont++;
|
||||
save_and_next(LS);
|
||||
}
|
||||
continue;
|
||||
case ']':
|
||||
save_and_next(LS);
|
||||
if (LS->current == ']') {
|
||||
if (cont == 0) goto endloop;
|
||||
cont--;
|
||||
save_and_next(LS);
|
||||
}
|
||||
continue;
|
||||
case '\n':
|
||||
save('\n');
|
||||
inclinenumber(LS);
|
||||
continue;
|
||||
default:
|
||||
save_and_next(LS);
|
||||
}
|
||||
} endloop:
|
||||
save_and_next(LS); /* pass the second ']' */
|
||||
LS->seminfo.ts = luaS_newlstr(L->Mbuffbase+2,
|
||||
L->Mbuffnext-(L->Mbuffbase-L->Mbuffer)-4);
|
||||
return STRING;
|
||||
}
|
||||
|
||||
|
||||
int luaX_lex (LexState *LS) {
|
||||
double a;
|
||||
luaL_resetbuffer();
|
||||
while (1) {
|
||||
switch (LS->current) {
|
||||
|
||||
case ' ': case '\t': case '\r': /* CR: to avoid problems with DOS */
|
||||
next(LS);
|
||||
continue;
|
||||
|
||||
case '\n':
|
||||
inclinenumber(LS);
|
||||
continue;
|
||||
|
||||
case '-':
|
||||
save_and_next(LS);
|
||||
if (LS->current != '-') return '-';
|
||||
do { next(LS); } while (LS->current != '\n' && LS->current != EOZ);
|
||||
luaL_resetbuffer();
|
||||
continue;
|
||||
|
||||
case '[':
|
||||
save_and_next(LS);
|
||||
if (LS->current != '[') return '[';
|
||||
else {
|
||||
save_and_next(LS); /* pass the second '[' */
|
||||
return read_long_string(LS);
|
||||
}
|
||||
|
||||
case '=':
|
||||
save_and_next(LS);
|
||||
if (LS->current != '=') return '=';
|
||||
else { save_and_next(LS); return EQ; }
|
||||
|
||||
case '<':
|
||||
save_and_next(LS);
|
||||
if (LS->current != '=') return '<';
|
||||
else { save_and_next(LS); return LE; }
|
||||
|
||||
case '>':
|
||||
save_and_next(LS);
|
||||
if (LS->current != '=') return '>';
|
||||
else { save_and_next(LS); return GE; }
|
||||
|
||||
case '~':
|
||||
save_and_next(LS);
|
||||
if (LS->current != '=') return '~';
|
||||
else { save_and_next(LS); return NE; }
|
||||
|
||||
case '"':
|
||||
case '\'': {
|
||||
int del = LS->current;
|
||||
save_and_next(LS);
|
||||
while (LS->current != del) {
|
||||
switch (LS->current) {
|
||||
case EOZ:
|
||||
case '\n':
|
||||
luaX_error(LS, "unfinished string");
|
||||
return EOS; /* to avoid warnings */
|
||||
case '\\':
|
||||
next(LS); /* do not save the '\' */
|
||||
switch (LS->current) {
|
||||
case 'a': save('\a'); next(LS); break;
|
||||
case 'b': save('\b'); next(LS); break;
|
||||
case 'f': save('\f'); next(LS); break;
|
||||
case 'n': save('\n'); next(LS); break;
|
||||
case 'r': save('\r'); next(LS); break;
|
||||
case 't': save('\t'); next(LS); break;
|
||||
case 'v': save('\v'); next(LS); break;
|
||||
case '\n': save('\n'); inclinenumber(LS); break;
|
||||
default : {
|
||||
if (isdigit(LS->current)) {
|
||||
int c = 0;
|
||||
int i = 0;
|
||||
do {
|
||||
c = 10*c + (LS->current-'0');
|
||||
next(LS);
|
||||
} while (++i<3 && isdigit(LS->current));
|
||||
if (c >= 256)
|
||||
luaX_error(LS, "escape sequence too large");
|
||||
save(c);
|
||||
}
|
||||
else { /* handles \, ", ', and ? */
|
||||
save(LS->current);
|
||||
next(LS);
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
break;
|
||||
default:
|
||||
save_and_next(LS);
|
||||
}
|
||||
}
|
||||
save_and_next(LS); /* skip delimiter */
|
||||
LS->seminfo.ts = luaS_newlstr(L->Mbuffbase+1,
|
||||
L->Mbuffnext-(L->Mbuffbase-L->Mbuffer)-2);
|
||||
return STRING;
|
||||
}
|
||||
|
||||
case '.':
|
||||
save_and_next(LS);
|
||||
if (LS->current == '.')
|
||||
{
|
||||
save_and_next(LS);
|
||||
if (LS->current == '.')
|
||||
{
|
||||
save_and_next(LS);
|
||||
return DOTS; /* ... */
|
||||
}
|
||||
else return CONC; /* .. */
|
||||
}
|
||||
else if (!isdigit(LS->current)) return '.';
|
||||
/* LS->current is a digit: goes through to number */
|
||||
a=0.0;
|
||||
goto fraction;
|
||||
|
||||
case '0': case '1': case '2': case '3': case '4':
|
||||
case '5': case '6': case '7': case '8': case '9':
|
||||
a=0.0;
|
||||
do {
|
||||
a = 10.0*a + (LS->current-'0');
|
||||
save_and_next(LS);
|
||||
} while (isdigit(LS->current));
|
||||
if (LS->current == '.') {
|
||||
save_and_next(LS);
|
||||
if (LS->current == '.') {
|
||||
save('.');
|
||||
luaX_error(LS,
|
||||
"ambiguous syntax (decimal point x string concatenation)");
|
||||
}
|
||||
}
|
||||
fraction:
|
||||
{ double da=0.1;
|
||||
while (isdigit(LS->current))
|
||||
{
|
||||
a += (LS->current-'0')*da;
|
||||
da /= 10.0;
|
||||
save_and_next(LS);
|
||||
}
|
||||
if (toupper(LS->current) == 'E') {
|
||||
int e = 0;
|
||||
int neg;
|
||||
double ea;
|
||||
save_and_next(LS);
|
||||
neg = (LS->current=='-');
|
||||
if (LS->current == '+' || LS->current == '-') save_and_next(LS);
|
||||
if (!isdigit(LS->current))
|
||||
luaX_error(LS, "invalid numeral format");
|
||||
do {
|
||||
e = 10*e + (LS->current-'0');
|
||||
save_and_next(LS);
|
||||
} while (isdigit(LS->current));
|
||||
for (ea=neg?0.1:10.0; e>0; e>>=1)
|
||||
{
|
||||
if (e & 1) a *= ea;
|
||||
ea *= ea;
|
||||
}
|
||||
}
|
||||
LS->seminfo.r = a;
|
||||
return NUMBER;
|
||||
}
|
||||
|
||||
case EOZ:
|
||||
if (LS->iflevel > 0)
|
||||
luaX_error(LS, "input ends inside a $if");
|
||||
return EOS;
|
||||
|
||||
default:
|
||||
if (LS->current != '_' && !isalpha(LS->current)) {
|
||||
int c = LS->current;
|
||||
if (iscntrl(c))
|
||||
luaX_invalidchar(LS, c);
|
||||
save_and_next(LS);
|
||||
return c;
|
||||
}
|
||||
else { /* identifier or reserved word */
|
||||
TaggedString *ts;
|
||||
do {
|
||||
save_and_next(LS);
|
||||
} while (isalnum(LS->current) || LS->current == '_');
|
||||
save(0);
|
||||
ts = luaS_new(L->Mbuffbase);
|
||||
if (ts->head.marked >= 'A')
|
||||
return ts->head.marked; /* reserved word */
|
||||
LS->seminfo.ts = ts;
|
||||
return NAME;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
62
llex.h
Normal file
62
llex.h
Normal file
@@ -0,0 +1,62 @@
|
||||
/*
|
||||
** $Id: llex.h,v 1.8 1998/05/27 13:03:40 roberto Exp roberto $
|
||||
** Lexical Analizer
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
#ifndef llex_h
|
||||
#define llex_h
|
||||
|
||||
#include "lobject.h"
|
||||
#include "lzio.h"
|
||||
|
||||
|
||||
#define FIRST_RESERVED 260
|
||||
|
||||
/* maximum length of a reserved word (+1 for terminal 0) */
|
||||
#define TOKEN_LEN 15
|
||||
|
||||
enum RESERVED {
|
||||
/* terminal symbols denoted by reserved words */
|
||||
AND = FIRST_RESERVED,
|
||||
DO, ELSE, ELSEIF, END, FUNCTION, IF, LOCAL, NIL, NOT, OR,
|
||||
REPEAT, RETURN, THEN, UNTIL, WHILE,
|
||||
/* other terminal symbols */
|
||||
NAME, CONC, DOTS, EQ, GE, LE, NE, NUMBER, STRING, EOS};
|
||||
|
||||
|
||||
#define MAX_IFS 5
|
||||
|
||||
/* "ifstate" keeps the state of each nested $if the lexical is dealing with. */
|
||||
|
||||
struct ifState {
|
||||
int elsepart; /* true if its in the $else part */
|
||||
int condition; /* true if $if condition is true */
|
||||
int skip; /* true if part must be skipped */
|
||||
};
|
||||
|
||||
|
||||
typedef struct LexState {
|
||||
int current; /* look ahead character */
|
||||
int token; /* look ahead token */
|
||||
struct FuncState *fs; /* 'FuncState' is private for the parser */
|
||||
union {
|
||||
real r;
|
||||
TaggedString *ts;
|
||||
} seminfo; /* semantics information */
|
||||
struct zio *lex_z; /* input stream */
|
||||
int linenumber; /* input line counter */
|
||||
int iflevel; /* level of nested $if's (for lexical analysis) */
|
||||
struct ifState ifstate[MAX_IFS];
|
||||
} LexState;
|
||||
|
||||
|
||||
void luaX_init (void);
|
||||
void luaX_setinput (LexState *LS, ZIO *z);
|
||||
int luaX_lex (LexState *LS);
|
||||
void luaX_syntaxerror (LexState *ls, char *s, char *token);
|
||||
void luaX_error (LexState *ls, char *s);
|
||||
void luaX_token2str (LexState *ls, int token, char *s);
|
||||
|
||||
|
||||
#endif
|
||||
213
lmathlib.c
Normal file
213
lmathlib.c
Normal file
@@ -0,0 +1,213 @@
|
||||
/*
|
||||
** $Id: lmathlib.c,v 1.9 1998/05/27 19:09:39 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_frexp (void) {
|
||||
int e;
|
||||
lua_pushnumber(frexp(luaL_check_number(1), &e));
|
||||
lua_pushnumber(e);
|
||||
}
|
||||
|
||||
static void math_ldexp (void) {
|
||||
lua_pushnumber(ldexp(luaL_check_number(1), luaL_check_number(2)));
|
||||
}
|
||||
|
||||
|
||||
|
||||
static void math_min (void)
|
||||
{
|
||||
int i = 1;
|
||||
double dmin = luaL_check_number(i);
|
||||
while (lua_getparam(++i) != LUA_NOOBJECT) {
|
||||
double d = luaL_check_number(i);
|
||||
if (d < dmin)
|
||||
dmin = d;
|
||||
}
|
||||
lua_pushnumber(dmin);
|
||||
}
|
||||
|
||||
|
||||
static void math_max (void)
|
||||
{
|
||||
int i = 1;
|
||||
double dmax = luaL_check_number(i);
|
||||
while (lua_getparam(++i) != LUA_NOOBJECT) {
|
||||
double d = luaL_check_number(i);
|
||||
if (d > dmax)
|
||||
dmax = d;
|
||||
}
|
||||
lua_pushnumber(dmax);
|
||||
}
|
||||
|
||||
|
||||
static void math_random (void)
|
||||
{
|
||||
/* the '%' is needed because on some systems (SunOS!) "rand()" may */
|
||||
/* return a value bigger than RAND_MAX... */
|
||||
double r = (double)(rand()%RAND_MAX) / (double)RAND_MAX;
|
||||
double l = luaL_opt_number(1, 0);
|
||||
if (l == 0)
|
||||
lua_pushnumber(r);
|
||||
else
|
||||
lua_pushnumber((int)(r*l)+1);
|
||||
}
|
||||
|
||||
|
||||
static void math_randomseed (void)
|
||||
{
|
||||
srand(luaL_check_number(1));
|
||||
}
|
||||
|
||||
|
||||
static struct luaL_reg mathlib[] = {
|
||||
{"abs", math_abs},
|
||||
{"sin", math_sin},
|
||||
{"cos", math_cos},
|
||||
{"tan", math_tan},
|
||||
{"asin", math_asin},
|
||||
{"acos", math_acos},
|
||||
{"atan", math_atan},
|
||||
{"atan2", math_atan2},
|
||||
{"ceil", math_ceil},
|
||||
{"floor", math_floor},
|
||||
{"mod", math_mod},
|
||||
{"frexp", math_frexp},
|
||||
{"ldexp", math_ldexp},
|
||||
{"sqrt", math_sqrt},
|
||||
{"min", math_min},
|
||||
{"max", math_max},
|
||||
{"log", math_log},
|
||||
{"log10", math_log10},
|
||||
{"exp", math_exp},
|
||||
{"deg", math_deg},
|
||||
{"rad", math_rad},
|
||||
{"random", math_random},
|
||||
{"randomseed", math_randomseed}
|
||||
};
|
||||
|
||||
/*
|
||||
** Open math library
|
||||
*/
|
||||
void lua_mathlibopen (void)
|
||||
{
|
||||
luaL_openlib(mathlib, (sizeof(mathlib)/sizeof(mathlib[0])));
|
||||
lua_pushstring("deg"); lua_setglobal("_TRIGMODE");
|
||||
lua_pushcfunction(math_pow);
|
||||
lua_pushnumber(0); /* to get its tag */
|
||||
lua_settagmethod(lua_tag(lua_pop()), "pow");
|
||||
lua_pushnumber(PI); lua_setglobal("PI");
|
||||
}
|
||||
|
||||
113
lmem.c
Normal file
113
lmem.c
Normal file
@@ -0,0 +1,113 @@
|
||||
/*
|
||||
** $Id: lmem.c,v 1.6 1998/06/19 16:14:09 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 <string.h>
|
||||
|
||||
|
||||
#define HEADER (sizeof(double))
|
||||
|
||||
#define MARK 55
|
||||
|
||||
unsigned long numblocks = 0;
|
||||
unsigned long totalmem = 0;
|
||||
|
||||
|
||||
static void *checkblock (void *block)
|
||||
{
|
||||
unsigned long *b = (unsigned long *)((char *)block - HEADER);
|
||||
unsigned long size = *b;
|
||||
LUA_ASSERT(*(((char *)b)+size+HEADER) == MARK,
|
||||
"corrupted block");
|
||||
numblocks--;
|
||||
totalmem -= size;
|
||||
return b;
|
||||
}
|
||||
|
||||
|
||||
void *luaM_realloc (void *block, unsigned long size)
|
||||
{
|
||||
unsigned long realsize = HEADER+size+1;
|
||||
if (realsize != (size_t)realsize)
|
||||
lua_error("Allocation Error: Block too big");
|
||||
if (size == 0) { /* ANSI dosen't need this, but some machines... */
|
||||
if (block) {
|
||||
unsigned long *b = (unsigned long *)((char *)block - HEADER);
|
||||
memset(block, -1, *b); /* erase block */
|
||||
block = checkblock(block);
|
||||
free(block);
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
if (block) {
|
||||
block = checkblock(block);
|
||||
block = (unsigned long *)realloc(block, realsize);
|
||||
}
|
||||
else
|
||||
block = (unsigned long *)malloc(realsize);
|
||||
if (block == NULL)
|
||||
lua_error(memEM);
|
||||
totalmem += size;
|
||||
numblocks++;
|
||||
*(unsigned long *)block = size;
|
||||
*(((char *)block)+size+HEADER) = MARK;
|
||||
return (unsigned long *)((char *)block+HEADER);
|
||||
}
|
||||
|
||||
|
||||
#endif
|
||||
43
lmem.h
Normal file
43
lmem.h
Normal 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
|
||||
|
||||
83
lobject.c
Normal file
83
lobject.c
Normal file
@@ -0,0 +1,83 @@
|
||||
/*
|
||||
** $Id: lobject.c,v 1.12 1998/06/18 16:57:03 roberto Exp roberto $
|
||||
** Some generic functions over Lua objects
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
#include <stdlib.h>
|
||||
|
||||
#include "lobject.h"
|
||||
#include "lua.h"
|
||||
|
||||
|
||||
char *luaO_typenames[] = { /* ORDER LUA_T */
|
||||
"userdata", "number", "string", "table", "function", "function",
|
||||
"nil", "function", "mark", "mark", "mark", "line", NULL
|
||||
};
|
||||
|
||||
|
||||
TObject luaO_nilobject = {LUA_T_NIL, {NULL}};
|
||||
|
||||
|
||||
|
||||
/* hash dimensions values */
|
||||
static long dimensions[] =
|
||||
{5L, 11L, 23L, 47L, 97L, 197L, 397L, 797L, 1597L, 3203L, 6421L,
|
||||
12853L, 25717L, 51437L, 102811L, 205619L, 411233L, 822433L,
|
||||
1644817L, 3289613L, 6579211L, 13158023L, MAX_INT};
|
||||
|
||||
|
||||
int luaO_redimension (int oldsize)
|
||||
{
|
||||
int i;
|
||||
for (i=0; dimensions[i]<MAX_INT; i++) {
|
||||
if (dimensions[i] > oldsize)
|
||||
return dimensions[i];
|
||||
}
|
||||
lua_error("table overflow");
|
||||
return 0; /* to avoid warnings */
|
||||
}
|
||||
|
||||
|
||||
int luaO_equalObj (TObject *t1, TObject *t2)
|
||||
{
|
||||
if (ttype(t1) != ttype(t2)) return 0;
|
||||
switch (ttype(t1)) {
|
||||
case LUA_T_NIL: return 1;
|
||||
case LUA_T_NUMBER: return nvalue(t1) == nvalue(t2);
|
||||
case LUA_T_STRING: case LUA_T_USERDATA: return svalue(t1) == svalue(t2);
|
||||
case LUA_T_ARRAY: return avalue(t1) == avalue(t2);
|
||||
case LUA_T_PROTO: return tfvalue(t1) == tfvalue(t2);
|
||||
case LUA_T_CPROTO: return fvalue(t1) == fvalue(t2);
|
||||
case LUA_T_CLOSURE: return t1->value.cl == t2->value.cl;
|
||||
default:
|
||||
LUA_INTERNALERROR("invalid type");
|
||||
return 0; /* UNREACHABLE */
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
void luaO_insertlist (GCnode *root, GCnode *node)
|
||||
{
|
||||
node->next = root->next;
|
||||
root->next = node;
|
||||
node->marked = 0;
|
||||
}
|
||||
|
||||
#ifdef OLD_ANSI
|
||||
void luaO_memup (void *dest, void *src, int size)
|
||||
{
|
||||
char *d = dest;
|
||||
char *s = src;
|
||||
while (size--) d[size]=s[size];
|
||||
}
|
||||
|
||||
void luaO_memdown (void *dest, void *src, int size)
|
||||
{
|
||||
char *d = dest;
|
||||
char *s = src;
|
||||
int i;
|
||||
for (i=0; i<size; i++) d[i]=s[i];
|
||||
}
|
||||
#endif
|
||||
|
||||
210
lobject.h
Normal file
210
lobject.h
Normal file
@@ -0,0 +1,210 @@
|
||||
/*
|
||||
** $Id: lobject.h,v 1.20 1998/06/11 18:21:37 roberto Exp roberto $
|
||||
** Type definitions for Lua objects
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
#ifndef lobject_h
|
||||
#define lobject_h
|
||||
|
||||
|
||||
#include <limits.h>
|
||||
|
||||
#include "lua.h"
|
||||
|
||||
|
||||
#ifdef DEBUG
|
||||
#include "lauxlib.h"
|
||||
#define LUA_INTERNALERROR(s) \
|
||||
luaL_verror("INTERNAL ERROR - %s [%s:%d]",(s),__FILE__,__LINE__)
|
||||
#define LUA_ASSERT(c,s) { if (!(c)) LUA_INTERNALERROR(s); }
|
||||
#else
|
||||
#define LUA_INTERNALERROR(s) /* empty */
|
||||
#define LUA_ASSERT(c,s) /* empty */
|
||||
#endif
|
||||
|
||||
|
||||
/*
|
||||
** "real" is the type "number" of Lua
|
||||
** GREP LUA_NUMBER to change that
|
||||
*/
|
||||
#ifndef LUA_NUM_TYPE
|
||||
#define LUA_NUM_TYPE double
|
||||
#endif
|
||||
|
||||
/*
|
||||
** format to convert number to strings
|
||||
*/
|
||||
#define NUMBER_FMT "%g"
|
||||
|
||||
typedef LUA_NUM_TYPE real;
|
||||
|
||||
#define Byte lua_Byte /* some systems have Byte as a predefined type */
|
||||
typedef unsigned char Byte; /* unsigned 8 bits */
|
||||
|
||||
|
||||
#define MAX_INT (INT_MAX-2) /* maximum value of an int (-2 for safety) */
|
||||
|
||||
/* maximum value of a word of 2 bytes (-2 for safety); must fit in an "int" */
|
||||
#if MAX_INT < 65534
|
||||
#define MAX_WORD MAX_INT
|
||||
#else
|
||||
#define MAX_WORD 65534
|
||||
#endif
|
||||
|
||||
typedef unsigned int IntPoint; /* unsigned with same size as a pointer (for hashing) */
|
||||
|
||||
|
||||
/*
|
||||
** Lua TYPES
|
||||
** WARNING: if you change the order of this enumeration,
|
||||
** grep "ORDER LUA_T"
|
||||
*/
|
||||
typedef enum {
|
||||
LUA_T_USERDATA = 0, /* tag default for userdata */
|
||||
LUA_T_NUMBER = -1, /* fixed tag for numbers */
|
||||
LUA_T_STRING = -2, /* fixed tag for strings */
|
||||
LUA_T_ARRAY = -3, /* tag default for tables (or arrays) */
|
||||
LUA_T_PROTO = -4, /* fixed tag for functions */
|
||||
LUA_T_CPROTO = -5, /* fixed tag for Cfunctions */
|
||||
LUA_T_NIL = -6, /* last "pre-defined" tag */
|
||||
LUA_T_CLOSURE = -7,
|
||||
LUA_T_CLMARK = -8, /* mark for closures */
|
||||
LUA_T_PMARK = -9, /* mark for Lua prototypes */
|
||||
LUA_T_CMARK = -10, /* mark for C prototypes */
|
||||
LUA_T_LINE = -11
|
||||
} lua_Type;
|
||||
|
||||
#define NUM_TYPES 11
|
||||
#define NUM_TAGS 7
|
||||
|
||||
|
||||
typedef union {
|
||||
lua_CFunction f; /* LUA_T_CPROTO, LUA_T_CMARK */
|
||||
real n; /* LUA_T_NUMBER */
|
||||
struct TaggedString *ts; /* LUA_T_STRING, LUA_T_USERDATA */
|
||||
struct TProtoFunc *tf; /* LUA_T_PROTO, LUA_T_PMARK */
|
||||
struct Closure *cl; /* LUA_T_CLOSURE, LUA_T_CLMARK */
|
||||
struct Hash *a; /* LUA_T_ARRAY */
|
||||
int i; /* LUA_T_LINE */
|
||||
} Value;
|
||||
|
||||
|
||||
typedef struct TObject {
|
||||
lua_Type ttype;
|
||||
Value value;
|
||||
} TObject;
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** generic header for garbage collector lists
|
||||
*/
|
||||
typedef struct GCnode {
|
||||
struct GCnode *next;
|
||||
int marked;
|
||||
} GCnode;
|
||||
|
||||
|
||||
/*
|
||||
** String headers for string table
|
||||
*/
|
||||
|
||||
typedef struct TaggedString {
|
||||
GCnode head;
|
||||
unsigned long hash;
|
||||
int constindex; /* hint to reuse constants (= -1 if this is a userdata) */
|
||||
union {
|
||||
struct {
|
||||
TObject globalval;
|
||||
long len; /* if this is a string, here is its length */
|
||||
} s;
|
||||
struct {
|
||||
int tag;
|
||||
void *v; /* if this is a userdata, here is its value */
|
||||
} d;
|
||||
} u;
|
||||
char str[1]; /* \0 byte already reserved */
|
||||
} TaggedString;
|
||||
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** Function Prototypes
|
||||
*/
|
||||
typedef struct TProtoFunc {
|
||||
GCnode head;
|
||||
struct TObject *consts;
|
||||
int nconsts;
|
||||
Byte *code; /* ends with opcode ENDCODE */
|
||||
int lineDefined;
|
||||
TaggedString *fileName;
|
||||
struct LocVar *locvars; /* ends with line = -1 */
|
||||
} TProtoFunc;
|
||||
|
||||
typedef struct LocVar {
|
||||
TaggedString *varname; /* NULL signals end of scope */
|
||||
int line;
|
||||
} LocVar;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
/* Macros to access structure members */
|
||||
#define ttype(o) ((o)->ttype)
|
||||
#define nvalue(o) ((o)->value.n)
|
||||
#define svalue(o) ((o)->value.ts->str)
|
||||
#define tsvalue(o) ((o)->value.ts)
|
||||
#define clvalue(o) ((o)->value.cl)
|
||||
#define avalue(o) ((o)->value.a)
|
||||
#define fvalue(o) ((o)->value.f)
|
||||
#define tfvalue(o) ((o)->value.tf)
|
||||
|
||||
#define protovalue(o) ((o)->value.cl->consts)
|
||||
|
||||
|
||||
/*
|
||||
** Closures
|
||||
*/
|
||||
typedef struct Closure {
|
||||
GCnode head;
|
||||
int nelems; /* not included the first one (always the prototype) */
|
||||
TObject consts[1]; /* at least one for prototype */
|
||||
} Closure;
|
||||
|
||||
|
||||
|
||||
typedef struct node {
|
||||
TObject ref;
|
||||
TObject val;
|
||||
} Node;
|
||||
|
||||
typedef struct Hash {
|
||||
GCnode head;
|
||||
Node *node;
|
||||
int nhash;
|
||||
int nuse;
|
||||
int htag;
|
||||
} Hash;
|
||||
|
||||
|
||||
extern char *luaO_typenames[];
|
||||
|
||||
extern TObject luaO_nilobject;
|
||||
|
||||
int luaO_equalObj (TObject *t1, TObject *t2);
|
||||
int luaO_redimension (int oldsize);
|
||||
void luaO_insertlist (GCnode *root, GCnode *node);
|
||||
|
||||
#ifdef OLD_ANSI
|
||||
void luaO_memup (void *dest, void *src, int size);
|
||||
void luaO_memdown (void *dest, void *src, int size);
|
||||
#else
|
||||
#include <string.h>
|
||||
#define luaO_memup(d,s,n) memmove(d,s,n)
|
||||
#define luaO_memdown(d,s,n) memmove(d,s,n)
|
||||
#endif
|
||||
|
||||
#endif
|
||||
181
lopcodes.h
Normal file
181
lopcodes.h
Normal file
@@ -0,0 +1,181 @@
|
||||
/*
|
||||
** $Id: lopcodes.h,v 1.17 1998/03/25 18:52:29 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[CNST[b]] */
|
||||
GETDOTTED0,/* - t t[CNST[0]] */
|
||||
GETDOTTED1,/* - t t[CNST[1]] */
|
||||
GETDOTTED2,/* - t t[CNST[2]] */
|
||||
GETDOTTED3,/* - t t[CNST[3]] */
|
||||
GETDOTTED4,/* - t t[CNST[4]] */
|
||||
GETDOTTED5,/* - t t[CNST[5]] */
|
||||
GETDOTTED6,/* - t t[CNST[6]] */
|
||||
GETDOTTED7,/* - t t[CNST[7]] */
|
||||
GETDOTTEDW,/* w t t[CNST[w]] */
|
||||
|
||||
PUSHSELF,/* b t t t[CNST[b]] */
|
||||
PUSHSELF0,/* - t t t[CNST[0]] */
|
||||
PUSHSELF1,/* - t t t[CNST[1]] */
|
||||
PUSHSELF2,/* - t t t[CNST[2]] */
|
||||
PUSHSELF3,/* - t t t[CNST[3]] */
|
||||
PUSHSELF4,/* - t t t[CNST[4]] */
|
||||
PUSHSELF5,/* - t t t[CNST[5]] */
|
||||
PUSHSELF6,/* - t t t[CNST[6]] */
|
||||
PUSHSELF7,/* - t t t[CNST[7]] */
|
||||
PUSHSELFW,/* w t t t[CNST[w]] */
|
||||
|
||||
CREATEARRAY,/* b - newarray(size = b) */
|
||||
CREATEARRAY0,/* - - newarray(size = 0) */
|
||||
CREATEARRAY1,/* - - newarray(size = 1) */
|
||||
CREATEARRAYW,/* w - newarray(size = w) */
|
||||
|
||||
SETLOCAL,/* b x - LOC[b]=x */
|
||||
SETLOCAL0,/* - x - LOC[0]=x */
|
||||
SETLOCAL1,/* - x - LOC[1]=x */
|
||||
SETLOCAL2,/* - x - LOC[2]=x */
|
||||
SETLOCAL3,/* - x - LOC[3]=x */
|
||||
SETLOCAL4,/* - x - LOC[4]=x */
|
||||
SETLOCAL5,/* - x - LOC[5]=x */
|
||||
SETLOCAL6,/* - x - LOC[6]=x */
|
||||
SETLOCAL7,/* - x - LOC[7]=x */
|
||||
|
||||
SETGLOBAL,/* b x - VAR[CNST[b]]=x */
|
||||
SETGLOBAL0,/* - x - VAR[CNST[0]]=x */
|
||||
SETGLOBAL1,/* - x - VAR[CNST[1]]=x */
|
||||
SETGLOBAL2,/* - x - VAR[CNST[2]]=x */
|
||||
SETGLOBAL3,/* - x - VAR[CNST[3]]=x */
|
||||
SETGLOBAL4,/* - x - VAR[CNST[4]]=x */
|
||||
SETGLOBAL5,/* - x - VAR[CNST[5]]=x */
|
||||
SETGLOBAL6,/* - x - VAR[CNST[6]]=x */
|
||||
SETGLOBAL7,/* - x - VAR[CNST[7]]=x */
|
||||
SETGLOBALW,/* w x - VAR[CNST[w]]=x */
|
||||
|
||||
SETTABLE0,/* - v i t - t[i]=v */
|
||||
|
||||
SETTABLE,/* b v a_b...a_1 i t a_b...a_1 i t t[i]=v */
|
||||
|
||||
SETLIST,/* b c v_c...v_1 t - t[i+b*FPF]=v_i */
|
||||
SETLIST0,/* b v_b...v_1 t - t[i]=v_i */
|
||||
SETLISTW,/* w c v_c...v_1 t - t[i+w*FPF]=v_i */
|
||||
|
||||
SETMAP,/* b v_b k_b ...v_0 k_0 t t t[k_i]=v_i */
|
||||
SETMAP0,/* - v_0 k_0 t t t[k_0]=v_0 */
|
||||
|
||||
EQOP,/* - y x (x==y)? 1 : nil */
|
||||
NEQOP,/* - y x (x~=y)? 1 : nil */
|
||||
LTOP,/* - y x (x<y)? 1 : nil */
|
||||
LEOP,/* - y x (x<y)? 1 : nil */
|
||||
GTOP,/* - y x (x>y)? 1 : nil */
|
||||
GEOP,/* - y x (x>=y)? 1 : nil */
|
||||
ADDOP,/* - y x x+y */
|
||||
SUBOP,/* - y x x-y */
|
||||
MULTOP,/* - y x x*y */
|
||||
DIVOP,/* - y x x/y */
|
||||
POWOP,/* - y x x^y */
|
||||
CONCOP,/* - y x x..y */
|
||||
MINUSOP,/* - x -x */
|
||||
NOTOP,/* - x (x==nil)? 1 : nil */
|
||||
|
||||
ONTJMP,/* b x (x!=nil)? x : - (x!=nil)? PC+=b */
|
||||
ONTJMPW,/* w x (x!=nil)? x : - (x!=nil)? PC+=w */
|
||||
ONFJMP,/* b x (x==nil)? x : - (x==nil)? PC+=b */
|
||||
ONFJMPW,/* w x (x==nil)? x : - (x==nil)? PC+=w */
|
||||
JMP,/* b - - PC+=b */
|
||||
JMPW,/* w - - PC+=w */
|
||||
IFFJMP,/* b x - (x==nil)? PC+=b */
|
||||
IFFJMPW,/* w x - (x==nil)? PC+=w */
|
||||
IFTUPJMP,/* b x - (x!=nil)? PC-=b */
|
||||
IFTUPJMPW,/* w x - (x!=nil)? PC-=w */
|
||||
IFFUPJMP,/* b x - (x==nil)? PC-=b */
|
||||
IFFUPJMPW,/* w x - (x==nil)? PC-=w */
|
||||
|
||||
CLOSURE,/* b c v_c...v_1 closure(CNST[b], v_c...v_1) */
|
||||
CLOSUREW,/* w c v_b...v_1 closure(CNST[w], v_c...v_1) */
|
||||
|
||||
CALLFUNC,/* b c v_c...v_1 f r_b...r_1 f(v1,...,v_c) */
|
||||
CALLFUNC0,/* b v_b...v_1 f - f(v1,...,v_b) */
|
||||
CALLFUNC1,/* b v_b...v_1 f r_1 f(v1,...,v_b) */
|
||||
|
||||
RETCODE,/* b - - */
|
||||
|
||||
SETLINE,/* b - - LINE=b */
|
||||
SETLINEW,/* w - - LINE=w */
|
||||
|
||||
POP,/* b - - TOP-=(b+1) */
|
||||
POP0,/* - - - TOP-=1 */
|
||||
POP1/* - - - TOP-=2 */
|
||||
|
||||
} OpCode;
|
||||
|
||||
|
||||
#define RFIELDS_PER_FLUSH 32 /* records (SETMAP) */
|
||||
#define LFIELDS_PER_FLUSH 64 /* lists (SETLIST) */
|
||||
|
||||
#define ZEROVARARG 64
|
||||
|
||||
#endif
|
||||
20
lparser.h
Normal file
20
lparser.h
Normal 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
|
||||
86
lstate.c
Normal file
86
lstate.c
Normal file
@@ -0,0 +1,86 @@
|
||||
/*
|
||||
** $Id: lstate.c,v 1.5 1997/12/17 20:48:58 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"
|
||||
|
||||
|
||||
lua_State *lua_state = NULL;
|
||||
|
||||
|
||||
void lua_open (void)
|
||||
{
|
||||
if (lua_state) return;
|
||||
lua_state = luaM_new(lua_State);
|
||||
L->numCblocks = 0;
|
||||
L->Cstack.base = 0;
|
||||
L->Cstack.lua2C = 0;
|
||||
L->Cstack.num = 0;
|
||||
L->errorJmp = NULL;
|
||||
L->rootproto.next = NULL;
|
||||
L->rootproto.marked = 0;
|
||||
L->rootcl.next = NULL;
|
||||
L->rootcl.marked = 0;
|
||||
L->rootglobal.next = NULL;
|
||||
L->rootglobal.marked = 0;
|
||||
L->roottable.next = NULL;
|
||||
L->roottable.marked = 0;
|
||||
L->refArray = NULL;
|
||||
L->refSize = 0;
|
||||
L->Mbuffsize = 0;
|
||||
L->Mbuffnext = 0;
|
||||
L->Mbuffbase = NULL;
|
||||
L->Mbuffer = NULL;
|
||||
L->GCthreshold = GARBAGE_BLOCK;
|
||||
L->nblocks = 0;
|
||||
luaD_init();
|
||||
luaS_init();
|
||||
luaX_init();
|
||||
luaT_init();
|
||||
luaB_predefine();
|
||||
}
|
||||
|
||||
|
||||
void lua_close (void)
|
||||
{
|
||||
TaggedString *alludata = luaS_collectudata();
|
||||
L->GCthreshold = MAX_INT; /* to avoid GC during GC */
|
||||
luaC_hashcallIM((Hash *)L->roottable.next); /* GC t.methods for tables */
|
||||
luaC_strcallIM(alludata); /* GC tag methods for userdata */
|
||||
luaD_gcIM(&luaO_nilobject); /* GC tag method for nil (signal end of GC) */
|
||||
luaH_free((Hash *)L->roottable.next);
|
||||
luaF_freeproto((TProtoFunc *)L->rootproto.next);
|
||||
luaF_freeclosure((Closure *)L->rootcl.next);
|
||||
luaS_free(alludata);
|
||||
luaS_freeall();
|
||||
luaM_free(L->stack.stack);
|
||||
luaM_free(L->IMtable);
|
||||
luaM_free(L->refArray);
|
||||
luaM_free(L->Mbuffer);
|
||||
luaM_free(L);
|
||||
L = NULL;
|
||||
#ifdef DEBUG
|
||||
printf("total de blocos: %ld\n", numblocks);
|
||||
printf("total de memoria: %ld\n", totalmem);
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
lua_State *lua_setstate (lua_State *st) {
|
||||
lua_State *old = lua_state;
|
||||
lua_state = st;
|
||||
return old;
|
||||
}
|
||||
|
||||
86
lstate.h
Normal file
86
lstate.h
Normal file
@@ -0,0 +1,86 @@
|
||||
/*
|
||||
** $Id: lstate.h,v 1.10 1998/06/19 16:14:09 roberto Exp roberto $
|
||||
** Global State
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
#ifndef lstate_h
|
||||
#define lstate_h
|
||||
|
||||
#include <setjmp.h>
|
||||
|
||||
#include "lobject.h"
|
||||
#include "lua.h"
|
||||
|
||||
|
||||
#define MAX_C_BLOCKS 10
|
||||
|
||||
#define GARBAGE_BLOCK 150
|
||||
|
||||
|
||||
typedef int StkId; /* index to stack elements */
|
||||
|
||||
struct Stack {
|
||||
TObject *top;
|
||||
TObject *stack;
|
||||
TObject *last;
|
||||
};
|
||||
|
||||
struct C_Lua_Stack {
|
||||
StkId base; /* when Lua calls C or C calls Lua, points to */
|
||||
/* the first slot after the last parameter. */
|
||||
StkId lua2C; /* points to first element of "array" lua2C */
|
||||
int num; /* size of "array" lua2C */
|
||||
};
|
||||
|
||||
|
||||
typedef struct {
|
||||
int size;
|
||||
int nuse; /* number of elements (including EMPTYs) */
|
||||
TaggedString **hash;
|
||||
} stringtable;
|
||||
|
||||
|
||||
enum Status {LOCK, HOLD, FREE, COLLECTED};
|
||||
|
||||
struct ref {
|
||||
TObject o;
|
||||
enum Status status;
|
||||
};
|
||||
|
||||
|
||||
struct lua_State {
|
||||
/* thread-specific state */
|
||||
struct Stack stack; /* Lua stack */
|
||||
struct C_Lua_Stack Cstack; /* C2lua struct */
|
||||
jmp_buf *errorJmp; /* current error recover point */
|
||||
char *Mbuffer; /* global buffer */
|
||||
char *Mbuffbase; /* current first position of Mbuffer */
|
||||
int Mbuffsize; /* size of Mbuffer */
|
||||
int Mbuffnext; /* next position to fill in Mbuffer */
|
||||
struct C_Lua_Stack Cblocks[MAX_C_BLOCKS];
|
||||
int numCblocks; /* number of nested Cblocks */
|
||||
/* global state */
|
||||
TObject errorim; /* error tag method */
|
||||
GCnode rootproto; /* list of all prototypes */
|
||||
GCnode rootcl; /* list of all closures */
|
||||
GCnode roottable; /* list of all tables */
|
||||
GCnode rootglobal; /* list of strings with global values */
|
||||
stringtable *string_root; /* array of hash tables for strings and udata */
|
||||
struct IM *IMtable; /* table for tag methods */
|
||||
int IMtable_size; /* size of IMtable */
|
||||
int last_tag; /* last used tag in IMtable */
|
||||
struct ref *refArray; /* locked objects */
|
||||
int refSize; /* size of refArray */
|
||||
unsigned long GCthreshold;
|
||||
unsigned long nblocks; /* number of 'blocks' currently allocated */
|
||||
};
|
||||
|
||||
|
||||
extern lua_State *lua_state;
|
||||
|
||||
|
||||
#define L lua_state
|
||||
|
||||
|
||||
#endif
|
||||
313
lstring.c
Normal file
313
lstring.c
Normal file
@@ -0,0 +1,313 @@
|
||||
/*
|
||||
** $Id: lstring.c,v 1.12 1998/03/06 16:54:42 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}, 0L, 0,
|
||||
{{{LUA_T_NIL, {NULL}}, 0L}}, {0}};
|
||||
|
||||
|
||||
void luaS_init (void)
|
||||
{
|
||||
int i;
|
||||
L->string_root = luaM_newvector(NUM_HASHS, stringtable);
|
||||
for (i=0; i<NUM_HASHS; i++) {
|
||||
L->string_root[i].size = 0;
|
||||
L->string_root[i].nuse = 0;
|
||||
L->string_root[i].hash = NULL;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static unsigned long hash_s (char *s, long l)
|
||||
{
|
||||
unsigned long h = 0;
|
||||
while (l--)
|
||||
h = ((h<<5)-h)^(unsigned char)*(s++);
|
||||
return h;
|
||||
}
|
||||
|
||||
static int newsize (stringtable *tb)
|
||||
{
|
||||
int size = tb->size;
|
||||
int realuse = 0;
|
||||
int i;
|
||||
/* count how many entries are really in use */
|
||||
for (i=0; i<size; i++)
|
||||
if (tb->hash[i] != NULL && tb->hash[i] != &EMPTY)
|
||||
realuse++;
|
||||
if (2*(realuse+1) <= size) /* +1 is the new element */
|
||||
return size; /* don't need to grow, just rehash to clear EMPTYs */
|
||||
else
|
||||
return luaO_redimension(size);
|
||||
}
|
||||
|
||||
|
||||
static void grow (stringtable *tb)
|
||||
{
|
||||
|
||||
int ns = newsize(tb);
|
||||
TaggedString **newhash = luaM_newvector(ns, TaggedString *);
|
||||
int i;
|
||||
for (i=0; i<ns; i++)
|
||||
newhash[i] = NULL;
|
||||
/* rehash */
|
||||
tb->nuse = 0;
|
||||
for (i=0; i<tb->size; i++) {
|
||||
if (tb->hash[i] != NULL && tb->hash[i] != &EMPTY) {
|
||||
int h = tb->hash[i]->hash%ns;
|
||||
while (newhash[h])
|
||||
h = (h+1)%ns;
|
||||
newhash[h] = tb->hash[i];
|
||||
tb->nuse++;
|
||||
}
|
||||
}
|
||||
luaM_free(tb->hash);
|
||||
tb->size = ns;
|
||||
tb->hash = newhash;
|
||||
}
|
||||
|
||||
|
||||
static TaggedString *newone_s (char *str, long l, unsigned long h)
|
||||
{
|
||||
TaggedString *ts = (TaggedString *)luaM_malloc(sizeof(TaggedString)+l);
|
||||
memcpy(ts->str, str, l);
|
||||
ts->str[l] = 0; /* ending 0 */
|
||||
ts->u.s.globalval.ttype = LUA_T_NIL; /* initialize global value */
|
||||
ts->u.s.len = l;
|
||||
ts->constindex = 0;
|
||||
L->nblocks += gcsizestring(l);
|
||||
ts->head.marked = 0;
|
||||
ts->head.next = (GCnode *)ts; /* signal it is in no list */
|
||||
ts->hash = h;
|
||||
return ts;
|
||||
}
|
||||
|
||||
static TaggedString *newone_u (char *buff, int tag, unsigned long h)
|
||||
{
|
||||
TaggedString *ts = luaM_new(TaggedString);
|
||||
ts->u.d.v = buff;
|
||||
ts->u.d.tag = (tag == LUA_ANYTAG) ? 0 : tag;
|
||||
ts->constindex = -1; /* tag -> this is a userdata */
|
||||
L->nblocks++;
|
||||
ts->head.marked = 0;
|
||||
ts->head.next = (GCnode *)ts; /* signal it is in no list */
|
||||
ts->hash = h;
|
||||
return ts;
|
||||
}
|
||||
|
||||
static TaggedString *insert_s (char *str, long l, stringtable *tb)
|
||||
{
|
||||
TaggedString *ts;
|
||||
unsigned long h = hash_s(str, l);
|
||||
int size = tb->size;
|
||||
int i;
|
||||
int j = -1;
|
||||
if ((long)tb->nuse*3 >= (long)size*2) {
|
||||
grow(tb);
|
||||
size = tb->size;
|
||||
}
|
||||
for (i = h%size; (ts = tb->hash[i]) != NULL; ) {
|
||||
if (ts == &EMPTY)
|
||||
j = i;
|
||||
else if (ts->constindex >= 0 &&
|
||||
ts->u.s.len == l &&
|
||||
(memcmp(str, ts->str, l) == 0))
|
||||
return ts;
|
||||
if (++i == size) i=0;
|
||||
}
|
||||
/* not found */
|
||||
if (j != -1) /* is there an EMPTY space? */
|
||||
i = j;
|
||||
else
|
||||
tb->nuse++;
|
||||
ts = tb->hash[i] = newone_s(str, l, h);
|
||||
return ts;
|
||||
}
|
||||
|
||||
static TaggedString *insert_u (void *buff, int tag, stringtable *tb)
|
||||
{
|
||||
TaggedString *ts;
|
||||
unsigned long h = (unsigned long)buff;
|
||||
int size = tb->size;
|
||||
int i;
|
||||
int j = -1;
|
||||
if ((long)tb->nuse*3 >= (long)size*2) {
|
||||
grow(tb);
|
||||
size = tb->size;
|
||||
}
|
||||
for (i = h%size; (ts = tb->hash[i]) != NULL; ) {
|
||||
if (ts == &EMPTY)
|
||||
j = i;
|
||||
else if (ts->constindex < 0 && /* is a udata? */
|
||||
(tag == ts->u.d.tag || tag == LUA_ANYTAG) &&
|
||||
buff == ts->u.d.v)
|
||||
return ts;
|
||||
if (++i == size) i=0;
|
||||
}
|
||||
/* not found */
|
||||
if (j != -1) /* is there an EMPTY space? */
|
||||
i = j;
|
||||
else
|
||||
tb->nuse++;
|
||||
ts = tb->hash[i] = newone_u(buff, tag, h);
|
||||
return ts;
|
||||
}
|
||||
|
||||
TaggedString *luaS_createudata (void *udata, int tag)
|
||||
{
|
||||
return insert_u(udata, tag, &L->string_root[(unsigned)udata%NUM_HASHS]);
|
||||
}
|
||||
|
||||
TaggedString *luaS_newlstr (char *str, long l)
|
||||
{
|
||||
int i = (l==0)?0:(unsigned char)str[0];
|
||||
return insert_s(str, l, &L->string_root[i%NUM_HASHS]);
|
||||
}
|
||||
|
||||
TaggedString *luaS_new (char *str)
|
||||
{
|
||||
return luaS_newlstr(str, strlen(str));
|
||||
}
|
||||
|
||||
TaggedString *luaS_newfixedstring (char *str)
|
||||
{
|
||||
TaggedString *ts = luaS_new(str);
|
||||
if (ts->head.marked == 0)
|
||||
ts->head.marked = 2; /* avoid GC */
|
||||
return ts;
|
||||
}
|
||||
|
||||
|
||||
void luaS_free (TaggedString *l)
|
||||
{
|
||||
while (l) {
|
||||
TaggedString *next = (TaggedString *)l->head.next;
|
||||
L->nblocks -= (l->constindex == -1) ? 1 : gcsizestring(l->u.s.len);
|
||||
luaM_free(l);
|
||||
l = next;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Garbage collection functions.
|
||||
*/
|
||||
|
||||
static void remove_from_list (GCnode *l)
|
||||
{
|
||||
while (l) {
|
||||
GCnode *next = l->next;
|
||||
while (next && !next->marked)
|
||||
next = l->next = next->next;
|
||||
l = next;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
TaggedString *luaS_collector (void)
|
||||
{
|
||||
TaggedString *frees = NULL;
|
||||
int i;
|
||||
remove_from_list(&(L->rootglobal));
|
||||
for (i=0; i<NUM_HASHS; i++) {
|
||||
stringtable *tb = &L->string_root[i];
|
||||
int j;
|
||||
for (j=0; j<tb->size; j++) {
|
||||
TaggedString *t = tb->hash[j];
|
||||
if (t == NULL) continue;
|
||||
if (t->head.marked == 1)
|
||||
t->head.marked = 0;
|
||||
else if (!t->head.marked) {
|
||||
t->head.next = (GCnode *)frees;
|
||||
frees = t;
|
||||
tb->hash[j] = &EMPTY;
|
||||
}
|
||||
}
|
||||
}
|
||||
return frees;
|
||||
}
|
||||
|
||||
|
||||
TaggedString *luaS_collectudata (void)
|
||||
{
|
||||
TaggedString *frees = NULL;
|
||||
int i;
|
||||
L->rootglobal.next = NULL; /* empty list of globals */
|
||||
for (i=0; i<NUM_HASHS; i++) {
|
||||
stringtable *tb = &L->string_root[i];
|
||||
int j;
|
||||
for (j=0; j<tb->size; j++) {
|
||||
TaggedString *t = tb->hash[j];
|
||||
if (t == NULL || t == &EMPTY || t->constindex != -1)
|
||||
continue; /* get only user data */
|
||||
t->head.next = (GCnode *)frees;
|
||||
frees = t;
|
||||
tb->hash[j] = &EMPTY;
|
||||
}
|
||||
}
|
||||
return frees;
|
||||
}
|
||||
|
||||
|
||||
void luaS_freeall (void)
|
||||
{
|
||||
int i;
|
||||
for (i=0; i<NUM_HASHS; i++) {
|
||||
stringtable *tb = &L->string_root[i];
|
||||
int j;
|
||||
for (j=0; j<tb->size; j++) {
|
||||
TaggedString *t = tb->hash[j];
|
||||
if (t == &EMPTY) continue;
|
||||
luaM_free(t);
|
||||
}
|
||||
luaM_free(tb->hash);
|
||||
}
|
||||
luaM_free(L->string_root);
|
||||
}
|
||||
|
||||
|
||||
void luaS_rawsetglobal (TaggedString *ts, TObject *newval)
|
||||
{
|
||||
ts->u.s.globalval = *newval;
|
||||
if (ts->head.next == (GCnode *)ts) { /* is not in list? */
|
||||
ts->head.next = L->rootglobal.next;
|
||||
L->rootglobal.next = (GCnode *)ts;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
char *luaS_travsymbol (int (*fn)(TObject *))
|
||||
{
|
||||
TaggedString *g;
|
||||
for (g=(TaggedString *)L->rootglobal.next; g; g=(TaggedString *)g->head.next)
|
||||
if (fn(&g->u.s.globalval))
|
||||
return g->str;
|
||||
return NULL;
|
||||
}
|
||||
|
||||
|
||||
int luaS_globaldefined (char *name)
|
||||
{
|
||||
TaggedString *ts = luaS_new(name);
|
||||
return ts->u.s.globalval.ttype != LUA_T_NIL;
|
||||
}
|
||||
|
||||
28
lstring.h
Normal file
28
lstring.h
Normal file
@@ -0,0 +1,28 @@
|
||||
/*
|
||||
** $Id: lstring.h,v 1.6 1997/12/01 20:31:25 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_newlstr (char *str, long l);
|
||||
TaggedString *luaS_new (char *str);
|
||||
TaggedString *luaS_newfixedstring (char *str);
|
||||
void luaS_rawsetglobal (TaggedString *ts, TObject *newval);
|
||||
char *luaS_travsymbol (int (*fn)(TObject *));
|
||||
int luaS_globaldefined (char *name);
|
||||
TaggedString *luaS_collectudata (void);
|
||||
void luaS_freeall (void);
|
||||
|
||||
|
||||
#endif
|
||||
541
lstrlib.c
Normal file
541
lstrlib.c
Normal file
@@ -0,0 +1,541 @@
|
||||
/*
|
||||
** $Id: lstrlib.c,v 1.17 1998/06/29 18:24:06 roberto Exp roberto $
|
||||
** Standard library for strings and pattern-matching
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
#include <ctype.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
#include "lauxlib.h"
|
||||
#include "lua.h"
|
||||
#include "lualib.h"
|
||||
|
||||
|
||||
|
||||
static void addnchar (char *s, int n)
|
||||
{
|
||||
char *b = luaL_openspace(n);
|
||||
memcpy(b, s, n);
|
||||
luaL_addsize(n);
|
||||
}
|
||||
|
||||
|
||||
static void str_len (void)
|
||||
{
|
||||
long l;
|
||||
luaL_check_lstr(1, &l);
|
||||
lua_pushnumber(l);
|
||||
}
|
||||
|
||||
|
||||
static void closeandpush (void)
|
||||
{
|
||||
lua_pushlstring(luaL_buffer(), luaL_getsize());
|
||||
}
|
||||
|
||||
|
||||
static long posrelat (long pos, long len)
|
||||
{
|
||||
/* relative string position: negative means back from end */
|
||||
return (pos>=0) ? pos : len+pos+1;
|
||||
}
|
||||
|
||||
|
||||
static void str_sub (void)
|
||||
{
|
||||
long l;
|
||||
char *s = luaL_check_lstr(1, &l);
|
||||
long start = posrelat(luaL_check_number(2), l);
|
||||
long end = posrelat(luaL_opt_number(3, -1), l);
|
||||
if (1 <= start && start <= end && end <= l)
|
||||
lua_pushlstring(s+start-1, end-start+1);
|
||||
else lua_pushstring("");
|
||||
}
|
||||
|
||||
|
||||
static void str_lower (void)
|
||||
{
|
||||
long l;
|
||||
int i;
|
||||
char *s = luaL_check_lstr(1, &l);
|
||||
luaL_resetbuffer();
|
||||
for (i=0; i<l; i++)
|
||||
luaL_addchar(tolower((unsigned char)(s[i])));
|
||||
closeandpush();
|
||||
}
|
||||
|
||||
|
||||
static void str_upper (void)
|
||||
{
|
||||
long l;
|
||||
int i;
|
||||
char *s = luaL_check_lstr(1, &l);
|
||||
luaL_resetbuffer();
|
||||
for (i=0; i<l; i++)
|
||||
luaL_addchar(toupper((unsigned char)(s[i])));
|
||||
closeandpush();
|
||||
}
|
||||
|
||||
static void str_rep (void)
|
||||
{
|
||||
long l;
|
||||
char *s = luaL_check_lstr(1, &l);
|
||||
int n = (int)luaL_check_number(2);
|
||||
luaL_resetbuffer();
|
||||
while (n-- > 0)
|
||||
addnchar(s, l);
|
||||
closeandpush();
|
||||
}
|
||||
|
||||
|
||||
static void str_byte (void)
|
||||
{
|
||||
long l;
|
||||
char *s = luaL_check_lstr(1, &l);
|
||||
long pos = posrelat(luaL_opt_number(2, 1), l);
|
||||
luaL_arg_check(0<pos && pos<=l, 2, "out of range");
|
||||
lua_pushnumber((unsigned char)s[pos-1]);
|
||||
}
|
||||
|
||||
static void str_char (void) {
|
||||
int i = 0;
|
||||
luaL_resetbuffer();
|
||||
while (lua_getparam(++i) != LUA_NOOBJECT) {
|
||||
double c = luaL_check_number(i);
|
||||
luaL_arg_check((unsigned char)c == c, i, "invalid value");
|
||||
luaL_addchar((int)c);
|
||||
}
|
||||
closeandpush();
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** =======================================================
|
||||
** PATTERN MATCHING
|
||||
** =======================================================
|
||||
*/
|
||||
|
||||
#define MAX_CAPT 9
|
||||
|
||||
struct Capture {
|
||||
int level; /* total number of captures (finished or unfinished) */
|
||||
char *src_end; /* end ('\0') of source string */
|
||||
struct {
|
||||
char *init;
|
||||
int len; /* -1 signals unfinished capture */
|
||||
} capture[MAX_CAPT];
|
||||
};
|
||||
|
||||
|
||||
#define ESC '%'
|
||||
#define SPECIALS "^$*?.([%-"
|
||||
|
||||
|
||||
static void push_captures (struct Capture *cap)
|
||||
{
|
||||
int i;
|
||||
for (i=0; i<cap->level; i++)
|
||||
lua_pushlstring(cap->capture[i].init, cap->capture[i].len);
|
||||
}
|
||||
|
||||
|
||||
static int check_cap (int l, struct Capture *cap)
|
||||
{
|
||||
l -= '1';
|
||||
if (!(0 <= l && l < cap->level && cap->capture[l].len != -1))
|
||||
lua_error("invalid capture index");
|
||||
return l;
|
||||
}
|
||||
|
||||
|
||||
static int capture_to_close (struct Capture *cap)
|
||||
{
|
||||
int level = cap->level;
|
||||
for (level--; level>=0; level--)
|
||||
if (cap->capture[level].len == -1) return level;
|
||||
lua_error("invalid pattern capture");
|
||||
return 0; /* to avoid warnings */
|
||||
}
|
||||
|
||||
|
||||
static char *bracket_end (char *p)
|
||||
{
|
||||
return (*p == 0) ? NULL : strchr((*p=='^') ? p+2 : p+1, ']');
|
||||
}
|
||||
|
||||
|
||||
static int matchclass (int c, int cl)
|
||||
{
|
||||
int res;
|
||||
switch (tolower(cl)) {
|
||||
case 'a' : res = isalpha(c); break;
|
||||
case 'c' : res = iscntrl(c); break;
|
||||
case 'd' : res = isdigit(c); break;
|
||||
case 'l' : res = islower(c); break;
|
||||
case 'p' : res = ispunct(c); break;
|
||||
case 's' : res = isspace(c); break;
|
||||
case 'u' : res = isupper(c); break;
|
||||
case 'w' : res = isalnum(c); break;
|
||||
case 'z' : res = (c == '\0'); break;
|
||||
default: return (cl == c);
|
||||
}
|
||||
return (islower((unsigned char)cl) ? res : !res);
|
||||
}
|
||||
|
||||
|
||||
int luaI_singlematch (int c, char *p, char **ep)
|
||||
{
|
||||
switch (*p) {
|
||||
case '.': /* matches any char */
|
||||
*ep = p+1;
|
||||
return 1;
|
||||
case '\0': /* end of pattern; matches nothing */
|
||||
*ep = p;
|
||||
return 0;
|
||||
case ESC:
|
||||
if (*(++p) == '\0')
|
||||
luaL_verror("incorrect pattern (ends with `%c')", ESC);
|
||||
*ep = p+1;
|
||||
return matchclass(c, (unsigned char)*p);
|
||||
case '[': {
|
||||
char *end = bracket_end(p+1);
|
||||
int sig = *(p+1) == '^' ? (p++, 0) : 1;
|
||||
if (end == NULL) lua_error("incorrect pattern (missing `]')");
|
||||
*ep = end+1;
|
||||
while (++p < end) {
|
||||
if (*p == ESC) {
|
||||
if (((p+1) < end) && matchclass(c, (unsigned char)*++p))
|
||||
return sig;
|
||||
}
|
||||
else if ((*(p+1) == '-') && (p+2 < end)) {
|
||||
p+=2;
|
||||
if ((unsigned char)*(p-2) <= c && c <= (unsigned char)*p)
|
||||
return sig;
|
||||
}
|
||||
else if ((unsigned char)*p == c) return sig;
|
||||
}
|
||||
return !sig;
|
||||
}
|
||||
default:
|
||||
*ep = p+1;
|
||||
return ((unsigned char)*p == c);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static char *matchbalance (char *s, int b, int e, struct Capture *cap)
|
||||
{
|
||||
if (*s != b) return NULL;
|
||||
else {
|
||||
int cont = 1;
|
||||
while (++s < cap->src_end) {
|
||||
if (*s == e) {
|
||||
if (--cont == 0) return s+1;
|
||||
}
|
||||
else if (*s == b) cont++;
|
||||
}
|
||||
}
|
||||
return NULL; /* string ends out of balance */
|
||||
}
|
||||
|
||||
|
||||
static char *matchitem (char *s, char *p, struct Capture *cap, char **ep)
|
||||
{
|
||||
if (*p == ESC) {
|
||||
p++;
|
||||
if (isdigit((unsigned char)*p)) { /* capture */
|
||||
int l = check_cap(*p, cap);
|
||||
int len = cap->capture[l].len;
|
||||
*ep = p+1;
|
||||
if (cap->src_end-s >= len && memcmp(cap->capture[l].init, s, len) == 0)
|
||||
return s+len;
|
||||
else return NULL;
|
||||
}
|
||||
else if (*p == 'b') { /* balanced string */
|
||||
p++;
|
||||
if (*p == 0 || *(p+1) == 0)
|
||||
lua_error("unbalanced pattern");
|
||||
*ep = p+2;
|
||||
return matchbalance(s, *p, *(p+1), cap);
|
||||
}
|
||||
else p--; /* and go through */
|
||||
}
|
||||
/* "luaI_singlematch" sets "ep" (so must be called even when *s == 0) */
|
||||
return (luaI_singlematch((unsigned char)*s, p, ep) && s<cap->src_end) ?
|
||||
s+1 : NULL;
|
||||
}
|
||||
|
||||
|
||||
static char *match (char *s, char *p, struct Capture *cap)
|
||||
{
|
||||
init: /* using goto's to optimize tail recursion */
|
||||
switch (*p) {
|
||||
case '(': { /* start capture */
|
||||
char *res;
|
||||
if (cap->level >= MAX_CAPT) lua_error("too many captures");
|
||||
cap->capture[cap->level].init = s;
|
||||
cap->capture[cap->level].len = -1;
|
||||
cap->level++;
|
||||
if ((res=match(s, p+1, cap)) == NULL) /* match failed? */
|
||||
cap->level--; /* undo capture */
|
||||
return res;
|
||||
}
|
||||
case ')': { /* end capture */
|
||||
int l = capture_to_close(cap);
|
||||
char *res;
|
||||
cap->capture[l].len = s - cap->capture[l].init; /* close capture */
|
||||
if ((res = match(s, p+1, cap)) == NULL) /* match failed? */
|
||||
cap->capture[l].len = -1; /* undo capture */
|
||||
return res;
|
||||
}
|
||||
case '\0': case '$': /* (possibly) end of pattern */
|
||||
if (*p == 0 || (*(p+1) == 0 && s == cap->src_end))
|
||||
return s;
|
||||
/* else go through */
|
||||
default: { /* it is a pattern item */
|
||||
char *ep; /* get what is next */
|
||||
char *s1 = matchitem(s, p, cap, &ep);
|
||||
switch (*ep) {
|
||||
case '*': { /* repetition */
|
||||
char *res;
|
||||
if (s1 && s1>s && ((res=match(s1, p, cap)) != NULL))
|
||||
return res;
|
||||
p=ep+1; goto init; /* else return match(s, ep+1, cap); */
|
||||
}
|
||||
case '?': { /* optional */
|
||||
char *res;
|
||||
if (s1 && ((res=match(s1, ep+1, cap)) != NULL))
|
||||
return res;
|
||||
p=ep+1; goto init; /* else return match(s, ep+1, cap); */
|
||||
}
|
||||
case '-': { /* repetition */
|
||||
char *res;
|
||||
if ((res = match(s, ep+1, cap)) != NULL)
|
||||
return res;
|
||||
else if (s1 && s1>s) {
|
||||
s = s1;
|
||||
goto init; /* return match(s1, p, cap); */
|
||||
}
|
||||
else
|
||||
return NULL;
|
||||
}
|
||||
default:
|
||||
if (s1) { s=s1; p=ep; goto init; } /* return match(s1, ep, cap); */
|
||||
else return NULL;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void str_find (void)
|
||||
{
|
||||
long l;
|
||||
char *s = luaL_check_lstr(1, &l);
|
||||
char *p = luaL_check_string(2);
|
||||
long init = posrelat(luaL_opt_number(3, 1), l) - 1;
|
||||
struct Capture cap;
|
||||
luaL_arg_check(0 <= init && init <= l, 3, "out of range");
|
||||
if (lua_getparam(4) != LUA_NOOBJECT ||
|
||||
strpbrk(p, SPECIALS) == NULL) { /* no special characters? */
|
||||
char *s2 = strstr(s+init, p);
|
||||
if (s2) {
|
||||
lua_pushnumber(s2-s+1);
|
||||
lua_pushnumber(s2-s+strlen(p));
|
||||
return;
|
||||
}
|
||||
}
|
||||
else {
|
||||
int anchor = (*p == '^') ? (p++, 1) : 0;
|
||||
char *s1=s+init;
|
||||
cap.src_end = s+l;
|
||||
do {
|
||||
char *res;
|
||||
cap.level = 0;
|
||||
if ((res=match(s1, p, &cap)) != NULL) {
|
||||
lua_pushnumber(s1-s+1); /* start */
|
||||
lua_pushnumber(res-s); /* end */
|
||||
push_captures(&cap);
|
||||
return;
|
||||
}
|
||||
} while (s1++<cap.src_end && !anchor);
|
||||
}
|
||||
lua_pushnil(); /* if arrives here, it didn't find */
|
||||
}
|
||||
|
||||
|
||||
static void add_s (lua_Object newp, struct Capture *cap)
|
||||
{
|
||||
if (lua_isstring(newp)) {
|
||||
char *news = lua_getstring(newp);
|
||||
int l = lua_strlen(newp);
|
||||
int i;
|
||||
for (i=0; i<l; i++) {
|
||||
if (news[i] != ESC)
|
||||
luaL_addchar(news[i]);
|
||||
else {
|
||||
i++; /* skip ESC */
|
||||
if (!isdigit((unsigned char)news[i]))
|
||||
luaL_addchar(news[i]);
|
||||
else {
|
||||
int level = check_cap(news[i], cap);
|
||||
addnchar(cap->capture[level].init, cap->capture[level].len);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
else { /* is a function */
|
||||
lua_Object res;
|
||||
int status;
|
||||
int oldbuff;
|
||||
lua_beginblock();
|
||||
push_captures(cap);
|
||||
/* function may use buffer, so save it and create a new one */
|
||||
oldbuff = luaL_newbuffer(0);
|
||||
status = lua_callfunction(newp);
|
||||
/* restore old buffer */
|
||||
luaL_oldbuffer(oldbuff);
|
||||
if (status != 0) {
|
||||
lua_endblock();
|
||||
lua_error(NULL);
|
||||
}
|
||||
res = lua_getresult(1);
|
||||
if (lua_isstring(res))
|
||||
addnchar(lua_getstring(res), lua_strlen(res));
|
||||
lua_endblock();
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void str_gsub (void)
|
||||
{
|
||||
long srcl;
|
||||
char *src = luaL_check_lstr(1, &srcl);
|
||||
char *p = luaL_check_string(2);
|
||||
lua_Object newp = lua_getparam(3);
|
||||
int max_s = (int)luaL_opt_number(4, srcl+1);
|
||||
int anchor = (*p == '^') ? (p++, 1) : 0;
|
||||
int n = 0;
|
||||
struct Capture cap;
|
||||
luaL_arg_check(lua_isstring(newp) || lua_isfunction(newp), 3,
|
||||
"string or function expected");
|
||||
luaL_resetbuffer();
|
||||
cap.src_end = src+srcl;
|
||||
while (n < max_s) {
|
||||
char *e;
|
||||
cap.level = 0;
|
||||
e = match(src, p, &cap);
|
||||
if (e) {
|
||||
n++;
|
||||
add_s(newp, &cap);
|
||||
}
|
||||
if (e && e>src) /* non empty match? */
|
||||
src = e; /* skip it */
|
||||
else if (src < cap.src_end)
|
||||
luaL_addchar(*src++);
|
||||
else break;
|
||||
if (anchor) break;
|
||||
}
|
||||
addnchar(src, cap.src_end-src);
|
||||
closeandpush();
|
||||
lua_pushnumber(n); /* number of substitutions */
|
||||
}
|
||||
|
||||
|
||||
static void luaI_addquoted (char *s)
|
||||
{
|
||||
luaL_addchar('"');
|
||||
for (; *s; s++) {
|
||||
if (strchr("\"\\\n", *s))
|
||||
luaL_addchar('\\');
|
||||
luaL_addchar(*s);
|
||||
}
|
||||
luaL_addchar('"');
|
||||
}
|
||||
|
||||
#define MAX_FORMAT 200
|
||||
|
||||
static void str_format (void)
|
||||
{
|
||||
int arg = 1;
|
||||
char *strfrmt = luaL_check_string(arg);
|
||||
struct Capture cap;
|
||||
cap.src_end = strfrmt+strlen(strfrmt)+1;
|
||||
luaL_resetbuffer();
|
||||
while (*strfrmt) {
|
||||
if (*strfrmt != '%')
|
||||
luaL_addchar(*strfrmt++);
|
||||
else if (*++strfrmt == '%')
|
||||
luaL_addchar(*strfrmt++); /* %% */
|
||||
else { /* format item */
|
||||
char form[MAX_FORMAT]; /* store the format ('%...') */
|
||||
char *buff;
|
||||
char *initf = strfrmt;
|
||||
form[0] = '%';
|
||||
cap.level = 0;
|
||||
if (isdigit((unsigned char)initf[0]) && initf[1] == '$') {
|
||||
arg = initf[0] - '0';
|
||||
initf += 2; /* skip the 'n$' */
|
||||
}
|
||||
arg++;
|
||||
strfrmt = match(initf, "[-+ #0]*(%d*)%.?(%d*)", &cap);
|
||||
if (cap.capture[0].len > 2 || cap.capture[1].len > 2) /* < 100? */
|
||||
lua_error("invalid format (width or precision too long)");
|
||||
strncpy(form+1, initf, strfrmt-initf+1); /* +1 to include conversion */
|
||||
form[strfrmt-initf+2] = 0;
|
||||
buff = luaL_openspace(1000); /* to store the formatted value */
|
||||
switch (*strfrmt++) {
|
||||
case 'q':
|
||||
luaI_addquoted(luaL_check_string(arg));
|
||||
continue;
|
||||
case 's': {
|
||||
char *s = luaL_check_string(arg);
|
||||
buff = luaL_openspace(strlen(s));
|
||||
sprintf(buff, form, s);
|
||||
break;
|
||||
}
|
||||
case 'c': case 'd': case 'i':
|
||||
sprintf(buff, form, (int)luaL_check_number(arg));
|
||||
break;
|
||||
case 'o': case 'u': case 'x': case 'X':
|
||||
sprintf(buff, form, (unsigned int)luaL_check_number(arg));
|
||||
break;
|
||||
case 'e': case 'E': case 'f': case 'g': case 'G':
|
||||
sprintf(buff, form, luaL_check_number(arg));
|
||||
break;
|
||||
default: /* also treat cases 'pnLlh' */
|
||||
lua_error("invalid option in `format'");
|
||||
}
|
||||
luaL_addsize(strlen(buff));
|
||||
}
|
||||
}
|
||||
closeandpush(); /* push the result */
|
||||
}
|
||||
|
||||
|
||||
static struct luaL_reg strlib[] = {
|
||||
{"strlen", str_len},
|
||||
{"strsub", str_sub},
|
||||
{"strlower", str_lower},
|
||||
{"strupper", str_upper},
|
||||
{"strchar", str_char},
|
||||
{"strrep", str_rep},
|
||||
{"ascii", str_byte}, /* for compatibility */
|
||||
{"strbyte", str_byte},
|
||||
{"format", str_format},
|
||||
{"strfind", str_find},
|
||||
{"gsub", str_gsub}
|
||||
};
|
||||
|
||||
|
||||
/*
|
||||
** Open string library
|
||||
*/
|
||||
void strlib_open (void)
|
||||
{
|
||||
luaL_openlib(strlib, (sizeof(strlib)/sizeof(strlib[0])));
|
||||
}
|
||||
216
ltable.c
Normal file
216
ltable.c
Normal file
@@ -0,0 +1,216 @@
|
||||
/*
|
||||
** $Id: ltable.c,v 1.11 1998/01/13 18:06:27 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;
|
||||
}
|
||||
|
||||
|
||||
static int newsize (Hash *t)
|
||||
{
|
||||
Node *v = t->node;
|
||||
int size = nhash(t);
|
||||
int realuse = 0;
|
||||
int i;
|
||||
for (i=0; i<size; i++) {
|
||||
if (ttype(ref(v+i)) != LUA_T_NIL && ttype(val(v+i)) != LUA_T_NIL)
|
||||
realuse++;
|
||||
}
|
||||
if (2*(realuse+1) <= size) /* +1 is the new element */
|
||||
return size; /* don't need to grow, just rehash */
|
||||
else
|
||||
return luaO_redimension(size);
|
||||
}
|
||||
|
||||
static void rehash (Hash *t)
|
||||
{
|
||||
int nold = nhash(t);
|
||||
Node *vold = nodevector(t);
|
||||
int nnew = newsize(t);
|
||||
int i;
|
||||
nodevector(t) = hashnodecreate(nnew);
|
||||
nhash(t) = nnew;
|
||||
for (i=0; i<nold; i++) {
|
||||
Node *n = vold+i;
|
||||
if (ttype(ref(n)) != LUA_T_NIL && ttype(val(n)) != LUA_T_NIL)
|
||||
*node(t, present(t, ref(n))) = *n; /* copy old node to luaM_new hash */
|
||||
}
|
||||
L->nblocks += gcsize(nnew)-gcsize(nold);
|
||||
luaM_free(vold);
|
||||
}
|
||||
|
||||
/*
|
||||
** If the hash node is present, return its pointer, otherwise return
|
||||
** null.
|
||||
*/
|
||||
TObject *luaH_get (Hash *t, TObject *ref)
|
||||
{
|
||||
int h = present(t, ref);
|
||||
if (ttype(ref(node(t, h))) != LUA_T_NIL) return val(node(t, h));
|
||||
else return NULL;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** If the hash node is present, return its pointer, otherwise create a luaM_new
|
||||
** node for the given reference and also return its pointer.
|
||||
*/
|
||||
TObject *luaH_set (Hash *t, TObject *ref)
|
||||
{
|
||||
Node *n = node(t, present(t, ref));
|
||||
if (ttype(ref(n)) == LUA_T_NIL) {
|
||||
nuse(t)++;
|
||||
if ((float)nuse(t) > (float)nhash(t)*REHASH_LIMIT) {
|
||||
rehash(t);
|
||||
n = node(t, present(t, ref));
|
||||
}
|
||||
*ref(n) = *ref;
|
||||
ttype(val(n)) = LUA_T_NIL;
|
||||
}
|
||||
return (val(n));
|
||||
}
|
||||
|
||||
|
||||
static Node *hashnext (Hash *t, int i)
|
||||
{
|
||||
Node *n;
|
||||
int tsize = nhash(t);
|
||||
if (i >= tsize)
|
||||
return NULL;
|
||||
n = node(t, i);
|
||||
while (ttype(ref(n)) == LUA_T_NIL || ttype(val(n)) == LUA_T_NIL) {
|
||||
if (++i >= tsize)
|
||||
return NULL;
|
||||
n = node(t, i);
|
||||
}
|
||||
return node(t, i);
|
||||
}
|
||||
|
||||
Node *luaH_next (TObject *o, TObject *r)
|
||||
{
|
||||
Hash *t = avalue(o);
|
||||
if (ttype(r) == LUA_T_NIL)
|
||||
return hashnext(t, 0);
|
||||
else {
|
||||
int i = present(t, r);
|
||||
Node *n = node(t, i);
|
||||
luaL_arg_check(ttype(ref(n))!=LUA_T_NIL && ttype(val(n))!=LUA_T_NIL,
|
||||
2, "key not found");
|
||||
return hashnext(t, i+1);
|
||||
}
|
||||
}
|
||||
24
ltable.h
Normal file
24
ltable.h
Normal 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
263
ltm.c
Normal file
@@ -0,0 +1,263 @@
|
||||
/*
|
||||
** $Id: ltm.c,v 1.15 1998/03/11 13:59:50 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 = luaL_findstring(name, list);
|
||||
if (e < 0)
|
||||
luaL_verror("`%.50s' is not a valid event name", name);
|
||||
return e;
|
||||
}
|
||||
|
||||
|
||||
|
||||
/* events in LUA_T_NIL are all allowed, since this is used as a
|
||||
* 'placeholder' for "default" fallbacks
|
||||
*/
|
||||
static char validevents[NUM_TAGS][IM_N] = { /* ORDER LUA_T, ORDER IM */
|
||||
{1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1}, /* LUA_T_USERDATA */
|
||||
{1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1}, /* LUA_T_NUMBER */
|
||||
{1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, /* LUA_T_STRING */
|
||||
{0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}, /* LUA_T_ARRAY */
|
||||
{1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0}, /* LUA_T_PROTO */
|
||||
{1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0}, /* LUA_T_CPROTO */
|
||||
{1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1} /* LUA_T_NIL */
|
||||
};
|
||||
|
||||
|
||||
static int validevent (int t, int e)
|
||||
{ /* ORDER LUA_T */
|
||||
return (t < LUA_T_NIL) ? 1 : validevents[-t][e];
|
||||
}
|
||||
|
||||
|
||||
static void init_entry (int tag)
|
||||
{
|
||||
int i;
|
||||
for (i=0; i<IM_N; i++)
|
||||
ttype(luaT_getim(tag, i)) = LUA_T_NIL;
|
||||
}
|
||||
|
||||
|
||||
void luaT_init (void)
|
||||
{
|
||||
int t;
|
||||
L->IMtable_size = NUM_TAGS*2;
|
||||
L->last_tag = -(NUM_TAGS-1);
|
||||
L->IMtable = luaM_newvector(L->IMtable_size, struct IM);
|
||||
for (t=L->last_tag; t<=0; t++)
|
||||
init_entry(t);
|
||||
}
|
||||
|
||||
|
||||
int lua_newtag (void)
|
||||
{
|
||||
--L->last_tag;
|
||||
if ((-L->last_tag) >= L->IMtable_size)
|
||||
L->IMtable_size = luaM_growvector(&L->IMtable, L->IMtable_size,
|
||||
struct IM, memEM, MAX_INT);
|
||||
init_entry(L->last_tag);
|
||||
return L->last_tag;
|
||||
}
|
||||
|
||||
|
||||
static void checktag (int tag)
|
||||
{
|
||||
if (!(L->last_tag <= tag && tag <= 0))
|
||||
luaL_verror("%d is not a valid tag", tag);
|
||||
}
|
||||
|
||||
void luaT_realtag (int tag)
|
||||
{
|
||||
if (!(L->last_tag <= tag && tag < LUA_T_NIL))
|
||||
luaL_verror("tag %d is not result of `newtag'", tag);
|
||||
}
|
||||
|
||||
|
||||
int lua_copytagmethods (int tagto, int tagfrom)
|
||||
{
|
||||
int e;
|
||||
checktag(tagto);
|
||||
checktag(tagfrom);
|
||||
for (e=0; e<IM_N; e++) {
|
||||
if (validevent(tagto, e))
|
||||
*luaT_getim(tagto, e) = *luaT_getim(tagfrom, e);
|
||||
}
|
||||
return tagto;
|
||||
}
|
||||
|
||||
|
||||
int luaT_efectivetag (TObject *o)
|
||||
{
|
||||
int t;
|
||||
switch (t = ttype(o)) {
|
||||
case LUA_T_ARRAY:
|
||||
return o->value.a->htag;
|
||||
case LUA_T_USERDATA: {
|
||||
int tag = o->value.ts->u.d.tag;
|
||||
return (tag >= 0) ? LUA_T_USERDATA : tag;
|
||||
}
|
||||
case LUA_T_CLOSURE:
|
||||
return o->value.cl->consts[0].ttype;
|
||||
#ifdef DEBUG
|
||||
case LUA_T_PMARK: case LUA_T_CMARK:
|
||||
case LUA_T_CLMARK: case LUA_T_LINE:
|
||||
LUA_INTERNALERROR("invalid type");
|
||||
#endif
|
||||
default:
|
||||
return t;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
TObject *luaT_gettagmethod (int t, char *event)
|
||||
{
|
||||
int e = luaI_checkevent(event, luaT_eventname);
|
||||
checktag(t);
|
||||
if (validevent(t, e))
|
||||
return luaT_getim(t,e);
|
||||
else
|
||||
return &luaO_nilobject;
|
||||
}
|
||||
|
||||
|
||||
void luaT_settagmethod (int t, char *event, TObject *func)
|
||||
{
|
||||
TObject temp = *func;
|
||||
int e = luaI_checkevent(event, luaT_eventname);
|
||||
checktag(t);
|
||||
if (!validevent(t, e))
|
||||
luaL_verror("settagmethod: cannot change tag method `%.20s' for tag %d",
|
||||
luaT_eventname[e], t);
|
||||
*func = *luaT_getim(t,e);
|
||||
*luaT_getim(t, e) = temp;
|
||||
}
|
||||
|
||||
|
||||
char *luaT_travtagmethods (int (*fn)(TObject *))
|
||||
{
|
||||
int e;
|
||||
if (fn(&L->errorim))
|
||||
return "error";
|
||||
for (e=IM_GETTABLE; e<=IM_FUNCTION; e++) { /* ORDER IM */
|
||||
int t;
|
||||
for (t=0; t>=L->last_tag; t--)
|
||||
if (fn(luaT_getim(t,e)))
|
||||
return luaT_eventname[e];
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* ===================================================================
|
||||
* compatibility with old fallback system
|
||||
*/
|
||||
#ifdef LUA_COMPAT2_5
|
||||
|
||||
#include "lapi.h"
|
||||
|
||||
static void errorFB (void)
|
||||
{
|
||||
lua_Object o = lua_getparam(1);
|
||||
if (lua_isstring(o))
|
||||
fprintf(stderr, "lua: %s\n", lua_getstring(o));
|
||||
else
|
||||
fprintf(stderr, "lua: unknown error\n");
|
||||
}
|
||||
|
||||
|
||||
static void nilFB (void) { }
|
||||
|
||||
|
||||
static void typeFB (void)
|
||||
{
|
||||
lua_error("unexpected type");
|
||||
}
|
||||
|
||||
|
||||
static void fillvalids (IMS e, TObject *func)
|
||||
{
|
||||
int t;
|
||||
for (t=LUA_T_NIL; t<=LUA_T_USERDATA; t++)
|
||||
if (validevent(t, e))
|
||||
*luaT_getim(t, e) = *func;
|
||||
}
|
||||
|
||||
|
||||
void luaT_setfallback (void)
|
||||
{
|
||||
static char *oldnames [] = {"error", "getglobal", "arith", "order", NULL};
|
||||
TObject oldfunc;
|
||||
lua_CFunction replace;
|
||||
char *name = luaL_check_string(1);
|
||||
lua_Object func = lua_getparam(2);
|
||||
luaL_arg_check(lua_isfunction(func), 2, "function expected");
|
||||
switch (luaL_findstring(name, oldnames)) {
|
||||
case 0: /* old error fallback */
|
||||
oldfunc = L->errorim;
|
||||
L->errorim = *luaA_Address(func);
|
||||
replace = errorFB;
|
||||
break;
|
||||
case 1: /* old getglobal fallback */
|
||||
oldfunc = *luaT_getim(LUA_T_NIL, IM_GETGLOBAL);
|
||||
*luaT_getim(LUA_T_NIL, IM_GETGLOBAL) = *luaA_Address(func);
|
||||
replace = nilFB;
|
||||
break;
|
||||
case 2: { /* old arith fallback */
|
||||
int i;
|
||||
oldfunc = *luaT_getim(LUA_T_NUMBER, IM_POW);
|
||||
for (i=IM_ADD; i<=IM_UNM; i++) /* ORDER IM */
|
||||
fillvalids(i, luaA_Address(func));
|
||||
replace = typeFB;
|
||||
break;
|
||||
}
|
||||
case 3: { /* old order fallback */
|
||||
int i;
|
||||
oldfunc = *luaT_getim(LUA_T_NIL, IM_LT);
|
||||
for (i=IM_LT; i<=IM_GE; i++) /* ORDER IM */
|
||||
fillvalids(i, luaA_Address(func));
|
||||
replace = typeFB;
|
||||
break;
|
||||
}
|
||||
default: {
|
||||
int e;
|
||||
if ((e = luaL_findstring(name, luaT_eventname)) >= 0) {
|
||||
oldfunc = *luaT_getim(LUA_T_NIL, e);
|
||||
fillvalids(e, luaA_Address(func));
|
||||
replace = (e == IM_GC || e == IM_INDEX) ? nilFB : typeFB;
|
||||
}
|
||||
else {
|
||||
luaL_verror("`%.50s' is not a valid fallback name", name);
|
||||
replace = NULL; /* to avoid warnings */
|
||||
}
|
||||
}
|
||||
}
|
||||
if (oldfunc.ttype != LUA_T_NIL)
|
||||
luaA_pushobject(&oldfunc);
|
||||
else
|
||||
lua_pushcfunction(replace);
|
||||
}
|
||||
#endif
|
||||
|
||||
62
ltm.h
Normal file
62
ltm.h
Normal 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
|
||||
234
lua.c
234
lua.c
@@ -1,92 +1,194 @@
|
||||
/*
|
||||
** lua.c
|
||||
** Linguagem para Usuarios de Aplicacao
|
||||
** $Id: lua.c,v 1.13 1998/01/19 19:49:49 roberto Exp roberto $
|
||||
** Lua stand-alone interpreter
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
char *rcs_lua="$Id: lua.c,v 1.7 1995/10/31 17:05:35 roberto Exp roberto $";
|
||||
|
||||
#include <signal.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
#include "lua.h"
|
||||
#include "luadebug.h"
|
||||
#include "lualib.h"
|
||||
|
||||
static int lua_argc;
|
||||
static char **lua_argv;
|
||||
|
||||
/*
|
||||
** although this function is POSIX, there is no standard header file that
|
||||
** defines it
|
||||
*/
|
||||
int isatty (int fd);
|
||||
#ifndef OLD_ANSI
|
||||
#include <locale.h>
|
||||
#else
|
||||
#define setlocale(a,b) 0
|
||||
#endif
|
||||
|
||||
/*
|
||||
%F Allow Lua code to access argv strings.
|
||||
%i Receive from Lua the argument number (starting with 1).
|
||||
%o Return to Lua the argument, or nil if it does not exist.
|
||||
*/
|
||||
static void lua_getargv (void)
|
||||
#ifdef _POSIX_SOURCE
|
||||
#include <unistd.h>
|
||||
#else
|
||||
#define isatty(x) (x==0) /* assume stdin is a tty */
|
||||
#endif
|
||||
|
||||
|
||||
typedef void (*handler)(int); /* type for signal actions */
|
||||
|
||||
static void laction (int i);
|
||||
|
||||
static handler lreset (void)
|
||||
{
|
||||
lua_Object lo = lua_getparam(1);
|
||||
if (!lua_isnumber(lo))
|
||||
lua_pushnil();
|
||||
else
|
||||
{
|
||||
int n = (int)lua_getnumber(lo);
|
||||
if (n < 1 || n > lua_argc) lua_pushnil();
|
||||
else lua_pushstring(lua_argv[n]);
|
||||
}
|
||||
lua_linehook = NULL;
|
||||
lua_callhook = NULL;
|
||||
return signal(SIGINT, laction);
|
||||
}
|
||||
|
||||
static void lstop (void)
|
||||
{
|
||||
lreset();
|
||||
lua_error("interrupted!");
|
||||
}
|
||||
|
||||
static void laction (int i)
|
||||
{
|
||||
lua_linehook = (lua_LHFunction)lstop;
|
||||
lua_callhook = (lua_CHFunction)lstop;
|
||||
}
|
||||
|
||||
static int ldo (int (*f)(char *), char *name)
|
||||
{
|
||||
int res;
|
||||
handler h = lreset();
|
||||
res = f(name); /* dostring | dofile */
|
||||
signal(SIGINT, h); /* restore old action */
|
||||
return res;
|
||||
}
|
||||
|
||||
|
||||
static void manual_input (void)
|
||||
static void print_message (void)
|
||||
{
|
||||
if (isatty(fileno(stdin)))
|
||||
{
|
||||
char buffer[250];
|
||||
while (fgets(buffer, sizeof(buffer), stdin) != 0)
|
||||
lua_dostring(buffer);
|
||||
fprintf(stderr,
|
||||
"Lua: command line options:\n"
|
||||
" -v print version information\n"
|
||||
" -d turn debug on\n"
|
||||
" -e stat dostring `stat'\n"
|
||||
" -q interactive mode without prompt\n"
|
||||
" -i interactive mode with prompt\n"
|
||||
" - executes stdin as a file\n"
|
||||
" a=b sets global `a' with string `b'\n"
|
||||
" name dofile `name'\n\n");
|
||||
}
|
||||
|
||||
|
||||
static void assign (char *arg)
|
||||
{
|
||||
if (strlen(arg) >= 500)
|
||||
fprintf(stderr, "lua: shell argument too long");
|
||||
else {
|
||||
char buffer[500];
|
||||
char *eq = strchr(arg, '=');
|
||||
lua_pushstring(eq+1);
|
||||
strncpy(buffer, arg, eq-arg);
|
||||
buffer[eq-arg] = 0;
|
||||
lua_setglobal(buffer);
|
||||
}
|
||||
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;
|
||||
ldo(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("argv", lua_getargv);
|
||||
|
||||
if (argc < 2)
|
||||
manual_input();
|
||||
else
|
||||
{
|
||||
for (i=1; i<argc; i++)
|
||||
if (strcmp(argv[i], "--") == 0)
|
||||
{
|
||||
lua_argc = argc-i-1;
|
||||
lua_argv = argv+i;
|
||||
break;
|
||||
}
|
||||
for (i=1; i<argc; i++)
|
||||
{
|
||||
if (strcmp(argv[i], "--") == 0)
|
||||
break;
|
||||
else 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
|
||||
result = lua_dofile (argv[i]);
|
||||
int i;
|
||||
setlocale(LC_ALL, "");
|
||||
lua_iolibopen();
|
||||
lua_strlibopen();
|
||||
lua_mathlibopen();
|
||||
lua_pushstring("> "); lua_setglobal("_PROMPT");
|
||||
if (argc < 2) { /* no arguments? */
|
||||
if (isatty(0)) {
|
||||
printf("%s %s\n", LUA_VERSION, LUA_COPYRIGHT);
|
||||
manual_input(1);
|
||||
}
|
||||
else
|
||||
ldo(lua_dofile, NULL); /* executes stdin as a file */
|
||||
}
|
||||
}
|
||||
return result;
|
||||
else for (i=1; i<argc; i++) {
|
||||
if (argv[i][0] == '-') { /* option? */
|
||||
switch (argv[i][1]) {
|
||||
case 0:
|
||||
ldo(lua_dofile, NULL); /* executes stdin as a file */
|
||||
break;
|
||||
case 'i':
|
||||
manual_input(1);
|
||||
break;
|
||||
case 'q':
|
||||
manual_input(0);
|
||||
break;
|
||||
case 'd':
|
||||
lua_debug = 1;
|
||||
break;
|
||||
case 'v':
|
||||
printf("%s %s\n(written by %s)\n\n",
|
||||
LUA_VERSION, LUA_COPYRIGHT, LUA_AUTHORS);
|
||||
break;
|
||||
case 'e':
|
||||
i++;
|
||||
if (ldo(lua_dostring, argv[i]) != 0) {
|
||||
fprintf(stderr, "lua: error running argument `%s'\n", argv[i]);
|
||||
return 1;
|
||||
}
|
||||
break;
|
||||
default:
|
||||
print_message();
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
else if (strchr(argv[i], '='))
|
||||
assign(argv[i]);
|
||||
else {
|
||||
int result = ldo(lua_dofile, argv[i]);
|
||||
if (result) {
|
||||
if (result == 2) {
|
||||
fprintf(stderr, "lua: cannot execute file ");
|
||||
perror(argv[i]);
|
||||
}
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
}
|
||||
#ifdef DEBUG
|
||||
lua_close();
|
||||
#endif
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
|
||||
207
lua.h
207
lua.h
@@ -1,109 +1,196 @@
|
||||
/*
|
||||
** LUA - Linguagem para Usuarios de Aplicacao
|
||||
** Grupo de Tecnologia em Computacao Grafica
|
||||
** TeCGraf - PUC-Rio
|
||||
** $Id: lua.h,v 3.24 1996/03/19 22:28:37 roberto Exp roberto $
|
||||
** $Id: lua.h,v 1.22 1998/06/15 21:34:14 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
|
||||
** www: http://www.tecgraf.puc-rio.br/lua/
|
||||
** See Copyright Notice at the end of this file
|
||||
*/
|
||||
|
||||
|
||||
#ifndef lua_h
|
||||
#define lua_h
|
||||
|
||||
#define LUA_VERSION "Lua 2.4 (beta)"
|
||||
#define LUA_COPYRIGHT "Copyright (C) 1994, 1995 TeCGraf"
|
||||
#define LUA_VERSION "Lua 3.1"
|
||||
#define LUA_COPYRIGHT "Copyright (C) 1994-1998 TeCGraf, PUC-Rio"
|
||||
#define LUA_AUTHORS "W. Celes, R. Ierusalimschy & L. H. de Figueiredo"
|
||||
|
||||
|
||||
/* Private Part */
|
||||
|
||||
typedef enum
|
||||
{
|
||||
LUA_T_NIL = -1,
|
||||
LUA_T_NUMBER = -2,
|
||||
LUA_T_STRING = -3,
|
||||
LUA_T_ARRAY = -4,
|
||||
LUA_T_FUNCTION = -5,
|
||||
LUA_T_CFUNCTION= -6,
|
||||
LUA_T_MARK = -7,
|
||||
LUA_T_CMARK = -8,
|
||||
LUA_T_LINE = -9,
|
||||
LUA_T_USERDATA = 0
|
||||
} lua_Type;
|
||||
|
||||
|
||||
/* Public Part */
|
||||
|
||||
#define LUA_NOOBJECT 0
|
||||
|
||||
#define LUA_ANYTAG (-1)
|
||||
|
||||
typedef void (*lua_CFunction) (void);
|
||||
typedef unsigned int lua_Object;
|
||||
|
||||
lua_Object lua_setfallback (char *name, lua_CFunction fallback);
|
||||
typedef struct lua_State lua_State;
|
||||
extern lua_State *lua_state;
|
||||
|
||||
void lua_open (void);
|
||||
void lua_close (void);
|
||||
lua_State *lua_setstate (lua_State *st);
|
||||
|
||||
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);
|
||||
int lua_dofile (char *filename);
|
||||
int lua_dostring (char *string);
|
||||
int lua_callfunction (lua_Object function);
|
||||
int lua_call (char *funcname);
|
||||
int lua_dofile (char *filename); /* Out: returns */
|
||||
int lua_dostring (char *string); /* Out: returns */
|
||||
int lua_dobuffer (char *buff, int size, char *name);
|
||||
/* Out: returns */
|
||||
int lua_callfunction (lua_Object f);
|
||||
/* In: parameters; Out: returns */
|
||||
|
||||
void lua_beginblock (void);
|
||||
void lua_endblock (void);
|
||||
|
||||
lua_Object lua_getparam (int number);
|
||||
#define lua_getresult(_) lua_getparam(_)
|
||||
lua_Object lua_lua2C (int number);
|
||||
#define lua_getparam(_) lua_lua2C(_)
|
||||
#define lua_getresult(_) lua_lua2C(_)
|
||||
|
||||
#define lua_isnil(_) (lua_type(_)==LUA_T_NIL)
|
||||
#define lua_istable(_) (lua_type(_)==LUA_T_ARRAY)
|
||||
#define lua_isuserdata(_) (lua_type(_)>=LUA_T_USERDATA)
|
||||
#define lua_iscfunction(_) (lua_type(_)==LUA_T_CFUNCTION)
|
||||
int lua_isnil (lua_Object object);
|
||||
int lua_istable (lua_Object object);
|
||||
int lua_isuserdata (lua_Object object);
|
||||
int lua_iscfunction (lua_Object object);
|
||||
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);
|
||||
long lua_strlen (lua_Object object);
|
||||
lua_CFunction lua_getcfunction (lua_Object object);
|
||||
void *lua_getuserdata (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_pushlstring (char *s, long len);
|
||||
void lua_pushstring (char *s);
|
||||
void lua_pushcfunction (lua_CFunction fn);
|
||||
void lua_pushusertag (void *u, int tag);
|
||||
void lua_pushcclosure (lua_CFunction fn, int n);
|
||||
void lua_pushusertag (void *u, int tag);
|
||||
void lua_pushobject (lua_Object object);
|
||||
|
||||
lua_Object lua_pop (void);
|
||||
|
||||
lua_Object lua_getglobal (char *name);
|
||||
void lua_storeglobal (char *name);
|
||||
lua_Object lua_rawgetglobal (char *name);
|
||||
void lua_setglobal (char *name); /* In: value */
|
||||
void lua_rawsetglobal (char *name); /* In: value */
|
||||
|
||||
void lua_storesubscript (void);
|
||||
lua_Object lua_getsubscript (void);
|
||||
void lua_settable (void); /* In: table, index, value */
|
||||
void lua_rawsettable (void); /* In: table, index, value */
|
||||
lua_Object lua_gettable (void); /* In: table, index */
|
||||
lua_Object lua_rawgettable (void); /* In: table, index */
|
||||
|
||||
int lua_type (lua_Object object);
|
||||
int lua_tag (lua_Object object);
|
||||
|
||||
int lua_lock (void);
|
||||
lua_Object lua_getlocked (int ref);
|
||||
void lua_pushlocked (int ref);
|
||||
void lua_unlock (int ref);
|
||||
|
||||
int lua_ref (int lock); /* In: value */
|
||||
lua_Object lua_getref (int ref);
|
||||
void lua_unref (int ref);
|
||||
|
||||
lua_Object lua_createtable (void);
|
||||
|
||||
|
||||
/* some useful macros */
|
||||
|
||||
#define lua_lockobject(o) (lua_pushobject(o), lua_lock())
|
||||
|
||||
#define lua_register(n,f) (lua_pushcfunction(f), lua_storeglobal(n))
|
||||
|
||||
#define lua_pushuserdata(u) lua_pushusertag(u, LUA_T_USERDATA)
|
||||
long lua_collectgarbage (long limit);
|
||||
|
||||
|
||||
/* for compatibility with old versions. Avoid using these macros */
|
||||
/* =============================================================== */
|
||||
/* some useful macros/derived functions */
|
||||
|
||||
int (lua_call) (char *name);
|
||||
#define lua_call(name) lua_callfunction(lua_getglobal(name))
|
||||
|
||||
void (lua_pushref) (int ref);
|
||||
#define lua_pushref(ref) lua_pushobject(lua_getref(ref))
|
||||
|
||||
int (lua_refobject) (lua_Object o, int l);
|
||||
#define lua_refobject(o,l) (lua_pushobject(o), lua_ref(l))
|
||||
|
||||
void (lua_register) (char *n, lua_CFunction f);
|
||||
#define lua_register(n,f) (lua_pushcfunction(f), lua_setglobal(n))
|
||||
|
||||
void (lua_pushuserdata) (void *u);
|
||||
#define lua_pushuserdata(u) lua_pushusertag(u, 0)
|
||||
|
||||
void (lua_pushcfunction) (lua_CFunction f);
|
||||
#define lua_pushcfunction(f) lua_pushcclosure(f, 0)
|
||||
|
||||
int (lua_clonetag) (int t);
|
||||
#define lua_clonetag(t) lua_copytagmethods(lua_newtag(), (t))
|
||||
|
||||
|
||||
/* ==========================================================================
|
||||
** for compatibility with old versions. Avoid using these macros/functions
|
||||
** If your program does need any of these, define LUA_COMPAT2_5
|
||||
*/
|
||||
|
||||
|
||||
#ifdef LUA_COMPAT2_5
|
||||
|
||||
|
||||
lua_Object lua_setfallback (char *event, lua_CFunction fallback);
|
||||
|
||||
#define lua_storeglobal lua_setglobal
|
||||
#define lua_type lua_tag
|
||||
|
||||
#define lua_lockobject(o) lua_refobject(o,1)
|
||||
#define lua_lock() lua_ref(1)
|
||||
#define lua_getlocked lua_getref
|
||||
#define lua_pushlocked lua_pushref
|
||||
#define lua_unlock lua_unref
|
||||
|
||||
#define lua_pushliteral(o) lua_pushstring(o)
|
||||
|
||||
#define lua_getindexed(o,n) (lua_pushobject(o), lua_pushnumber(n), lua_getsubscript())
|
||||
#define lua_getfield(o,f) (lua_pushobject(o), lua_pushliteral(f), lua_getsubscript())
|
||||
#define lua_getindexed(o,n) (lua_pushobject(o), lua_pushnumber(n), lua_gettable())
|
||||
#define lua_getfield(o,f) (lua_pushobject(o), lua_pushstring(f), lua_gettable())
|
||||
|
||||
#define lua_copystring(o) (strdup(lua_getstring(o)))
|
||||
|
||||
#define lua_getsubscript lua_gettable
|
||||
#define lua_storesubscript lua_settable
|
||||
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
|
||||
|
||||
/******************************************************************************
|
||||
* Copyright (c) 1994-1998 TeCGraf, PUC-Rio. All rights reserved.
|
||||
*
|
||||
* Permission is hereby granted, without written agreement and without license
|
||||
* or royalty fees, to use, copy, modify, and distribute this software and its
|
||||
* documentation for any purpose, including commercial applications, subject to
|
||||
* the following conditions:
|
||||
*
|
||||
* - The above copyright notice and this permission notice shall appear in all
|
||||
* copies or substantial portions of this software.
|
||||
*
|
||||
* - The origin of this software must not be misrepresented; you must not
|
||||
* claim that you wrote the original software. If you use this software in a
|
||||
* product, an acknowledgment in the product documentation would be greatly
|
||||
* appreciated (but it is not required).
|
||||
*
|
||||
* - Altered source versions must be plainly marked as such, and must not be
|
||||
* misrepresented as being the original software.
|
||||
*
|
||||
* 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 modifications. In no event shall TeCGraf, PUC-Rio, or the
|
||||
* authors be held liable to any party for direct, indirect, special,
|
||||
* incidental, or consequential damages arising out of the use of this software
|
||||
* and its documentation.
|
||||
*
|
||||
* The Lua language and this implementation have been entirely designed and
|
||||
* written by Waldemar Celes Filho, Roberto Ierusalimschy and
|
||||
* Luiz Henrique de Figueiredo at TeCGraf, PUC-Rio.
|
||||
* This implementation contains no third-party code.
|
||||
******************************************************************************/
|
||||
|
||||
788
lua.stx
788
lua.stx
@@ -1,788 +0,0 @@
|
||||
%{
|
||||
|
||||
char *rcs_luastx = "$Id: lua.stx,v 3.35 1996/03/08 12:02:37 roberto Exp roberto $";
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
|
||||
#include "luadebug.h"
|
||||
#include "mem.h"
|
||||
#include "lex.h"
|
||||
#include "opcode.h"
|
||||
#include "hash.h"
|
||||
#include "inout.h"
|
||||
#include "tree.h"
|
||||
#include "table.h"
|
||||
#include "lua.h"
|
||||
#include "func.h"
|
||||
|
||||
/* to avoid warnings generated by yacc */
|
||||
int yyparse (void);
|
||||
#define malloc luaI_malloc
|
||||
#define realloc luaI_realloc
|
||||
#define free luaI_free
|
||||
|
||||
#ifndef LISTING
|
||||
#define LISTING 0
|
||||
#endif
|
||||
|
||||
#ifndef CODE_BLOCK
|
||||
#define CODE_BLOCK 256
|
||||
#endif
|
||||
static int maxcode;
|
||||
static int maxmain;
|
||||
static int maxcurr;
|
||||
static Byte *funcCode = NULL;
|
||||
static Byte **initcode;
|
||||
static Byte *basepc;
|
||||
static int maincode;
|
||||
static int pc;
|
||||
|
||||
|
||||
#define MAXVAR 32
|
||||
static Long varbuffer[MAXVAR]; /* variables in an assignment list;
|
||||
it's long to store negative Word values */
|
||||
static int nvarbuffer=0; /* number of variables at a list */
|
||||
|
||||
#define MAXLOCALS 32
|
||||
static TaggedString *localvar[MAXLOCALS]; /* store local variable names */
|
||||
static int nlocalvar=0; /* number of local variables */
|
||||
|
||||
#define MAXFIELDS FIELDS_PER_FLUSH*2
|
||||
static Word fields[MAXFIELDS]; /* fieldnames to be flushed */
|
||||
static int nfields=0;
|
||||
|
||||
int lua_debug = 0;
|
||||
|
||||
/* Internal functions */
|
||||
|
||||
static void yyerror (char *s)
|
||||
{
|
||||
char msg[256];
|
||||
char *token = lua_lasttext();
|
||||
if (token[0] == 0)
|
||||
token = "<eof>";
|
||||
sprintf (msg,"%s; last token read: \"%s\" at line %d in file `%s'",
|
||||
s, token, lua_linenumber, lua_parsedfile);
|
||||
lua_error (msg);
|
||||
}
|
||||
|
||||
static void code_byte (Byte c)
|
||||
{
|
||||
if (pc>maxcurr-2) /* 1 byte free to code HALT of main code */
|
||||
maxcurr = growvector(&basepc, maxcurr, Byte, codeEM, MAX_INT);
|
||||
basepc[pc++] = c;
|
||||
}
|
||||
|
||||
static void code_word (Word n)
|
||||
{
|
||||
CodeWord code;
|
||||
code.w = n;
|
||||
code_byte(code.m.c1);
|
||||
code_byte(code.m.c2);
|
||||
}
|
||||
|
||||
static void code_float (float n)
|
||||
{
|
||||
CodeFloat code;
|
||||
code.f = n;
|
||||
code_byte(code.m.c1);
|
||||
code_byte(code.m.c2);
|
||||
code_byte(code.m.c3);
|
||||
code_byte(code.m.c4);
|
||||
}
|
||||
|
||||
static void code_code (TFunc *tf)
|
||||
{
|
||||
CodeCode code;
|
||||
code.tf = tf;
|
||||
code_byte(code.m.c1);
|
||||
code_byte(code.m.c2);
|
||||
code_byte(code.m.c3);
|
||||
code_byte(code.m.c4);
|
||||
}
|
||||
|
||||
static void code_word_at (Byte *p, int n)
|
||||
{
|
||||
CodeWord code;
|
||||
if ((Word)n != n)
|
||||
yyerror("block too big");
|
||||
code.w = (Word)n;
|
||||
*p++ = code.m.c1;
|
||||
*p++ = code.m.c2;
|
||||
}
|
||||
|
||||
static void push_field (Word name)
|
||||
{
|
||||
if (nfields < MAXFIELDS)
|
||||
fields[nfields++] = name;
|
||||
else
|
||||
yyerror ("too many fields in nested constructors");
|
||||
}
|
||||
|
||||
static void flush_record (int n)
|
||||
{
|
||||
int i;
|
||||
if (n == 0) return;
|
||||
code_byte(STORERECORD);
|
||||
code_byte(n);
|
||||
for (i=0; i<n; i++)
|
||||
code_word(fields[--nfields]);
|
||||
}
|
||||
|
||||
static void flush_list (int m, int n)
|
||||
{
|
||||
if (n == 0) return;
|
||||
if (m == 0)
|
||||
code_byte(STORELIST0);
|
||||
else
|
||||
if (m < 255)
|
||||
{
|
||||
code_byte(STORELIST);
|
||||
code_byte(m);
|
||||
}
|
||||
else
|
||||
yyerror ("list constructor too long");
|
||||
code_byte(n);
|
||||
}
|
||||
|
||||
static void store_localvar (TaggedString *name, int n)
|
||||
{
|
||||
if (nlocalvar+n < MAXLOCALS)
|
||||
localvar[nlocalvar+n] = name;
|
||||
else
|
||||
yyerror ("too many local variables");
|
||||
if (lua_debug)
|
||||
luaI_registerlocalvar(name, lua_linenumber);
|
||||
}
|
||||
|
||||
static void add_localvar (TaggedString *name)
|
||||
{
|
||||
store_localvar(name, 0);
|
||||
nlocalvar++;
|
||||
}
|
||||
|
||||
static void add_varbuffer (Long var)
|
||||
{
|
||||
if (nvarbuffer < MAXVAR)
|
||||
varbuffer[nvarbuffer++] = var;
|
||||
else
|
||||
yyerror ("variable buffer overflow");
|
||||
}
|
||||
|
||||
static void code_number (float f)
|
||||
{
|
||||
Word i = (Word)f;
|
||||
if (f == (float)i) /* f has an (short) integer value */
|
||||
{
|
||||
if (i <= 2) code_byte(PUSH0 + i);
|
||||
else if (i <= 255)
|
||||
{
|
||||
code_byte(PUSHBYTE);
|
||||
code_byte(i);
|
||||
}
|
||||
else
|
||||
{
|
||||
code_byte(PUSHWORD);
|
||||
code_word(i);
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
code_byte(PUSHFLOAT);
|
||||
code_float(f);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
** Search a local name and if find return its index. If do not find return -1
|
||||
*/
|
||||
static int lua_localname (TaggedString *n)
|
||||
{
|
||||
int i;
|
||||
for (i=nlocalvar-1; i >= 0; i--)
|
||||
if (n == localvar[i]) return i; /* local var */
|
||||
return -1; /* global var */
|
||||
}
|
||||
|
||||
/*
|
||||
** Push a variable given a number. If number is positive, push global variable
|
||||
** indexed by (number -1). If negative, push local indexed by ABS(number)-1.
|
||||
** Otherwise, if zero, push indexed variable (record).
|
||||
*/
|
||||
static void lua_pushvar (Long number)
|
||||
{
|
||||
if (number > 0) /* global var */
|
||||
{
|
||||
code_byte(PUSHGLOBAL);
|
||||
code_word(number-1);
|
||||
}
|
||||
else if (number < 0) /* local var */
|
||||
{
|
||||
number = (-number) - 1;
|
||||
if (number < 10) code_byte(PUSHLOCAL0 + number);
|
||||
else
|
||||
{
|
||||
code_byte(PUSHLOCAL);
|
||||
code_byte(number);
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
code_byte(PUSHINDEXED);
|
||||
}
|
||||
}
|
||||
|
||||
static void lua_codeadjust (int n)
|
||||
{
|
||||
if (n+nlocalvar == 0)
|
||||
code_byte(ADJUST0);
|
||||
else
|
||||
{
|
||||
code_byte(ADJUST);
|
||||
code_byte(n+nlocalvar);
|
||||
}
|
||||
}
|
||||
|
||||
static void change2main (void)
|
||||
{
|
||||
/* (re)store main values */
|
||||
pc=maincode; basepc=*initcode; maxcurr=maxmain;
|
||||
nlocalvar=0;
|
||||
}
|
||||
|
||||
static void savemain (void)
|
||||
{
|
||||
/* save main values */
|
||||
maincode=pc; *initcode=basepc; maxmain=maxcurr;
|
||||
}
|
||||
|
||||
static void init_func (void)
|
||||
{
|
||||
if (funcCode == NULL) /* first function */
|
||||
{
|
||||
funcCode = newvector(CODE_BLOCK, Byte);
|
||||
maxcode = CODE_BLOCK;
|
||||
}
|
||||
savemain(); /* save main values */
|
||||
/* set func values */
|
||||
pc=0; basepc=funcCode; maxcurr=maxcode;
|
||||
nlocalvar = 0;
|
||||
luaI_codedebugline(lua_linenumber);
|
||||
}
|
||||
|
||||
static void codereturn (void)
|
||||
{
|
||||
if (nlocalvar == 0)
|
||||
code_byte(RETCODE0);
|
||||
else
|
||||
{
|
||||
code_byte(RETCODE);
|
||||
code_byte(nlocalvar);
|
||||
}
|
||||
}
|
||||
|
||||
void luaI_codedebugline (int line)
|
||||
{
|
||||
static int lastline = 0;
|
||||
if (lua_debug && line != lastline)
|
||||
{
|
||||
code_byte(SETLINE);
|
||||
code_word(line);
|
||||
lastline = line;
|
||||
}
|
||||
}
|
||||
|
||||
static int adjust_functioncall (Long exp, int i)
|
||||
{
|
||||
if (exp <= 0)
|
||||
return -exp; /* exp is -list length */
|
||||
else
|
||||
{
|
||||
int temp = basepc[exp];
|
||||
basepc[exp] = i;
|
||||
return temp+i;
|
||||
}
|
||||
}
|
||||
|
||||
static void adjust_mult_assign (int vars, Long exps, int temps)
|
||||
{
|
||||
if (exps > 0)
|
||||
{ /* must correct function call */
|
||||
int diff = vars - basepc[exps];
|
||||
if (diff >= 0)
|
||||
adjust_functioncall(exps, diff);
|
||||
else
|
||||
{
|
||||
adjust_functioncall(exps, 0);
|
||||
lua_codeadjust(temps);
|
||||
}
|
||||
}
|
||||
else if (vars != -exps)
|
||||
lua_codeadjust(temps);
|
||||
}
|
||||
|
||||
static void storesinglevar (Long v)
|
||||
{
|
||||
if (v > 0) /* global var */
|
||||
{
|
||||
code_byte(STOREGLOBAL);
|
||||
code_word(v-1);
|
||||
}
|
||||
else if (v < 0) /* local var */
|
||||
{
|
||||
int number = (-v) - 1;
|
||||
if (number < 10) code_byte(STORELOCAL0 + number);
|
||||
else
|
||||
{
|
||||
code_byte(STORELOCAL);
|
||||
code_byte(number);
|
||||
}
|
||||
}
|
||||
else
|
||||
code_byte(STOREINDEXED0);
|
||||
}
|
||||
|
||||
static void lua_codestore (int i)
|
||||
{
|
||||
if (varbuffer[i] != 0) /* global or local var */
|
||||
storesinglevar(varbuffer[i]);
|
||||
else /* indexed var */
|
||||
{
|
||||
int j;
|
||||
int upper=0; /* number of indexed variables upper */
|
||||
int param; /* number of itens until indexed expression */
|
||||
for (j=i+1; j <nvarbuffer; j++)
|
||||
if (varbuffer[j] == 0) upper++;
|
||||
param = upper*2 + i;
|
||||
if (param == 0)
|
||||
code_byte(STOREINDEXED0);
|
||||
else
|
||||
{
|
||||
code_byte(STOREINDEXED);
|
||||
code_byte(param);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
static void codeIf (Long thenAdd, Long elseAdd)
|
||||
{
|
||||
Long elseinit = elseAdd+sizeof(Word)+1;
|
||||
if (pc == elseinit) /* no else */
|
||||
{
|
||||
pc -= sizeof(Word)+1;
|
||||
elseinit = pc;
|
||||
}
|
||||
else
|
||||
{
|
||||
basepc[elseAdd] = JMP;
|
||||
code_word_at(basepc+elseAdd+1, pc-elseinit);
|
||||
}
|
||||
basepc[thenAdd] = IFFJMP;
|
||||
code_word_at(basepc+thenAdd+1,elseinit-(thenAdd+sizeof(Word)+1));
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Parse LUA code.
|
||||
*/
|
||||
void lua_parse (TFunc *tf)
|
||||
{
|
||||
initcode = &(tf->code);
|
||||
*initcode = newvector(CODE_BLOCK, Byte);
|
||||
maincode = 0;
|
||||
maxmain = CODE_BLOCK;
|
||||
change2main();
|
||||
if (yyparse ()) lua_error("parse error");
|
||||
savemain();
|
||||
(*initcode)[maincode++] = RETCODE0;
|
||||
tf->size = maincode;
|
||||
#if LISTING
|
||||
{ static void PrintCode (Byte *c, Byte *end);
|
||||
PrintCode(*initcode,*initcode+maincode); }
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
%}
|
||||
|
||||
|
||||
%union
|
||||
{
|
||||
int vInt;
|
||||
float vFloat;
|
||||
char *pChar;
|
||||
Word vWord;
|
||||
Long vLong;
|
||||
TFunc *pFunc;
|
||||
TaggedString *pTStr;
|
||||
}
|
||||
|
||||
%start functionlist
|
||||
|
||||
%token WRONGTOKEN
|
||||
%token NIL
|
||||
%token IF THEN ELSE ELSEIF WHILE DO REPEAT UNTIL END
|
||||
%token RETURN
|
||||
%token LOCAL
|
||||
%token FUNCTION
|
||||
%token <vFloat> NUMBER
|
||||
%token <vWord> STRING
|
||||
%token <pTStr> NAME
|
||||
%token <vInt> DEBUG
|
||||
|
||||
%type <vLong> PrepJump
|
||||
%type <vLong> exprlist, exprlist1 /* if > 0, points to function return
|
||||
counter (which has list length); if <= 0, -list lenght */
|
||||
%type <vLong> functioncall, expr /* if != 0, points to function return
|
||||
counter */
|
||||
%type <vInt> varlist1, funcParams, funcvalue
|
||||
%type <vInt> fieldlist, localdeclist, decinit
|
||||
%type <vInt> ffieldlist, ffieldlist1, semicolonpart
|
||||
%type <vInt> lfieldlist, lfieldlist1
|
||||
%type <vInt> parlist
|
||||
%type <vLong> var, singlevar, funcname
|
||||
%type <pFunc> body
|
||||
|
||||
%left AND OR
|
||||
%left EQ NE '>' '<' LE GE
|
||||
%left CONC
|
||||
%left '+' '-'
|
||||
%left '*' '/'
|
||||
%left UNARY NOT
|
||||
%right '^'
|
||||
|
||||
|
||||
%% /* beginning of rules section */
|
||||
|
||||
|
||||
functionlist : /* empty */
|
||||
| functionlist globalstat
|
||||
| functionlist function
|
||||
;
|
||||
|
||||
globalstat : stat sc
|
||||
| setdebug
|
||||
;
|
||||
|
||||
function : FUNCTION funcname body
|
||||
{
|
||||
code_byte(PUSHFUNCTION);
|
||||
code_code($3);
|
||||
storesinglevar($2);
|
||||
}
|
||||
;
|
||||
|
||||
funcname : var { $$ =$1; init_func(); }
|
||||
| varexp ':' NAME
|
||||
{
|
||||
code_byte(PUSHSTRING);
|
||||
code_word(luaI_findconstant($3));
|
||||
$$ = 0; /* indexed variable */
|
||||
init_func();
|
||||
add_localvar(luaI_createfixedstring("self"));
|
||||
}
|
||||
;
|
||||
|
||||
body : '(' parlist ')' block END
|
||||
{
|
||||
codereturn();
|
||||
$$ = new(TFunc);
|
||||
luaI_initTFunc($$);
|
||||
$$->size = pc;
|
||||
$$->code = newvector(pc, Byte);
|
||||
$$->fileName = lua_parsedfile;
|
||||
$$->lineDefined = $2;
|
||||
memcpy($$->code, basepc, pc*sizeof(Byte));
|
||||
if (lua_debug)
|
||||
luaI_closelocalvars($$);
|
||||
/* save func values */
|
||||
funcCode = basepc; maxcode=maxcurr;
|
||||
#if LISTING
|
||||
PrintCode(funcCode,funcCode+pc);
|
||||
#endif
|
||||
change2main(); /* change back to main code */
|
||||
}
|
||||
;
|
||||
|
||||
statlist : /* empty */
|
||||
| statlist stat sc
|
||||
;
|
||||
|
||||
sc : /* empty */ | ';' ;
|
||||
|
||||
stat : IF expr1 THEN PrepJump block PrepJump elsepart END
|
||||
{ codeIf($4, $6); }
|
||||
|
||||
| WHILE {$<vLong>$=pc;} expr1 DO PrepJump block PrepJump END
|
||||
{
|
||||
basepc[$5] = IFFJMP;
|
||||
code_word_at(basepc+$5+1, pc - ($5 + sizeof(Word)+1));
|
||||
basepc[$7] = UPJMP;
|
||||
code_word_at(basepc+$7+1, pc - ($<vLong>2));
|
||||
}
|
||||
|
||||
| REPEAT {$<vLong>$=pc;} block UNTIL expr1 PrepJump
|
||||
{
|
||||
basepc[$6] = IFFUPJMP;
|
||||
code_word_at(basepc+$6+1, pc - ($<vLong>2));
|
||||
}
|
||||
|
||||
| varlist1 '=' exprlist1
|
||||
{
|
||||
{
|
||||
int i;
|
||||
adjust_mult_assign(nvarbuffer, $3, $1 * 2 + nvarbuffer);
|
||||
for (i=nvarbuffer-1; i>=0; i--)
|
||||
lua_codestore (i);
|
||||
if ($1 > 1 || ($1 == 1 && varbuffer[0] != 0))
|
||||
lua_codeadjust (0);
|
||||
}
|
||||
}
|
||||
| functioncall
|
||||
| LOCAL localdeclist decinit
|
||||
{ nlocalvar += $2;
|
||||
adjust_mult_assign($2, $3, 0);
|
||||
}
|
||||
;
|
||||
|
||||
elsepart : /* empty */
|
||||
| ELSE block
|
||||
| ELSEIF expr1 THEN PrepJump block PrepJump elsepart
|
||||
{ codeIf($4, $6); }
|
||||
;
|
||||
|
||||
block : {$<vInt>$ = nlocalvar;} statlist ret
|
||||
{
|
||||
if (nlocalvar != $<vInt>1)
|
||||
{
|
||||
if (lua_debug)
|
||||
for (; nlocalvar > $<vInt>1; nlocalvar--)
|
||||
luaI_unregisterlocalvar(lua_linenumber);
|
||||
else
|
||||
nlocalvar = $<vInt>1;
|
||||
lua_codeadjust (0);
|
||||
}
|
||||
}
|
||||
;
|
||||
|
||||
ret : /* empty */
|
||||
| RETURN exprlist sc
|
||||
{
|
||||
adjust_functioncall($2, MULT_RET);
|
||||
codereturn();
|
||||
}
|
||||
;
|
||||
|
||||
PrepJump : /* empty */
|
||||
{
|
||||
$$ = pc;
|
||||
code_byte(0); /* open space */
|
||||
code_word (0);
|
||||
}
|
||||
|
||||
expr1 : expr { adjust_functioncall($1, 1); }
|
||||
;
|
||||
|
||||
expr : '(' expr ')' { $$ = $2; }
|
||||
| expr1 EQ expr1 { code_byte(EQOP); $$ = 0; }
|
||||
| expr1 '<' expr1 { code_byte(LTOP); $$ = 0; }
|
||||
| expr1 '>' expr1 { code_byte(GTOP); $$ = 0; }
|
||||
| expr1 NE expr1 { code_byte(EQOP); code_byte(NOTOP); $$ = 0; }
|
||||
| expr1 LE expr1 { code_byte(LEOP); $$ = 0; }
|
||||
| expr1 GE expr1 { code_byte(GEOP); $$ = 0; }
|
||||
| expr1 '+' expr1 { code_byte(ADDOP); $$ = 0; }
|
||||
| expr1 '-' expr1 { code_byte(SUBOP); $$ = 0; }
|
||||
| expr1 '*' expr1 { code_byte(MULTOP); $$ = 0; }
|
||||
| expr1 '/' expr1 { code_byte(DIVOP); $$ = 0; }
|
||||
| expr1 '^' expr1 { code_byte(POWOP); $$ = 0; }
|
||||
| expr1 CONC expr1 { code_byte(CONCOP); $$ = 0; }
|
||||
| '-' expr1 %prec UNARY { code_byte(MINUSOP); $$ = 0;}
|
||||
| table { $$ = 0; }
|
||||
| varexp { $$ = 0;}
|
||||
| NUMBER { code_number($1); $$ = 0; }
|
||||
| STRING
|
||||
{
|
||||
code_byte(PUSHSTRING);
|
||||
code_word($1);
|
||||
$$ = 0;
|
||||
}
|
||||
| NIL {code_byte(PUSHNIL); $$ = 0; }
|
||||
| functioncall { $$ = $1; }
|
||||
| NOT expr1 { code_byte(NOTOP); $$ = 0;}
|
||||
| expr1 AND PrepJump {code_byte(POP); } expr1
|
||||
{
|
||||
basepc[$3] = ONFJMP;
|
||||
code_word_at(basepc+$3+1, pc - ($3 + sizeof(Word)+1));
|
||||
$$ = 0;
|
||||
}
|
||||
| expr1 OR PrepJump {code_byte(POP); } expr1
|
||||
{
|
||||
basepc[$3] = ONTJMP;
|
||||
code_word_at(basepc+$3+1, pc - ($3 + sizeof(Word)+1));
|
||||
$$ = 0;
|
||||
}
|
||||
;
|
||||
|
||||
table :
|
||||
{
|
||||
code_byte(CREATEARRAY);
|
||||
$<vLong>$ = pc; code_word(0);
|
||||
}
|
||||
'{' fieldlist '}'
|
||||
{
|
||||
code_word_at(basepc+$<vLong>1, $3);
|
||||
}
|
||||
;
|
||||
|
||||
functioncall : funcvalue funcParams
|
||||
{
|
||||
code_byte(CALLFUNC);
|
||||
code_byte($1+$2);
|
||||
$$ = pc;
|
||||
code_byte(0); /* may be modified by other rules */
|
||||
}
|
||||
;
|
||||
|
||||
funcvalue : varexp { $$ = 0; }
|
||||
| varexp ':' NAME
|
||||
{
|
||||
code_byte(PUSHSELF);
|
||||
code_word(luaI_findconstant($3));
|
||||
$$ = 1;
|
||||
}
|
||||
;
|
||||
|
||||
funcParams : '(' exprlist ')'
|
||||
{ $$ = adjust_functioncall($2, 1); }
|
||||
| table { $$ = 1; }
|
||||
;
|
||||
|
||||
exprlist : /* empty */ { $$ = 0; }
|
||||
| exprlist1 { $$ = $1; }
|
||||
;
|
||||
|
||||
exprlist1 : expr { if ($1 != 0) $$ = $1; else $$ = -1; }
|
||||
| exprlist1 ',' { $<vLong>$ = adjust_functioncall($1, 1); } expr
|
||||
{
|
||||
if ($4 == 0) $$ = -($<vLong>3 + 1); /* -length */
|
||||
else
|
||||
{
|
||||
adjust_functioncall($4, $<vLong>3);
|
||||
$$ = $4;
|
||||
}
|
||||
}
|
||||
;
|
||||
|
||||
parlist : /* empty */ { lua_codeadjust(0); $$ = lua_linenumber; }
|
||||
| parlist1 { lua_codeadjust(0); $$ = lua_linenumber; }
|
||||
;
|
||||
|
||||
parlist1 : NAME { add_localvar($1); }
|
||||
| parlist1 ',' NAME { add_localvar($3); }
|
||||
;
|
||||
|
||||
fieldlist : lfieldlist
|
||||
{ flush_list($1/FIELDS_PER_FLUSH, $1%FIELDS_PER_FLUSH); }
|
||||
semicolonpart
|
||||
{ $$ = $1+$3; }
|
||||
| ffieldlist1 lastcomma
|
||||
{ $$ = $1; flush_record($1%FIELDS_PER_FLUSH); }
|
||||
;
|
||||
|
||||
semicolonpart : /* empty */
|
||||
{ $$ = 0; }
|
||||
| ';' ffieldlist
|
||||
{ $$ = $2; flush_record($2%FIELDS_PER_FLUSH); }
|
||||
;
|
||||
|
||||
lastcomma : /* empty */
|
||||
| ','
|
||||
;
|
||||
|
||||
ffieldlist : /* empty */ { $$ = 0; }
|
||||
| ffieldlist1 lastcomma { $$ = $1; }
|
||||
;
|
||||
|
||||
ffieldlist1 : ffield {$$=1;}
|
||||
| ffieldlist1 ',' ffield
|
||||
{
|
||||
$$=$1+1;
|
||||
if ($$%FIELDS_PER_FLUSH == 0) flush_record(FIELDS_PER_FLUSH);
|
||||
}
|
||||
;
|
||||
|
||||
ffield : NAME '=' expr1
|
||||
{
|
||||
push_field(luaI_findconstant($1));
|
||||
}
|
||||
;
|
||||
|
||||
lfieldlist : /* empty */ { $$ = 0; }
|
||||
| lfieldlist1 lastcomma { $$ = $1; }
|
||||
;
|
||||
|
||||
lfieldlist1 : expr1 {$$=1;}
|
||||
| lfieldlist1 ',' expr1
|
||||
{
|
||||
$$=$1+1;
|
||||
if ($$%FIELDS_PER_FLUSH == 0)
|
||||
flush_list($$/FIELDS_PER_FLUSH - 1, FIELDS_PER_FLUSH);
|
||||
}
|
||||
;
|
||||
|
||||
varlist1 : var
|
||||
{
|
||||
nvarbuffer = 0;
|
||||
add_varbuffer($1);
|
||||
$$ = ($1 == 0) ? 1 : 0;
|
||||
}
|
||||
| varlist1 ',' var
|
||||
{
|
||||
add_varbuffer($3);
|
||||
$$ = ($3 == 0) ? $1 + 1 : $1;
|
||||
}
|
||||
;
|
||||
|
||||
var : singlevar { $$ = $1; }
|
||||
| varexp '[' expr1 ']'
|
||||
{
|
||||
$$ = 0; /* indexed variable */
|
||||
}
|
||||
| varexp '.' NAME
|
||||
{
|
||||
code_byte(PUSHSTRING);
|
||||
code_word(luaI_findconstant($3));
|
||||
$$ = 0; /* indexed variable */
|
||||
}
|
||||
;
|
||||
|
||||
singlevar : NAME
|
||||
{
|
||||
int local = lua_localname($1);
|
||||
if (local == -1) /* global var */
|
||||
$$ = luaI_findsymbol($1)+1; /* return positive value */
|
||||
else
|
||||
$$ = -(local+1); /* return negative value */
|
||||
}
|
||||
;
|
||||
|
||||
varexp : var { lua_pushvar($1); }
|
||||
;
|
||||
|
||||
localdeclist : NAME {store_localvar($1, 0); $$ = 1;}
|
||||
| localdeclist ',' NAME
|
||||
{
|
||||
store_localvar($3, $1);
|
||||
$$ = $1+1;
|
||||
}
|
||||
;
|
||||
|
||||
decinit : /* empty */ { $$ = 0; }
|
||||
| '=' exprlist1 { $$ = $2; }
|
||||
;
|
||||
|
||||
setdebug : DEBUG { lua_debug = $1; }
|
||||
;
|
||||
|
||||
%%
|
||||
10
luadebug.h
10
luadebug.h
@@ -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: luadebug.h,v 1.1 1997/09/16 19:25:59 roberto Exp roberto $
|
||||
** Debugging 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
|
||||
|
||||
36
lualib.h
36
lualib.h
@@ -1,24 +1,34 @@
|
||||
/*
|
||||
** Libraries to be used in LUA programs
|
||||
** Grupo de Tecnologia em Computacao Grafica
|
||||
** TeCGraf - PUC-Rio
|
||||
** $Id: lualib.h,v 1.6 1996/02/09 19:00:23 roberto Exp roberto $
|
||||
** $Id: lualib.h,v 1.3 1997/12/17 20:48:58 roberto Exp roberto $
|
||||
** Lua standard libraries
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
#ifndef lualib_h
|
||||
#define lualib_h
|
||||
|
||||
void iolib_open (void);
|
||||
void strlib_open (void);
|
||||
void mathlib_open (void);
|
||||
#include "lua.h"
|
||||
|
||||
|
||||
/* auxiliar functions (private) */
|
||||
void lua_arg_error(char *funcname);
|
||||
char *lua_check_string (int numArg, char *funcname);
|
||||
double lua_check_number (int numArg, char *funcname);
|
||||
char *luaI_addchar (int c);
|
||||
void luaI_addquoted (char *s);
|
||||
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
|
||||
|
||||
|
||||
|
||||
/* Auxiliary functions (private) */
|
||||
|
||||
int luaI_singlematch (int c, char *p, char **ep);
|
||||
|
||||
#endif
|
||||
|
||||
|
||||
70
luamem.c
70
luamem.c
@@ -1,70 +0,0 @@
|
||||
/*
|
||||
** mem.c
|
||||
** TecCGraf - PUC-Rio
|
||||
*/
|
||||
|
||||
char *rcs_mem = "$Id: mem.c,v 1.10 1996/03/21 16:31:32 roberto Exp roberto $";
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <stdio.h>
|
||||
|
||||
#include "mem.h"
|
||||
#include "lua.h"
|
||||
#include "table.h"
|
||||
|
||||
|
||||
#define mem_error() lua_error(memEM)
|
||||
|
||||
|
||||
void luaI_free (void *block)
|
||||
{
|
||||
if (block)
|
||||
{
|
||||
*((int *)block) = -1; /* to catch errors */
|
||||
free(block);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
void *luaI_malloc (unsigned long size)
|
||||
{
|
||||
void *block = malloc((size_t)size);
|
||||
if (block == NULL)
|
||||
mem_error();
|
||||
return block;
|
||||
}
|
||||
|
||||
|
||||
void *luaI_realloc (void *oldblock, unsigned long size)
|
||||
{
|
||||
void *block = oldblock ? realloc(oldblock, (size_t)size) :
|
||||
malloc((size_t)size);
|
||||
if (block == NULL)
|
||||
mem_error();
|
||||
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;
|
||||
}
|
||||
|
||||
39
luamem.h
39
luamem.h
@@ -1,39 +0,0 @@
|
||||
/*
|
||||
** mem.c
|
||||
** memory manager for lua
|
||||
** $Id: mem.h,v 1.5 1996/03/21 16:31:32 roberto Exp roberto $
|
||||
*/
|
||||
|
||||
#ifndef mem_h
|
||||
#define mem_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 lockEM "lock table overflow"
|
||||
#define tableEM "table overflow"
|
||||
#define memEM "not enough memory"
|
||||
|
||||
|
||||
void luaI_free (void *block);
|
||||
void *luaI_malloc (unsigned long size);
|
||||
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 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
|
||||
|
||||
226
lundump.c
Normal file
226
lundump.c
Normal file
@@ -0,0 +1,226 @@
|
||||
/*
|
||||
** $Id: lundump.c,v 1.10 1998/06/25 15:50:09 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"
|
||||
|
||||
#define LoadBlock(b,size,Z) ezread(Z,b,size)
|
||||
#define LoadNative(t,Z) LoadBlock(&t,sizeof(t),Z)
|
||||
|
||||
#if ID_NUMBER==ID_NATIVE
|
||||
#define doLoadNumber(f,Z) LoadNative(f,Z)
|
||||
#else
|
||||
#define doLoadNumber(f,Z) f=LoadNumber(Z)
|
||||
#endif
|
||||
|
||||
static void unexpectedEOZ(ZIO* Z)
|
||||
{
|
||||
luaL_verror("unexpected end of file in %s",zname(Z));
|
||||
}
|
||||
|
||||
static int ezgetc(ZIO* Z)
|
||||
{
|
||||
int c=zgetc(Z);
|
||||
if (c==EOZ) unexpectedEOZ(Z);
|
||||
return c;
|
||||
}
|
||||
|
||||
static void ezread(ZIO* Z, void* b, int n)
|
||||
{
|
||||
int r=zread(Z,b,n);
|
||||
if (r!=0) unexpectedEOZ(Z);
|
||||
}
|
||||
|
||||
static unsigned int LoadWord(ZIO* Z)
|
||||
{
|
||||
unsigned int hi=ezgetc(Z);
|
||||
unsigned int lo=ezgetc(Z);
|
||||
return (hi<<8)|lo;
|
||||
}
|
||||
|
||||
static unsigned long LoadLong(ZIO* Z)
|
||||
{
|
||||
unsigned long hi=LoadWord(Z);
|
||||
unsigned long lo=LoadWord(Z);
|
||||
return (hi<<16)|lo;
|
||||
}
|
||||
|
||||
#if ID_NUMBER==ID_REAL4
|
||||
/* LUA_NUMBER */
|
||||
/* assumes sizeof(long)==4 and sizeof(float)==4 (IEEE) */
|
||||
static float LoadFloat(ZIO* Z)
|
||||
{
|
||||
unsigned long l=LoadLong(Z);
|
||||
float f=*(float*)&l;
|
||||
return f;
|
||||
}
|
||||
#endif
|
||||
|
||||
#if ID_NUMBER==ID_REAL8
|
||||
/* LUA_NUMBER */
|
||||
/* assumes sizeof(long)==4 and sizeof(double)==8 (IEEE) */
|
||||
static double LoadDouble(ZIO* Z)
|
||||
{
|
||||
unsigned long l[2];
|
||||
double f;
|
||||
int x=1;
|
||||
if (*(char*)&x==1) /* little-endian */
|
||||
{
|
||||
l[1]=LoadLong(Z);
|
||||
l[0]=LoadLong(Z);
|
||||
}
|
||||
else /* big-endian */
|
||||
{
|
||||
l[0]=LoadLong(Z);
|
||||
l[1]=LoadLong(Z);
|
||||
}
|
||||
f=*(double*)l;
|
||||
return f;
|
||||
}
|
||||
#endif
|
||||
|
||||
static Byte* LoadCode(ZIO* Z)
|
||||
{
|
||||
unsigned long size=LoadLong(Z);
|
||||
unsigned int s=size;
|
||||
void* b;
|
||||
if (s!=size) luaL_verror("code too long (%ld bytes) in %s",size,zname(Z));
|
||||
b=luaM_malloc(size);
|
||||
LoadBlock(b,size,Z);
|
||||
return b;
|
||||
}
|
||||
|
||||
static TaggedString* LoadTString(ZIO* Z)
|
||||
{
|
||||
int size=LoadWord(Z);
|
||||
if (size==0)
|
||||
return NULL;
|
||||
else
|
||||
{
|
||||
char* s=luaL_openspace(size);
|
||||
LoadBlock(s,size,Z);
|
||||
return luaS_newlstr(s,size-1);
|
||||
}
|
||||
}
|
||||
|
||||
static void LoadLocals(TProtoFunc* tf, ZIO* Z)
|
||||
{
|
||||
int i,n=LoadWord(Z);
|
||||
if (n==0) return;
|
||||
tf->locvars=luaM_newvector(n+1,LocVar);
|
||||
for (i=0; i<n; i++)
|
||||
{
|
||||
tf->locvars[i].line=LoadWord(Z);
|
||||
tf->locvars[i].varname=LoadTString(Z);
|
||||
}
|
||||
tf->locvars[i].line=-1; /* flag end of vector */
|
||||
tf->locvars[i].varname=NULL;
|
||||
}
|
||||
|
||||
static TProtoFunc* LoadFunction(ZIO* Z);
|
||||
|
||||
static void LoadConstants(TProtoFunc* tf, ZIO* Z)
|
||||
{
|
||||
int i,n=LoadWord(Z);
|
||||
tf->nconsts=n;
|
||||
if (n==0) return;
|
||||
tf->consts=luaM_newvector(n,TObject);
|
||||
for (i=0; i<n; i++)
|
||||
{
|
||||
TObject* o=tf->consts+i;
|
||||
int c=ezgetc(Z);
|
||||
switch (c)
|
||||
{
|
||||
case ID_NUM:
|
||||
ttype(o)=LUA_T_NUMBER;
|
||||
doLoadNumber(nvalue(o),Z);
|
||||
break;
|
||||
case ID_STR:
|
||||
ttype(o)=LUA_T_STRING;
|
||||
tsvalue(o)=LoadTString(Z);
|
||||
break;
|
||||
case ID_FUN:
|
||||
ttype(o)=LUA_T_PROTO;
|
||||
tfvalue(o)=LoadFunction(Z);
|
||||
break;
|
||||
default:
|
||||
luaL_verror("bad constant #%d in %s: type=%d ('%c')",i,zname(Z),c,c);
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
static TProtoFunc* LoadFunction(ZIO* Z)
|
||||
{
|
||||
TProtoFunc* tf=luaF_newproto();
|
||||
tf->lineDefined=LoadWord(Z);
|
||||
tf->fileName=LoadTString(Z);
|
||||
tf->code=LoadCode(Z);
|
||||
LoadLocals(tf,Z);
|
||||
LoadConstants(tf,Z);
|
||||
return tf;
|
||||
}
|
||||
|
||||
static void LoadSignature(ZIO* Z)
|
||||
{
|
||||
char* s=SIGNATURE;
|
||||
while (*s!=0 && ezgetc(Z)==*s)
|
||||
++s;
|
||||
if (*s!=0) luaL_verror("bad signature in %s",zname(Z));
|
||||
}
|
||||
|
||||
static void LoadHeader(ZIO* Z)
|
||||
{
|
||||
int version,id,sizeofR;
|
||||
real f=-TEST_NUMBER,tf=TEST_NUMBER;
|
||||
LoadSignature(Z);
|
||||
version=ezgetc(Z);
|
||||
if (version>VERSION)
|
||||
luaL_verror(
|
||||
"%s too new: version=0x%02x; expected at most 0x%02x",
|
||||
zname(Z),version,VERSION);
|
||||
if (version<VERSION0) /* check last major change */
|
||||
luaL_verror(
|
||||
"%s too old: version=0x%02x; expected at least 0x%02x",
|
||||
zname(Z),version,VERSION0);
|
||||
id=ezgetc(Z); /* test number representation */
|
||||
sizeofR=ezgetc(Z);
|
||||
if (id!=ID_NUMBER || sizeofR!=sizeof(real))
|
||||
{
|
||||
luaL_verror("unknown number signature in %s: "
|
||||
"read 0x%02x%02x; expected 0x%02x%02x",
|
||||
zname(Z),id,sizeofR,ID_NUMBER,sizeof(real));
|
||||
}
|
||||
doLoadNumber(f,Z);
|
||||
if (f!=tf)
|
||||
luaL_verror("unknown number representation in %s: "
|
||||
"read " NUMBER_FMT "; expected " NUMBER_FMT "", /* LUA_NUMBER */
|
||||
zname(Z),(double)f,(double)tf);
|
||||
}
|
||||
|
||||
static TProtoFunc* LoadChunk(ZIO* Z)
|
||||
{
|
||||
LoadHeader(Z);
|
||||
return LoadFunction(Z);
|
||||
}
|
||||
|
||||
/*
|
||||
** load one chunk from a file or buffer
|
||||
** return main if ok and NULL at EOF
|
||||
*/
|
||||
TProtoFunc* luaU_undump1(ZIO* Z)
|
||||
{
|
||||
int c=zgetc(Z);
|
||||
if (c==ID_CHUNK)
|
||||
return LoadChunk(Z);
|
||||
else if (c!=EOZ)
|
||||
luaL_verror("%s is not a Lua binary file",zname(Z));
|
||||
return NULL;
|
||||
}
|
||||
81
lundump.h
Normal file
81
lundump.h
Normal file
@@ -0,0 +1,81 @@
|
||||
/*
|
||||
** $Id: lundump.h,v 1.7 1998/06/25 15:50:09 lhf Exp $
|
||||
** load pre-compiled Lua chunks
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
#ifndef lundump_h
|
||||
#define lundump_h
|
||||
|
||||
#include "lobject.h"
|
||||
#include "lzio.h"
|
||||
|
||||
TProtoFunc* luaU_undump1(ZIO* Z); /* load one chunk */
|
||||
|
||||
#define SIGNATURE "Lua"
|
||||
#define VERSION 0x31 /* last format change was in 3.1 */
|
||||
#define VERSION0 0x31 /* last major change was in 3.1 */
|
||||
|
||||
#define IsMain(f) (f->lineDefined==0)
|
||||
|
||||
#define ID_CHUNK 27 /* ESC */
|
||||
#define ID_NUM 'N'
|
||||
#define ID_STR 'S'
|
||||
#define ID_FUN 'F'
|
||||
|
||||
/* number representation */
|
||||
#define ID_INT4 'l' /* 4-byte integers */
|
||||
#define ID_REAL4 'f' /* 4-byte reals */
|
||||
#define ID_REAL8 'd' /* 8-byte reals */
|
||||
#define ID_NATIVE '?' /* whatever your machine uses */
|
||||
|
||||
/*
|
||||
* use a multiple of PI for testing number representation.
|
||||
* multiplying by 1E8 gives notrivial integer values.
|
||||
*/
|
||||
#define TEST_NUMBER 3.14159265358979323846E8
|
||||
|
||||
/* LUA_NUMBER
|
||||
* choose one below for the number representation in precompiled chunks.
|
||||
* the default is ID_REAL8 because the default for LUA_NUM_TYPE is double.
|
||||
* if your machine does not use IEEE 754, use ID_NATIVE.
|
||||
* the next version will support conversion to/from IEEE 754.
|
||||
*
|
||||
* if you change LUA_NUM_TYPE, make sure you set ID_NUMBER accordingly,
|
||||
* specially if sizeof(long)!=4.
|
||||
* for types other than the ones listed below, you'll have to write your own
|
||||
* dump and undump routines.
|
||||
*/
|
||||
|
||||
#ifndef ID_NUMBER
|
||||
#define ID_NUMBER ID_NATIVE
|
||||
#endif
|
||||
|
||||
#if 0
|
||||
#define ID_NUMBER ID_INT4
|
||||
#define ID_NUMBER ID_REAL4
|
||||
#define ID_NUMBER ID_REAL8
|
||||
#define ID_NUMBER ID_NATIVE
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
#if ID_NUMBER==ID_REAL4
|
||||
#define DumpNumber DumpFloat
|
||||
#define LoadNumber LoadFloat
|
||||
#define SIZEOF_NUMBER 4
|
||||
#elif ID_NUMBER==ID_REAL8
|
||||
#define DumpNumber DumpDouble
|
||||
#define LoadNumber LoadDouble
|
||||
#define SIZEOF_NUMBER 8
|
||||
#elif ID_NUMBER==ID_INT4
|
||||
#define DumpNumber DumpLong
|
||||
#define LoadNumber LoadLong
|
||||
#define SIZEOF_NUMBER 4
|
||||
#elif ID_NUMBER==ID_NATIVE
|
||||
#define DumpNumber DumpNative
|
||||
#define LoadNumber LoadNative
|
||||
#define SIZEOF_NUMBER sizeof(real)
|
||||
#else
|
||||
#error bad ID_NUMBER
|
||||
#endif
|
||||
737
lvm.c
Normal file
737
lvm.c
Normal file
@@ -0,0 +1,737 @@
|
||||
/*
|
||||
** $Id: lvm.c,v 1.29 1998/05/31 22:18:24 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)<<8)+(*((pc)+1)))
|
||||
#define next_word(pc) (pc+=2, get_word(pc-2))
|
||||
|
||||
|
||||
/* Extra stack size to run a function: LUA_T_LINE(1), TM calls(2), ... */
|
||||
#define EXTRA_STACK 5
|
||||
|
||||
|
||||
|
||||
static TaggedString *strconc (TaggedString *l, TaggedString *r)
|
||||
{
|
||||
size_t nl = l->u.s.len;
|
||||
size_t nr = r->u.s.len;
|
||||
char *buffer = luaL_openspace(nl+nr+1);
|
||||
memcpy(buffer, l->str, nl);
|
||||
memcpy(buffer+nl, r->str, nr);
|
||||
return luaS_newlstr(buffer, nl+nr);
|
||||
}
|
||||
|
||||
|
||||
int luaV_tonumber (TObject *obj)
|
||||
{ /* LUA_NUMBER */
|
||||
double t;
|
||||
char c;
|
||||
if (ttype(obj) != LUA_T_STRING)
|
||||
return 1;
|
||||
else if (sscanf(svalue(obj), "%lf %c",&t, &c) == 1) {
|
||||
nvalue(obj) = (real)t;
|
||||
ttype(obj) = LUA_T_NUMBER;
|
||||
return 0;
|
||||
}
|
||||
else
|
||||
return 2;
|
||||
}
|
||||
|
||||
|
||||
int luaV_tostring (TObject *obj)
|
||||
{ /* LUA_NUMBER */
|
||||
if (ttype(obj) != LUA_T_NUMBER)
|
||||
return 1;
|
||||
else {
|
||||
char s[60];
|
||||
real f = nvalue(obj);
|
||||
int i;
|
||||
if ((real)(-MAX_INT) <= f && f <= (real)MAX_INT && (real)(i=(int)f) == f)
|
||||
sprintf (s, "%d", i);
|
||||
else
|
||||
sprintf (s, NUMBER_FMT, nvalue(obj));
|
||||
tsvalue(obj) = luaS_new(s);
|
||||
ttype(obj) = LUA_T_STRING;
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
void luaV_closure (int nelems)
|
||||
{
|
||||
if (nelems > 0) {
|
||||
struct Stack *S = &L->stack;
|
||||
Closure *c = luaF_newclosure(nelems);
|
||||
c->consts[0] = *(S->top-1);
|
||||
memcpy(&c->consts[1], S->top-(nelems+1), nelems*sizeof(TObject));
|
||||
S->top -= nelems;
|
||||
ttype(S->top-1) = LUA_T_CLOSURE;
|
||||
(S->top-1)->value.cl = c;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Function to index a table.
|
||||
** Receives the table at top-2 and the index at top-1.
|
||||
*/
|
||||
void luaV_gettable (void)
|
||||
{
|
||||
struct Stack *S = &L->stack;
|
||||
TObject *im;
|
||||
if (ttype(S->top-2) != LUA_T_ARRAY) /* not a table, get "gettable" method */
|
||||
im = luaT_getimbyObj(S->top-2, IM_GETTABLE);
|
||||
else { /* object is a table... */
|
||||
int tg = (S->top-2)->value.a->htag;
|
||||
im = luaT_getim(tg, IM_GETTABLE);
|
||||
if (ttype(im) == LUA_T_NIL) { /* and does not have a "gettable" method */
|
||||
TObject *h = luaH_get(avalue(S->top-2), S->top-1);
|
||||
if (h != NULL && ttype(h) != LUA_T_NIL) {
|
||||
--S->top;
|
||||
*(S->top-1) = *h;
|
||||
}
|
||||
else if (ttype(im=luaT_getim(tg, IM_INDEX)) != LUA_T_NIL)
|
||||
luaD_callTM(im, 2, 1);
|
||||
else {
|
||||
--S->top;
|
||||
ttype(S->top-1) = LUA_T_NIL;
|
||||
}
|
||||
return;
|
||||
}
|
||||
/* else it has a "gettable" method, go through to next command */
|
||||
}
|
||||
/* object is not a table, or it has a "gettable" method */
|
||||
if (ttype(im) != LUA_T_NIL)
|
||||
luaD_callTM(im, 2, 1);
|
||||
else
|
||||
lua_error("indexed expression not a table");
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Function to store indexed based on values at the stack.top
|
||||
** mode = 0: raw store (without tag methods)
|
||||
** mode = 1: normal store (with tag methods)
|
||||
** mode = 2: "deep L->stack.stack" store (with tag methods)
|
||||
*/
|
||||
void luaV_settable (TObject *t, int mode)
|
||||
{
|
||||
struct Stack *S = &L->stack;
|
||||
TObject *im = (mode == 0) ? NULL : luaT_getimbyObj(t, IM_SETTABLE);
|
||||
if (ttype(t) == LUA_T_ARRAY && (im == NULL || ttype(im) == LUA_T_NIL)) {
|
||||
TObject *h = luaH_set(avalue(t), t+1);
|
||||
*h = *(S->top-1);
|
||||
S->top -= (mode == 2) ? 1 : 3;
|
||||
}
|
||||
else { /* object is not a table, and/or has a specific "settable" method */
|
||||
if (im && ttype(im) != LUA_T_NIL) {
|
||||
if (mode == 2) {
|
||||
*(S->top+1) = *(L->stack.top-1);
|
||||
*(S->top) = *(t+1);
|
||||
*(S->top-1) = *t;
|
||||
S->top += 2; /* WARNING: caller must assure stack space */
|
||||
}
|
||||
luaD_callTM(im, 3, 0);
|
||||
}
|
||||
else
|
||||
lua_error("indexed expression not a table");
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
void luaV_getglobal (TaggedString *ts)
|
||||
{
|
||||
/* WARNING: caller must assure stack space */
|
||||
TObject *value = &ts->u.s.globalval;
|
||||
TObject *im = luaT_getimbyObj(value, IM_GETGLOBAL);
|
||||
if (ttype(im) == LUA_T_NIL) { /* default behavior */
|
||||
*L->stack.top++ = *value;
|
||||
}
|
||||
else {
|
||||
struct Stack *S = &L->stack;
|
||||
ttype(S->top) = LUA_T_STRING;
|
||||
tsvalue(S->top) = ts;
|
||||
S->top++;
|
||||
*S->top++ = *value;
|
||||
luaD_callTM(im, 2, 1);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
void luaV_setglobal (TaggedString *ts)
|
||||
{
|
||||
TObject *oldvalue = &ts->u.s.globalval;
|
||||
TObject *im = luaT_getimbyObj(oldvalue, IM_SETGLOBAL);
|
||||
if (ttype(im) == LUA_T_NIL) /* default behavior */
|
||||
luaS_rawsetglobal(ts, --L->stack.top);
|
||||
else {
|
||||
/* WARNING: caller must assure stack space */
|
||||
struct Stack *S = &L->stack;
|
||||
TObject newvalue = *(S->top-1);
|
||||
ttype(S->top-1) = LUA_T_STRING;
|
||||
tsvalue(S->top-1) = ts;
|
||||
*S->top++ = *oldvalue;
|
||||
*S->top++ = newvalue;
|
||||
luaD_callTM(im, 3, 0);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void call_binTM (IMS event, char *msg)
|
||||
{
|
||||
TObject *im = luaT_getimbyObj(L->stack.top-2, event);/* try first operand */
|
||||
if (ttype(im) == LUA_T_NIL) {
|
||||
im = luaT_getimbyObj(L->stack.top-1, event); /* try second operand */
|
||||
if (ttype(im) == LUA_T_NIL) {
|
||||
im = luaT_getim(0, event); /* try a 'global' i.m. */
|
||||
if (ttype(im) == LUA_T_NIL)
|
||||
lua_error(msg);
|
||||
}
|
||||
}
|
||||
lua_pushstring(luaT_eventname[event]);
|
||||
luaD_callTM(im, 3, 1);
|
||||
}
|
||||
|
||||
|
||||
static void call_arith (IMS event)
|
||||
{
|
||||
call_binTM(event, "unexpected type in arithmetic operation");
|
||||
}
|
||||
|
||||
|
||||
static int strcomp (char *l, long ll, char *r, long lr)
|
||||
{
|
||||
for (;;) {
|
||||
long temp = strcoll(l, r);
|
||||
if (temp != 0) return temp;
|
||||
/* strings are equal up to a '\0' */
|
||||
temp = strlen(l); /* index of first '\0' in both strings */
|
||||
if (temp == ll) /* l is finished? */
|
||||
return (temp == lr) ? 0 : -1; /* l is equal or smaller than r */
|
||||
else if (temp == lr) /* r is finished? */
|
||||
return 1; /* l is greater than r (because l is not finished) */
|
||||
/* both strings longer than temp; go on comparing (after the '\0') */
|
||||
temp++;
|
||||
l += temp; ll -= temp; r += temp; lr -= temp;
|
||||
}
|
||||
}
|
||||
|
||||
static void comparison (lua_Type ttype_less, lua_Type ttype_equal,
|
||||
lua_Type ttype_great, IMS op)
|
||||
{
|
||||
struct Stack *S = &L->stack;
|
||||
TObject *l = S->top-2;
|
||||
TObject *r = S->top-1;
|
||||
int result;
|
||||
if (ttype(l) == LUA_T_NUMBER && ttype(r) == LUA_T_NUMBER)
|
||||
result = (nvalue(l) < nvalue(r)) ? -1 : (nvalue(l) == nvalue(r)) ? 0 : 1;
|
||||
else if (ttype(l) == LUA_T_STRING && ttype(r) == LUA_T_STRING)
|
||||
result = strcomp(svalue(l), tsvalue(l)->u.s.len,
|
||||
svalue(r), tsvalue(r)->u.s.len);
|
||||
else {
|
||||
call_binTM(op, "unexpected type in comparison");
|
||||
return;
|
||||
}
|
||||
S->top--;
|
||||
nvalue(S->top-1) = 1;
|
||||
ttype(S->top-1) = (result < 0) ? ttype_less :
|
||||
(result == 0) ? ttype_equal : ttype_great;
|
||||
}
|
||||
|
||||
|
||||
void luaV_pack (StkId firstel, int nvararg, TObject *tab)
|
||||
{
|
||||
TObject *firstelem = L->stack.stack+firstel;
|
||||
int i;
|
||||
if (nvararg < 0) nvararg = 0;
|
||||
avalue(tab) = luaH_new(nvararg+1); /* +1 for field 'n' */
|
||||
ttype(tab) = LUA_T_ARRAY;
|
||||
for (i=0; i<nvararg; i++) {
|
||||
TObject index;
|
||||
ttype(&index) = LUA_T_NUMBER;
|
||||
nvalue(&index) = i+1;
|
||||
*(luaH_set(avalue(tab), &index)) = *(firstelem+i);
|
||||
}
|
||||
/* store counter in field "n" */ {
|
||||
TObject index, extra;
|
||||
ttype(&index) = LUA_T_STRING;
|
||||
tsvalue(&index) = luaS_new("n");
|
||||
ttype(&extra) = LUA_T_NUMBER;
|
||||
nvalue(&extra) = nvararg;
|
||||
*(luaH_set(avalue(tab), &index)) = extra;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void adjust_varargs (StkId first_extra_arg)
|
||||
{
|
||||
TObject arg;
|
||||
luaV_pack(first_extra_arg,
|
||||
(L->stack.top-L->stack.stack)-first_extra_arg, &arg);
|
||||
luaD_adjusttop(first_extra_arg);
|
||||
*L->stack.top++ = arg;
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** Execute the given opcode, until a RET. Parameters are between
|
||||
** [stack+base,top). Returns n such that the the results are between
|
||||
** [stack+n,top).
|
||||
*/
|
||||
StkId luaV_execute (Closure *cl, TProtoFunc *tf, StkId base)
|
||||
{
|
||||
struct Stack *S = &L->stack; /* to optimize */
|
||||
Byte *pc = tf->code;
|
||||
TObject *consts = tf->consts;
|
||||
if (lua_callhook)
|
||||
luaD_callHook(base, tf, 0);
|
||||
luaD_checkstack((*pc++)+EXTRA_STACK);
|
||||
if (*pc < ZEROVARARG)
|
||||
luaD_adjusttop(base+*(pc++));
|
||||
else { /* varargs */
|
||||
luaC_checkGC();
|
||||
adjust_varargs(base+(*pc++)-ZEROVARARG);
|
||||
}
|
||||
while (1) {
|
||||
int aux;
|
||||
switch ((OpCode)(aux = *pc++)) {
|
||||
|
||||
case PUSHNIL0:
|
||||
ttype(S->top++) = LUA_T_NIL;
|
||||
break;
|
||||
|
||||
case PUSHNIL:
|
||||
aux = *pc++;
|
||||
do {
|
||||
ttype(S->top++) = LUA_T_NIL;
|
||||
} while (aux--);
|
||||
break;
|
||||
|
||||
case PUSHNUMBER:
|
||||
aux = *pc++; goto pushnumber;
|
||||
|
||||
case PUSHNUMBERW:
|
||||
aux = next_word(pc); goto pushnumber;
|
||||
|
||||
case PUSHNUMBER0: case PUSHNUMBER1: case PUSHNUMBER2:
|
||||
aux -= PUSHNUMBER0;
|
||||
pushnumber:
|
||||
ttype(S->top) = LUA_T_NUMBER;
|
||||
nvalue(S->top) = aux;
|
||||
S->top++;
|
||||
break;
|
||||
|
||||
case PUSHLOCAL:
|
||||
aux = *pc++; goto pushlocal;
|
||||
|
||||
case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2: case PUSHLOCAL3:
|
||||
case PUSHLOCAL4: case PUSHLOCAL5: case PUSHLOCAL6: case PUSHLOCAL7:
|
||||
aux -= PUSHLOCAL0;
|
||||
pushlocal:
|
||||
*S->top++ = *((S->stack+base) + aux);
|
||||
break;
|
||||
|
||||
case GETGLOBALW:
|
||||
aux = next_word(pc); goto getglobal;
|
||||
|
||||
case GETGLOBAL:
|
||||
aux = *pc++; goto getglobal;
|
||||
|
||||
case GETGLOBAL0: case GETGLOBAL1: case GETGLOBAL2: case GETGLOBAL3:
|
||||
case GETGLOBAL4: case GETGLOBAL5: case GETGLOBAL6: case GETGLOBAL7:
|
||||
aux -= GETGLOBAL0;
|
||||
getglobal:
|
||||
luaV_getglobal(tsvalue(&consts[aux]));
|
||||
break;
|
||||
|
||||
case GETTABLE:
|
||||
luaV_gettable();
|
||||
break;
|
||||
|
||||
case GETDOTTEDW:
|
||||
aux = next_word(pc); goto getdotted;
|
||||
|
||||
case GETDOTTED:
|
||||
aux = *pc++; goto getdotted;
|
||||
|
||||
case GETDOTTED0: case GETDOTTED1: case GETDOTTED2: case GETDOTTED3:
|
||||
case GETDOTTED4: case GETDOTTED5: case GETDOTTED6: case GETDOTTED7:
|
||||
aux -= GETDOTTED0;
|
||||
getdotted:
|
||||
*S->top++ = consts[aux];
|
||||
luaV_gettable();
|
||||
break;
|
||||
|
||||
case PUSHSELFW:
|
||||
aux = next_word(pc); goto pushself;
|
||||
|
||||
case PUSHSELF:
|
||||
aux = *pc++; goto pushself;
|
||||
|
||||
case PUSHSELF0: case PUSHSELF1: case PUSHSELF2: case PUSHSELF3:
|
||||
case PUSHSELF4: case PUSHSELF5: case PUSHSELF6: case PUSHSELF7:
|
||||
aux -= PUSHSELF0;
|
||||
pushself: {
|
||||
TObject receiver = *(S->top-1);
|
||||
*S->top++ = consts[aux];
|
||||
luaV_gettable();
|
||||
*S->top++ = receiver;
|
||||
break;
|
||||
}
|
||||
|
||||
case PUSHCONSTANTW:
|
||||
aux = next_word(pc); goto pushconstant;
|
||||
|
||||
case PUSHCONSTANT:
|
||||
aux = *pc++; goto pushconstant;
|
||||
|
||||
case PUSHCONSTANT0: case PUSHCONSTANT1: case PUSHCONSTANT2:
|
||||
case PUSHCONSTANT3: case PUSHCONSTANT4: case PUSHCONSTANT5:
|
||||
case PUSHCONSTANT6: case PUSHCONSTANT7:
|
||||
aux -= PUSHCONSTANT0;
|
||||
pushconstant:
|
||||
*S->top++ = consts[aux];
|
||||
break;
|
||||
|
||||
case PUSHUPVALUE:
|
||||
aux = *pc++; goto pushupvalue;
|
||||
|
||||
case PUSHUPVALUE0: case PUSHUPVALUE1:
|
||||
aux -= PUSHUPVALUE0;
|
||||
pushupvalue:
|
||||
*S->top++ = cl->consts[aux+1];
|
||||
break;
|
||||
|
||||
case SETLOCAL:
|
||||
aux = *pc++; goto setlocal;
|
||||
|
||||
case SETLOCAL0: case SETLOCAL1: case SETLOCAL2: case SETLOCAL3:
|
||||
case SETLOCAL4: case SETLOCAL5: case SETLOCAL6: case SETLOCAL7:
|
||||
aux -= SETLOCAL0;
|
||||
setlocal:
|
||||
*((S->stack+base) + aux) = *(--S->top);
|
||||
break;
|
||||
|
||||
case SETGLOBALW:
|
||||
aux = next_word(pc); goto setglobal;
|
||||
|
||||
case SETGLOBAL:
|
||||
aux = *pc++; goto setglobal;
|
||||
|
||||
case SETGLOBAL0: case SETGLOBAL1: case SETGLOBAL2: case SETGLOBAL3:
|
||||
case SETGLOBAL4: case SETGLOBAL5: case SETGLOBAL6: case SETGLOBAL7:
|
||||
aux -= SETGLOBAL0;
|
||||
setglobal:
|
||||
luaV_setglobal(tsvalue(&consts[aux]));
|
||||
break;
|
||||
|
||||
case SETTABLE0:
|
||||
luaV_settable(S->top-3, 1);
|
||||
break;
|
||||
|
||||
case SETTABLE:
|
||||
luaV_settable(S->top-3-(*pc++), 2);
|
||||
break;
|
||||
|
||||
case SETLISTW:
|
||||
aux = next_word(pc); aux *= LFIELDS_PER_FLUSH; goto setlist;
|
||||
|
||||
case SETLIST:
|
||||
aux = *(pc++) * LFIELDS_PER_FLUSH; goto setlist;
|
||||
|
||||
case SETLIST0:
|
||||
aux = 0;
|
||||
setlist: {
|
||||
int n = *(pc++);
|
||||
TObject *arr = S->top-n-1;
|
||||
for (; n; n--) {
|
||||
ttype(S->top) = LUA_T_NUMBER;
|
||||
nvalue(S->top) = n+aux;
|
||||
*(luaH_set(avalue(arr), S->top)) = *(S->top-1);
|
||||
S->top--;
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
case SETMAP0:
|
||||
aux = 0; goto setmap;
|
||||
|
||||
case SETMAP:
|
||||
aux = *pc++;
|
||||
setmap: {
|
||||
TObject *arr = S->top-(2*aux)-3;
|
||||
do {
|
||||
*(luaH_set(avalue(arr), S->top-2)) = *(S->top-1);
|
||||
S->top-=2;
|
||||
} while (aux--);
|
||||
break;
|
||||
}
|
||||
|
||||
case POP:
|
||||
aux = *pc++; goto pop;
|
||||
|
||||
case POP0: case POP1:
|
||||
aux -= POP0;
|
||||
pop:
|
||||
S->top -= (aux+1);
|
||||
break;
|
||||
|
||||
case CREATEARRAYW:
|
||||
aux = next_word(pc); goto createarray;
|
||||
|
||||
case CREATEARRAY0: case CREATEARRAY1:
|
||||
aux -= CREATEARRAY0; goto createarray;
|
||||
|
||||
case CREATEARRAY:
|
||||
aux = *pc++;
|
||||
createarray:
|
||||
luaC_checkGC();
|
||||
avalue(S->top) = luaH_new(aux);
|
||||
ttype(S->top) = LUA_T_ARRAY;
|
||||
S->top++;
|
||||
break;
|
||||
|
||||
case EQOP: case NEQOP: {
|
||||
int res = luaO_equalObj(S->top-2, S->top-1);
|
||||
S->top--;
|
||||
if (aux == NEQOP) res = !res;
|
||||
ttype(S->top-1) = res ? LUA_T_NUMBER : LUA_T_NIL;
|
||||
nvalue(S->top-1) = 1;
|
||||
break;
|
||||
}
|
||||
|
||||
case LTOP:
|
||||
comparison(LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, IM_LT);
|
||||
break;
|
||||
|
||||
case LEOP:
|
||||
comparison(LUA_T_NUMBER, LUA_T_NUMBER, LUA_T_NIL, IM_LE);
|
||||
break;
|
||||
|
||||
case GTOP:
|
||||
comparison(LUA_T_NIL, LUA_T_NIL, LUA_T_NUMBER, IM_GT);
|
||||
break;
|
||||
|
||||
case GEOP:
|
||||
comparison(LUA_T_NIL, LUA_T_NUMBER, LUA_T_NUMBER, IM_GE);
|
||||
break;
|
||||
|
||||
case ADDOP: {
|
||||
TObject *l = S->top-2;
|
||||
TObject *r = S->top-1;
|
||||
if (tonumber(r) || tonumber(l))
|
||||
call_arith(IM_ADD);
|
||||
else {
|
||||
nvalue(l) += nvalue(r);
|
||||
--S->top;
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
case SUBOP: {
|
||||
TObject *l = S->top-2;
|
||||
TObject *r = S->top-1;
|
||||
if (tonumber(r) || tonumber(l))
|
||||
call_arith(IM_SUB);
|
||||
else {
|
||||
nvalue(l) -= nvalue(r);
|
||||
--S->top;
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
case MULTOP: {
|
||||
TObject *l = S->top-2;
|
||||
TObject *r = S->top-1;
|
||||
if (tonumber(r) || tonumber(l))
|
||||
call_arith(IM_MUL);
|
||||
else {
|
||||
nvalue(l) *= nvalue(r);
|
||||
--S->top;
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
case DIVOP: {
|
||||
TObject *l = S->top-2;
|
||||
TObject *r = S->top-1;
|
||||
if (tonumber(r) || tonumber(l))
|
||||
call_arith(IM_DIV);
|
||||
else {
|
||||
nvalue(l) /= nvalue(r);
|
||||
--S->top;
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
case POWOP:
|
||||
call_binTM(IM_POW, "undefined operation");
|
||||
break;
|
||||
|
||||
case CONCOP: {
|
||||
TObject *l = S->top-2;
|
||||
TObject *r = S->top-1;
|
||||
if (tostring(l) || tostring(r))
|
||||
call_binTM(IM_CONCAT, "unexpected type for concatenation");
|
||||
else {
|
||||
tsvalue(l) = strconc(tsvalue(l), tsvalue(r));
|
||||
--S->top;
|
||||
}
|
||||
luaC_checkGC();
|
||||
break;
|
||||
}
|
||||
|
||||
case MINUSOP:
|
||||
if (tonumber(S->top-1)) {
|
||||
ttype(S->top) = LUA_T_NIL;
|
||||
S->top++;
|
||||
call_arith(IM_UNM);
|
||||
}
|
||||
else
|
||||
nvalue(S->top-1) = - nvalue(S->top-1);
|
||||
break;
|
||||
|
||||
case NOTOP:
|
||||
ttype(S->top-1) =
|
||||
(ttype(S->top-1) == LUA_T_NIL) ? LUA_T_NUMBER : LUA_T_NIL;
|
||||
nvalue(S->top-1) = 1;
|
||||
break;
|
||||
|
||||
case ONTJMPW:
|
||||
aux = next_word(pc); goto ontjmp;
|
||||
|
||||
case ONTJMP:
|
||||
aux = *pc++;
|
||||
ontjmp:
|
||||
if (ttype(S->top-1) != LUA_T_NIL) pc += aux;
|
||||
else S->top--;
|
||||
break;
|
||||
|
||||
case ONFJMPW:
|
||||
aux = next_word(pc); goto onfjmp;
|
||||
|
||||
case ONFJMP:
|
||||
aux = *pc++;
|
||||
onfjmp:
|
||||
if (ttype(S->top-1) == LUA_T_NIL) pc += aux;
|
||||
else S->top--;
|
||||
break;
|
||||
|
||||
case JMPW:
|
||||
aux = next_word(pc); goto jmp;
|
||||
|
||||
case JMP:
|
||||
aux = *pc++;
|
||||
jmp:
|
||||
pc += aux;
|
||||
break;
|
||||
|
||||
case IFFJMPW:
|
||||
aux = next_word(pc); goto iffjmp;
|
||||
|
||||
case IFFJMP:
|
||||
aux = *pc++;
|
||||
iffjmp:
|
||||
if (ttype(--S->top) == LUA_T_NIL) pc += aux;
|
||||
break;
|
||||
|
||||
case IFTUPJMPW:
|
||||
aux = next_word(pc); goto iftupjmp;
|
||||
|
||||
case IFTUPJMP:
|
||||
aux = *pc++;
|
||||
iftupjmp:
|
||||
if (ttype(--S->top) != LUA_T_NIL) pc -= aux;
|
||||
break;
|
||||
|
||||
case IFFUPJMPW:
|
||||
aux = next_word(pc); goto iffupjmp;
|
||||
|
||||
case IFFUPJMP:
|
||||
aux = *pc++;
|
||||
iffupjmp:
|
||||
if (ttype(--S->top) == LUA_T_NIL) pc -= aux;
|
||||
break;
|
||||
|
||||
case CLOSUREW:
|
||||
aux = next_word(pc); goto closure;
|
||||
|
||||
case CLOSURE:
|
||||
aux = *pc++;
|
||||
closure:
|
||||
*S->top++ = consts[aux];
|
||||
luaV_closure(*pc++);
|
||||
luaC_checkGC();
|
||||
break;
|
||||
|
||||
case CALLFUNC:
|
||||
aux = *pc++; goto callfunc;
|
||||
|
||||
case CALLFUNC0: case CALLFUNC1:
|
||||
aux -= CALLFUNC0;
|
||||
callfunc: {
|
||||
StkId newBase = (S->top-S->stack)-(*pc++);
|
||||
luaD_call(newBase, aux);
|
||||
break;
|
||||
}
|
||||
|
||||
case ENDCODE:
|
||||
S->top = S->stack + base;
|
||||
/* goes through */
|
||||
case RETCODE:
|
||||
if (lua_callhook)
|
||||
luaD_callHook(base, NULL, 1);
|
||||
return (base + ((aux==RETCODE) ? *pc : 0));
|
||||
|
||||
case SETLINEW:
|
||||
aux = next_word(pc); goto setline;
|
||||
|
||||
case SETLINE:
|
||||
aux = *pc++;
|
||||
setline:
|
||||
if ((S->stack+base-1)->ttype != LUA_T_LINE) {
|
||||
/* open space for LINE value */
|
||||
luaD_openstack((S->top-S->stack)-base);
|
||||
base++;
|
||||
(S->stack+base-1)->ttype = LUA_T_LINE;
|
||||
}
|
||||
(S->stack+base-1)->value.i = aux;
|
||||
if (lua_linehook)
|
||||
luaD_lineHook(aux);
|
||||
break;
|
||||
|
||||
#ifdef DEBUG
|
||||
default:
|
||||
LUA_INTERNALERROR("opcode doesn't match");
|
||||
#endif
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
29
lvm.h
Normal file
29
lvm.h
Normal 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
|
||||
84
lzio.c
Normal file
84
lzio.c
Normal file
@@ -0,0 +1,84 @@
|
||||
/*
|
||||
** $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 <string.h>
|
||||
|
||||
#include "lzio.h"
|
||||
|
||||
|
||||
|
||||
/* ----------------------------------------------------- memory buffers --- */
|
||||
|
||||
static int zmfilbuf (ZIO* z)
|
||||
{
|
||||
return EOZ;
|
||||
}
|
||||
|
||||
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, char *name)
|
||||
{
|
||||
if (s==NULL) return NULL;
|
||||
return zmopen(z,s,strlen(s),name);
|
||||
}
|
||||
|
||||
/* -------------------------------------------------------------- FILEs --- */
|
||||
|
||||
static int zffilbuf (ZIO* z)
|
||||
{
|
||||
int n=fread(z->buffer,1,ZBSIZE,z->u);
|
||||
if (n==0) return EOZ;
|
||||
z->n=n-1;
|
||||
z->p=z->buffer;
|
||||
return *(z->p++);
|
||||
}
|
||||
|
||||
|
||||
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)
|
||||
{
|
||||
while (n) {
|
||||
int m;
|
||||
if (z->n == 0) {
|
||||
if (z->filbuf(z) == EOZ)
|
||||
return n; /* retorna quantos faltaram ler */
|
||||
zungetc(z); /* poe o resultado de filbuf no buffer */
|
||||
}
|
||||
m = (n <= z->n) ? n : z->n; /* minimo de n e z->n */
|
||||
memcpy(b, z->p, m);
|
||||
z->n -= m;
|
||||
z->p += m;
|
||||
b = (char *)b + m;
|
||||
n -= m;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
50
lzio.h
Normal file
50
lzio.h
Normal file
@@ -0,0 +1,50 @@
|
||||
/*
|
||||
** $Id: lzio.h,v 1.3 1997/12/22 20:57:18 roberto Exp roberto $
|
||||
** Buffered streams
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
#ifndef lzio_h
|
||||
#define lzio_h
|
||||
|
||||
#include <stdio.h>
|
||||
|
||||
|
||||
|
||||
/* For Lua only */
|
||||
#define zFopen luaZ_Fopen
|
||||
#define zsopen luaZ_sopen
|
||||
#define zmopen luaZ_mopen
|
||||
#define zread luaZ_read
|
||||
|
||||
#define EOZ (-1) /* end of stream */
|
||||
|
||||
typedef struct zio ZIO;
|
||||
|
||||
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 */
|
||||
|
||||
#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 ------------------ */
|
||||
|
||||
#define ZBSIZE 256 /* buffer size */
|
||||
|
||||
struct zio {
|
||||
int n; /* bytes still unread */
|
||||
unsigned char* p; /* current position in buffer */
|
||||
int (*filbuf)(ZIO* z);
|
||||
void* u; /* additional data */
|
||||
char *name;
|
||||
unsigned char buffer[ZBSIZE]; /* buffer */
|
||||
};
|
||||
|
||||
|
||||
#endif
|
||||
145
makefile
145
makefile
@@ -1,91 +1,124 @@
|
||||
# $Id: makefile,v 1.21 1996/03/05 15:57:53 roberto Exp roberto $
|
||||
#
|
||||
## $Id: makefile,v 1.12 1998/05/27 13:03:40 roberto Exp roberto $
|
||||
## Makefile
|
||||
## See Copyright Notice in lua.h
|
||||
#
|
||||
|
||||
#configuration
|
||||
|
||||
#CONFIGURATION
|
||||
|
||||
# define (undefine) POPEN if your system (does not) support piped I/O
|
||||
CONFIG = -DPOPEN
|
||||
#
|
||||
# define (undefine) _POSIX_SOURCE if your system is (not) POSIX compliant
|
||||
#
|
||||
# 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)
|
||||
#
|
||||
# define LUA_NUM_TYPE if you need numbers to be different from double
|
||||
|
||||
CONFIG = -DPOPEN -D_POSIX_SOURCE
|
||||
#CONFIG = -DLUA_COMPAT2_5 -DOLD_ANSI -DDEBUG
|
||||
|
||||
|
||||
# Compilation parameters
|
||||
CC = gcc
|
||||
CFLAGS = $(CONFIG) -I/usr/5include -Wall -Wmissing-prototypes -Wshadow -ansi -O2
|
||||
CWARNS = -Wall -Wmissing-prototypes -Wshadow -pedantic -Wpointer-arith -Wcast-align -Waggregate-return
|
||||
CFLAGS = $(CONFIG) $(CWARNS) -ansi -O2
|
||||
|
||||
#CC = acc
|
||||
#CFLAGS = -fast -I/usr/5include
|
||||
|
||||
AR = ar
|
||||
ARFLAGS = rvl
|
||||
|
||||
|
||||
# Aplication modules
|
||||
LUAOBJS = \
|
||||
parser.o \
|
||||
lex.o \
|
||||
opcode.o \
|
||||
hash.o \
|
||||
table.o \
|
||||
inout.o \
|
||||
tree.o \
|
||||
fallback.o \
|
||||
mem.o \
|
||||
func.o \
|
||||
undump.o
|
||||
lapi.o \
|
||||
lauxlib.o \
|
||||
lbuffer.o \
|
||||
lbuiltin.o \
|
||||
ldo.o \
|
||||
lfunc.o \
|
||||
lgc.o \
|
||||
llex.o \
|
||||
lmem.o \
|
||||
lobject.o \
|
||||
lparser.o \
|
||||
lstate.o \
|
||||
lstring.o \
|
||||
ltable.o \
|
||||
ltm.o \
|
||||
lvm.o \
|
||||
lundump.o \
|
||||
lzio.o
|
||||
|
||||
LIBOBJS = \
|
||||
iolib.o \
|
||||
mathlib.o \
|
||||
strlib.o
|
||||
liolib.o \
|
||||
lmathlib.o \
|
||||
lstrlib.o
|
||||
|
||||
|
||||
lua : lua.o lua.a lualib.a
|
||||
$(CC) $(CFLAGS) -o $@ lua.o lua.a lualib.a -lm
|
||||
lua : lua.o liblua.a liblualib.a
|
||||
$(CC) $(CFLAGS) -o $@ lua.o -L. -llua -llualib -lm
|
||||
|
||||
lua.a : $(LUAOBJS)
|
||||
liblua.a : $(LUAOBJS)
|
||||
$(AR) $(ARFLAGS) $@ $?
|
||||
ranlib lua.a
|
||||
ranlib $@
|
||||
|
||||
lualib.a : $(LIBOBJS)
|
||||
liblualib.a : $(LIBOBJS)
|
||||
$(AR) $(ARFLAGS) $@ $?
|
||||
ranlib $@
|
||||
|
||||
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' y.tab.c > parser.c
|
||||
|
||||
parser.h : y.tab.h
|
||||
sed -e 's/yy/luaY_/g' y.tab.h > parser.h
|
||||
|
||||
clear :
|
||||
rcsclean
|
||||
rm -f *.o
|
||||
rm -f parser.c parser.h y.tab.c y.tab.h
|
||||
rm -f
|
||||
co lua.h lualib.h luadebug.h
|
||||
|
||||
|
||||
% : RCS/%,v
|
||||
%.h : RCS/%.h,v
|
||||
co $@
|
||||
|
||||
%.c : RCS/%.c,v
|
||||
co $@
|
||||
|
||||
|
||||
|
||||
fallback.o : fallback.c mem.h fallback.h opcode.h lua.h types.h tree.h func.h
|
||||
func.o : func.c luadebug.h lua.h table.h tree.h types.h opcode.h func.h mem.h
|
||||
hash.o : hash.c mem.h opcode.h lua.h types.h tree.h func.h hash.h table.h
|
||||
inout.o : inout.c lex.h opcode.h lua.h types.h tree.h func.h inout.h table.h \
|
||||
mem.h
|
||||
iolib.o : iolib.c lua.h luadebug.h lualib.h
|
||||
lex.o : lex.c mem.h tree.h types.h table.h opcode.h lua.h func.h lex.h inout.h \
|
||||
luadebug.h parser.h
|
||||
lua.o : lua.c lua.h lualib.h
|
||||
mathlib.o : mathlib.c lualib.h lua.h
|
||||
mem.o : mem.c mem.h lua.h table.h tree.h types.h opcode.h func.h
|
||||
opcode.o : opcode.c luadebug.h lua.h mem.h opcode.h types.h tree.h func.h hash.h \
|
||||
inout.h table.h fallback.h undump.h
|
||||
parser.o : parser.c luadebug.h lua.h mem.h lex.h opcode.h types.h tree.h func.h \
|
||||
hash.h inout.h table.h
|
||||
strlib.o : strlib.c lua.h lualib.h
|
||||
table.o : table.c mem.h opcode.h lua.h types.h tree.h func.h hash.h table.h \
|
||||
inout.h fallback.h luadebug.h
|
||||
tree.o : tree.c mem.h lua.h tree.h types.h lex.h hash.h opcode.h func.h table.h
|
||||
undump.o : undump.c opcode.h lua.h types.h tree.h func.h mem.h table.h undump.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 lundump.h \
|
||||
lzio.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 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
|
||||
lparser.o: lparser.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
|
||||
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
|
||||
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
|
||||
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
|
||||
|
||||
3560
manual.tex
3560
manual.tex
File diff suppressed because it is too large
Load Diff
227
mathlib.c
227
mathlib.c
@@ -1,227 +0,0 @@
|
||||
/*
|
||||
** mathlib.c
|
||||
** Mathematics library to LUA
|
||||
*/
|
||||
|
||||
char *rcs_mathlib="$Id: mathlib.c,v 1.13 1995/11/10 17:54:31 roberto Exp roberto $";
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <math.h>
|
||||
|
||||
#include "lualib.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 = lua_check_number(1, "abs");
|
||||
if (d < 0) d = -d;
|
||||
lua_pushnumber (d);
|
||||
}
|
||||
|
||||
|
||||
static void math_sin (void)
|
||||
{
|
||||
double d = lua_check_number(1, "sin");
|
||||
lua_pushnumber (sin(TORAD(d)));
|
||||
}
|
||||
|
||||
|
||||
|
||||
static void math_cos (void)
|
||||
{
|
||||
double d = lua_check_number(1, "cos");
|
||||
lua_pushnumber (cos(TORAD(d)));
|
||||
}
|
||||
|
||||
|
||||
|
||||
static void math_tan (void)
|
||||
{
|
||||
double d = lua_check_number(1, "tan");
|
||||
lua_pushnumber (tan(TORAD(d)));
|
||||
}
|
||||
|
||||
|
||||
static void math_asin (void)
|
||||
{
|
||||
double d = lua_check_number(1, "asin");
|
||||
lua_pushnumber (TODEGREE(asin(d)));
|
||||
}
|
||||
|
||||
|
||||
static void math_acos (void)
|
||||
{
|
||||
double d = lua_check_number(1, "acos");
|
||||
lua_pushnumber (TODEGREE(acos(d)));
|
||||
}
|
||||
|
||||
|
||||
static void math_atan (void)
|
||||
{
|
||||
double d = lua_check_number(1, "atan");
|
||||
lua_pushnumber (TODEGREE(atan(d)));
|
||||
}
|
||||
|
||||
|
||||
static void math_atan2 (void)
|
||||
{
|
||||
double d1 = lua_check_number(1, "atan2");
|
||||
double d2 = lua_check_number(2, "atan2");
|
||||
lua_pushnumber (TODEGREE(atan2(d1, d2)));
|
||||
}
|
||||
|
||||
|
||||
static void math_ceil (void)
|
||||
{
|
||||
double d = lua_check_number(1, "ceil");
|
||||
lua_pushnumber (ceil(d));
|
||||
}
|
||||
|
||||
|
||||
static void math_floor (void)
|
||||
{
|
||||
double d = lua_check_number(1, "floor");
|
||||
lua_pushnumber (floor(d));
|
||||
}
|
||||
|
||||
static void math_mod (void)
|
||||
{
|
||||
int d1 = (int)lua_check_number(1, "mod");
|
||||
int d2 = (int)lua_check_number(2, "mod");
|
||||
lua_pushnumber (d1%d2);
|
||||
}
|
||||
|
||||
|
||||
static void math_sqrt (void)
|
||||
{
|
||||
double d = lua_check_number(1, "sqrt");
|
||||
lua_pushnumber (sqrt(d));
|
||||
}
|
||||
|
||||
static int old_pow;
|
||||
|
||||
static void math_pow (void)
|
||||
{
|
||||
lua_Object o1 = lua_getparam (1);
|
||||
lua_Object o2 = lua_getparam (2);
|
||||
lua_Object op = lua_getparam(3);
|
||||
if (!lua_isnumber(o1) || !lua_isnumber(o2) || *(lua_getstring(op)) != 'p')
|
||||
{
|
||||
lua_Object old = lua_getlocked(old_pow);
|
||||
lua_pushobject(o1);
|
||||
lua_pushobject(o2);
|
||||
lua_pushobject(op);
|
||||
if (lua_callfunction(old) != 0)
|
||||
lua_error(NULL);
|
||||
}
|
||||
else
|
||||
{
|
||||
double d1 = lua_getnumber(o1);
|
||||
double d2 = lua_getnumber(o2);
|
||||
lua_pushnumber (pow(d1,d2));
|
||||
}
|
||||
}
|
||||
|
||||
static void math_min (void)
|
||||
{
|
||||
int i=1;
|
||||
double dmin = lua_check_number(i, "min");
|
||||
while (lua_getparam(++i) != LUA_NOOBJECT)
|
||||
{
|
||||
double d = lua_check_number(i, "min");
|
||||
if (d < dmin) dmin = d;
|
||||
}
|
||||
lua_pushnumber (dmin);
|
||||
}
|
||||
|
||||
static void math_max (void)
|
||||
{
|
||||
int i=1;
|
||||
double dmax = lua_check_number(i, "max");
|
||||
while (lua_getparam(++i) != LUA_NOOBJECT)
|
||||
{
|
||||
double d = lua_check_number(i, "max");
|
||||
if (d > dmax) dmax = d;
|
||||
}
|
||||
lua_pushnumber (dmax);
|
||||
}
|
||||
|
||||
static void math_log (void)
|
||||
{
|
||||
double d = lua_check_number(1, "log");
|
||||
lua_pushnumber (log(d));
|
||||
}
|
||||
|
||||
|
||||
static void math_log10 (void)
|
||||
{
|
||||
double d = lua_check_number(1, "log10");
|
||||
lua_pushnumber (log10(d));
|
||||
}
|
||||
|
||||
|
||||
static void math_exp (void)
|
||||
{
|
||||
double d = lua_check_number(1, "exp");
|
||||
lua_pushnumber (exp(d));
|
||||
}
|
||||
|
||||
static void math_deg (void)
|
||||
{
|
||||
float d = lua_check_number(1, "deg");
|
||||
lua_pushnumber (d*180./PI);
|
||||
}
|
||||
|
||||
static void math_rad (void)
|
||||
{
|
||||
float d = lua_check_number(1, "rad");
|
||||
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(lua_check_number(1, "randomseed"));
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** Open math library
|
||||
*/
|
||||
void mathlib_open (void)
|
||||
{
|
||||
lua_register ("abs", math_abs);
|
||||
lua_register ("sin", math_sin);
|
||||
lua_register ("cos", math_cos);
|
||||
lua_register ("tan", math_tan);
|
||||
lua_register ("asin", math_asin);
|
||||
lua_register ("acos", math_acos);
|
||||
lua_register ("atan", math_atan);
|
||||
lua_register ("atan2", math_atan2);
|
||||
lua_register ("ceil", math_ceil);
|
||||
lua_register ("floor", math_floor);
|
||||
lua_register ("mod", math_mod);
|
||||
lua_register ("sqrt", math_sqrt);
|
||||
lua_register ("min", math_min);
|
||||
lua_register ("max", math_max);
|
||||
lua_register ("log", math_log);
|
||||
lua_register ("log10", math_log10);
|
||||
lua_register ("exp", math_exp);
|
||||
lua_register ("deg", math_deg);
|
||||
lua_register ("rad", math_rad);
|
||||
lua_register ("random", math_random);
|
||||
lua_register ("randomseed", math_randomseed);
|
||||
|
||||
old_pow = lua_lockobject(lua_setfallback("arith", math_pow));
|
||||
}
|
||||
13
mathlib.h
13
mathlib.h
@@ -1,13 +0,0 @@
|
||||
/*
|
||||
** Math library to LUA
|
||||
** TeCGraf - PUC-Rio
|
||||
** $Id: $
|
||||
*/
|
||||
|
||||
|
||||
#ifndef strlib_h
|
||||
|
||||
void mathlib_open (void);
|
||||
|
||||
#endif
|
||||
|
||||
143
opcode.h
143
opcode.h
@@ -1,143 +0,0 @@
|
||||
/*
|
||||
** TeCGraf - PUC-Rio
|
||||
** $Id: opcode.h,v 3.19 1996/03/06 13:11:23 roberto Exp $
|
||||
*/
|
||||
|
||||
#ifndef opcode_h
|
||||
#define opcode_h
|
||||
|
||||
#include "lua.h"
|
||||
#include "types.h"
|
||||
#include "tree.h"
|
||||
#include "func.h"
|
||||
|
||||
|
||||
#define FIELDS_PER_FLUSH 40
|
||||
|
||||
|
||||
typedef enum
|
||||
{
|
||||
PUSHNIL,
|
||||
PUSH0, PUSH1, PUSH2,
|
||||
PUSHBYTE,
|
||||
PUSHWORD,
|
||||
PUSHFLOAT,
|
||||
PUSHSTRING,
|
||||
PUSHFUNCTION,
|
||||
PUSHLOCAL0, PUSHLOCAL1, PUSHLOCAL2, PUSHLOCAL3, PUSHLOCAL4,
|
||||
PUSHLOCAL5, PUSHLOCAL6, PUSHLOCAL7, PUSHLOCAL8, PUSHLOCAL9,
|
||||
PUSHLOCAL,
|
||||
PUSHGLOBAL,
|
||||
PUSHINDEXED,
|
||||
PUSHSELF,
|
||||
STORELOCAL0, STORELOCAL1, STORELOCAL2, STORELOCAL3, STORELOCAL4,
|
||||
STORELOCAL5, STORELOCAL6, STORELOCAL7, STORELOCAL8, STORELOCAL9,
|
||||
STORELOCAL,
|
||||
STOREGLOBAL,
|
||||
STOREINDEXED0,
|
||||
STOREINDEXED,
|
||||
STORELIST0,
|
||||
STORELIST,
|
||||
STORERECORD,
|
||||
ADJUST0,
|
||||
ADJUST,
|
||||
CREATEARRAY,
|
||||
EQOP,
|
||||
LTOP,
|
||||
LEOP,
|
||||
GTOP,
|
||||
GEOP,
|
||||
ADDOP,
|
||||
SUBOP,
|
||||
MULTOP,
|
||||
DIVOP,
|
||||
POWOP,
|
||||
CONCOP,
|
||||
MINUSOP,
|
||||
NOTOP,
|
||||
ONTJMP,
|
||||
ONFJMP,
|
||||
JMP,
|
||||
UPJMP,
|
||||
IFFJMP,
|
||||
IFFUPJMP,
|
||||
POP,
|
||||
CALLFUNC,
|
||||
RETCODE0,
|
||||
RETCODE,
|
||||
SETLINE
|
||||
} OpCode;
|
||||
|
||||
#define MULT_RET 255
|
||||
|
||||
|
||||
typedef union
|
||||
{
|
||||
lua_CFunction f;
|
||||
real n;
|
||||
TaggedString *ts;
|
||||
TFunc *tf;
|
||||
struct Hash *a;
|
||||
void *u;
|
||||
int i;
|
||||
} Value;
|
||||
|
||||
typedef struct Object
|
||||
{
|
||||
lua_Type tag;
|
||||
Value value;
|
||||
} Object;
|
||||
|
||||
|
||||
/* Macros to access structure members */
|
||||
#define tag(o) ((o)->tag)
|
||||
#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)
|
||||
#define uvalue(o) ((o)->value.u)
|
||||
|
||||
/* Macros to access symbol table */
|
||||
#define s_object(i) (lua_table[i].object)
|
||||
#define s_tag(i) (tag(&s_object(i)))
|
||||
#define s_nvalue(i) (nvalue(&s_object(i)))
|
||||
#define s_svalue(i) (svalue(&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)))
|
||||
|
||||
typedef union
|
||||
{
|
||||
struct {Byte c1; Byte c2;} m;
|
||||
Word w;
|
||||
} CodeWord;
|
||||
#define get_word(code,pc) {code.m.c1 = *pc++; code.m.c2 = *pc++;}
|
||||
|
||||
typedef union
|
||||
{
|
||||
struct {Byte c1; Byte c2; Byte c3; Byte c4;} m;
|
||||
float f;
|
||||
} CodeFloat;
|
||||
#define get_float(code,pc) {code.m.c1 = *pc++; code.m.c2 = *pc++;\
|
||||
code.m.c3 = *pc++; code.m.c4 = *pc++;}
|
||||
|
||||
typedef union
|
||||
{
|
||||
struct {Byte c1; Byte c2; Byte c3; Byte c4;} m;
|
||||
TFunc *tf;
|
||||
} CodeCode;
|
||||
#define get_code(code,pc) {code.m.c1 = *pc++; code.m.c2 = *pc++;\
|
||||
code.m.c3 = *pc++; code.m.c4 = *pc++;}
|
||||
|
||||
|
||||
/* 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)(Object *));
|
||||
Object *luaI_Address (lua_Object o);
|
||||
void luaI_pushobject (Object *o);
|
||||
void luaI_gcFB (Object *o);
|
||||
int luaI_dorun (TFunc *tf);
|
||||
|
||||
#endif
|
||||
264
strlib.c
264
strlib.c
@@ -1,264 +0,0 @@
|
||||
/*
|
||||
** strlib.c
|
||||
** String library to LUA
|
||||
*/
|
||||
|
||||
char *rcs_strlib="$Id: strlib.c,v 1.21 1996/03/21 22:18:08 roberto Exp roberto $";
|
||||
|
||||
#include <string.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <ctype.h>
|
||||
#include <limits.h>
|
||||
|
||||
#include "lua.h"
|
||||
#include "lualib.h"
|
||||
|
||||
|
||||
void lua_arg_error(char *funcname)
|
||||
{
|
||||
char buff[100];
|
||||
sprintf(buff, "incorrect arguments to function `%s'", funcname);
|
||||
lua_error(buff);
|
||||
}
|
||||
|
||||
char *lua_check_string (int numArg, char *funcname)
|
||||
{
|
||||
lua_Object o = lua_getparam(numArg);
|
||||
if (!lua_isstring(o))
|
||||
lua_arg_error(funcname);
|
||||
return lua_getstring(o);
|
||||
}
|
||||
|
||||
double lua_check_number (int numArg, char *funcname)
|
||||
{
|
||||
lua_Object o = lua_getparam(numArg);
|
||||
if (!lua_isnumber(o))
|
||||
lua_arg_error(funcname);
|
||||
return lua_getnumber(o);
|
||||
}
|
||||
|
||||
static int lua_opt_number (int numArg, int def, char *funcname)
|
||||
{
|
||||
return (lua_getparam(numArg) == LUA_NOOBJECT) ? def :
|
||||
(int)lua_check_number(numArg, funcname);
|
||||
}
|
||||
|
||||
char *luaI_addchar (int c)
|
||||
{
|
||||
static char *buff = NULL;
|
||||
static int max = 0;
|
||||
static int n = 0;
|
||||
if (n >= max)
|
||||
{
|
||||
if (max == 0)
|
||||
{
|
||||
max = 100;
|
||||
buff = (char *)malloc(max);
|
||||
}
|
||||
else
|
||||
{
|
||||
max *= 2;
|
||||
buff = (char *)realloc(buff, max);
|
||||
}
|
||||
if (buff == NULL)
|
||||
lua_error("memory overflow");
|
||||
}
|
||||
buff[n++] = c;
|
||||
if (c == 0)
|
||||
n = 0; /* prepare for next string */
|
||||
return buff;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Return the position of the first caracter of a substring into a string
|
||||
** LUA interface:
|
||||
** n = strfind (string, substring, init, end)
|
||||
*/
|
||||
static void str_find (void)
|
||||
{
|
||||
char *s1 = lua_check_string(1, "strfind");
|
||||
char *s2 = lua_check_string(2, "strfind");
|
||||
int init = lua_opt_number(3, 1, "strfind") - 1;
|
||||
char *f = (init>=0 && init<=strlen(s1)) ? strstr(s1+init,s2) : NULL;
|
||||
if (f != NULL)
|
||||
{
|
||||
int pos = f-s1+1;
|
||||
if (lua_opt_number(4, INT_MAX, "strfind") >= pos+strlen(s2)-1)
|
||||
lua_pushnumber (pos);
|
||||
else
|
||||
lua_pushnil();
|
||||
}
|
||||
else
|
||||
lua_pushnil();
|
||||
}
|
||||
|
||||
/*
|
||||
** Return the string length
|
||||
** LUA interface:
|
||||
** n = strlen (string)
|
||||
*/
|
||||
static void str_len (void)
|
||||
{
|
||||
char *s = lua_check_string(1, "strlen");
|
||||
lua_pushnumber(strlen(s));
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Return the substring of a string, from start to end
|
||||
** LUA interface:
|
||||
** substring = strsub (string, start, end)
|
||||
*/
|
||||
static void str_sub (void)
|
||||
{
|
||||
char *s = lua_check_string(1, "strsub");
|
||||
int start = (int)lua_check_number(2, "strsub");
|
||||
int end = lua_opt_number(3, strlen(s), "strsub");
|
||||
if (end < start || start < 1 || end > strlen(s))
|
||||
lua_pushliteral("");
|
||||
else
|
||||
{
|
||||
luaI_addchar(0);
|
||||
while (start <= end)
|
||||
luaI_addchar(s[start++ - 1]);
|
||||
lua_pushstring (luaI_addchar(0));
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
** Convert a string to lower case.
|
||||
** LUA interface:
|
||||
** lowercase = strlower (string)
|
||||
*/
|
||||
static void str_lower (void)
|
||||
{
|
||||
char *s = lua_check_string(1, "strlower");
|
||||
luaI_addchar(0);
|
||||
while (*s)
|
||||
luaI_addchar(tolower(*s++));
|
||||
lua_pushstring(luaI_addchar(0));
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Convert a string to upper case.
|
||||
** LUA interface:
|
||||
** uppercase = strupper (string)
|
||||
*/
|
||||
static void str_upper (void)
|
||||
{
|
||||
char *s = lua_check_string(1, "strupper");
|
||||
luaI_addchar(0);
|
||||
while (*s)
|
||||
luaI_addchar(toupper(*s++));
|
||||
lua_pushstring(luaI_addchar(0));
|
||||
}
|
||||
|
||||
/*
|
||||
** get ascii value of a character in a string
|
||||
*/
|
||||
static void str_ascii (void)
|
||||
{
|
||||
char *s = lua_check_string(1, "ascii");
|
||||
int pos = lua_opt_number(2, 1, "ascii") - 1;
|
||||
if (pos<0 || pos>=strlen(s))
|
||||
lua_arg_error("ascii");
|
||||
lua_pushnumber(s[pos]);
|
||||
}
|
||||
|
||||
void luaI_addquoted (char *s)
|
||||
{
|
||||
luaI_addchar('"');
|
||||
for (; *s; s++)
|
||||
{
|
||||
if (*s == '"' || *s == '\\' || *s == '\n')
|
||||
luaI_addchar('\\');
|
||||
luaI_addchar(*s);
|
||||
}
|
||||
luaI_addchar('"');
|
||||
}
|
||||
|
||||
#define MAX_CONVERTION 2000
|
||||
#define MAX_FORMAT 50
|
||||
|
||||
static void str_format (void)
|
||||
{
|
||||
int arg = 1;
|
||||
char *strfrmt = lua_check_string(arg++, "format");
|
||||
luaI_addchar(0); /* 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[MAX_CONVERTION]; /* store the formated value */
|
||||
int size = 0;
|
||||
int i = 0;
|
||||
form[i++] = '%';
|
||||
form[i] = *strfrmt++;
|
||||
while (!isalpha(form[i]))
|
||||
{
|
||||
if (isdigit(form[i]))
|
||||
{
|
||||
size = size*10 + form[i]-'0';
|
||||
if (size >= MAX_CONVERTION)
|
||||
lua_error("format size/precision too long in function `format'");
|
||||
}
|
||||
else if (form[i] == '.')
|
||||
size = 0; /* re-start */
|
||||
if (++i >= MAX_FORMAT)
|
||||
lua_error("bad format in function `format'");
|
||||
form[i] = *strfrmt++;
|
||||
}
|
||||
form[i+1] = 0; /* ends string */
|
||||
switch (form[i])
|
||||
{
|
||||
case 'q':
|
||||
luaI_addquoted(lua_check_string(arg++, "format"));
|
||||
buff[0] = '\0'; /* addchar already done */
|
||||
break;
|
||||
case 's':
|
||||
{
|
||||
char *s = lua_check_string(arg++, "format");
|
||||
if (strlen(s) >= MAX_CONVERTION)
|
||||
lua_error("string argument too long in function `format'");
|
||||
sprintf(buff, form, s);
|
||||
break;
|
||||
}
|
||||
case 'c': case 'd': case 'i': case 'o':
|
||||
case 'u': case 'x': case 'X':
|
||||
sprintf(buff, form, (int)lua_check_number(arg++, "format"));
|
||||
break;
|
||||
case 'e': case 'E': case 'f': case 'g':
|
||||
sprintf(buff, form, lua_check_number(arg++, "format"));
|
||||
break;
|
||||
default: /* also treat cases 'pnLlh' */
|
||||
lua_error("invalid format option in function `format'");
|
||||
}
|
||||
for (i=0; buff[i]; i++) /* move formated value to result */
|
||||
luaI_addchar(buff[i]);
|
||||
}
|
||||
}
|
||||
lua_pushstring(luaI_addchar(0)); /* push the result */
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Open string library
|
||||
*/
|
||||
void strlib_open (void)
|
||||
{
|
||||
lua_register ("strfind", str_find);
|
||||
lua_register ("strlen", str_len);
|
||||
lua_register ("strsub", str_sub);
|
||||
lua_register ("strlower", str_lower);
|
||||
lua_register ("strupper", str_upper);
|
||||
lua_register ("ascii", str_ascii);
|
||||
lua_register ("format", str_format);
|
||||
}
|
||||
13
strlib.h
13
strlib.h
@@ -1,13 +0,0 @@
|
||||
/*
|
||||
** String library to LUA
|
||||
** TeCGraf - PUC-Rio
|
||||
** $Id: $
|
||||
*/
|
||||
|
||||
|
||||
#ifndef strlib_h
|
||||
|
||||
void strlib_open (void);
|
||||
|
||||
#endif
|
||||
|
||||
266
table.c
266
table.c
@@ -1,266 +0,0 @@
|
||||
/*
|
||||
** table.c
|
||||
** Module to control static tables
|
||||
*/
|
||||
|
||||
char *rcs_table="$Id: table.c,v 2.50 1996/03/21 16:31:32 roberto Exp roberto $";
|
||||
|
||||
#include "mem.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 1024
|
||||
#define MIN_GARBAGE_BLOCK (GARBAGE_BLOCK/2)
|
||||
|
||||
static void lua_nextvar (void);
|
||||
|
||||
/*
|
||||
** Internal functions
|
||||
*/
|
||||
static struct {
|
||||
char *name;
|
||||
lua_CFunction func;
|
||||
} int_funcs[] = {
|
||||
{"assert", luaI_assert},
|
||||
{"dofile", lua_internaldofile},
|
||||
{"dostring", lua_internaldostring},
|
||||
{"error", luaI_error},
|
||||
{"getglobal", luaI_getglobal},
|
||||
{"next", lua_next},
|
||||
{"nextvar", lua_nextvar},
|
||||
{"print", luaI_print},
|
||||
{"setfallback", luaI_setfallback},
|
||||
{"setglobal", luaI_setglobal},
|
||||
{"tonumber", lua_obj2number},
|
||||
{"tostring", luaI_tostring},
|
||||
{"type", luaI_type}
|
||||
};
|
||||
|
||||
#define INTFUNCSIZE (sizeof(int_funcs)/sizeof(int_funcs[0]))
|
||||
|
||||
|
||||
void luaI_initsymbol (void)
|
||||
{
|
||||
int i;
|
||||
lua_maxsymbol = BUFFER_BLOCK;
|
||||
lua_table = newvector(lua_maxsymbol, Symbol);
|
||||
for (i=0; i<INTFUNCSIZE; i++)
|
||||
{
|
||||
Word n = luaI_findsymbolbyname(int_funcs[i].name);
|
||||
s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = int_funcs[i].func;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** 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->varindex == NOT_USED)
|
||||
{
|
||||
if (lua_ntable == lua_maxsymbol)
|
||||
lua_maxsymbol = growvector(&lua_table, lua_maxsymbol, Symbol,
|
||||
symbolEM, MAX_WORD);
|
||||
t->varindex = lua_ntable;
|
||||
lua_table[lua_ntable].varname = t;
|
||||
s_tag(lua_ntable) = LUA_T_NIL;
|
||||
lua_ntable++;
|
||||
}
|
||||
return t->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->constindex == NOT_USED)
|
||||
{
|
||||
if (lua_nconstant == lua_maxconstant)
|
||||
lua_maxconstant = growvector(&lua_constant, lua_maxconstant, TaggedString *,
|
||||
constantEM, MAX_WORD);
|
||||
t->constindex = lua_nconstant;
|
||||
lua_constant[lua_nconstant] = t;
|
||||
lua_nconstant++;
|
||||
}
|
||||
return t->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;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Traverse symbol table objects
|
||||
*/
|
||||
static char *lua_travsymbol (int (*fn)(Object *))
|
||||
{
|
||||
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 (Object *o)
|
||||
{/* if already marked, does not change mark value */
|
||||
if (tag(o) == LUA_T_STRING && !tsvalue(o)->marked)
|
||||
tsvalue(o)->marked = 1;
|
||||
else if (tag(o) == LUA_T_ARRAY)
|
||||
lua_hashmark (avalue(o));
|
||||
else if ((o->tag == LUA_T_FUNCTION || o->tag == LUA_T_MARK)
|
||||
&& !o->value.tf->marked)
|
||||
o->value.tf->marked = 1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Garbage collection.
|
||||
** Delete all unused strings and arrays.
|
||||
*/
|
||||
Long luaI_collectgarbage (void)
|
||||
{
|
||||
Long recovered = 0;
|
||||
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 */
|
||||
recovered += lua_strcollector();
|
||||
recovered += lua_hashcollector();
|
||||
recovered += luaI_funccollector();
|
||||
return recovered;
|
||||
}
|
||||
|
||||
void lua_pack (void)
|
||||
{
|
||||
static Long block = GARBAGE_BLOCK; /* when garbage collector will be called */
|
||||
static Long nentity = 0; /* counter of new entities (strings and arrays) */
|
||||
Long recovered = 0;
|
||||
if (nentity++ < block) return;
|
||||
recovered = luaI_collectgarbage();
|
||||
nentity = 0; /* reset counter */
|
||||
block=(16*block-7*recovered)/12; /* adapt block size */
|
||||
if (block < MIN_GARBAGE_BLOCK) block = MIN_GARBAGE_BLOCK;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Internal function: return next global variable
|
||||
*/
|
||||
static void lua_nextvar (void)
|
||||
{
|
||||
Word next;
|
||||
lua_Object o = lua_getparam(1);
|
||||
if (o == LUA_NOOBJECT)
|
||||
lua_error("too few arguments to function `nextvar'");
|
||||
if (lua_getparam(2) != LUA_NOOBJECT)
|
||||
lua_error("too many arguments to function `nextvar'");
|
||||
if (lua_isnil(o))
|
||||
next = 0;
|
||||
else if (!lua_isstring(o))
|
||||
{
|
||||
lua_error("incorrect argument to function `nextvar'");
|
||||
return; /* to avoid warnings */
|
||||
}
|
||||
else
|
||||
next = luaI_findsymbolbyname(lua_getstring(o)) + 1;
|
||||
while (next < lua_ntable && s_tag(next) == LUA_T_NIL) next++;
|
||||
if (next >= lua_ntable)
|
||||
{
|
||||
lua_pushnil();
|
||||
lua_pushnil();
|
||||
}
|
||||
else
|
||||
{
|
||||
TaggedString *t = lua_table[next].varname;
|
||||
Object name;
|
||||
tag(&name) = LUA_T_STRING;
|
||||
tsvalue(&name) = t;
|
||||
luaI_pushobject(&name);
|
||||
luaI_pushobject(&s_object(next));
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static Object *functofind;
|
||||
static int checkfunc (Object *o)
|
||||
{
|
||||
if (o->tag == LUA_T_FUNCTION)
|
||||
return
|
||||
((functofind->tag == LUA_T_FUNCTION || functofind->tag == LUA_T_MARK)
|
||||
&& (functofind->value.tf == o->value.tf));
|
||||
if (o->tag == LUA_T_CFUNCTION)
|
||||
return
|
||||
((functofind->tag == LUA_T_CFUNCTION || functofind->tag == 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 "fallback";
|
||||
else if ((*name = lua_travsymbol(checkfunc)) != NULL)
|
||||
return "global";
|
||||
else return "";
|
||||
}
|
||||
|
||||
37
table.h
37
table.h
@@ -1,37 +0,0 @@
|
||||
/*
|
||||
** Module to control static tables
|
||||
** TeCGraf - PUC-Rio
|
||||
** $Id: table.h,v 2.19 1996/02/26 21:00:27 roberto Exp roberto $
|
||||
*/
|
||||
|
||||
#ifndef table_h
|
||||
#define table_h
|
||||
|
||||
#include "tree.h"
|
||||
#include "opcode.h"
|
||||
|
||||
typedef struct
|
||||
{
|
||||
Object 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);
|
||||
TaggedString *luaI_createfixedstring (char *str);
|
||||
int lua_markobject (Object *o);
|
||||
Long luaI_collectgarbage (void);
|
||||
void lua_pack (void);
|
||||
|
||||
|
||||
#endif
|
||||
145
tree.c
145
tree.c
@@ -1,145 +0,0 @@
|
||||
/*
|
||||
** tree.c
|
||||
** TecCGraf - PUC-Rio
|
||||
*/
|
||||
|
||||
char *rcs_tree="$Id: tree.c,v 1.19 1996/02/22 20:34:33 roberto Exp $";
|
||||
|
||||
|
||||
#include <string.h>
|
||||
|
||||
#include "mem.h"
|
||||
#include "lua.h"
|
||||
#include "tree.h"
|
||||
#include "lex.h"
|
||||
#include "hash.h"
|
||||
#include "table.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 = {NOT_USED, NOT_USED, 0, 2, {0}};
|
||||
|
||||
|
||||
static unsigned long hash (char *str)
|
||||
{
|
||||
unsigned long h = 0;
|
||||
while (*str)
|
||||
h = ((h<<5)-h)^(unsigned char)*(str++);
|
||||
return h;
|
||||
}
|
||||
|
||||
static void initialize (void)
|
||||
{
|
||||
initialized = 1;
|
||||
luaI_addReserved();
|
||||
luaI_initsymbol();
|
||||
luaI_initconstant();
|
||||
}
|
||||
|
||||
|
||||
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 *insert (char *str, stringtable *tb)
|
||||
{
|
||||
TaggedString *ts;
|
||||
unsigned long h = hash(str);
|
||||
int i;
|
||||
int j = -1;
|
||||
if ((Long)tb->nuse*3 >= (Long)tb->size*2)
|
||||
{
|
||||
if (!initialized)
|
||||
initialize();
|
||||
grow(tb);
|
||||
}
|
||||
i = h%tb->size;
|
||||
while (tb->hash[i])
|
||||
{
|
||||
if (tb->hash[i] == &EMPTY)
|
||||
j = i;
|
||||
else if (strcmp(str, tb->hash[i]->str) == 0)
|
||||
return tb->hash[i];
|
||||
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] = (TaggedString *)luaI_malloc(sizeof(TaggedString)+strlen(str));
|
||||
strcpy(ts->str, str);
|
||||
ts->marked = 0;
|
||||
ts->hash = h;
|
||||
ts->varindex = ts->constindex = NOT_USED;
|
||||
return ts;
|
||||
}
|
||||
|
||||
TaggedString *lua_createstring (char *str)
|
||||
{
|
||||
return insert(str, &string_root[(unsigned)str[0]%NUM_HASHS]);
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Garbage collection function.
|
||||
** This function traverse the string list freeing unindexed strings
|
||||
*/
|
||||
Long lua_strcollector (void)
|
||||
{
|
||||
Long counter = 0;
|
||||
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
|
||||
{
|
||||
luaI_free(t);
|
||||
tb->hash[j] = &EMPTY;
|
||||
counter++;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
return counter;
|
||||
}
|
||||
|
||||
28
tree.h
28
tree.h
@@ -1,28 +0,0 @@
|
||||
/*
|
||||
** tree.h
|
||||
** TecCGraf - PUC-Rio
|
||||
** $Id: tree.h,v 1.13 1996/02/14 13:35:51 roberto Exp roberto $
|
||||
*/
|
||||
|
||||
#ifndef tree_h
|
||||
#define tree_h
|
||||
|
||||
#include "types.h"
|
||||
|
||||
#define NOT_USED 0xFFFE
|
||||
|
||||
|
||||
typedef struct TaggedString
|
||||
{
|
||||
Word varindex; /* != NOT_USED if this is a symbol */
|
||||
Word constindex; /* != NOT_USED if this is a constant */
|
||||
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);
|
||||
Long lua_strcollector (void);
|
||||
|
||||
#endif
|
||||
29
types.h
29
types.h
@@ -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
|
||||
326
undump.c
326
undump.c
@@ -1,326 +0,0 @@
|
||||
/*
|
||||
** undump.c
|
||||
** load bytecodes from files
|
||||
*/
|
||||
|
||||
char* rcs_undump="$Id: undump.c,v 1.13 1996/03/12 20:00:40 lhf Exp lhf $";
|
||||
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
#include "opcode.h"
|
||||
#include "mem.h"
|
||||
#include "table.h"
|
||||
#include "undump.h"
|
||||
|
||||
static int swapword=0;
|
||||
static int swapfloat=0;
|
||||
static TFunc* Main=NULL; /* functions in a chunk */
|
||||
static TFunc* lastF=NULL;
|
||||
|
||||
static void warn(char* s) /* TODO: remove */
|
||||
{
|
||||
#if 0
|
||||
fprintf(stderr,"undump: %s\n",s);
|
||||
#endif
|
||||
}
|
||||
|
||||
static void FixCode(Byte* code, Byte* end) /* swap words */
|
||||
{
|
||||
Byte* p;
|
||||
for (p=code; p!=end;)
|
||||
{
|
||||
OpCode op=(OpCode)*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:
|
||||
p+=2;
|
||||
break;
|
||||
case STORELIST:
|
||||
case CALLFUNC:
|
||||
p+=3;
|
||||
break;
|
||||
case PUSHFUNCTION:
|
||||
p+=5;
|
||||
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:
|
||||
{
|
||||
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:
|
||||
lua_error("corrupt binary file");
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
static void Unthread(Byte* code, int i, int v)
|
||||
{
|
||||
while (i!=0)
|
||||
{
|
||||
CodeWord c;
|
||||
Byte* p=code+i;
|
||||
get_word(c,p);
|
||||
i=c.w;
|
||||
c.w=v;
|
||||
p[-2]=c.m.c1;
|
||||
p[-1]=c.m.c2;
|
||||
}
|
||||
}
|
||||
|
||||
static int LoadWord(FILE* D)
|
||||
{
|
||||
Word w;
|
||||
fread(&w,sizeof(w),1,D);
|
||||
if (swapword)
|
||||
{
|
||||
Byte* p=(Byte*)&w; /* TODO: need union? */
|
||||
Byte t;
|
||||
t=p[0]; p[0]=p[1]; p[1]=t;
|
||||
}
|
||||
return w;
|
||||
}
|
||||
|
||||
static int LoadSize(FILE* D)
|
||||
{
|
||||
Word hi=LoadWord(D);
|
||||
Word lo=LoadWord(D);
|
||||
int s=(hi<<16)|lo;
|
||||
if ((Word)s != s) lua_error("code too long");
|
||||
return s;
|
||||
}
|
||||
|
||||
static char* LoadBlock(int size, FILE* D)
|
||||
{
|
||||
char* b=luaI_malloc(size);
|
||||
fread(b,size,1,D);
|
||||
return b;
|
||||
}
|
||||
|
||||
static char* LoadString(FILE* D)
|
||||
{
|
||||
int size=LoadWord(D);
|
||||
char *b=luaI_buffer(size);
|
||||
fread(b,size,1,D);
|
||||
return b;
|
||||
}
|
||||
|
||||
static char* LoadNewString(FILE* D)
|
||||
{
|
||||
return LoadBlock(LoadWord(D),D);
|
||||
}
|
||||
|
||||
static void LoadFunction(FILE* D)
|
||||
{
|
||||
TFunc* tf=new(TFunc);
|
||||
tf->next=NULL;
|
||||
tf->locvars=NULL;
|
||||
tf->size=LoadSize(D);
|
||||
tf->lineDefined=LoadWord(D);
|
||||
if (IsMain(tf)) /* new main */
|
||||
{
|
||||
tf->fileName=LoadNewString(D);
|
||||
Main=lastF=tf;
|
||||
}
|
||||
else /* fix PUSHFUNCTION */
|
||||
{
|
||||
CodeCode c;
|
||||
Byte* p;
|
||||
tf->marked=LoadWord(D);
|
||||
tf->fileName=Main->fileName;
|
||||
p=Main->code+tf->marked;
|
||||
c.tf=tf;
|
||||
*p++=c.m.c1; *p++=c.m.c2; *p++=c.m.c3; *p++=c.m.c4;
|
||||
lastF=lastF->next=tf;
|
||||
}
|
||||
tf->code=LoadBlock(tf->size,D);
|
||||
if (swapword || swapfloat) FixCode(tf->code,tf->code+tf->size);
|
||||
while (1) /* unthread */
|
||||
{
|
||||
int c=getc(D);
|
||||
if (c==ID_VAR) /* global var */
|
||||
{
|
||||
int i=LoadWord(D);
|
||||
char* s=LoadString(D);
|
||||
int v=luaI_findsymbolbyname(s);
|
||||
Unthread(tf->code,i,v);
|
||||
}
|
||||
else if (c==ID_STR) /* constant string */
|
||||
{
|
||||
int i=LoadWord(D);
|
||||
char* s=LoadString(D);
|
||||
int v=luaI_findconstantbyname(s);
|
||||
Unthread(tf->code,i,v);
|
||||
}
|
||||
else
|
||||
{
|
||||
ungetc(c,D);
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
static void LoadSignature(FILE* D)
|
||||
{
|
||||
char* s=SIGNATURE;
|
||||
while (*s!=0 && getc(D)==*s)
|
||||
++s;
|
||||
if (*s!=0) lua_error("bad signature");
|
||||
}
|
||||
|
||||
static void LoadHeader(FILE* D) /* TODO: error handling */
|
||||
{
|
||||
Word w,tw=TEST_WORD;
|
||||
float f,tf=TEST_FLOAT;
|
||||
LoadSignature(D);
|
||||
getc(D); /* skip version */
|
||||
fread(&w,sizeof(w),1,D); /* test word */
|
||||
if (w!=tw)
|
||||
{
|
||||
swapword=1;
|
||||
warn("different byte order");
|
||||
}
|
||||
fread(&f,sizeof(f),1,D); /* test float */
|
||||
if (f!=tf)
|
||||
{
|
||||
Byte* p=(Byte*)&f; /* TODO: need union? */
|
||||
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("different float representation");
|
||||
else
|
||||
warn("different byte order in floats");
|
||||
}
|
||||
}
|
||||
|
||||
static void LoadChunk(FILE* D)
|
||||
{
|
||||
LoadHeader(D);
|
||||
while (1)
|
||||
{
|
||||
int c=getc(D);
|
||||
if (c==ID_FUN) LoadFunction(D); else { ungetc(c,D); break; }
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
** load one chunk from a file.
|
||||
** return list of functions found, headed by main, or NULL at EOF.
|
||||
*/
|
||||
TFunc* luaI_undump1(FILE* D)
|
||||
{
|
||||
while (1)
|
||||
{
|
||||
int c=getc(D);
|
||||
if (c==ID_CHUNK)
|
||||
{
|
||||
LoadChunk(D);
|
||||
return Main;
|
||||
}
|
||||
else if (c==EOF)
|
||||
return NULL;
|
||||
else
|
||||
lua_error("not a lua binary file");
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
** load and run all chunks in a file
|
||||
*/
|
||||
int luaI_undump(FILE* D)
|
||||
{
|
||||
TFunc* m;
|
||||
while ((m=luaI_undump1(D)))
|
||||
{
|
||||
int status=luaI_dorun(m);
|
||||
luaI_freefunc(m);
|
||||
if (status!=0) return status;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
23
undump.h
23
undump.h
@@ -1,23 +0,0 @@
|
||||
/*
|
||||
** undump.h
|
||||
** definitions for lua decompiler
|
||||
** $Id: undump.h,v 1.1 1996/03/08 21:43:21 lhf Exp lhf $
|
||||
*/
|
||||
|
||||
#include "func.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 0x23 /* 2.3 */
|
||||
#define TEST_WORD 0x1234 /* a word for testing byte ordering */
|
||||
#define TEST_FLOAT 0.123456789e-23 /* a float for testing representation */
|
||||
|
||||
TFunc* luaI_undump1(FILE* D); /* load one chunk */
|
||||
int luaI_undump(FILE* D); /* load all chunks */
|
||||
Reference in New Issue
Block a user