mirror of
https://github.com/lua/lua.git
synced 2026-07-27 00:19:07 +00:00
Compare commits
1 Commits
v4.1-alpha
...
v1.0
| Author | SHA1 | Date | |
|---|---|---|---|
|
b9dde086db |
29
Makefile
Normal file
29
Makefile
Normal file
@@ -0,0 +1,29 @@
|
||||
OBJS= hash.o inout.o lex_yy.o opcode.o table.o y_tab.o lua.o iolib.o mathlib.o strlib.o
|
||||
|
||||
CFLAGS= -O2 -I.
|
||||
|
||||
T= lua
|
||||
|
||||
all: $T
|
||||
|
||||
$T: $(OBJS)
|
||||
$(CC) -o $@ $(OBJS) -lm
|
||||
|
||||
A=--------------------------------------------------------------------------
|
||||
test: $T
|
||||
@echo "$A"
|
||||
./$T sort.lua main
|
||||
@echo "$A"
|
||||
./$T globals.lua | sort | column
|
||||
@echo "$A"
|
||||
./$T array.lua
|
||||
@echo "$A"
|
||||
./$T save.lua
|
||||
@echo "$A"
|
||||
./$T test.lua retorno_multiplo norma
|
||||
|
||||
clean:
|
||||
rm -f $T $(OBJS) core core.*
|
||||
|
||||
diff:
|
||||
diff . fixed | grep -v ^Only
|
||||
22
README
Normal file
22
README
Normal file
@@ -0,0 +1,22 @@
|
||||
This is Lua 1.0. It was never publicly released. This code is a snapshot of
|
||||
the status of Lua on 28 Jul 1993. It is distributed for historical curiosity
|
||||
to celebrate 10 years of Lua and is hereby placed in the public domain.
|
||||
|
||||
There is no documentation, except the test programs. The manual for Lua 1.1
|
||||
probably works for this version as well.
|
||||
|
||||
The source files for the lexer and parser have been lost: all that is left is
|
||||
the output of lex and yacc. A grammar can be found inside y_tab.c in yyreds.
|
||||
|
||||
The code compiles and runs in RedHat 5.2 with gcc 2.7.2.3. It may not run in
|
||||
newer systems, because it assumes that stdin and stdout are constants, though
|
||||
ANSI C does not promise they are. If make fails, try using the fixed modules
|
||||
provided in the "fixed" directory. To see the differences (which are really
|
||||
quite minor), do "make diff".
|
||||
|
||||
To see Lua 1.0 in action, do "make test". (The last test raises an error on
|
||||
purpose.)
|
||||
|
||||
Enjoy!
|
||||
|
||||
-- The Lua team, lua@tecgraf.puc-rio.br
|
||||
15
array.lua
Normal file
15
array.lua
Normal file
@@ -0,0 +1,15 @@
|
||||
$debug
|
||||
|
||||
a = @()
|
||||
|
||||
i=0
|
||||
while i<10 do
|
||||
a[i] = i*i
|
||||
i=i+1
|
||||
end
|
||||
|
||||
r,v = next(a,nil)
|
||||
while r ~= nil do
|
||||
print ("array["..r.."] = "..v)
|
||||
r,v = next(a,r)
|
||||
end
|
||||
272
bugs
272
bugs
@@ -1,272 +0,0 @@
|
||||
|
||||
** 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
|
||||
(by lhf)
|
||||
|
||||
** 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 "empty" 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.
|
||||
|
||||
|
||||
|
||||
=================================================================
|
||||
--- Version 3.1
|
||||
|
||||
** liolib.c / lauxlib.c
|
||||
Mon Sep 7 15:57:02 EST 1998
|
||||
>> function "luaL_argerror" prints wrong argument number (from a user's point
|
||||
of view) when functions have upvalues.
|
||||
|
||||
** lstrlib.c
|
||||
Tue Nov 10 17:29:36 EDT 1998
|
||||
>> gsub/strfind do not check whether captures are properly finished.
|
||||
(by roberto/tomas)
|
||||
|
||||
** lbuiltin.c
|
||||
Fri Dec 18 11:22:55 EDT 1998
|
||||
>> "tonumber" goes crazy with negative numbers in other bases (not 10),
|
||||
because "strtol" returns long, not unsigned long.
|
||||
(by Visual C++)
|
||||
|
||||
** lstrlib.c
|
||||
Mon Jan 4 10:41:40 EDT 1999
|
||||
>> "format" does not check size of format item (such as "%00000...00000d").
|
||||
|
||||
** lapi.c
|
||||
Wed Feb 3 14:40:21 EDT 1999
|
||||
>> getlocal cannot return the local itself, since lua_isstring and
|
||||
lua_isnumber can modify it.
|
||||
|
||||
** lstrlib.c
|
||||
Thu Feb 4 17:08:50 EDT 1999
|
||||
>> format "%s" may break limit of "sprintf" on some machines.
|
||||
(by Marcelo Sales)
|
||||
|
||||
** lzio.c
|
||||
Thu Mar 4 11:49:37 EST 1999
|
||||
>> file stream cannot call fread after EOF.
|
||||
(by lhf)
|
||||
|
||||
|
||||
|
||||
=================================================================
|
||||
--- Version 3.2 (beta)
|
||||
|
||||
** lstrlib.c
|
||||
Fri Apr 30 11:10:20 EST 1999
|
||||
>> '$' at end of pattern was matching regular '$', too.
|
||||
(by anna; since 2.5)
|
||||
|
||||
** lbuiltin.c
|
||||
Fri May 21 17:15:11 EST 1999
|
||||
>> foreach, foreachi, foreachvar points to function in stack when stack
|
||||
can be reallocated.
|
||||
(by tomas; since 3.2 beta)
|
||||
|
||||
** lparser.c
|
||||
Wed Jun 16 10:32:46 EST 1999
|
||||
>> cannot assign to unlimited variables, because it causes overflow in
|
||||
the number of returns of a function.
|
||||
(since 3.1)
|
||||
|
||||
|
||||
|
||||
=================================================================
|
||||
--- Version 3.2
|
||||
|
||||
** lmathlib.c
|
||||
Wed Aug 18 11:28:38 EST 1999
|
||||
>> random(0) and random(x,0) are wrong (0 is read as no argument!).
|
||||
(by Dave Bollinger; since 3.1)
|
||||
|
||||
** lparser.c
|
||||
Thu Sep 2 10:07:20 EST 1999
|
||||
>> in the (old) expression << ls->fs->f->consts[checkname(ls)] >>, checkname
|
||||
could realloc f->consts.
|
||||
(by Supratik Champati; since 3.2 beta)
|
||||
|
||||
** lobject.c / lbuiltin.c
|
||||
Wed Sep 8 17:41:54 EST 1999
|
||||
>> tonumber'e1' and tonumber(' ', x), for x!=10, gave 0 instead of nil.
|
||||
(since 3.1)
|
||||
|
||||
** lstrlib.c
|
||||
Thu Nov 11 14:36:30 EDT 1999
|
||||
>> `strfind' does not handle \0 in plain search.
|
||||
(by Jon Kleiser; since 3.1)
|
||||
|
||||
** lparser.c
|
||||
Wed Dec 29 16:05:43 EDT 1999
|
||||
>> return gives wrong line in debug information
|
||||
(by lhf; since 3.2 [at least])
|
||||
|
||||
** ldo.c
|
||||
Thu Dec 30 16:39:33 EDT 1999
|
||||
>> cannot reopen stdin (for binary mode)
|
||||
(by lhf & roberto; since 3.1)
|
||||
|
||||
** lapi.c
|
||||
Thu Mar 2 09:41:53 EST 2000
|
||||
>> lua_settable should check stack space (it could call a T.M.)
|
||||
(by lhf & celes; since 3.2; it was already fixed by fixed stack)
|
||||
|
||||
** lparser.c
|
||||
Mon Apr 3 09:59:06 EST 2000
|
||||
>> '%' should be in expfollow
|
||||
(by Edgar Toernig; since 3.1; it was already fixed)
|
||||
|
||||
** lbuiltin.c
|
||||
Mon Apr 3 10:05:05 EST 2000
|
||||
>> tostring() without arguments gives seg. fault.
|
||||
(by Edgar Toernig; since 3.0)
|
||||
|
||||
|
||||
|
||||
=================================================================
|
||||
--- Version 4.0 alpha
|
||||
|
||||
Tested with full test suites (as locked in Mon Apr 24 14:23:11 EST 2000)
|
||||
in the following platforms:
|
||||
* Linux - gcc, g++
|
||||
* AIX - gcc
|
||||
* Solaris - gcc, cc
|
||||
* IRIX - cc, cc-purify
|
||||
* Windows - Visual C++ (.c e .cpp, warning level=4)
|
||||
|
||||
|
||||
** lstrlib.c
|
||||
Tue May 2 15:27:58 EST 2000
|
||||
>> `strfind' gets wrong subject length when there is an offset
|
||||
(by Jon Kleiser; since 4.0a)
|
||||
|
||||
** lparser.c
|
||||
Fri May 12 15:11:12 EST 2000
|
||||
>> first element in a list constructor is not adjusted to one value
|
||||
>> (e.g. «a = {gsub('a','a','')}»)
|
||||
(by Tomas; since 4.0a)
|
||||
|
||||
** lparser.c
|
||||
Wed May 24 14:50:16 EST 2000
|
||||
>> record-constructor starting with an upvalue name gets an error
|
||||
>> (e.g. «local a; function f() x = {a=1} end»)
|
||||
(by Edgar Toernig; since 3.1)
|
||||
|
||||
** lparser.c
|
||||
Tue Aug 29 15:56:05 EST 2000
|
||||
>> error message for `for' uses `while'
|
||||
(since 4.0a; already corrected)
|
||||
|
||||
** lgc.c
|
||||
Tue Aug 29 15:57:41 EST 2000
|
||||
>> gc tag method for nil could call line hook
|
||||
(by ry; since ?)
|
||||
|
||||
|
||||
|
||||
=================================================================
|
||||
--- Version 4.0 Beta
|
||||
|
||||
** liolib.c
|
||||
Fri Sep 22 15:12:37 EST 2000
|
||||
>> `read("*w")' should return nil at EOF
|
||||
(by roberto; since 4.0b)
|
||||
|
||||
** lvm.c
|
||||
Mon Sep 25 11:47:48 EST 2000
|
||||
>> lua_gettable does not get key from stack top
|
||||
(by Philip Yi; since 4.0b)
|
||||
|
||||
** lgc.c
|
||||
Mon Sep 25 11:50:48 EST 2000
|
||||
>> GC may crash when checking locked C closures
|
||||
(by Philip Yi; since 4.0b)
|
||||
|
||||
** lapi.c
|
||||
Wed Sep 27 09:50:19 EST 2000
|
||||
>> lua_tag should return LUA_NOTAG for non-valid indices
|
||||
(by Paul Hankin; since 4.0b)
|
||||
|
||||
** llex.h / llex.c / lparser.c
|
||||
Wed Sep 27 13:39:45 EST 2000
|
||||
>> parser overwrites semantic information when looking ahead
|
||||
>> (e.g. «a = {print'foo'}»)
|
||||
(by Edgar Toernig; since 4.0b, deriving from previous bug)
|
||||
|
||||
** liolib.c
|
||||
Thu Oct 26 10:50:46 EDT 2000
|
||||
>> in function `read_file', realloc() doesn't free the buffer if it can't
|
||||
>> allocate new memory
|
||||
(by Mauro Vezzosi; since 4.0b)
|
||||
|
||||
|
||||
|
||||
=================================================================
|
||||
--- Version 4.0
|
||||
|
||||
** lparser.c
|
||||
Wed Nov 29 09:51:44 EDT 2000
|
||||
>> parser does not accept a `;' after a `return'
|
||||
(by lhf; since 4.0b)
|
||||
|
||||
** liolib.c
|
||||
Fri Dec 22 15:30:42 EDT 2000
|
||||
>> when `read' fails it must return nil (and not no value)
|
||||
(by cassino; since at least 3.1)
|
||||
|
||||
** lstring.c/lapi.c
|
||||
Thu Feb 1 11:55:45 EDT 2001
|
||||
>> lua_pushuserdata(L, NULL) is buggy
|
||||
(by Edgar Toernig; since 4.0)
|
||||
|
||||
** ldo.c
|
||||
Fri Feb 2 14:06:40 EDT 2001
|
||||
>> «while 1 dostring[[print('hello\n')]] end» never reclaims memory
|
||||
(by Andrew Paton; since 4.0b)
|
||||
|
||||
** lbaselib.c
|
||||
Tue Feb 6 11:57:13 EDT 2001
|
||||
>> ESC (which starts precompiled code) in C is \33, not \27
|
||||
(by Edgar Toernig and lhf; since 4.0b)
|
||||
|
||||
** lparser.c
|
||||
Tue Jul 10 16:59:18 EST 2001
|
||||
>> error message for `%a' gave wrong line number
|
||||
(by Leonardo Constantino; since 4.0)
|
||||
|
||||
402
fixed/iolib.c
Normal file
402
fixed/iolib.c
Normal file
@@ -0,0 +1,402 @@
|
||||
/*
|
||||
** iolib.c
|
||||
** Input/output library to LUA
|
||||
**
|
||||
** Waldemar Celes Filho
|
||||
** TeCGraf - PUC-Rio
|
||||
** 19 May 93
|
||||
*/
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <stdio.h>
|
||||
#include <ctype.h>
|
||||
#ifdef __GNUC__
|
||||
#include <floatingpoint.h>
|
||||
#endif
|
||||
|
||||
#include "lua.h"
|
||||
|
||||
static FILE *in=NULL, *out=NULL;
|
||||
|
||||
/*
|
||||
** Open a file to read.
|
||||
** LUA interface:
|
||||
** status = readfrom (filename)
|
||||
** where:
|
||||
** status = 1 -> success
|
||||
** status = 0 -> error
|
||||
*/
|
||||
static void io_readfrom (void)
|
||||
{
|
||||
lua_Object o = lua_getparam (1);
|
||||
if (o == NULL) /* restore standart input */
|
||||
{
|
||||
if (in != stdin)
|
||||
{
|
||||
fclose (in);
|
||||
in = stdin;
|
||||
}
|
||||
lua_pushnumber (1);
|
||||
}
|
||||
else
|
||||
{
|
||||
if (!lua_isstring (o))
|
||||
{
|
||||
lua_error ("incorrect argument to function 'readfrom`");
|
||||
lua_pushnumber (0);
|
||||
}
|
||||
else
|
||||
{
|
||||
FILE *fp = fopen (lua_getstring(o),"r");
|
||||
if (fp == NULL)
|
||||
{
|
||||
lua_pushnumber (0);
|
||||
}
|
||||
else
|
||||
{
|
||||
if (in != stdin) fclose (in);
|
||||
in = fp;
|
||||
lua_pushnumber (1);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Open a file to write.
|
||||
** LUA interface:
|
||||
** status = writeto (filename)
|
||||
** where:
|
||||
** status = 1 -> success
|
||||
** status = 0 -> error
|
||||
*/
|
||||
static void io_writeto (void)
|
||||
{
|
||||
lua_Object o = lua_getparam (1);
|
||||
if (o == NULL) /* restore standart output */
|
||||
{
|
||||
if (out != stdout)
|
||||
{
|
||||
fclose (out);
|
||||
out = stdout;
|
||||
}
|
||||
lua_pushnumber (1);
|
||||
}
|
||||
else
|
||||
{
|
||||
if (!lua_isstring (o))
|
||||
{
|
||||
lua_error ("incorrect argument to function 'writeto`");
|
||||
lua_pushnumber (0);
|
||||
}
|
||||
else
|
||||
{
|
||||
FILE *fp = fopen (lua_getstring(o),"w");
|
||||
if (fp == NULL)
|
||||
{
|
||||
lua_pushnumber (0);
|
||||
}
|
||||
else
|
||||
{
|
||||
if (out != stdout) fclose (out);
|
||||
out = fp;
|
||||
lua_pushnumber (1);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** 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 void io_read (void)
|
||||
{
|
||||
lua_Object o = lua_getparam (1);
|
||||
if (o == NULL) /* free format */
|
||||
{
|
||||
int c;
|
||||
char s[256];
|
||||
while (isspace(c=fgetc(in)))
|
||||
;
|
||||
if (c == '\"')
|
||||
{
|
||||
if (fscanf (in, "%[^\"]\"", s) != 1)
|
||||
{
|
||||
lua_pushnil ();
|
||||
return;
|
||||
}
|
||||
}
|
||||
else if (c == '\'')
|
||||
{
|
||||
if (fscanf (in, "%[^\']\'", s) != 1)
|
||||
{
|
||||
lua_pushnil ();
|
||||
return;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
char *ptr;
|
||||
double d;
|
||||
ungetc (c, in);
|
||||
if (fscanf (in, "%s", s) != 1)
|
||||
{
|
||||
lua_pushnil ();
|
||||
return;
|
||||
}
|
||||
d = strtod (s, &ptr);
|
||||
if (!(*ptr))
|
||||
{
|
||||
lua_pushnumber (d);
|
||||
return;
|
||||
}
|
||||
}
|
||||
lua_pushstring (s);
|
||||
return;
|
||||
}
|
||||
else /* formatted */
|
||||
{
|
||||
char *e = lua_getstring(o);
|
||||
char t;
|
||||
int m=0;
|
||||
while (isspace(*e)) e++;
|
||||
t = *e++;
|
||||
while (isdigit(*e))
|
||||
m = m*10 + (*e++ - '0');
|
||||
|
||||
if (m > 0)
|
||||
{
|
||||
char f[80];
|
||||
char s[256];
|
||||
sprintf (f, "%%%ds", m);
|
||||
fscanf (in, f, s);
|
||||
switch (tolower(t))
|
||||
{
|
||||
case 'i':
|
||||
{
|
||||
long int l;
|
||||
sscanf (s, "%ld", &l);
|
||||
lua_pushnumber(l);
|
||||
}
|
||||
break;
|
||||
case 'f': case 'g': case 'e':
|
||||
{
|
||||
float f;
|
||||
sscanf (s, "%f", &f);
|
||||
lua_pushnumber(f);
|
||||
}
|
||||
break;
|
||||
default:
|
||||
lua_pushstring(s);
|
||||
break;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
switch (tolower(t))
|
||||
{
|
||||
case 'i':
|
||||
{
|
||||
long int l;
|
||||
fscanf (in, "%ld", &l);
|
||||
lua_pushnumber(l);
|
||||
}
|
||||
break;
|
||||
case 'f': case 'g': case 'e':
|
||||
{
|
||||
float f;
|
||||
fscanf (in, "%f", &f);
|
||||
lua_pushnumber(f);
|
||||
}
|
||||
break;
|
||||
default:
|
||||
{
|
||||
char s[256];
|
||||
fscanf (in, "%s", s);
|
||||
lua_pushstring(s);
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** 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 char *buildformat (char *e, lua_Object o)
|
||||
{
|
||||
static char buffer[512];
|
||||
static char f[80];
|
||||
char *string = &buffer[255];
|
||||
char t, j='r';
|
||||
int m=0, n=0, l;
|
||||
while (isspace(*e)) e++;
|
||||
t = *e++;
|
||||
if (*e == '<' || *e == '|' || *e == '>') j = *e++;
|
||||
while (isdigit(*e))
|
||||
m = m*10 + (*e++ - '0');
|
||||
e++; /* skip point */
|
||||
while (isdigit(*e))
|
||||
n = n*10 + (*e++ - '0');
|
||||
|
||||
sprintf(f,"%%");
|
||||
if (j == '<' || j == '|') sprintf(strchr(f,0),"-");
|
||||
if (m != 0) sprintf(strchr(f,0),"%d", m);
|
||||
if (n != 0) sprintf(strchr(f,0),".%d", n);
|
||||
sprintf(strchr(f,0), "%c", t);
|
||||
switch (tolower(t))
|
||||
{
|
||||
case 'i': t = 'i';
|
||||
sprintf (string, f, (long int)lua_getnumber(o));
|
||||
break;
|
||||
case 'f': case 'g': case 'e': t = 'f';
|
||||
sprintf (string, f, (float)lua_getnumber(o));
|
||||
break;
|
||||
case 's': t = 's';
|
||||
sprintf (string, f, lua_getstring(o));
|
||||
break;
|
||||
default: return "";
|
||||
}
|
||||
l = strlen(string);
|
||||
if (m!=0 && l>m)
|
||||
{
|
||||
int i;
|
||||
for (i=0; i<m; i++)
|
||||
string[i] = '*';
|
||||
string[i] = 0;
|
||||
}
|
||||
else if (m!=0 && j=='|')
|
||||
{
|
||||
int i=l-1;
|
||||
while (isspace(string[i])) i--;
|
||||
string -= (m-i) / 2;
|
||||
i=0;
|
||||
while (string[i]==0) string[i++] = ' ';
|
||||
string[l] = 0;
|
||||
}
|
||||
return string;
|
||||
}
|
||||
static void io_write (void)
|
||||
{
|
||||
lua_Object o1 = lua_getparam (1);
|
||||
lua_Object o2 = lua_getparam (2);
|
||||
if (o1 == NULL) /* new line */
|
||||
{
|
||||
fprintf (out, "\n");
|
||||
lua_pushnumber(1);
|
||||
}
|
||||
else if (o2 == NULL) /* free format */
|
||||
{
|
||||
int status=0;
|
||||
if (lua_isnumber(o1))
|
||||
status = fprintf (out, "%g", lua_getnumber(o1));
|
||||
else if (lua_isstring(o1))
|
||||
status = fprintf (out, "%s", lua_getstring(o1));
|
||||
lua_pushnumber(status);
|
||||
}
|
||||
else /* formated */
|
||||
{
|
||||
if (!lua_isstring(o2))
|
||||
{
|
||||
lua_error ("incorrect format to function `write'");
|
||||
lua_pushnumber(0);
|
||||
return;
|
||||
}
|
||||
lua_pushnumber(fprintf (out, "%s", buildformat(lua_getstring(o2),o1)));
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
** Execute a executable program using "sustem".
|
||||
** On error put 0 on stack, otherwise put 1.
|
||||
*/
|
||||
void io_execute (void)
|
||||
{
|
||||
lua_Object o = lua_getparam (1);
|
||||
if (o == NULL || !lua_isstring (o))
|
||||
{
|
||||
lua_error ("incorrect argument to function 'execute`");
|
||||
lua_pushnumber (0);
|
||||
}
|
||||
else
|
||||
{
|
||||
system(lua_getstring(o));
|
||||
lua_pushnumber (1);
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
/*
|
||||
** Remove a file.
|
||||
** On error put 0 on stack, otherwise put 1.
|
||||
*/
|
||||
void io_remove (void)
|
||||
{
|
||||
lua_Object o = lua_getparam (1);
|
||||
if (o == NULL || !lua_isstring (o))
|
||||
{
|
||||
lua_error ("incorrect argument to function 'execute`");
|
||||
lua_pushnumber (0);
|
||||
}
|
||||
else
|
||||
{
|
||||
if (remove(lua_getstring(o)) == 0)
|
||||
lua_pushnumber (1);
|
||||
else
|
||||
lua_pushnumber (0);
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
/*
|
||||
** Open io library
|
||||
*/
|
||||
void iolib_open (void)
|
||||
{
|
||||
in=stdin; out=stdout;
|
||||
lua_register ("readfrom", io_readfrom);
|
||||
lua_register ("writeto", io_writeto);
|
||||
lua_register ("read", io_read);
|
||||
lua_register ("write", io_write);
|
||||
lua_register ("execute", io_execute);
|
||||
lua_register ("remove", io_remove);
|
||||
}
|
||||
923
fixed/lex_yy.c
Normal file
923
fixed/lex_yy.c
Normal file
@@ -0,0 +1,923 @@
|
||||
# include "stdio.h"
|
||||
# define U(x) x
|
||||
# define NLSTATE yyprevious=YYNEWLINE
|
||||
# define BEGIN yybgin = yysvec + 1 +
|
||||
# define INITIAL 0
|
||||
# define YYLERR yysvec
|
||||
# define YYSTATE (yyestate-yysvec-1)
|
||||
# define YYOPTIM 1
|
||||
# define YYLMAX BUFSIZ
|
||||
# define output(c) putc(c,yyout)
|
||||
# define input() (((yytchar=yysptr>yysbuf?U(*--yysptr):getc(yyin))==10?(yylineno++,yytchar):yytchar)==EOF?0:yytchar)
|
||||
# define unput(c) {yytchar= (c);if(yytchar=='\n')yylineno--;*yysptr++=yytchar;}
|
||||
# define yymore() (yymorfg=1)
|
||||
# define ECHO fprintf(yyout, "%s",yytext)
|
||||
# define REJECT { nstr = yyreject(); goto yyfussy;}
|
||||
int yyleng; extern char yytext[];
|
||||
int yymorfg;
|
||||
extern char *yysptr, yysbuf[];
|
||||
int yytchar;
|
||||
FILE *yyin = {NULL}, *yyout = {NULL};
|
||||
extern int yylineno;
|
||||
struct yysvf {
|
||||
struct yywork *yystoff;
|
||||
struct yysvf *yyother;
|
||||
int *yystops;};
|
||||
struct yysvf *yyestate;
|
||||
extern struct yysvf yysvec[], *yybgin;
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
#include "opcode.h"
|
||||
#include "hash.h"
|
||||
#include "inout.h"
|
||||
#include "table.h"
|
||||
#include "y_tab.h"
|
||||
|
||||
#undef input
|
||||
#undef unput
|
||||
|
||||
static Input input;
|
||||
static Unput unput;
|
||||
|
||||
void lua_setinput (Input fn)
|
||||
{
|
||||
input = fn;
|
||||
}
|
||||
|
||||
void lua_setunput (Unput fn)
|
||||
{
|
||||
unput = fn;
|
||||
}
|
||||
|
||||
char *lua_lasttext (void)
|
||||
{
|
||||
return yytext;
|
||||
}
|
||||
|
||||
# define YYNEWLINE 10
|
||||
yylex(){
|
||||
int nstr; extern int yyprevious;
|
||||
while((nstr = yylook()) >= 0)
|
||||
yyfussy: switch(nstr){
|
||||
case 0:
|
||||
if(yywrap()) return(0); break;
|
||||
case 1:
|
||||
;
|
||||
break;
|
||||
case 2:
|
||||
{yylval.vInt = 1; return DEBUG;}
|
||||
break;
|
||||
case 3:
|
||||
{yylval.vInt = 0; return DEBUG;}
|
||||
break;
|
||||
case 4:
|
||||
lua_linenumber++;
|
||||
break;
|
||||
case 5:
|
||||
;
|
||||
break;
|
||||
case 6:
|
||||
return LOCAL;
|
||||
break;
|
||||
case 7:
|
||||
return IF;
|
||||
break;
|
||||
case 8:
|
||||
return THEN;
|
||||
break;
|
||||
case 9:
|
||||
return ELSE;
|
||||
break;
|
||||
case 10:
|
||||
return ELSEIF;
|
||||
break;
|
||||
case 11:
|
||||
return WHILE;
|
||||
break;
|
||||
case 12:
|
||||
return DO;
|
||||
break;
|
||||
case 13:
|
||||
return REPEAT;
|
||||
break;
|
||||
case 14:
|
||||
return UNTIL;
|
||||
break;
|
||||
case 15:
|
||||
{
|
||||
yylval.vWord = lua_nfile-1;
|
||||
return FUNCTION;
|
||||
}
|
||||
break;
|
||||
case 16:
|
||||
return END;
|
||||
break;
|
||||
case 17:
|
||||
return RETURN;
|
||||
break;
|
||||
case 18:
|
||||
return LOCAL;
|
||||
break;
|
||||
case 19:
|
||||
return NIL;
|
||||
break;
|
||||
case 20:
|
||||
return AND;
|
||||
break;
|
||||
case 21:
|
||||
return OR;
|
||||
break;
|
||||
case 22:
|
||||
return NOT;
|
||||
break;
|
||||
case 23:
|
||||
return NE;
|
||||
break;
|
||||
case 24:
|
||||
return LE;
|
||||
break;
|
||||
case 25:
|
||||
return GE;
|
||||
break;
|
||||
case 26:
|
||||
return CONC;
|
||||
break;
|
||||
case 27:
|
||||
case 28:
|
||||
{
|
||||
yylval.vWord = lua_findenclosedconstant (yytext);
|
||||
return STRING;
|
||||
}
|
||||
break;
|
||||
case 29:
|
||||
case 30:
|
||||
case 31:
|
||||
case 32:
|
||||
{
|
||||
yylval.vFloat = atof(yytext);
|
||||
return NUMBER;
|
||||
}
|
||||
break;
|
||||
case 33:
|
||||
{
|
||||
yylval.vWord = lua_findsymbol (yytext);
|
||||
return NAME;
|
||||
}
|
||||
break;
|
||||
case 34:
|
||||
return *yytext;
|
||||
break;
|
||||
case -1:
|
||||
break;
|
||||
default:
|
||||
fprintf(yyout,"bad switch yylook %d",nstr);
|
||||
} return(0); }
|
||||
/* end of yylex */
|
||||
int yyvstop[] = {
|
||||
0,
|
||||
|
||||
1,
|
||||
0,
|
||||
|
||||
1,
|
||||
0,
|
||||
|
||||
34,
|
||||
0,
|
||||
|
||||
1,
|
||||
34,
|
||||
0,
|
||||
|
||||
4,
|
||||
0,
|
||||
|
||||
34,
|
||||
0,
|
||||
|
||||
34,
|
||||
0,
|
||||
|
||||
34,
|
||||
0,
|
||||
|
||||
34,
|
||||
0,
|
||||
|
||||
29,
|
||||
34,
|
||||
0,
|
||||
|
||||
34,
|
||||
0,
|
||||
|
||||
34,
|
||||
0,
|
||||
|
||||
33,
|
||||
34,
|
||||
0,
|
||||
|
||||
33,
|
||||
34,
|
||||
0,
|
||||
|
||||
33,
|
||||
34,
|
||||
0,
|
||||
|
||||
33,
|
||||
34,
|
||||
0,
|
||||
|
||||
33,
|
||||
34,
|
||||
0,
|
||||
|
||||
33,
|
||||
34,
|
||||
0,
|
||||
|
||||
33,
|
||||
34,
|
||||
0,
|
||||
|
||||
33,
|
||||
34,
|
||||
0,
|
||||
|
||||
33,
|
||||
34,
|
||||
0,
|
||||
|
||||
33,
|
||||
34,
|
||||
0,
|
||||
|
||||
33,
|
||||
34,
|
||||
0,
|
||||
|
||||
33,
|
||||
34,
|
||||
0,
|
||||
|
||||
33,
|
||||
34,
|
||||
0,
|
||||
|
||||
34,
|
||||
0,
|
||||
|
||||
34,
|
||||
0,
|
||||
|
||||
1,
|
||||
0,
|
||||
|
||||
27,
|
||||
0,
|
||||
|
||||
28,
|
||||
0,
|
||||
|
||||
5,
|
||||
0,
|
||||
|
||||
26,
|
||||
0,
|
||||
|
||||
30,
|
||||
0,
|
||||
|
||||
29,
|
||||
0,
|
||||
|
||||
29,
|
||||
0,
|
||||
|
||||
24,
|
||||
0,
|
||||
|
||||
25,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
12,
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
7,
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
21,
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
23,
|
||||
0,
|
||||
|
||||
29,
|
||||
30,
|
||||
0,
|
||||
|
||||
31,
|
||||
0,
|
||||
|
||||
20,
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
16,
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
19,
|
||||
33,
|
||||
0,
|
||||
|
||||
22,
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
32,
|
||||
0,
|
||||
|
||||
9,
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
8,
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
31,
|
||||
32,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
6,
|
||||
18,
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
14,
|
||||
33,
|
||||
0,
|
||||
|
||||
11,
|
||||
33,
|
||||
0,
|
||||
|
||||
10,
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
13,
|
||||
33,
|
||||
0,
|
||||
|
||||
17,
|
||||
33,
|
||||
0,
|
||||
|
||||
2,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
15,
|
||||
33,
|
||||
0,
|
||||
|
||||
3,
|
||||
0,
|
||||
0};
|
||||
# define YYTYPE char
|
||||
struct yywork { YYTYPE verify, advance; } yycrank[] = {
|
||||
0,0, 0,0, 1,3, 0,0,
|
||||
0,0, 0,0, 0,0, 0,0,
|
||||
0,0, 0,0, 1,4, 1,5,
|
||||
6,29, 4,28, 0,0, 0,0,
|
||||
0,0, 0,0, 7,31, 0,0,
|
||||
6,29, 6,29, 0,0, 0,0,
|
||||
0,0, 0,0, 7,31, 7,31,
|
||||
0,0, 0,0, 0,0, 0,0,
|
||||
0,0, 0,0, 0,0, 1,6,
|
||||
4,28, 0,0, 0,0, 0,0,
|
||||
1,7, 0,0, 0,0, 0,0,
|
||||
1,3, 6,30, 1,8, 1,9,
|
||||
0,0, 1,10, 6,29, 7,31,
|
||||
8,33, 0,0, 6,29, 0,0,
|
||||
7,32, 0,0, 0,0, 6,29,
|
||||
7,31, 1,11, 0,0, 1,12,
|
||||
2,27, 7,31, 1,13, 11,39,
|
||||
12,40, 1,13, 26,56, 0,0,
|
||||
0,0, 2,8, 2,9, 0,0,
|
||||
6,29, 0,0, 0,0, 6,29,
|
||||
0,0, 0,0, 7,31, 0,0,
|
||||
0,0, 7,31, 0,0, 0,0,
|
||||
2,11, 0,0, 2,12, 0,0,
|
||||
0,0, 0,0, 0,0, 0,0,
|
||||
0,0, 0,0, 1,14, 0,0,
|
||||
0,0, 1,15, 1,16, 1,17,
|
||||
0,0, 22,52, 1,18, 18,47,
|
||||
23,53, 1,19, 42,63, 1,20,
|
||||
1,21, 25,55, 14,42, 1,22,
|
||||
15,43, 1,23, 1,24, 16,44,
|
||||
1,25, 16,45, 17,46, 19,48,
|
||||
21,51, 2,14, 20,49, 1,26,
|
||||
2,15, 2,16, 2,17, 24,54,
|
||||
20,50, 2,18, 44,64, 45,65,
|
||||
2,19, 46,66, 2,20, 2,21,
|
||||
27,57, 48,67, 2,22, 49,68,
|
||||
2,23, 2,24, 50,69, 2,25,
|
||||
52,70, 53,72, 27,58, 54,73,
|
||||
52,71, 9,34, 2,26, 9,35,
|
||||
9,35, 9,35, 9,35, 9,35,
|
||||
9,35, 9,35, 9,35, 9,35,
|
||||
9,35, 10,36, 55,74, 10,37,
|
||||
10,37, 10,37, 10,37, 10,37,
|
||||
10,37, 10,37, 10,37, 10,37,
|
||||
10,37, 57,75, 58,76, 64,80,
|
||||
66,81, 67,82, 70,83, 71,84,
|
||||
72,85, 73,86, 74,87, 10,38,
|
||||
10,38, 38,61, 10,38, 38,61,
|
||||
75,88, 76,89, 38,62, 38,62,
|
||||
38,62, 38,62, 38,62, 38,62,
|
||||
38,62, 38,62, 38,62, 38,62,
|
||||
80,92, 81,93, 13,41, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
82,94, 83,95, 84,96, 10,38,
|
||||
10,38, 86,97, 10,38, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
13,41, 87,98, 88,99, 60,79,
|
||||
60,79, 13,41, 60,79, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
13,41, 33,33, 89,100, 60,79,
|
||||
60,79, 92,101, 60,79, 93,102,
|
||||
95,103, 33,33, 33,0, 96,104,
|
||||
99,105, 100,106, 102,107, 106,108,
|
||||
107,109, 35,35, 35,35, 35,35,
|
||||
35,35, 35,35, 35,35, 35,35,
|
||||
35,35, 35,35, 35,35, 108,110,
|
||||
0,0, 0,0, 0,0, 0,0,
|
||||
0,0, 0,0, 33,33, 0,0,
|
||||
0,0, 35,59, 35,59, 33,33,
|
||||
35,59, 0,0, 0,0, 33,33,
|
||||
0,0, 0,0, 0,0, 0,0,
|
||||
33,33, 0,0, 0,0, 0,0,
|
||||
0,0, 36,60, 36,60, 36,60,
|
||||
36,60, 36,60, 36,60, 36,60,
|
||||
36,60, 36,60, 36,60, 0,0,
|
||||
0,0, 33,33, 0,0, 0,0,
|
||||
33,33, 35,59, 35,59, 0,0,
|
||||
35,59, 36,38, 36,38, 59,77,
|
||||
36,38, 59,77, 0,0, 0,0,
|
||||
59,78, 59,78, 59,78, 59,78,
|
||||
59,78, 59,78, 59,78, 59,78,
|
||||
59,78, 59,78, 61,62, 61,62,
|
||||
61,62, 61,62, 61,62, 61,62,
|
||||
61,62, 61,62, 61,62, 61,62,
|
||||
0,0, 0,0, 0,0, 0,0,
|
||||
0,0, 36,38, 36,38, 0,0,
|
||||
36,38, 77,78, 77,78, 77,78,
|
||||
77,78, 77,78, 77,78, 77,78,
|
||||
77,78, 77,78, 77,78, 79,90,
|
||||
0,0, 79,90, 0,0, 0,0,
|
||||
79,91, 79,91, 79,91, 79,91,
|
||||
79,91, 79,91, 79,91, 79,91,
|
||||
79,91, 79,91, 90,91, 90,91,
|
||||
90,91, 90,91, 90,91, 90,91,
|
||||
90,91, 90,91, 90,91, 90,91,
|
||||
0,0};
|
||||
struct yysvf yysvec[] = {
|
||||
0, 0, 0,
|
||||
yycrank+-1, 0, yyvstop+1,
|
||||
yycrank+-28, yysvec+1, yyvstop+3,
|
||||
yycrank+0, 0, yyvstop+5,
|
||||
yycrank+4, 0, yyvstop+7,
|
||||
yycrank+0, 0, yyvstop+10,
|
||||
yycrank+-11, 0, yyvstop+12,
|
||||
yycrank+-17, 0, yyvstop+14,
|
||||
yycrank+7, 0, yyvstop+16,
|
||||
yycrank+107, 0, yyvstop+18,
|
||||
yycrank+119, 0, yyvstop+20,
|
||||
yycrank+6, 0, yyvstop+23,
|
||||
yycrank+7, 0, yyvstop+25,
|
||||
yycrank+158, 0, yyvstop+27,
|
||||
yycrank+4, yysvec+13, yyvstop+30,
|
||||
yycrank+5, yysvec+13, yyvstop+33,
|
||||
yycrank+11, yysvec+13, yyvstop+36,
|
||||
yycrank+5, yysvec+13, yyvstop+39,
|
||||
yycrank+5, yysvec+13, yyvstop+42,
|
||||
yycrank+12, yysvec+13, yyvstop+45,
|
||||
yycrank+21, yysvec+13, yyvstop+48,
|
||||
yycrank+10, yysvec+13, yyvstop+51,
|
||||
yycrank+4, yysvec+13, yyvstop+54,
|
||||
yycrank+4, yysvec+13, yyvstop+57,
|
||||
yycrank+21, yysvec+13, yyvstop+60,
|
||||
yycrank+9, yysvec+13, yyvstop+63,
|
||||
yycrank+9, 0, yyvstop+66,
|
||||
yycrank+40, 0, yyvstop+68,
|
||||
yycrank+0, yysvec+4, yyvstop+70,
|
||||
yycrank+0, yysvec+6, 0,
|
||||
yycrank+0, 0, yyvstop+72,
|
||||
yycrank+0, yysvec+7, 0,
|
||||
yycrank+0, 0, yyvstop+74,
|
||||
yycrank+-280, 0, yyvstop+76,
|
||||
yycrank+0, 0, yyvstop+78,
|
||||
yycrank+249, 0, yyvstop+80,
|
||||
yycrank+285, 0, yyvstop+82,
|
||||
yycrank+0, yysvec+10, yyvstop+84,
|
||||
yycrank+146, 0, 0,
|
||||
yycrank+0, 0, yyvstop+86,
|
||||
yycrank+0, 0, yyvstop+88,
|
||||
yycrank+0, yysvec+13, yyvstop+90,
|
||||
yycrank+10, yysvec+13, yyvstop+92,
|
||||
yycrank+0, yysvec+13, yyvstop+94,
|
||||
yycrank+19, yysvec+13, yyvstop+97,
|
||||
yycrank+35, yysvec+13, yyvstop+99,
|
||||
yycrank+27, yysvec+13, yyvstop+101,
|
||||
yycrank+0, yysvec+13, yyvstop+103,
|
||||
yycrank+42, yysvec+13, yyvstop+106,
|
||||
yycrank+35, yysvec+13, yyvstop+108,
|
||||
yycrank+30, yysvec+13, yyvstop+110,
|
||||
yycrank+0, yysvec+13, yyvstop+112,
|
||||
yycrank+36, yysvec+13, yyvstop+115,
|
||||
yycrank+48, yysvec+13, yyvstop+117,
|
||||
yycrank+35, yysvec+13, yyvstop+119,
|
||||
yycrank+61, yysvec+13, yyvstop+121,
|
||||
yycrank+0, 0, yyvstop+123,
|
||||
yycrank+76, 0, 0,
|
||||
yycrank+67, 0, 0,
|
||||
yycrank+312, 0, 0,
|
||||
yycrank+183, yysvec+36, yyvstop+125,
|
||||
yycrank+322, 0, 0,
|
||||
yycrank+0, yysvec+61, yyvstop+128,
|
||||
yycrank+0, yysvec+13, yyvstop+130,
|
||||
yycrank+78, yysvec+13, yyvstop+133,
|
||||
yycrank+0, yysvec+13, yyvstop+135,
|
||||
yycrank+81, yysvec+13, yyvstop+138,
|
||||
yycrank+84, yysvec+13, yyvstop+140,
|
||||
yycrank+0, yysvec+13, yyvstop+142,
|
||||
yycrank+0, yysvec+13, yyvstop+145,
|
||||
yycrank+81, yysvec+13, yyvstop+148,
|
||||
yycrank+66, yysvec+13, yyvstop+150,
|
||||
yycrank+74, yysvec+13, yyvstop+152,
|
||||
yycrank+80, yysvec+13, yyvstop+154,
|
||||
yycrank+78, yysvec+13, yyvstop+156,
|
||||
yycrank+94, 0, 0,
|
||||
yycrank+93, 0, 0,
|
||||
yycrank+341, 0, 0,
|
||||
yycrank+0, yysvec+77, yyvstop+158,
|
||||
yycrank+356, 0, 0,
|
||||
yycrank+99, yysvec+13, yyvstop+160,
|
||||
yycrank+89, yysvec+13, yyvstop+163,
|
||||
yycrank+108, yysvec+13, yyvstop+165,
|
||||
yycrank+120, yysvec+13, yyvstop+167,
|
||||
yycrank+104, yysvec+13, yyvstop+169,
|
||||
yycrank+0, yysvec+13, yyvstop+171,
|
||||
yycrank+113, yysvec+13, yyvstop+174,
|
||||
yycrank+148, yysvec+13, yyvstop+176,
|
||||
yycrank+133, 0, 0,
|
||||
yycrank+181, 0, 0,
|
||||
yycrank+366, 0, 0,
|
||||
yycrank+0, yysvec+90, yyvstop+178,
|
||||
yycrank+183, yysvec+13, yyvstop+181,
|
||||
yycrank+182, yysvec+13, yyvstop+183,
|
||||
yycrank+0, yysvec+13, yyvstop+185,
|
||||
yycrank+172, yysvec+13, yyvstop+189,
|
||||
yycrank+181, yysvec+13, yyvstop+191,
|
||||
yycrank+0, yysvec+13, yyvstop+193,
|
||||
yycrank+0, yysvec+13, yyvstop+196,
|
||||
yycrank+189, 0, 0,
|
||||
yycrank+195, 0, 0,
|
||||
yycrank+0, yysvec+13, yyvstop+199,
|
||||
yycrank+183, yysvec+13, yyvstop+202,
|
||||
yycrank+0, yysvec+13, yyvstop+204,
|
||||
yycrank+0, yysvec+13, yyvstop+207,
|
||||
yycrank+0, 0, yyvstop+210,
|
||||
yycrank+178, 0, 0,
|
||||
yycrank+186, yysvec+13, yyvstop+212,
|
||||
yycrank+204, 0, 0,
|
||||
yycrank+0, yysvec+13, yyvstop+214,
|
||||
yycrank+0, 0, yyvstop+217,
|
||||
0, 0, 0};
|
||||
struct yywork *yytop = yycrank+423;
|
||||
struct yysvf *yybgin = yysvec+1;
|
||||
char yymatch[] = {
|
||||
00 ,01 ,01 ,01 ,01 ,01 ,01 ,01 ,
|
||||
01 ,011 ,012 ,01 ,01 ,01 ,01 ,01 ,
|
||||
01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 ,
|
||||
01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 ,
|
||||
011 ,01 ,'"' ,01 ,01 ,01 ,01 ,047 ,
|
||||
01 ,01 ,01 ,'+' ,01 ,'+' ,01 ,01 ,
|
||||
'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,
|
||||
'0' ,'0' ,01 ,01 ,01 ,01 ,01 ,01 ,
|
||||
01 ,'A' ,'A' ,'A' ,'D' ,'D' ,'A' ,'D' ,
|
||||
'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
|
||||
'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
|
||||
'A' ,'A' ,'A' ,01 ,01 ,01 ,01 ,'A' ,
|
||||
01 ,'A' ,'A' ,'A' ,'D' ,'D' ,'A' ,'D' ,
|
||||
'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
|
||||
'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
|
||||
'A' ,'A' ,'A' ,01 ,01 ,01 ,01 ,01 ,
|
||||
0};
|
||||
char yyextra[] = {
|
||||
0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,
|
||||
0};
|
||||
#ifndef lint
|
||||
static char ncform_sccsid[] = "@(#)ncform 1.6 88/02/08 SMI"; /* from S5R2 1.2 */
|
||||
#endif
|
||||
|
||||
int yylineno =1;
|
||||
# define YYU(x) x
|
||||
# define NLSTATE yyprevious=YYNEWLINE
|
||||
char yytext[YYLMAX];
|
||||
struct yysvf *yylstate [YYLMAX], **yylsp, **yyolsp;
|
||||
char yysbuf[YYLMAX];
|
||||
char *yysptr = yysbuf;
|
||||
int *yyfnd;
|
||||
extern struct yysvf *yyestate;
|
||||
int yyprevious = YYNEWLINE;
|
||||
yylook(){
|
||||
register struct yysvf *yystate, **lsp;
|
||||
register struct yywork *yyt;
|
||||
struct yysvf *yyz;
|
||||
int yych, yyfirst;
|
||||
struct yywork *yyr;
|
||||
# ifdef LEXDEBUG
|
||||
int debug;
|
||||
# endif
|
||||
char *yylastch;
|
||||
/* start off machines */
|
||||
# ifdef LEXDEBUG
|
||||
debug = 0;
|
||||
# endif
|
||||
yyfirst=1;
|
||||
if (!yymorfg)
|
||||
yylastch = yytext;
|
||||
else {
|
||||
yymorfg=0;
|
||||
yylastch = yytext+yyleng;
|
||||
}
|
||||
for(;;){
|
||||
lsp = yylstate;
|
||||
yyestate = yystate = yybgin;
|
||||
if (yyprevious==YYNEWLINE) yystate++;
|
||||
for (;;){
|
||||
# ifdef LEXDEBUG
|
||||
if(debug)fprintf(yyout,"state %d\n",yystate-yysvec-1);
|
||||
# endif
|
||||
yyt = yystate->yystoff;
|
||||
if(yyt == yycrank && !yyfirst){ /* may not be any transitions */
|
||||
yyz = yystate->yyother;
|
||||
if(yyz == 0)break;
|
||||
if(yyz->yystoff == yycrank)break;
|
||||
}
|
||||
*yylastch++ = yych = input();
|
||||
yyfirst=0;
|
||||
tryagain:
|
||||
# ifdef LEXDEBUG
|
||||
if(debug){
|
||||
fprintf(yyout,"char ");
|
||||
allprint(yych);
|
||||
putchar('\n');
|
||||
}
|
||||
# endif
|
||||
yyr = yyt;
|
||||
if ( (int)yyt > (int)yycrank){
|
||||
yyt = yyr + yych;
|
||||
if (yyt <= yytop && yyt->verify+yysvec == yystate){
|
||||
if(yyt->advance+yysvec == YYLERR) /* error transitions */
|
||||
{unput(*--yylastch);break;}
|
||||
*lsp++ = yystate = yyt->advance+yysvec;
|
||||
goto contin;
|
||||
}
|
||||
}
|
||||
# ifdef YYOPTIM
|
||||
else if((int)yyt < (int)yycrank) { /* r < yycrank */
|
||||
yyt = yyr = yycrank+(yycrank-yyt);
|
||||
# ifdef LEXDEBUG
|
||||
if(debug)fprintf(yyout,"compressed state\n");
|
||||
# endif
|
||||
yyt = yyt + yych;
|
||||
if(yyt <= yytop && yyt->verify+yysvec == yystate){
|
||||
if(yyt->advance+yysvec == YYLERR) /* error transitions */
|
||||
{unput(*--yylastch);break;}
|
||||
*lsp++ = yystate = yyt->advance+yysvec;
|
||||
goto contin;
|
||||
}
|
||||
yyt = yyr + YYU(yymatch[yych]);
|
||||
# ifdef LEXDEBUG
|
||||
if(debug){
|
||||
fprintf(yyout,"try fall back character ");
|
||||
allprint(YYU(yymatch[yych]));
|
||||
putchar('\n');
|
||||
}
|
||||
# endif
|
||||
if(yyt <= yytop && yyt->verify+yysvec == yystate){
|
||||
if(yyt->advance+yysvec == YYLERR) /* error transition */
|
||||
{unput(*--yylastch);break;}
|
||||
*lsp++ = yystate = yyt->advance+yysvec;
|
||||
goto contin;
|
||||
}
|
||||
}
|
||||
if ((yystate = yystate->yyother) && (yyt= yystate->yystoff) != yycrank){
|
||||
# ifdef LEXDEBUG
|
||||
if(debug)fprintf(yyout,"fall back to state %d\n",yystate-yysvec-1);
|
||||
# endif
|
||||
goto tryagain;
|
||||
}
|
||||
# endif
|
||||
else
|
||||
{unput(*--yylastch);break;}
|
||||
contin:
|
||||
# ifdef LEXDEBUG
|
||||
if(debug){
|
||||
fprintf(yyout,"state %d char ",yystate-yysvec-1);
|
||||
allprint(yych);
|
||||
putchar('\n');
|
||||
}
|
||||
# endif
|
||||
;
|
||||
}
|
||||
# ifdef LEXDEBUG
|
||||
if(debug){
|
||||
fprintf(yyout,"stopped at %d with ",*(lsp-1)-yysvec-1);
|
||||
allprint(yych);
|
||||
putchar('\n');
|
||||
}
|
||||
# endif
|
||||
while (lsp-- > yylstate){
|
||||
*yylastch-- = 0;
|
||||
if (*lsp != 0 && (yyfnd= (*lsp)->yystops) && *yyfnd > 0){
|
||||
yyolsp = lsp;
|
||||
if(yyextra[*yyfnd]){ /* must backup */
|
||||
while(yyback((*lsp)->yystops,-*yyfnd) != 1 && lsp > yylstate){
|
||||
lsp--;
|
||||
unput(*yylastch--);
|
||||
}
|
||||
}
|
||||
yyprevious = YYU(*yylastch);
|
||||
yylsp = lsp;
|
||||
yyleng = yylastch-yytext+1;
|
||||
yytext[yyleng] = 0;
|
||||
# ifdef LEXDEBUG
|
||||
if(debug){
|
||||
fprintf(yyout,"\nmatch ");
|
||||
sprint(yytext);
|
||||
fprintf(yyout," action %d\n",*yyfnd);
|
||||
}
|
||||
# endif
|
||||
return(*yyfnd++);
|
||||
}
|
||||
unput(*yylastch);
|
||||
}
|
||||
if (yytext[0] == 0 /* && feof(yyin) */)
|
||||
{
|
||||
yysptr=yysbuf;
|
||||
return(0);
|
||||
}
|
||||
yyprevious = yytext[0] = input();
|
||||
if (yyprevious>0)
|
||||
output(yyprevious);
|
||||
yylastch=yytext;
|
||||
# ifdef LEXDEBUG
|
||||
if(debug)putchar('\n');
|
||||
# endif
|
||||
}
|
||||
}
|
||||
yyback(p, m)
|
||||
int *p;
|
||||
{
|
||||
if (p==0) return(0);
|
||||
while (*p)
|
||||
{
|
||||
if (*p++ == m)
|
||||
return(1);
|
||||
}
|
||||
return(0);
|
||||
}
|
||||
/* the following are only used in the lex library */
|
||||
yyinput(){
|
||||
return(input());
|
||||
}
|
||||
yyoutput(c)
|
||||
int c; {
|
||||
output(c);
|
||||
}
|
||||
yyunput(c)
|
||||
int c; {
|
||||
unput(c);
|
||||
}
|
||||
55
fixed/lua.c
Normal file
55
fixed/lua.c
Normal file
@@ -0,0 +1,55 @@
|
||||
/*
|
||||
** lua.c
|
||||
** Linguagem para Usuarios de Aplicacao
|
||||
** TeCGraf - PUC-Rio
|
||||
** 28 Apr 93
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
|
||||
#include "lua.h"
|
||||
#include "lualib.h"
|
||||
|
||||
|
||||
void test (void)
|
||||
{
|
||||
lua_pushobject(lua_getparam(1));
|
||||
lua_call ("c", 1);
|
||||
}
|
||||
|
||||
|
||||
static void callfunc (void)
|
||||
{
|
||||
lua_Object obj = lua_getparam (1);
|
||||
if (lua_isstring(obj)) lua_call(lua_getstring(obj),0);
|
||||
}
|
||||
|
||||
static void execstr (void)
|
||||
{
|
||||
lua_Object obj = lua_getparam (1);
|
||||
if (lua_isstring(obj)) lua_dostring(lua_getstring(obj));
|
||||
}
|
||||
|
||||
int main (int argc, char *argv[])
|
||||
{
|
||||
int i;
|
||||
if (argc < 2)
|
||||
{
|
||||
puts ("usage: lua filename [functionnames]");
|
||||
return;
|
||||
}
|
||||
lua_register ("callfunc", callfunc);
|
||||
lua_register ("execstr", execstr);
|
||||
lua_register ("test", test);
|
||||
iolib_open ();
|
||||
strlib_open ();
|
||||
mathlib_open ();
|
||||
lua_dofile (argv[1]);
|
||||
for (i=2; i<argc; i++)
|
||||
{
|
||||
lua_call (argv[i],0);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
1
floatingpoint.h
Normal file
1
floatingpoint.h
Normal file
@@ -0,0 +1 @@
|
||||
/* empty file to please silly code in iolib.c and opcode.c */
|
||||
5
globals.lua
Normal file
5
globals.lua
Normal file
@@ -0,0 +1,5 @@
|
||||
k,v=nextvar(k)
|
||||
while k do
|
||||
print(k)
|
||||
k,v=nextvar(k)
|
||||
end
|
||||
259
hash.c
Normal file
259
hash.c
Normal file
@@ -0,0 +1,259 @@
|
||||
/*
|
||||
** hash.c
|
||||
** hash manager for lua
|
||||
** Luiz Henrique de Figueiredo - 17 Aug 90
|
||||
** Modified by Waldemar Celes Filho
|
||||
** 12 May 93
|
||||
*/
|
||||
|
||||
#include <string.h>
|
||||
#include <stdlib.h>
|
||||
|
||||
#include "opcode.h"
|
||||
#include "hash.h"
|
||||
#include "inout.h"
|
||||
#include "table.h"
|
||||
#include "lua.h"
|
||||
|
||||
#define streq(s1,s2) (strcmp(s1,s2)==0)
|
||||
#define strneq(s1,s2) (strcmp(s1,s2)!=0)
|
||||
|
||||
#define new(s) ((s *)malloc(sizeof(s)))
|
||||
#define newvector(n,s) ((s *)calloc(n,sizeof(s)))
|
||||
|
||||
#define nhash(t) ((t)->nhash)
|
||||
#define nodelist(t) ((t)->list)
|
||||
#define list(t,i) ((t)->list[i])
|
||||
#define ref_tag(n) (tag(&(n)->ref))
|
||||
#define ref_nvalue(n) (nvalue(&(n)->ref))
|
||||
#define ref_svalue(n) (svalue(&(n)->ref))
|
||||
|
||||
static int head (Hash *t, Object *ref) /* hash function */
|
||||
{
|
||||
if (tag(ref) == T_NUMBER) return (((int)nvalue(ref))%nhash(t));
|
||||
else if (tag(ref) == T_STRING)
|
||||
{
|
||||
int h;
|
||||
char *name = svalue(ref);
|
||||
for (h=0; *name!=0; name++) /* interpret name as binary number */
|
||||
{
|
||||
h <<= 8;
|
||||
h += (unsigned char) *name; /* avoid sign extension */
|
||||
h %= nhash(t); /* make it a valid index */
|
||||
}
|
||||
return h;
|
||||
}
|
||||
else
|
||||
{
|
||||
lua_reportbug ("unexpected type to index table");
|
||||
return -1;
|
||||
}
|
||||
}
|
||||
|
||||
static Node *present(Hash *t, Object *ref, int h)
|
||||
{
|
||||
Node *n=NULL, *p;
|
||||
if (tag(ref) == T_NUMBER)
|
||||
{
|
||||
for (p=NULL,n=list(t,h); n!=NULL; p=n, n=n->next)
|
||||
if (ref_tag(n) == T_NUMBER && nvalue(ref) == ref_nvalue(n)) break;
|
||||
}
|
||||
else if (tag(ref) == T_STRING)
|
||||
{
|
||||
for (p=NULL,n=list(t,h); n!=NULL; p=n, n=n->next)
|
||||
if (ref_tag(n) == T_STRING && streq(svalue(ref),ref_svalue(n))) break;
|
||||
}
|
||||
if (n==NULL) /* name not present */
|
||||
return NULL;
|
||||
#if 0
|
||||
if (p!=NULL) /* name present but not first */
|
||||
{
|
||||
p->next=n->next; /* move-to-front self-organization */
|
||||
n->next=list(t,h);
|
||||
list(t,h)=n;
|
||||
}
|
||||
#endif
|
||||
return n;
|
||||
}
|
||||
|
||||
static void freelist (Node *n)
|
||||
{
|
||||
while (n)
|
||||
{
|
||||
Node *next = n->next;
|
||||
free (n);
|
||||
n = next;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
** Create a new hash. Return the hash pointer or NULL on error.
|
||||
*/
|
||||
Hash *lua_hashcreate (unsigned int nhash)
|
||||
{
|
||||
Hash *t = new (Hash);
|
||||
if (t == NULL)
|
||||
{
|
||||
lua_error ("not enough memory");
|
||||
return NULL;
|
||||
}
|
||||
nhash(t) = nhash;
|
||||
markarray(t) = 0;
|
||||
nodelist(t) = newvector (nhash, Node*);
|
||||
if (nodelist(t) == NULL)
|
||||
{
|
||||
lua_error ("not enough memory");
|
||||
return NULL;
|
||||
}
|
||||
return t;
|
||||
}
|
||||
|
||||
/*
|
||||
** Delete a hash
|
||||
*/
|
||||
void lua_hashdelete (Hash *h)
|
||||
{
|
||||
int i;
|
||||
for (i=0; i<nhash(h); i++)
|
||||
freelist (list(h,i));
|
||||
free (nodelist(h));
|
||||
free(h);
|
||||
}
|
||||
|
||||
/*
|
||||
** If the hash node is present, return its pointer, otherwise create a new
|
||||
** node for the given reference and also return its pointer.
|
||||
** On error, return NULL.
|
||||
*/
|
||||
Object *lua_hashdefine (Hash *t, Object *ref)
|
||||
{
|
||||
int h;
|
||||
Node *n;
|
||||
h = head (t, ref);
|
||||
if (h < 0) return NULL;
|
||||
|
||||
n = present(t, ref, h);
|
||||
if (n == NULL)
|
||||
{
|
||||
n = new(Node);
|
||||
if (n == NULL)
|
||||
{
|
||||
lua_error ("not enough memory");
|
||||
return NULL;
|
||||
}
|
||||
n->ref = *ref;
|
||||
tag(&n->val) = T_NIL;
|
||||
n->next = list(t,h); /* link node to head of list */
|
||||
list(t,h) = n;
|
||||
}
|
||||
return (&n->val);
|
||||
}
|
||||
|
||||
/*
|
||||
** Mark a hash and check its elements
|
||||
*/
|
||||
void lua_hashmark (Hash *h)
|
||||
{
|
||||
int i;
|
||||
|
||||
markarray(h) = 1;
|
||||
|
||||
for (i=0; i<nhash(h); i++)
|
||||
{
|
||||
Node *n;
|
||||
for (n = list(h,i); n != NULL; n = n->next)
|
||||
{
|
||||
lua_markobject (&n->ref);
|
||||
lua_markobject (&n->val);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** 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.
|
||||
*/
|
||||
#include "lua.h"
|
||||
static void firstnode (Hash *a, int h)
|
||||
{
|
||||
if (h < nhash(a))
|
||||
{
|
||||
int i;
|
||||
for (i=h; i<nhash(a); i++)
|
||||
{
|
||||
if (list(a,i) != NULL && tag(&list(a,i)->val) != T_NIL)
|
||||
{
|
||||
lua_pushobject (&list(a,i)->ref);
|
||||
lua_pushobject (&list(a,i)->val);
|
||||
return;
|
||||
}
|
||||
}
|
||||
}
|
||||
lua_pushnil();
|
||||
lua_pushnil();
|
||||
}
|
||||
void lua_next (void)
|
||||
{
|
||||
Hash *a;
|
||||
Object *o = lua_getparam (1);
|
||||
Object *r = lua_getparam (2);
|
||||
if (o == NULL || r == NULL)
|
||||
{ lua_error ("too few arguments to function `next'"); return; }
|
||||
if (lua_getparam (3) != NULL)
|
||||
{ lua_error ("too many arguments to function `next'"); return; }
|
||||
if (tag(o) != T_ARRAY)
|
||||
{ lua_error ("first argument of function `next' is not a table"); return; }
|
||||
a = avalue(o);
|
||||
if (tag(r) == T_NIL)
|
||||
{
|
||||
firstnode (a, 0);
|
||||
return;
|
||||
}
|
||||
else
|
||||
{
|
||||
int h = head (a, r);
|
||||
if (h >= 0)
|
||||
{
|
||||
Node *n = list(a,h);
|
||||
while (n)
|
||||
{
|
||||
if (memcmp(&n->ref,r,sizeof(Object)) == 0)
|
||||
{
|
||||
if (n->next == NULL)
|
||||
{
|
||||
firstnode (a, h+1);
|
||||
return;
|
||||
}
|
||||
else if (tag(&n->next->val) != T_NIL)
|
||||
{
|
||||
lua_pushobject (&n->next->ref);
|
||||
lua_pushobject (&n->next->val);
|
||||
return;
|
||||
}
|
||||
else
|
||||
{
|
||||
Node *next = n->next->next;
|
||||
while (next != NULL && tag(&next->val) == T_NIL) next = next->next;
|
||||
if (next == NULL)
|
||||
{
|
||||
firstnode (a, h+1);
|
||||
return;
|
||||
}
|
||||
else
|
||||
{
|
||||
lua_pushobject (&next->ref);
|
||||
lua_pushobject (&next->val);
|
||||
}
|
||||
return;
|
||||
}
|
||||
}
|
||||
n = n->next;
|
||||
}
|
||||
if (n == NULL)
|
||||
lua_error ("error in function 'next': reference not found");
|
||||
}
|
||||
}
|
||||
}
|
||||
35
hash.h
Normal file
35
hash.h
Normal file
@@ -0,0 +1,35 @@
|
||||
/*
|
||||
** hash.h
|
||||
** hash manager for lua
|
||||
** Luiz Henrique de Figueiredo - 17 Aug 90
|
||||
** Modified by Waldemar Celes Filho
|
||||
** 26 Apr 93
|
||||
*/
|
||||
|
||||
#ifndef hash_h
|
||||
#define hash_h
|
||||
|
||||
typedef struct node
|
||||
{
|
||||
Object ref;
|
||||
Object val;
|
||||
struct node *next;
|
||||
} Node;
|
||||
|
||||
typedef struct Hash
|
||||
{
|
||||
char mark;
|
||||
unsigned int nhash;
|
||||
Node **list;
|
||||
} Hash;
|
||||
|
||||
#define markarray(t) ((t)->mark)
|
||||
|
||||
Hash *lua_hashcreate (unsigned int nhash);
|
||||
void lua_hashdelete (Hash *h);
|
||||
Object *lua_hashdefine (Hash *t, Object *ref);
|
||||
void lua_hashmark (Hash *h);
|
||||
|
||||
void lua_next (void);
|
||||
|
||||
#endif
|
||||
188
inout.c
Normal file
188
inout.c
Normal file
@@ -0,0 +1,188 @@
|
||||
/*
|
||||
** inout.c
|
||||
** Provide function to realise the input/output function and debugger
|
||||
** facilities.
|
||||
**
|
||||
** Waldemar Celes Filho
|
||||
** TeCGraf - PUC-Rio
|
||||
** 11 May 93
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
|
||||
#include "opcode.h"
|
||||
#include "hash.h"
|
||||
#include "inout.h"
|
||||
#include "table.h"
|
||||
|
||||
/* Exported variables */
|
||||
int lua_linenumber;
|
||||
int lua_debug;
|
||||
int lua_debugline;
|
||||
|
||||
/* Internal variables */
|
||||
#ifndef MAXFUNCSTACK
|
||||
#define MAXFUNCSTACK 32
|
||||
#endif
|
||||
static struct { int file; int function; } funcstack[MAXFUNCSTACK];
|
||||
static int nfuncstack=0;
|
||||
|
||||
static FILE *fp;
|
||||
static char *st;
|
||||
static void (*usererror) (char *s);
|
||||
|
||||
/*
|
||||
** Function to set user function to handle errors.
|
||||
*/
|
||||
void lua_errorfunction (void (*fn) (char *s))
|
||||
{
|
||||
usererror = fn;
|
||||
}
|
||||
|
||||
/*
|
||||
** Function to get the next character from the input file
|
||||
*/
|
||||
static int fileinput (void)
|
||||
{
|
||||
int c = fgetc (fp);
|
||||
return (c == EOF ? 0 : c);
|
||||
}
|
||||
|
||||
/*
|
||||
** Function to unget the next character from to input file
|
||||
*/
|
||||
static void fileunput (int c)
|
||||
{
|
||||
ungetc (c, fp);
|
||||
}
|
||||
|
||||
/*
|
||||
** Function to get the next character from the input string
|
||||
*/
|
||||
static int stringinput (void)
|
||||
{
|
||||
st++;
|
||||
return (*(st-1));
|
||||
}
|
||||
|
||||
/*
|
||||
** Function to unget the next character from to input string
|
||||
*/
|
||||
static void stringunput (int c)
|
||||
{
|
||||
st--;
|
||||
}
|
||||
|
||||
/*
|
||||
** Function to open a file to be input unit.
|
||||
** Return 0 on success or 1 on error.
|
||||
*/
|
||||
int lua_openfile (char *fn)
|
||||
{
|
||||
lua_linenumber = 1;
|
||||
lua_setinput (fileinput);
|
||||
lua_setunput (fileunput);
|
||||
fp = fopen (fn, "r");
|
||||
if (fp == NULL) return 1;
|
||||
if (lua_addfile (fn)) return 1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
** Function to close an opened file
|
||||
*/
|
||||
void lua_closefile (void)
|
||||
{
|
||||
if (fp != NULL)
|
||||
{
|
||||
fclose (fp);
|
||||
fp = NULL;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
** Function to open a string to be input unit
|
||||
*/
|
||||
int lua_openstring (char *s)
|
||||
{
|
||||
lua_linenumber = 1;
|
||||
lua_setinput (stringinput);
|
||||
lua_setunput (stringunput);
|
||||
st = s;
|
||||
{
|
||||
char sn[64];
|
||||
sprintf (sn, "String: %10.10s...", s);
|
||||
if (lua_addfile (sn)) return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
** Call user function to handle error messages, if registred. Or report error
|
||||
** using standard function (fprintf).
|
||||
*/
|
||||
void lua_error (char *s)
|
||||
{
|
||||
if (usererror != NULL) usererror (s);
|
||||
else fprintf (stderr, "lua: %s\n", s);
|
||||
}
|
||||
|
||||
/*
|
||||
** Called to execute SETFUNCTION opcode, this function pushs a function into
|
||||
** function stack. Return 0 on success or 1 on error.
|
||||
*/
|
||||
int lua_pushfunction (int file, int function)
|
||||
{
|
||||
if (nfuncstack >= MAXFUNCSTACK-1)
|
||||
{
|
||||
lua_error ("function stack overflow");
|
||||
return 1;
|
||||
}
|
||||
funcstack[nfuncstack].file = file;
|
||||
funcstack[nfuncstack].function = function;
|
||||
nfuncstack++;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
** Called to execute RESET opcode, this function pops a function from
|
||||
** function stack.
|
||||
*/
|
||||
void lua_popfunction (void)
|
||||
{
|
||||
nfuncstack--;
|
||||
}
|
||||
|
||||
/*
|
||||
** Report bug building a message and sending it to lua_error function.
|
||||
*/
|
||||
void lua_reportbug (char *s)
|
||||
{
|
||||
char msg[1024];
|
||||
strcpy (msg, s);
|
||||
if (lua_debugline != 0)
|
||||
{
|
||||
int i;
|
||||
if (nfuncstack > 0)
|
||||
{
|
||||
sprintf (strchr(msg,0),
|
||||
"\n\tin statement begining at line %d in function \"%s\" of file \"%s\"",
|
||||
lua_debugline, s_name(funcstack[nfuncstack-1].function),
|
||||
lua_file[funcstack[nfuncstack-1].file]);
|
||||
sprintf (strchr(msg,0), "\n\tactive stack\n");
|
||||
for (i=nfuncstack-1; i>=0; i--)
|
||||
sprintf (strchr(msg,0), "\t-> function \"%s\" of file \"%s\"\n",
|
||||
s_name(funcstack[i].function),
|
||||
lua_file[funcstack[i].file]);
|
||||
}
|
||||
else
|
||||
{
|
||||
sprintf (strchr(msg,0),
|
||||
"\n\tin statement begining at line %d of file \"%s\"",
|
||||
lua_debugline, lua_filename());
|
||||
}
|
||||
}
|
||||
lua_error (msg);
|
||||
}
|
||||
|
||||
24
inout.h
Normal file
24
inout.h
Normal file
@@ -0,0 +1,24 @@
|
||||
/*
|
||||
** inout.h
|
||||
**
|
||||
** Waldemar Celes Filho
|
||||
** TeCGraf - PUC-Rio
|
||||
** 11 May 93
|
||||
*/
|
||||
|
||||
|
||||
#ifndef inout_h
|
||||
#define inout_h
|
||||
|
||||
extern int lua_linenumber;
|
||||
extern int lua_debug;
|
||||
extern int lua_debugline;
|
||||
|
||||
int lua_openfile (char *fn);
|
||||
void lua_closefile (void);
|
||||
int lua_openstring (char *s);
|
||||
int lua_pushfunction (int file, int function);
|
||||
void lua_popfunction (void);
|
||||
void lua_reportbug (char *s);
|
||||
|
||||
#endif
|
||||
401
iolib.c
Normal file
401
iolib.c
Normal file
@@ -0,0 +1,401 @@
|
||||
/*
|
||||
** iolib.c
|
||||
** Input/output library to LUA
|
||||
**
|
||||
** Waldemar Celes Filho
|
||||
** TeCGraf - PUC-Rio
|
||||
** 19 May 93
|
||||
*/
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <stdio.h>
|
||||
#include <ctype.h>
|
||||
#ifdef __GNUC__
|
||||
#include <floatingpoint.h>
|
||||
#endif
|
||||
|
||||
#include "lua.h"
|
||||
|
||||
static FILE *in=stdin, *out=stdout;
|
||||
|
||||
/*
|
||||
** Open a file to read.
|
||||
** LUA interface:
|
||||
** status = readfrom (filename)
|
||||
** where:
|
||||
** status = 1 -> success
|
||||
** status = 0 -> error
|
||||
*/
|
||||
static void io_readfrom (void)
|
||||
{
|
||||
lua_Object o = lua_getparam (1);
|
||||
if (o == NULL) /* restore standart input */
|
||||
{
|
||||
if (in != stdin)
|
||||
{
|
||||
fclose (in);
|
||||
in = stdin;
|
||||
}
|
||||
lua_pushnumber (1);
|
||||
}
|
||||
else
|
||||
{
|
||||
if (!lua_isstring (o))
|
||||
{
|
||||
lua_error ("incorrect argument to function 'readfrom`");
|
||||
lua_pushnumber (0);
|
||||
}
|
||||
else
|
||||
{
|
||||
FILE *fp = fopen (lua_getstring(o),"r");
|
||||
if (fp == NULL)
|
||||
{
|
||||
lua_pushnumber (0);
|
||||
}
|
||||
else
|
||||
{
|
||||
if (in != stdin) fclose (in);
|
||||
in = fp;
|
||||
lua_pushnumber (1);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Open a file to write.
|
||||
** LUA interface:
|
||||
** status = writeto (filename)
|
||||
** where:
|
||||
** status = 1 -> success
|
||||
** status = 0 -> error
|
||||
*/
|
||||
static void io_writeto (void)
|
||||
{
|
||||
lua_Object o = lua_getparam (1);
|
||||
if (o == NULL) /* restore standart output */
|
||||
{
|
||||
if (out != stdout)
|
||||
{
|
||||
fclose (out);
|
||||
out = stdout;
|
||||
}
|
||||
lua_pushnumber (1);
|
||||
}
|
||||
else
|
||||
{
|
||||
if (!lua_isstring (o))
|
||||
{
|
||||
lua_error ("incorrect argument to function 'writeto`");
|
||||
lua_pushnumber (0);
|
||||
}
|
||||
else
|
||||
{
|
||||
FILE *fp = fopen (lua_getstring(o),"w");
|
||||
if (fp == NULL)
|
||||
{
|
||||
lua_pushnumber (0);
|
||||
}
|
||||
else
|
||||
{
|
||||
if (out != stdout) fclose (out);
|
||||
out = fp;
|
||||
lua_pushnumber (1);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** 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 void io_read (void)
|
||||
{
|
||||
lua_Object o = lua_getparam (1);
|
||||
if (o == NULL) /* free format */
|
||||
{
|
||||
int c;
|
||||
char s[256];
|
||||
while (isspace(c=fgetc(in)))
|
||||
;
|
||||
if (c == '\"')
|
||||
{
|
||||
if (fscanf (in, "%[^\"]\"", s) != 1)
|
||||
{
|
||||
lua_pushnil ();
|
||||
return;
|
||||
}
|
||||
}
|
||||
else if (c == '\'')
|
||||
{
|
||||
if (fscanf (in, "%[^\']\'", s) != 1)
|
||||
{
|
||||
lua_pushnil ();
|
||||
return;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
char *ptr;
|
||||
double d;
|
||||
ungetc (c, in);
|
||||
if (fscanf (in, "%s", s) != 1)
|
||||
{
|
||||
lua_pushnil ();
|
||||
return;
|
||||
}
|
||||
d = strtod (s, &ptr);
|
||||
if (!(*ptr))
|
||||
{
|
||||
lua_pushnumber (d);
|
||||
return;
|
||||
}
|
||||
}
|
||||
lua_pushstring (s);
|
||||
return;
|
||||
}
|
||||
else /* formatted */
|
||||
{
|
||||
char *e = lua_getstring(o);
|
||||
char t;
|
||||
int m=0;
|
||||
while (isspace(*e)) e++;
|
||||
t = *e++;
|
||||
while (isdigit(*e))
|
||||
m = m*10 + (*e++ - '0');
|
||||
|
||||
if (m > 0)
|
||||
{
|
||||
char f[80];
|
||||
char s[256];
|
||||
sprintf (f, "%%%ds", m);
|
||||
fscanf (in, f, s);
|
||||
switch (tolower(t))
|
||||
{
|
||||
case 'i':
|
||||
{
|
||||
long int l;
|
||||
sscanf (s, "%ld", &l);
|
||||
lua_pushnumber(l);
|
||||
}
|
||||
break;
|
||||
case 'f': case 'g': case 'e':
|
||||
{
|
||||
float f;
|
||||
sscanf (s, "%f", &f);
|
||||
lua_pushnumber(f);
|
||||
}
|
||||
break;
|
||||
default:
|
||||
lua_pushstring(s);
|
||||
break;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
switch (tolower(t))
|
||||
{
|
||||
case 'i':
|
||||
{
|
||||
long int l;
|
||||
fscanf (in, "%ld", &l);
|
||||
lua_pushnumber(l);
|
||||
}
|
||||
break;
|
||||
case 'f': case 'g': case 'e':
|
||||
{
|
||||
float f;
|
||||
fscanf (in, "%f", &f);
|
||||
lua_pushnumber(f);
|
||||
}
|
||||
break;
|
||||
default:
|
||||
{
|
||||
char s[256];
|
||||
fscanf (in, "%s", s);
|
||||
lua_pushstring(s);
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** 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 char *buildformat (char *e, lua_Object o)
|
||||
{
|
||||
static char buffer[512];
|
||||
static char f[80];
|
||||
char *string = &buffer[255];
|
||||
char t, j='r';
|
||||
int m=0, n=0, l;
|
||||
while (isspace(*e)) e++;
|
||||
t = *e++;
|
||||
if (*e == '<' || *e == '|' || *e == '>') j = *e++;
|
||||
while (isdigit(*e))
|
||||
m = m*10 + (*e++ - '0');
|
||||
e++; /* skip point */
|
||||
while (isdigit(*e))
|
||||
n = n*10 + (*e++ - '0');
|
||||
|
||||
sprintf(f,"%%");
|
||||
if (j == '<' || j == '|') sprintf(strchr(f,0),"-");
|
||||
if (m != 0) sprintf(strchr(f,0),"%d", m);
|
||||
if (n != 0) sprintf(strchr(f,0),".%d", n);
|
||||
sprintf(strchr(f,0), "%c", t);
|
||||
switch (tolower(t))
|
||||
{
|
||||
case 'i': t = 'i';
|
||||
sprintf (string, f, (long int)lua_getnumber(o));
|
||||
break;
|
||||
case 'f': case 'g': case 'e': t = 'f';
|
||||
sprintf (string, f, (float)lua_getnumber(o));
|
||||
break;
|
||||
case 's': t = 's';
|
||||
sprintf (string, f, lua_getstring(o));
|
||||
break;
|
||||
default: return "";
|
||||
}
|
||||
l = strlen(string);
|
||||
if (m!=0 && l>m)
|
||||
{
|
||||
int i;
|
||||
for (i=0; i<m; i++)
|
||||
string[i] = '*';
|
||||
string[i] = 0;
|
||||
}
|
||||
else if (m!=0 && j=='|')
|
||||
{
|
||||
int i=l-1;
|
||||
while (isspace(string[i])) i--;
|
||||
string -= (m-i) / 2;
|
||||
i=0;
|
||||
while (string[i]==0) string[i++] = ' ';
|
||||
string[l] = 0;
|
||||
}
|
||||
return string;
|
||||
}
|
||||
static void io_write (void)
|
||||
{
|
||||
lua_Object o1 = lua_getparam (1);
|
||||
lua_Object o2 = lua_getparam (2);
|
||||
if (o1 == NULL) /* new line */
|
||||
{
|
||||
fprintf (out, "\n");
|
||||
lua_pushnumber(1);
|
||||
}
|
||||
else if (o2 == NULL) /* free format */
|
||||
{
|
||||
int status=0;
|
||||
if (lua_isnumber(o1))
|
||||
status = fprintf (out, "%g", lua_getnumber(o1));
|
||||
else if (lua_isstring(o1))
|
||||
status = fprintf (out, "%s", lua_getstring(o1));
|
||||
lua_pushnumber(status);
|
||||
}
|
||||
else /* formated */
|
||||
{
|
||||
if (!lua_isstring(o2))
|
||||
{
|
||||
lua_error ("incorrect format to function `write'");
|
||||
lua_pushnumber(0);
|
||||
return;
|
||||
}
|
||||
lua_pushnumber(fprintf (out, "%s", buildformat(lua_getstring(o2),o1)));
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
** Execute a executable program using "sustem".
|
||||
** On error put 0 on stack, otherwise put 1.
|
||||
*/
|
||||
void io_execute (void)
|
||||
{
|
||||
lua_Object o = lua_getparam (1);
|
||||
if (o == NULL || !lua_isstring (o))
|
||||
{
|
||||
lua_error ("incorrect argument to function 'execute`");
|
||||
lua_pushnumber (0);
|
||||
}
|
||||
else
|
||||
{
|
||||
system(lua_getstring(o));
|
||||
lua_pushnumber (1);
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
/*
|
||||
** Remove a file.
|
||||
** On error put 0 on stack, otherwise put 1.
|
||||
*/
|
||||
void io_remove (void)
|
||||
{
|
||||
lua_Object o = lua_getparam (1);
|
||||
if (o == NULL || !lua_isstring (o))
|
||||
{
|
||||
lua_error ("incorrect argument to function 'execute`");
|
||||
lua_pushnumber (0);
|
||||
}
|
||||
else
|
||||
{
|
||||
if (remove(lua_getstring(o)) == 0)
|
||||
lua_pushnumber (1);
|
||||
else
|
||||
lua_pushnumber (0);
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
/*
|
||||
** Open io library
|
||||
*/
|
||||
void iolib_open (void)
|
||||
{
|
||||
lua_register ("readfrom", io_readfrom);
|
||||
lua_register ("writeto", io_writeto);
|
||||
lua_register ("read", io_read);
|
||||
lua_register ("write", io_write);
|
||||
lua_register ("execute", io_execute);
|
||||
lua_register ("remove", io_remove);
|
||||
}
|
||||
780
lapi.c
780
lapi.c
@@ -1,780 +0,0 @@
|
||||
/*
|
||||
** $Id: lapi.c,v 1.148 2001/07/12 18:11:58 roberto Exp roberto $
|
||||
** Lua API
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
#include <string.h>
|
||||
|
||||
#define LUA_PRIVATE
|
||||
#include "lua.h"
|
||||
|
||||
#include "lapi.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 "lvm.h"
|
||||
|
||||
|
||||
const l_char lua_ident[] = l_s("$Lua: ") l_s(LUA_VERSION) l_s(" ")
|
||||
l_s(LUA_COPYRIGHT) l_s(" $\n") l_s("$Authors: ") l_s(LUA_AUTHORS) l_s(" $");
|
||||
|
||||
|
||||
|
||||
#ifndef api_check
|
||||
#define api_check(L, o) /* nothing */
|
||||
#endif
|
||||
|
||||
#define api_checknelems(L, n) api_check(L, (n) <= (L->top - L->ci->base))
|
||||
|
||||
#define api_incr_top(L) incr_top
|
||||
|
||||
|
||||
|
||||
TObject *luaA_index (lua_State *L, int index) {
|
||||
if (index > 0) {
|
||||
api_check(L, index <= L->top - L->ci->base);
|
||||
return L->ci->base+index-1;
|
||||
}
|
||||
else {
|
||||
api_check(L, index != 0 && -index <= L->top - L->ci->base);
|
||||
return L->top+index;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static TObject *luaA_indexAcceptable (lua_State *L, int index) {
|
||||
if (index > 0) {
|
||||
TObject *o = L->ci->base+(index-1);
|
||||
api_check(L, index <= L->stack_last - L->ci->base);
|
||||
if (o >= L->top) return NULL;
|
||||
else return o;
|
||||
}
|
||||
else {
|
||||
api_check(L, index != 0 && -index <= L->top - L->ci->base);
|
||||
return L->top+index;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
void luaA_pushobject (lua_State *L, const TObject *o) {
|
||||
setobj(L->top, o);
|
||||
incr_top;
|
||||
}
|
||||
|
||||
LUA_API int lua_stackspace (lua_State *L) {
|
||||
return (L->stack_last - L->top);
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** basic stack manipulation
|
||||
*/
|
||||
|
||||
|
||||
LUA_API int lua_gettop (lua_State *L) {
|
||||
return (L->top - L->ci->base);
|
||||
}
|
||||
|
||||
|
||||
LUA_API void lua_settop (lua_State *L, int index) {
|
||||
lua_lock(L);
|
||||
if (index >= 0) {
|
||||
api_check(L, index <= L->stack_last - L->ci->base);
|
||||
luaD_adjusttop(L, L->ci->base+index);
|
||||
}
|
||||
else {
|
||||
api_check(L, -(index+1) <= (L->top - L->ci->base));
|
||||
L->top += index+1; /* `subtract' index (index is negative) */
|
||||
}
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
LUA_API void lua_remove (lua_State *L, int index) {
|
||||
StkId p;
|
||||
lua_lock(L);
|
||||
p = luaA_index(L, index);
|
||||
while (++p < L->top) setobj(p-1, p);
|
||||
L->top--;
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
LUA_API void lua_insert (lua_State *L, int index) {
|
||||
StkId p;
|
||||
StkId q;
|
||||
lua_lock(L);
|
||||
p = luaA_index(L, index);
|
||||
for (q = L->top; q>p; q--) setobj(q, q-1);
|
||||
setobj(p, L->top);
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
LUA_API void lua_pushvalue (lua_State *L, int index) {
|
||||
lua_lock(L);
|
||||
setobj(L->top, luaA_index(L, index));
|
||||
api_incr_top(L);
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** access functions (stack -> C)
|
||||
*/
|
||||
|
||||
|
||||
LUA_API int lua_rawtag (lua_State *L, int index) {
|
||||
StkId o = luaA_indexAcceptable(L, index);
|
||||
return (o == NULL) ? LUA_TNONE : ttype(o);
|
||||
}
|
||||
|
||||
|
||||
LUA_API const l_char *lua_type (lua_State *L, int index) {
|
||||
StkId o;
|
||||
const l_char *type;
|
||||
lua_lock(L);
|
||||
o = luaA_indexAcceptable(L, index);
|
||||
type = (o == NULL) ? l_s("no value") : luaT_typename(G(L), o);
|
||||
lua_unlock(L);
|
||||
return type;
|
||||
}
|
||||
|
||||
|
||||
LUA_API int lua_iscfunction (lua_State *L, int index) {
|
||||
StkId o = luaA_indexAcceptable(L, index);
|
||||
return (o == NULL) ? 0 : iscfunction(o);
|
||||
}
|
||||
|
||||
|
||||
LUA_API int lua_isnumber (lua_State *L, int index) {
|
||||
TObject n;
|
||||
TObject *o = luaA_indexAcceptable(L, index);
|
||||
return (o != NULL && (ttype(o) == LUA_TNUMBER || luaV_tonumber(o, &n)));
|
||||
}
|
||||
|
||||
|
||||
LUA_API int lua_isstring (lua_State *L, int index) {
|
||||
int t = lua_rawtag(L, index);
|
||||
return (t == LUA_TSTRING || t == LUA_TNUMBER);
|
||||
}
|
||||
|
||||
|
||||
LUA_API int lua_tag (lua_State *L, int index) {
|
||||
StkId o;
|
||||
int i;
|
||||
lua_lock(L); /* other thread could be changing the tag */
|
||||
o = luaA_indexAcceptable(L, index);
|
||||
i = (o == NULL) ? LUA_NOTAG : luaT_tag(o);
|
||||
lua_unlock(L);
|
||||
return i;
|
||||
}
|
||||
|
||||
|
||||
LUA_API int lua_equal (lua_State *L, int index1, int index2) {
|
||||
StkId o1 = luaA_indexAcceptable(L, index1);
|
||||
StkId o2 = luaA_indexAcceptable(L, index2);
|
||||
return (o1 == NULL || o2 == NULL) ? 0 /* index out of range */
|
||||
: luaO_equalObj(o1, o2);
|
||||
}
|
||||
|
||||
|
||||
LUA_API int lua_lessthan (lua_State *L, int index1, int index2) {
|
||||
StkId o1, o2;
|
||||
int i;
|
||||
lua_lock(L); /* may call tag method */
|
||||
o1 = luaA_indexAcceptable(L, index1);
|
||||
o2 = luaA_indexAcceptable(L, index2);
|
||||
i = (o1 == NULL || o2 == NULL) ? 0 /* index out-of-range */
|
||||
: luaV_lessthan(L, o1, o2);
|
||||
lua_unlock(L);
|
||||
return i;
|
||||
}
|
||||
|
||||
|
||||
|
||||
LUA_API lua_Number lua_tonumber (lua_State *L, int index) {
|
||||
TObject n;
|
||||
const TObject *o = luaA_indexAcceptable(L, index);
|
||||
if (o != NULL &&
|
||||
(ttype(o) == LUA_TNUMBER || (o = luaV_tonumber(o, &n)) != NULL))
|
||||
return nvalue(o);
|
||||
else
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
LUA_API const l_char *lua_tostring (lua_State *L, int index) {
|
||||
StkId o = luaA_indexAcceptable(L, index);
|
||||
if (o == NULL)
|
||||
return NULL;
|
||||
else if (ttype(o) == LUA_TSTRING)
|
||||
return svalue(o);
|
||||
else {
|
||||
const l_char *s;
|
||||
lua_lock(L); /* `luaV_tostring' may create a new string */
|
||||
s = (luaV_tostring(L, o) == 0) ? svalue(o) : NULL;
|
||||
lua_unlock(L);
|
||||
return s;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
LUA_API size_t lua_strlen (lua_State *L, int index) {
|
||||
StkId o = luaA_indexAcceptable(L, index);
|
||||
if (o == NULL)
|
||||
return 0;
|
||||
else if (ttype(o) == LUA_TSTRING)
|
||||
return tsvalue(o)->tsv.len;
|
||||
else {
|
||||
size_t l;
|
||||
lua_lock(L); /* `luaV_tostring' may create a new string */
|
||||
l = (luaV_tostring(L, o) == 0) ? tsvalue(o)->tsv.len : 0;
|
||||
lua_unlock(L);
|
||||
return l;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
LUA_API lua_CFunction lua_tocfunction (lua_State *L, int index) {
|
||||
StkId o = luaA_indexAcceptable(L, index);
|
||||
return (o == NULL || !iscfunction(o)) ? NULL : clvalue(o)->f.c;
|
||||
}
|
||||
|
||||
|
||||
LUA_API void *lua_touserdata (lua_State *L, int index) {
|
||||
StkId o = luaA_indexAcceptable(L, index);
|
||||
return (o == NULL || ttype(o) != LUA_TUSERDATA) ? NULL : uvalue(o)->uv.value;
|
||||
}
|
||||
|
||||
|
||||
LUA_API const void *lua_topointer (lua_State *L, int index) {
|
||||
StkId o = luaA_indexAcceptable(L, index);
|
||||
if (o == NULL) return NULL;
|
||||
else {
|
||||
switch (ttype(o)) {
|
||||
case LUA_TTABLE: return hvalue(o);
|
||||
case LUA_TFUNCTION: return clvalue(o);
|
||||
default: return NULL;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** push functions (C -> stack)
|
||||
*/
|
||||
|
||||
|
||||
LUA_API void lua_pushnil (lua_State *L) {
|
||||
lua_lock(L);
|
||||
setnilvalue(L->top);
|
||||
api_incr_top(L);
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
LUA_API void lua_pushnumber (lua_State *L, lua_Number n) {
|
||||
lua_lock(L);
|
||||
setnvalue(L->top, n);
|
||||
api_incr_top(L);
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
LUA_API void lua_pushlstring (lua_State *L, const l_char *s, size_t len) {
|
||||
lua_lock(L);
|
||||
setsvalue(L->top, luaS_newlstr(L, s, len));
|
||||
api_incr_top(L);
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
LUA_API void lua_pushstring (lua_State *L, const l_char *s) {
|
||||
if (s == NULL)
|
||||
lua_pushnil(L);
|
||||
else
|
||||
lua_pushlstring(L, s, strlen(s));
|
||||
}
|
||||
|
||||
|
||||
LUA_API void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n) {
|
||||
lua_lock(L);
|
||||
api_checknelems(L, n);
|
||||
luaV_Cclosure(L, fn, n);
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** get functions (Lua -> stack)
|
||||
*/
|
||||
|
||||
|
||||
LUA_API void lua_getglobal (lua_State *L, const l_char *name) {
|
||||
lua_lock(L);
|
||||
luaV_getglobal(L, luaS_new(L, name), L->top);
|
||||
api_incr_top(L);
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
LUA_API void lua_gettable (lua_State *L, int index) {
|
||||
StkId t;
|
||||
lua_lock(L);
|
||||
t = luaA_index(L, index);
|
||||
luaV_gettable(L, t, L->top-1, L->top-1);
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
LUA_API void lua_rawget (lua_State *L, int index) {
|
||||
StkId t;
|
||||
lua_lock(L);
|
||||
t = luaA_index(L, index);
|
||||
api_check(L, ttype(t) == LUA_TTABLE);
|
||||
setobj(L->top - 1, luaH_get(hvalue(t), L->top - 1));
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
LUA_API void lua_rawgeti (lua_State *L, int index, int n) {
|
||||
StkId o;
|
||||
lua_lock(L);
|
||||
o = luaA_index(L, index);
|
||||
api_check(L, ttype(o) == LUA_TTABLE);
|
||||
setobj(L->top, luaH_getnum(hvalue(o), n));
|
||||
api_incr_top(L);
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
LUA_API void lua_getglobals (lua_State *L) {
|
||||
lua_lock(L);
|
||||
sethvalue(L->top, L->gt);
|
||||
api_incr_top(L);
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
LUA_API int lua_getref (lua_State *L, int ref) {
|
||||
int status;
|
||||
lua_lock(L);
|
||||
if (ref == LUA_REFNIL) {
|
||||
setnilvalue(L->top);
|
||||
status = 1;
|
||||
}
|
||||
else {
|
||||
setobj(L->top, luaH_getnum(G(L)->weakregistry, ref));
|
||||
status = (ttype(L->top) != LUA_TNIL);
|
||||
}
|
||||
if (status)
|
||||
api_incr_top(L);
|
||||
lua_unlock(L);
|
||||
return status;
|
||||
}
|
||||
|
||||
|
||||
LUA_API void lua_newtable (lua_State *L) {
|
||||
lua_lock(L);
|
||||
sethvalue(L->top, luaH_new(L, 0));
|
||||
api_incr_top(L);
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
LUA_API void lua_getregistry (lua_State *L) {
|
||||
lua_lock(L);
|
||||
sethvalue(L->top, G(L)->registry);
|
||||
api_incr_top(L);
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
LUA_API void lua_getweakregistry (lua_State *L) {
|
||||
lua_lock(L);
|
||||
sethvalue(L->top, G(L)->weakregistry);
|
||||
api_incr_top(L);
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** set functions (stack -> Lua)
|
||||
*/
|
||||
|
||||
|
||||
LUA_API void lua_setglobal (lua_State *L, const l_char *name) {
|
||||
lua_lock(L);
|
||||
api_checknelems(L, 1);
|
||||
luaV_setglobal(L, luaS_new(L, name), L->top - 1);
|
||||
L->top--; /* remove element from the top */
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
LUA_API void lua_settable (lua_State *L, int index) {
|
||||
StkId t;
|
||||
lua_lock(L);
|
||||
api_checknelems(L, 2);
|
||||
t = luaA_index(L, index);
|
||||
luaV_settable(L, t, L->top - 2, L->top - 1);
|
||||
L->top -= 2; /* pop index and value */
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
LUA_API void lua_rawset (lua_State *L, int index) {
|
||||
StkId t;
|
||||
lua_lock(L);
|
||||
api_checknelems(L, 2);
|
||||
t = luaA_index(L, index);
|
||||
api_check(L, ttype(t) == LUA_TTABLE);
|
||||
setobj(luaH_set(L, hvalue(t), L->top-2), (L->top-1));
|
||||
L->top -= 2;
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
LUA_API void lua_rawseti (lua_State *L, int index, int n) {
|
||||
StkId o;
|
||||
lua_lock(L);
|
||||
api_checknelems(L, 1);
|
||||
o = luaA_index(L, index);
|
||||
api_check(L, ttype(o) == LUA_TTABLE);
|
||||
setobj(luaH_setnum(L, hvalue(o), n), (L->top-1));
|
||||
L->top--;
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
LUA_API void lua_setglobals (lua_State *L) {
|
||||
StkId newtable;
|
||||
lua_lock(L);
|
||||
api_checknelems(L, 1);
|
||||
newtable = --L->top;
|
||||
api_check(L, ttype(newtable) == LUA_TTABLE);
|
||||
L->gt = hvalue(newtable);
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
LUA_API int lua_ref (lua_State *L, int lock) {
|
||||
int ref;
|
||||
if (lua_isnil(L, -1)) {
|
||||
lua_pop(L, 1);
|
||||
ref = LUA_REFNIL;
|
||||
}
|
||||
else {
|
||||
lua_getweakregistry(L);
|
||||
ref = lua_getn(L, -1) + 1;
|
||||
lua_pushvalue(L, -2);
|
||||
lua_rawseti(L, -2, ref);
|
||||
if (lock) {
|
||||
lua_getregistry(L);
|
||||
lua_pushvalue(L, -3);
|
||||
lua_rawseti(L, -2, ref);
|
||||
lua_pop(L, 1); /* remove registry */
|
||||
}
|
||||
lua_pushliteral(L, l_s("n"));
|
||||
lua_pushnumber(L, ref);
|
||||
lua_settable(L, -3);
|
||||
lua_pop(L, 2);
|
||||
}
|
||||
return ref;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** `do' functions (run Lua code)
|
||||
*/
|
||||
|
||||
LUA_API void lua_rawcall (lua_State *L, int nargs, int nresults) {
|
||||
StkId func;
|
||||
lua_lock(L);
|
||||
api_checknelems(L, nargs+1);
|
||||
func = L->top - (nargs+1);
|
||||
luaD_call(L, func);
|
||||
if (nresults != LUA_MULTRET)
|
||||
luaD_adjusttop(L, func + nresults);
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
LUA_API int lua_dofile (lua_State *L, const l_char *filename) {
|
||||
int status;
|
||||
status = lua_loadfile(L, filename);
|
||||
if (status == 0) /* parse OK? */
|
||||
status = lua_call(L, 0, LUA_MULTRET); /* call main */
|
||||
return status;
|
||||
}
|
||||
|
||||
|
||||
LUA_API int lua_dobuffer (lua_State *L, const l_char *buff, size_t size,
|
||||
const l_char *name) {
|
||||
int status;
|
||||
status = lua_loadbuffer(L, buff, size, name);
|
||||
if (status == 0) /* parse OK? */
|
||||
status = lua_call(L, 0, LUA_MULTRET); /* call main */
|
||||
return status;
|
||||
}
|
||||
|
||||
|
||||
LUA_API int lua_dostring (lua_State *L, const l_char *str) {
|
||||
return lua_dobuffer(L, str, strlen(str), str);
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** Garbage-collection functions
|
||||
*/
|
||||
|
||||
/* GC values are expressed in Kbytes: #bytes/2^10 */
|
||||
#define GCscale(x) ((int)((x)>>10))
|
||||
#define GCunscale(x) ((lu_mem)(x)<<10)
|
||||
|
||||
LUA_API int lua_getgcthreshold (lua_State *L) {
|
||||
int threshold;
|
||||
lua_lock(L);
|
||||
threshold = GCscale(G(L)->GCthreshold);
|
||||
lua_unlock(L);
|
||||
return threshold;
|
||||
}
|
||||
|
||||
LUA_API int lua_getgccount (lua_State *L) {
|
||||
int count;
|
||||
lua_lock(L);
|
||||
count = GCscale(G(L)->nblocks);
|
||||
lua_unlock(L);
|
||||
return count;
|
||||
}
|
||||
|
||||
LUA_API void lua_setgcthreshold (lua_State *L, int newthreshold) {
|
||||
lua_lock(L);
|
||||
if (newthreshold > GCscale(ULONG_MAX))
|
||||
G(L)->GCthreshold = ULONG_MAX;
|
||||
else
|
||||
G(L)->GCthreshold = GCunscale(newthreshold);
|
||||
luaC_checkGC(L);
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** miscellaneous functions
|
||||
*/
|
||||
|
||||
LUA_API int lua_newtype (lua_State *L, const l_char *name, int basictype) {
|
||||
int tag;
|
||||
lua_lock(L);
|
||||
if (basictype != LUA_TNONE &&
|
||||
basictype != LUA_TTABLE &&
|
||||
basictype != LUA_TUSERDATA)
|
||||
luaO_verror(L, l_s("invalid basic type (%d) for new type"), basictype);
|
||||
tag = luaT_newtag(L, name, basictype);
|
||||
if (tag == LUA_TNONE)
|
||||
luaO_verror(L, l_s("type name '%.30s' already exists"), name);
|
||||
lua_unlock(L);
|
||||
return tag;
|
||||
}
|
||||
|
||||
|
||||
LUA_API int lua_name2tag (lua_State *L, const l_char *name) {
|
||||
int tag;
|
||||
const TObject *v;
|
||||
lua_lock(L);
|
||||
v = luaH_getstr(G(L)->type2tag, luaS_new(L, name));
|
||||
if (ttype(v) == LUA_TNIL)
|
||||
tag = LUA_TNONE;
|
||||
else {
|
||||
lua_assert(ttype(v) == LUA_TNUMBER);
|
||||
tag = (int)nvalue(v);
|
||||
}
|
||||
lua_unlock(L);
|
||||
return tag;
|
||||
}
|
||||
|
||||
|
||||
LUA_API const l_char *lua_tag2name (lua_State *L, int tag) {
|
||||
const l_char *s;
|
||||
lua_lock(L);
|
||||
s = (tag == LUA_TNONE) ? l_s("no value") : typenamebytag(G(L), tag);
|
||||
lua_unlock(L);
|
||||
return s;
|
||||
}
|
||||
|
||||
|
||||
LUA_API void lua_settag (lua_State *L, int tag) {
|
||||
int basictype;
|
||||
lua_lock(L);
|
||||
api_checknelems(L, 1);
|
||||
if (tag < 0 || tag >= G(L)->ntag)
|
||||
luaO_verror(L, l_s("%d is not a valid tag"), tag);
|
||||
basictype = G(L)->TMtable[tag].basictype;
|
||||
if (basictype != LUA_TNONE && basictype != ttype(L->top-1))
|
||||
luaO_verror(L, l_s("tag %d can only be used for type '%.20s'"), tag,
|
||||
typenamebytag(G(L), basictype));
|
||||
switch (ttype(L->top-1)) {
|
||||
case LUA_TTABLE:
|
||||
hvalue(L->top-1)->htag = tag;
|
||||
break;
|
||||
case LUA_TUSERDATA:
|
||||
uvalue(L->top-1)->uv.tag = tag;
|
||||
break;
|
||||
default:
|
||||
luaO_verror(L, l_s("cannot change the tag of a %.20s"),
|
||||
luaT_typename(G(L), L->top-1));
|
||||
}
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
LUA_API void lua_error (lua_State *L, const l_char *s) {
|
||||
lua_lock(L);
|
||||
luaD_error(L, s);
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
LUA_API void lua_unref (lua_State *L, int ref) {
|
||||
if (ref >= 0) {
|
||||
lua_getregistry(L);
|
||||
lua_pushnil(L);
|
||||
lua_rawseti(L, -2, ref);
|
||||
lua_getweakregistry(L);
|
||||
lua_pushnil(L);
|
||||
lua_rawseti(L, -2, ref);
|
||||
lua_pop(L, 2); /* remove both registries */
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
LUA_API int lua_next (lua_State *L, int index) {
|
||||
StkId t;
|
||||
Node *n;
|
||||
int more;
|
||||
lua_lock(L);
|
||||
t = luaA_index(L, index);
|
||||
api_check(L, ttype(t) == LUA_TTABLE);
|
||||
n = luaH_next(L, hvalue(t), luaA_index(L, -1));
|
||||
if (n) {
|
||||
setobj(L->top-1, key(n));
|
||||
setobj(L->top, val(n));
|
||||
api_incr_top(L);
|
||||
more = 1;
|
||||
}
|
||||
else { /* no more elements */
|
||||
L->top -= 1; /* remove key */
|
||||
more = 0;
|
||||
}
|
||||
lua_unlock(L);
|
||||
return more;
|
||||
}
|
||||
|
||||
|
||||
LUA_API int lua_getn (lua_State *L, int index) {
|
||||
StkId t;
|
||||
const TObject *value;
|
||||
int n;
|
||||
lua_lock(L);
|
||||
t = luaA_index(L, index);
|
||||
api_check(L, ttype(t) == LUA_TTABLE);
|
||||
value = luaH_getstr(hvalue(t), luaS_newliteral(L, l_s("n"))); /* = t.n */
|
||||
if (ttype(value) == LUA_TNUMBER)
|
||||
n = (int)nvalue(value);
|
||||
else {
|
||||
lua_Number max = 0;
|
||||
int i = hvalue(t)->size;
|
||||
Node *nd = hvalue(t)->node;
|
||||
while (i--) {
|
||||
if (ttype(key(nd)) == LUA_TNUMBER &&
|
||||
ttype(val(nd)) != LUA_TNIL &&
|
||||
nvalue(key(nd)) > max)
|
||||
max = nvalue(key(nd));
|
||||
nd++;
|
||||
}
|
||||
n = (int)max;
|
||||
}
|
||||
lua_unlock(L);
|
||||
return n;
|
||||
}
|
||||
|
||||
|
||||
LUA_API void lua_concat (lua_State *L, int n) {
|
||||
lua_lock(L);
|
||||
api_checknelems(L, n);
|
||||
if (n >= 2) {
|
||||
luaV_strconc(L, n, L->top);
|
||||
L->top -= (n-1);
|
||||
luaC_checkGC(L);
|
||||
}
|
||||
else if (n == 0) { /* push null string */
|
||||
setsvalue(L->top, luaS_newlstr(L, NULL, 0));
|
||||
api_incr_top(L);
|
||||
}
|
||||
/* else n == 1; nothing to do */
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
static Udata *pushnewudata (lua_State *L, size_t size) {
|
||||
Udata *u = luaS_newudata(L, size);
|
||||
setuvalue(L->top, u);
|
||||
api_incr_top(L);
|
||||
return uvalue(L->top-1);
|
||||
}
|
||||
|
||||
|
||||
LUA_API void *lua_newuserdata (lua_State *L, size_t size) {
|
||||
Udata *u;
|
||||
void *p;
|
||||
lua_lock(L);
|
||||
u = pushnewudata(L, size);
|
||||
p = u->uv.value;
|
||||
lua_unlock(L);
|
||||
return p;
|
||||
}
|
||||
|
||||
|
||||
LUA_API void lua_newuserdatabox (lua_State *L, void *p) {
|
||||
Udata *u;
|
||||
lua_lock(L);
|
||||
u = pushnewudata(L, 0);
|
||||
u->uv.value = p;
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
LUA_API int lua_getweakmode (lua_State *L, int index) {
|
||||
StkId t;
|
||||
int mode;
|
||||
lua_lock(L);
|
||||
t = luaA_index(L, index);
|
||||
api_check(L, ttype(t) == LUA_TTABLE);
|
||||
mode = hvalue(t)->weakmode;
|
||||
lua_unlock(L);
|
||||
return mode;
|
||||
}
|
||||
|
||||
|
||||
LUA_API void lua_setweakmode (lua_State *L, int mode) {
|
||||
lua_lock(L);
|
||||
api_check(L, ttype(L->top-1) == LUA_TTABLE);
|
||||
hvalue(L->top-1)->weakmode = mode;
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
17
lapi.h
17
lapi.h
@@ -1,17 +0,0 @@
|
||||
/*
|
||||
** $Id: lapi.h,v 1.19 2000/08/28 17:57:04 roberto Exp roberto $
|
||||
** Auxiliary functions from Lua API
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
#ifndef lapi_h
|
||||
#define lapi_h
|
||||
|
||||
|
||||
#include "lobject.h"
|
||||
|
||||
|
||||
TObject *luaA_index (lua_State *L, int index);
|
||||
void luaA_pushobject (lua_State *L, const TObject *o);
|
||||
|
||||
#endif
|
||||
225
lauxlib.c
225
lauxlib.c
@@ -1,225 +0,0 @@
|
||||
/*
|
||||
** $Id: lauxlib.c,v 1.50 2001/04/23 16:35:45 roberto Exp roberto $
|
||||
** Auxiliary functions for building Lua libraries
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
#include <stdarg.h>
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
|
||||
/* This file uses only the official API of Lua.
|
||||
** Any function declared here could be written as an application function.
|
||||
** With care, these functions can be used by other libraries.
|
||||
*/
|
||||
|
||||
#define LUA_PRIVATE
|
||||
#include "lua.h"
|
||||
|
||||
#include "lauxlib.h"
|
||||
#include "luadebug.h"
|
||||
#include "lualib.h"
|
||||
|
||||
|
||||
|
||||
LUALIB_API int luaL_findstring (const l_char *name, const l_char *const list[]) {
|
||||
int i;
|
||||
for (i=0; list[i]; i++)
|
||||
if (strcmp(list[i], name) == 0)
|
||||
return i;
|
||||
return -1; /* name not found */
|
||||
}
|
||||
|
||||
LUALIB_API void luaL_argerror (lua_State *L, int narg, const l_char *extramsg) {
|
||||
lua_Debug ar;
|
||||
lua_getstack(L, 0, &ar);
|
||||
lua_getinfo(L, l_s("n"), &ar);
|
||||
if (ar.name == NULL)
|
||||
ar.name = l_s("?");
|
||||
luaL_verror(L, l_s("bad argument #%d to `%.50s' (%.100s)"),
|
||||
narg, ar.name, extramsg);
|
||||
}
|
||||
|
||||
|
||||
static void type_error (lua_State *L, int narg, const l_char *tname) {
|
||||
l_char buff[80];
|
||||
sprintf(buff, l_s("%.25s expected, got %.25s"), tname, lua_type(L,narg));
|
||||
luaL_argerror(L, narg, buff);
|
||||
}
|
||||
|
||||
|
||||
static void tag_error (lua_State *L, int narg, int tag) {
|
||||
type_error(L, narg, lua_typename(L, tag));
|
||||
}
|
||||
|
||||
|
||||
LUALIB_API void luaL_checkstack (lua_State *L, int space, const l_char *mes) {
|
||||
if (space > lua_stackspace(L))
|
||||
luaL_verror(L, l_s("stack overflow (%.30s)"), mes);
|
||||
}
|
||||
|
||||
|
||||
LUALIB_API void luaL_checktype(lua_State *L, int narg, int t) {
|
||||
if (lua_rawtag(L, narg) != t)
|
||||
tag_error(L, narg, t);
|
||||
}
|
||||
|
||||
|
||||
LUALIB_API void luaL_checkany (lua_State *L, int narg) {
|
||||
if (lua_rawtag(L, narg) == LUA_TNONE)
|
||||
luaL_argerror(L, narg, l_s("value expected"));
|
||||
}
|
||||
|
||||
|
||||
LUALIB_API void *luaL_check_userdata (lua_State *L, int narg,
|
||||
const l_char *name) {
|
||||
if (strcmp(lua_type(L, narg), name) != 0)
|
||||
type_error(L, narg, name);
|
||||
return lua_touserdata(L, narg);
|
||||
}
|
||||
|
||||
|
||||
LUALIB_API const l_char *luaL_check_lstr (lua_State *L, int narg, size_t *len) {
|
||||
const l_char *s = lua_tostring(L, narg);
|
||||
if (!s) tag_error(L, narg, LUA_TSTRING);
|
||||
if (len) *len = lua_strlen(L, narg);
|
||||
return s;
|
||||
}
|
||||
|
||||
|
||||
LUALIB_API const l_char *luaL_opt_lstr (lua_State *L, int narg, const l_char *def, size_t *len) {
|
||||
if (lua_isnull(L, narg)) {
|
||||
if (len)
|
||||
*len = (def ? strlen(def) : 0);
|
||||
return def;
|
||||
}
|
||||
else return luaL_check_lstr(L, narg, len);
|
||||
}
|
||||
|
||||
|
||||
LUALIB_API lua_Number luaL_check_number (lua_State *L, int narg) {
|
||||
lua_Number d = lua_tonumber(L, narg);
|
||||
if (d == 0 && !lua_isnumber(L, narg)) /* avoid extra test when d is not 0 */
|
||||
tag_error(L, narg, LUA_TNUMBER);
|
||||
return d;
|
||||
}
|
||||
|
||||
|
||||
LUALIB_API lua_Number luaL_opt_number (lua_State *L, int narg, lua_Number def) {
|
||||
if (lua_isnull(L, narg)) return def;
|
||||
else return luaL_check_number(L, narg);
|
||||
}
|
||||
|
||||
|
||||
LUALIB_API void luaL_openlib (lua_State *L, const luaL_reg *l, int n) {
|
||||
int i;
|
||||
for (i=0; i<n; i++)
|
||||
lua_register(L, l[i].name, l[i].func);
|
||||
}
|
||||
|
||||
|
||||
LUALIB_API void luaL_verror (lua_State *L, const l_char *fmt, ...) {
|
||||
l_char buff[500];
|
||||
va_list argp;
|
||||
va_start(argp, fmt);
|
||||
vsprintf(buff, fmt, argp);
|
||||
va_end(argp);
|
||||
lua_error(L, buff);
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** {======================================================
|
||||
** Generic Buffer manipulation
|
||||
** =======================================================
|
||||
*/
|
||||
|
||||
|
||||
#define buffempty(B) ((B)->p == (B)->buffer)
|
||||
#define bufflen(B) ((B)->p - (B)->buffer)
|
||||
#define bufffree(B) ((size_t)(LUAL_BUFFERSIZE - bufflen(B)))
|
||||
|
||||
#define LIMIT (LUA_MINSTACK/2)
|
||||
|
||||
|
||||
static int emptybuffer (luaL_Buffer *B) {
|
||||
size_t l = bufflen(B);
|
||||
if (l == 0) return 0; /* put nothing on stack */
|
||||
else {
|
||||
lua_pushlstring(B->L, B->buffer, l);
|
||||
B->p = B->buffer;
|
||||
B->level++;
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void adjuststack (luaL_Buffer *B) {
|
||||
if (B->level > 1) {
|
||||
lua_State *L = B->L;
|
||||
int toget = 1; /* number of levels to concat */
|
||||
size_t toplen = lua_strlen(L, -1);
|
||||
do {
|
||||
size_t l = lua_strlen(L, -(toget+1));
|
||||
if (B->level - toget + 1 >= LIMIT || toplen > l) {
|
||||
toplen += l;
|
||||
toget++;
|
||||
}
|
||||
else break;
|
||||
} while (toget < B->level);
|
||||
lua_concat(L, toget);
|
||||
B->level = B->level - toget + 1;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
LUALIB_API l_char *luaL_prepbuffer (luaL_Buffer *B) {
|
||||
if (emptybuffer(B))
|
||||
adjuststack(B);
|
||||
return B->buffer;
|
||||
}
|
||||
|
||||
|
||||
LUALIB_API void luaL_addlstring (luaL_Buffer *B, const l_char *s, size_t l) {
|
||||
while (l--)
|
||||
luaL_putchar(B, *s++);
|
||||
}
|
||||
|
||||
|
||||
LUALIB_API void luaL_addstring (luaL_Buffer *B, const l_char *s) {
|
||||
luaL_addlstring(B, s, strlen(s));
|
||||
}
|
||||
|
||||
|
||||
LUALIB_API void luaL_pushresult (luaL_Buffer *B) {
|
||||
emptybuffer(B);
|
||||
lua_concat(B->L, B->level);
|
||||
B->level = 1;
|
||||
}
|
||||
|
||||
|
||||
LUALIB_API void luaL_addvalue (luaL_Buffer *B) {
|
||||
lua_State *L = B->L;
|
||||
size_t vl = lua_strlen(L, -1);
|
||||
if (vl <= bufffree(B)) { /* fit into buffer? */
|
||||
memcpy(B->p, lua_tostring(L, -1), vl); /* put it there */
|
||||
B->p += vl;
|
||||
lua_pop(L, 1); /* remove from stack */
|
||||
}
|
||||
else {
|
||||
if (emptybuffer(B))
|
||||
lua_insert(L, -2); /* put buffer before new value */
|
||||
B->level++; /* add new value into B stack */
|
||||
adjuststack(B);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
LUALIB_API void luaL_buffinit (lua_State *L, luaL_Buffer *B) {
|
||||
B->L = L;
|
||||
B->p = B->buffer;
|
||||
B->level = 0;
|
||||
}
|
||||
|
||||
/* }====================================================== */
|
||||
106
lauxlib.h
106
lauxlib.h
@@ -1,106 +0,0 @@
|
||||
/*
|
||||
** $Id: lauxlib.h,v 1.35 2001/04/06 21:17:37 roberto Exp roberto $
|
||||
** Auxiliary functions for building Lua libraries
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
#ifndef lauxlib_h
|
||||
#define lauxlib_h
|
||||
|
||||
|
||||
#include <stddef.h>
|
||||
#include <stdio.h>
|
||||
|
||||
#include "lua.h"
|
||||
|
||||
|
||||
#ifndef LUALIB_API
|
||||
#define LUALIB_API extern
|
||||
#endif
|
||||
|
||||
|
||||
typedef struct luaL_reg {
|
||||
const lua_char *name;
|
||||
lua_CFunction func;
|
||||
} luaL_reg;
|
||||
|
||||
|
||||
LUALIB_API void luaL_openlib (lua_State *L, const luaL_reg *l, int n);
|
||||
LUALIB_API void luaL_argerror (lua_State *L, int numarg,
|
||||
const lua_char *extramsg);
|
||||
LUALIB_API const lua_char *luaL_check_lstr (lua_State *L, int numArg,
|
||||
size_t *len);
|
||||
LUALIB_API const lua_char *luaL_opt_lstr (lua_State *L, int numArg,
|
||||
const lua_char *def, size_t *len);
|
||||
LUALIB_API lua_Number luaL_check_number (lua_State *L, int numArg);
|
||||
LUALIB_API lua_Number luaL_opt_number (lua_State *L, int nArg, lua_Number def);
|
||||
|
||||
LUALIB_API void luaL_checkstack (lua_State *L, int space, const lua_char *msg);
|
||||
LUALIB_API void luaL_checktype (lua_State *L, int narg, int t);
|
||||
LUALIB_API void luaL_checkany (lua_State *L, int narg);
|
||||
LUALIB_API void *luaL_check_userdata (lua_State *L, int narg,
|
||||
const lua_char *name);
|
||||
|
||||
LUALIB_API void luaL_verror (lua_State *L, const lua_char *fmt, ...);
|
||||
LUALIB_API int luaL_findstring (const lua_char *name,
|
||||
const lua_char *const list[]);
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** ===============================================================
|
||||
** some useful macros
|
||||
** ===============================================================
|
||||
*/
|
||||
|
||||
#define luaL_arg_check(L, cond,numarg,extramsg) if (!(cond)) \
|
||||
luaL_argerror(L, numarg,extramsg)
|
||||
#define luaL_check_string(L,n) (luaL_check_lstr(L, (n), NULL))
|
||||
#define luaL_opt_string(L,n,d) (luaL_opt_lstr(L, (n), (d), NULL))
|
||||
#define luaL_check_int(L,n) ((int)luaL_check_number(L, n))
|
||||
#define luaL_check_long(L,n) ((long)luaL_check_number(L, n))
|
||||
#define luaL_opt_int(L,n,d) ((int)luaL_opt_number(L, n,d))
|
||||
#define luaL_opt_long(L,n,d) ((long)luaL_opt_number(L, n,d))
|
||||
#define luaL_openl(L,a) luaL_openlib(L, a, (sizeof(a)/sizeof(a[0])))
|
||||
|
||||
|
||||
/*
|
||||
** {======================================================
|
||||
** Generic Buffer manipulation
|
||||
** =======================================================
|
||||
*/
|
||||
|
||||
|
||||
#ifndef LUAL_BUFFERSIZE
|
||||
#define LUAL_BUFFERSIZE BUFSIZ
|
||||
#endif
|
||||
|
||||
|
||||
typedef struct luaL_Buffer {
|
||||
lua_char *p; /* current position in buffer */
|
||||
int level;
|
||||
lua_State *L;
|
||||
lua_char buffer[LUAL_BUFFERSIZE];
|
||||
} luaL_Buffer;
|
||||
|
||||
#define luaL_putchar(B,c) \
|
||||
((void)((B)->p < ((B)->buffer+LUAL_BUFFERSIZE) || luaL_prepbuffer(B)), \
|
||||
(*(B)->p++ = (lua_char)(c)))
|
||||
|
||||
#define luaL_addsize(B,n) ((B)->p += (n))
|
||||
|
||||
LUALIB_API void luaL_buffinit (lua_State *L, luaL_Buffer *B);
|
||||
LUALIB_API lua_char *luaL_prepbuffer (luaL_Buffer *B);
|
||||
LUALIB_API void luaL_addlstring (luaL_Buffer *B, const lua_char *s, size_t l);
|
||||
LUALIB_API void luaL_addstring (luaL_Buffer *B, const lua_char *s);
|
||||
LUALIB_API void luaL_addvalue (luaL_Buffer *B);
|
||||
LUALIB_API void luaL_pushresult (luaL_Buffer *B);
|
||||
|
||||
|
||||
/* }====================================================== */
|
||||
|
||||
|
||||
#endif
|
||||
|
||||
|
||||
745
lbaselib.c
745
lbaselib.c
@@ -1,745 +0,0 @@
|
||||
/*
|
||||
** $Id: lbaselib.c,v 1.38 2001/06/20 17:25:30 roberto Exp roberto $
|
||||
** Basic library
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
|
||||
#include <ctype.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
#define LUA_PRIVATE
|
||||
#include "lua.h"
|
||||
|
||||
#include "lauxlib.h"
|
||||
#include "luadebug.h"
|
||||
#include "lualib.h"
|
||||
|
||||
|
||||
|
||||
static void aux_setn (lua_State *L, int t, int n) {
|
||||
lua_pushliteral(L, l_s("n"));
|
||||
lua_pushnumber(L, n);
|
||||
lua_settable(L, t);
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** If your system does not support `stderr', redefine this function, or
|
||||
** redefine _ERRORMESSAGE so that it won't need _ALERT.
|
||||
*/
|
||||
static int luaB__ALERT (lua_State *L) {
|
||||
fputs(luaL_check_string(L, 1), stderr);
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Basic implementation of _ERRORMESSAGE.
|
||||
** The library `liolib' redefines _ERRORMESSAGE for better error information.
|
||||
*/
|
||||
static int luaB__ERRORMESSAGE (lua_State *L) {
|
||||
luaL_checktype(L, 1, LUA_TSTRING);
|
||||
lua_getglobal(L, l_s(LUA_ALERT));
|
||||
if (lua_isfunction(L, -1)) { /* avoid error loop if _ALERT is not defined */
|
||||
lua_Debug ar;
|
||||
lua_pushliteral(L, l_s("error: "));
|
||||
lua_pushvalue(L, 1);
|
||||
if (lua_getstack(L, 1, &ar)) {
|
||||
lua_getinfo(L, l_s("Sl"), &ar);
|
||||
if (ar.source && ar.currentline > 0) {
|
||||
l_char buff[100];
|
||||
sprintf(buff, l_s("\n <%.70s: line %d>"), ar.short_src, ar.currentline);
|
||||
lua_pushstring(L, buff);
|
||||
lua_concat(L, 2);
|
||||
}
|
||||
}
|
||||
lua_pushliteral(L, l_s("\n"));
|
||||
lua_concat(L, 3);
|
||||
lua_rawcall(L, 1, 0);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** If your system does not support `stdout', you can just remove this function.
|
||||
** If you need, you can define your own `print' function, following this
|
||||
** model but changing `fputs' to put the strings at a proper place
|
||||
** (a console window or a log file, for instance).
|
||||
*/
|
||||
static int luaB_print (lua_State *L) {
|
||||
int n = lua_gettop(L); /* number of arguments */
|
||||
int i;
|
||||
lua_getglobal(L, l_s("tostring"));
|
||||
for (i=1; i<=n; i++) {
|
||||
const l_char *s;
|
||||
lua_pushvalue(L, -1); /* function to be called */
|
||||
lua_pushvalue(L, i); /* value to print */
|
||||
lua_rawcall(L, 1, 1);
|
||||
s = lua_tostring(L, -1); /* get result */
|
||||
if (s == NULL)
|
||||
lua_error(L, l_s("`tostring' must return a string to `print'"));
|
||||
if (i>1) fputs(l_s("\t"), stdout);
|
||||
fputs(s, stdout);
|
||||
lua_pop(L, 1); /* pop result */
|
||||
}
|
||||
fputs(l_s("\n"), stdout);
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
static int luaB_tonumber (lua_State *L) {
|
||||
int base = luaL_opt_int(L, 2, 10);
|
||||
if (base == 10) { /* standard conversion */
|
||||
luaL_checkany(L, 1);
|
||||
if (lua_isnumber(L, 1)) {
|
||||
lua_pushnumber(L, lua_tonumber(L, 1));
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
else {
|
||||
const l_char *s1 = luaL_check_string(L, 1);
|
||||
l_char *s2;
|
||||
unsigned long n;
|
||||
luaL_arg_check(L, 2 <= base && base <= 36, 2, l_s("base out of range"));
|
||||
n = strtoul(s1, &s2, base);
|
||||
if (s1 != s2) { /* at least one valid digit? */
|
||||
while (isspace(uchar(*s2))) s2++; /* skip trailing spaces */
|
||||
if (*s2 == l_c('\0')) { /* no invalid trailing characters? */
|
||||
lua_pushnumber(L, n);
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
lua_pushnil(L); /* else not a number */
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int luaB_error (lua_State *L) {
|
||||
lua_error(L, luaL_opt_string(L, 1, NULL));
|
||||
return 0; /* to avoid warnings */
|
||||
}
|
||||
|
||||
static int luaB_setglobal (lua_State *L) {
|
||||
luaL_checkany(L, 2);
|
||||
lua_setglobal(L, luaL_check_string(L, 1));
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int luaB_getglobal (lua_State *L) {
|
||||
lua_getglobal(L, luaL_check_string(L, 1));
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
/* auxiliary function to get `tags' */
|
||||
static int gettag (lua_State *L, int narg) {
|
||||
switch (lua_rawtag(L, narg)) {
|
||||
case LUA_TNUMBER:
|
||||
return (int)lua_tonumber(L, narg);
|
||||
case LUA_TSTRING: {
|
||||
const l_char *name = lua_tostring(L, narg);
|
||||
int tag = lua_name2tag(L, name);
|
||||
if (tag == LUA_TNONE)
|
||||
luaL_verror(L, l_s("'%.30s' is not a valid type name"), name);
|
||||
return tag;
|
||||
}
|
||||
default:
|
||||
luaL_argerror(L, narg, l_s("tag or type name expected"));
|
||||
return 0; /* to avoid warnings */
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static int luaB_tag (lua_State *L) {
|
||||
luaL_checkany(L, 1);
|
||||
lua_pushnumber(L, lua_tag(L, 1));
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int luaB_settype (lua_State *L) {
|
||||
luaL_checktype(L, 1, LUA_TTABLE);
|
||||
lua_pushvalue(L, 1); /* push table */
|
||||
lua_settag(L, gettag(L, 2));
|
||||
return 1; /* return table */
|
||||
}
|
||||
|
||||
static int luaB_weakmode (lua_State *L) {
|
||||
const l_char *mode = luaL_check_string(L, 2);
|
||||
luaL_checktype(L, 1, LUA_TTABLE);
|
||||
if (*mode == l_c('?')) {
|
||||
l_char buff[3];
|
||||
l_char *s = buff;
|
||||
int imode = lua_getweakmode(L, 1);
|
||||
if (imode & LUA_WEAK_KEY) *s++ = 'k';
|
||||
if (imode & LUA_WEAK_VALUE) *s++ = 'v';
|
||||
*s = '\0';
|
||||
lua_pushstring(L, buff);
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
int imode = 0;
|
||||
if (strchr(mode, l_c('k'))) imode |= LUA_WEAK_KEY;
|
||||
if (strchr(mode, l_c('v'))) imode |= LUA_WEAK_VALUE;
|
||||
lua_pushvalue(L, 1); /* push table */
|
||||
lua_setweakmode(L, imode);
|
||||
return 1; /* return the table */
|
||||
}
|
||||
}
|
||||
|
||||
static int luaB_newtype (lua_State *L) {
|
||||
const l_char *name = luaL_opt_string(L, 1, NULL);
|
||||
lua_pushnumber(L, lua_newtype(L, name, LUA_TTABLE));
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int luaB_copytagmethods (lua_State *L) {
|
||||
lua_pushnumber(L, lua_copytagmethods(L, gettag(L, 1), gettag(L, 2)));
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int luaB_globals (lua_State *L) {
|
||||
lua_getglobals(L); /* value to be returned */
|
||||
if (!lua_isnull(L, 1)) {
|
||||
luaL_checktype(L, 1, LUA_TTABLE);
|
||||
lua_pushvalue(L, 1); /* new table of globals */
|
||||
lua_setglobals(L);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int luaB_rawget (lua_State *L) {
|
||||
luaL_checktype(L, 1, LUA_TTABLE);
|
||||
luaL_checkany(L, 2);
|
||||
lua_rawget(L, -2);
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int luaB_rawset (lua_State *L) {
|
||||
luaL_checktype(L, 1, LUA_TTABLE);
|
||||
luaL_checkany(L, 2);
|
||||
luaL_checkany(L, 3);
|
||||
lua_rawset(L, -3);
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int luaB_settagmethod (lua_State *L) {
|
||||
int tag = gettag(L, 1);
|
||||
const l_char *event = luaL_check_string(L, 2);
|
||||
luaL_arg_check(L, lua_isfunction(L, 3) || lua_isnil(L, 3), 3,
|
||||
l_s("function or nil expected"));
|
||||
if (strcmp(event, l_s("gc")) == 0)
|
||||
lua_error(L, l_s("deprecated use: cannot set the `gc' tag method from Lua"));
|
||||
lua_gettagmethod(L, tag, event);
|
||||
lua_pushvalue(L, 3);
|
||||
lua_settagmethod(L, tag, event);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int luaB_gettagmethod (lua_State *L) {
|
||||
int tag = gettag(L, 1);
|
||||
const l_char *event = luaL_check_string(L, 2);
|
||||
if (strcmp(event, l_s("gc")) == 0)
|
||||
lua_error(L, l_s("deprecated use: cannot get the `gc' tag method from Lua"));
|
||||
lua_gettagmethod(L, tag, event);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int luaB_gcinfo (lua_State *L) {
|
||||
lua_pushnumber(L, lua_getgccount(L));
|
||||
lua_pushnumber(L, lua_getgcthreshold(L));
|
||||
return 2;
|
||||
}
|
||||
|
||||
|
||||
static int luaB_collectgarbage (lua_State *L) {
|
||||
lua_setgcthreshold(L, luaL_opt_int(L, 1, 0));
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
static int luaB_type (lua_State *L) {
|
||||
luaL_checkany(L, 1);
|
||||
lua_pushstring(L, lua_type(L, 1));
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int luaB_rawtype (lua_State *L) {
|
||||
luaL_checkany(L, 1);
|
||||
lua_pushstring(L, lua_tag2name(L, lua_rawtag(L, 1)));
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int luaB_next (lua_State *L) {
|
||||
luaL_checktype(L, 1, LUA_TTABLE);
|
||||
lua_settop(L, 2); /* create a 2nd argument if there isn't one */
|
||||
if (lua_next(L, 1))
|
||||
return 2;
|
||||
else {
|
||||
lua_pushnil(L);
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static int passresults (lua_State *L, int status, int oldtop) {
|
||||
static const l_char *const errornames[] =
|
||||
{l_s("ok"), l_s("run-time error"), l_s("file error"), l_s("syntax error"),
|
||||
l_s("memory error"), l_s("error in error handling")};
|
||||
if (status == 0) {
|
||||
int nresults = lua_gettop(L) - oldtop;
|
||||
if (nresults > 0)
|
||||
return nresults; /* results are already on the stack */
|
||||
else {
|
||||
lua_newuserdatabox(L, NULL); /* at least one result to signal no errors */
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
else { /* error */
|
||||
lua_pushnil(L);
|
||||
lua_pushstring(L, errornames[status]); /* error code */
|
||||
return 2;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static int luaB_dostring (lua_State *L) {
|
||||
int oldtop = lua_gettop(L);
|
||||
size_t l;
|
||||
const l_char *s = luaL_check_lstr(L, 1, &l);
|
||||
const l_char *chunkname = luaL_opt_string(L, 2, s);
|
||||
return passresults(L, lua_dobuffer(L, s, l, chunkname), oldtop);
|
||||
}
|
||||
|
||||
|
||||
static int luaB_loadstring (lua_State *L) {
|
||||
int oldtop = lua_gettop(L);
|
||||
size_t l;
|
||||
const l_char *s = luaL_check_lstr(L, 1, &l);
|
||||
const l_char *chunkname = luaL_opt_string(L, 2, s);
|
||||
return passresults(L, lua_loadbuffer(L, s, l, chunkname), oldtop);
|
||||
}
|
||||
|
||||
static int luaB_dofile (lua_State *L) {
|
||||
int oldtop = lua_gettop(L);
|
||||
const l_char *fname = luaL_opt_string(L, 1, NULL);
|
||||
return passresults(L, lua_dofile(L, fname), oldtop);
|
||||
}
|
||||
|
||||
|
||||
static int luaB_loadfile (lua_State *L) {
|
||||
int oldtop = lua_gettop(L);
|
||||
const l_char *fname = luaL_opt_string(L, 1, NULL);
|
||||
return passresults(L, lua_loadfile(L, fname), oldtop);
|
||||
}
|
||||
|
||||
|
||||
|
||||
#define LUA_PATH l_s("LUA_PATH")
|
||||
|
||||
#define LUA_PATH_SEP l_s(";")
|
||||
|
||||
#ifndef LUA_PATH_DEFAULT
|
||||
#define LUA_PATH_DEFAULT l_s("./")
|
||||
#endif
|
||||
|
||||
static int luaB_require (lua_State *L) {
|
||||
const l_char *path;
|
||||
luaL_check_string(L, 1);
|
||||
lua_settop(L, 1);
|
||||
lua_getglobal(L, LUA_PATH); /* get path */
|
||||
if (lua_isstring(L, 2)) /* is LUA_PATH defined? */
|
||||
path = lua_tostring(L, 2);
|
||||
else { /* LUA_PATH not defined */
|
||||
lua_pop(L, 1); /* pop old global value */
|
||||
path = getenv(LUA_PATH); /* try environment variable */
|
||||
if (path == NULL) path = LUA_PATH_DEFAULT; /* else use default */
|
||||
lua_pushstring(L, path);
|
||||
lua_pushvalue(L, -1); /* duplicate to leave a copy on stack */
|
||||
lua_setglobal(L, LUA_PATH);
|
||||
}
|
||||
lua_getregistry(L);
|
||||
lua_pushliteral(L, LUA_PATH);
|
||||
lua_gettable(L, 3); /* get book-keeping table */
|
||||
if (lua_isnil(L, 4)) { /* no book-keeping table? */
|
||||
lua_pop(L, 1); /* pop the `nil' */
|
||||
lua_newtable(L); /* create book-keeping table */
|
||||
lua_pushliteral(L, LUA_PATH);
|
||||
lua_pushvalue(L, -2); /* duplicate table to leave a copy on stack */
|
||||
lua_settable(L, 3); /* store book-keeping table in registry */
|
||||
}
|
||||
lua_pushvalue(L, 1);
|
||||
lua_gettable(L, 4); /* check package's name in book-keeping table */
|
||||
if (!lua_isnil(L, -1)) /* is it there? */
|
||||
return 0; /* package is already loaded */
|
||||
else { /* must load it */
|
||||
for (;;) { /* traverse path */
|
||||
int res;
|
||||
int l = strcspn(path, LUA_PATH_SEP); /* find separator */
|
||||
lua_pushlstring(L, path, l); /* directory name */
|
||||
lua_pushvalue(L, 1); /* package name */
|
||||
lua_concat(L, 2); /* concat directory with package name */
|
||||
res = lua_dofile(L, lua_tostring(L, -1)); /* try to load it */
|
||||
lua_settop(L, 4); /* pop string and eventual results from dofile */
|
||||
if (res == 0) break; /* ok; file done */
|
||||
else if (res != LUA_ERRFILE)
|
||||
lua_error(L, NULL); /* error running package; propagate it */
|
||||
if (*(path+l) == l_c('\0')) /* no more directories? */
|
||||
luaL_verror(L, l_s("could not load package `%.20s' from path `%.200s'"),
|
||||
lua_tostring(L, 1), lua_tostring(L, 2));
|
||||
path += l+1; /* try next directory */
|
||||
}
|
||||
}
|
||||
lua_pushvalue(L, 1);
|
||||
lua_pushnumber(L, 1);
|
||||
lua_settable(L, 4); /* mark it as loaded */
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
static int aux_unpack (lua_State *L, int arg) {
|
||||
int n, i;
|
||||
luaL_checktype(L, arg, LUA_TTABLE);
|
||||
n = lua_getn(L, arg);
|
||||
luaL_checkstack(L, n, l_s("table too big to unpack"));
|
||||
for (i=1; i<=n; i++) /* push arg[1...n] */
|
||||
lua_rawgeti(L, arg, i);
|
||||
return n;
|
||||
}
|
||||
|
||||
|
||||
static int luaB_unpack (lua_State *L) {
|
||||
return aux_unpack(L, 1);
|
||||
}
|
||||
|
||||
|
||||
static int luaB_call (lua_State *L) {
|
||||
int oldtop;
|
||||
const l_char *options = luaL_opt_string(L, 3, l_s(""));
|
||||
int err = 0; /* index of old error method */
|
||||
int status;
|
||||
int n;
|
||||
if (!lua_isnull(L, 4)) { /* set new error method */
|
||||
lua_getglobal(L, l_s(LUA_ERRORMESSAGE));
|
||||
err = lua_gettop(L); /* get index */
|
||||
lua_pushvalue(L, 4);
|
||||
lua_setglobal(L, l_s(LUA_ERRORMESSAGE));
|
||||
}
|
||||
oldtop = lua_gettop(L); /* top before function-call preparation */
|
||||
/* push function */
|
||||
lua_pushvalue(L, 1);
|
||||
n = aux_unpack(L, 2); /* push arg[1...n] */
|
||||
status = lua_call(L, n, LUA_MULTRET);
|
||||
if (err != 0) { /* restore old error method */
|
||||
lua_pushvalue(L, err);
|
||||
lua_setglobal(L, l_s(LUA_ERRORMESSAGE));
|
||||
}
|
||||
if (status != 0) { /* error in call? */
|
||||
if (strchr(options, l_c('x')))
|
||||
lua_pushnil(L); /* return nil to signal the error */
|
||||
else
|
||||
lua_error(L, NULL); /* propagate error without additional messages */
|
||||
return 1;
|
||||
}
|
||||
if (strchr(options, l_c('p'))) /* pack results? */
|
||||
lua_error(L, l_s("deprecated option `p' in `call'"));
|
||||
return lua_gettop(L) - oldtop; /* results are already on the stack */
|
||||
}
|
||||
|
||||
|
||||
static int luaB_tostring (lua_State *L) {
|
||||
l_char buff[64];
|
||||
switch (lua_rawtag(L, 1)) {
|
||||
case LUA_TNUMBER:
|
||||
lua_pushstring(L, lua_tostring(L, 1));
|
||||
return 1;
|
||||
case LUA_TSTRING:
|
||||
lua_pushvalue(L, 1);
|
||||
return 1;
|
||||
case LUA_TTABLE:
|
||||
sprintf(buff, l_s("%.40s: %p"), lua_type(L, 1), lua_topointer(L, 1));
|
||||
break;
|
||||
case LUA_TFUNCTION:
|
||||
sprintf(buff, l_s("function: %p"), lua_topointer(L, 1));
|
||||
break;
|
||||
case LUA_TUSERDATA: {
|
||||
const l_char *t = lua_type(L, 1);
|
||||
if (strcmp(t, l_s("userdata")) == 0)
|
||||
sprintf(buff, l_s("userdata(%d): %p"), lua_tag(L, 1),
|
||||
lua_touserdata(L, 1));
|
||||
else
|
||||
sprintf(buff, l_s("%.40s: %p"), t, lua_touserdata(L, 1));
|
||||
break;
|
||||
}
|
||||
case LUA_TNIL:
|
||||
lua_pushliteral(L, l_s("nil"));
|
||||
return 1;
|
||||
default:
|
||||
luaL_argerror(L, 1, l_s("value expected"));
|
||||
}
|
||||
lua_pushstring(L, buff);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int luaB_foreachi (lua_State *L) {
|
||||
int n, i;
|
||||
luaL_checktype(L, 1, LUA_TTABLE);
|
||||
luaL_checktype(L, 2, LUA_TFUNCTION);
|
||||
n = lua_getn(L, 1);
|
||||
for (i=1; i<=n; i++) {
|
||||
lua_pushvalue(L, 2); /* function */
|
||||
lua_pushnumber(L, i); /* 1st argument */
|
||||
lua_rawgeti(L, 1, i); /* 2nd argument */
|
||||
lua_rawcall(L, 2, 1);
|
||||
if (!lua_isnil(L, -1))
|
||||
return 1;
|
||||
lua_pop(L, 1); /* remove nil result */
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
static int luaB_foreach (lua_State *L) {
|
||||
luaL_checktype(L, 1, LUA_TTABLE);
|
||||
luaL_checktype(L, 2, LUA_TFUNCTION);
|
||||
lua_pushnil(L); /* first index */
|
||||
for (;;) {
|
||||
if (lua_next(L, 1) == 0)
|
||||
return 0;
|
||||
lua_pushvalue(L, 2); /* function */
|
||||
lua_pushvalue(L, -3); /* key */
|
||||
lua_pushvalue(L, -3); /* value */
|
||||
lua_rawcall(L, 2, 1);
|
||||
if (!lua_isnil(L, -1))
|
||||
return 1;
|
||||
lua_pop(L, 2); /* remove value and result */
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static int luaB_assert (lua_State *L) {
|
||||
luaL_checkany(L, 1);
|
||||
if (lua_isnil(L, 1))
|
||||
luaL_verror(L, l_s("assertion failed! %.90s"), luaL_opt_string(L, 2, l_s("")));
|
||||
lua_settop(L, 1);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int luaB_getn (lua_State *L) {
|
||||
luaL_checktype(L, 1, LUA_TTABLE);
|
||||
lua_pushnumber(L, lua_getn(L, 1));
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int luaB_tinsert (lua_State *L) {
|
||||
int v = lua_gettop(L); /* last argument: to be inserted */
|
||||
int n, pos;
|
||||
luaL_checktype(L, 1, LUA_TTABLE);
|
||||
n = lua_getn(L, 1);
|
||||
if (v == 2) /* called with only 2 arguments */
|
||||
pos = n+1;
|
||||
else
|
||||
pos = luaL_check_int(L, 2); /* 2nd argument is the position */
|
||||
aux_setn(L, 1, n+1); /* t.n = n+1 */
|
||||
for (; n>=pos; n--) {
|
||||
lua_rawgeti(L, 1, n);
|
||||
lua_rawseti(L, 1, n+1); /* t[n+1] = t[n] */
|
||||
}
|
||||
lua_pushvalue(L, v);
|
||||
lua_rawseti(L, 1, pos); /* t[pos] = v */
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
static int luaB_tremove (lua_State *L) {
|
||||
int pos, n;
|
||||
luaL_checktype(L, 1, LUA_TTABLE);
|
||||
n = lua_getn(L, 1);
|
||||
pos = luaL_opt_int(L, 2, n);
|
||||
if (n <= 0) return 0; /* table is `empty' */
|
||||
aux_setn(L, 1, n-1); /* t.n = n-1 */
|
||||
lua_rawgeti(L, 1, pos); /* result = t[pos] */
|
||||
for ( ;pos<n; pos++) {
|
||||
lua_rawgeti(L, 1, pos+1);
|
||||
lua_rawseti(L, 1, pos); /* a[pos] = a[pos+1] */
|
||||
}
|
||||
lua_pushnil(L);
|
||||
lua_rawseti(L, 1, n); /* t[n] = nil */
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** {======================================================
|
||||
** Quicksort
|
||||
** (based on `Algorithms in MODULA-3', Robert Sedgewick;
|
||||
** Addison-Wesley, 1993.)
|
||||
*/
|
||||
|
||||
|
||||
static void set2 (lua_State *L, int i, int j) {
|
||||
lua_rawseti(L, 1, i);
|
||||
lua_rawseti(L, 1, j);
|
||||
}
|
||||
|
||||
static int sort_comp (lua_State *L, int a, int b) {
|
||||
/* WARNING: the caller (auxsort) must ensure stack space */
|
||||
if (!lua_isnil(L, 2)) { /* function? */
|
||||
int res;
|
||||
lua_pushvalue(L, 2);
|
||||
lua_pushvalue(L, a-1); /* -1 to compensate function */
|
||||
lua_pushvalue(L, b-2); /* -2 to compensate function and `a' */
|
||||
lua_rawcall(L, 2, 1);
|
||||
res = !lua_isnil(L, -1);
|
||||
lua_pop(L, 1);
|
||||
return res;
|
||||
}
|
||||
else /* a < b? */
|
||||
return lua_lessthan(L, a, b);
|
||||
}
|
||||
|
||||
static void auxsort (lua_State *L, int l, int u) {
|
||||
while (l < u) { /* for tail recursion */
|
||||
int i, j;
|
||||
/* sort elements a[l], a[(l+u)/2] and a[u] */
|
||||
lua_rawgeti(L, 1, l);
|
||||
lua_rawgeti(L, 1, u);
|
||||
if (sort_comp(L, -1, -2)) /* a[u] < a[l]? */
|
||||
set2(L, l, u); /* swap a[l] - a[u] */
|
||||
else
|
||||
lua_pop(L, 2);
|
||||
if (u-l == 1) break; /* only 2 elements */
|
||||
i = (l+u)/2;
|
||||
lua_rawgeti(L, 1, i);
|
||||
lua_rawgeti(L, 1, l);
|
||||
if (sort_comp(L, -2, -1)) /* a[i]<a[l]? */
|
||||
set2(L, i, l);
|
||||
else {
|
||||
lua_pop(L, 1); /* remove a[l] */
|
||||
lua_rawgeti(L, 1, u);
|
||||
if (sort_comp(L, -1, -2)) /* a[u]<a[i]? */
|
||||
set2(L, i, u);
|
||||
else
|
||||
lua_pop(L, 2);
|
||||
}
|
||||
if (u-l == 2) break; /* only 3 elements */
|
||||
lua_rawgeti(L, 1, i); /* Pivot */
|
||||
lua_pushvalue(L, -1);
|
||||
lua_rawgeti(L, 1, u-1);
|
||||
set2(L, i, u-1);
|
||||
/* a[l] <= P == a[u-1] <= a[u], only need to sort from l+1 to u-2 */
|
||||
i = l; j = u-1;
|
||||
for (;;) { /* invariant: a[l..i] <= P <= a[j..u] */
|
||||
/* repeat ++i until a[i] >= P */
|
||||
while (lua_rawgeti(L, 1, ++i), sort_comp(L, -1, -2)) {
|
||||
if (i>u) lua_error(L, l_s("invalid order function for sorting"));
|
||||
lua_pop(L, 1); /* remove a[i] */
|
||||
}
|
||||
/* repeat --j until a[j] <= P */
|
||||
while (lua_rawgeti(L, 1, --j), sort_comp(L, -3, -1)) {
|
||||
if (j<l) lua_error(L, l_s("invalid order function for sorting"));
|
||||
lua_pop(L, 1); /* remove a[j] */
|
||||
}
|
||||
if (j<i) {
|
||||
lua_pop(L, 3); /* pop pivot, a[i], a[j] */
|
||||
break;
|
||||
}
|
||||
set2(L, i, j);
|
||||
}
|
||||
lua_rawgeti(L, 1, u-1);
|
||||
lua_rawgeti(L, 1, i);
|
||||
set2(L, u-1, i); /* swap pivot (a[u-1]) with a[i] */
|
||||
/* a[l..i-1] <= a[i] == P <= a[i+1..u] */
|
||||
/* adjust so that smaller half is in [j..i] and larger one in [l..u] */
|
||||
if (i-l < u-i) {
|
||||
j=l; i=i-1; l=i+2;
|
||||
}
|
||||
else {
|
||||
j=i+1; i=u; u=j-2;
|
||||
}
|
||||
auxsort(L, j, i); /* call recursively the smaller one */
|
||||
} /* repeat the routine for the larger one */
|
||||
}
|
||||
|
||||
static int luaB_sort (lua_State *L) {
|
||||
int n;
|
||||
luaL_checktype(L, 1, LUA_TTABLE);
|
||||
n = lua_getn(L, 1);
|
||||
if (!lua_isnull(L, 2)) /* is there a 2nd argument? */
|
||||
luaL_checktype(L, 2, LUA_TFUNCTION);
|
||||
lua_settop(L, 2); /* make sure there is two arguments */
|
||||
auxsort(L, 1, n);
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* }====================================================== */
|
||||
|
||||
|
||||
|
||||
static const luaL_reg base_funcs[] = {
|
||||
{l_s(LUA_ALERT), luaB__ALERT},
|
||||
{l_s(LUA_ERRORMESSAGE), luaB__ERRORMESSAGE},
|
||||
{l_s("call"), luaB_call},
|
||||
{l_s("collectgarbage"), luaB_collectgarbage},
|
||||
{l_s("copytagmethods"), luaB_copytagmethods},
|
||||
{l_s("dofile"), luaB_dofile},
|
||||
{l_s("dostring"), luaB_dostring},
|
||||
{l_s("error"), luaB_error},
|
||||
{l_s("foreach"), luaB_foreach},
|
||||
{l_s("foreachi"), luaB_foreachi},
|
||||
{l_s("gcinfo"), luaB_gcinfo},
|
||||
{l_s("getglobal"), luaB_getglobal},
|
||||
{l_s("gettagmethod"), luaB_gettagmethod},
|
||||
{l_s("globals"), luaB_globals},
|
||||
{l_s("loadfile"), luaB_loadfile},
|
||||
{l_s("loadstring"), luaB_loadstring},
|
||||
{l_s("newtype"), luaB_newtype},
|
||||
{l_s("newtag"), luaB_newtype}, /* for compatibility 4.0 */
|
||||
{l_s("next"), luaB_next},
|
||||
{l_s("print"), luaB_print},
|
||||
{l_s("rawget"), luaB_rawget},
|
||||
{l_s("rawset"), luaB_rawset},
|
||||
{l_s("rawgettable"), luaB_rawget}, /* for compatibility 3.2 */
|
||||
{l_s("rawsettable"), luaB_rawset}, /* for compatibility 3.2 */
|
||||
{l_s("rawtype"), luaB_rawtype},
|
||||
{l_s("require"), luaB_require},
|
||||
{l_s("setglobal"), luaB_setglobal},
|
||||
{l_s("settag"), luaB_settype}, /* for compatibility 4.0 */
|
||||
{l_s("settype"), luaB_settype},
|
||||
{l_s("settagmethod"), luaB_settagmethod},
|
||||
{l_s("tag"), luaB_tag},
|
||||
{l_s("tonumber"), luaB_tonumber},
|
||||
{l_s("tostring"), luaB_tostring},
|
||||
{l_s("type"), luaB_type},
|
||||
{l_s("assert"), luaB_assert},
|
||||
{l_s("getn"), luaB_getn},
|
||||
{l_s("sort"), luaB_sort},
|
||||
{l_s("tinsert"), luaB_tinsert},
|
||||
{l_s("tremove"), luaB_tremove},
|
||||
{l_s("unpack"), luaB_unpack},
|
||||
{l_s("weakmode"), luaB_weakmode}
|
||||
};
|
||||
|
||||
|
||||
|
||||
LUALIB_API int lua_baselibopen (lua_State *L) {
|
||||
luaL_openl(L, base_funcs);
|
||||
lua_pushliteral(L, l_s(LUA_VERSION));
|
||||
lua_setglobal(L, l_s("_VERSION"));
|
||||
return 0;
|
||||
}
|
||||
|
||||
801
lcode.c
801
lcode.c
@@ -1,801 +0,0 @@
|
||||
/*
|
||||
** $Id: lcode.c,v 1.77 2001/07/17 14:30:44 roberto Exp roberto $
|
||||
** Code generator for Lua
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
#include <stdlib.h>
|
||||
|
||||
#define LUA_PRIVATE
|
||||
#include "lua.h"
|
||||
|
||||
#include "lcode.h"
|
||||
#include "ldebug.h"
|
||||
#include "ldo.h"
|
||||
#include "llex.h"
|
||||
#include "lmem.h"
|
||||
#include "lobject.h"
|
||||
#include "lopcodes.h"
|
||||
#include "lparser.h"
|
||||
|
||||
|
||||
#define hasjumps(e) ((e)->t != (e)->f)
|
||||
|
||||
#define getcode(fs,e) ((fs)->f->code[(e)->u.i.info])
|
||||
|
||||
|
||||
|
||||
void luaK_error (LexState *ls, const l_char *msg) {
|
||||
luaX_error(ls, msg, ls->t.token);
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Returns the the previous instruction, for optimizations.
|
||||
** If there is a jump target between this and the current instruction,
|
||||
** returns a dummy instruction to avoid wrong optimizations.
|
||||
*/
|
||||
static Instruction previous_instruction (FuncState *fs) {
|
||||
if (fs->pc > fs->lasttarget) /* no jumps to current position? */
|
||||
return fs->f->code[fs->pc-1]; /* returns previous instruction */
|
||||
else
|
||||
return (Instruction)(-1);/* no optimizations after an invalid instruction */
|
||||
}
|
||||
|
||||
|
||||
void luaK_nil (FuncState *fs, int from, int n) {
|
||||
Instruction previous = previous_instruction(fs);
|
||||
if (GET_OPCODE(previous) == OP_LOADNIL) {
|
||||
int pfrom = GETARG_A(previous);
|
||||
int pto = GETARG_B(previous);
|
||||
if (pfrom <= from && from <= pto+1) { /* can connect both? */
|
||||
if (from+n-1 > pto)
|
||||
SETARG_B(fs->f->code[fs->pc-1], from+n-1);
|
||||
return;
|
||||
}
|
||||
}
|
||||
luaK_codeABC(fs, OP_LOADNIL, from, from+n-1, 0); /* else no optimization */
|
||||
}
|
||||
|
||||
|
||||
int luaK_jump (FuncState *fs) {
|
||||
int j = luaK_codeAsBc(fs, OP_JMP, 0, NO_JUMP);
|
||||
if (j == fs->lasttarget) { /* possible jumps to this jump? */
|
||||
luaK_concat(fs, &j, fs->jlt); /* keep them on hold */
|
||||
fs->jlt = NO_JUMP;
|
||||
}
|
||||
return j;
|
||||
}
|
||||
|
||||
|
||||
static int luaK_condjump (FuncState *fs, OpCode op, int A, int B, int C) {
|
||||
luaK_codeABC(fs, op, A, B, C);
|
||||
return luaK_codeAsBc(fs, OP_CJMP, 0, NO_JUMP);
|
||||
}
|
||||
|
||||
|
||||
static void luaK_fixjump (FuncState *fs, int pc, int dest) {
|
||||
Instruction *jmp = &fs->f->code[pc];
|
||||
if (dest == NO_JUMP)
|
||||
SETARG_sBc(*jmp, NO_JUMP); /* point to itself to represent end of list */
|
||||
else { /* jump is relative to position following jump instruction */
|
||||
int offset = dest-(pc+1);
|
||||
if (abs(offset) > MAXARG_sBc)
|
||||
luaK_error(fs->ls, l_s("control structure too long"));
|
||||
SETARG_sBc(*jmp, offset);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** prep-for instructions (OP_FORPREP & OP_TFORPREP) have a negated jump,
|
||||
** as they simulate the real jump...
|
||||
*/
|
||||
void luaK_fixfor (FuncState *fs, int pc, int dest) {
|
||||
Instruction *jmp = &fs->f->code[pc];
|
||||
int offset = dest-(pc+1);
|
||||
SETARG_sBc(*jmp, -offset);
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** returns current `pc' and marks it as a jump target (to avoid wrong
|
||||
** optimizations with consecutive instructions not in the same basic block).
|
||||
** discharge list of jumps to last target.
|
||||
*/
|
||||
int luaK_getlabel (FuncState *fs) {
|
||||
if (fs->pc != fs->lasttarget) {
|
||||
int lasttarget = fs->lasttarget;
|
||||
fs->lasttarget = fs->pc;
|
||||
luaK_patchlist(fs, fs->jlt, lasttarget); /* discharge old list `jlt' */
|
||||
fs->jlt = NO_JUMP; /* nobody jumps to this new label (yet) */
|
||||
}
|
||||
return fs->pc;
|
||||
}
|
||||
|
||||
|
||||
static int luaK_getjump (FuncState *fs, int pc) {
|
||||
int offset = GETARG_sBc(fs->f->code[pc]);
|
||||
if (offset == NO_JUMP) /* point to itself represents end of list */
|
||||
return NO_JUMP; /* end of list */
|
||||
else
|
||||
return (pc+1)+offset; /* turn offset into absolute position */
|
||||
}
|
||||
|
||||
|
||||
static Instruction *getjumpcontrol (FuncState *fs, int pc) {
|
||||
Instruction *pi = &fs->f->code[pc];
|
||||
OpCode op = GET_OPCODE(*pi);
|
||||
if (op == OP_CJMP)
|
||||
return pi-1;
|
||||
else {
|
||||
lua_assert(op == OP_JMP || op == OP_FORLOOP || op == OP_TFORLOOP);
|
||||
return pi;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static int need_value (FuncState *fs, int list, OpCode op) {
|
||||
/* check whether list has any jump different from `op' */
|
||||
for (; list != NO_JUMP; list = luaK_getjump(fs, list))
|
||||
if (GET_OPCODE(*getjumpcontrol(fs, list)) != op) return 1;
|
||||
return 0; /* not found */
|
||||
}
|
||||
|
||||
|
||||
static void patchtestreg (Instruction *i, int reg) {
|
||||
if (reg == NO_REG) reg = GETARG_B(*i);
|
||||
SETARG_A(*i, reg);
|
||||
}
|
||||
|
||||
|
||||
static void luaK_patchlistaux (FuncState *fs, int list,
|
||||
int ttarget, int treg, int ftarget, int freg, int dtarget) {
|
||||
while (list != NO_JUMP) {
|
||||
int next = luaK_getjump(fs, list);
|
||||
Instruction *i = getjumpcontrol(fs, list);
|
||||
switch (GET_OPCODE(*i)) {
|
||||
case OP_TESTT: {
|
||||
patchtestreg(i, treg);
|
||||
luaK_fixjump(fs, list, ttarget);
|
||||
break;
|
||||
}
|
||||
case OP_TESTF: {
|
||||
patchtestreg(i, freg);
|
||||
luaK_fixjump(fs, list, ftarget);
|
||||
break;
|
||||
}
|
||||
default: {
|
||||
luaK_fixjump(fs, list, dtarget); /* jump to default target */
|
||||
break;
|
||||
}
|
||||
}
|
||||
list = next;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
void luaK_patchlist (FuncState *fs, int list, int target) {
|
||||
if (target == fs->lasttarget) /* same target that list `jlt'? */
|
||||
luaK_concat(fs, &fs->jlt, list); /* delay fixing */
|
||||
else
|
||||
luaK_patchlistaux(fs, list, target, NO_REG, target, NO_REG, target);
|
||||
}
|
||||
|
||||
|
||||
void luaK_concat (FuncState *fs, int *l1, int l2) {
|
||||
if (*l1 == NO_JUMP)
|
||||
*l1 = l2;
|
||||
else {
|
||||
int list = *l1;
|
||||
int next;
|
||||
while ((next = luaK_getjump(fs, list)) != NO_JUMP) /* find last element */
|
||||
list = next;
|
||||
luaK_fixjump(fs, list, l2);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
void luaK_reserveregs (FuncState *fs, int n) {
|
||||
fs->freereg += n;
|
||||
if (fs->freereg > fs->f->maxstacksize) {
|
||||
if (fs->freereg >= MAXSTACK)
|
||||
luaK_error(fs->ls, l_s("function or expression too complex"));
|
||||
fs->f->maxstacksize = (short)fs->freereg;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void freereg (FuncState *fs, int reg) {
|
||||
if (reg >= fs->nactloc && reg < MAXSTACK) {
|
||||
fs->freereg--;
|
||||
lua_assert(reg == fs->freereg);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void freeexp (FuncState *fs, expdesc *e) {
|
||||
if (e->k == VNONRELOC)
|
||||
freereg(fs, e->u.i.info);
|
||||
}
|
||||
|
||||
|
||||
static int addk (FuncState *fs, TObject *k) {
|
||||
Proto *f = fs->f;
|
||||
luaM_growvector(fs->L, f->k, fs->nk, f->sizek, TObject,
|
||||
MAXARG_Bc, l_s("constant table overflow"));
|
||||
setobj(&f->k[fs->nk], k);
|
||||
return fs->nk++;
|
||||
}
|
||||
|
||||
|
||||
int luaK_stringk (FuncState *fs, TString *s) {
|
||||
Proto *f = fs->f;
|
||||
int c = s->tsv.constindex;
|
||||
if (c >= fs->nk || ttype(&f->k[c]) != LUA_TSTRING || tsvalue(&f->k[c]) != s) {
|
||||
TObject o;
|
||||
setsvalue(&o, s);
|
||||
c = addk(fs, &o);
|
||||
s->tsv.constindex = (unsigned short)c; /* hint for next time */
|
||||
}
|
||||
return c;
|
||||
}
|
||||
|
||||
|
||||
static int number_constant (FuncState *fs, lua_Number r) {
|
||||
/* check whether `r' has appeared within the last LOOKBACKNUMS entries */
|
||||
TObject o;
|
||||
Proto *f = fs->f;
|
||||
int c = fs->nk;
|
||||
int lim = c < LOOKBACKNUMS ? 0 : c-LOOKBACKNUMS;
|
||||
while (--c >= lim) {
|
||||
if (ttype(&f->k[c]) == LUA_TNUMBER && nvalue(&f->k[c]) == r)
|
||||
return c;
|
||||
}
|
||||
/* not found; create a new entry */
|
||||
setnvalue(&o, r);
|
||||
return addk(fs, &o);
|
||||
}
|
||||
|
||||
|
||||
void luaK_setcallreturns (FuncState *fs, expdesc *e, int nresults) {
|
||||
if (e->k == VCALL) { /* expression is an open function call? */
|
||||
if (nresults == LUA_MULTRET) nresults = NO_REG;
|
||||
SETARG_C(getcode(fs, e), nresults);
|
||||
if (nresults == 1) { /* `regular' expression? */
|
||||
e->k = VNONRELOC;
|
||||
e->u.i.info = GETARG_A(getcode(fs, e));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
void luaK_dischargevars (FuncState *fs, expdesc *e) {
|
||||
switch (e->k) {
|
||||
case VLOCAL: {
|
||||
e->k = VNONRELOC;
|
||||
break;
|
||||
}
|
||||
case VGLOBAL: {
|
||||
e->u.i.info = luaK_codeABc(fs, OP_GETGLOBAL, 0, e->u.i.info);
|
||||
e->k = VRELOCABLE;
|
||||
break;
|
||||
}
|
||||
case VINDEXED: {
|
||||
freereg(fs, e->u.i.aux);
|
||||
freereg(fs, e->u.i.info);
|
||||
e->u.i.info = luaK_codeABC(fs, OP_GETTABLE, 0, e->u.i.info, e->u.i.aux);
|
||||
e->k = VRELOCABLE;
|
||||
break;
|
||||
}
|
||||
case VCALL: {
|
||||
luaK_setcallreturns(fs, e, 1);
|
||||
break;
|
||||
}
|
||||
default: break; /* there is one value available (somewhere) */
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static int code_label (FuncState *fs, OpCode op, int A, int sBc) {
|
||||
luaK_getlabel(fs); /* those instructions may be jump targets */
|
||||
return luaK_codeAsBc(fs, op, A, sBc);
|
||||
}
|
||||
|
||||
|
||||
static void dischargejumps (FuncState *fs, expdesc *e, int reg) {
|
||||
if (hasjumps(e)) {
|
||||
int final; /* position after whole expression */
|
||||
int p_nil = NO_JUMP; /* position of an eventual PUSHNIL */
|
||||
int p_1 = NO_JUMP; /* position of an eventual PUSHINT */
|
||||
if (need_value(fs, e->f, OP_TESTF) || need_value(fs, e->t, OP_TESTT)) {
|
||||
/* expression needs values */
|
||||
if (e->k != VJMP)
|
||||
code_label(fs, OP_JMP, 0, 2); /* to jump over both pushes */
|
||||
p_nil = code_label(fs, OP_NILJMP, reg, 0);
|
||||
p_1 = code_label(fs, OP_LOADINT, reg, 1);
|
||||
}
|
||||
final = luaK_getlabel(fs);
|
||||
luaK_patchlistaux(fs, e->f, p_nil, NO_REG, final, reg, p_nil);
|
||||
luaK_patchlistaux(fs, e->t, final, reg, p_1, NO_REG, p_1);
|
||||
}
|
||||
e->f = e->t = NO_JUMP;
|
||||
}
|
||||
|
||||
|
||||
static void discharge2reg (FuncState *fs, expdesc *e, int reg) {
|
||||
luaK_dischargevars(fs, e);
|
||||
switch (e->k) {
|
||||
case VNIL: {
|
||||
luaK_nil(fs, reg, 1);
|
||||
break;
|
||||
}
|
||||
case VNUMBER: {
|
||||
lua_Number f = e->u.n;
|
||||
int i = (int)f;
|
||||
if ((lua_Number)i == f && -MAXARG_sBc <= i && i <= MAXARG_sBc)
|
||||
luaK_codeAsBc(fs, OP_LOADINT, reg, i); /* f has a small int value */
|
||||
else
|
||||
luaK_codeABc(fs, OP_LOADK, reg, number_constant(fs, f));
|
||||
break;
|
||||
}
|
||||
case VK: {
|
||||
luaK_codeABc(fs, OP_LOADK, reg, e->u.i.info);
|
||||
break;
|
||||
}
|
||||
case VRELOCABLE: {
|
||||
Instruction *pc = &getcode(fs, e);
|
||||
SETARG_A(*pc, reg);
|
||||
break;
|
||||
}
|
||||
default: return;
|
||||
}
|
||||
e->u.i.info = reg;
|
||||
e->k = VNONRELOC;
|
||||
}
|
||||
|
||||
|
||||
static void discharge2anyreg (FuncState *fs, expdesc *e) {
|
||||
if (e->k != VNONRELOC) {
|
||||
luaK_reserveregs(fs, 1);
|
||||
discharge2reg(fs, e, fs->freereg-1);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void luaK_exp2reg (FuncState *fs, expdesc *e, int reg) {
|
||||
discharge2reg(fs, e, reg);
|
||||
switch (e->k) {
|
||||
case VVOID: {
|
||||
return; /* nothing to do... */
|
||||
}
|
||||
case VNONRELOC: {
|
||||
if (reg != e->u.i.info)
|
||||
luaK_codeABC(fs, OP_MOVE, reg, e->u.i.info, 0);
|
||||
break;
|
||||
}
|
||||
case VJMP: {
|
||||
luaK_concat(fs, &e->t, e->u.i.info); /* put this jump in `t' list */
|
||||
break;
|
||||
}
|
||||
default: {
|
||||
lua_assert(0); /* cannot happen */
|
||||
break;
|
||||
}
|
||||
}
|
||||
dischargejumps(fs, e, reg);
|
||||
e->u.i.info = reg;
|
||||
e->k = VNONRELOC;
|
||||
}
|
||||
|
||||
|
||||
void luaK_exp2nextreg (FuncState *fs, expdesc *e) {
|
||||
int reg;
|
||||
luaK_dischargevars(fs, e);
|
||||
freeexp(fs, e);
|
||||
reg = fs->freereg;
|
||||
luaK_reserveregs(fs, 1);
|
||||
luaK_exp2reg(fs, e, reg);
|
||||
}
|
||||
|
||||
|
||||
int luaK_exp2anyreg (FuncState *fs, expdesc *e) {
|
||||
luaK_dischargevars(fs, e);
|
||||
if (e->k == VNONRELOC) {
|
||||
if (!hasjumps(e)) return e->u.i.info; /* exp is already in a register */
|
||||
if (e->u.i.info >= fs->nactloc) { /* reg. is not a local? */
|
||||
dischargejumps(fs, e, e->u.i.info); /* put value on it */
|
||||
return e->u.i.info;
|
||||
}
|
||||
}
|
||||
luaK_exp2nextreg(fs, e); /* default */
|
||||
return e->u.i.info;
|
||||
}
|
||||
|
||||
|
||||
void luaK_exp2val (FuncState *fs, expdesc *e) {
|
||||
if (hasjumps(e))
|
||||
luaK_exp2anyreg(fs, e);
|
||||
else
|
||||
luaK_dischargevars(fs, e);
|
||||
}
|
||||
|
||||
|
||||
int luaK_exp2RK (FuncState *fs, expdesc *e) {
|
||||
luaK_exp2val(fs, e);
|
||||
if (e->k == VNUMBER && fs->nk + MAXSTACK <= MAXARG_C) {
|
||||
e->u.i.info = number_constant(fs, e->u.n);
|
||||
e->k = VK;
|
||||
}
|
||||
else if (!(e->k == VK && e->u.i.info + MAXSTACK <= MAXARG_C))
|
||||
luaK_exp2anyreg(fs, e); /* not a constant in the right range */
|
||||
return (e->k == VK) ? e->u.i.info+MAXSTACK : e->u.i.info;
|
||||
}
|
||||
|
||||
|
||||
void luaK_storevar (FuncState *fs, expdesc *var, expdesc *exp) {
|
||||
switch (var->k) {
|
||||
case VLOCAL: {
|
||||
freeexp(fs, exp);
|
||||
luaK_exp2reg(fs, exp, var->u.i.info);
|
||||
break;
|
||||
}
|
||||
case VGLOBAL: {
|
||||
int e = luaK_exp2anyreg(fs, exp);
|
||||
freereg(fs, e);
|
||||
luaK_codeABc(fs, OP_SETGLOBAL, e, var->u.i.info);
|
||||
break;
|
||||
}
|
||||
case VINDEXED: {
|
||||
int e = luaK_exp2anyreg(fs, exp);
|
||||
freereg(fs, e);
|
||||
luaK_codeABC(fs, OP_SETTABLE, e, var->u.i.info, var->u.i.aux);
|
||||
break;
|
||||
}
|
||||
default: {
|
||||
lua_assert(0); /* invalid var kind to store */
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
void luaK_self (FuncState *fs, expdesc *e, expdesc *key) {
|
||||
int func;
|
||||
luaK_exp2anyreg(fs, e);
|
||||
freeexp(fs, e);
|
||||
func = fs->freereg;
|
||||
luaK_reserveregs(fs, 2);
|
||||
luaK_codeABC(fs, OP_SELF, func, e->u.i.info, luaK_exp2RK(fs, key));
|
||||
freeexp(fs, key);
|
||||
e->u.i.info = func;
|
||||
e->k = VNONRELOC;
|
||||
}
|
||||
|
||||
|
||||
static OpCode invertoperator (OpCode op) {
|
||||
switch (op) {
|
||||
case OP_TESTNE: return OP_TESTEQ;
|
||||
case OP_TESTEQ: return OP_TESTNE;
|
||||
case OP_TESTLT: return OP_TESTGE;
|
||||
case OP_TESTLE: return OP_TESTGT;
|
||||
case OP_TESTGT: return OP_TESTLE;
|
||||
case OP_TESTGE: return OP_TESTLT;
|
||||
case OP_TESTT: return OP_TESTF;
|
||||
case OP_TESTF: return OP_TESTT;
|
||||
default: lua_assert(0); return op; /* invalid jump instruction */
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void invertjump (FuncState *fs, expdesc *e) {
|
||||
Instruction *pc = getjumpcontrol(fs, e->u.i.info);
|
||||
*pc = SET_OPCODE(*pc, invertoperator(GET_OPCODE(*pc)));
|
||||
}
|
||||
|
||||
|
||||
static int jumponcond (FuncState *fs, expdesc *e, OpCode op) {
|
||||
if (e->k == VRELOCABLE) {
|
||||
Instruction ie = getcode(fs, e);
|
||||
if (GET_OPCODE(ie) == OP_NOT) {
|
||||
op = invertoperator(op);
|
||||
fs->pc--; /* remove previous OP_NOT */
|
||||
return luaK_condjump(fs, op, NO_REG, GETARG_B(ie), 0);
|
||||
}
|
||||
/* else go through */
|
||||
}
|
||||
discharge2anyreg(fs, e);
|
||||
freeexp(fs, e);
|
||||
return luaK_condjump(fs, op, NO_REG, e->u.i.info, 0);
|
||||
}
|
||||
|
||||
|
||||
void luaK_goiftrue (FuncState *fs, expdesc *e) {
|
||||
int pc; /* pc of last jump */
|
||||
luaK_dischargevars(fs, e);
|
||||
switch (e->k) {
|
||||
case VK: case VNUMBER: {
|
||||
pc = NO_JUMP; /* always true; do nothing */
|
||||
break;
|
||||
}
|
||||
case VNIL: {
|
||||
pc = luaK_codeAsBc(fs, OP_JMP, 0, NO_JUMP); /* always jump */
|
||||
break;
|
||||
}
|
||||
case VJMP: {
|
||||
invertjump(fs, e);
|
||||
pc = e->u.i.info;
|
||||
break;
|
||||
}
|
||||
case VRELOCABLE:
|
||||
case VNONRELOC: {
|
||||
pc = jumponcond(fs, e, OP_TESTF);
|
||||
break;
|
||||
}
|
||||
default: {
|
||||
pc = 0; /* to avoid warnings */
|
||||
lua_assert(0); /* cannot happen */
|
||||
break;
|
||||
}
|
||||
}
|
||||
luaK_concat(fs, &e->f, pc); /* insert last jump in `f' list */
|
||||
luaK_patchlist(fs, e->t, luaK_getlabel(fs));
|
||||
e->t = NO_JUMP;
|
||||
}
|
||||
|
||||
|
||||
static void luaK_goiffalse (FuncState *fs, expdesc *e) {
|
||||
int pc; /* pc of last jump */
|
||||
luaK_dischargevars(fs, e);
|
||||
switch (e->k) {
|
||||
case VNIL: {
|
||||
pc = NO_JUMP; /* always false; do nothing */
|
||||
break;
|
||||
}
|
||||
case VJMP: {
|
||||
pc = e->u.i.info;
|
||||
break;
|
||||
}
|
||||
case VK: case VNUMBER: /* cannot optimize it (`or' must keep value) */
|
||||
case VRELOCABLE:
|
||||
case VNONRELOC: {
|
||||
pc = jumponcond(fs, e, OP_TESTT);
|
||||
break;
|
||||
}
|
||||
default: {
|
||||
pc = 0; /* to avoid warnings */
|
||||
lua_assert(0); /* cannot happen */
|
||||
break;
|
||||
}
|
||||
}
|
||||
luaK_concat(fs, &e->t, pc); /* insert last jump in `t' list */
|
||||
luaK_patchlist(fs, e->f, luaK_getlabel(fs));
|
||||
e->f = NO_JUMP;
|
||||
}
|
||||
|
||||
|
||||
static void codenot (FuncState *fs, expdesc *e) {
|
||||
luaK_dischargevars(fs, e);
|
||||
switch (e->k) {
|
||||
case VNIL: {
|
||||
e->u.n = 1;
|
||||
e->k = VNUMBER;
|
||||
break;
|
||||
}
|
||||
case VK: case VNUMBER: {
|
||||
e->k = VNIL;
|
||||
break;
|
||||
}
|
||||
case VJMP: {
|
||||
invertjump(fs, e);
|
||||
break;
|
||||
}
|
||||
case VRELOCABLE:
|
||||
case VNONRELOC: {
|
||||
discharge2anyreg(fs, e);
|
||||
freeexp(fs, e);
|
||||
e->u.i.info = luaK_codeABC(fs, OP_NOT, 0, e->u.i.info, 0);
|
||||
e->k = VRELOCABLE;
|
||||
break;
|
||||
}
|
||||
default: {
|
||||
lua_assert(0); /* cannot happen */
|
||||
break;
|
||||
}
|
||||
}
|
||||
/* interchange true and false lists */
|
||||
{ int temp = e->f; e->f = e->t; e->t = temp; }
|
||||
}
|
||||
|
||||
|
||||
void luaK_indexed (FuncState *fs, expdesc *t, expdesc *k) {
|
||||
t->u.i.aux = luaK_exp2RK(fs, k);
|
||||
t->k = VINDEXED;
|
||||
}
|
||||
|
||||
|
||||
void luaK_prefix (FuncState *fs, UnOpr op, expdesc *e) {
|
||||
if (op == OPR_MINUS) {
|
||||
luaK_exp2val(fs, e);
|
||||
if (e->k == VNUMBER)
|
||||
e->u.n = -e->u.n;
|
||||
else {
|
||||
luaK_exp2anyreg(fs, e);
|
||||
freeexp(fs, e);
|
||||
e->u.i.info = luaK_codeABC(fs, OP_UNM, 0, e->u.i.info, 0);
|
||||
e->k = VRELOCABLE;
|
||||
}
|
||||
}
|
||||
else /* op == NOT */
|
||||
codenot(fs, e);
|
||||
}
|
||||
|
||||
|
||||
void luaK_infix (FuncState *fs, BinOpr op, expdesc *v) {
|
||||
switch (op) {
|
||||
case OPR_AND: {
|
||||
luaK_goiftrue(fs, v);
|
||||
break;
|
||||
}
|
||||
case OPR_OR: {
|
||||
luaK_goiffalse(fs, v);
|
||||
break;
|
||||
}
|
||||
case OPR_CONCAT: {
|
||||
luaK_exp2nextreg(fs, v); /* operand must be on the `stack' */
|
||||
break;
|
||||
}
|
||||
case OPR_SUB: case OPR_DIV: case OPR_POW: {
|
||||
/* non-comutative operators */
|
||||
luaK_exp2anyreg(fs, v); /* first operand must be a register */
|
||||
break;
|
||||
}
|
||||
default: {
|
||||
luaK_exp2RK(fs, v);
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
/* opcode for each binary operator */
|
||||
static const OpCode codes[] = { /* ORDER OPR */
|
||||
OP_ADD, OP_SUB, OP_MUL, OP_DIV,
|
||||
OP_POW, OP_CONCAT,
|
||||
OP_TESTNE, OP_TESTEQ,
|
||||
OP_TESTLT, OP_TESTLE, OP_TESTGT, OP_TESTGE
|
||||
};
|
||||
|
||||
|
||||
/* `inverted' opcode for each binary operator */
|
||||
/* ( -1 means operator has no inverse) */
|
||||
static const OpCode invcodes[] = { /* ORDER OPR */
|
||||
OP_ADD, (OpCode)-1, OP_MUL, (OpCode)-1,
|
||||
(OpCode)-1, (OpCode)-1,
|
||||
OP_TESTNE, OP_TESTEQ,
|
||||
OP_TESTGT, OP_TESTGE, OP_TESTLT, OP_TESTLE
|
||||
};
|
||||
|
||||
|
||||
void luaK_posfix (FuncState *fs, BinOpr op, expdesc *e1, expdesc *e2) {
|
||||
switch (op) {
|
||||
case OPR_AND: {
|
||||
lua_assert(e1->t == NO_JUMP); /* list must be closed */
|
||||
luaK_dischargevars(fs, e2);
|
||||
luaK_concat(fs, &e1->f, e2->f);
|
||||
e1->k = e2->k; e1->u = e2->u; e1->t = e2->t;
|
||||
break;
|
||||
}
|
||||
case OPR_OR: {
|
||||
lua_assert(e1->f == NO_JUMP); /* list must be closed */
|
||||
luaK_dischargevars(fs, e2);
|
||||
luaK_concat(fs, &e1->t, e2->t);
|
||||
e1->k = e2->k; e1->u = e2->u; e1->f = e2->f;
|
||||
break;
|
||||
}
|
||||
case OPR_CONCAT: {
|
||||
luaK_exp2val(fs, e2);
|
||||
if (e2->k == VRELOCABLE && GET_OPCODE(getcode(fs, e2)) == OP_CONCAT) {
|
||||
lua_assert(e1->u.i.info == GETARG_B(getcode(fs, e2))-1);
|
||||
freeexp(fs, e1);
|
||||
SETARG_B(getcode(fs, e2), e1->u.i.info);
|
||||
e1->k = e2->k; e1->u.i.info = e2->u.i.info;
|
||||
}
|
||||
else {
|
||||
luaK_exp2nextreg(fs, e2);
|
||||
freeexp(fs, e2);
|
||||
freeexp(fs, e1);
|
||||
e1->u.i.info = luaK_codeABC(fs, codes[op], 0, e1->u.i.info,
|
||||
e2->u.i.info);
|
||||
e1->k = VRELOCABLE;
|
||||
}
|
||||
break;
|
||||
}
|
||||
case OPR_EQ: case OPR_NE: {
|
||||
luaK_exp2val(fs, e2);
|
||||
if (e2->k == VNIL) { /* exp x= nil ? */
|
||||
if (e1->k == VK) { /* constant x= nil ? */
|
||||
if (op == OPR_EQ) /* constant == nil ? */
|
||||
e1->k = VNIL; /* always false */
|
||||
/* else always true (leave the constant itself) */
|
||||
}
|
||||
else {
|
||||
OpCode opc = (op == OPR_EQ) ? OP_TESTF : OP_TESTT;
|
||||
e1->u.i.info = jumponcond(fs, e1, opc);
|
||||
e1->k = VJMP;
|
||||
}
|
||||
break;
|
||||
}
|
||||
/* else go through */
|
||||
}
|
||||
default: {
|
||||
int o1, o2;
|
||||
OpCode opc;
|
||||
if (e1->k != VK) { /* not a constant operator? */
|
||||
o1 = e1->u.i.info;
|
||||
o2 = luaK_exp2RK(fs, e2); /* maybe other operator is constant... */
|
||||
opc = codes[op];
|
||||
}
|
||||
else { /* invert operands */
|
||||
o2 = luaK_exp2RK(fs, e1); /* constant must be 2nd operand */
|
||||
o1 = luaK_exp2anyreg(fs, e2); /* other operator must be in register */
|
||||
opc = invcodes[op]; /* use inverted operator */
|
||||
}
|
||||
freeexp(fs, e2);
|
||||
freeexp(fs, e1);
|
||||
if (op < OPR_NE) { /* ORDER OPR */
|
||||
e1->u.i.info = luaK_codeABC(fs, opc, 0, o1, o2);
|
||||
e1->k = VRELOCABLE;
|
||||
}
|
||||
else { /* jump */
|
||||
e1->u.i.info = luaK_condjump(fs, opc, o1, 0, o2);
|
||||
e1->k = VJMP;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void codelineinfo (FuncState *fs) {
|
||||
Proto *f = fs->f;
|
||||
LexState *ls = fs->ls;
|
||||
if (ls->lastline > fs->lastline) {
|
||||
if (ls->lastline > fs->lastline+1) {
|
||||
luaM_growvector(fs->L, f->lineinfo, fs->nlineinfo, f->sizelineinfo, int,
|
||||
MAX_INT, l_s("line info overflow"));
|
||||
f->lineinfo[fs->nlineinfo++] = -(ls->lastline - (fs->lastline+1));
|
||||
}
|
||||
luaM_growvector(fs->L, f->lineinfo, fs->nlineinfo, f->sizelineinfo, int,
|
||||
MAX_INT, l_s("line info overflow"));
|
||||
f->lineinfo[fs->nlineinfo++] = fs->pc;
|
||||
fs->lastline = ls->lastline;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static int luaK_code (FuncState *fs, Instruction i) {
|
||||
Proto *f;
|
||||
codelineinfo(fs);
|
||||
f = fs->f;
|
||||
/* put new instruction in code array */
|
||||
luaM_growvector(fs->L, f->code, fs->pc, f->sizecode, Instruction,
|
||||
MAX_INT, l_s("code size overflow"));
|
||||
f->code[fs->pc] = i;
|
||||
/*printf("free: %d ", fs->freereg); printopcode(f, fs->pc);*/
|
||||
return fs->pc++;
|
||||
}
|
||||
|
||||
|
||||
int luaK_codeABC (FuncState *fs, OpCode o, int a, int b, int c) {
|
||||
lua_assert(getOpMode(o) == iABC);
|
||||
return luaK_code(fs, CREATE_ABC(o, a, b, c));
|
||||
}
|
||||
|
||||
|
||||
int luaK_codeABc (FuncState *fs, OpCode o, int a, unsigned int bc) {
|
||||
lua_assert(getOpMode(o) == iABc || getOpMode(o) == iAsBc);
|
||||
return luaK_code(fs, CREATE_ABc(o, a, bc));
|
||||
}
|
||||
|
||||
67
lcode.h
67
lcode.h
@@ -1,67 +0,0 @@
|
||||
/*
|
||||
** $Id: lcode.h,v 1.23 2001/06/12 14:36:48 roberto Exp roberto $
|
||||
** Code generator for Lua
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
#ifndef lcode_h
|
||||
#define lcode_h
|
||||
|
||||
#include "llex.h"
|
||||
#include "lobject.h"
|
||||
#include "lopcodes.h"
|
||||
#include "lparser.h"
|
||||
|
||||
|
||||
/*
|
||||
** Marks the end of a patch list. It is an invalid value both as an absolute
|
||||
** address, and as a list link (would link an element to itself).
|
||||
*/
|
||||
#define NO_JUMP (-1)
|
||||
|
||||
|
||||
/*
|
||||
** grep "ORDER OPR" if you change these enums
|
||||
*/
|
||||
typedef enum BinOpr {
|
||||
OPR_ADD, OPR_SUB, OPR_MULT, OPR_DIV, OPR_POW,
|
||||
OPR_CONCAT,
|
||||
OPR_NE, OPR_EQ, OPR_LT, OPR_LE, OPR_GT, OPR_GE,
|
||||
OPR_AND, OPR_OR,
|
||||
OPR_NOBINOPR
|
||||
} BinOpr;
|
||||
|
||||
#define binopistest(op) ((op) >= OPR_NE)
|
||||
|
||||
typedef enum UnOpr { OPR_MINUS, OPR_NOT, OPR_NOUNOPR } UnOpr;
|
||||
|
||||
|
||||
#define luaK_codeAsBc(fs,o,A,sBc) luaK_codeABc(fs,o,A,(sBc)+MAXARG_sBc)
|
||||
|
||||
void luaK_error (LexState *ls, const l_char *msg);
|
||||
int luaK_codeABc (FuncState *fs, OpCode o, int A, unsigned int Bc);
|
||||
int luaK_codeABC (FuncState *fs, OpCode o, int A, int B, int C);
|
||||
void luaK_nil (FuncState *fs, int from, int n);
|
||||
void luaK_reserveregs (FuncState *fs, int n);
|
||||
int luaK_stringk (FuncState *fs, TString *s);
|
||||
void luaK_dischargevars (FuncState *fs, expdesc *e);
|
||||
int luaK_exp2anyreg (FuncState *fs, expdesc *e);
|
||||
void luaK_exp2nextreg (FuncState *fs, expdesc *e);
|
||||
void luaK_exp2val (FuncState *fs, expdesc *e);
|
||||
int luaK_exp2RK (FuncState *fs, expdesc *e);
|
||||
void luaK_self (FuncState *fs, expdesc *e, expdesc *key);
|
||||
void luaK_indexed (FuncState *fs, expdesc *t, expdesc *k);
|
||||
void luaK_goiftrue (FuncState *fs, expdesc *e);
|
||||
void luaK_storevar (FuncState *fs, expdesc *var, expdesc *e);
|
||||
void luaK_setcallreturns (FuncState *fs, expdesc *var, int nresults);
|
||||
int luaK_jump (FuncState *fs);
|
||||
void luaK_patchlist (FuncState *fs, int list, int target);
|
||||
void luaK_fixfor (FuncState *fs, int pc, int dest);
|
||||
void luaK_concat (FuncState *fs, int *l1, int l2);
|
||||
int luaK_getlabel (FuncState *fs);
|
||||
void luaK_prefix (FuncState *fs, UnOpr op, expdesc *v);
|
||||
void luaK_infix (FuncState *fs, BinOpr op, expdesc *v);
|
||||
void luaK_posfix (FuncState *fs, BinOpr op, expdesc *v1, expdesc *v2);
|
||||
|
||||
|
||||
#endif
|
||||
188
ldblib.c
188
ldblib.c
@@ -1,188 +0,0 @@
|
||||
/*
|
||||
** $Id: ldblib.c,v 1.36 2001/03/26 14:31:49 roberto Exp roberto $
|
||||
** Interface from Lua to its debug API
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
#define LUA_PRIVATE
|
||||
#include "lua.h"
|
||||
|
||||
#include "lauxlib.h"
|
||||
#include "luadebug.h"
|
||||
#include "lualib.h"
|
||||
|
||||
|
||||
|
||||
static void settabss (lua_State *L, const l_char *i, const l_char *v) {
|
||||
lua_pushstring(L, i);
|
||||
lua_pushstring(L, v);
|
||||
lua_settable(L, -3);
|
||||
}
|
||||
|
||||
|
||||
static void settabsi (lua_State *L, const l_char *i, int v) {
|
||||
lua_pushstring(L, i);
|
||||
lua_pushnumber(L, v);
|
||||
lua_settable(L, -3);
|
||||
}
|
||||
|
||||
|
||||
static int getinfo (lua_State *L) {
|
||||
lua_Debug ar;
|
||||
const l_char *options = luaL_opt_string(L, 2, l_s("flnSu"));
|
||||
l_char buff[20];
|
||||
if (lua_isnumber(L, 1)) {
|
||||
if (!lua_getstack(L, (int)lua_tonumber(L, 1), &ar)) {
|
||||
lua_pushnil(L); /* level out of range */
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
else if (lua_isfunction(L, 1)) {
|
||||
lua_pushvalue(L, 1);
|
||||
sprintf(buff, l_s(">%.10s"), options);
|
||||
options = buff;
|
||||
}
|
||||
else
|
||||
luaL_argerror(L, 1, l_s("function or level expected"));
|
||||
if (!lua_getinfo(L, options, &ar))
|
||||
luaL_argerror(L, 2, l_s("invalid option"));
|
||||
lua_newtable(L);
|
||||
for (; *options; options++) {
|
||||
switch (*options) {
|
||||
case l_c('S'):
|
||||
settabss(L, l_s("source"), ar.source);
|
||||
if (ar.source)
|
||||
settabss(L, l_s("short_src"), ar.short_src);
|
||||
settabsi(L, l_s("linedefined"), ar.linedefined);
|
||||
settabss(L, l_s("what"), ar.what);
|
||||
break;
|
||||
case l_c('l'):
|
||||
settabsi(L, l_s("currentline"), ar.currentline);
|
||||
break;
|
||||
case l_c('u'):
|
||||
settabsi(L, l_s("nups"), ar.nups);
|
||||
break;
|
||||
case l_c('n'):
|
||||
settabss(L, l_s("name"), ar.name);
|
||||
settabss(L, l_s("namewhat"), ar.namewhat);
|
||||
break;
|
||||
case l_c('f'):
|
||||
lua_pushliteral(L, l_s("func"));
|
||||
lua_pushvalue(L, -3);
|
||||
lua_settable(L, -3);
|
||||
break;
|
||||
}
|
||||
}
|
||||
return 1; /* return table */
|
||||
}
|
||||
|
||||
|
||||
static int getlocal (lua_State *L) {
|
||||
lua_Debug ar;
|
||||
const l_char *name;
|
||||
if (!lua_getstack(L, luaL_check_int(L, 1), &ar)) /* level out of range? */
|
||||
luaL_argerror(L, 1, l_s("level out of range"));
|
||||
name = lua_getlocal(L, &ar, luaL_check_int(L, 2));
|
||||
if (name) {
|
||||
lua_pushstring(L, name);
|
||||
lua_pushvalue(L, -2);
|
||||
return 2;
|
||||
}
|
||||
else {
|
||||
lua_pushnil(L);
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static int setlocal (lua_State *L) {
|
||||
lua_Debug ar;
|
||||
if (!lua_getstack(L, luaL_check_int(L, 1), &ar)) /* level out of range? */
|
||||
luaL_argerror(L, 1, l_s("level out of range"));
|
||||
luaL_checkany(L, 3);
|
||||
lua_pushstring(L, lua_setlocal(L, &ar, luaL_check_int(L, 2)));
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
|
||||
#define KEY_CALLHOOK l_s("luadblibCallhook")
|
||||
#define KEY_LINEHOOK l_s("luadblibLinehook")
|
||||
|
||||
|
||||
static void hookf (lua_State *L, const l_char *key) {
|
||||
lua_getregistry(L);
|
||||
lua_pushstring(L, key);
|
||||
lua_gettable(L, -2);
|
||||
if (lua_isfunction(L, -1)) {
|
||||
lua_pushvalue(L, -3); /* original argument (below table and function) */
|
||||
lua_rawcall(L, 1, 0);
|
||||
}
|
||||
else
|
||||
lua_pop(L, 1); /* pop result from gettable */
|
||||
lua_pop(L, 1); /* pop table */
|
||||
}
|
||||
|
||||
|
||||
static void callf (lua_State *L, lua_Debug *ar) {
|
||||
lua_pushstring(L, ar->event);
|
||||
hookf(L, KEY_CALLHOOK);
|
||||
}
|
||||
|
||||
|
||||
static void linef (lua_State *L, lua_Debug *ar) {
|
||||
lua_pushnumber(L, ar->currentline);
|
||||
hookf(L, KEY_LINEHOOK);
|
||||
}
|
||||
|
||||
|
||||
static void sethook (lua_State *L, const l_char *key, lua_Hook hook,
|
||||
lua_Hook (*sethookf)(lua_State * L, lua_Hook h)) {
|
||||
lua_settop(L, 1);
|
||||
if (lua_isnil(L, 1))
|
||||
(*sethookf)(L, NULL);
|
||||
else if (lua_isfunction(L, 1))
|
||||
(*sethookf)(L, hook);
|
||||
else
|
||||
luaL_argerror(L, 1, l_s("function expected"));
|
||||
lua_getregistry(L);
|
||||
lua_pushstring(L, key);
|
||||
lua_pushvalue(L, -1); /* dup key */
|
||||
lua_gettable(L, -3); /* get old value */
|
||||
lua_pushvalue(L, -2); /* key (again) */
|
||||
lua_pushvalue(L, 1);
|
||||
lua_settable(L, -5); /* set new value */
|
||||
}
|
||||
|
||||
|
||||
static int setcallhook (lua_State *L) {
|
||||
sethook(L, KEY_CALLHOOK, callf, lua_setcallhook);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int setlinehook (lua_State *L) {
|
||||
sethook(L, KEY_LINEHOOK, linef, lua_setlinehook);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static const luaL_reg dblib[] = {
|
||||
{l_s("getlocal"), getlocal},
|
||||
{l_s("getinfo"), getinfo},
|
||||
{l_s("setcallhook"), setcallhook},
|
||||
{l_s("setlinehook"), setlinehook},
|
||||
{l_s("setlocal"), setlocal}
|
||||
};
|
||||
|
||||
|
||||
LUALIB_API int lua_dblibopen (lua_State *L) {
|
||||
luaL_openl(L, dblib);
|
||||
return 0;
|
||||
}
|
||||
|
||||
566
ldebug.c
566
ldebug.c
@@ -1,566 +0,0 @@
|
||||
/*
|
||||
** $Id: ldebug.c,v 1.86 2001/06/28 19:58:57 roberto Exp roberto $
|
||||
** Debug Interface
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
#include <stdlib.h>
|
||||
|
||||
#define LUA_PRIVATE
|
||||
#include "lua.h"
|
||||
|
||||
#include "lapi.h"
|
||||
#include "lcode.h"
|
||||
#include "ldebug.h"
|
||||
#include "ldo.h"
|
||||
#include "lfunc.h"
|
||||
#include "lobject.h"
|
||||
#include "lopcodes.h"
|
||||
#include "lstate.h"
|
||||
#include "lstring.h"
|
||||
#include "ltable.h"
|
||||
#include "ltm.h"
|
||||
#include "luadebug.h"
|
||||
#include "lvm.h"
|
||||
|
||||
|
||||
|
||||
static const l_char *getfuncname (lua_State *L, CallInfo *ci,
|
||||
const l_char **name);
|
||||
|
||||
|
||||
|
||||
static int isLmark (CallInfo *ci) {
|
||||
lua_assert(ci == NULL || ttype(ci->base - 1) == LUA_TFUNCTION);
|
||||
return (ci && ci->prev && !ci_func(ci)->isC);
|
||||
}
|
||||
|
||||
|
||||
LUA_API lua_Hook lua_setcallhook (lua_State *L, lua_Hook func) {
|
||||
lua_Hook oldhook;
|
||||
lua_lock(L);
|
||||
oldhook = L->callhook;
|
||||
L->callhook = func;
|
||||
lua_unlock(L);
|
||||
return oldhook;
|
||||
}
|
||||
|
||||
|
||||
LUA_API lua_Hook lua_setlinehook (lua_State *L, lua_Hook func) {
|
||||
lua_Hook oldhook;
|
||||
lua_lock(L);
|
||||
oldhook = L->linehook;
|
||||
L->linehook = func;
|
||||
lua_unlock(L);
|
||||
return oldhook;
|
||||
}
|
||||
|
||||
|
||||
static CallInfo *ci_stack (lua_State *L, StkId obj) {
|
||||
CallInfo *ci = L->ci;
|
||||
while (ci->base > obj) ci = ci->prev;
|
||||
return (ci != &L->basefunc) ? ci : NULL;
|
||||
}
|
||||
|
||||
|
||||
LUA_API int lua_getstack (lua_State *L, int level, lua_Debug *ar) {
|
||||
CallInfo *ci;
|
||||
int status;
|
||||
lua_lock(L);
|
||||
ci = L->ci;
|
||||
while (level-- && ci != &L->basefunc) {
|
||||
lua_assert(ci->base > ci->prev->base);
|
||||
ci = ci->prev;
|
||||
}
|
||||
if (ci == &L->basefunc) status = 0; /* there is no such level */
|
||||
else {
|
||||
ar->_ci = ci;
|
||||
status = 1;
|
||||
}
|
||||
lua_unlock(L);
|
||||
return status;
|
||||
}
|
||||
|
||||
|
||||
int luaG_getline (int *lineinfo, int pc, int refline, int *prefi) {
|
||||
int refi;
|
||||
if (lineinfo == NULL || pc == -1)
|
||||
return -1; /* no line info or function is not active */
|
||||
refi = prefi ? *prefi : 0;
|
||||
if (lineinfo[refi] < 0)
|
||||
refline += -lineinfo[refi++];
|
||||
lua_assert(lineinfo[refi] >= 0);
|
||||
while (lineinfo[refi] > pc) {
|
||||
refline--;
|
||||
refi--;
|
||||
if (lineinfo[refi] < 0)
|
||||
refline -= -lineinfo[refi--];
|
||||
lua_assert(lineinfo[refi] >= 0);
|
||||
}
|
||||
for (;;) {
|
||||
int nextline = refline + 1;
|
||||
int nextref = refi + 1;
|
||||
if (lineinfo[nextref] < 0)
|
||||
nextline += -lineinfo[nextref++];
|
||||
lua_assert(lineinfo[nextref] >= 0);
|
||||
if (lineinfo[nextref] > pc)
|
||||
break;
|
||||
refline = nextline;
|
||||
refi = nextref;
|
||||
}
|
||||
if (prefi) *prefi = refi;
|
||||
return refline;
|
||||
}
|
||||
|
||||
|
||||
static int currentpc (CallInfo *ci) {
|
||||
lua_assert(isLmark(ci));
|
||||
if (ci->pc)
|
||||
return (*ci->pc - ci_func(ci)->f.l->code) - 1;
|
||||
else
|
||||
return -1; /* function is not active */
|
||||
}
|
||||
|
||||
|
||||
static int currentline (CallInfo *ci) {
|
||||
if (!isLmark(ci))
|
||||
return -1; /* only active lua functions have current-line information */
|
||||
else {
|
||||
int *lineinfo = ci_func(ci)->f.l->lineinfo;
|
||||
return luaG_getline(lineinfo, currentpc(ci), 1, NULL);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
static Proto *getluaproto (CallInfo *ci) {
|
||||
return (isLmark(ci) ? ci_func(ci)->f.l : NULL);
|
||||
}
|
||||
|
||||
|
||||
LUA_API const l_char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n) {
|
||||
const l_char *name;
|
||||
CallInfo *ci;
|
||||
Proto *fp;
|
||||
lua_lock(L);
|
||||
name = NULL;
|
||||
ci = ar->_ci;
|
||||
fp = getluaproto(ci);
|
||||
if (fp) { /* is a Lua function? */
|
||||
name = luaF_getlocalname(fp, n, currentpc(ci));
|
||||
if (name)
|
||||
luaA_pushobject(L, ci->base+(n-1)); /* push value */
|
||||
}
|
||||
lua_unlock(L);
|
||||
return name;
|
||||
}
|
||||
|
||||
|
||||
LUA_API const l_char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n) {
|
||||
const l_char *name;
|
||||
CallInfo *ci;
|
||||
Proto *fp;
|
||||
lua_lock(L);
|
||||
name = NULL;
|
||||
ci = ar->_ci;
|
||||
fp = getluaproto(ci);
|
||||
L->top--; /* pop new value */
|
||||
if (fp) { /* is a Lua function? */
|
||||
name = luaF_getlocalname(fp, n, currentpc(ci));
|
||||
if (!name || name[0] == l_c('(')) /* `(' starts private locals */
|
||||
name = NULL;
|
||||
else
|
||||
setobj(ci->base+(n-1), L->top);
|
||||
}
|
||||
lua_unlock(L);
|
||||
return name;
|
||||
}
|
||||
|
||||
|
||||
static void infoLproto (lua_Debug *ar, Proto *f) {
|
||||
ar->source = getstr(f->source);
|
||||
ar->linedefined = f->lineDefined;
|
||||
ar->what = l_s("Lua");
|
||||
}
|
||||
|
||||
|
||||
static void funcinfo (lua_State *L, lua_Debug *ar, StkId func) {
|
||||
Closure *cl;
|
||||
if (ttype(func) == LUA_TFUNCTION)
|
||||
cl = clvalue(func);
|
||||
else {
|
||||
luaD_error(L, l_s("value for `lua_getinfo' is not a function"));
|
||||
cl = NULL; /* to avoid warnings */
|
||||
}
|
||||
if (cl->isC) {
|
||||
ar->source = l_s("=C");
|
||||
ar->linedefined = -1;
|
||||
ar->what = l_s("C");
|
||||
}
|
||||
else
|
||||
infoLproto(ar, cl->f.l);
|
||||
luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE);
|
||||
if (ar->linedefined == 0)
|
||||
ar->what = l_s("main");
|
||||
}
|
||||
|
||||
|
||||
static const l_char *travtagmethods (global_State *G, const TObject *o) {
|
||||
if (ttype(o) == LUA_TFUNCTION) {
|
||||
int e;
|
||||
for (e=0; e<TM_N; e++) {
|
||||
int t;
|
||||
for (t=0; t<G->ntag; t++)
|
||||
if (clvalue(o) == luaT_gettm(G, t, e))
|
||||
return luaT_eventname[e];
|
||||
}
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
|
||||
static const l_char *travglobals (lua_State *L, const TObject *o) {
|
||||
Hash *g = L->gt;
|
||||
int i;
|
||||
for (i=0; i<g->size; i++) {
|
||||
if (luaO_equalObj(o, val(node(g, i))) &&
|
||||
ttype(key(node(g, i))) == LUA_TSTRING)
|
||||
return getstr(tsvalue(key(node(g, i))));
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
|
||||
static void getname (lua_State *L, const TObject *f, lua_Debug *ar) {
|
||||
/* try to find a name for given function */
|
||||
if ((ar->name = travglobals(L, f)) != NULL)
|
||||
ar->namewhat = l_s("global");
|
||||
/* not found: try tag methods */
|
||||
else if ((ar->name = travtagmethods(G(L), f)) != NULL)
|
||||
ar->namewhat = l_s("tag-method");
|
||||
else ar->namewhat = l_s(""); /* not found at all */
|
||||
}
|
||||
|
||||
|
||||
LUA_API int lua_getinfo (lua_State *L, const l_char *what, lua_Debug *ar) {
|
||||
StkId f;
|
||||
CallInfo *ci;
|
||||
int status = 1;
|
||||
lua_lock(L);
|
||||
if (*what != l_c('>')) { /* function is active? */
|
||||
ci = ar->_ci;
|
||||
f = ci->base - 1;
|
||||
}
|
||||
else {
|
||||
what++; /* skip the `>' */
|
||||
ci = NULL;
|
||||
f = L->top - 1;
|
||||
}
|
||||
for (; *what; what++) {
|
||||
switch (*what) {
|
||||
case l_c('S'): {
|
||||
funcinfo(L, ar, f);
|
||||
break;
|
||||
}
|
||||
case l_c('l'): {
|
||||
ar->currentline = currentline(ci);
|
||||
break;
|
||||
}
|
||||
case l_c('u'): {
|
||||
ar->nups = (ttype(f) == LUA_TFUNCTION) ? clvalue(f)->nupvalues : 0;
|
||||
break;
|
||||
}
|
||||
case l_c('n'): {
|
||||
ar->namewhat = (ci) ? getfuncname(L, ci, &ar->name) : NULL;
|
||||
if (ar->namewhat == NULL)
|
||||
getname(L, f, ar);
|
||||
break;
|
||||
}
|
||||
case l_c('f'): {
|
||||
setobj(L->top, f);
|
||||
incr_top; /* push function */
|
||||
break;
|
||||
}
|
||||
default: status = 0; /* invalid option */
|
||||
}
|
||||
}
|
||||
if (!ci) L->top--; /* pop function */
|
||||
lua_unlock(L);
|
||||
return status;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** {======================================================
|
||||
** Symbolic Execution and code checker
|
||||
** =======================================================
|
||||
*/
|
||||
|
||||
#define check(x) if (!(x)) return 0;
|
||||
|
||||
#define checkjump(pt,pc) check(0 <= pc && pc < pt->sizecode)
|
||||
|
||||
#define checkreg(pt,reg) check((reg) < (pt)->maxstacksize)
|
||||
|
||||
|
||||
static int checklineinfo (const Proto *pt) {
|
||||
int *lineinfo = pt->lineinfo;
|
||||
if (lineinfo == NULL) return 1;
|
||||
check(pt->sizelineinfo >= 2 && lineinfo[pt->sizelineinfo-1] == MAX_INT);
|
||||
if (*lineinfo < 0) lineinfo++;
|
||||
check(*lineinfo == 0);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int precheck (const Proto *pt) {
|
||||
check(checklineinfo(pt));
|
||||
check(pt->maxstacksize <= MAXSTACK);
|
||||
check(pt->numparams+pt->is_vararg <= pt->maxstacksize);
|
||||
check(GET_OPCODE(pt->code[pt->sizecode-1]) == OP_RETURN);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int checkopenop (Instruction i) {
|
||||
OpCode op = GET_OPCODE(i);
|
||||
switch (op) {
|
||||
case OP_CALL:
|
||||
case OP_RETURN: {
|
||||
check(GETARG_B(i) == NO_REG);
|
||||
return 1;
|
||||
}
|
||||
case OP_SETLISTO: return 1;
|
||||
default: return 0; /* invalid instruction after an open call */
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static Instruction luaG_symbexec (const Proto *pt, int lastpc, int reg) {
|
||||
int pc;
|
||||
int last; /* stores position of last instruction that changed `reg' */
|
||||
last = pt->sizecode-1; /* points to final return (a `neutral' instruction) */
|
||||
if (reg == NO_REG) /* full check? */
|
||||
check(precheck(pt));
|
||||
for (pc = 0; pc < lastpc; pc++) {
|
||||
const Instruction i = pt->code[pc];
|
||||
OpCode op = GET_OPCODE(i);
|
||||
int a = GETARG_A(i);
|
||||
int b = 0;
|
||||
int c = 0;
|
||||
checkreg(pt, a);
|
||||
switch (getOpMode(op)) {
|
||||
case iABC: {
|
||||
b = GETARG_B(i);
|
||||
c = GETARG_C(i);
|
||||
if (testOpMode(op, OpModeBreg))
|
||||
checkreg(pt, b);
|
||||
if (testOpMode(op, OpModeCreg))
|
||||
check(c < pt->maxstacksize ||
|
||||
(c >= MAXSTACK && c-MAXSTACK < pt->sizek));
|
||||
break;
|
||||
}
|
||||
case iABc: {
|
||||
b = GETARG_Bc(i);
|
||||
if (testOpMode(op, OpModeK)) check(b < pt->sizek);
|
||||
break;
|
||||
}
|
||||
case iAsBc: {
|
||||
b = GETARG_sBc(i);
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (testOpMode(op, OpModesetA)) {
|
||||
if (a == reg) last = pc; /* change register `a' */
|
||||
}
|
||||
if (testOpMode(op, OpModeT))
|
||||
check(GET_OPCODE(pt->code[pc+1]) == OP_CJMP);
|
||||
switch (op) {
|
||||
case OP_LOADNIL: {
|
||||
if (a <= reg && reg <= b)
|
||||
last = pc; /* set registers from `a' to `b' */
|
||||
break;
|
||||
}
|
||||
case OP_LOADUPVAL: {
|
||||
check(b < pt->nupvalues);
|
||||
break;
|
||||
}
|
||||
case OP_GETGLOBAL:
|
||||
case OP_SETGLOBAL: {
|
||||
check(ttype(&pt->k[b]) == LUA_TSTRING);
|
||||
break;
|
||||
}
|
||||
case OP_SELF: {
|
||||
checkreg(pt, a+1);
|
||||
if (reg == a+1) last = pc;
|
||||
break;
|
||||
}
|
||||
case OP_CONCAT: {
|
||||
/* `c' is a register, and at least two operands */
|
||||
check(c < MAXSTACK && b < c);
|
||||
break;
|
||||
}
|
||||
case OP_JMP:
|
||||
case OP_CJMP: {
|
||||
int dest = pc+1+b;
|
||||
check(0 <= dest && dest < pt->sizecode);
|
||||
/* not full check and jump is forward and do not skip `lastpc'? */
|
||||
if (reg != NO_REG && pc < dest && dest <= lastpc)
|
||||
pc += b; /* do the jump */
|
||||
break;
|
||||
}
|
||||
case OP_NILJMP: {
|
||||
check(pc+2 < pt->sizecode); /* check its jump */
|
||||
break;
|
||||
}
|
||||
case OP_CALL: {
|
||||
if (b != NO_REG) {
|
||||
checkreg(pt, a+b);
|
||||
}
|
||||
if (c == NO_REG) {
|
||||
check(checkopenop(pt->code[pc+1]));
|
||||
}
|
||||
else if (c != 0)
|
||||
checkreg(pt, a+c-1);
|
||||
if (reg >= a) last = pc; /* affect all registers above base */
|
||||
break;
|
||||
}
|
||||
case OP_RETURN: {
|
||||
if (b != NO_REG && b != 0)
|
||||
checkreg(pt, a+b-1);
|
||||
break;
|
||||
}
|
||||
case OP_FORPREP:
|
||||
case OP_TFORPREP: {
|
||||
int dest = pc-b; /* jump is negated here */
|
||||
check(0 <= dest && dest < pt->sizecode &&
|
||||
GET_OPCODE(pt->code[dest]) == op+1);
|
||||
break;
|
||||
}
|
||||
case OP_FORLOOP:
|
||||
case OP_TFORLOOP: {
|
||||
int dest = pc+b;
|
||||
check(0 <= dest && dest < pt->sizecode &&
|
||||
pt->code[dest] == SET_OPCODE(i, op-1));
|
||||
checkreg(pt, a + ((op == OP_FORLOOP) ? 2 : 3));
|
||||
break;
|
||||
}
|
||||
case OP_SETLIST: {
|
||||
checkreg(pt, a + (b&(LFIELDS_PER_FLUSH-1)) + 1);
|
||||
break;
|
||||
}
|
||||
case OP_CLOSURE: {
|
||||
check(b < pt->sizep);
|
||||
checkreg(pt, a + pt->p[b]->nupvalues - 1);
|
||||
break;
|
||||
}
|
||||
default: break;
|
||||
}
|
||||
}
|
||||
return pt->code[last];
|
||||
}
|
||||
|
||||
/* }====================================================== */
|
||||
|
||||
|
||||
int luaG_checkcode (const Proto *pt) {
|
||||
return luaG_symbexec(pt, pt->sizecode, NO_REG);
|
||||
}
|
||||
|
||||
|
||||
static const l_char *getobjname (lua_State *L, StkId obj, const l_char **name) {
|
||||
CallInfo *ci = ci_stack(L, obj);
|
||||
if (isLmark(ci)) { /* an active Lua function? */
|
||||
Proto *p = ci_func(ci)->f.l;
|
||||
int pc = currentpc(ci);
|
||||
int stackpos = obj - ci->base;
|
||||
Instruction i;
|
||||
*name = luaF_getlocalname(p, stackpos+1, pc);
|
||||
if (*name) /* is a local? */
|
||||
return l_s("local");
|
||||
i = luaG_symbexec(p, pc, stackpos); /* try symbolic execution */
|
||||
lua_assert(pc != -1);
|
||||
switch (GET_OPCODE(i)) {
|
||||
case OP_GETGLOBAL: {
|
||||
lua_assert(ttype(&p->k[GETARG_Bc(i)]) == LUA_TSTRING);
|
||||
*name = svalue(&p->k[GETARG_Bc(i)]);
|
||||
return l_s("global");
|
||||
}
|
||||
case OP_MOVE: {
|
||||
int a = GETARG_A(i);
|
||||
int b = GETARG_B(i); /* move from `b' to `a' */
|
||||
if (b < a)
|
||||
return getobjname(L, ci->base+b, name); /* get name for `b' */
|
||||
break;
|
||||
}
|
||||
case OP_GETTABLE:
|
||||
case OP_SELF: {
|
||||
int c = GETARG_C(i) - MAXSTACK;
|
||||
if (c >= 0 && ttype(&p->k[c]) == LUA_TSTRING) {
|
||||
*name = svalue(&p->k[c]);
|
||||
return l_s("field");
|
||||
}
|
||||
break;
|
||||
}
|
||||
default: break;
|
||||
}
|
||||
}
|
||||
return NULL; /* no useful name found */
|
||||
}
|
||||
|
||||
|
||||
static const l_char *getfuncname (lua_State *L, CallInfo *ci,
|
||||
const l_char **name) {
|
||||
ci = ci->prev; /* calling function */
|
||||
if (ci == &L->basefunc || !isLmark(ci))
|
||||
return NULL; /* not an active Lua function */
|
||||
else {
|
||||
Proto *p = ci_func(ci)->f.l;
|
||||
int pc = currentpc(ci);
|
||||
Instruction i;
|
||||
if (pc == -1) return NULL; /* function is not activated */
|
||||
i = p->code[pc];
|
||||
return (GET_OPCODE(i) == OP_CALL
|
||||
? getobjname(L, ci->base+GETARG_A(i), name)
|
||||
: NULL); /* no useful name found */
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
void luaG_typeerror (lua_State *L, StkId o, const l_char *op) {
|
||||
const l_char *name;
|
||||
const l_char *kind = getobjname(L, o, &name);
|
||||
const l_char *t = luaT_typename(G(L), o);
|
||||
if (kind)
|
||||
luaO_verror(L, l_s("attempt to %.30s %.20s `%.40s' (a %.10s value)"),
|
||||
op, kind, name, t);
|
||||
else
|
||||
luaO_verror(L, l_s("attempt to %.30s a %.10s value"), op, t);
|
||||
}
|
||||
|
||||
|
||||
void luaG_concaterror (lua_State *L, StkId p1, StkId p2) {
|
||||
if (ttype(p1) == LUA_TSTRING) p1 = p2;
|
||||
lua_assert(ttype(p1) != LUA_TSTRING);
|
||||
luaG_typeerror(L, p1, l_s("concat"));
|
||||
}
|
||||
|
||||
|
||||
void luaG_aritherror (lua_State *L, StkId p1, TObject *p2) {
|
||||
TObject temp;
|
||||
if (luaV_tonumber(p1, &temp) != NULL)
|
||||
p1 = p2; /* first operand is OK; error is in the second */
|
||||
luaG_typeerror(L, p1, l_s("perform arithmetic on"));
|
||||
}
|
||||
|
||||
|
||||
void luaG_ordererror (lua_State *L, const TObject *p1, const TObject *p2) {
|
||||
const l_char *t1 = luaT_typename(G(L), p1);
|
||||
const l_char *t2 = luaT_typename(G(L), p2);
|
||||
if (t1[2] == t2[2])
|
||||
luaO_verror(L, l_s("attempt to compare two %.10s values"), t1);
|
||||
else
|
||||
luaO_verror(L, l_s("attempt to compare %.10s with %.10s"), t1, t2);
|
||||
}
|
||||
|
||||
23
ldebug.h
23
ldebug.h
@@ -1,23 +0,0 @@
|
||||
/*
|
||||
** $Id: ldebug.h,v 1.14 2001/06/11 14:56:42 roberto Exp roberto $
|
||||
** Auxiliary functions from Debug Interface module
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
#ifndef ldebug_h
|
||||
#define ldebug_h
|
||||
|
||||
|
||||
#include "lstate.h"
|
||||
#include "luadebug.h"
|
||||
|
||||
|
||||
void luaG_typeerror (lua_State *L, StkId o, const l_char *op);
|
||||
void luaG_concaterror (lua_State *L, StkId p1, StkId p2);
|
||||
void luaG_aritherror (lua_State *L, StkId p1, TObject *p2);
|
||||
int luaG_getline (int *lineinfo, int pc, int refline, int *refi);
|
||||
void luaG_ordererror (lua_State *L, const TObject *p1, const TObject *p2);
|
||||
int luaG_checkcode (const Proto *pt);
|
||||
|
||||
|
||||
#endif
|
||||
348
ldo.c
348
ldo.c
@@ -1,348 +0,0 @@
|
||||
/*
|
||||
** $Id: ldo.c,v 1.137 2001/07/12 19:34:03 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>
|
||||
|
||||
#define LUA_PRIVATE
|
||||
#include "lua.h"
|
||||
|
||||
#include "ldebug.h"
|
||||
#include "ldo.h"
|
||||
#include "lgc.h"
|
||||
#include "lmem.h"
|
||||
#include "lobject.h"
|
||||
#include "lparser.h"
|
||||
#include "lstate.h"
|
||||
#include "lstring.h"
|
||||
#include "ltable.h"
|
||||
#include "ltm.h"
|
||||
#include "lundump.h"
|
||||
#include "lvm.h"
|
||||
#include "lzio.h"
|
||||
|
||||
|
||||
/* space to handle stack overflow errors */
|
||||
#define EXTRA_STACK (2*LUA_MINSTACK)
|
||||
|
||||
|
||||
static void restore_stack_limit (lua_State *L) {
|
||||
StkId limit = L->stack+(L->stacksize-EXTRA_STACK)-1;
|
||||
if (L->top < limit)
|
||||
L->stack_last = limit;
|
||||
}
|
||||
|
||||
|
||||
void luaD_init (lua_State *L, int stacksize) {
|
||||
stacksize += EXTRA_STACK;
|
||||
L->stack = luaM_newvector(L, stacksize, TObject);
|
||||
L->stacksize = stacksize;
|
||||
L->basefunc.base = L->top = L->stack;
|
||||
restore_stack_limit(L);
|
||||
}
|
||||
|
||||
|
||||
void luaD_stackerror (lua_State *L) {
|
||||
if (L->stack_last == L->stack+L->stacksize-1) {
|
||||
/* overflow while handling overflow */
|
||||
luaD_breakrun(L, LUA_ERRERR); /* break run without error message */
|
||||
}
|
||||
else {
|
||||
L->stack_last += EXTRA_STACK; /* to be used by error message */
|
||||
lua_assert(L->stack_last == L->stack+L->stacksize-1);
|
||||
luaD_error(L, l_s("stack overflow"));
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** adjust top to new value; assume that new top is valid
|
||||
*/
|
||||
void luaD_adjusttop (lua_State *L, StkId newtop) {
|
||||
while (L->top < newtop)
|
||||
setnilvalue(L->top++);
|
||||
L->top = newtop; /* `newtop' could be lower than `top' */
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Open a hole inside the stack at `pos'
|
||||
*/
|
||||
static void luaD_openstack (lua_State *L, StkId pos) {
|
||||
int i = L->top-pos;
|
||||
while (i--) setobj(pos+i+1, pos+i);
|
||||
incr_top;
|
||||
}
|
||||
|
||||
|
||||
static void dohook (lua_State *L, lua_Debug *ar, lua_Hook hook) {
|
||||
StkId old_top = L->top;
|
||||
luaD_checkstack(L, LUA_MINSTACK); /* ensure minimum stack size */
|
||||
L->allowhooks = 0; /* cannot call hooks inside a hook */
|
||||
lua_unlock(L);
|
||||
(*hook)(L, ar);
|
||||
lua_lock(L);
|
||||
lua_assert(L->allowhooks == 0);
|
||||
L->allowhooks = 1;
|
||||
L->top = old_top;
|
||||
}
|
||||
|
||||
|
||||
void luaD_lineHook (lua_State *L, int line, lua_Hook linehook) {
|
||||
if (L->allowhooks) {
|
||||
lua_Debug ar;
|
||||
ar.event = l_s("line");
|
||||
ar._ci = L->ci;
|
||||
ar.currentline = line;
|
||||
dohook(L, &ar, linehook);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void luaD_callHook (lua_State *L, lua_Hook callhook,
|
||||
const l_char *event) {
|
||||
if (L->allowhooks) {
|
||||
lua_Debug ar;
|
||||
ar.event = event;
|
||||
ar._ci = L->ci;
|
||||
L->ci->pc = NULL; /* function is not active */
|
||||
dohook(L, &ar, callhook);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static StkId callCclosure (lua_State *L, const struct Closure *cl) {
|
||||
int nup = cl->nupvalues; /* number of upvalues */
|
||||
int n;
|
||||
luaD_checkstack(L, nup+LUA_MINSTACK); /* ensure minimum stack size */
|
||||
for (n=0; n<nup; n++) /* copy upvalues as extra arguments */
|
||||
setobj(L->top++, &cl->upvalue[n]);
|
||||
lua_unlock(L);
|
||||
n = (*cl->f.c)(L); /* do the actual call */
|
||||
lua_lock(L);
|
||||
return L->top - n; /* return index of first result */
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Call a function (C or Lua). The function to be called is at *func.
|
||||
** The arguments are on the stack, right after the function.
|
||||
** When returns, all the results are on the stack, starting at the original
|
||||
** function position.
|
||||
*/
|
||||
void luaD_call (lua_State *L, StkId func) {
|
||||
lua_Hook callhook;
|
||||
StkId firstResult;
|
||||
CallInfo ci;
|
||||
if (ttype(func) != LUA_TFUNCTION) {
|
||||
/* `func' is not a function; check the `function' tag method */
|
||||
Closure *tm = luaT_gettmbyObj(G(L), func, TM_FUNCTION);
|
||||
if (tm == NULL)
|
||||
luaG_typeerror(L, func, l_s("call"));
|
||||
luaD_openstack(L, func);
|
||||
setclvalue(func, tm); /* tag method is the new function to be called */
|
||||
}
|
||||
ci.prev = L->ci; /* chain new callinfo */
|
||||
L->ci = &ci;
|
||||
ci.base = func+1;
|
||||
callhook = L->callhook;
|
||||
if (callhook)
|
||||
luaD_callHook(L, callhook, l_s("call"));
|
||||
firstResult = (clvalue(func)->isC ? callCclosure(L, clvalue(func)) :
|
||||
luaV_execute(L, clvalue(func), func+1));
|
||||
if (callhook) /* same hook that was active at entry */
|
||||
luaD_callHook(L, callhook, l_s("return"));
|
||||
L->ci = ci.prev; /* unchain callinfo */
|
||||
/* move results to `func' (to erase parameters and function) */
|
||||
while (firstResult < L->top)
|
||||
setobj(func++, firstResult++);
|
||||
L->top = func;
|
||||
luaC_checkGC(L);
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Execute a protected call.
|
||||
*/
|
||||
struct CallS { /* data to `f_call' */
|
||||
StkId func;
|
||||
int nresults;
|
||||
};
|
||||
|
||||
static void f_call (lua_State *L, void *ud) {
|
||||
struct CallS *c = (struct CallS *)ud;
|
||||
luaD_call(L, c->func);
|
||||
if (c->nresults != LUA_MULTRET)
|
||||
luaD_adjusttop(L, c->func + c->nresults);
|
||||
}
|
||||
|
||||
|
||||
LUA_API int lua_call (lua_State *L, int nargs, int nresults) {
|
||||
StkId func;
|
||||
struct CallS c;
|
||||
int status;
|
||||
lua_lock(L);
|
||||
func = L->top - (nargs+1); /* function to be called */
|
||||
c.func = func; c.nresults = nresults;
|
||||
status = luaD_runprotected(L, f_call, &c);
|
||||
if (status != 0) /* an error occurred? */
|
||||
L->top = func; /* remove parameters from the stack */
|
||||
lua_unlock(L);
|
||||
return status;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Execute a protected parser.
|
||||
*/
|
||||
struct SParser { /* data to `f_parser' */
|
||||
ZIO *z;
|
||||
int bin;
|
||||
};
|
||||
|
||||
static void f_parser (lua_State *L, void *ud) {
|
||||
struct SParser *p = (struct SParser *)ud;
|
||||
Proto *tf = p->bin ? luaU_undump(L, p->z) : luaY_parser(L, p->z);
|
||||
luaV_Lclosure(L, tf, 0);
|
||||
}
|
||||
|
||||
|
||||
static int protectedparser (lua_State *L, ZIO *z, int bin) {
|
||||
struct SParser p;
|
||||
lu_mem old_blocks;
|
||||
int status;
|
||||
lua_lock(L);
|
||||
p.z = z; p.bin = bin;
|
||||
/* before parsing, give a (good) chance to GC */
|
||||
if (G(L)->nblocks/8 >= G(L)->GCthreshold/10)
|
||||
luaC_collectgarbage(L);
|
||||
old_blocks = G(L)->nblocks;
|
||||
status = luaD_runprotected(L, f_parser, &p);
|
||||
if (status == 0) {
|
||||
/* add new memory to threshold (as it probably will stay) */
|
||||
lua_assert(G(L)->nblocks >= old_blocks);
|
||||
G(L)->GCthreshold += (G(L)->nblocks - old_blocks);
|
||||
}
|
||||
else if (status == LUA_ERRRUN) /* an error occurred: correct error code */
|
||||
status = LUA_ERRSYNTAX;
|
||||
lua_unlock(L);
|
||||
return status;
|
||||
}
|
||||
|
||||
|
||||
LUA_API int lua_loadfile (lua_State *L, const l_char *filename) {
|
||||
ZIO z;
|
||||
int status;
|
||||
int bin; /* flag for file mode */
|
||||
int nlevel; /* level on the stack of filename */
|
||||
FILE *f = (filename == NULL) ? stdin : fopen(filename, l_s("r"));
|
||||
if (f == NULL) return LUA_ERRFILE; /* unable to open file */
|
||||
bin = (ungetc(getc(f), f) == LUA_SIGNATURE[0]);
|
||||
if (bin && f != stdin) {
|
||||
fclose(f);
|
||||
f = fopen(filename, l_s("rb")); /* reopen in binary mode */
|
||||
if (f == NULL) return LUA_ERRFILE; /* unable to reopen file */
|
||||
}
|
||||
lua_pushliteral(L, l_s("@"));
|
||||
lua_pushstring(L, (filename == NULL) ? l_s("(stdin)") : filename);
|
||||
lua_concat(L, 2);
|
||||
nlevel = lua_gettop(L);
|
||||
filename = lua_tostring(L, -1); /* filename = `@'..filename */
|
||||
luaZ_Fopen(&z, f, filename);
|
||||
status = protectedparser(L, &z, bin);
|
||||
lua_remove(L, nlevel); /* remove filename */
|
||||
if (f != stdin)
|
||||
fclose(f);
|
||||
return status;
|
||||
}
|
||||
|
||||
|
||||
LUA_API int lua_loadbuffer (lua_State *L, const l_char *buff, size_t size,
|
||||
const l_char *name) {
|
||||
ZIO z;
|
||||
int status;
|
||||
if (!name) name = l_s("?");
|
||||
luaZ_mopen(&z, buff, size, name);
|
||||
status = protectedparser(L, &z, buff[0]==LUA_SIGNATURE[0]);
|
||||
return status;
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** {======================================================
|
||||
** Error-recover functions (based on long jumps)
|
||||
** =======================================================
|
||||
*/
|
||||
|
||||
/* chain list of long jump buffers */
|
||||
struct lua_longjmp {
|
||||
jmp_buf b;
|
||||
struct lua_longjmp *previous;
|
||||
volatile int status; /* error code */
|
||||
};
|
||||
|
||||
|
||||
static void message (lua_State *L, const l_char *s) {
|
||||
StkId top = L->top;
|
||||
luaV_getglobal(L, luaS_newliteral(L, l_s(LUA_ERRORMESSAGE)), top);
|
||||
if (ttype(top) == LUA_TFUNCTION) {
|
||||
incr_top;
|
||||
setsvalue(top+1, luaS_new(L, s));
|
||||
incr_top;
|
||||
luaD_call(L, top);
|
||||
L->top = top;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Reports an error, and jumps up to the available recovery label
|
||||
*/
|
||||
void luaD_error (lua_State *L, const l_char *s) {
|
||||
if (s) message(L, s);
|
||||
luaD_breakrun(L, LUA_ERRRUN);
|
||||
}
|
||||
|
||||
|
||||
void luaD_breakrun (lua_State *L, int errcode) {
|
||||
if (L->errorJmp) {
|
||||
L->errorJmp->status = errcode;
|
||||
longjmp(L->errorJmp->b, 1);
|
||||
}
|
||||
else {
|
||||
if (errcode != LUA_ERRMEM)
|
||||
message(L, l_s("unable to recover; exiting\n"));
|
||||
exit(EXIT_FAILURE);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
int luaD_runprotected (lua_State *L, void (*f)(lua_State *, void *), void *ud) {
|
||||
CallInfo *oldci = L->ci;
|
||||
StkId oldtop = L->top;
|
||||
struct lua_longjmp lj;
|
||||
int allowhooks = L->allowhooks;
|
||||
lj.status = 0;
|
||||
lj.previous = L->errorJmp; /* chain new error handler */
|
||||
L->errorJmp = &lj;
|
||||
if (setjmp(lj.b) == 0)
|
||||
(*f)(L, ud);
|
||||
else { /* an error occurred: restore the state */
|
||||
L->allowhooks = allowhooks;
|
||||
L->ci = oldci;
|
||||
L->top = oldtop;
|
||||
restore_stack_limit(L);
|
||||
}
|
||||
L->errorJmp = lj.previous; /* restore old error handler */
|
||||
return lj.status;
|
||||
}
|
||||
|
||||
/* }====================================================== */
|
||||
|
||||
36
ldo.h
36
ldo.h
@@ -1,36 +0,0 @@
|
||||
/*
|
||||
** $Id: ldo.h,v 1.33 2001/06/05 19:41:24 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"
|
||||
|
||||
|
||||
/*
|
||||
** macro to increment stack top.
|
||||
** There must be always an empty slot at the L->stack.top
|
||||
*/
|
||||
#define incr_top {if (L->top == L->stack_last) luaD_checkstack(L, 1); L->top++;}
|
||||
|
||||
|
||||
#define luaD_checkstack(L,n) if (L->stack_last-(n)<=L->top) luaD_stackerror(L)
|
||||
|
||||
|
||||
void luaD_init (lua_State *L, int stacksize);
|
||||
void luaD_adjusttop (lua_State *L, StkId newtop);
|
||||
void luaD_lineHook (lua_State *L, int line, lua_Hook linehook);
|
||||
void luaD_call (lua_State *L, StkId func);
|
||||
void luaD_stackerror (lua_State *L);
|
||||
|
||||
void luaD_error (lua_State *L, const l_char *s);
|
||||
void luaD_breakrun (lua_State *L, int errcode);
|
||||
int luaD_runprotected (lua_State *L, void (*f)(lua_State *, void *), void *ud);
|
||||
|
||||
|
||||
#endif
|
||||
923
lex_yy.c
Normal file
923
lex_yy.c
Normal file
@@ -0,0 +1,923 @@
|
||||
# include "stdio.h"
|
||||
# define U(x) x
|
||||
# define NLSTATE yyprevious=YYNEWLINE
|
||||
# define BEGIN yybgin = yysvec + 1 +
|
||||
# define INITIAL 0
|
||||
# define YYLERR yysvec
|
||||
# define YYSTATE (yyestate-yysvec-1)
|
||||
# define YYOPTIM 1
|
||||
# define YYLMAX BUFSIZ
|
||||
# define output(c) putc(c,yyout)
|
||||
# define input() (((yytchar=yysptr>yysbuf?U(*--yysptr):getc(yyin))==10?(yylineno++,yytchar):yytchar)==EOF?0:yytchar)
|
||||
# define unput(c) {yytchar= (c);if(yytchar=='\n')yylineno--;*yysptr++=yytchar;}
|
||||
# define yymore() (yymorfg=1)
|
||||
# define ECHO fprintf(yyout, "%s",yytext)
|
||||
# define REJECT { nstr = yyreject(); goto yyfussy;}
|
||||
int yyleng; extern char yytext[];
|
||||
int yymorfg;
|
||||
extern char *yysptr, yysbuf[];
|
||||
int yytchar;
|
||||
FILE *yyin = {stdin}, *yyout = {stdout};
|
||||
extern int yylineno;
|
||||
struct yysvf {
|
||||
struct yywork *yystoff;
|
||||
struct yysvf *yyother;
|
||||
int *yystops;};
|
||||
struct yysvf *yyestate;
|
||||
extern struct yysvf yysvec[], *yybgin;
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
#include "opcode.h"
|
||||
#include "hash.h"
|
||||
#include "inout.h"
|
||||
#include "table.h"
|
||||
#include "y_tab.h"
|
||||
|
||||
#undef input
|
||||
#undef unput
|
||||
|
||||
static Input input;
|
||||
static Unput unput;
|
||||
|
||||
void lua_setinput (Input fn)
|
||||
{
|
||||
input = fn;
|
||||
}
|
||||
|
||||
void lua_setunput (Unput fn)
|
||||
{
|
||||
unput = fn;
|
||||
}
|
||||
|
||||
char *lua_lasttext (void)
|
||||
{
|
||||
return yytext;
|
||||
}
|
||||
|
||||
# define YYNEWLINE 10
|
||||
yylex(){
|
||||
int nstr; extern int yyprevious;
|
||||
while((nstr = yylook()) >= 0)
|
||||
yyfussy: switch(nstr){
|
||||
case 0:
|
||||
if(yywrap()) return(0); break;
|
||||
case 1:
|
||||
;
|
||||
break;
|
||||
case 2:
|
||||
{yylval.vInt = 1; return DEBUG;}
|
||||
break;
|
||||
case 3:
|
||||
{yylval.vInt = 0; return DEBUG;}
|
||||
break;
|
||||
case 4:
|
||||
lua_linenumber++;
|
||||
break;
|
||||
case 5:
|
||||
;
|
||||
break;
|
||||
case 6:
|
||||
return LOCAL;
|
||||
break;
|
||||
case 7:
|
||||
return IF;
|
||||
break;
|
||||
case 8:
|
||||
return THEN;
|
||||
break;
|
||||
case 9:
|
||||
return ELSE;
|
||||
break;
|
||||
case 10:
|
||||
return ELSEIF;
|
||||
break;
|
||||
case 11:
|
||||
return WHILE;
|
||||
break;
|
||||
case 12:
|
||||
return DO;
|
||||
break;
|
||||
case 13:
|
||||
return REPEAT;
|
||||
break;
|
||||
case 14:
|
||||
return UNTIL;
|
||||
break;
|
||||
case 15:
|
||||
{
|
||||
yylval.vWord = lua_nfile-1;
|
||||
return FUNCTION;
|
||||
}
|
||||
break;
|
||||
case 16:
|
||||
return END;
|
||||
break;
|
||||
case 17:
|
||||
return RETURN;
|
||||
break;
|
||||
case 18:
|
||||
return LOCAL;
|
||||
break;
|
||||
case 19:
|
||||
return NIL;
|
||||
break;
|
||||
case 20:
|
||||
return AND;
|
||||
break;
|
||||
case 21:
|
||||
return OR;
|
||||
break;
|
||||
case 22:
|
||||
return NOT;
|
||||
break;
|
||||
case 23:
|
||||
return NE;
|
||||
break;
|
||||
case 24:
|
||||
return LE;
|
||||
break;
|
||||
case 25:
|
||||
return GE;
|
||||
break;
|
||||
case 26:
|
||||
return CONC;
|
||||
break;
|
||||
case 27:
|
||||
case 28:
|
||||
{
|
||||
yylval.vWord = lua_findenclosedconstant (yytext);
|
||||
return STRING;
|
||||
}
|
||||
break;
|
||||
case 29:
|
||||
case 30:
|
||||
case 31:
|
||||
case 32:
|
||||
{
|
||||
yylval.vFloat = atof(yytext);
|
||||
return NUMBER;
|
||||
}
|
||||
break;
|
||||
case 33:
|
||||
{
|
||||
yylval.vWord = lua_findsymbol (yytext);
|
||||
return NAME;
|
||||
}
|
||||
break;
|
||||
case 34:
|
||||
return *yytext;
|
||||
break;
|
||||
case -1:
|
||||
break;
|
||||
default:
|
||||
fprintf(yyout,"bad switch yylook %d",nstr);
|
||||
} return(0); }
|
||||
/* end of yylex */
|
||||
int yyvstop[] = {
|
||||
0,
|
||||
|
||||
1,
|
||||
0,
|
||||
|
||||
1,
|
||||
0,
|
||||
|
||||
34,
|
||||
0,
|
||||
|
||||
1,
|
||||
34,
|
||||
0,
|
||||
|
||||
4,
|
||||
0,
|
||||
|
||||
34,
|
||||
0,
|
||||
|
||||
34,
|
||||
0,
|
||||
|
||||
34,
|
||||
0,
|
||||
|
||||
34,
|
||||
0,
|
||||
|
||||
29,
|
||||
34,
|
||||
0,
|
||||
|
||||
34,
|
||||
0,
|
||||
|
||||
34,
|
||||
0,
|
||||
|
||||
33,
|
||||
34,
|
||||
0,
|
||||
|
||||
33,
|
||||
34,
|
||||
0,
|
||||
|
||||
33,
|
||||
34,
|
||||
0,
|
||||
|
||||
33,
|
||||
34,
|
||||
0,
|
||||
|
||||
33,
|
||||
34,
|
||||
0,
|
||||
|
||||
33,
|
||||
34,
|
||||
0,
|
||||
|
||||
33,
|
||||
34,
|
||||
0,
|
||||
|
||||
33,
|
||||
34,
|
||||
0,
|
||||
|
||||
33,
|
||||
34,
|
||||
0,
|
||||
|
||||
33,
|
||||
34,
|
||||
0,
|
||||
|
||||
33,
|
||||
34,
|
||||
0,
|
||||
|
||||
33,
|
||||
34,
|
||||
0,
|
||||
|
||||
33,
|
||||
34,
|
||||
0,
|
||||
|
||||
34,
|
||||
0,
|
||||
|
||||
34,
|
||||
0,
|
||||
|
||||
1,
|
||||
0,
|
||||
|
||||
27,
|
||||
0,
|
||||
|
||||
28,
|
||||
0,
|
||||
|
||||
5,
|
||||
0,
|
||||
|
||||
26,
|
||||
0,
|
||||
|
||||
30,
|
||||
0,
|
||||
|
||||
29,
|
||||
0,
|
||||
|
||||
29,
|
||||
0,
|
||||
|
||||
24,
|
||||
0,
|
||||
|
||||
25,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
12,
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
7,
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
21,
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
23,
|
||||
0,
|
||||
|
||||
29,
|
||||
30,
|
||||
0,
|
||||
|
||||
31,
|
||||
0,
|
||||
|
||||
20,
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
16,
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
19,
|
||||
33,
|
||||
0,
|
||||
|
||||
22,
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
32,
|
||||
0,
|
||||
|
||||
9,
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
8,
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
31,
|
||||
32,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
6,
|
||||
18,
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
14,
|
||||
33,
|
||||
0,
|
||||
|
||||
11,
|
||||
33,
|
||||
0,
|
||||
|
||||
10,
|
||||
33,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
13,
|
||||
33,
|
||||
0,
|
||||
|
||||
17,
|
||||
33,
|
||||
0,
|
||||
|
||||
2,
|
||||
0,
|
||||
|
||||
33,
|
||||
0,
|
||||
|
||||
15,
|
||||
33,
|
||||
0,
|
||||
|
||||
3,
|
||||
0,
|
||||
0};
|
||||
# define YYTYPE char
|
||||
struct yywork { YYTYPE verify, advance; } yycrank[] = {
|
||||
0,0, 0,0, 1,3, 0,0,
|
||||
0,0, 0,0, 0,0, 0,0,
|
||||
0,0, 0,0, 1,4, 1,5,
|
||||
6,29, 4,28, 0,0, 0,0,
|
||||
0,0, 0,0, 7,31, 0,0,
|
||||
6,29, 6,29, 0,0, 0,0,
|
||||
0,0, 0,0, 7,31, 7,31,
|
||||
0,0, 0,0, 0,0, 0,0,
|
||||
0,0, 0,0, 0,0, 1,6,
|
||||
4,28, 0,0, 0,0, 0,0,
|
||||
1,7, 0,0, 0,0, 0,0,
|
||||
1,3, 6,30, 1,8, 1,9,
|
||||
0,0, 1,10, 6,29, 7,31,
|
||||
8,33, 0,0, 6,29, 0,0,
|
||||
7,32, 0,0, 0,0, 6,29,
|
||||
7,31, 1,11, 0,0, 1,12,
|
||||
2,27, 7,31, 1,13, 11,39,
|
||||
12,40, 1,13, 26,56, 0,0,
|
||||
0,0, 2,8, 2,9, 0,0,
|
||||
6,29, 0,0, 0,0, 6,29,
|
||||
0,0, 0,0, 7,31, 0,0,
|
||||
0,0, 7,31, 0,0, 0,0,
|
||||
2,11, 0,0, 2,12, 0,0,
|
||||
0,0, 0,0, 0,0, 0,0,
|
||||
0,0, 0,0, 1,14, 0,0,
|
||||
0,0, 1,15, 1,16, 1,17,
|
||||
0,0, 22,52, 1,18, 18,47,
|
||||
23,53, 1,19, 42,63, 1,20,
|
||||
1,21, 25,55, 14,42, 1,22,
|
||||
15,43, 1,23, 1,24, 16,44,
|
||||
1,25, 16,45, 17,46, 19,48,
|
||||
21,51, 2,14, 20,49, 1,26,
|
||||
2,15, 2,16, 2,17, 24,54,
|
||||
20,50, 2,18, 44,64, 45,65,
|
||||
2,19, 46,66, 2,20, 2,21,
|
||||
27,57, 48,67, 2,22, 49,68,
|
||||
2,23, 2,24, 50,69, 2,25,
|
||||
52,70, 53,72, 27,58, 54,73,
|
||||
52,71, 9,34, 2,26, 9,35,
|
||||
9,35, 9,35, 9,35, 9,35,
|
||||
9,35, 9,35, 9,35, 9,35,
|
||||
9,35, 10,36, 55,74, 10,37,
|
||||
10,37, 10,37, 10,37, 10,37,
|
||||
10,37, 10,37, 10,37, 10,37,
|
||||
10,37, 57,75, 58,76, 64,80,
|
||||
66,81, 67,82, 70,83, 71,84,
|
||||
72,85, 73,86, 74,87, 10,38,
|
||||
10,38, 38,61, 10,38, 38,61,
|
||||
75,88, 76,89, 38,62, 38,62,
|
||||
38,62, 38,62, 38,62, 38,62,
|
||||
38,62, 38,62, 38,62, 38,62,
|
||||
80,92, 81,93, 13,41, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
82,94, 83,95, 84,96, 10,38,
|
||||
10,38, 86,97, 10,38, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
13,41, 87,98, 88,99, 60,79,
|
||||
60,79, 13,41, 60,79, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
13,41, 13,41, 13,41, 13,41,
|
||||
13,41, 33,33, 89,100, 60,79,
|
||||
60,79, 92,101, 60,79, 93,102,
|
||||
95,103, 33,33, 33,0, 96,104,
|
||||
99,105, 100,106, 102,107, 106,108,
|
||||
107,109, 35,35, 35,35, 35,35,
|
||||
35,35, 35,35, 35,35, 35,35,
|
||||
35,35, 35,35, 35,35, 108,110,
|
||||
0,0, 0,0, 0,0, 0,0,
|
||||
0,0, 0,0, 33,33, 0,0,
|
||||
0,0, 35,59, 35,59, 33,33,
|
||||
35,59, 0,0, 0,0, 33,33,
|
||||
0,0, 0,0, 0,0, 0,0,
|
||||
33,33, 0,0, 0,0, 0,0,
|
||||
0,0, 36,60, 36,60, 36,60,
|
||||
36,60, 36,60, 36,60, 36,60,
|
||||
36,60, 36,60, 36,60, 0,0,
|
||||
0,0, 33,33, 0,0, 0,0,
|
||||
33,33, 35,59, 35,59, 0,0,
|
||||
35,59, 36,38, 36,38, 59,77,
|
||||
36,38, 59,77, 0,0, 0,0,
|
||||
59,78, 59,78, 59,78, 59,78,
|
||||
59,78, 59,78, 59,78, 59,78,
|
||||
59,78, 59,78, 61,62, 61,62,
|
||||
61,62, 61,62, 61,62, 61,62,
|
||||
61,62, 61,62, 61,62, 61,62,
|
||||
0,0, 0,0, 0,0, 0,0,
|
||||
0,0, 36,38, 36,38, 0,0,
|
||||
36,38, 77,78, 77,78, 77,78,
|
||||
77,78, 77,78, 77,78, 77,78,
|
||||
77,78, 77,78, 77,78, 79,90,
|
||||
0,0, 79,90, 0,0, 0,0,
|
||||
79,91, 79,91, 79,91, 79,91,
|
||||
79,91, 79,91, 79,91, 79,91,
|
||||
79,91, 79,91, 90,91, 90,91,
|
||||
90,91, 90,91, 90,91, 90,91,
|
||||
90,91, 90,91, 90,91, 90,91,
|
||||
0,0};
|
||||
struct yysvf yysvec[] = {
|
||||
0, 0, 0,
|
||||
yycrank+-1, 0, yyvstop+1,
|
||||
yycrank+-28, yysvec+1, yyvstop+3,
|
||||
yycrank+0, 0, yyvstop+5,
|
||||
yycrank+4, 0, yyvstop+7,
|
||||
yycrank+0, 0, yyvstop+10,
|
||||
yycrank+-11, 0, yyvstop+12,
|
||||
yycrank+-17, 0, yyvstop+14,
|
||||
yycrank+7, 0, yyvstop+16,
|
||||
yycrank+107, 0, yyvstop+18,
|
||||
yycrank+119, 0, yyvstop+20,
|
||||
yycrank+6, 0, yyvstop+23,
|
||||
yycrank+7, 0, yyvstop+25,
|
||||
yycrank+158, 0, yyvstop+27,
|
||||
yycrank+4, yysvec+13, yyvstop+30,
|
||||
yycrank+5, yysvec+13, yyvstop+33,
|
||||
yycrank+11, yysvec+13, yyvstop+36,
|
||||
yycrank+5, yysvec+13, yyvstop+39,
|
||||
yycrank+5, yysvec+13, yyvstop+42,
|
||||
yycrank+12, yysvec+13, yyvstop+45,
|
||||
yycrank+21, yysvec+13, yyvstop+48,
|
||||
yycrank+10, yysvec+13, yyvstop+51,
|
||||
yycrank+4, yysvec+13, yyvstop+54,
|
||||
yycrank+4, yysvec+13, yyvstop+57,
|
||||
yycrank+21, yysvec+13, yyvstop+60,
|
||||
yycrank+9, yysvec+13, yyvstop+63,
|
||||
yycrank+9, 0, yyvstop+66,
|
||||
yycrank+40, 0, yyvstop+68,
|
||||
yycrank+0, yysvec+4, yyvstop+70,
|
||||
yycrank+0, yysvec+6, 0,
|
||||
yycrank+0, 0, yyvstop+72,
|
||||
yycrank+0, yysvec+7, 0,
|
||||
yycrank+0, 0, yyvstop+74,
|
||||
yycrank+-280, 0, yyvstop+76,
|
||||
yycrank+0, 0, yyvstop+78,
|
||||
yycrank+249, 0, yyvstop+80,
|
||||
yycrank+285, 0, yyvstop+82,
|
||||
yycrank+0, yysvec+10, yyvstop+84,
|
||||
yycrank+146, 0, 0,
|
||||
yycrank+0, 0, yyvstop+86,
|
||||
yycrank+0, 0, yyvstop+88,
|
||||
yycrank+0, yysvec+13, yyvstop+90,
|
||||
yycrank+10, yysvec+13, yyvstop+92,
|
||||
yycrank+0, yysvec+13, yyvstop+94,
|
||||
yycrank+19, yysvec+13, yyvstop+97,
|
||||
yycrank+35, yysvec+13, yyvstop+99,
|
||||
yycrank+27, yysvec+13, yyvstop+101,
|
||||
yycrank+0, yysvec+13, yyvstop+103,
|
||||
yycrank+42, yysvec+13, yyvstop+106,
|
||||
yycrank+35, yysvec+13, yyvstop+108,
|
||||
yycrank+30, yysvec+13, yyvstop+110,
|
||||
yycrank+0, yysvec+13, yyvstop+112,
|
||||
yycrank+36, yysvec+13, yyvstop+115,
|
||||
yycrank+48, yysvec+13, yyvstop+117,
|
||||
yycrank+35, yysvec+13, yyvstop+119,
|
||||
yycrank+61, yysvec+13, yyvstop+121,
|
||||
yycrank+0, 0, yyvstop+123,
|
||||
yycrank+76, 0, 0,
|
||||
yycrank+67, 0, 0,
|
||||
yycrank+312, 0, 0,
|
||||
yycrank+183, yysvec+36, yyvstop+125,
|
||||
yycrank+322, 0, 0,
|
||||
yycrank+0, yysvec+61, yyvstop+128,
|
||||
yycrank+0, yysvec+13, yyvstop+130,
|
||||
yycrank+78, yysvec+13, yyvstop+133,
|
||||
yycrank+0, yysvec+13, yyvstop+135,
|
||||
yycrank+81, yysvec+13, yyvstop+138,
|
||||
yycrank+84, yysvec+13, yyvstop+140,
|
||||
yycrank+0, yysvec+13, yyvstop+142,
|
||||
yycrank+0, yysvec+13, yyvstop+145,
|
||||
yycrank+81, yysvec+13, yyvstop+148,
|
||||
yycrank+66, yysvec+13, yyvstop+150,
|
||||
yycrank+74, yysvec+13, yyvstop+152,
|
||||
yycrank+80, yysvec+13, yyvstop+154,
|
||||
yycrank+78, yysvec+13, yyvstop+156,
|
||||
yycrank+94, 0, 0,
|
||||
yycrank+93, 0, 0,
|
||||
yycrank+341, 0, 0,
|
||||
yycrank+0, yysvec+77, yyvstop+158,
|
||||
yycrank+356, 0, 0,
|
||||
yycrank+99, yysvec+13, yyvstop+160,
|
||||
yycrank+89, yysvec+13, yyvstop+163,
|
||||
yycrank+108, yysvec+13, yyvstop+165,
|
||||
yycrank+120, yysvec+13, yyvstop+167,
|
||||
yycrank+104, yysvec+13, yyvstop+169,
|
||||
yycrank+0, yysvec+13, yyvstop+171,
|
||||
yycrank+113, yysvec+13, yyvstop+174,
|
||||
yycrank+148, yysvec+13, yyvstop+176,
|
||||
yycrank+133, 0, 0,
|
||||
yycrank+181, 0, 0,
|
||||
yycrank+366, 0, 0,
|
||||
yycrank+0, yysvec+90, yyvstop+178,
|
||||
yycrank+183, yysvec+13, yyvstop+181,
|
||||
yycrank+182, yysvec+13, yyvstop+183,
|
||||
yycrank+0, yysvec+13, yyvstop+185,
|
||||
yycrank+172, yysvec+13, yyvstop+189,
|
||||
yycrank+181, yysvec+13, yyvstop+191,
|
||||
yycrank+0, yysvec+13, yyvstop+193,
|
||||
yycrank+0, yysvec+13, yyvstop+196,
|
||||
yycrank+189, 0, 0,
|
||||
yycrank+195, 0, 0,
|
||||
yycrank+0, yysvec+13, yyvstop+199,
|
||||
yycrank+183, yysvec+13, yyvstop+202,
|
||||
yycrank+0, yysvec+13, yyvstop+204,
|
||||
yycrank+0, yysvec+13, yyvstop+207,
|
||||
yycrank+0, 0, yyvstop+210,
|
||||
yycrank+178, 0, 0,
|
||||
yycrank+186, yysvec+13, yyvstop+212,
|
||||
yycrank+204, 0, 0,
|
||||
yycrank+0, yysvec+13, yyvstop+214,
|
||||
yycrank+0, 0, yyvstop+217,
|
||||
0, 0, 0};
|
||||
struct yywork *yytop = yycrank+423;
|
||||
struct yysvf *yybgin = yysvec+1;
|
||||
char yymatch[] = {
|
||||
00 ,01 ,01 ,01 ,01 ,01 ,01 ,01 ,
|
||||
01 ,011 ,012 ,01 ,01 ,01 ,01 ,01 ,
|
||||
01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 ,
|
||||
01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 ,
|
||||
011 ,01 ,'"' ,01 ,01 ,01 ,01 ,047 ,
|
||||
01 ,01 ,01 ,'+' ,01 ,'+' ,01 ,01 ,
|
||||
'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,
|
||||
'0' ,'0' ,01 ,01 ,01 ,01 ,01 ,01 ,
|
||||
01 ,'A' ,'A' ,'A' ,'D' ,'D' ,'A' ,'D' ,
|
||||
'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
|
||||
'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
|
||||
'A' ,'A' ,'A' ,01 ,01 ,01 ,01 ,'A' ,
|
||||
01 ,'A' ,'A' ,'A' ,'D' ,'D' ,'A' ,'D' ,
|
||||
'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
|
||||
'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
|
||||
'A' ,'A' ,'A' ,01 ,01 ,01 ,01 ,01 ,
|
||||
0};
|
||||
char yyextra[] = {
|
||||
0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,
|
||||
0};
|
||||
#ifndef lint
|
||||
static char ncform_sccsid[] = "@(#)ncform 1.6 88/02/08 SMI"; /* from S5R2 1.2 */
|
||||
#endif
|
||||
|
||||
int yylineno =1;
|
||||
# define YYU(x) x
|
||||
# define NLSTATE yyprevious=YYNEWLINE
|
||||
char yytext[YYLMAX];
|
||||
struct yysvf *yylstate [YYLMAX], **yylsp, **yyolsp;
|
||||
char yysbuf[YYLMAX];
|
||||
char *yysptr = yysbuf;
|
||||
int *yyfnd;
|
||||
extern struct yysvf *yyestate;
|
||||
int yyprevious = YYNEWLINE;
|
||||
yylook(){
|
||||
register struct yysvf *yystate, **lsp;
|
||||
register struct yywork *yyt;
|
||||
struct yysvf *yyz;
|
||||
int yych, yyfirst;
|
||||
struct yywork *yyr;
|
||||
# ifdef LEXDEBUG
|
||||
int debug;
|
||||
# endif
|
||||
char *yylastch;
|
||||
/* start off machines */
|
||||
# ifdef LEXDEBUG
|
||||
debug = 0;
|
||||
# endif
|
||||
yyfirst=1;
|
||||
if (!yymorfg)
|
||||
yylastch = yytext;
|
||||
else {
|
||||
yymorfg=0;
|
||||
yylastch = yytext+yyleng;
|
||||
}
|
||||
for(;;){
|
||||
lsp = yylstate;
|
||||
yyestate = yystate = yybgin;
|
||||
if (yyprevious==YYNEWLINE) yystate++;
|
||||
for (;;){
|
||||
# ifdef LEXDEBUG
|
||||
if(debug)fprintf(yyout,"state %d\n",yystate-yysvec-1);
|
||||
# endif
|
||||
yyt = yystate->yystoff;
|
||||
if(yyt == yycrank && !yyfirst){ /* may not be any transitions */
|
||||
yyz = yystate->yyother;
|
||||
if(yyz == 0)break;
|
||||
if(yyz->yystoff == yycrank)break;
|
||||
}
|
||||
*yylastch++ = yych = input();
|
||||
yyfirst=0;
|
||||
tryagain:
|
||||
# ifdef LEXDEBUG
|
||||
if(debug){
|
||||
fprintf(yyout,"char ");
|
||||
allprint(yych);
|
||||
putchar('\n');
|
||||
}
|
||||
# endif
|
||||
yyr = yyt;
|
||||
if ( (int)yyt > (int)yycrank){
|
||||
yyt = yyr + yych;
|
||||
if (yyt <= yytop && yyt->verify+yysvec == yystate){
|
||||
if(yyt->advance+yysvec == YYLERR) /* error transitions */
|
||||
{unput(*--yylastch);break;}
|
||||
*lsp++ = yystate = yyt->advance+yysvec;
|
||||
goto contin;
|
||||
}
|
||||
}
|
||||
# ifdef YYOPTIM
|
||||
else if((int)yyt < (int)yycrank) { /* r < yycrank */
|
||||
yyt = yyr = yycrank+(yycrank-yyt);
|
||||
# ifdef LEXDEBUG
|
||||
if(debug)fprintf(yyout,"compressed state\n");
|
||||
# endif
|
||||
yyt = yyt + yych;
|
||||
if(yyt <= yytop && yyt->verify+yysvec == yystate){
|
||||
if(yyt->advance+yysvec == YYLERR) /* error transitions */
|
||||
{unput(*--yylastch);break;}
|
||||
*lsp++ = yystate = yyt->advance+yysvec;
|
||||
goto contin;
|
||||
}
|
||||
yyt = yyr + YYU(yymatch[yych]);
|
||||
# ifdef LEXDEBUG
|
||||
if(debug){
|
||||
fprintf(yyout,"try fall back character ");
|
||||
allprint(YYU(yymatch[yych]));
|
||||
putchar('\n');
|
||||
}
|
||||
# endif
|
||||
if(yyt <= yytop && yyt->verify+yysvec == yystate){
|
||||
if(yyt->advance+yysvec == YYLERR) /* error transition */
|
||||
{unput(*--yylastch);break;}
|
||||
*lsp++ = yystate = yyt->advance+yysvec;
|
||||
goto contin;
|
||||
}
|
||||
}
|
||||
if ((yystate = yystate->yyother) && (yyt= yystate->yystoff) != yycrank){
|
||||
# ifdef LEXDEBUG
|
||||
if(debug)fprintf(yyout,"fall back to state %d\n",yystate-yysvec-1);
|
||||
# endif
|
||||
goto tryagain;
|
||||
}
|
||||
# endif
|
||||
else
|
||||
{unput(*--yylastch);break;}
|
||||
contin:
|
||||
# ifdef LEXDEBUG
|
||||
if(debug){
|
||||
fprintf(yyout,"state %d char ",yystate-yysvec-1);
|
||||
allprint(yych);
|
||||
putchar('\n');
|
||||
}
|
||||
# endif
|
||||
;
|
||||
}
|
||||
# ifdef LEXDEBUG
|
||||
if(debug){
|
||||
fprintf(yyout,"stopped at %d with ",*(lsp-1)-yysvec-1);
|
||||
allprint(yych);
|
||||
putchar('\n');
|
||||
}
|
||||
# endif
|
||||
while (lsp-- > yylstate){
|
||||
*yylastch-- = 0;
|
||||
if (*lsp != 0 && (yyfnd= (*lsp)->yystops) && *yyfnd > 0){
|
||||
yyolsp = lsp;
|
||||
if(yyextra[*yyfnd]){ /* must backup */
|
||||
while(yyback((*lsp)->yystops,-*yyfnd) != 1 && lsp > yylstate){
|
||||
lsp--;
|
||||
unput(*yylastch--);
|
||||
}
|
||||
}
|
||||
yyprevious = YYU(*yylastch);
|
||||
yylsp = lsp;
|
||||
yyleng = yylastch-yytext+1;
|
||||
yytext[yyleng] = 0;
|
||||
# ifdef LEXDEBUG
|
||||
if(debug){
|
||||
fprintf(yyout,"\nmatch ");
|
||||
sprint(yytext);
|
||||
fprintf(yyout," action %d\n",*yyfnd);
|
||||
}
|
||||
# endif
|
||||
return(*yyfnd++);
|
||||
}
|
||||
unput(*yylastch);
|
||||
}
|
||||
if (yytext[0] == 0 /* && feof(yyin) */)
|
||||
{
|
||||
yysptr=yysbuf;
|
||||
return(0);
|
||||
}
|
||||
yyprevious = yytext[0] = input();
|
||||
if (yyprevious>0)
|
||||
output(yyprevious);
|
||||
yylastch=yytext;
|
||||
# ifdef LEXDEBUG
|
||||
if(debug)putchar('\n');
|
||||
# endif
|
||||
}
|
||||
}
|
||||
yyback(p, m)
|
||||
int *p;
|
||||
{
|
||||
if (p==0) return(0);
|
||||
while (*p)
|
||||
{
|
||||
if (*p++ == m)
|
||||
return(1);
|
||||
}
|
||||
return(0);
|
||||
}
|
||||
/* the following are only used in the lex library */
|
||||
yyinput(){
|
||||
return(input());
|
||||
}
|
||||
yyoutput(c)
|
||||
int c; {
|
||||
output(c);
|
||||
}
|
||||
yyunput(c)
|
||||
int c; {
|
||||
unput(c);
|
||||
}
|
||||
86
lfunc.c
86
lfunc.c
@@ -1,86 +0,0 @@
|
||||
/*
|
||||
** $Id: lfunc.c,v 1.44 2001/06/05 18:17:01 roberto Exp roberto $
|
||||
** Auxiliary functions to manipulate prototypes and closures
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
#include <stdlib.h>
|
||||
|
||||
#define LUA_PRIVATE
|
||||
#include "lua.h"
|
||||
|
||||
#include "lfunc.h"
|
||||
#include "lmem.h"
|
||||
#include "lstate.h"
|
||||
|
||||
|
||||
#define sizeclosure(n) ((int)sizeof(Closure) + (int)sizeof(TObject)*((n)-1))
|
||||
|
||||
|
||||
Closure *luaF_newclosure (lua_State *L, int nelems) {
|
||||
Closure *c = (Closure *)luaM_malloc(L, sizeclosure(nelems));
|
||||
c->next = G(L)->rootcl;
|
||||
G(L)->rootcl = c;
|
||||
c->mark = c;
|
||||
c->nupvalues = nelems;
|
||||
return c;
|
||||
}
|
||||
|
||||
|
||||
Proto *luaF_newproto (lua_State *L) {
|
||||
Proto *f = luaM_new(L, Proto);
|
||||
f->k = NULL;
|
||||
f->sizek = 0;
|
||||
f->p = NULL;
|
||||
f->sizep = 0;
|
||||
f->code = NULL;
|
||||
f->sizecode = 0;
|
||||
f->nupvalues = 0;
|
||||
f->numparams = 0;
|
||||
f->is_vararg = 0;
|
||||
f->maxstacksize = 0;
|
||||
f->marked = 0;
|
||||
f->lineinfo = NULL;
|
||||
f->sizelocvars = 0;
|
||||
f->sizelineinfo = 0;
|
||||
f->locvars = NULL;
|
||||
f->lineDefined = 0;
|
||||
f->source = NULL;
|
||||
f->next = G(L)->rootproto; /* chain in list of protos */
|
||||
G(L)->rootproto = f;
|
||||
return f;
|
||||
}
|
||||
|
||||
|
||||
void luaF_freeproto (lua_State *L, Proto *f) {
|
||||
luaM_freearray(L, f->code, f->sizecode, Instruction);
|
||||
luaM_freearray(L, f->locvars, f->sizelocvars, struct LocVar);
|
||||
luaM_freearray(L, f->k, f->sizek, TObject);
|
||||
luaM_freearray(L, f->p, f->sizep, Proto *);
|
||||
luaM_freearray(L, f->lineinfo, f->sizelineinfo, int);
|
||||
luaM_freelem(L, f, Proto);
|
||||
}
|
||||
|
||||
|
||||
void luaF_freeclosure (lua_State *L, Closure *c) {
|
||||
luaM_free(L, c, sizeclosure(c->nupvalues));
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Look for n-th local variable at line `line' in function `func'.
|
||||
** Returns NULL if not found.
|
||||
*/
|
||||
const l_char *luaF_getlocalname (const Proto *f, int local_number, int pc) {
|
||||
int i;
|
||||
for (i = 0; i<f->sizelocvars && f->locvars[i].startpc <= pc; i++) {
|
||||
if (pc < f->locvars[i].endpc) { /* is variable active? */
|
||||
local_number--;
|
||||
if (local_number == 0)
|
||||
return getstr(f->locvars[i].varname);
|
||||
}
|
||||
}
|
||||
return NULL; /* not found */
|
||||
}
|
||||
|
||||
23
lfunc.h
23
lfunc.h
@@ -1,23 +0,0 @@
|
||||
/*
|
||||
** $Id: lfunc.h,v 1.14 2000/12/28 12:55:41 roberto Exp roberto $
|
||||
** Auxiliary functions to manipulate prototypes and closures
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
#ifndef lfunc_h
|
||||
#define lfunc_h
|
||||
|
||||
|
||||
#include "lobject.h"
|
||||
|
||||
|
||||
|
||||
Proto *luaF_newproto (lua_State *L);
|
||||
Closure *luaF_newclosure (lua_State *L, int nelems);
|
||||
void luaF_freeproto (lua_State *L, Proto *f);
|
||||
void luaF_freeclosure (lua_State *L, Closure *c);
|
||||
|
||||
const l_char *luaF_getlocalname (const Proto *func, int local_number, int pc);
|
||||
|
||||
|
||||
#endif
|
||||
386
lgc.c
386
lgc.c
@@ -1,386 +0,0 @@
|
||||
/*
|
||||
** $Id: lgc.c,v 1.108 2001/06/26 13:20:45 roberto Exp roberto $
|
||||
** Garbage Collector
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
#define LUA_PRIVATE
|
||||
#include "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"
|
||||
|
||||
|
||||
|
||||
typedef struct GCState {
|
||||
Hash *tmark; /* list of marked tables to be visited */
|
||||
Closure *cmark; /* list of marked closures to be visited */
|
||||
} GCState;
|
||||
|
||||
|
||||
|
||||
/* mark a string; marks larger than 1 cannot be changed */
|
||||
#define strmark(s) {if ((s)->tsv.marked == 0) (s)->tsv.marked = 1;}
|
||||
|
||||
|
||||
|
||||
static void protomark (Proto *f) {
|
||||
if (!f->marked) {
|
||||
int i;
|
||||
f->marked = 1;
|
||||
strmark(f->source);
|
||||
for (i=0; i<f->sizek; i++) {
|
||||
if (ttype(f->k+i) == LUA_TSTRING)
|
||||
strmark(tsvalue(f->k+i));
|
||||
}
|
||||
for (i=0; i<f->sizep; i++)
|
||||
protomark(f->p[i]);
|
||||
for (i=0; i<f->sizelocvars; i++) /* mark local-variable names */
|
||||
strmark(f->locvars[i].varname);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void markclosure (GCState *st, Closure *cl) {
|
||||
if (!ismarked(cl)) {
|
||||
if (!cl->isC) {
|
||||
lua_assert(cl->nupvalues == cl->f.l->nupvalues);
|
||||
protomark(cl->f.l);
|
||||
}
|
||||
cl->mark = st->cmark; /* chain it for later traversal */
|
||||
st->cmark = cl;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void marktable (GCState *st, Hash *h) {
|
||||
if (!ismarked(h)) {
|
||||
h->mark = st->tmark; /* chain it for later traversal */
|
||||
st->tmark = h;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void markobject (GCState *st, TObject *o) {
|
||||
switch (ttype(o)) {
|
||||
case LUA_TSTRING:
|
||||
strmark(tsvalue(o));
|
||||
break;
|
||||
case LUA_TUSERDATA:
|
||||
if (!ismarkedudata(uvalue(o)))
|
||||
switchudatamark(uvalue(o));
|
||||
break;
|
||||
case LUA_TFUNCTION:
|
||||
markclosure(st, clvalue(o));
|
||||
break;
|
||||
case LUA_TTABLE: {
|
||||
marktable(st, hvalue(o));
|
||||
break;
|
||||
}
|
||||
default: break; /* numbers, etc */
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void markstacks (lua_State *L, GCState *st) {
|
||||
lua_State *L1 = L;
|
||||
do { /* for each thread */
|
||||
StkId o, lim;
|
||||
marktable(st, L1->gt); /* mark table of globals */
|
||||
for (o=L1->stack; o<L1->top; o++)
|
||||
markobject(st, o);
|
||||
lim = (L1->stack_last - L1->ci->base > MAXSTACK) ? L1->ci->base+MAXSTACK
|
||||
: L1->stack_last;
|
||||
for (; o<=lim; o++) setnilvalue(o);
|
||||
lua_assert(L1->previous->next == L1 && L1->next->previous == L1);
|
||||
L1 = L1->next;
|
||||
} while (L1 != L);
|
||||
}
|
||||
|
||||
|
||||
static void marktagmethods (global_State *G, GCState *st) {
|
||||
int t;
|
||||
for (t=0; t<G->ntag; t++) {
|
||||
struct TM *tm = &G->TMtable[t];
|
||||
int e;
|
||||
if (tm->name) strmark(tm->name);
|
||||
for (e=0; e<TM_N; e++) {
|
||||
Closure *cl = tm->method[e];
|
||||
if (cl) markclosure(st, cl);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void traverseclosure (GCState *st, Closure *f) {
|
||||
int i;
|
||||
for (i=0; i<f->nupvalues; i++) /* mark its upvalues */
|
||||
markobject(st, &f->upvalue[i]);
|
||||
}
|
||||
|
||||
|
||||
static void removekey (Node *n) {
|
||||
lua_assert(ttype(val(n)) == LUA_TNIL);
|
||||
if (ttype(key(n)) != LUA_TNIL && ttype(key(n)) != LUA_TNUMBER)
|
||||
setttype(key(n), LUA_TNONE); /* dead key; remove it */
|
||||
}
|
||||
|
||||
|
||||
static void traversetable (GCState *st, Hash *h) {
|
||||
int i;
|
||||
int mode = h->weakmode;
|
||||
if (mode == (LUA_WEAK_KEY | LUA_WEAK_VALUE))
|
||||
return; /* avoid traversing if both keys and values are weak */
|
||||
for (i=0; i<h->size; i++) {
|
||||
Node *n = node(h, i);
|
||||
if (ttype(val(n)) == LUA_TNIL)
|
||||
removekey(n);
|
||||
else {
|
||||
lua_assert(ttype(key(n)) != LUA_TNIL);
|
||||
if (ttype(key(n)) != LUA_TNUMBER && !(mode & LUA_WEAK_KEY))
|
||||
markobject(st, key(n));
|
||||
if (!(mode & LUA_WEAK_VALUE))
|
||||
markobject(st, val(n));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void markall (lua_State *L) {
|
||||
GCState st;
|
||||
st.cmark = NULL;
|
||||
st.tmark = NULL;
|
||||
marktagmethods(G(L), &st); /* mark tag methods */
|
||||
markstacks(L, &st); /* mark all stacks */
|
||||
marktable(&st, G(L)->type2tag);
|
||||
marktable(&st, G(L)->registry);
|
||||
marktable(&st, G(L)->weakregistry);
|
||||
for (;;) { /* mark tables and closures */
|
||||
if (st.cmark) {
|
||||
Closure *f = st.cmark; /* get first closure from list */
|
||||
st.cmark = f->mark; /* remove it from list */
|
||||
traverseclosure(&st, f);
|
||||
}
|
||||
else if (st.tmark) {
|
||||
Hash *h = st.tmark; /* get first table from list */
|
||||
st.tmark = h->mark; /* remove it from list */
|
||||
traversetable(&st, h);
|
||||
}
|
||||
else break; /* nothing else to mark */
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static int hasmark (const TObject *o) {
|
||||
switch (ttype(o)) {
|
||||
case LUA_TSTRING:
|
||||
return tsvalue(o)->tsv.marked;
|
||||
case LUA_TUSERDATA:
|
||||
return ismarkedudata(uvalue(o));
|
||||
case LUA_TTABLE:
|
||||
return ismarked(hvalue(o));
|
||||
case LUA_TFUNCTION:
|
||||
return ismarked(clvalue(o));
|
||||
default: /* number, nil */
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void cleardeadnodes (Hash *h) {
|
||||
int i;
|
||||
for (i=0; i<h->size; i++) {
|
||||
Node *n = node(h, i);
|
||||
if (ttype(val(n)) == LUA_TNIL) continue; /* empty node */
|
||||
if (!hasmark(val(n)) || !hasmark(key(n))) {
|
||||
setnilvalue(val(n)); /* remove value */
|
||||
removekey(n);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void cleartables (global_State *G) {
|
||||
Hash *h;
|
||||
for (h = G->roottable; h; h = h->next) {
|
||||
if (h->weakmode && ismarked(h))
|
||||
cleardeadnodes(h);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void collectproto (lua_State *L) {
|
||||
Proto **p = &G(L)->rootproto;
|
||||
Proto *curr;
|
||||
while ((curr = *p) != NULL) {
|
||||
if (curr->marked) {
|
||||
curr->marked = 0;
|
||||
p = &curr->next;
|
||||
}
|
||||
else {
|
||||
*p = curr->next;
|
||||
luaF_freeproto(L, curr);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void collectclosure (lua_State *L) {
|
||||
Closure **p = &G(L)->rootcl;
|
||||
Closure *curr;
|
||||
while ((curr = *p) != NULL) {
|
||||
if (ismarked(curr)) {
|
||||
curr->mark = curr; /* unmark */
|
||||
p = &curr->next;
|
||||
}
|
||||
else {
|
||||
*p = curr->next;
|
||||
luaF_freeclosure(L, curr);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void collecttable (lua_State *L) {
|
||||
Hash **p = &G(L)->roottable;
|
||||
Hash *curr;
|
||||
while ((curr = *p) != NULL) {
|
||||
if (ismarked(curr)) {
|
||||
curr->mark = curr; /* unmark */
|
||||
p = &curr->next;
|
||||
}
|
||||
else {
|
||||
*p = curr->next;
|
||||
luaH_free(L, curr);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void collectudata (lua_State *L, int keep) {
|
||||
Udata **p = &G(L)->rootudata;
|
||||
Udata *curr;
|
||||
while ((curr = *p) != NULL) {
|
||||
if (ismarkedudata(curr)) {
|
||||
switchudatamark(curr); /* unmark */
|
||||
p = &curr->uv.next;
|
||||
}
|
||||
else { /* collect */
|
||||
int tag = curr->uv.tag;
|
||||
*p = curr->uv.next;
|
||||
if (keep || /* must keep all of them (to close state)? */
|
||||
luaT_gettm(G(L), tag, TM_GC)) { /* or is there a GC tag method? */
|
||||
curr->uv.next = G(L)->TMtable[tag].collected; /* chain udata ... */
|
||||
G(L)->TMtable[tag].collected = curr; /* ... to call its TM later */
|
||||
}
|
||||
else /* no tag method; delete udata */
|
||||
luaM_free(L, curr, sizeudata(curr->uv.len));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void collectstrings (lua_State *L, int all) {
|
||||
int i;
|
||||
for (i=0; i<G(L)->strt.size; i++) { /* for each list */
|
||||
TString **p = &G(L)->strt.hash[i];
|
||||
TString *curr;
|
||||
while ((curr = *p) != NULL) {
|
||||
if (curr->tsv.marked && !all) { /* preserve? */
|
||||
if (curr->tsv.marked < FIXMARK) /* does not change FIXMARKs */
|
||||
curr->tsv.marked = 0;
|
||||
p = &curr->tsv.nexthash;
|
||||
}
|
||||
else { /* collect */
|
||||
*p = curr->tsv.nexthash;
|
||||
G(L)->strt.nuse--;
|
||||
luaM_free(L, curr, sizestring(curr->tsv.len));
|
||||
}
|
||||
}
|
||||
}
|
||||
if (G(L)->strt.nuse < (ls_nstr)(G(L)->strt.size/4) &&
|
||||
G(L)->strt.size > MINPOWER2)
|
||||
luaS_resize(L, G(L)->strt.size/2); /* table is too big */
|
||||
}
|
||||
|
||||
|
||||
|
||||
#define MINBUFFER 256
|
||||
static void checkMbuffer (lua_State *L) {
|
||||
if (G(L)->Mbuffsize > MINBUFFER*2) { /* is buffer too big? */
|
||||
size_t newsize = G(L)->Mbuffsize/2; /* still larger than MINBUFFER */
|
||||
luaM_reallocvector(L, G(L)->Mbuffer, G(L)->Mbuffsize, newsize, l_char);
|
||||
G(L)->Mbuffsize = newsize;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void callgcTM (lua_State *L, const TObject *obj) {
|
||||
Closure *tm = luaT_gettmbyObj(G(L), obj, TM_GC);
|
||||
if (tm != NULL) {
|
||||
int oldah = L->allowhooks;
|
||||
StkId top = L->top;
|
||||
L->allowhooks = 0; /* stop debug hooks during GC tag methods */
|
||||
setclvalue(top, tm);
|
||||
setobj(top+1, obj);
|
||||
L->top += 2;
|
||||
luaD_call(L, top);
|
||||
L->top = top; /* restore top */
|
||||
L->allowhooks = oldah; /* restore hooks */
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void callgcTMudata (lua_State *L) {
|
||||
int tag;
|
||||
luaD_checkstack(L, 3);
|
||||
for (tag=G(L)->ntag-1; tag>=0; tag--) { /* for each tag (in reverse order) */
|
||||
Udata *udata;
|
||||
while ((udata = G(L)->TMtable[tag].collected) != NULL) {
|
||||
G(L)->TMtable[tag].collected = udata->uv.next; /* remove it from list */
|
||||
udata->uv.next = G(L)->rootudata; /* resurect it */
|
||||
G(L)->rootudata = udata;
|
||||
setuvalue(L->top, udata);
|
||||
L->top++; /* keep it in stack to avoid being (recursively) collected */
|
||||
callgcTM(L, L->top-1);
|
||||
uvalue(L->top-1)->uv.tag = 0; /* default tag (udata is `finalized') */
|
||||
L->top--;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
void luaC_callallgcTM (lua_State *L) {
|
||||
if (G(L)->rootudata) { /* avoid problems with incomplete states */
|
||||
collectudata(L, 1); /* collect all udata into tag lists */
|
||||
callgcTMudata(L); /* call their GC tag methods */
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
void luaC_collect (lua_State *L, int all) {
|
||||
collectudata(L, 0);
|
||||
collectstrings(L, all);
|
||||
collecttable(L);
|
||||
collectproto(L);
|
||||
collectclosure(L);
|
||||
}
|
||||
|
||||
|
||||
void luaC_collectgarbage (lua_State *L) {
|
||||
markall(L);
|
||||
cleartables(G(L));
|
||||
luaC_collect(L, 0);
|
||||
checkMbuffer(L);
|
||||
G(L)->GCthreshold = 2*G(L)->nblocks; /* new threshold */
|
||||
callgcTMudata(L);
|
||||
callgcTM(L, &luaO_nilobject);
|
||||
}
|
||||
|
||||
23
lgc.h
23
lgc.h
@@ -1,23 +0,0 @@
|
||||
/*
|
||||
** $Id: lgc.h,v 1.11 2001/06/12 18:43:13 roberto Exp roberto $
|
||||
** Garbage Collector
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
#ifndef lgc_h
|
||||
#define lgc_h
|
||||
|
||||
|
||||
#include "lobject.h"
|
||||
|
||||
|
||||
#define luaC_checkGC(L) if (G(L)->nblocks >= G(L)->GCthreshold) \
|
||||
luaC_collectgarbage(L)
|
||||
|
||||
|
||||
void luaC_callallgcTM (lua_State *L);
|
||||
void luaC_collect (lua_State *L, int all);
|
||||
void luaC_collectgarbage (lua_State *L);
|
||||
|
||||
|
||||
#endif
|
||||
8
linit.c
8
linit.c
@@ -1,8 +0,0 @@
|
||||
/*
|
||||
** $Id: linit.c,v 1.5 2000/06/16 17:22:43 roberto Exp roberto $
|
||||
** Initialization of libraries for lua.c
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
>>>>>>> This module is now obsolete, and is not part of Lua. <<<<<<<<<
|
||||
|
||||
695
liolib.c
695
liolib.c
@@ -1,695 +0,0 @@
|
||||
/*
|
||||
** $Id: liolib.c,v 1.120 2001/07/16 18:48:31 roberto Exp roberto $
|
||||
** Standard I/O (and system) library
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <time.h>
|
||||
|
||||
#define LUA_PRIVATE
|
||||
#include "lua.h"
|
||||
|
||||
#include "lauxlib.h"
|
||||
#include "luadebug.h"
|
||||
#include "lualib.h"
|
||||
|
||||
|
||||
#ifndef OLD_ANSI
|
||||
#include <errno.h>
|
||||
#include <locale.h>
|
||||
#endif
|
||||
|
||||
|
||||
|
||||
#ifdef POPEN
|
||||
/* FILE *popen();
|
||||
int pclose(); */
|
||||
#define CLOSEFILE(L, f) ((pclose(f) == -1) ? fclose(f) : 0)
|
||||
#else
|
||||
/* no support for popen */
|
||||
#define popen(x,y) NULL /* that is, popen always fails */
|
||||
#define CLOSEFILE(L, f) (fclose(f))
|
||||
#endif
|
||||
|
||||
|
||||
#define INFILE 0
|
||||
#define OUTFILE 1
|
||||
#define NOFILE 2
|
||||
|
||||
#define FILEHANDLE l_s("FileHandle")
|
||||
#define CLOSEDFILEHANDLE l_s("ClosedFileHandle")
|
||||
|
||||
|
||||
static const l_char *const filenames[] = {l_s("_INPUT"), l_s("_OUTPUT")};
|
||||
static const l_char *const basicfiles[] = {l_s("_STDIN"), l_s("_STDOUT")};
|
||||
|
||||
|
||||
static int pushresult (lua_State *L, int i) {
|
||||
if (i) {
|
||||
lua_pushnumber(L, 1);
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
lua_pushnil(L);
|
||||
lua_pushstring(L, strerror(errno));
|
||||
lua_pushnumber(L, errno);
|
||||
return 3;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** {======================================================
|
||||
** FILE Operations
|
||||
** =======================================================
|
||||
*/
|
||||
|
||||
|
||||
#define checkfile(L,f) (strcmp(lua_type(L,(f)), FILEHANDLE) == 0)
|
||||
|
||||
|
||||
static FILE *getopthandle (lua_State *L, int inout) {
|
||||
FILE *p = (FILE *)lua_touserdata(L, 1);
|
||||
if (p != NULL) { /* is it a userdata ? */
|
||||
if (!checkfile(L, 1)) { /* not a valid file handle? */
|
||||
if (strcmp(lua_type(L, 1), CLOSEDFILEHANDLE) == 0)
|
||||
luaL_argerror(L, 1, l_s("file is closed"));
|
||||
else
|
||||
luaL_argerror(L, 1, l_s("(invalid value)"));
|
||||
}
|
||||
lua_pushvalue(L, 1); lua_remove(L, 1); /* move it to stack top */
|
||||
}
|
||||
else { /* try global value */
|
||||
lua_getglobal(L, filenames[inout]);
|
||||
if (!checkfile(L,-1))
|
||||
luaL_verror(L, l_s("global variable `%.10s' is not a valid file handle"),
|
||||
filenames[inout]);
|
||||
p = (FILE *)lua_touserdata(L, -1);
|
||||
}
|
||||
return p; /* leave handle at stack top to avoid GC */
|
||||
}
|
||||
|
||||
|
||||
static void newfile (lua_State *L, FILE *f) {
|
||||
lua_newuserdatabox(L, f);
|
||||
lua_settag(L, lua_name2tag(L, FILEHANDLE));
|
||||
}
|
||||
|
||||
|
||||
static void newfilewithname (lua_State *L, FILE *f, const l_char *name) {
|
||||
newfile(L, f);
|
||||
lua_setglobal(L, name);
|
||||
}
|
||||
|
||||
|
||||
static int setnewfile (lua_State *L, FILE *f, int inout) {
|
||||
if (f == NULL)
|
||||
return pushresult(L, 0);
|
||||
else {
|
||||
newfile(L, f);
|
||||
if (inout != NOFILE) {
|
||||
lua_pushvalue(L, -1);
|
||||
lua_setglobal(L, filenames[inout]);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void resetfile (lua_State *L, int inout) {
|
||||
lua_getglobal(L, basicfiles[inout]);
|
||||
lua_setglobal(L, filenames[inout]);
|
||||
}
|
||||
|
||||
|
||||
static int io_close (lua_State *L) {
|
||||
FILE *f = (FILE *)luaL_check_userdata(L, 1, FILEHANDLE);
|
||||
int status = 1;
|
||||
if (f != stdin && f != stdout && f != stderr) {
|
||||
lua_settop(L, 1); /* make sure file is on top */
|
||||
lua_settag(L, lua_name2tag(L, CLOSEDFILEHANDLE));
|
||||
status = (CLOSEFILE(L, f) == 0);
|
||||
}
|
||||
return pushresult(L, status);
|
||||
}
|
||||
|
||||
|
||||
static int file_collect (lua_State *L) {
|
||||
FILE *f = (FILE *)luaL_check_userdata(L, 1, FILEHANDLE);
|
||||
if (f != stdin && f != stdout && f != stderr)
|
||||
CLOSEFILE(L, f);
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
static int io_open (lua_State *L) {
|
||||
FILE *f = fopen(luaL_check_string(L, 1), luaL_check_string(L, 2));
|
||||
return setnewfile(L, f, NOFILE);
|
||||
}
|
||||
|
||||
|
||||
static int io_tmpfile (lua_State *L) {
|
||||
return setnewfile(L, tmpfile(), NOFILE);
|
||||
}
|
||||
|
||||
|
||||
|
||||
static int io_fromto (lua_State *L, int inout, const l_char *mode) {
|
||||
FILE *current;
|
||||
if (lua_isnull(L, 1)) {
|
||||
getopthandle(L, inout);
|
||||
resetfile(L, inout);
|
||||
return io_close(L);
|
||||
}
|
||||
else {
|
||||
const l_char *s = luaL_check_string(L, 1);
|
||||
current = (*s == l_c('|')) ? popen(s+1, mode) : fopen(s, mode);
|
||||
return setnewfile(L, current, inout);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static int io_readfrom (lua_State *L) {
|
||||
return io_fromto(L, INFILE, l_s("r"));
|
||||
}
|
||||
|
||||
|
||||
static int io_writeto (lua_State *L) {
|
||||
return io_fromto(L, OUTFILE, l_s("w"));
|
||||
}
|
||||
|
||||
|
||||
static int io_appendto (lua_State *L) {
|
||||
FILE *current = fopen(luaL_check_string(L, 1), l_s("a"));
|
||||
return setnewfile(L, current, OUTFILE);
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** {======================================================
|
||||
** READ
|
||||
** =======================================================
|
||||
*/
|
||||
|
||||
|
||||
#ifndef LUA_MAXUNTIL
|
||||
#define LUA_MAXUNTIL 100
|
||||
#endif
|
||||
|
||||
|
||||
/*
|
||||
** Knuth-Morris-Pratt algorithm for string searching
|
||||
** (based on `Algorithms in MODULA-3', Robert Sedgewick;
|
||||
** Addison-Wesley, 1993.)
|
||||
*/
|
||||
|
||||
static void prep_read_until (int next[], const l_char *p, int pl) {
|
||||
int i = 0;
|
||||
int j = -1;
|
||||
next[0] = -1;
|
||||
while (i < pl) {
|
||||
if (j == -1 || p[i] == p[j]) {
|
||||
i++; j++; next[i] = j;
|
||||
}
|
||||
else j = next[j];
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static int read_until (lua_State *L, FILE *f, const l_char *p, int pl) {
|
||||
l_charint c;
|
||||
int j;
|
||||
int next[LUA_MAXUNTIL+1];
|
||||
luaL_Buffer b;
|
||||
luaL_buffinit(L, &b);
|
||||
prep_read_until(next, p, pl);
|
||||
j = 0;
|
||||
while ((c = getc(f)) != EOF) {
|
||||
NoRead:
|
||||
if (c == p[j]) {
|
||||
j++; /* go to next char in pattern */
|
||||
if (j == pl) { /* complete match? */
|
||||
luaL_pushresult(&b); /* close buffer */
|
||||
return 1; /* always success */
|
||||
}
|
||||
}
|
||||
else if (j == 0)
|
||||
luaL_putchar(&b, c);
|
||||
else { /* match fail */
|
||||
luaL_addlstring(&b, p, j - next[j]); /* put failed part on result */
|
||||
j = next[j]; /* backtrack pattern index */
|
||||
goto NoRead; /* repeat without reading next char */
|
||||
}
|
||||
}
|
||||
/* end of file without a match */
|
||||
luaL_addlstring(&b, p, j); /* put failed part on result */
|
||||
luaL_pushresult(&b); /* close buffer */
|
||||
return (lua_strlen(L, -1) > 0);
|
||||
}
|
||||
|
||||
|
||||
static int read_number (lua_State *L, FILE *f) {
|
||||
double d;
|
||||
if (fscanf(f, l_s(LUA_NUMBER_SCAN), &d) == 1) {
|
||||
lua_pushnumber(L, d);
|
||||
return 1;
|
||||
}
|
||||
else return 0; /* read fails */
|
||||
}
|
||||
|
||||
|
||||
static int test_eof (lua_State *L, FILE *f) {
|
||||
l_charint c = getc(f);
|
||||
ungetc(c, f);
|
||||
lua_pushlstring(L, NULL, 0);
|
||||
return (c != EOF);
|
||||
}
|
||||
|
||||
|
||||
static int read_chars (lua_State *L, FILE *f, size_t n) {
|
||||
size_t rlen; /* how much to read */
|
||||
size_t nr; /* number of chars actually read */
|
||||
luaL_Buffer b;
|
||||
luaL_buffinit(L, &b);
|
||||
rlen = LUAL_BUFFERSIZE; /* try to read that much each time */
|
||||
do {
|
||||
l_char *p = luaL_prepbuffer(&b);
|
||||
if (rlen > n) rlen = n; /* cannot read more than asked */
|
||||
nr = fread(p, sizeof(l_char), rlen, f);
|
||||
luaL_addsize(&b, nr);
|
||||
n -= nr; /* still have to read `n' chars */
|
||||
} while (n > 0 && nr == rlen); /* until end of count or eof */
|
||||
luaL_pushresult(&b); /* close buffer */
|
||||
return (n == 0 || lua_strlen(L, -1) > 0);
|
||||
}
|
||||
|
||||
|
||||
static int io_read (lua_State *L) {
|
||||
FILE *f = getopthandle(L, INFILE);
|
||||
int nargs = lua_gettop(L) - 1;
|
||||
int success;
|
||||
int n;
|
||||
if (nargs == 0) { /* no arguments? */
|
||||
success = read_until(L, f, l_s("\n"), 1); /* read until \n (a line) */
|
||||
n = 2; /* will return n-1 results */
|
||||
}
|
||||
else { /* ensure stack space for all results and for auxlib's buffer */
|
||||
luaL_checkstack(L, nargs+LUA_MINSTACK, l_s("too many arguments"));
|
||||
success = 1;
|
||||
for (n = 1; n<=nargs && success; n++) {
|
||||
if (lua_rawtag(L, n) == LUA_TNUMBER) {
|
||||
size_t l = (size_t)lua_tonumber(L, n);
|
||||
success = (l == 0) ? test_eof(L, f) : read_chars(L, f, l);
|
||||
}
|
||||
else {
|
||||
const l_char *p = lua_tostring(L, n);
|
||||
if (!p || p[0] != l_c('*'))
|
||||
lua_error(L, l_s("invalid `read' option"));
|
||||
switch (p[1]) {
|
||||
case l_c('n'): /* number */
|
||||
success = read_number(L, f);
|
||||
break;
|
||||
case l_c('l'): /* line */
|
||||
success = read_until(L, f, l_s("\n"), 1); /* read until \n */
|
||||
break;
|
||||
case l_c('a'): /* file */
|
||||
read_chars(L, f, ~((size_t)0)); /* read MAX_SIZE_T chars */
|
||||
success = 1; /* always success */
|
||||
break;
|
||||
case l_c('w'): /* word */
|
||||
lua_error(L, l_s("option `*w' is deprecated"));
|
||||
break;
|
||||
case l_c('u'): { /* read until */
|
||||
size_t pl = lua_strlen(L, n) - 2;
|
||||
luaL_arg_check(L, 0 < pl && pl <= LUA_MAXUNTIL, n,
|
||||
l_s("invalid read-until length"));
|
||||
success = read_until(L, f, p+2, (int)pl);
|
||||
break;
|
||||
}
|
||||
default:
|
||||
luaL_argerror(L, n, l_s("invalid format"));
|
||||
success = 0; /* to avoid warnings */
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
if (!success) {
|
||||
lua_pop(L, 1); /* remove last result */
|
||||
lua_pushnil(L); /* push nil instead */
|
||||
}
|
||||
return n - 1;
|
||||
}
|
||||
|
||||
/* }====================================================== */
|
||||
|
||||
|
||||
static int io_write (lua_State *L) {
|
||||
FILE *f = getopthandle(L, OUTFILE);
|
||||
int nargs = lua_gettop(L)-1;
|
||||
int arg;
|
||||
int status = 1;
|
||||
for (arg=1; arg<=nargs; arg++) {
|
||||
if (lua_rawtag(L, arg) == LUA_TNUMBER) {
|
||||
/* optimization: could be done exactly as for strings */
|
||||
status = status &&
|
||||
fprintf(f, l_s(LUA_NUMBER_FMT), lua_tonumber(L, arg)) > 0;
|
||||
}
|
||||
else {
|
||||
size_t l;
|
||||
const l_char *s = luaL_check_lstr(L, arg, &l);
|
||||
status = status && (fwrite(s, sizeof(l_char), l, f) == l);
|
||||
}
|
||||
}
|
||||
pushresult(L, status);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int io_seek (lua_State *L) {
|
||||
static const int mode[] = {SEEK_SET, SEEK_CUR, SEEK_END};
|
||||
static const l_char *const modenames[] = {l_s("set"), l_s("cur"), l_s("end"), NULL};
|
||||
FILE *f = (FILE *)luaL_check_userdata(L, 1, FILEHANDLE);
|
||||
int op = luaL_findstring(luaL_opt_string(L, 2, l_s("cur")), modenames);
|
||||
long offset = luaL_opt_long(L, 3, 0);
|
||||
luaL_arg_check(L, op != -1, 2, l_s("invalid mode"));
|
||||
op = fseek(f, offset, mode[op]);
|
||||
if (op)
|
||||
return pushresult(L, 0); /* error */
|
||||
else {
|
||||
lua_pushnumber(L, ftell(f));
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static int io_flush (lua_State *L) {
|
||||
FILE *f = (lua_isnull(L, 1)) ? (FILE *)NULL :
|
||||
(FILE *)luaL_check_userdata(L, 1, FILEHANDLE);
|
||||
return pushresult(L, fflush(f) == 0);
|
||||
}
|
||||
|
||||
/* }====================================================== */
|
||||
|
||||
|
||||
/*
|
||||
** {======================================================
|
||||
** Other O.S. Operations
|
||||
** =======================================================
|
||||
*/
|
||||
|
||||
static int io_execute (lua_State *L) {
|
||||
lua_pushnumber(L, system(luaL_check_string(L, 1)));
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int io_remove (lua_State *L) {
|
||||
return pushresult(L, remove(luaL_check_string(L, 1)) == 0);
|
||||
}
|
||||
|
||||
|
||||
static int io_rename (lua_State *L) {
|
||||
return pushresult(L, rename(luaL_check_string(L, 1),
|
||||
luaL_check_string(L, 2)) == 0);
|
||||
}
|
||||
|
||||
|
||||
static int io_tmpname (lua_State *L) {
|
||||
l_char buff[L_tmpnam];
|
||||
if (tmpnam(buff) != buff)
|
||||
lua_error(L, l_s("unable to generate a unique filename"));
|
||||
lua_pushstring(L, buff);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
|
||||
static int io_getenv (lua_State *L) {
|
||||
lua_pushstring(L, getenv(luaL_check_string(L, 1))); /* if NULL push nil */
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int io_clock (lua_State *L) {
|
||||
lua_pushnumber(L, ((lua_Number)clock())/(lua_Number)CLOCKS_PER_SEC);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** {======================================================
|
||||
** Time/Date operations
|
||||
** { year=%Y, month=%m, day=%d, hour=%H, min=%M, sec=%S,
|
||||
** wday=%w+1, yday=%j, isdst=? }
|
||||
** =======================================================
|
||||
*/
|
||||
|
||||
static void setfield (lua_State *L, const l_char *key, int value) {
|
||||
lua_pushstring(L, key);
|
||||
lua_pushnumber(L, value);
|
||||
lua_rawset(L, -3);
|
||||
}
|
||||
|
||||
|
||||
static int getfield (lua_State *L, const l_char *key, int d) {
|
||||
int res;
|
||||
lua_pushstring(L, key);
|
||||
lua_rawget(L, -2);
|
||||
if (lua_isnumber(L, -1))
|
||||
res = (int)lua_tonumber(L, -1);
|
||||
else {
|
||||
if (d == -2)
|
||||
luaL_verror(L, l_s("field `%.20s' missing in date table"), key);
|
||||
res = d;
|
||||
}
|
||||
lua_pop(L, 1);
|
||||
return res;
|
||||
}
|
||||
|
||||
|
||||
static int io_date (lua_State *L) {
|
||||
const l_char *s = luaL_opt_string(L, 1, l_s("%c"));
|
||||
time_t t = (time_t)luaL_opt_number(L, 2, -1);
|
||||
struct tm *stm;
|
||||
if (t == (time_t)-1) /* no time given? */
|
||||
t = time(NULL); /* use current time */
|
||||
if (*s == l_c('!')) { /* UTC? */
|
||||
stm = gmtime(&t);
|
||||
s++; /* skip `!' */
|
||||
}
|
||||
else
|
||||
stm = localtime(&t);
|
||||
if (stm == NULL) /* invalid date? */
|
||||
lua_pushnil(L);
|
||||
else if (strcmp(s, l_s("*t")) == 0) {
|
||||
lua_newtable(L);
|
||||
setfield(L, l_s("sec"), stm->tm_sec);
|
||||
setfield(L, l_s("min"), stm->tm_min);
|
||||
setfield(L, l_s("hour"), stm->tm_hour);
|
||||
setfield(L, l_s("day"), stm->tm_mday);
|
||||
setfield(L, l_s("month"), stm->tm_mon+1);
|
||||
setfield(L, l_s("year"), stm->tm_year+1900);
|
||||
setfield(L, l_s("wday"), stm->tm_wday+1);
|
||||
setfield(L, l_s("yday"), stm->tm_yday+1);
|
||||
setfield(L, l_s("isdst"), stm->tm_isdst);
|
||||
}
|
||||
else {
|
||||
l_char b[256];
|
||||
if (strftime(b, sizeof(b), s, stm))
|
||||
lua_pushstring(L, b);
|
||||
else
|
||||
lua_error(L, l_s("invalid `date' format"));
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int io_time (lua_State *L) {
|
||||
if (lua_isnull(L, 1)) /* called without args? */
|
||||
lua_pushnumber(L, time(NULL)); /* return current time */
|
||||
else {
|
||||
time_t t;
|
||||
struct tm ts;
|
||||
luaL_checktype(L, 1, LUA_TTABLE);
|
||||
lua_settop(L, 1); /* make sure table is at the top */
|
||||
ts.tm_sec = getfield(L, l_s("sec"), 0);
|
||||
ts.tm_min = getfield(L, l_s("min"), 0);
|
||||
ts.tm_hour = getfield(L, l_s("hour"), 12);
|
||||
ts.tm_mday = getfield(L, l_s("day"), -2);
|
||||
ts.tm_mon = getfield(L, l_s("month"), -2)-1;
|
||||
ts.tm_year = getfield(L, l_s("year"), -2)-1900;
|
||||
ts.tm_isdst = getfield(L, l_s("isdst"), -1);
|
||||
t = mktime(&ts);
|
||||
if (t == (time_t)-1)
|
||||
lua_pushnil(L);
|
||||
else
|
||||
lua_pushnumber(L, t);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int io_difftime (lua_State *L) {
|
||||
lua_pushnumber(L, difftime((time_t)luaL_check_number(L, 1),
|
||||
(time_t)luaL_opt_number(L, 2, 0)));
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* }====================================================== */
|
||||
|
||||
|
||||
static int io_setloc (lua_State *L) {
|
||||
static const int cat[] = {LC_ALL, LC_COLLATE, LC_CTYPE, LC_MONETARY,
|
||||
LC_NUMERIC, LC_TIME};
|
||||
static const l_char *const catnames[] = {l_s("all"), l_s("collate"), l_s("ctype"), l_s("monetary"),
|
||||
l_s("numeric"), l_s("time"), NULL};
|
||||
int op = luaL_findstring(luaL_opt_string(L, 2, l_s("all")), catnames);
|
||||
luaL_arg_check(L, op != -1, 2, l_s("invalid option"));
|
||||
lua_pushstring(L, setlocale(cat[op], luaL_check_string(L, 1)));
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int io_exit (lua_State *L) {
|
||||
exit(luaL_opt_int(L, 1, EXIT_SUCCESS));
|
||||
return 0; /* to avoid warnings */
|
||||
}
|
||||
|
||||
/* }====================================================== */
|
||||
|
||||
|
||||
|
||||
static int io_debug (lua_State *L) {
|
||||
for (;;) {
|
||||
l_char buffer[250];
|
||||
fprintf(stderr, l_s("lua_debug> "));
|
||||
if (fgets(buffer, sizeof(buffer), stdin) == 0 ||
|
||||
strcmp(buffer, l_s("cont\n")) == 0)
|
||||
return 0;
|
||||
lua_dostring(L, buffer);
|
||||
lua_settop(L, 0); /* remove eventual returns */
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#define LEVELS1 12 /* size of the first part of the stack */
|
||||
#define LEVELS2 10 /* size of the second part of the stack */
|
||||
|
||||
static int errorfb (lua_State *L) {
|
||||
int level = 1; /* skip level 0 (it's this function) */
|
||||
int firstpart = 1; /* still before eventual `...' */
|
||||
lua_Debug ar;
|
||||
luaL_Buffer b;
|
||||
luaL_buffinit(L, &b);
|
||||
luaL_addstring(&b, l_s("error: "));
|
||||
luaL_addstring(&b, luaL_check_string(L, 1));
|
||||
luaL_addstring(&b, l_s("\n"));
|
||||
while (lua_getstack(L, level++, &ar)) {
|
||||
l_char buff[120]; /* enough to fit following `sprintf's */
|
||||
if (level == 2)
|
||||
luaL_addstring(&b, l_s("stack traceback:\n"));
|
||||
else if (level > LEVELS1 && firstpart) {
|
||||
/* no more than `LEVELS2' more levels? */
|
||||
if (!lua_getstack(L, level+LEVELS2, &ar))
|
||||
level--; /* keep going */
|
||||
else {
|
||||
luaL_addstring(&b, l_s(" ...\n")); /* too many levels */
|
||||
while (lua_getstack(L, level+LEVELS2, &ar)) /* find last levels */
|
||||
level++;
|
||||
}
|
||||
firstpart = 0;
|
||||
continue;
|
||||
}
|
||||
sprintf(buff, l_s("%4d: "), level-1);
|
||||
luaL_addstring(&b, buff);
|
||||
lua_getinfo(L, l_s("Snl"), &ar);
|
||||
switch (*ar.namewhat) {
|
||||
case l_c('g'): case l_c('l'): /* global, local */
|
||||
sprintf(buff, l_s("function `%.50s'"), ar.name);
|
||||
break;
|
||||
case l_c('f'): /* field */
|
||||
sprintf(buff, l_s("method `%.50s'"), ar.name);
|
||||
break;
|
||||
case l_c('t'): /* tag method */
|
||||
sprintf(buff, l_s("`%.50s' tag method"), ar.name);
|
||||
break;
|
||||
default: {
|
||||
if (*ar.what == l_c('m')) /* main? */
|
||||
sprintf(buff, l_s("main of %.70s"), ar.short_src);
|
||||
else if (*ar.what == l_c('C')) /* C function? */
|
||||
sprintf(buff, l_s("%.70s"), ar.short_src);
|
||||
else
|
||||
sprintf(buff, l_s("function <%d:%.70s>"), ar.linedefined, ar.short_src);
|
||||
ar.source = NULL; /* do not print source again */
|
||||
}
|
||||
}
|
||||
luaL_addstring(&b, buff);
|
||||
if (ar.currentline > 0) {
|
||||
sprintf(buff, l_s(" at line %d"), ar.currentline);
|
||||
luaL_addstring(&b, buff);
|
||||
}
|
||||
if (ar.source) {
|
||||
sprintf(buff, l_s(" [%.70s]"), ar.short_src);
|
||||
luaL_addstring(&b, buff);
|
||||
}
|
||||
luaL_addstring(&b, l_s("\n"));
|
||||
}
|
||||
luaL_pushresult(&b);
|
||||
lua_getglobal(L, l_s(LUA_ALERT));
|
||||
if (lua_isfunction(L, -1)) { /* avoid loop if _ALERT is not defined */
|
||||
lua_pushvalue(L, -2); /* error message */
|
||||
lua_rawcall(L, 1, 0);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
|
||||
static const luaL_reg iolib[] = {
|
||||
{l_s("appendto"), io_appendto},
|
||||
{l_s("clock"), io_clock},
|
||||
{l_s("closefile"), io_close},
|
||||
{l_s("date"), io_date},
|
||||
{l_s("debug"), io_debug},
|
||||
{l_s("difftime"), io_difftime},
|
||||
{l_s("execute"), io_execute},
|
||||
{l_s("exit"), io_exit},
|
||||
{l_s("flush"), io_flush},
|
||||
{l_s("getenv"), io_getenv},
|
||||
{l_s("openfile"), io_open},
|
||||
{l_s("read"), io_read},
|
||||
{l_s("readfrom"), io_readfrom},
|
||||
{l_s("remove"), io_remove},
|
||||
{l_s("rename"), io_rename},
|
||||
{l_s("seek"), io_seek},
|
||||
{l_s("setlocale"), io_setloc},
|
||||
{l_s("time"), io_time},
|
||||
{l_s("tmpfile"), io_tmpfile},
|
||||
{l_s("tmpname"), io_tmpname},
|
||||
{l_s("write"), io_write},
|
||||
{l_s("writeto"), io_writeto},
|
||||
{l_s(LUA_ERRORMESSAGE), errorfb}
|
||||
};
|
||||
|
||||
|
||||
LUALIB_API int lua_iolibopen (lua_State *L) {
|
||||
int iotag = lua_newtype(L, FILEHANDLE, LUA_TUSERDATA);
|
||||
lua_newtype(L, CLOSEDFILEHANDLE, LUA_TUSERDATA);
|
||||
luaL_openl(L, iolib);
|
||||
/* predefined file handles */
|
||||
newfilewithname(L, stdin, basicfiles[INFILE]);
|
||||
newfilewithname(L, stdout, basicfiles[OUTFILE]);
|
||||
newfilewithname(L, stderr, l_s("_STDERR"));
|
||||
resetfile(L, INFILE);
|
||||
resetfile(L, OUTFILE);
|
||||
/* close files when collected */
|
||||
lua_pushcfunction(L, file_collect);
|
||||
lua_settagmethod(L, iotag, l_s("gc"));
|
||||
return 0;
|
||||
}
|
||||
|
||||
390
llex.c
390
llex.c
@@ -1,390 +0,0 @@
|
||||
/*
|
||||
** $Id: llex.c,v 1.88 2001/06/20 21:07:57 roberto Exp roberto $
|
||||
** Lexical Analyzer
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
#include <ctype.h>
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
|
||||
#define LUA_PRIVATE
|
||||
#include "lua.h"
|
||||
|
||||
#include "llex.h"
|
||||
#include "lobject.h"
|
||||
#include "lparser.h"
|
||||
#include "lstate.h"
|
||||
#include "lstring.h"
|
||||
#include "lzio.h"
|
||||
|
||||
|
||||
|
||||
#define next(LS) (LS->current = zgetc(LS->z))
|
||||
|
||||
|
||||
|
||||
/* ORDER RESERVED */
|
||||
static const l_char *const token2string [] = {
|
||||
l_s("and"), l_s("break"), l_s("do"), l_s("else"), l_s("elseif"),
|
||||
l_s("end"), l_s("for"), l_s("function"), l_s("global"), l_s("if"),
|
||||
l_s("in"), l_s("local"), l_s("nil"), l_s("not"), l_s("or"), l_s("repeat"),
|
||||
l_s("return"), l_s("then"), l_s("until"), l_s("while"), l_s(""),
|
||||
l_s(".."), l_s("..."), l_s("=="), l_s(">="), l_s("<="), l_s("~="),
|
||||
l_s(""), l_s(""), l_s("<eof>")
|
||||
};
|
||||
|
||||
|
||||
void luaX_init (lua_State *L) {
|
||||
int i;
|
||||
for (i=0; i<NUM_RESERVED; i++) {
|
||||
TString *ts = luaS_new(L, token2string[i]);
|
||||
lua_assert(strlen(token2string[i])+1 <= TOKEN_LEN);
|
||||
ts->tsv.marked = (unsigned short)(RESERVEDMARK+i); /* reserved word */
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#define MAXSRC 80
|
||||
|
||||
|
||||
void luaX_checklimit (LexState *ls, int val, int limit, const l_char *msg) {
|
||||
if (val > limit) {
|
||||
l_char buff[90];
|
||||
sprintf(buff, l_s("too many %.40s (limit=%d)"), msg, limit);
|
||||
luaX_error(ls, buff, ls->t.token);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
void luaX_syntaxerror (LexState *ls, const l_char *s, const l_char *token) {
|
||||
l_char buff[MAXSRC];
|
||||
luaO_chunkid(buff, getstr(ls->source), MAXSRC);
|
||||
luaO_verror(ls->L,
|
||||
l_s("%.99s;\n last token read: `%.30s' at line %d in %.80s"),
|
||||
s, token, ls->linenumber, buff);
|
||||
}
|
||||
|
||||
|
||||
void luaX_error (LexState *ls, const l_char *s, int token) {
|
||||
l_char buff[TOKEN_LEN];
|
||||
luaX_token2str(token, buff);
|
||||
if (buff[0] == l_c('\0'))
|
||||
luaX_syntaxerror(ls, s, (l_char *)G(ls->L)->Mbuffer);
|
||||
else
|
||||
luaX_syntaxerror(ls, s, buff);
|
||||
}
|
||||
|
||||
|
||||
void luaX_token2str (int token, l_char *s) {
|
||||
if (token < 256) {
|
||||
s[0] = (l_char)token;
|
||||
s[1] = l_c('\0');
|
||||
}
|
||||
else
|
||||
strcpy(s, token2string[token-FIRST_RESERVED]);
|
||||
}
|
||||
|
||||
|
||||
static void luaX_invalidchar (LexState *ls, int c) {
|
||||
l_char buff[8];
|
||||
sprintf(buff, l_s("0x%02X"), uchar(c));
|
||||
luaX_syntaxerror(ls, l_s("invalid control char"), buff);
|
||||
}
|
||||
|
||||
|
||||
static void inclinenumber (LexState *LS) {
|
||||
next(LS); /* skip `\n' */
|
||||
++LS->linenumber;
|
||||
luaX_checklimit(LS, LS->linenumber, MAX_INT, l_s("lines in a chunk"));
|
||||
}
|
||||
|
||||
|
||||
void luaX_setinput (lua_State *L, LexState *LS, ZIO *z, TString *source) {
|
||||
LS->L = L;
|
||||
LS->lookahead.token = TK_EOS; /* no look-ahead token */
|
||||
LS->z = z;
|
||||
LS->fs = NULL;
|
||||
LS->linenumber = 1;
|
||||
LS->lastline = 1;
|
||||
LS->source = source;
|
||||
next(LS); /* read first char */
|
||||
if (LS->current == l_c('#')) {
|
||||
do { /* skip first line */
|
||||
next(LS);
|
||||
} while (LS->current != l_c('\n') && LS->current != EOZ);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** =======================================================
|
||||
** LEXICAL ANALYZER
|
||||
** =======================================================
|
||||
*/
|
||||
|
||||
|
||||
/* use Mbuffer to store names, literal strings and numbers */
|
||||
|
||||
#define EXTRABUFF 128
|
||||
#define checkbuffer(L, n, len) \
|
||||
if (((len)+(n))*sizeof(l_char) > G(L)->Mbuffsize) \
|
||||
luaO_openspace(L, (len)+(n)+EXTRABUFF, l_char)
|
||||
|
||||
#define save(L, c, l) (((l_char *)G(L)->Mbuffer)[l++] = (l_char)c)
|
||||
#define save_and_next(L, LS, l) (save(L, LS->current, l), next(LS))
|
||||
|
||||
|
||||
static size_t readname (LexState *LS) {
|
||||
lua_State *L = LS->L;
|
||||
size_t l = 0;
|
||||
checkbuffer(L, 10, l);
|
||||
do {
|
||||
checkbuffer(L, 10, l);
|
||||
save_and_next(L, LS, l);
|
||||
} while (isalnum(LS->current) || LS->current == l_c('_'));
|
||||
save(L, l_c('\0'), l);
|
||||
return l-1;
|
||||
}
|
||||
|
||||
|
||||
/* LUA_NUMBER */
|
||||
static void read_number (LexState *LS, int comma, SemInfo *seminfo) {
|
||||
lua_State *L = LS->L;
|
||||
size_t l = 0;
|
||||
checkbuffer(L, 10, l);
|
||||
if (comma) save(L, l_c('.'), l);
|
||||
while (isdigit(LS->current)) {
|
||||
checkbuffer(L, 10, l);
|
||||
save_and_next(L, LS, l);
|
||||
}
|
||||
if (LS->current == l_c('.')) {
|
||||
save_and_next(L, LS, l);
|
||||
if (LS->current == l_c('.')) {
|
||||
save_and_next(L, LS, l);
|
||||
save(L, l_c('\0'), l);
|
||||
luaX_error(LS,
|
||||
l_s("ambiguous syntax (decimal point x string concatenation)"),
|
||||
TK_NUMBER);
|
||||
}
|
||||
}
|
||||
while (isdigit(LS->current)) {
|
||||
checkbuffer(L, 10, l);
|
||||
save_and_next(L, LS, l);
|
||||
}
|
||||
if (LS->current == l_c('e') || LS->current == l_c('E')) {
|
||||
save_and_next(L, LS, l); /* read `E' */
|
||||
if (LS->current == l_c('+') || LS->current == l_c('-'))
|
||||
save_and_next(L, LS, l); /* optional exponent sign */
|
||||
while (isdigit(LS->current)) {
|
||||
checkbuffer(L, 10, l);
|
||||
save_and_next(L, LS, l);
|
||||
}
|
||||
}
|
||||
save(L, l_c('\0'), l);
|
||||
if (!luaO_str2d((l_char *)G(L)->Mbuffer, &seminfo->r))
|
||||
luaX_error(LS, l_s("malformed number"), TK_NUMBER);
|
||||
}
|
||||
|
||||
|
||||
static void read_long_string (LexState *LS, SemInfo *seminfo) {
|
||||
lua_State *L = LS->L;
|
||||
int cont = 0;
|
||||
size_t l = 0;
|
||||
checkbuffer(L, 10, l);
|
||||
save(L, l_c('['), l); /* save first `[' */
|
||||
save_and_next(L, LS, l); /* pass the second `[' */
|
||||
if (LS->current == l_c('\n')) /* string starts with a newline? */
|
||||
inclinenumber(LS); /* skip it */
|
||||
for (;;) {
|
||||
checkbuffer(L, 10, l);
|
||||
switch (LS->current) {
|
||||
case EOZ:
|
||||
save(L, l_c('\0'), l);
|
||||
luaX_error(LS, l_s("unfinished long string"), TK_STRING);
|
||||
break; /* to avoid warnings */
|
||||
case l_c('['):
|
||||
save_and_next(L, LS, l);
|
||||
if (LS->current == l_c('[')) {
|
||||
cont++;
|
||||
save_and_next(L, LS, l);
|
||||
}
|
||||
continue;
|
||||
case l_c(']'):
|
||||
save_and_next(L, LS, l);
|
||||
if (LS->current == l_c(']')) {
|
||||
if (cont == 0) goto endloop;
|
||||
cont--;
|
||||
save_and_next(L, LS, l);
|
||||
}
|
||||
continue;
|
||||
case l_c('\n'):
|
||||
save(L, l_c('\n'), l);
|
||||
inclinenumber(LS);
|
||||
continue;
|
||||
default:
|
||||
save_and_next(L, LS, l);
|
||||
}
|
||||
} endloop:
|
||||
save_and_next(L, LS, l); /* skip the second `]' */
|
||||
save(L, l_c('\0'), l);
|
||||
seminfo->ts = luaS_newlstr(L, (l_char *)G(L)->Mbuffer+2, l-5);
|
||||
}
|
||||
|
||||
|
||||
static void read_string (LexState *LS, int del, SemInfo *seminfo) {
|
||||
lua_State *L = LS->L;
|
||||
size_t l = 0;
|
||||
checkbuffer(L, 10, l);
|
||||
save_and_next(L, LS, l);
|
||||
while (LS->current != del) {
|
||||
checkbuffer(L, 10, l);
|
||||
switch (LS->current) {
|
||||
case EOZ: case l_c('\n'):
|
||||
save(L, l_c('\0'), l);
|
||||
luaX_error(LS, l_s("unfinished string"), TK_STRING);
|
||||
break; /* to avoid warnings */
|
||||
case l_c('\\'):
|
||||
next(LS); /* do not save the `\' */
|
||||
switch (LS->current) {
|
||||
case l_c('a'): save(L, l_c('\a'), l); next(LS); break;
|
||||
case l_c('b'): save(L, l_c('\b'), l); next(LS); break;
|
||||
case l_c('f'): save(L, l_c('\f'), l); next(LS); break;
|
||||
case l_c('n'): save(L, l_c('\n'), l); next(LS); break;
|
||||
case l_c('r'): save(L, l_c('\r'), l); next(LS); break;
|
||||
case l_c('t'): save(L, l_c('\t'), l); next(LS); break;
|
||||
case l_c('v'): save(L, l_c('\v'), l); next(LS); break;
|
||||
case l_c('\n'): save(L, l_c('\n'), l); inclinenumber(LS); break;
|
||||
default: {
|
||||
if (!isdigit(LS->current))
|
||||
save_and_next(L, LS, l); /* handles \\, \", \', and \? */
|
||||
else { /* \xxx */
|
||||
int c = 0;
|
||||
int i = 0;
|
||||
do {
|
||||
c = 10*c + (LS->current-l_c('0'));
|
||||
next(LS);
|
||||
} while (++i<3 && isdigit(LS->current));
|
||||
if (c > UCHAR_MAX) {
|
||||
save(L, l_c('\0'), l);
|
||||
luaX_error(LS, l_s("escape sequence too large"), TK_STRING);
|
||||
}
|
||||
save(L, c, l);
|
||||
}
|
||||
}
|
||||
}
|
||||
break;
|
||||
default:
|
||||
save_and_next(L, LS, l);
|
||||
}
|
||||
}
|
||||
save_and_next(L, LS, l); /* skip delimiter */
|
||||
save(L, l_c('\0'), l);
|
||||
seminfo->ts = luaS_newlstr(L, (l_char *)G(L)->Mbuffer+1, l-3);
|
||||
}
|
||||
|
||||
|
||||
int luaX_lex (LexState *LS, SemInfo *seminfo) {
|
||||
for (;;) {
|
||||
switch (LS->current) {
|
||||
|
||||
case l_c(' '): case l_c('\t'): case l_c('\r'): /* `\r' to avoid problems with DOS */
|
||||
next(LS);
|
||||
continue;
|
||||
|
||||
case l_c('\n'):
|
||||
inclinenumber(LS);
|
||||
continue;
|
||||
|
||||
case l_c('$'):
|
||||
luaX_error(LS,
|
||||
l_s("unexpected `$' (pragmas are no longer supported)"),
|
||||
LS->current);
|
||||
break;
|
||||
|
||||
case l_c('-'):
|
||||
next(LS);
|
||||
if (LS->current != l_c('-')) return l_c('-');
|
||||
do { next(LS); } while (LS->current != l_c('\n') && LS->current != EOZ);
|
||||
continue;
|
||||
|
||||
case l_c('['):
|
||||
next(LS);
|
||||
if (LS->current != l_c('[')) return l_c('[');
|
||||
else {
|
||||
read_long_string(LS, seminfo);
|
||||
return TK_STRING;
|
||||
}
|
||||
|
||||
case l_c('='):
|
||||
next(LS);
|
||||
if (LS->current != l_c('=')) return l_c('=');
|
||||
else { next(LS); return TK_EQ; }
|
||||
|
||||
case l_c('<'):
|
||||
next(LS);
|
||||
if (LS->current != l_c('=')) return l_c('<');
|
||||
else { next(LS); return TK_LE; }
|
||||
|
||||
case l_c('>'):
|
||||
next(LS);
|
||||
if (LS->current != l_c('=')) return l_c('>');
|
||||
else { next(LS); return TK_GE; }
|
||||
|
||||
case l_c('~'):
|
||||
next(LS);
|
||||
if (LS->current != l_c('=')) return l_c('~');
|
||||
else { next(LS); return TK_NE; }
|
||||
|
||||
case l_c('"'):
|
||||
case l_c('\''):
|
||||
read_string(LS, LS->current, seminfo);
|
||||
return TK_STRING;
|
||||
|
||||
case l_c('.'):
|
||||
next(LS);
|
||||
if (LS->current == l_c('.')) {
|
||||
next(LS);
|
||||
if (LS->current == l_c('.')) {
|
||||
next(LS);
|
||||
return TK_DOTS; /* ... */
|
||||
}
|
||||
else return TK_CONCAT; /* .. */
|
||||
}
|
||||
else if (!isdigit(LS->current)) return l_c('.');
|
||||
else {
|
||||
read_number(LS, 1, seminfo);
|
||||
return TK_NUMBER;
|
||||
}
|
||||
|
||||
case EOZ:
|
||||
return TK_EOS;
|
||||
|
||||
default: {
|
||||
if (isdigit(LS->current)) {
|
||||
read_number(LS, 0, seminfo);
|
||||
return TK_NUMBER;
|
||||
}
|
||||
else if (isalpha(LS->current) || LS->current == l_c('_')) {
|
||||
/* identifier or reserved word */
|
||||
size_t l = readname(LS);
|
||||
TString *ts = luaS_newlstr(LS->L, (l_char *)G(LS->L)->Mbuffer, l);
|
||||
if (ts->tsv.marked >= RESERVEDMARK) /* reserved word? */
|
||||
return ts->tsv.marked-RESERVEDMARK+FIRST_RESERVED;
|
||||
seminfo->ts = ts;
|
||||
return TK_NAME;
|
||||
}
|
||||
else {
|
||||
l_charint c = LS->current;
|
||||
if (iscntrl(c))
|
||||
luaX_invalidchar(LS, c);
|
||||
next(LS);
|
||||
return c; /* single-char tokens (+ - / ...) */
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
73
llex.h
73
llex.h
@@ -1,73 +0,0 @@
|
||||
/*
|
||||
** $Id: llex.h,v 1.36 2001/06/20 21:07:57 roberto Exp roberto $
|
||||
** Lexical Analyzer
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
#ifndef llex_h
|
||||
#define llex_h
|
||||
|
||||
#include "lobject.h"
|
||||
#include "lzio.h"
|
||||
|
||||
|
||||
#define FIRST_RESERVED 257
|
||||
|
||||
/* maximum length of a reserved word */
|
||||
#define TOKEN_LEN (sizeof(l_s("function"))/sizeof(l_char))
|
||||
|
||||
|
||||
/*
|
||||
* WARNING: if you change the order of this enumeration,
|
||||
* grep "ORDER RESERVED"
|
||||
*/
|
||||
enum RESERVED {
|
||||
/* terminal symbols denoted by reserved words */
|
||||
TK_AND = FIRST_RESERVED, TK_BREAK,
|
||||
TK_DO, TK_ELSE, TK_ELSEIF, TK_END, TK_FOR, TK_FUNCTION, TK_GLOBAL, TK_IF,
|
||||
TK_IN, TK_LOCAL, TK_NIL, TK_NOT, TK_OR, TK_REPEAT, TK_RETURN, TK_THEN,
|
||||
TK_UNTIL, TK_WHILE,
|
||||
/* other terminal symbols */
|
||||
TK_NAME, TK_CONCAT, TK_DOTS, TK_EQ, TK_GE, TK_LE, TK_NE, TK_NUMBER,
|
||||
TK_STRING, TK_EOS
|
||||
};
|
||||
|
||||
/* number of reserved words */
|
||||
#define NUM_RESERVED ((int)(TK_WHILE-FIRST_RESERVED+1))
|
||||
|
||||
|
||||
typedef union {
|
||||
lua_Number r;
|
||||
TString *ts;
|
||||
} SemInfo; /* semantics information */
|
||||
|
||||
|
||||
typedef struct Token {
|
||||
int token;
|
||||
SemInfo seminfo;
|
||||
} Token;
|
||||
|
||||
|
||||
typedef struct LexState {
|
||||
l_charint current; /* current character */
|
||||
Token t; /* current token */
|
||||
Token lookahead; /* look ahead token */
|
||||
struct FuncState *fs; /* `FuncState' is private to the parser */
|
||||
struct lua_State *L;
|
||||
struct zio *z; /* input stream */
|
||||
int linenumber; /* input line counter */
|
||||
int lastline; /* line of last token `consumed' */
|
||||
TString *source; /* current source name */
|
||||
} LexState;
|
||||
|
||||
|
||||
void luaX_init (lua_State *L);
|
||||
void luaX_setinput (lua_State *L, LexState *LS, ZIO *z, TString *source);
|
||||
int luaX_lex (LexState *LS, SemInfo *seminfo);
|
||||
void luaX_checklimit (LexState *ls, int val, int limit, const l_char *msg);
|
||||
void luaX_syntaxerror (LexState *ls, const l_char *s, const l_char *token);
|
||||
void luaX_error (LexState *ls, const l_char *s, int token);
|
||||
void luaX_token2str (int token, l_char *s);
|
||||
|
||||
|
||||
#endif
|
||||
133
llimits.h
133
llimits.h
@@ -1,133 +0,0 @@
|
||||
/*
|
||||
** $Id: llimits.h,v 1.29 2001/06/05 18:17:01 roberto Exp roberto $
|
||||
** Limits, basic types, and some other `installation-dependent' definitions
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
#ifndef llimits_h
|
||||
#define llimits_h
|
||||
|
||||
|
||||
#include <limits.h>
|
||||
#include <stddef.h>
|
||||
|
||||
|
||||
#include "lua.h"
|
||||
|
||||
|
||||
/*
|
||||
** try to find number of bits in an integer
|
||||
*/
|
||||
#ifndef BITS_INT
|
||||
/* avoid overflows in comparison */
|
||||
#if INT_MAX-20 < 32760
|
||||
#define BITS_INT 16
|
||||
#else
|
||||
#if INT_MAX > 2147483640L
|
||||
/* machine has at least 32 bits */
|
||||
#define BITS_INT 32
|
||||
#else
|
||||
#error "you must define BITS_INT with number of bits in an integer"
|
||||
#endif
|
||||
#endif
|
||||
#endif
|
||||
|
||||
|
||||
/*
|
||||
** the following types define integer types for values that may not
|
||||
** fit in a `small int' (16 bits), but may waste space in a
|
||||
** `large long' (64 bits). The current definitions should work in
|
||||
** any machine, but may not be optimal.
|
||||
*/
|
||||
|
||||
/* an unsigned integer to hold hash values */
|
||||
typedef unsigned int lu_hash;
|
||||
/* its signed equivalent */
|
||||
typedef int ls_hash;
|
||||
|
||||
/* an unsigned integer big enough to count the total memory used by Lua */
|
||||
typedef unsigned long lu_mem;
|
||||
|
||||
/* an integer big enough to count the number of strings in use */
|
||||
typedef long ls_nstr;
|
||||
|
||||
|
||||
/* chars used as small naturals (so that `char' is reserved for characteres) */
|
||||
typedef unsigned char lu_byte;
|
||||
|
||||
|
||||
#define MAX_SIZET ((size_t)(~(size_t)0)-2)
|
||||
|
||||
|
||||
#define MAX_INT (INT_MAX-2) /* maximum value of an int (-2 for safety) */
|
||||
|
||||
/*
|
||||
** conversion of pointer to integer
|
||||
** this is for hashing only; there is no problem if the integer
|
||||
** cannot hold the whole pointer value
|
||||
** (the shift removes bits that are usually 0 because of alignment)
|
||||
*/
|
||||
#define IntPoint(p) ((((lu_hash)(p)) >> 4) ^ (lu_hash)(p))
|
||||
|
||||
|
||||
|
||||
#define MINPOWER2 4 /* minimum size for `growing' vectors */
|
||||
|
||||
|
||||
|
||||
#ifndef DEFAULT_STACK_SIZE
|
||||
#define DEFAULT_STACK_SIZE 1024
|
||||
#endif
|
||||
|
||||
|
||||
|
||||
/* type to ensure maximum alignment */
|
||||
#ifndef LUSER_ALIGNMENT_T
|
||||
#define LUSER_ALIGNMENT_T double
|
||||
#endif
|
||||
union L_Umaxalign { LUSER_ALIGNMENT_T u; void *s; long l; };
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** type for virtual-machine instructions
|
||||
** must be an unsigned with (at least) 4 bytes (see details in lopcodes.h)
|
||||
*/
|
||||
typedef unsigned long Instruction;
|
||||
|
||||
|
||||
/* maximum stack for a Lua function */
|
||||
#define MAXSTACK 250
|
||||
|
||||
|
||||
/* maximum number of local variables */
|
||||
#ifndef MAXLOCALS
|
||||
#define MAXLOCALS 200 /* arbitrary limit (<MAXSTACK) */
|
||||
#endif
|
||||
|
||||
|
||||
/* maximum number of upvalues */
|
||||
#ifndef MAXUPVALUES
|
||||
#define MAXUPVALUES 32 /* arbitrary limit (<MAXSTACK) */
|
||||
#endif
|
||||
|
||||
|
||||
/* maximum number of parameters in a function */
|
||||
#ifndef MAXPARAMS
|
||||
#define MAXPARAMS 100 /* arbitrary limit (<MAXLOCALS) */
|
||||
#endif
|
||||
|
||||
|
||||
/* number of list items to accumulate before a SETLIST instruction */
|
||||
/* (must be a power of 2) */
|
||||
#define LFIELDS_PER_FLUSH 64
|
||||
|
||||
|
||||
|
||||
/* maximum lookback to find a real constant (for code generation) */
|
||||
#ifndef LOOKBACKNUMS
|
||||
#define LOOKBACKNUMS 40 /* arbitrary constant */
|
||||
#endif
|
||||
|
||||
|
||||
#endif
|
||||
240
lmathlib.c
240
lmathlib.c
@@ -1,240 +0,0 @@
|
||||
/*
|
||||
** $Id: lmathlib.c,v 1.37 2001/03/06 20:09:38 roberto Exp roberto $
|
||||
** Standard mathematical library
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <math.h>
|
||||
|
||||
#define LUA_PRIVATE
|
||||
#include "lua.h"
|
||||
|
||||
#include "lauxlib.h"
|
||||
#include "lualib.h"
|
||||
|
||||
|
||||
#undef PI
|
||||
#define PI (3.14159265358979323846)
|
||||
#define RADIANS_PER_DEGREE (PI/180.0)
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** If you want Lua to operate in radians (instead of degrees),
|
||||
** define RADIANS
|
||||
*/
|
||||
#ifdef RADIANS
|
||||
#define FROMRAD(a) (a)
|
||||
#define TORAD(a) (a)
|
||||
#else
|
||||
#define FROMRAD(a) ((a)/RADIANS_PER_DEGREE)
|
||||
#define TORAD(a) ((a)*RADIANS_PER_DEGREE)
|
||||
#endif
|
||||
|
||||
|
||||
static int math_abs (lua_State *L) {
|
||||
lua_pushnumber(L, fabs(luaL_check_number(L, 1)));
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int math_sin (lua_State *L) {
|
||||
lua_pushnumber(L, sin(TORAD(luaL_check_number(L, 1))));
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int math_cos (lua_State *L) {
|
||||
lua_pushnumber(L, cos(TORAD(luaL_check_number(L, 1))));
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int math_tan (lua_State *L) {
|
||||
lua_pushnumber(L, tan(TORAD(luaL_check_number(L, 1))));
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int math_asin (lua_State *L) {
|
||||
lua_pushnumber(L, FROMRAD(asin(luaL_check_number(L, 1))));
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int math_acos (lua_State *L) {
|
||||
lua_pushnumber(L, FROMRAD(acos(luaL_check_number(L, 1))));
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int math_atan (lua_State *L) {
|
||||
lua_pushnumber(L, FROMRAD(atan(luaL_check_number(L, 1))));
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int math_atan2 (lua_State *L) {
|
||||
lua_pushnumber(L, FROMRAD(atan2(luaL_check_number(L, 1), luaL_check_number(L, 2))));
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int math_ceil (lua_State *L) {
|
||||
lua_pushnumber(L, ceil(luaL_check_number(L, 1)));
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int math_floor (lua_State *L) {
|
||||
lua_pushnumber(L, floor(luaL_check_number(L, 1)));
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int math_mod (lua_State *L) {
|
||||
lua_pushnumber(L, fmod(luaL_check_number(L, 1), luaL_check_number(L, 2)));
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int math_sqrt (lua_State *L) {
|
||||
lua_pushnumber(L, sqrt(luaL_check_number(L, 1)));
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int math_pow (lua_State *L) {
|
||||
lua_pushnumber(L, pow(luaL_check_number(L, 1), luaL_check_number(L, 2)));
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int math_log (lua_State *L) {
|
||||
lua_pushnumber(L, log(luaL_check_number(L, 1)));
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int math_log10 (lua_State *L) {
|
||||
lua_pushnumber(L, log10(luaL_check_number(L, 1)));
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int math_exp (lua_State *L) {
|
||||
lua_pushnumber(L, exp(luaL_check_number(L, 1)));
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int math_deg (lua_State *L) {
|
||||
lua_pushnumber(L, luaL_check_number(L, 1)/RADIANS_PER_DEGREE);
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int math_rad (lua_State *L) {
|
||||
lua_pushnumber(L, luaL_check_number(L, 1)*RADIANS_PER_DEGREE);
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int math_frexp (lua_State *L) {
|
||||
int e;
|
||||
lua_pushnumber(L, frexp(luaL_check_number(L, 1), &e));
|
||||
lua_pushnumber(L, e);
|
||||
return 2;
|
||||
}
|
||||
|
||||
static int math_ldexp (lua_State *L) {
|
||||
lua_pushnumber(L, ldexp(luaL_check_number(L, 1), luaL_check_int(L, 2)));
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
|
||||
static int math_min (lua_State *L) {
|
||||
int n = lua_gettop(L); /* number of arguments */
|
||||
lua_Number dmin = luaL_check_number(L, 1);
|
||||
int i;
|
||||
for (i=2; i<=n; i++) {
|
||||
lua_Number d = luaL_check_number(L, i);
|
||||
if (d < dmin)
|
||||
dmin = d;
|
||||
}
|
||||
lua_pushnumber(L, dmin);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int math_max (lua_State *L) {
|
||||
int n = lua_gettop(L); /* number of arguments */
|
||||
lua_Number dmax = luaL_check_number(L, 1);
|
||||
int i;
|
||||
for (i=2; i<=n; i++) {
|
||||
lua_Number d = luaL_check_number(L, i);
|
||||
if (d > dmax)
|
||||
dmax = d;
|
||||
}
|
||||
lua_pushnumber(L, dmax);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int math_random (lua_State *L) {
|
||||
/* the `%' avoids the (rare) case of r==1, and is needed also because on
|
||||
some systems (SunOS!) `rand()' may return a value larger than RAND_MAX */
|
||||
lua_Number r = (lua_Number)(rand()%RAND_MAX) / (lua_Number)RAND_MAX;
|
||||
switch (lua_gettop(L)) { /* check number of arguments */
|
||||
case 0: { /* no arguments */
|
||||
lua_pushnumber(L, r); /* Number between 0 and 1 */
|
||||
break;
|
||||
}
|
||||
case 1: { /* only upper limit */
|
||||
int u = luaL_check_int(L, 1);
|
||||
luaL_arg_check(L, 1<=u, 1, l_s("interval is empty"));
|
||||
lua_pushnumber(L, (int)(r*u)+1); /* integer between 1 and `u' */
|
||||
break;
|
||||
}
|
||||
case 2: { /* lower and upper limits */
|
||||
int l = luaL_check_int(L, 1);
|
||||
int u = luaL_check_int(L, 2);
|
||||
luaL_arg_check(L, l<=u, 2, l_s("interval is empty"));
|
||||
lua_pushnumber(L, (int)(r*(u-l+1))+l); /* integer between `l' and `u' */
|
||||
break;
|
||||
}
|
||||
default: lua_error(L, l_s("wrong number of arguments"));
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int math_randomseed (lua_State *L) {
|
||||
srand(luaL_check_int(L, 1));
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
static const luaL_reg mathlib[] = {
|
||||
{l_s("abs"), math_abs},
|
||||
{l_s("sin"), math_sin},
|
||||
{l_s("cos"), math_cos},
|
||||
{l_s("tan"), math_tan},
|
||||
{l_s("asin"), math_asin},
|
||||
{l_s("acos"), math_acos},
|
||||
{l_s("atan"), math_atan},
|
||||
{l_s("atan2"), math_atan2},
|
||||
{l_s("ceil"), math_ceil},
|
||||
{l_s("floor"), math_floor},
|
||||
{l_s("mod"), math_mod},
|
||||
{l_s("frexp"), math_frexp},
|
||||
{l_s("ldexp"), math_ldexp},
|
||||
{l_s("sqrt"), math_sqrt},
|
||||
{l_s("min"), math_min},
|
||||
{l_s("max"), math_max},
|
||||
{l_s("log"), math_log},
|
||||
{l_s("log10"), math_log10},
|
||||
{l_s("exp"), math_exp},
|
||||
{l_s("deg"), math_deg},
|
||||
{l_s("rad"), math_rad},
|
||||
{l_s("random"), math_random},
|
||||
{l_s("randomseed"), math_randomseed}
|
||||
};
|
||||
|
||||
/*
|
||||
** Open math library
|
||||
*/
|
||||
LUALIB_API int lua_mathlibopen (lua_State *L) {
|
||||
luaL_openl(L, mathlib);
|
||||
lua_pushcfunction(L, math_pow);
|
||||
lua_settagmethod(L, LUA_TNUMBER, l_s("pow"));
|
||||
lua_pushnumber(L, PI);
|
||||
lua_setglobal(L, l_s("PI"));
|
||||
return 0;
|
||||
}
|
||||
|
||||
68
lmem.c
68
lmem.c
@@ -1,68 +0,0 @@
|
||||
/*
|
||||
** $Id: lmem.c,v 1.48 2001/02/23 17:17:25 roberto Exp roberto $
|
||||
** Interface to Memory Manager
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
#include <stdlib.h>
|
||||
|
||||
#define LUA_PRIVATE
|
||||
#include "lua.h"
|
||||
|
||||
#include "ldo.h"
|
||||
#include "lmem.h"
|
||||
#include "lobject.h"
|
||||
#include "lstate.h"
|
||||
|
||||
|
||||
|
||||
#ifndef l_realloc
|
||||
#define l_realloc(b,os,s) realloc(b,s)
|
||||
#define l_free(b,s) free(b)
|
||||
#endif
|
||||
|
||||
|
||||
void *luaM_growaux (lua_State *L, void *block, int *size, int size_elems,
|
||||
int limit, const l_char *errormsg) {
|
||||
void *newblock;
|
||||
int newsize = (*size)*2;
|
||||
if (newsize < MINPOWER2)
|
||||
newsize = MINPOWER2; /* minimum size */
|
||||
else if (*size >= limit/2) { /* cannot double it? */
|
||||
if (*size < limit - MINPOWER2) /* try something smaller... */
|
||||
newsize = limit; /* still have at least MINPOWER2 free places */
|
||||
else luaD_error(L, errormsg);
|
||||
}
|
||||
newblock = luaM_realloc(L, block, (lu_mem)(*size)*(lu_mem)size_elems,
|
||||
(lu_mem)newsize*(lu_mem)size_elems);
|
||||
*size = newsize; /* update only when everything else is OK */
|
||||
return newblock;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** generic allocation routine.
|
||||
*/
|
||||
void *luaM_realloc (lua_State *L, void *block, lu_mem oldsize, lu_mem size) {
|
||||
if (size == 0) {
|
||||
l_free(block, oldsize); /* block may be NULL; that is OK for free */
|
||||
block = NULL;
|
||||
}
|
||||
else if (size >= MAX_SIZET)
|
||||
luaD_error(L, l_s("memory allocation error: block too big"));
|
||||
else {
|
||||
block = l_realloc(block, oldsize, size);
|
||||
if (block == NULL) {
|
||||
if (L)
|
||||
luaD_breakrun(L, LUA_ERRMEM); /* break run without error message */
|
||||
else return NULL; /* error before creating state! */
|
||||
}
|
||||
}
|
||||
if (L && G(L)) {
|
||||
G(L)->nblocks -= oldsize;
|
||||
G(L)->nblocks += size;
|
||||
}
|
||||
return block;
|
||||
}
|
||||
|
||||
41
lmem.h
41
lmem.h
@@ -1,41 +0,0 @@
|
||||
/*
|
||||
** $Id: lmem.h,v 1.21 2001/02/20 18:15:33 roberto Exp roberto $
|
||||
** Interface to Memory Manager
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
#ifndef lmem_h
|
||||
#define lmem_h
|
||||
|
||||
|
||||
#include <stddef.h>
|
||||
|
||||
#include "llimits.h"
|
||||
#include "lua.h"
|
||||
|
||||
void *luaM_realloc (lua_State *L, void *oldblock, lu_mem oldsize, lu_mem size);
|
||||
|
||||
void *luaM_growaux (lua_State *L, void *block, int *size, int size_elem,
|
||||
int limit, const l_char *errormsg);
|
||||
|
||||
#define luaM_free(L, b, s) luaM_realloc(L, (b), (s), 0)
|
||||
#define luaM_freelem(L, b, t) luaM_realloc(L, (b), sizeof(t), 0)
|
||||
#define luaM_freearray(L, b, n, t) luaM_realloc(L, (b), \
|
||||
((lu_mem)(n)*(lu_mem)sizeof(t)), 0)
|
||||
|
||||
#define luaM_malloc(L, t) luaM_realloc(L, NULL, 0, (t))
|
||||
#define luaM_new(L, t) ((t *)luaM_malloc(L, sizeof(t)))
|
||||
#define luaM_newvector(L, n,t) ((t *)luaM_malloc(L, \
|
||||
(lu_mem)(n)*(lu_mem)sizeof(t)))
|
||||
|
||||
#define luaM_growvector(L,v,nelems,size,t,limit,e) \
|
||||
if (((nelems)+1) > (size)) \
|
||||
((v)=(t *)luaM_growaux(L,v,&(size),sizeof(t),limit,e))
|
||||
|
||||
#define luaM_reallocvector(L, v,oldn,n,t) \
|
||||
((v)=(t *)luaM_realloc(L, v,(lu_mem)(oldn)*(lu_mem)sizeof(t), \
|
||||
(lu_mem)(n)*(lu_mem)sizeof(t)))
|
||||
|
||||
|
||||
#endif
|
||||
|
||||
105
lobject.c
105
lobject.c
@@ -1,105 +0,0 @@
|
||||
/*
|
||||
** $Id: lobject.c,v 1.69 2001/03/07 12:27:06 roberto Exp roberto $
|
||||
** Some generic functions over Lua objects
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
#include <ctype.h>
|
||||
#include <stdarg.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
#define LUA_PRIVATE
|
||||
#include "lua.h"
|
||||
|
||||
#include "ldo.h"
|
||||
#include "lmem.h"
|
||||
#include "lobject.h"
|
||||
#include "lstate.h"
|
||||
|
||||
|
||||
|
||||
const TObject luaO_nilobject = {LUA_TNIL, {NULL}};
|
||||
|
||||
|
||||
int luaO_equalObj (const TObject *t1, const TObject *t2) {
|
||||
if (ttype(t1) != ttype(t2)) return 0;
|
||||
switch (ttype(t1)) {
|
||||
case LUA_TNUMBER:
|
||||
return nvalue(t1) == nvalue(t2);
|
||||
case LUA_TNIL:
|
||||
return 1;
|
||||
default: /* all other types are equal if pointers are equal */
|
||||
return tsvalue(t1) == tsvalue(t2);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
void *luaO_openspaceaux (lua_State *L, size_t n) {
|
||||
if (n > G(L)->Mbuffsize) {
|
||||
G(L)->Mbuffer = luaM_realloc(L, G(L)->Mbuffer, G(L)->Mbuffsize, n);
|
||||
G(L)->Mbuffsize = n;
|
||||
}
|
||||
return G(L)->Mbuffer;
|
||||
}
|
||||
|
||||
|
||||
int luaO_str2d (const l_char *s, lua_Number *result) {
|
||||
l_char *endptr;
|
||||
lua_Number res = lua_str2number(s, &endptr);
|
||||
if (endptr == s) return 0; /* no conversion */
|
||||
while (isspace(uchar(*endptr))) endptr++;
|
||||
if (*endptr != l_c('\0')) return 0; /* invalid trailing characters? */
|
||||
*result = res;
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
/* maximum length of a string format for `luaO_verror' */
|
||||
#define MAX_VERROR 280
|
||||
|
||||
/* this function needs to handle only '%d' and '%.XXs' formats */
|
||||
void luaO_verror (lua_State *L, const l_char *fmt, ...) {
|
||||
va_list argp;
|
||||
l_char buff[MAX_VERROR]; /* to hold formatted message */
|
||||
va_start(argp, fmt);
|
||||
vsprintf(buff, fmt, argp);
|
||||
va_end(argp);
|
||||
luaD_error(L, buff);
|
||||
}
|
||||
|
||||
|
||||
void luaO_chunkid (l_char *out, const l_char *source, int bufflen) {
|
||||
if (*source == l_c('=')) {
|
||||
strncpy(out, source+1, bufflen); /* remove first char */
|
||||
out[bufflen-1] = l_c('\0'); /* ensures null termination */
|
||||
}
|
||||
else {
|
||||
if (*source == l_c('@')) {
|
||||
int l;
|
||||
source++; /* skip the `@' */
|
||||
bufflen -= sizeof(l_s("file `...%s'"));
|
||||
l = strlen(source);
|
||||
if (l>bufflen) {
|
||||
source += (l-bufflen); /* get last part of file name */
|
||||
sprintf(out, l_s("file `...%.99s'"), source);
|
||||
}
|
||||
else
|
||||
sprintf(out, l_s("file `%.99s'"), source);
|
||||
}
|
||||
else {
|
||||
int len = strcspn(source, l_s("\n")); /* stop at first newline */
|
||||
bufflen -= sizeof(l_s("string \"%.*s...\""));
|
||||
if (len > bufflen) len = bufflen;
|
||||
if (source[len] != l_c('\0')) { /* must truncate? */
|
||||
strcpy(out, l_s("string \""));
|
||||
out += strlen(out);
|
||||
strncpy(out, source, len);
|
||||
strcpy(out+len, l_s("...\""));
|
||||
}
|
||||
else
|
||||
sprintf(out, l_s("string \"%.99s\""), source);
|
||||
}
|
||||
}
|
||||
}
|
||||
231
lobject.h
231
lobject.h
@@ -1,231 +0,0 @@
|
||||
/*
|
||||
** $Id: lobject.h,v 1.108 2001/06/28 14:48:44 roberto Exp roberto $
|
||||
** Type definitions for Lua objects
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
#ifndef lobject_h
|
||||
#define lobject_h
|
||||
|
||||
|
||||
#include "llimits.h"
|
||||
#include "lua.h"
|
||||
|
||||
|
||||
#ifndef lua_assert
|
||||
#define lua_assert(c) /* empty */
|
||||
#endif
|
||||
|
||||
|
||||
#ifndef UNUSED
|
||||
#define UNUSED(x) ((void)(x)) /* to avoid warnings */
|
||||
#endif
|
||||
|
||||
|
||||
|
||||
/* tags for values visible from Lua == first user-created tag */
|
||||
#define NUM_TAGS 6
|
||||
|
||||
|
||||
typedef union {
|
||||
union TString *ts;
|
||||
union Udata *u;
|
||||
struct Closure *cl;
|
||||
struct Hash *h;
|
||||
lua_Number n; /* LUA_TNUMBER */
|
||||
} Value;
|
||||
|
||||
|
||||
typedef struct lua_TObject {
|
||||
int tt;
|
||||
Value value;
|
||||
} TObject;
|
||||
|
||||
|
||||
/* Macros to access values */
|
||||
#define ttype(o) ((o)->tt)
|
||||
#define nvalue(o) ((o)->value.n)
|
||||
#define tsvalue(o) ((o)->value.ts)
|
||||
#define uvalue(o) ((o)->value.u)
|
||||
#define clvalue(o) ((o)->value.cl)
|
||||
#define hvalue(o) ((o)->value.h)
|
||||
|
||||
|
||||
/* Macros to set values */
|
||||
#define setnvalue(obj,x) \
|
||||
{ TObject *_o=(obj); _o->tt=LUA_TNUMBER; _o->value.n=(x); }
|
||||
|
||||
#define chgnvalue(obj,x) ((obj)->value.n=(x))
|
||||
|
||||
#define setsvalue(obj,x) \
|
||||
{ TObject *_o=(obj); _o->tt=LUA_TSTRING; _o->value.ts=(x); }
|
||||
|
||||
#define setuvalue(obj,x) \
|
||||
{ TObject *_o=(obj); _o->tt=LUA_TUSERDATA; _o->value.u=(x); }
|
||||
|
||||
#define setclvalue(obj,x) \
|
||||
{ TObject *_o=(obj); _o->tt=LUA_TFUNCTION; _o->value.cl=(x); }
|
||||
|
||||
#define sethvalue(obj,x) \
|
||||
{ TObject *_o=(obj); _o->tt=LUA_TTABLE; _o->value.h=(x); }
|
||||
|
||||
#define setnilvalue(obj) ((obj)->tt=LUA_TNIL)
|
||||
|
||||
#define setobj(obj1,obj2) \
|
||||
{ TObject *o1=(obj1); const TObject *o2=(obj2); \
|
||||
o1->tt=o2->tt; o1->value = o2->value; }
|
||||
|
||||
#define setttype(obj, tt) (ttype(obj) = (tt))
|
||||
|
||||
|
||||
|
||||
typedef TObject *StkId; /* index to stack elements */
|
||||
|
||||
|
||||
/*
|
||||
** String headers for string table
|
||||
*/
|
||||
typedef union TString {
|
||||
union L_Umaxalign dummy; /* ensures maximum alignment for strings */
|
||||
struct {
|
||||
lu_hash hash;
|
||||
size_t len;
|
||||
unsigned short constindex; /* hint to reuse constants */
|
||||
short marked;
|
||||
union TString *nexthash; /* chain for hash table */
|
||||
} tsv;
|
||||
} TString;
|
||||
|
||||
|
||||
#define getstr(ts) ((l_char *)((ts) + 1))
|
||||
#define svalue(o) getstr(tsvalue(o))
|
||||
|
||||
|
||||
|
||||
typedef union Udata {
|
||||
union L_Umaxalign dummy; /* ensures maximum alignment for `local' udata */
|
||||
struct {
|
||||
int tag; /* negative means `marked' (only during GC) */
|
||||
void *value;
|
||||
size_t len;
|
||||
union Udata *next; /* chain for list of all udata */
|
||||
} uv;
|
||||
} Udata;
|
||||
|
||||
|
||||
#define switchudatamark(u) ((u)->uv.tag = (-((u)->uv.tag+1)))
|
||||
#define ismarkedudata(u) ((u)->uv.tag < 0)
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** Function Prototypes
|
||||
*/
|
||||
typedef struct Proto {
|
||||
TObject *k; /* constants used by the function */
|
||||
int sizek; /* size of `k' */
|
||||
struct Proto **p; /* functions defined inside the function */
|
||||
int sizep; /* size of `p' */
|
||||
Instruction *code;
|
||||
int sizecode;
|
||||
short nupvalues;
|
||||
short numparams;
|
||||
short is_vararg;
|
||||
short maxstacksize;
|
||||
short marked;
|
||||
struct Proto *next;
|
||||
/* debug information */
|
||||
int *lineinfo; /* map from opcodes to source lines */
|
||||
int sizelineinfo; /* size of `lineinfo' */
|
||||
struct LocVar *locvars; /* information about local variables */
|
||||
int sizelocvars;
|
||||
int lineDefined;
|
||||
TString *source;
|
||||
} Proto;
|
||||
|
||||
|
||||
typedef struct LocVar {
|
||||
TString *varname;
|
||||
int startpc; /* first point where variable is active */
|
||||
int endpc; /* first point where variable is dead */
|
||||
} LocVar;
|
||||
|
||||
|
||||
/*
|
||||
** Closures
|
||||
*/
|
||||
typedef struct Closure {
|
||||
int isC; /* 0 for Lua functions, 1 for C functions */
|
||||
int nupvalues;
|
||||
union {
|
||||
lua_CFunction c; /* C functions */
|
||||
struct Proto *l; /* Lua functions */
|
||||
} f;
|
||||
struct Closure *next;
|
||||
struct Closure *mark; /* marked closures (point to itself when not marked) */
|
||||
TObject upvalue[1];
|
||||
} Closure;
|
||||
|
||||
|
||||
#define iscfunction(o) (ttype(o) == LUA_TFUNCTION && clvalue(o)->isC)
|
||||
|
||||
|
||||
typedef struct Node {
|
||||
struct Node *next; /* for chaining */
|
||||
TObject key;
|
||||
TObject val;
|
||||
} Node;
|
||||
|
||||
|
||||
typedef struct Hash {
|
||||
Node *node;
|
||||
int htag;
|
||||
int size;
|
||||
Node *firstfree; /* this position is free; all positions after it are full */
|
||||
struct Hash *next;
|
||||
struct Hash *mark; /* marked tables (point to itself when not marked) */
|
||||
int weakmode;
|
||||
} Hash;
|
||||
|
||||
|
||||
/* unmarked tables and closures are represented by pointing `mark' to
|
||||
** themselves
|
||||
*/
|
||||
#define ismarked(x) ((x)->mark != (x))
|
||||
|
||||
|
||||
/*
|
||||
** `module' operation for hashing (size is always a power of 2)
|
||||
*/
|
||||
#define lmod(s,size) ((int)((s) & ((size)-1)))
|
||||
|
||||
|
||||
/*
|
||||
** informations about a call (for debugging)
|
||||
*/
|
||||
typedef struct CallInfo {
|
||||
struct CallInfo *prev; /* linked list */
|
||||
StkId base; /* base for called function */
|
||||
const Instruction **pc; /* current pc of called function */
|
||||
int lastpc; /* last pc traced */
|
||||
int line; /* current line */
|
||||
int refi; /* current index in `lineinfo' */
|
||||
} CallInfo;
|
||||
|
||||
#define ci_func(ci) (clvalue((ci)->base - 1))
|
||||
|
||||
|
||||
extern const TObject luaO_nilobject;
|
||||
|
||||
|
||||
#define luaO_openspace(L,n,t) ((t *)luaO_openspaceaux(L,(n)*sizeof(t)))
|
||||
void *luaO_openspaceaux (lua_State *L, size_t n);
|
||||
|
||||
int luaO_equalObj (const TObject *t1, const TObject *t2);
|
||||
int luaO_str2d (const l_char *s, lua_Number *result);
|
||||
|
||||
void luaO_verror (lua_State *L, const l_char *fmt, ...);
|
||||
void luaO_chunkid (l_char *out, const l_char *source, int len);
|
||||
|
||||
|
||||
#endif
|
||||
107
lopcodes.c
107
lopcodes.c
@@ -1,107 +0,0 @@
|
||||
/*
|
||||
** $Id:$
|
||||
** extracted automatically from lopcodes.h by mkprint.lua
|
||||
** DO NOT EDIT
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
#define LUA_PRIVATE
|
||||
#include "lua.h"
|
||||
|
||||
#include "lopcodes.h"
|
||||
|
||||
|
||||
#ifdef LUA_OPNAMES
|
||||
|
||||
const l_char *const luaP_opnames[] = {
|
||||
l_s("MOVE"),
|
||||
l_s("LOADK"),
|
||||
l_s("LOADINT"),
|
||||
l_s("LOADNIL"),
|
||||
l_s("LOADUPVAL"),
|
||||
l_s("GETGLOBAL"),
|
||||
l_s("GETTABLE"),
|
||||
l_s("SETGLOBAL"),
|
||||
l_s("SETTABLE"),
|
||||
l_s("NEWTABLE"),
|
||||
l_s("SELF"),
|
||||
l_s("ADD"),
|
||||
l_s("SUB"),
|
||||
l_s("MUL"),
|
||||
l_s("DIV"),
|
||||
l_s("POW"),
|
||||
l_s("UNM"),
|
||||
l_s("NOT"),
|
||||
l_s("CONCAT"),
|
||||
l_s("JMP"),
|
||||
l_s("CJMP"),
|
||||
l_s("TESTEQ"),
|
||||
l_s("TESTNE"),
|
||||
l_s("TESTLT"),
|
||||
l_s("TESTLE"),
|
||||
l_s("TESTGT"),
|
||||
l_s("TESTGE"),
|
||||
l_s("TESTT"),
|
||||
l_s("TESTF"),
|
||||
l_s("NILJMP"),
|
||||
l_s("CALL"),
|
||||
l_s("RETURN"),
|
||||
l_s("FORPREP"),
|
||||
l_s("FORLOOP"),
|
||||
l_s("TFORPREP"),
|
||||
l_s("TFORLOOP"),
|
||||
l_s("SETLIST"),
|
||||
l_s("SETLISTO"),
|
||||
l_s("CLOSURE")
|
||||
};
|
||||
|
||||
#endif
|
||||
|
||||
#define opmode(t,x,b,c,sa,k,m) (((t)<<OpModeT) | \
|
||||
((b)<<OpModeBreg) | ((c)<<OpModeCreg) | \
|
||||
((sa)<<OpModesetA) | ((k)<<OpModeK) | (m))
|
||||
|
||||
const lu_byte luaP_opmodes[] = {
|
||||
/* T _ B C sA K mode opcode */
|
||||
opmode(0,0,1,0, 1,0,iABC) /* OP_MOVE */
|
||||
,opmode(0,0,0,0, 1,1,iABc) /* OP_LOADK */
|
||||
,opmode(0,0,0,0, 1,0,iAsBc) /* OP_LOADINT */
|
||||
,opmode(0,0,1,0, 1,0,iABC) /* OP_LOADNIL */
|
||||
,opmode(0,0,0,0, 1,0,iABc) /* OP_LOADUPVAL */
|
||||
,opmode(0,0,0,0, 1,1,iABc) /* OP_GETGLOBAL */
|
||||
,opmode(0,0,1,1, 1,0,iABC) /* OP_GETTABLE */
|
||||
,opmode(0,0,0,0, 0,1,iABc) /* OP_SETGLOBAL */
|
||||
,opmode(0,0,1,1, 0,0,iABC) /* OP_SETTABLE */
|
||||
,opmode(0,0,0,0, 1,0,iABc) /* OP_NEWTABLE */
|
||||
,opmode(0,0,1,1, 1,0,iABC) /* OP_SELF */
|
||||
,opmode(0,0,1,1, 1,0,iABC) /* OP_ADD */
|
||||
,opmode(0,0,1,1, 1,0,iABC) /* OP_SUB */
|
||||
,opmode(0,0,1,1, 1,0,iABC) /* OP_MUL */
|
||||
,opmode(0,0,1,1, 1,0,iABC) /* OP_DIV */
|
||||
,opmode(0,0,1,1, 1,0,iABC) /* OP_POW */
|
||||
,opmode(0,0,1,0, 1,0,iABC) /* OP_UNM */
|
||||
,opmode(0,0,1,0, 1,0,iABC) /* OP_NOT */
|
||||
,opmode(0,0,1,1, 1,0,iABC) /* OP_CONCAT */
|
||||
,opmode(0,0,0,0, 0,0,iAsBc) /* OP_JMP */
|
||||
,opmode(0,0,0,0, 0,0,iAsBc) /* OP_CJMP */
|
||||
,opmode(1,0,0,1, 0,0,iABC) /* OP_TESTEQ */
|
||||
,opmode(1,0,0,1, 0,0,iABC) /* OP_TESTNE */
|
||||
,opmode(1,0,0,1, 0,0,iABC) /* OP_TESTLT */
|
||||
,opmode(1,0,0,1, 0,0,iABC) /* OP_TESTLE */
|
||||
,opmode(1,0,0,1, 0,0,iABC) /* OP_TESTGT */
|
||||
,opmode(1,0,0,1, 0,0,iABC) /* OP_TESTGE */
|
||||
,opmode(1,0,1,0, 1,0,iABC) /* OP_TESTT */
|
||||
,opmode(1,0,1,0, 1,0,iABC) /* OP_TESTF */
|
||||
,opmode(0,0,0,0, 1,0,iABc) /* OP_NILJMP */
|
||||
,opmode(0,0,0,0, 0,0,iABC) /* OP_CALL */
|
||||
,opmode(0,0,0,0, 0,0,iABC) /* OP_RETURN */
|
||||
,opmode(0,0,0,0, 0,0,iAsBc) /* OP_FORPREP */
|
||||
,opmode(0,0,0,0, 0,0,iAsBc) /* OP_FORLOOP */
|
||||
,opmode(0,0,0,0, 0,0,iAsBc) /* OP_TFORPREP */
|
||||
,opmode(0,0,0,0, 0,0,iAsBc) /* OP_TFORLOOP */
|
||||
,opmode(0,0,0,0, 0,0,iABc) /* OP_SETLIST */
|
||||
,opmode(0,0,0,0, 0,0,iABc) /* OP_SETLISTO */
|
||||
,opmode(0,0,0,0, 1,0,iABc) /* OP_CLOSURE */
|
||||
};
|
||||
|
||||
228
lopcodes.h
228
lopcodes.h
@@ -1,228 +0,0 @@
|
||||
/*
|
||||
** $Id: lopcodes.h,v 1.77 2001/07/03 17:01:34 roberto Exp roberto $
|
||||
** Opcodes for Lua virtual machine
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
#ifndef lopcodes_h
|
||||
#define lopcodes_h
|
||||
|
||||
#include "llimits.h"
|
||||
|
||||
|
||||
/*===========================================================================
|
||||
We assume that instructions are unsigned numbers.
|
||||
All instructions have an opcode in the first 6 bits.
|
||||
Instructions can have the following fields:
|
||||
`A' : 8 bits (25-32)
|
||||
`B' : 8 bits (17-24)
|
||||
`C' : 10 bits (7-16)
|
||||
`Bc' : 18 bits (`B' and `C' together)
|
||||
`sBc' : signed Bc
|
||||
|
||||
A signed argument is represented in excess K; that is, the number
|
||||
value is the unsigned value minus K. K is exactly the maximum value
|
||||
for that argument (so that -max is represented by 0, and +max is
|
||||
represented by 2*max), which is half the maximum for the corresponding
|
||||
unsigned argument.
|
||||
===========================================================================*/
|
||||
|
||||
|
||||
enum OpMode {iABC, iABc, iAsBc}; /* basic instruction format */
|
||||
|
||||
|
||||
/*
|
||||
** size and position of opcode arguments.
|
||||
*/
|
||||
#define SIZE_C 10
|
||||
#define SIZE_B 8
|
||||
#define SIZE_Bc (SIZE_C + SIZE_B)
|
||||
#define SIZE_A 8
|
||||
|
||||
#define SIZE_OP 6
|
||||
|
||||
#define POS_C SIZE_OP
|
||||
#define POS_B (POS_C + SIZE_C)
|
||||
#define POS_Bc POS_C
|
||||
#define POS_A (POS_B + SIZE_B)
|
||||
|
||||
|
||||
/*
|
||||
** limits for opcode arguments.
|
||||
** we use (signed) int to manipulate most arguments,
|
||||
** so they must fit in BITS_INT-1 bits (-1 for sign)
|
||||
*/
|
||||
#if SIZE_Bc < BITS_INT-1
|
||||
#define MAXARG_Bc ((1<<SIZE_Bc)-1)
|
||||
#define MAXARG_sBc (MAXARG_Bc>>1) /* `sBc' is signed */
|
||||
#else
|
||||
#define MAXARG_Bc MAX_INT
|
||||
#define MAXARG_sBc MAX_INT
|
||||
#endif
|
||||
|
||||
|
||||
#define MAXARG_A ((1<<SIZE_A)-1)
|
||||
#define MAXARG_B ((1<<SIZE_B)-1)
|
||||
#define MAXARG_C ((1<<SIZE_C)-1)
|
||||
|
||||
|
||||
/* creates a mask with `n' 1 bits at position `p' */
|
||||
#define MASK1(n,p) ((~((~(Instruction)0)<<n))<<p)
|
||||
|
||||
/* creates a mask with `n' 0 bits at position `p' */
|
||||
#define MASK0(n,p) (~MASK1(n,p))
|
||||
|
||||
/*
|
||||
** the following macros help to manipulate instructions
|
||||
*/
|
||||
|
||||
#define GET_OPCODE(i) ((OpCode)((i)&MASK1(SIZE_OP,0)))
|
||||
#define SET_OPCODE(i,o) (((i)&MASK0(SIZE_OP,0)) | (Instruction)(o))
|
||||
|
||||
#define GETARG_A(i) ((int)((i)>>POS_A))
|
||||
#define SETARG_A(i,u) ((i) = (((i)&MASK0(SIZE_A,POS_A)) | \
|
||||
((Instruction)(u)<<POS_A)))
|
||||
|
||||
#define GETARG_B(i) ((int)(((i)>>POS_B) & MASK1(SIZE_B,0)))
|
||||
#define SETARG_B(i,b) ((i) = (((i)&MASK0(SIZE_B,POS_B)) | \
|
||||
((Instruction)(b)<<POS_B)))
|
||||
|
||||
#define GETARG_C(i) ((int)(((i)>>POS_C) & MASK1(SIZE_C,0)))
|
||||
#define SETARG_C(i,b) ((i) = (((i)&MASK0(SIZE_C,POS_C)) | \
|
||||
((Instruction)(b)<<POS_C)))
|
||||
|
||||
#define GETARG_Bc(i) ((int)(((i)>>POS_Bc) & MASK1(SIZE_Bc,0)))
|
||||
#define SETARG_Bc(i,b) ((i) = (((i)&MASK0(SIZE_Bc,POS_Bc)) | \
|
||||
((Instruction)(b)<<POS_Bc)))
|
||||
|
||||
#define GETARG_sBc(i) (GETARG_Bc(i)-MAXARG_sBc)
|
||||
#define SETARG_sBc(i,b) SETARG_Bc((i),(unsigned int)((b)+MAXARG_sBc))
|
||||
|
||||
|
||||
#define CREATE_ABC(o,a,b,c) ((Instruction)(o) \
|
||||
| ((Instruction)(a)<<POS_A) \
|
||||
| ((Instruction)(b)<<POS_B) \
|
||||
| ((Instruction)(c)<<POS_C))
|
||||
|
||||
#define CREATE_ABc(o,a,bc) ((Instruction)(o) \
|
||||
| ((Instruction)(a)<<POS_A) \
|
||||
| ((Instruction)(bc)<<POS_Bc))
|
||||
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** an invalid register that fits in 8 bits
|
||||
*/
|
||||
#define NO_REG MAXARG_A
|
||||
|
||||
|
||||
/*
|
||||
** R(x) - register
|
||||
** Kst(x) - constant (in constant table)
|
||||
** R/K(x) == if x < MAXSTACK then R(x) else Kst(x-MAXSTACK)
|
||||
*/
|
||||
|
||||
typedef enum {
|
||||
/*----------------------------------------------------------------------
|
||||
name args description
|
||||
------------------------------------------------------------------------*/
|
||||
OP_MOVE,/* A B R(A) := R(B) */
|
||||
OP_LOADK,/* A Bc R(A) := Kst(Bc) */
|
||||
OP_LOADINT,/* A sBc R(A) := (Number)sBc */
|
||||
OP_LOADNIL,/* A B R(A) := ... := R(B) := nil */
|
||||
OP_LOADUPVAL,/* A Bc R(A) := UpValue[Bc] */
|
||||
|
||||
OP_GETGLOBAL,/* A Bc R(A) := Gbl[Kst(Bc)] */
|
||||
OP_GETTABLE,/* A B C R(A) := R(B)[R/K(C)] */
|
||||
|
||||
OP_SETGLOBAL,/* A Bc Gbl[Kst(Bc)] := R(A) */
|
||||
OP_SETTABLE,/* A B C R(B)[R/K(C)] := R(A) */
|
||||
|
||||
OP_NEWTABLE,/* A Bc R(A) := {} (size = Bc) */
|
||||
|
||||
OP_SELF,/* A B C R(A+1) := R(B); R(A) := R(B)[R/K(C)] */
|
||||
|
||||
OP_ADD,/* A B C R(A) := R(B) + R/K(C) */
|
||||
OP_SUB,/* A B C R(A) := R(B) - R/K(C) */
|
||||
OP_MUL,/* A B C R(A) := R(B) * R/K(C) */
|
||||
OP_DIV,/* A B C R(A) := R(B) / R/K(C) */
|
||||
OP_POW,/* A B C R(A) := R(B) ^ R/K(C) */
|
||||
OP_UNM,/* A B R(A) := -R(B) */
|
||||
OP_NOT,/* A B R(A) := not R(B) */
|
||||
|
||||
OP_CONCAT,/* A B C R(A) := R(B).. ... ..R(C) */
|
||||
|
||||
OP_JMP,/* sBc PC += sBc */
|
||||
OP_CJMP,/* sBc if test then PC += sBc (see (1)) */
|
||||
|
||||
OP_TESTEQ,/* A C test := (R(A) == R/K(C)) */
|
||||
OP_TESTNE,/* A C test := (R(A) ~= R/K(C)) */
|
||||
OP_TESTLT,/* A C test := (R(A) < R/K(C)) */
|
||||
OP_TESTLE,/* A C test := (R(A) <= R/K(C)) */
|
||||
OP_TESTGT,/* A C test := (R(A) > R/K(C)) */
|
||||
OP_TESTGE,/* A C test := (R(A) >= R/K(C)) */
|
||||
|
||||
OP_TESTT,/* A B test := R(B); if (test) R(A) := R(B) */
|
||||
OP_TESTF,/* A B test := not R(B); if (test) R(A) := nil */
|
||||
|
||||
OP_NILJMP,/* A Bc R(A) := nil; PC++; */
|
||||
|
||||
OP_CALL,/* A B C R(A), ... ,R(A+C-1) := R(A)(R(A+1), ... ,R(A+B))*/
|
||||
OP_RETURN,/* A B return R(A), ... ,R(A+B-1) (see (3)) */
|
||||
|
||||
OP_FORPREP,/* A sBc */
|
||||
OP_FORLOOP,/* A sBc */
|
||||
|
||||
OP_TFORPREP,/* A sBc */
|
||||
OP_TFORLOOP,/* A sBc */
|
||||
|
||||
OP_SETLIST,/* A Bc R(A)[Bc-Bc%FPF+i] := R(A+i), 1 <= i <= Bc%FPF+1 */
|
||||
OP_SETLISTO,/* A Bc */
|
||||
|
||||
OP_CLOSURE /* A Bc R(A) := closure(KPROTO[Bc], R(A), ... ,R(A+n)) */
|
||||
} OpCode;
|
||||
|
||||
|
||||
#define NUM_OPCODES ((int)OP_CLOSURE+1)
|
||||
|
||||
|
||||
|
||||
/*===========================================================================
|
||||
Notes:
|
||||
(1) In the current implementation there is no `test' variable;
|
||||
instructions OP_TEST* and OP_CJMP must always occur together.
|
||||
|
||||
(2) In OP_CALL, if (B == NO_REG) then B = top. C is the number of returns,
|
||||
and can be NO_REG. OP_CALL can set `top' to last_result+1, so
|
||||
next open instruction (OP_CALL, OP_RETURN, OP_SETLIST) may use `top'.
|
||||
|
||||
(3) In OP_RETURN, if (B == NO_REG) then return up to `top'
|
||||
===========================================================================*/
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** masks for instruction properties
|
||||
*/
|
||||
enum OpModeMask {
|
||||
OpModeBreg = 2, /* B is a register */
|
||||
OpModeCreg, /* C is a register/constant */
|
||||
OpModesetA, /* instruction set register A */
|
||||
OpModeK, /* Bc is a constant */
|
||||
OpModeT /* operator is a test */
|
||||
};
|
||||
|
||||
extern const lu_byte luaP_opmodes[];
|
||||
|
||||
#define getOpMode(m) ((enum OpMode)(luaP_opmodes[m] & 3))
|
||||
#define testOpMode(m, b) (luaP_opmodes[m] & (1 << (b)))
|
||||
|
||||
|
||||
/*
|
||||
** opcode names (only included when compiled with LUA_OPNAMES)
|
||||
*/
|
||||
extern const l_char *const luaP_opnames[];
|
||||
|
||||
|
||||
#endif
|
||||
70
lparser.h
70
lparser.h
@@ -1,70 +0,0 @@
|
||||
/*
|
||||
** $Id: lparser.h,v 1.31 2001/06/05 18:17:01 roberto Exp roberto $
|
||||
** LL(1) Parser and code generator for Lua
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
#ifndef lparser_h
|
||||
#define lparser_h
|
||||
|
||||
#include "lobject.h"
|
||||
#include "lzio.h"
|
||||
|
||||
|
||||
/*
|
||||
** Expression descriptor
|
||||
*/
|
||||
|
||||
typedef enum {
|
||||
VVOID, /* no value */
|
||||
VNIL,
|
||||
VNUMBER, /* n = value */
|
||||
VK, /* info = index of constant in `k' */
|
||||
VGLOBAL, /* info = index of global name in `k' */
|
||||
VLOCAL, /* info = local register */
|
||||
VINDEXED, /* info = table register; aux = index register (or `k') */
|
||||
VRELOCABLE, /* info = instruction pc */
|
||||
VNONRELOC, /* info = result register */
|
||||
VJMP, /* info = result register */
|
||||
VCALL /* info = result register */
|
||||
} expkind;
|
||||
|
||||
typedef struct expdesc {
|
||||
expkind k;
|
||||
union {
|
||||
struct {
|
||||
int info, aux;
|
||||
} i;
|
||||
lua_Number n;
|
||||
} u;
|
||||
int t; /* patch list of `exit when true' */
|
||||
int f; /* patch list of `exit when false' */
|
||||
} expdesc;
|
||||
|
||||
|
||||
/* state needed to generate code for a given function */
|
||||
typedef struct FuncState {
|
||||
Proto *f; /* current function header */
|
||||
struct FuncState *prev; /* enclosing function */
|
||||
struct LexState *ls; /* lexical state */
|
||||
struct lua_State *L; /* copy of the Lua state */
|
||||
int pc; /* next position to code (equivalent to `ncode') */
|
||||
int lasttarget; /* `pc' of last `jump target' */
|
||||
int jlt; /* list of jumps to `lasttarget' */
|
||||
int freereg; /* first free register */
|
||||
int nk; /* number of elements in `k' */
|
||||
int np; /* number of elements in `p' */
|
||||
int nlineinfo; /* number of elements in `lineinfo' */
|
||||
int nlocvars; /* number of elements in `locvars' */
|
||||
int nactloc; /* number of active local variables */
|
||||
int lastline; /* line where last `lineinfo' was generated */
|
||||
struct Breaklabel *bl; /* chain of breakable blocks */
|
||||
expdesc upvalues[MAXUPVALUES]; /* upvalues */
|
||||
int actloc[MAXLOCALS]; /* local-variable stack (indices to locvars) */
|
||||
} FuncState;
|
||||
|
||||
|
||||
Proto *luaY_parser (lua_State *L, ZIO *z);
|
||||
|
||||
|
||||
#endif
|
||||
142
lstate.c
142
lstate.c
@@ -1,142 +0,0 @@
|
||||
/*
|
||||
** $Id: lstate.c,v 1.65 2001/06/21 16:41:34 roberto Exp roberto $
|
||||
** Global State
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
#include <stdio.h>
|
||||
|
||||
#define LUA_PRIVATE
|
||||
#include "lua.h"
|
||||
|
||||
#include "ldo.h"
|
||||
#include "lgc.h"
|
||||
#include "llex.h"
|
||||
#include "lmem.h"
|
||||
#include "lstate.h"
|
||||
#include "lstring.h"
|
||||
#include "ltable.h"
|
||||
#include "ltm.h"
|
||||
|
||||
|
||||
struct Sopen {
|
||||
int stacksize;
|
||||
lua_State *L;
|
||||
};
|
||||
|
||||
|
||||
static void close_state (lua_State *L, lua_State *OL);
|
||||
|
||||
|
||||
/*
|
||||
** open parts that may cause memory-allocation errors
|
||||
*/
|
||||
static void f_luaopen (lua_State *L, void *ud) {
|
||||
struct Sopen *so = (struct Sopen *)ud;
|
||||
if (so->stacksize == 0)
|
||||
so->stacksize = DEFAULT_STACK_SIZE;
|
||||
else
|
||||
so->stacksize += LUA_MINSTACK;
|
||||
if (so->L != NULL) { /* shared global state? */
|
||||
L->G = G(so->L);
|
||||
L->gt = so->L->gt; /* share table of globals */
|
||||
so->L->next->previous = L; /* insert L into linked list */
|
||||
L->next = so->L->next;
|
||||
so->L->next = L;
|
||||
L->previous = so->L;
|
||||
luaD_init(L, so->stacksize); /* init stack */
|
||||
}
|
||||
else { /* create a new global state */
|
||||
L->G = luaM_new(L, global_State);
|
||||
G(L)->strt.size = 0;
|
||||
G(L)->strt.nuse = 0;
|
||||
G(L)->strt.hash = NULL;
|
||||
G(L)->Mbuffer = NULL;
|
||||
G(L)->Mbuffsize = 0;
|
||||
G(L)->rootproto = NULL;
|
||||
G(L)->rootcl = NULL;
|
||||
G(L)->roottable = NULL;
|
||||
G(L)->rootudata = NULL;
|
||||
G(L)->TMtable = NULL;
|
||||
G(L)->sizeTM = 0;
|
||||
G(L)->ntag = 0;
|
||||
G(L)->nblocks = sizeof(lua_State) + sizeof(global_State);
|
||||
luaD_init(L, so->stacksize); /* init stack */
|
||||
L->gt = luaH_new(L, 10); /* table of globals */
|
||||
G(L)->type2tag = luaH_new(L, 10);
|
||||
G(L)->registry = luaH_new(L, 0);
|
||||
G(L)->weakregistry = luaH_new(L, 0);
|
||||
/* make weakregistry weak */
|
||||
G(L)->weakregistry->weakmode = LUA_WEAK_KEY | LUA_WEAK_VALUE;
|
||||
luaS_resize(L, MINPOWER2);
|
||||
luaX_init(L);
|
||||
luaT_init(L);
|
||||
G(L)->GCthreshold = 4*G(L)->nblocks;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
LUA_API lua_State *lua_newthread (lua_State *OL, int stacksize) {
|
||||
struct Sopen so;
|
||||
lua_State *L;
|
||||
if (OL) lua_lock(OL);
|
||||
L = luaM_new(OL, lua_State);
|
||||
if (L) { /* allocation OK? */
|
||||
L->G = NULL;
|
||||
L->stack = NULL;
|
||||
L->stacksize = 0;
|
||||
L->ci = &L->basefunc;
|
||||
L->basefunc.prev = NULL;
|
||||
L->errorJmp = NULL;
|
||||
L->callhook = NULL;
|
||||
L->linehook = NULL;
|
||||
L->allowhooks = 1;
|
||||
L->next = L->previous = L;
|
||||
so.stacksize = stacksize;
|
||||
so.L = OL;
|
||||
if (luaD_runprotected(L, f_luaopen, &so) != 0) {
|
||||
/* memory allocation error: free partial state */
|
||||
close_state(L, OL);
|
||||
L = NULL;
|
||||
}
|
||||
}
|
||||
if (OL) lua_unlock(OL);
|
||||
return L;
|
||||
}
|
||||
|
||||
|
||||
static void close_state (lua_State *L, lua_State *OL) {
|
||||
if (OL != NULL) { /* are there other threads? */
|
||||
lua_assert(L->previous != L);
|
||||
L->previous->next = L->next;
|
||||
L->next->previous = L->previous;
|
||||
}
|
||||
else if (G(L)) { /* last thread; close global state */
|
||||
luaC_callallgcTM(L); /* call GC tag methods for all udata */
|
||||
luaC_collect(L, 1); /* collect all elements */
|
||||
lua_assert(G(L)->rootproto == NULL);
|
||||
lua_assert(G(L)->rootudata == NULL);
|
||||
lua_assert(G(L)->rootcl == NULL);
|
||||
lua_assert(G(L)->roottable == NULL);
|
||||
luaS_freeall(L);
|
||||
luaM_freearray(L, G(L)->TMtable, G(L)->sizeTM, struct TM);
|
||||
luaM_freearray(L, G(L)->Mbuffer, G(L)->Mbuffsize, l_char);
|
||||
luaM_freelem(NULL, L->G, global_State);
|
||||
}
|
||||
luaM_freearray(OL, L->stack, L->stacksize, TObject);
|
||||
luaM_freelem(OL, L, lua_State);
|
||||
}
|
||||
|
||||
LUA_API void lua_close (lua_State *L) {
|
||||
lua_State *OL;
|
||||
lua_assert(L != lua_state || lua_gettop(L) == 0);
|
||||
lua_lock(L);
|
||||
OL = L->next; /* any surviving thread (if there is one) */
|
||||
if (OL == L) OL = NULL; /* no surviving threads */
|
||||
close_state(L, OL);
|
||||
if (OL) lua_unlock(OL); /* cannot unlock over a freed state */
|
||||
lua_assert(L != lua_state || memdebug_numblocks == 0);
|
||||
lua_assert(L != lua_state || memdebug_total == 0);
|
||||
}
|
||||
|
||||
101
lstate.h
101
lstate.h
@@ -1,101 +0,0 @@
|
||||
/*
|
||||
** $Id: lstate.h,v 1.57 2001/06/06 18:00:19 roberto Exp roberto $
|
||||
** Global State
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
#ifndef lstate_h
|
||||
#define lstate_h
|
||||
|
||||
#include "lobject.h"
|
||||
#include "lua.h"
|
||||
#include "luadebug.h"
|
||||
|
||||
|
||||
/*
|
||||
** macros for thread syncronization inside Lua core machine:
|
||||
** all accesses to the global state and to global objects are syncronized.
|
||||
** Because threads can read the stack of other threads
|
||||
** (when running garbage collection),
|
||||
** a thread must also syncronize any write-access to its own stack.
|
||||
** Unsyncronized accesses are allowed only when reading its own stack,
|
||||
** or when reading immutable fields from global objects
|
||||
** (such as string values and udata values).
|
||||
*/
|
||||
#ifndef lua_lock
|
||||
#define lua_lock(L) ((void) 0)
|
||||
#endif
|
||||
|
||||
#ifndef lua_unlock
|
||||
#define lua_unlock(L) ((void) 0)
|
||||
#endif
|
||||
|
||||
/*
|
||||
** macro to allow the inclusion of user information in Lua state
|
||||
*/
|
||||
#ifndef LUA_USERSTATE
|
||||
#define LUA_USERSTATE
|
||||
#endif
|
||||
|
||||
|
||||
|
||||
struct lua_longjmp; /* defined in ldo.c */
|
||||
struct TM; /* defined in ltm.h */
|
||||
|
||||
|
||||
typedef struct stringtable {
|
||||
int size;
|
||||
ls_nstr nuse; /* number of elements */
|
||||
TString **hash;
|
||||
} stringtable;
|
||||
|
||||
|
||||
/*
|
||||
** `global state', shared by all threads of this state
|
||||
*/
|
||||
typedef struct global_State {
|
||||
void *Mbuffer; /* global buffer */
|
||||
size_t Mbuffsize; /* size of Mbuffer */
|
||||
Proto *rootproto; /* list of all prototypes */
|
||||
Closure *rootcl; /* list of all closures */
|
||||
Hash *roottable; /* list of all tables */
|
||||
Udata *rootudata; /* list of all userdata */
|
||||
stringtable strt; /* hash table for strings */
|
||||
Hash *type2tag; /* hash table from type names to tags */
|
||||
Hash *registry; /* (strong) registry table */
|
||||
Hash *weakregistry; /* weakregistry table */
|
||||
struct TM *TMtable; /* table for tag methods */
|
||||
int sizeTM; /* size of TMtable */
|
||||
int ntag; /* number of tags in TMtable */
|
||||
lu_mem GCthreshold;
|
||||
lu_mem nblocks; /* number of `bytes' currently allocated */
|
||||
} global_State;
|
||||
|
||||
|
||||
/*
|
||||
** `per thread' state
|
||||
*/
|
||||
struct lua_State {
|
||||
LUA_USERSTATE
|
||||
StkId top; /* first free slot in the stack */
|
||||
CallInfo *ci; /* call info for current function */
|
||||
StkId stack_last; /* last free slot in the stack */
|
||||
Hash *gt; /* table for globals */
|
||||
global_State *G;
|
||||
StkId stack; /* stack base */
|
||||
int stacksize;
|
||||
lua_Hook callhook;
|
||||
lua_Hook linehook;
|
||||
int allowhooks;
|
||||
struct lua_longjmp *errorJmp; /* current error recover point */
|
||||
lua_State *next; /* circular double linked list of states */
|
||||
lua_State *previous;
|
||||
CallInfo basefunc;
|
||||
};
|
||||
|
||||
|
||||
#define G(L) (L->G)
|
||||
|
||||
|
||||
#endif
|
||||
|
||||
98
lstring.c
98
lstring.c
@@ -1,98 +0,0 @@
|
||||
/*
|
||||
** $Id: lstring.c,v 1.64 2001/06/07 15:01:21 roberto Exp roberto $
|
||||
** String table (keeps all strings handled by Lua)
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
#include <string.h>
|
||||
|
||||
#define LUA_PRIVATE
|
||||
#include "lua.h"
|
||||
|
||||
#include "lmem.h"
|
||||
#include "lobject.h"
|
||||
#include "lstate.h"
|
||||
#include "lstring.h"
|
||||
|
||||
|
||||
|
||||
void luaS_freeall (lua_State *L) {
|
||||
lua_assert(G(L)->strt.nuse==0);
|
||||
luaM_freearray(L, G(L)->strt.hash, G(L)->strt.size, TString *);
|
||||
}
|
||||
|
||||
|
||||
void luaS_resize (lua_State *L, int newsize) {
|
||||
TString **newhash = luaM_newvector(L, newsize, TString *);
|
||||
stringtable *tb = &G(L)->strt;
|
||||
int i;
|
||||
for (i=0; i<newsize; i++) newhash[i] = NULL;
|
||||
/* rehash */
|
||||
for (i=0; i<tb->size; i++) {
|
||||
TString *p = tb->hash[i];
|
||||
while (p) { /* for each node in the list */
|
||||
TString *next = p->tsv.nexthash; /* save next */
|
||||
lu_hash h = p->tsv.hash;
|
||||
int h1 = lmod(h, newsize); /* new position */
|
||||
lua_assert((int)(h%newsize) == lmod(h, newsize));
|
||||
p->tsv.nexthash = newhash[h1]; /* chain it in new position */
|
||||
newhash[h1] = p;
|
||||
p = next;
|
||||
}
|
||||
}
|
||||
luaM_freearray(L, tb->hash, tb->size, TString *);
|
||||
tb->size = newsize;
|
||||
tb->hash = newhash;
|
||||
}
|
||||
|
||||
|
||||
static TString *newlstr (lua_State *L, const l_char *str, size_t l, lu_hash h) {
|
||||
TString *ts = (TString *)luaM_malloc(L, sizestring(l));
|
||||
stringtable *tb;
|
||||
ts->tsv.nexthash = NULL;
|
||||
ts->tsv.len = l;
|
||||
ts->tsv.hash = h;
|
||||
ts->tsv.marked = 0;
|
||||
ts->tsv.constindex = 0;
|
||||
memcpy(getstr(ts), str, l*sizeof(l_char));
|
||||
getstr(ts)[l] = l_c('\0'); /* ending 0 */
|
||||
tb = &G(L)->strt;
|
||||
h = lmod(h, tb->size);
|
||||
ts->tsv.nexthash = tb->hash[h]; /* chain new entry */
|
||||
tb->hash[h] = ts;
|
||||
tb->nuse++;
|
||||
if (tb->nuse > (ls_nstr)tb->size && tb->size <= MAX_INT/2)
|
||||
luaS_resize(L, tb->size*2); /* too crowded */
|
||||
return ts;
|
||||
}
|
||||
|
||||
|
||||
TString *luaS_newlstr (lua_State *L, const l_char *str, size_t l) {
|
||||
TString *ts;
|
||||
lu_hash h = l; /* seed */
|
||||
size_t step = (l>>5)+1; /* if string is too long, don't hash all its chars */
|
||||
size_t l1;
|
||||
for (l1=l; l1>=step; l1-=step) /* compute hash */
|
||||
h = h ^ ((h<<5)+(h>>2)+uchar(str[l1-1]));
|
||||
for (ts = G(L)->strt.hash[lmod(h, G(L)->strt.size)];
|
||||
ts != NULL;
|
||||
ts = ts->tsv.nexthash) {
|
||||
if (ts->tsv.len == l && (memcmp(str, getstr(ts), l) == 0))
|
||||
return ts;
|
||||
}
|
||||
return newlstr(L, str, l, h); /* not found */
|
||||
}
|
||||
|
||||
|
||||
Udata *luaS_newudata (lua_State *L, size_t s) {
|
||||
Udata *u = (Udata *)luaM_malloc(L, sizeudata(s));
|
||||
u->uv.len = s;
|
||||
u->uv.tag = 0;
|
||||
u->uv.value = u + 1;
|
||||
/* chain it on udata list */
|
||||
u->uv.next = G(L)->rootudata;
|
||||
G(L)->rootudata = u;
|
||||
return u;
|
||||
}
|
||||
|
||||
39
lstring.h
39
lstring.h
@@ -1,39 +0,0 @@
|
||||
/*
|
||||
** $Id: lstring.h,v 1.32 2001/06/06 18:00:19 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"
|
||||
#include "lstate.h"
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** any TString with mark>=FIXMARK is never collected.
|
||||
** Marks>=RESERVEDMARK are used to identify reserved words.
|
||||
*/
|
||||
#define FIXMARK 2
|
||||
#define RESERVEDMARK 3
|
||||
|
||||
|
||||
#define sizestring(l) ((lu_mem)sizeof(union TString)+ \
|
||||
((lu_mem)(l)+1)*sizeof(l_char))
|
||||
|
||||
#define sizeudata(l) ((lu_mem)sizeof(union Udata)+(l))
|
||||
|
||||
#define luaS_new(L, s) (luaS_newlstr(L, s, strlen(s)))
|
||||
#define luaS_newliteral(L, s) (luaS_newlstr(L, l_s("") s, \
|
||||
(sizeof(s)/sizeof(l_char))-1))
|
||||
|
||||
void luaS_resize (lua_State *L, int newsize);
|
||||
Udata *luaS_newudata (lua_State *L, size_t s);
|
||||
void luaS_freeall (lua_State *L);
|
||||
TString *luaS_newlstr (lua_State *L, const l_char *str, size_t l);
|
||||
|
||||
|
||||
#endif
|
||||
661
lstrlib.c
661
lstrlib.c
@@ -1,661 +0,0 @@
|
||||
/*
|
||||
** $Id: lstrlib.c,v 1.68 2001/03/26 14:31:49 roberto Exp roberto $
|
||||
** Standard library for string operations and pattern-matching
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
#include <ctype.h>
|
||||
#include <stddef.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
#define LUA_PRIVATE
|
||||
#include "lua.h"
|
||||
|
||||
#include "lauxlib.h"
|
||||
#include "lualib.h"
|
||||
|
||||
|
||||
typedef long sint32; /* a signed version for size_t */
|
||||
|
||||
|
||||
static int str_len (lua_State *L) {
|
||||
size_t l;
|
||||
luaL_check_lstr(L, 1, &l);
|
||||
lua_pushnumber(L, l);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static sint32 posrelat (sint32 pos, size_t len) {
|
||||
/* relative string position: negative means back from end */
|
||||
return (pos>=0) ? pos : (sint32)len+pos+1;
|
||||
}
|
||||
|
||||
|
||||
static int str_sub (lua_State *L) {
|
||||
size_t l;
|
||||
const l_char *s = luaL_check_lstr(L, 1, &l);
|
||||
sint32 start = posrelat(luaL_check_long(L, 2), l);
|
||||
sint32 end = posrelat(luaL_opt_long(L, 3, -1), l);
|
||||
if (start < 1) start = 1;
|
||||
if (end > (sint32)l) end = l;
|
||||
if (start <= end)
|
||||
lua_pushlstring(L, s+start-1, end-start+1);
|
||||
else lua_pushliteral(L, l_s(""));
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int str_lower (lua_State *L) {
|
||||
size_t l;
|
||||
size_t i;
|
||||
luaL_Buffer b;
|
||||
const l_char *s = luaL_check_lstr(L, 1, &l);
|
||||
luaL_buffinit(L, &b);
|
||||
for (i=0; i<l; i++)
|
||||
luaL_putchar(&b, tolower(uchar(s[i])));
|
||||
luaL_pushresult(&b);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int str_upper (lua_State *L) {
|
||||
size_t l;
|
||||
size_t i;
|
||||
luaL_Buffer b;
|
||||
const l_char *s = luaL_check_lstr(L, 1, &l);
|
||||
luaL_buffinit(L, &b);
|
||||
for (i=0; i<l; i++)
|
||||
luaL_putchar(&b, toupper(uchar(s[i])));
|
||||
luaL_pushresult(&b);
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int str_rep (lua_State *L) {
|
||||
size_t l;
|
||||
luaL_Buffer b;
|
||||
const l_char *s = luaL_check_lstr(L, 1, &l);
|
||||
int n = luaL_check_int(L, 2);
|
||||
luaL_buffinit(L, &b);
|
||||
while (n-- > 0)
|
||||
luaL_addlstring(&b, s, l);
|
||||
luaL_pushresult(&b);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int str_byte (lua_State *L) {
|
||||
size_t l;
|
||||
const l_char *s = luaL_check_lstr(L, 1, &l);
|
||||
sint32 pos = posrelat(luaL_opt_long(L, 2, 1), l);
|
||||
luaL_arg_check(L, 0<pos && (size_t)pos<=l, 2, l_s("out of range"));
|
||||
lua_pushnumber(L, uchar(s[pos-1]));
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int str_char (lua_State *L) {
|
||||
int n = lua_gettop(L); /* number of arguments */
|
||||
int i;
|
||||
luaL_Buffer b;
|
||||
luaL_buffinit(L, &b);
|
||||
for (i=1; i<=n; i++) {
|
||||
int c = luaL_check_int(L, i);
|
||||
luaL_arg_check(L, uchar(c) == c, i, l_s("invalid value"));
|
||||
luaL_putchar(&b, uchar(c));
|
||||
}
|
||||
luaL_pushresult(&b);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** {======================================================
|
||||
** PATTERN MATCHING
|
||||
** =======================================================
|
||||
*/
|
||||
|
||||
#ifndef MAX_CAPTURES
|
||||
#define MAX_CAPTURES 32 /* arbitrary limit */
|
||||
#endif
|
||||
|
||||
|
||||
#define CAP_UNFINISHED (-1)
|
||||
#define CAP_POSITION (-2)
|
||||
|
||||
typedef struct MatchState {
|
||||
const l_char *src_init; /* init of source string */
|
||||
const l_char *src_end; /* end (`\0') of source string */
|
||||
int level; /* total number of captures (finished or unfinished) */
|
||||
struct {
|
||||
const l_char *init;
|
||||
sint32 len;
|
||||
} capture[MAX_CAPTURES];
|
||||
lua_State *L;
|
||||
} MatchState;
|
||||
|
||||
|
||||
#define ESC l_c('%')
|
||||
#define SPECIALS l_s("^$*+?.([%-")
|
||||
|
||||
|
||||
static int check_capture (MatchState *ms, int l) {
|
||||
l -= l_c('1');
|
||||
if (l < 0 || l >= ms->level || ms->capture[l].len == CAP_UNFINISHED)
|
||||
lua_error(ms->L, l_s("invalid capture index"));
|
||||
return l;
|
||||
}
|
||||
|
||||
|
||||
static int capture_to_close (MatchState *ms) {
|
||||
int level = ms->level;
|
||||
for (level--; level>=0; level--)
|
||||
if (ms->capture[level].len == CAP_UNFINISHED) return level;
|
||||
lua_error(ms->L, l_s("invalid pattern capture"));
|
||||
return 0; /* to avoid warnings */
|
||||
}
|
||||
|
||||
|
||||
static const l_char *luaI_classend (MatchState *ms, const l_char *p) {
|
||||
switch (*p++) {
|
||||
case ESC:
|
||||
if (*p == l_c('\0'))
|
||||
lua_error(ms->L, l_s("malformed pattern (ends with `%')"));
|
||||
return p+1;
|
||||
case l_c('['):
|
||||
if (*p == l_c('^')) p++;
|
||||
do { /* look for a `]' */
|
||||
if (*p == l_c('\0'))
|
||||
lua_error(ms->L, l_s("malformed pattern (missing `]')"));
|
||||
if (*(p++) == ESC && *p != l_c('\0'))
|
||||
p++; /* skip escapes (e.g. `%]') */
|
||||
} while (*p != l_c(']'));
|
||||
return p+1;
|
||||
default:
|
||||
return p;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static int match_class (l_char c, l_char cl) {
|
||||
int res;
|
||||
switch (tolower(uchar(cl))) {
|
||||
case l_c('a') : res = isalpha(uchar(c)); break;
|
||||
case l_c('c') : res = iscntrl(uchar(c)); break;
|
||||
case l_c('d') : res = isdigit(uchar(c)); break;
|
||||
case l_c('l') : res = islower(uchar(c)); break;
|
||||
case l_c('p') : res = ispunct(uchar(c)); break;
|
||||
case l_c('s') : res = isspace(uchar(c)); break;
|
||||
case l_c('u') : res = isupper(uchar(c)); break;
|
||||
case l_c('w') : res = isalnum(uchar(c)); break;
|
||||
case l_c('x') : res = isxdigit(uchar(c)); break;
|
||||
case l_c('z') : res = (c == l_c('\0')); break;
|
||||
default: return (cl == c);
|
||||
}
|
||||
return (islower(uchar(cl)) ? res : !res);
|
||||
}
|
||||
|
||||
|
||||
static int matchbracketclass (l_char c, const l_char *p, const l_char *ec) {
|
||||
int sig = 1;
|
||||
if (*(p+1) == l_c('^')) {
|
||||
sig = 0;
|
||||
p++; /* skip the `^' */
|
||||
}
|
||||
while (++p < ec) {
|
||||
if (*p == ESC) {
|
||||
p++;
|
||||
if (match_class(c, *p))
|
||||
return sig;
|
||||
}
|
||||
else if ((*(p+1) == l_c('-')) && (p+2 < ec)) {
|
||||
p+=2;
|
||||
if (uchar(*(p-2)) <= uchar(c) && uchar(c) <= uchar(*p))
|
||||
return sig;
|
||||
}
|
||||
else if (*p == c) return sig;
|
||||
}
|
||||
return !sig;
|
||||
}
|
||||
|
||||
|
||||
static int luaI_singlematch (l_char c, const l_char *p, const l_char *ep) {
|
||||
switch (*p) {
|
||||
case l_c('.'): /* matches any char */
|
||||
return 1;
|
||||
case ESC:
|
||||
return match_class(c, *(p+1));
|
||||
case l_c('['):
|
||||
return matchbracketclass(c, p, ep-1);
|
||||
default:
|
||||
return (*p == c);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static const l_char *match (MatchState *ms, const l_char *s, const l_char *p);
|
||||
|
||||
|
||||
static const l_char *matchbalance (MatchState *ms, const l_char *s,
|
||||
const l_char *p) {
|
||||
if (*p == 0 || *(p+1) == 0)
|
||||
lua_error(ms->L, l_s("unbalanced pattern"));
|
||||
if (*s != *p) return NULL;
|
||||
else {
|
||||
int b = *p;
|
||||
int e = *(p+1);
|
||||
int cont = 1;
|
||||
while (++s < ms->src_end) {
|
||||
if (*s == e) {
|
||||
if (--cont == 0) return s+1;
|
||||
}
|
||||
else if (*s == b) cont++;
|
||||
}
|
||||
}
|
||||
return NULL; /* string ends out of balance */
|
||||
}
|
||||
|
||||
|
||||
static const l_char *max_expand (MatchState *ms, const l_char *s,
|
||||
const l_char *p, const l_char *ep) {
|
||||
sint32 i = 0; /* counts maximum expand for item */
|
||||
while ((s+i)<ms->src_end && luaI_singlematch(*(s+i), p, ep))
|
||||
i++;
|
||||
/* keeps trying to match with the maximum repetitions */
|
||||
while (i>=0) {
|
||||
const l_char *res = match(ms, (s+i), ep+1);
|
||||
if (res) return res;
|
||||
i--; /* else didn't match; reduce 1 repetition to try again */
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
|
||||
static const l_char *min_expand (MatchState *ms, const l_char *s,
|
||||
const l_char *p, const l_char *ep) {
|
||||
for (;;) {
|
||||
const l_char *res = match(ms, s, ep+1);
|
||||
if (res != NULL)
|
||||
return res;
|
||||
else if (s<ms->src_end && luaI_singlematch(*s, p, ep))
|
||||
s++; /* try with one more repetition */
|
||||
else return NULL;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static const l_char *start_capture (MatchState *ms, const l_char *s,
|
||||
const l_char *p, int what) {
|
||||
const l_char *res;
|
||||
int level = ms->level;
|
||||
if (level >= MAX_CAPTURES) lua_error(ms->L, l_s("too many captures"));
|
||||
ms->capture[level].init = s;
|
||||
ms->capture[level].len = what;
|
||||
ms->level = level+1;
|
||||
if ((res=match(ms, s, p)) == NULL) /* match failed? */
|
||||
ms->level--; /* undo capture */
|
||||
return res;
|
||||
}
|
||||
|
||||
|
||||
static const l_char *end_capture (MatchState *ms, const l_char *s,
|
||||
const l_char *p) {
|
||||
int l = capture_to_close(ms);
|
||||
const l_char *res;
|
||||
ms->capture[l].len = s - ms->capture[l].init; /* close capture */
|
||||
if ((res = match(ms, s, p)) == NULL) /* match failed? */
|
||||
ms->capture[l].len = CAP_UNFINISHED; /* undo capture */
|
||||
return res;
|
||||
}
|
||||
|
||||
|
||||
static const l_char *match_capture (MatchState *ms, const l_char *s, int l) {
|
||||
size_t len;
|
||||
l = check_capture(ms, l);
|
||||
len = ms->capture[l].len;
|
||||
if ((size_t)(ms->src_end-s) >= len &&
|
||||
memcmp(ms->capture[l].init, s, len) == 0)
|
||||
return s+len;
|
||||
else return NULL;
|
||||
}
|
||||
|
||||
|
||||
static const l_char *match (MatchState *ms, const l_char *s, const l_char *p) {
|
||||
init: /* using goto's to optimize tail recursion */
|
||||
switch (*p) {
|
||||
case l_c('('): /* start capture */
|
||||
if (*(p+1) == l_c(')')) /* position capture? */
|
||||
return start_capture(ms, s, p+2, CAP_POSITION);
|
||||
else
|
||||
return start_capture(ms, s, p+1, CAP_UNFINISHED);
|
||||
case l_c(')'): /* end capture */
|
||||
return end_capture(ms, s, p+1);
|
||||
case ESC: /* may be %[0-9] or %b */
|
||||
if (isdigit(uchar(*(p+1)))) { /* capture? */
|
||||
s = match_capture(ms, s, *(p+1));
|
||||
if (s == NULL) return NULL;
|
||||
p+=2; goto init; /* else return match(ms, s, p+2) */
|
||||
}
|
||||
else if (*(p+1) == l_c('b')) { /* balanced string? */
|
||||
s = matchbalance(ms, s, p+2);
|
||||
if (s == NULL) return NULL;
|
||||
p+=4; goto init; /* else return match(ms, s, p+4); */
|
||||
}
|
||||
else goto dflt; /* case default */
|
||||
case l_c('\0'): /* end of pattern */
|
||||
return s; /* match succeeded */
|
||||
case l_c('$'):
|
||||
if (*(p+1) == l_c('\0')) /* is the `$' the last char in pattern? */
|
||||
return (s == ms->src_end) ? s : NULL; /* check end of string */
|
||||
else goto dflt;
|
||||
default: dflt: { /* it is a pattern item */
|
||||
const l_char *ep = luaI_classend(ms, p); /* points to what is next */
|
||||
int m = s<ms->src_end && luaI_singlematch(*s, p, ep);
|
||||
switch (*ep) {
|
||||
case l_c('?'): { /* optional */
|
||||
const l_char *res;
|
||||
if (m && ((res=match(ms, s+1, ep+1)) != NULL))
|
||||
return res;
|
||||
p=ep+1; goto init; /* else return match(ms, s, ep+1); */
|
||||
}
|
||||
case l_c('*'): /* 0 or more repetitions */
|
||||
return max_expand(ms, s, p, ep);
|
||||
case l_c('+'): /* 1 or more repetitions */
|
||||
return (m ? max_expand(ms, s+1, p, ep) : NULL);
|
||||
case l_c('-'): /* 0 or more repetitions (minimum) */
|
||||
return min_expand(ms, s, p, ep);
|
||||
default:
|
||||
if (!m) return NULL;
|
||||
s++; p=ep; goto init; /* else return match(ms, s+1, ep); */
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
static const l_char *lmemfind (const l_char *s1, size_t l1,
|
||||
const l_char *s2, size_t l2) {
|
||||
if (l2 == 0) return s1; /* empty strings are everywhere */
|
||||
else if (l2 > l1) return NULL; /* avoids a negative `l1' */
|
||||
else {
|
||||
const l_char *init; /* to search for a `*s2' inside `s1' */
|
||||
l2--; /* 1st char will be checked by `memchr' */
|
||||
l1 = l1-l2; /* `s2' cannot be found after that */
|
||||
while (l1 > 0 && (init = (const l_char *)memchr(s1, *s2, l1)) != NULL) {
|
||||
init++; /* 1st char is already checked */
|
||||
if (memcmp(init, s2+1, l2) == 0)
|
||||
return init-1;
|
||||
else { /* correct `l1' and `s1' to try again */
|
||||
l1 -= init-s1;
|
||||
s1 = init;
|
||||
}
|
||||
}
|
||||
return NULL; /* not found */
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void push_onecapture (MatchState *ms, int i) {
|
||||
int l = ms->capture[i].len;
|
||||
if (l == CAP_UNFINISHED) lua_error(ms->L, l_s("unfinished capture"));
|
||||
if (l == CAP_POSITION)
|
||||
lua_pushnumber(ms->L, ms->capture[i].init - ms->src_init + 1);
|
||||
else
|
||||
lua_pushlstring(ms->L, ms->capture[i].init, l);
|
||||
}
|
||||
|
||||
|
||||
static int push_captures (MatchState *ms) {
|
||||
int i;
|
||||
luaL_checkstack(ms->L, ms->level, l_s("too many captures"));
|
||||
for (i=0; i<ms->level; i++)
|
||||
push_onecapture(ms, i);
|
||||
return ms->level; /* number of strings pushed */
|
||||
}
|
||||
|
||||
|
||||
static int str_find (lua_State *L) {
|
||||
size_t l1, l2;
|
||||
const l_char *s = luaL_check_lstr(L, 1, &l1);
|
||||
const l_char *p = luaL_check_lstr(L, 2, &l2);
|
||||
sint32 init = posrelat(luaL_opt_long(L, 3, 1), l1) - 1;
|
||||
luaL_arg_check(L, 0 <= init && (size_t)init <= l1, 3, l_s("out of range"));
|
||||
if (lua_gettop(L) > 3 || /* extra argument? */
|
||||
strpbrk(p, SPECIALS) == NULL) { /* or no special characters? */
|
||||
const l_char *s2 = lmemfind(s+init, l1-init, p, l2);
|
||||
if (s2) {
|
||||
lua_pushnumber(L, s2-s+1);
|
||||
lua_pushnumber(L, s2-s+l2);
|
||||
return 2;
|
||||
}
|
||||
}
|
||||
else {
|
||||
MatchState ms;
|
||||
int anchor = (*p == l_c('^')) ? (p++, 1) : 0;
|
||||
const l_char *s1=s+init;
|
||||
ms.L = L;
|
||||
ms.src_init = s;
|
||||
ms.src_end = s+l1;
|
||||
do {
|
||||
const l_char *res;
|
||||
ms.level = 0;
|
||||
if ((res=match(&ms, s1, p)) != NULL) {
|
||||
lua_pushnumber(L, s1-s+1); /* start */
|
||||
lua_pushnumber(L, res-s); /* end */
|
||||
return push_captures(&ms) + 2;
|
||||
}
|
||||
} while (s1++<ms.src_end && !anchor);
|
||||
}
|
||||
lua_pushnil(L); /* not found */
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static void add_s (MatchState *ms, luaL_Buffer *b) {
|
||||
lua_State *L = ms->L;
|
||||
if (lua_isstring(L, 3)) {
|
||||
const l_char *news = lua_tostring(L, 3);
|
||||
size_t l = lua_strlen(L, 3);
|
||||
size_t i;
|
||||
for (i=0; i<l; i++) {
|
||||
if (news[i] != ESC)
|
||||
luaL_putchar(b, news[i]);
|
||||
else {
|
||||
i++; /* skip ESC */
|
||||
if (!isdigit(uchar(news[i])))
|
||||
luaL_putchar(b, news[i]);
|
||||
else {
|
||||
int level = check_capture(ms, news[i]);
|
||||
push_onecapture(ms, level);
|
||||
luaL_addvalue(b); /* add capture to accumulated result */
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
else { /* is a function */
|
||||
int n;
|
||||
lua_pushvalue(L, 3);
|
||||
n = push_captures(ms);
|
||||
lua_rawcall(L, n, 1);
|
||||
if (lua_isstring(L, -1))
|
||||
luaL_addvalue(b); /* add return to accumulated result */
|
||||
else
|
||||
lua_pop(L, 1); /* function result is not a string: pop it */
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static int str_gsub (lua_State *L) {
|
||||
size_t srcl;
|
||||
const l_char *src = luaL_check_lstr(L, 1, &srcl);
|
||||
const l_char *p = luaL_check_string(L, 2);
|
||||
int max_s = luaL_opt_int(L, 4, srcl+1);
|
||||
int anchor = (*p == l_c('^')) ? (p++, 1) : 0;
|
||||
int n = 0;
|
||||
MatchState ms;
|
||||
luaL_Buffer b;
|
||||
luaL_arg_check(L,
|
||||
lua_gettop(L) >= 3 && (lua_isstring(L, 3) || lua_isfunction(L, 3)),
|
||||
3, l_s("string or function expected"));
|
||||
luaL_buffinit(L, &b);
|
||||
ms.L = L;
|
||||
ms.src_init = src;
|
||||
ms.src_end = src+srcl;
|
||||
while (n < max_s) {
|
||||
const l_char *e;
|
||||
ms.level = 0;
|
||||
e = match(&ms, src, p);
|
||||
if (e) {
|
||||
n++;
|
||||
add_s(&ms, &b);
|
||||
}
|
||||
if (e && e>src) /* non empty match? */
|
||||
src = e; /* skip it */
|
||||
else if (src < ms.src_end)
|
||||
luaL_putchar(&b, *src++);
|
||||
else break;
|
||||
if (anchor) break;
|
||||
}
|
||||
luaL_addlstring(&b, src, ms.src_end-src);
|
||||
luaL_pushresult(&b);
|
||||
lua_pushnumber(L, n); /* number of substitutions */
|
||||
return 2;
|
||||
}
|
||||
|
||||
/* }====================================================== */
|
||||
|
||||
|
||||
/* maximum size of each formatted item (> len(format('%99.99f', -1e308))) */
|
||||
#define MAX_ITEM 512
|
||||
/* maximum size of each format specification (such as '%-099.99d') */
|
||||
#define MAX_FORMAT 20
|
||||
|
||||
|
||||
static void luaI_addquoted (lua_State *L, luaL_Buffer *b, int arg) {
|
||||
size_t l;
|
||||
const l_char *s = luaL_check_lstr(L, arg, &l);
|
||||
luaL_putchar(b, l_c('"'));
|
||||
while (l--) {
|
||||
switch (*s) {
|
||||
case l_c('"'): case l_c('\\'): case l_c('\n'):
|
||||
luaL_putchar(b, l_c('\\'));
|
||||
luaL_putchar(b, *s);
|
||||
break;
|
||||
case l_c('\0'): luaL_addlstring(b, l_s("\\000"), 4); break;
|
||||
default: luaL_putchar(b, *s);
|
||||
}
|
||||
s++;
|
||||
}
|
||||
luaL_putchar(b, l_c('"'));
|
||||
}
|
||||
|
||||
|
||||
static const l_char *scanformat (lua_State *L, const l_char *strfrmt,
|
||||
l_char *form, int *hasprecision) {
|
||||
const l_char *p = strfrmt;
|
||||
while (strchr(l_s("-+ #0"), *p)) p++; /* skip flags */
|
||||
if (isdigit(uchar(*p))) p++; /* skip width */
|
||||
if (isdigit(uchar(*p))) p++; /* (2 digits at most) */
|
||||
if (*p == l_c('.')) {
|
||||
p++;
|
||||
*hasprecision = 1;
|
||||
if (isdigit(uchar(*p))) p++; /* skip precision */
|
||||
if (isdigit(uchar(*p))) p++; /* (2 digits at most) */
|
||||
}
|
||||
if (isdigit(uchar(*p)))
|
||||
lua_error(L, l_s("invalid format (width or precision too long)"));
|
||||
if (p-strfrmt+2 > MAX_FORMAT) /* +2 to include `%' and the specifier */
|
||||
lua_error(L, l_s("invalid format (too long)"));
|
||||
form[0] = l_c('%');
|
||||
strncpy(form+1, strfrmt, p-strfrmt+1);
|
||||
form[p-strfrmt+2] = 0;
|
||||
return p;
|
||||
}
|
||||
|
||||
|
||||
static int str_format (lua_State *L) {
|
||||
int arg = 1;
|
||||
size_t sfl;
|
||||
const l_char *strfrmt = luaL_check_lstr(L, arg, &sfl);
|
||||
const l_char *strfrmt_end = strfrmt+sfl;
|
||||
luaL_Buffer b;
|
||||
luaL_buffinit(L, &b);
|
||||
while (strfrmt < strfrmt_end) {
|
||||
if (*strfrmt != l_c('%'))
|
||||
luaL_putchar(&b, *strfrmt++);
|
||||
else if (*++strfrmt == l_c('%'))
|
||||
luaL_putchar(&b, *strfrmt++); /* %% */
|
||||
else { /* format item */
|
||||
l_char form[MAX_FORMAT]; /* to store the format (`%...') */
|
||||
l_char buff[MAX_ITEM]; /* to store the formatted item */
|
||||
int hasprecision = 0;
|
||||
if (isdigit(uchar(*strfrmt)) && *(strfrmt+1) == l_c('$'))
|
||||
lua_error(L, l_s("obsolete `format' option (d$)"));
|
||||
arg++;
|
||||
strfrmt = scanformat(L, strfrmt, form, &hasprecision);
|
||||
switch (*strfrmt++) {
|
||||
case l_c('c'): case l_c('d'): case l_c('i'):
|
||||
sprintf(buff, form, luaL_check_int(L, arg));
|
||||
break;
|
||||
case l_c('o'): case l_c('u'): case l_c('x'): case l_c('X'):
|
||||
sprintf(buff, form, (unsigned int)luaL_check_number(L, arg));
|
||||
break;
|
||||
case l_c('e'): case l_c('E'): case l_c('f'):
|
||||
case l_c('g'): case l_c('G'):
|
||||
sprintf(buff, form, luaL_check_number(L, arg));
|
||||
break;
|
||||
case l_c('q'):
|
||||
luaI_addquoted(L, &b, arg);
|
||||
continue; /* skip the `addsize' at the end */
|
||||
case l_c('s'): {
|
||||
size_t l;
|
||||
const l_char *s = luaL_check_lstr(L, arg, &l);
|
||||
if (!hasprecision && l >= 100) {
|
||||
/* no precision and string is too long to be formatted;
|
||||
keep original string */
|
||||
lua_pushvalue(L, arg);
|
||||
luaL_addvalue(&b);
|
||||
continue; /* skip the `addsize' at the end */
|
||||
}
|
||||
else {
|
||||
sprintf(buff, form, s);
|
||||
break;
|
||||
}
|
||||
}
|
||||
default: /* also treat cases `pnLlh' */
|
||||
lua_error(L, l_s("invalid option in `format'"));
|
||||
}
|
||||
luaL_addlstring(&b, buff, strlen(buff));
|
||||
}
|
||||
}
|
||||
luaL_pushresult(&b);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static const luaL_reg strlib[] = {
|
||||
{l_s("strlen"), str_len},
|
||||
{l_s("strsub"), str_sub},
|
||||
{l_s("strlower"), str_lower},
|
||||
{l_s("strupper"), str_upper},
|
||||
{l_s("strchar"), str_char},
|
||||
{l_s("strrep"), str_rep},
|
||||
{l_s("strbyte"), str_byte},
|
||||
{l_s("format"), str_format},
|
||||
{l_s("strfind"), str_find},
|
||||
{l_s("gsub"), str_gsub}
|
||||
};
|
||||
|
||||
|
||||
/*
|
||||
** Open string library
|
||||
*/
|
||||
LUALIB_API int lua_strlibopen (lua_State *L) {
|
||||
luaL_openl(L, strlib);
|
||||
return 0;
|
||||
}
|
||||
302
ltable.c
302
ltable.c
@@ -1,302 +0,0 @@
|
||||
/*
|
||||
** $Id: ltable.c,v 1.82 2001/06/26 13:20:45 roberto Exp roberto $
|
||||
** Lua tables (hash)
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
/*
|
||||
** Implementation of tables (aka arrays, objects, or hash tables);
|
||||
** uses a mix of chained scatter table with Brent's variation.
|
||||
** A main invariant of these tables is that, if an element is not
|
||||
** in its main position (i.e. the `original' position that its hash gives
|
||||
** to it), then the colliding element is in its own main position.
|
||||
** In other words, there are collisions only when two elements have the
|
||||
** same main position (i.e. the same hash values for that table size).
|
||||
** Because of that, the load factor of these tables can be 100% without
|
||||
** performance penalties.
|
||||
*/
|
||||
|
||||
|
||||
#define LUA_PRIVATE
|
||||
#include "lua.h"
|
||||
|
||||
#include "ldo.h"
|
||||
#include "lmem.h"
|
||||
#include "lobject.h"
|
||||
#include "lstate.h"
|
||||
#include "ltable.h"
|
||||
|
||||
|
||||
|
||||
#define TagDefault LUA_TTABLE
|
||||
|
||||
|
||||
#define hashnum(t,n) (node(t, lmod((lu_hash)(ls_hash)(n), t->size)))
|
||||
#define hashstr(t,str) (node(t, lmod((str)->tsv.hash, t->size)))
|
||||
#define hashpointer(t,p) (node(t, lmod(IntPoint(p), t->size)))
|
||||
|
||||
|
||||
/*
|
||||
** returns the `main' position of an element in a table (that is, the index
|
||||
** of its hash value)
|
||||
*/
|
||||
Node *luaH_mainposition (const Hash *t, const TObject *key) {
|
||||
switch (ttype(key)) {
|
||||
case LUA_TNUMBER:
|
||||
return hashnum(t, nvalue(key));
|
||||
case LUA_TSTRING:
|
||||
return hashstr(t, tsvalue(key));
|
||||
default: /* all other types are hashed as (void *) */
|
||||
return hashpointer(t, tsvalue(key));
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
Node *luaH_next (lua_State *L, Hash *t, const TObject *key) {
|
||||
int i;
|
||||
if (ttype(key) == LUA_TNIL)
|
||||
i = 0; /* first iteration */
|
||||
else {
|
||||
const TObject *v = luaH_get(t, key);
|
||||
if (v == &luaO_nilobject)
|
||||
luaD_error(L, l_s("invalid key for `next'"));
|
||||
i = (int)(((const lu_byte *)v -
|
||||
(const lu_byte *)(val(node(t, 0)))) / sizeof(Node)) + 1;
|
||||
}
|
||||
for (; i<t->size; i++) {
|
||||
Node *n = node(t, i);
|
||||
if (ttype(val(n)) != LUA_TNIL)
|
||||
return n;
|
||||
}
|
||||
return NULL; /* no more elements */
|
||||
}
|
||||
|
||||
|
||||
int luaH_nexti (Hash *t, int i) {
|
||||
while ((++i)<t->size) {
|
||||
if (ttype(val(node(t, i))) != LUA_TNIL) /* a non-nil value? */
|
||||
return i;
|
||||
}
|
||||
return -1; /* no more elements */
|
||||
}
|
||||
|
||||
|
||||
#define check_grow(L, p, n) \
|
||||
if ((p) >= MAX_INT/(n)) luaD_error(L, l_s("table overflow"));
|
||||
|
||||
/*
|
||||
** returns smaller power of 2 larger than `n' (minimum is MINPOWER2)
|
||||
*/
|
||||
static int power2 (lua_State *L, int n) {
|
||||
int p = MINPOWER2;
|
||||
while (p <= n) {
|
||||
check_grow(L, p, 2);
|
||||
p *= 2;
|
||||
}
|
||||
return p;
|
||||
}
|
||||
|
||||
|
||||
static void setnodevector (lua_State *L, Hash *t, int size) {
|
||||
int i;
|
||||
t->node = luaM_newvector(L, size, Node);
|
||||
for (i=0; i<size; i++) {
|
||||
t->node[i].next = NULL;
|
||||
setnilvalue(key(node(t, i)));
|
||||
setnilvalue(val(node(t, i)));
|
||||
}
|
||||
t->size = size;
|
||||
t->firstfree = node(t, size-1); /* first free position to be used */
|
||||
}
|
||||
|
||||
|
||||
Hash *luaH_new (lua_State *L, int size) {
|
||||
Hash *t = luaM_new(L, Hash);
|
||||
t->htag = TagDefault;
|
||||
t->next = G(L)->roottable;
|
||||
G(L)->roottable = t;
|
||||
t->mark = t;
|
||||
t->size = 0;
|
||||
t->weakmode = 0;
|
||||
t->node = NULL;
|
||||
setnodevector(L, t, power2(L, size));
|
||||
return t;
|
||||
}
|
||||
|
||||
|
||||
void luaH_free (lua_State *L, Hash *t) {
|
||||
luaM_freearray(L, t->node, t->size, Node);
|
||||
luaM_freelem(L, t, Hash);
|
||||
}
|
||||
|
||||
|
||||
static int numuse (const Hash *t) {
|
||||
Node *v = t->node;
|
||||
int size = t->size;
|
||||
int realuse = 0;
|
||||
int i;
|
||||
for (i=0; i<size; i++) {
|
||||
if (ttype(&v[i].val) != LUA_TNIL)
|
||||
realuse++;
|
||||
}
|
||||
return realuse;
|
||||
}
|
||||
|
||||
|
||||
static void rehash (lua_State *L, Hash *t) {
|
||||
int oldsize = t->size;
|
||||
Node *nold = t->node;
|
||||
int nelems = numuse(t);
|
||||
int i;
|
||||
lua_assert(nelems<=oldsize);
|
||||
if (nelems >= oldsize-oldsize/4) { /* using more than 3/4? */
|
||||
check_grow(L, oldsize, 2);
|
||||
setnodevector(L, t, oldsize*2); /* grow array */
|
||||
}
|
||||
else if (nelems <= oldsize/4 && /* less than 1/4? */
|
||||
oldsize > MINPOWER2)
|
||||
setnodevector(L, t, oldsize/2); /* shrink array */
|
||||
else
|
||||
setnodevector(L, t, oldsize); /* just rehash; keep the same size */
|
||||
for (i=0; i<oldsize; i++) {
|
||||
Node *old = nold+i;
|
||||
if (ttype(val(old)) != LUA_TNIL) {
|
||||
TObject *v = luaH_set(L, t, key(old));
|
||||
setobj(v, val(old));
|
||||
}
|
||||
}
|
||||
luaM_freearray(L, nold, oldsize, Node); /* free old array */
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** inserts a new key into a hash table; first, check whether key's main
|
||||
** position is free. If not, check whether colliding node is in its main
|
||||
** position or not: if it is not, move colliding node to an empty place and
|
||||
** put new key in its main position; otherwise (colliding node is in its main
|
||||
** position), new key goes to an empty position.
|
||||
*/
|
||||
static TObject *newkey (lua_State *L, Hash *t, const TObject *key) {
|
||||
Node *mp = luaH_mainposition(t, key);
|
||||
if (ttype(val(mp)) != LUA_TNIL) { /* main position is not free? */
|
||||
Node *othern = luaH_mainposition(t, key(mp)); /* `mp' of colliding node */
|
||||
Node *n = t->firstfree; /* get a free place */
|
||||
if (othern != mp) { /* is colliding node out of its main position? */
|
||||
/* yes; move colliding node into free position */
|
||||
while (othern->next != mp) othern = othern->next; /* find previous */
|
||||
othern->next = n; /* redo the chain with `n' in place of `mp' */
|
||||
*n = *mp; /* copy colliding node into free pos. (mp->next also goes) */
|
||||
mp->next = NULL; /* now `mp' is free */
|
||||
setnilvalue(val(mp));
|
||||
}
|
||||
else { /* colliding node is in its own main position */
|
||||
/* new node will go into free position */
|
||||
n->next = mp->next; /* chain new position */
|
||||
mp->next = n;
|
||||
mp = n;
|
||||
}
|
||||
}
|
||||
setobj(key(mp), key);
|
||||
lua_assert(ttype(val(mp)) == LUA_TNIL);
|
||||
for (;;) { /* correct `firstfree' */
|
||||
if (ttype(key(t->firstfree)) == LUA_TNIL)
|
||||
return val(mp); /* OK; table still has a free place */
|
||||
else if (t->firstfree == t->node) break; /* cannot decrement from here */
|
||||
else (t->firstfree)--;
|
||||
}
|
||||
rehash(L, t); /* no more free places */
|
||||
return luaH_set(L, t, key); /* `rehash' invalidates this insertion */
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** generic search function
|
||||
*/
|
||||
static const TObject *luaH_getany (Hash *t, const TObject *key) {
|
||||
if (ttype(key) == LUA_TNIL) return &luaO_nilobject;
|
||||
else {
|
||||
Node *n = luaH_mainposition(t, key);
|
||||
do { /* check whether `key' is somewhere in the chain */
|
||||
if (luaO_equalObj(key(n), key)) return val(n); /* that's it */
|
||||
else n = n->next;
|
||||
} while (n);
|
||||
return &luaO_nilobject;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** search function for integers
|
||||
*/
|
||||
const TObject *luaH_getnum (Hash *t, int key) {
|
||||
Node *n = hashnum(t, key);
|
||||
do { /* check whether `key' is somewhere in the chain */
|
||||
if (ttype(key(n)) == LUA_TNUMBER && nvalue(key(n)) == (lua_Number)key)
|
||||
return val(n); /* that's it */
|
||||
else n = n->next;
|
||||
} while (n);
|
||||
return &luaO_nilobject;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** search function for strings
|
||||
*/
|
||||
const TObject *luaH_getstr (Hash *t, TString *key) {
|
||||
Node *n = hashstr(t, key);
|
||||
do { /* check whether `key' is somewhere in the chain */
|
||||
if (ttype(key(n)) == LUA_TSTRING && tsvalue(key(n)) == key)
|
||||
return val(n); /* that's it */
|
||||
else n = n->next;
|
||||
} while (n);
|
||||
return &luaO_nilobject;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** main search function
|
||||
*/
|
||||
const TObject *luaH_get (Hash *t, const TObject *key) {
|
||||
switch (ttype(key)) {
|
||||
case LUA_TSTRING: return luaH_getstr(t, tsvalue(key));
|
||||
case LUA_TNUMBER: {
|
||||
int k = (int)nvalue(key);
|
||||
if ((lua_Number)k == nvalue(key)) /* is an integer index? */
|
||||
return luaH_getnum(t, k); /* use specialized version */
|
||||
/* else go through */
|
||||
}
|
||||
default: return luaH_getany(t, key);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
TObject *luaH_set (lua_State *L, Hash *t, const TObject *key) {
|
||||
const TObject *p = luaH_get(t, key);
|
||||
if (p != &luaO_nilobject) return (TObject *)p;
|
||||
else if (ttype(key) == LUA_TNIL) luaD_error(L, l_s("table index is nil"));
|
||||
return newkey(L, t, key);
|
||||
}
|
||||
|
||||
|
||||
TObject *luaH_setstr (lua_State *L, Hash *t, TString *key) {
|
||||
const TObject *p = luaH_getstr(t, key);
|
||||
if (p != &luaO_nilobject) return (TObject *)p;
|
||||
else {
|
||||
TObject k;
|
||||
setsvalue(&k, key);
|
||||
return newkey(L, t, &k);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
TObject *luaH_setnum (lua_State *L, Hash *t, int key) {
|
||||
const TObject *p = luaH_getnum(t, key);
|
||||
if (p != &luaO_nilobject) return (TObject *)p;
|
||||
else {
|
||||
TObject k;
|
||||
setnvalue(&k, key);
|
||||
return newkey(L, t, &k);
|
||||
}
|
||||
}
|
||||
|
||||
32
ltable.h
32
ltable.h
@@ -1,32 +0,0 @@
|
||||
/*
|
||||
** $Id: ltable.h,v 1.33 2001/06/26 13:20:45 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 key(_n) (&(_n)->key)
|
||||
#define val(_n) (&(_n)->val)
|
||||
|
||||
const TObject *luaH_getnum (Hash *t, int key);
|
||||
TObject *luaH_setnum (lua_State *L, Hash *t, int key);
|
||||
const TObject *luaH_getstr (Hash *t, TString *key);
|
||||
TObject *luaH_setstr (lua_State *L, Hash *t, TString *key);
|
||||
const TObject *luaH_get (Hash *t, const TObject *key);
|
||||
TObject *luaH_set (lua_State *L, Hash *t, const TObject *key);
|
||||
Hash *luaH_new (lua_State *L, int nhash);
|
||||
void luaH_free (lua_State *L, Hash *t);
|
||||
Node *luaH_next (lua_State *L, Hash *t, const TObject *r);
|
||||
int luaH_nexti (Hash *t, int i);
|
||||
|
||||
/* exported only for debugging */
|
||||
Node *luaH_mainposition (const Hash *t, const TObject *key);
|
||||
|
||||
|
||||
#endif
|
||||
676
ltests.c
676
ltests.c
@@ -1,676 +0,0 @@
|
||||
/*
|
||||
** $Id: ltests.c,v 1.87 2001/07/05 20:31:14 roberto Exp roberto $
|
||||
** Internal Module for Debugging of the Lua Implementation
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
#include <ctype.h>
|
||||
#include <limits.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
|
||||
#define LUA_PRIVATE
|
||||
#include "lua.h"
|
||||
|
||||
#include "lapi.h"
|
||||
#include "lauxlib.h"
|
||||
#include "lcode.h"
|
||||
#include "ldebug.h"
|
||||
#include "ldo.h"
|
||||
#include "lfunc.h"
|
||||
#include "lmem.h"
|
||||
#include "lopcodes.h"
|
||||
#include "lstate.h"
|
||||
#include "lstring.h"
|
||||
#include "ltable.h"
|
||||
#include "luadebug.h"
|
||||
#include "lualib.h"
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** The whole module only makes sense with LUA_DEBUG on
|
||||
*/
|
||||
#ifdef LUA_DEBUG
|
||||
|
||||
|
||||
lua_State *lua_state = NULL;
|
||||
|
||||
int islocked = 0;
|
||||
|
||||
|
||||
|
||||
static void setnameval (lua_State *L, const l_char *name, int val) {
|
||||
lua_pushstring(L, name);
|
||||
lua_pushnumber(L, val);
|
||||
lua_settable(L, -3);
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** {======================================================================
|
||||
** Controlled version for realloc.
|
||||
** =======================================================================
|
||||
*/
|
||||
|
||||
|
||||
/* ensures maximum alignment for HEADER */
|
||||
#define HEADER (sizeof(union L_Umaxalign))
|
||||
|
||||
#define MARKSIZE 32
|
||||
#define MARK 0x55 /* 01010101 (a nice pattern) */
|
||||
|
||||
|
||||
#define blocksize(b) ((size_t *)((l_char *)(b) - HEADER))
|
||||
|
||||
unsigned long memdebug_numblocks = 0;
|
||||
unsigned long memdebug_total = 0;
|
||||
unsigned long memdebug_maxmem = 0;
|
||||
unsigned long memdebug_memlimit = ULONG_MAX;
|
||||
|
||||
|
||||
static void *checkblock (void *block) {
|
||||
size_t *b = blocksize(block);
|
||||
size_t size = *b;
|
||||
int i;
|
||||
for (i=0;i<MARKSIZE;i++)
|
||||
lua_assert(*(((l_char *)b)+HEADER+size+i) == MARK+i); /* corrupted block? */
|
||||
return b;
|
||||
}
|
||||
|
||||
|
||||
static void freeblock (void *block) {
|
||||
if (block) {
|
||||
size_t size = *blocksize(block);
|
||||
block = checkblock(block);
|
||||
memset(block, -1, size+HEADER+MARKSIZE); /* erase block */
|
||||
free(block); /* free original block */
|
||||
memdebug_numblocks--;
|
||||
memdebug_total -= size;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
void *debug_realloc (void *block, size_t oldsize, size_t size) {
|
||||
lua_assert((oldsize == 0) ? block == NULL : oldsize == *blocksize(block));
|
||||
if (size == 0) {
|
||||
freeblock(block);
|
||||
return NULL;
|
||||
}
|
||||
else if (memdebug_total+size-oldsize > memdebug_memlimit)
|
||||
return NULL; /* to test memory allocation errors */
|
||||
else {
|
||||
l_char *newblock;
|
||||
int i;
|
||||
size_t realsize = HEADER+size+MARKSIZE;
|
||||
if (realsize < size) return NULL; /* overflow! */
|
||||
newblock = (l_char *)malloc(realsize); /* alloc a new block */
|
||||
if (newblock == NULL) return NULL;
|
||||
if (oldsize > size) oldsize = size;
|
||||
if (block) {
|
||||
memcpy(newblock+HEADER, block, oldsize);
|
||||
freeblock(block); /* erase (and check) old copy */
|
||||
}
|
||||
/* initialize new part of the block with something `weird' */
|
||||
memset(newblock+HEADER+oldsize, -MARK, size-oldsize);
|
||||
memdebug_total += size;
|
||||
if (memdebug_total > memdebug_maxmem)
|
||||
memdebug_maxmem = memdebug_total;
|
||||
memdebug_numblocks++;
|
||||
*(size_t *)newblock = size;
|
||||
for (i=0;i<MARKSIZE;i++)
|
||||
*(newblock+HEADER+size+i) = (l_char)(MARK+i);
|
||||
return newblock+HEADER;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/* }====================================================================== */
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** {======================================================
|
||||
** Disassembler
|
||||
** =======================================================
|
||||
*/
|
||||
|
||||
|
||||
static l_char *buildop (Proto *p, int pc, l_char *buff) {
|
||||
Instruction i = p->code[pc];
|
||||
OpCode o = GET_OPCODE(i);
|
||||
const l_char *name = luaP_opnames[o];
|
||||
sprintf(buff, l_s("%4d - "), pc);
|
||||
switch (getOpMode(o)) {
|
||||
case iABC:
|
||||
sprintf(buff+strlen(buff), l_s("%-12s%4d %4d %4d"), name,
|
||||
GETARG_A(i), GETARG_B(i), GETARG_C(i));
|
||||
break;
|
||||
case iABc:
|
||||
sprintf(buff+strlen(buff), l_s("%-12s%4d %4d"), name, GETARG_A(i), GETARG_Bc(i));
|
||||
break;
|
||||
case iAsBc:
|
||||
sprintf(buff+strlen(buff), l_s("%-12s%4d %4d"), name, GETARG_A(i), GETARG_sBc(i));
|
||||
break;
|
||||
}
|
||||
return buff;
|
||||
}
|
||||
|
||||
|
||||
static int listcode (lua_State *L) {
|
||||
int pc;
|
||||
Proto *p;
|
||||
luaL_arg_check(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1),
|
||||
1, l_s("Lua function expected"));
|
||||
p = clvalue(luaA_index(L, 1))->f.l;
|
||||
lua_newtable(L);
|
||||
setnameval(L, l_s("maxstack"), p->maxstacksize);
|
||||
setnameval(L, l_s("numparams"), p->numparams);
|
||||
for (pc=0; pc<p->sizecode; pc++) {
|
||||
l_char buff[100];
|
||||
lua_pushnumber(L, pc+1);
|
||||
lua_pushstring(L, buildop(p, pc, buff));
|
||||
lua_settable(L, -3);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int listk (lua_State *L) {
|
||||
Proto *p;
|
||||
int i;
|
||||
luaL_arg_check(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1),
|
||||
1, l_s("Lua function expected"));
|
||||
p = clvalue(luaA_index(L, 1))->f.l;
|
||||
lua_newtable(L);
|
||||
for (i=0; i<p->sizek; i++) {
|
||||
lua_pushnumber(L, i+1);
|
||||
luaA_pushobject(L, p->k+i);
|
||||
lua_settable(L, -3);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int listlocals (lua_State *L) {
|
||||
Proto *p;
|
||||
int pc = luaL_check_int(L, 2) - 1;
|
||||
int i = 0;
|
||||
const l_char *name;
|
||||
luaL_arg_check(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1),
|
||||
1, l_s("Lua function expected"));
|
||||
p = clvalue(luaA_index(L, 1))->f.l;
|
||||
while ((name = luaF_getlocalname(p, ++i, pc)) != NULL)
|
||||
lua_pushstring(L, name);
|
||||
return i-1;
|
||||
}
|
||||
|
||||
/* }====================================================== */
|
||||
|
||||
|
||||
static int pushbool (lua_State *L, int b) {
|
||||
if (b) lua_pushnumber(L, 1);
|
||||
else lua_pushnil(L);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
|
||||
static int get_limits (lua_State *L) {
|
||||
lua_newtable(L);
|
||||
setnameval(L, l_s("BITS_INT"), BITS_INT);
|
||||
setnameval(L, l_s("LFPF"), LFIELDS_PER_FLUSH);
|
||||
setnameval(L, l_s("MAXLOCALS"), MAXLOCALS);
|
||||
setnameval(L, l_s("MAXPARAMS"), MAXPARAMS);
|
||||
setnameval(L, l_s("MAXSTACK"), MAXSTACK);
|
||||
setnameval(L, l_s("MAXUPVALUES"), MAXUPVALUES);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int mem_query (lua_State *L) {
|
||||
if (lua_isnull(L, 1)) {
|
||||
lua_pushnumber(L, memdebug_total);
|
||||
lua_pushnumber(L, memdebug_numblocks);
|
||||
lua_pushnumber(L, memdebug_maxmem);
|
||||
return 3;
|
||||
}
|
||||
else {
|
||||
memdebug_memlimit = luaL_check_int(L, 1);
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static int hash_query (lua_State *L) {
|
||||
if (lua_isnull(L, 2)) {
|
||||
luaL_arg_check(L, lua_tag(L, 1) == LUA_TSTRING, 1, l_s("string expected"));
|
||||
lua_pushnumber(L, tsvalue(luaA_index(L, 1))->tsv.hash);
|
||||
}
|
||||
else {
|
||||
TObject *o = luaA_index(L, 1);
|
||||
Hash *t;
|
||||
luaL_checktype(L, 2, LUA_TTABLE);
|
||||
t = hvalue(luaA_index(L, 2));
|
||||
lua_pushnumber(L, luaH_mainposition(t, o) - t->node);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int table_query (lua_State *L) {
|
||||
const Hash *t;
|
||||
int i = luaL_opt_int(L, 2, -1);
|
||||
luaL_checktype(L, 1, LUA_TTABLE);
|
||||
t = hvalue(luaA_index(L, 1));
|
||||
if (i == -1) {
|
||||
lua_pushnumber(L, t->size);
|
||||
lua_pushnumber(L, t->firstfree - t->node);
|
||||
return 2;
|
||||
}
|
||||
else if (i < t->size) {
|
||||
if (ttype(val(node(t, i))) != LUA_TNIL ||
|
||||
ttype(key(node(t, i))) == LUA_TNIL ||
|
||||
ttype(key(node(t, i))) == LUA_TNUMBER) {
|
||||
luaA_pushobject(L, key(node(t, i)));
|
||||
}
|
||||
else
|
||||
lua_pushstring(L, "<undef>");
|
||||
luaA_pushobject(L, &t->node[i].val);
|
||||
if (t->node[i].next) {
|
||||
lua_pushnumber(L, t->node[i].next - t->node);
|
||||
return 3;
|
||||
}
|
||||
else
|
||||
return 2;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
static int string_query (lua_State *L) {
|
||||
stringtable *tb = &G(L)->strt;
|
||||
int s = luaL_opt_int(L, 2, 0) - 1;
|
||||
if (s==-1) {
|
||||
lua_pushnumber(L ,tb->nuse);
|
||||
lua_pushnumber(L ,tb->size);
|
||||
return 2;
|
||||
}
|
||||
else if (s < tb->size) {
|
||||
TString *ts;
|
||||
int n = 0;
|
||||
for (ts = tb->hash[s]; ts; ts = ts->tsv.nexthash) {
|
||||
setsvalue(L->top, ts);
|
||||
incr_top;
|
||||
n++;
|
||||
}
|
||||
return n;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
static int tref (lua_State *L) {
|
||||
int level = lua_gettop(L);
|
||||
luaL_checkany(L, 1);
|
||||
lua_pushvalue(L, 1);
|
||||
lua_pushnumber(L, lua_ref(L, luaL_opt_int(L, 2, 1)));
|
||||
assert(lua_gettop(L) == level+1); /* +1 for result */
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int getref (lua_State *L) {
|
||||
int level = lua_gettop(L);
|
||||
if (lua_getref(L, luaL_check_int(L, 1))) {
|
||||
assert(lua_gettop(L) == level+1);
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
assert(lua_gettop(L) == level);
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
static int unref (lua_State *L) {
|
||||
int level = lua_gettop(L);
|
||||
lua_unref(L, luaL_check_int(L, 1));
|
||||
assert(lua_gettop(L) == level);
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int newuserdata (lua_State *L) {
|
||||
size_t size = luaL_check_int(L, 1);
|
||||
l_char *p = (l_char *)lua_newuserdata(L, size);
|
||||
while (size--) *p++ = l_c('\0');
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int newuserdatabox (lua_State *L) {
|
||||
lua_newuserdatabox(L, (void *)luaL_check_int(L, 1));
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int settag (lua_State *L) {
|
||||
luaL_checkany(L, 1);
|
||||
lua_pushvalue(L, 1); /* push value */
|
||||
lua_settag(L, luaL_check_int(L, 2));
|
||||
return 1; /* return value */
|
||||
}
|
||||
|
||||
static int udataval (lua_State *L) {
|
||||
luaL_checktype(L, 1, LUA_TUSERDATA);
|
||||
lua_pushnumber(L, (int)lua_touserdata(L, 1));
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int newtag (lua_State *L) {
|
||||
lua_pushnumber(L, lua_newtype(L, lua_tostring(L, 1),
|
||||
(int)lua_tonumber(L, 2)));
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int doonnewstack (lua_State *L) {
|
||||
lua_State *L1 = lua_newthread(L, luaL_check_int(L, 1));
|
||||
if (L1 == NULL) return 0;
|
||||
*((int **)L1) = &islocked; /* initialize the lock */
|
||||
lua_dostring(L1, luaL_check_string(L, 2));
|
||||
lua_pushnumber(L, 1);
|
||||
lua_close(L1);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int s2d (lua_State *L) {
|
||||
lua_pushnumber(L, *(double *)luaL_check_string(L, 1));
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int d2s (lua_State *L) {
|
||||
double d = luaL_check_number(L, 1);
|
||||
lua_pushlstring(L, (l_char *)&d, sizeof(d));
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int newstate (lua_State *L) {
|
||||
lua_State *L1 = lua_open(luaL_check_int(L, 1));
|
||||
if (L1) {
|
||||
*((int **)L1) = &islocked; /* initialize the lock */
|
||||
lua_pushnumber(L, (unsigned long)L1);
|
||||
}
|
||||
else
|
||||
lua_pushnil(L);
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int loadlib (lua_State *L) {
|
||||
lua_State *L1 = (lua_State *)(unsigned long)luaL_check_number(L, 1);
|
||||
lua_register(L1, "mathlibopen", lua_mathlibopen);
|
||||
lua_register(L1, "strlibopen", lua_strlibopen);
|
||||
lua_register(L1, "iolibopen", lua_iolibopen);
|
||||
lua_register(L1, "dblibopen", lua_dblibopen);
|
||||
lua_register(L1, "baselibopen", lua_baselibopen);
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int closestate (lua_State *L) {
|
||||
lua_State *L1 = (lua_State *)(unsigned long)luaL_check_number(L, 1);
|
||||
lua_close(L1);
|
||||
lua_unlock(L); /* close cannot unlock that */
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int doremote (lua_State *L) {
|
||||
lua_State *L1;
|
||||
const l_char *code = luaL_check_string(L, 2);
|
||||
int status;
|
||||
L1 = (lua_State *)(unsigned long)luaL_check_number(L, 1);
|
||||
status = lua_dostring(L1, code);
|
||||
if (status != 0) {
|
||||
lua_pushnil(L);
|
||||
lua_pushnumber(L, status);
|
||||
return 2;
|
||||
}
|
||||
else {
|
||||
int i = 0;
|
||||
while (!lua_isnull(L1, ++i))
|
||||
lua_pushstring(L, lua_tostring(L1, i));
|
||||
lua_pop(L1, i-1);
|
||||
return i-1;
|
||||
}
|
||||
}
|
||||
|
||||
static int settagmethod (lua_State *L) {
|
||||
int tag = luaL_check_int(L, 1);
|
||||
const l_char *event = luaL_check_string(L, 2);
|
||||
luaL_checkany(L, 3);
|
||||
lua_gettagmethod(L, tag, event);
|
||||
lua_pushvalue(L, 3);
|
||||
lua_settagmethod(L, tag, event);
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int equal (lua_State *L) {
|
||||
return pushbool(L, lua_equal(L, 1, 2));
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** {======================================================
|
||||
** function to test the API with C. It interprets a kind of assembler
|
||||
** language with calls to the API, so the test can be driven by Lua code
|
||||
** =======================================================
|
||||
*/
|
||||
|
||||
static const l_char *const delimits = l_s(" \t\n,;");
|
||||
|
||||
static void skip (const l_char **pc) {
|
||||
while (**pc != l_c('\0') && strchr(delimits, **pc)) (*pc)++;
|
||||
}
|
||||
|
||||
static int getnum (lua_State *L, const l_char **pc) {
|
||||
int res = 0;
|
||||
int sig = 1;
|
||||
skip(pc);
|
||||
if (**pc == l_c('.')) {
|
||||
res = (int)lua_tonumber(L, -1);
|
||||
lua_pop(L, 1);
|
||||
(*pc)++;
|
||||
return res;
|
||||
}
|
||||
else if (**pc == l_c('-')) {
|
||||
sig = -1;
|
||||
(*pc)++;
|
||||
}
|
||||
while (isdigit(**pc)) res = res*10 + (*(*pc)++) - l_c('0');
|
||||
return sig*res;
|
||||
}
|
||||
|
||||
static const l_char *getname (l_char *buff, const l_char **pc) {
|
||||
int i = 0;
|
||||
skip(pc);
|
||||
while (**pc != l_c('\0') && !strchr(delimits, **pc))
|
||||
buff[i++] = *(*pc)++;
|
||||
buff[i] = l_c('\0');
|
||||
return buff;
|
||||
}
|
||||
|
||||
|
||||
#define EQ(s1) (strcmp(s1, inst) == 0)
|
||||
|
||||
#define getnum ((getnum)(L, &pc))
|
||||
#define getname ((getname)(buff, &pc))
|
||||
|
||||
|
||||
static int testC (lua_State *L) {
|
||||
l_char buff[30];
|
||||
const l_char *pc = luaL_check_string(L, 1);
|
||||
for (;;) {
|
||||
const l_char *inst = getname;
|
||||
if EQ(l_s("")) return 0;
|
||||
else if EQ(l_s("isnumber")) {
|
||||
lua_pushnumber(L, lua_isnumber(L, getnum));
|
||||
}
|
||||
else if EQ(l_s("isstring")) {
|
||||
lua_pushnumber(L, lua_isstring(L, getnum));
|
||||
}
|
||||
else if EQ(l_s("istable")) {
|
||||
lua_pushnumber(L, lua_istable(L, getnum));
|
||||
}
|
||||
else if EQ(l_s("iscfunction")) {
|
||||
lua_pushnumber(L, lua_iscfunction(L, getnum));
|
||||
}
|
||||
else if EQ(l_s("isfunction")) {
|
||||
lua_pushnumber(L, lua_isfunction(L, getnum));
|
||||
}
|
||||
else if EQ(l_s("isuserdata")) {
|
||||
lua_pushnumber(L, lua_isuserdata(L, getnum));
|
||||
}
|
||||
else if EQ(l_s("isnil")) {
|
||||
lua_pushnumber(L, lua_isnil(L, getnum));
|
||||
}
|
||||
else if EQ(l_s("isnull")) {
|
||||
lua_pushnumber(L, lua_isnull(L, getnum));
|
||||
}
|
||||
else if EQ(l_s("tonumber")) {
|
||||
lua_pushnumber(L, lua_tonumber(L, getnum));
|
||||
}
|
||||
else if EQ(l_s("tostring")) {
|
||||
const l_char *s = lua_tostring(L, getnum);
|
||||
lua_pushstring(L, s);
|
||||
}
|
||||
else if EQ(l_s("tonumber")) {
|
||||
lua_pushnumber(L, lua_tonumber(L, getnum));
|
||||
}
|
||||
else if EQ(l_s("strlen")) {
|
||||
lua_pushnumber(L, lua_strlen(L, getnum));
|
||||
}
|
||||
else if EQ(l_s("tocfunction")) {
|
||||
lua_pushcfunction(L, lua_tocfunction(L, getnum));
|
||||
}
|
||||
else if EQ(l_s("return")) {
|
||||
return getnum;
|
||||
}
|
||||
else if EQ(l_s("gettop")) {
|
||||
lua_pushnumber(L, lua_gettop(L));
|
||||
}
|
||||
else if EQ(l_s("settop")) {
|
||||
lua_settop(L, getnum);
|
||||
}
|
||||
else if EQ(l_s("pop")) {
|
||||
lua_pop(L, getnum);
|
||||
}
|
||||
else if EQ(l_s("pushnum")) {
|
||||
lua_pushnumber(L, getnum);
|
||||
}
|
||||
else if EQ(l_s("pushvalue")) {
|
||||
lua_pushvalue(L, getnum);
|
||||
}
|
||||
else if EQ(l_s("remove")) {
|
||||
lua_remove(L, getnum);
|
||||
}
|
||||
else if EQ(l_s("insert")) {
|
||||
lua_insert(L, getnum);
|
||||
}
|
||||
else if EQ(l_s("gettable")) {
|
||||
lua_gettable(L, getnum);
|
||||
}
|
||||
else if EQ(l_s("settable")) {
|
||||
lua_settable(L, getnum);
|
||||
}
|
||||
else if EQ(l_s("next")) {
|
||||
lua_next(L, -2);
|
||||
}
|
||||
else if EQ(l_s("concat")) {
|
||||
lua_concat(L, getnum);
|
||||
}
|
||||
else if EQ(l_s("lessthan")) {
|
||||
int a = getnum;
|
||||
if (lua_lessthan(L, a, getnum))
|
||||
lua_pushnumber(L, 1);
|
||||
else
|
||||
lua_pushnil(L);
|
||||
}
|
||||
else if EQ(l_s("rawcall")) {
|
||||
int narg = getnum;
|
||||
int nres = getnum;
|
||||
lua_rawcall(L, narg, nres);
|
||||
}
|
||||
else if EQ(l_s("call")) {
|
||||
int narg = getnum;
|
||||
int nres = getnum;
|
||||
lua_call(L, narg, nres);
|
||||
}
|
||||
else if EQ(l_s("dostring")) {
|
||||
lua_dostring(L, luaL_check_string(L, getnum));
|
||||
}
|
||||
else if EQ(l_s("settagmethod")) {
|
||||
int tag = getnum;
|
||||
const l_char *event = getname;
|
||||
lua_settagmethod(L, tag, event);
|
||||
}
|
||||
else if EQ(l_s("gettagmethod")) {
|
||||
int tag = getnum;
|
||||
const l_char *event = getname;
|
||||
lua_gettagmethod(L, tag, event);
|
||||
}
|
||||
else if EQ(l_s("type")) {
|
||||
lua_pushstring(L, lua_type(L, getnum));
|
||||
}
|
||||
else luaL_verror(L, l_s("unknown instruction %.30s"), buff);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* }====================================================== */
|
||||
|
||||
|
||||
|
||||
static const struct luaL_reg tests_funcs[] = {
|
||||
{l_s("hash"), hash_query},
|
||||
{l_s("limits"), get_limits},
|
||||
{l_s("listcode"), listcode},
|
||||
{l_s("listk"), listk},
|
||||
{l_s("listlocals"), listlocals},
|
||||
{l_s("loadlib"), loadlib},
|
||||
{l_s("querystr"), string_query},
|
||||
{l_s("querytab"), table_query},
|
||||
{l_s("testC"), testC},
|
||||
{l_s("ref"), tref},
|
||||
{l_s("getref"), getref},
|
||||
{l_s("unref"), unref},
|
||||
{l_s("d2s"), d2s},
|
||||
{l_s("s2d"), s2d},
|
||||
{l_s("newuserdata"), newuserdata},
|
||||
{l_s("newuserdatabox"), newuserdatabox},
|
||||
{l_s("settag"), settag},
|
||||
{l_s("udataval"), udataval},
|
||||
{l_s("newtag"), newtag},
|
||||
{l_s("doonnewstack"), doonnewstack},
|
||||
{l_s("newstate"), newstate},
|
||||
{l_s("closestate"), closestate},
|
||||
{l_s("doremote"), doremote},
|
||||
{l_s("settagmethod"), settagmethod},
|
||||
{l_s("equal"), equal},
|
||||
{l_s("totalmem"), mem_query}
|
||||
};
|
||||
|
||||
|
||||
void luaB_opentests (lua_State *L) {
|
||||
*((int **)L) = &islocked; /* init lock */
|
||||
lua_state = L; /* keep first state to be opened */
|
||||
/* open lib in a new table */
|
||||
lua_newtable(L);
|
||||
lua_getglobals(L);
|
||||
lua_pushvalue(L, -2);
|
||||
lua_setglobals(L);
|
||||
luaL_openl(L, tests_funcs); /* open functions inside new table */
|
||||
lua_setglobals(L); /* restore old table of globals */
|
||||
lua_setglobal(L, l_s("T")); /* set new table as global T */
|
||||
}
|
||||
|
||||
#endif
|
||||
58
ltests.h
58
ltests.h
@@ -1,58 +0,0 @@
|
||||
/*
|
||||
** $Id: ltests.h,v 1.6 2001/03/02 17:27:50 roberto Exp roberto $
|
||||
** Internal Header for Debugging of the Lua Implementation
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
#ifndef ltests_h
|
||||
#define ltests_h
|
||||
|
||||
|
||||
#include <stdlib.h>
|
||||
|
||||
|
||||
#define LUA_DEBUG
|
||||
|
||||
#define LUA_OPNAMES
|
||||
|
||||
#undef NDEBUG
|
||||
#include <assert.h>
|
||||
#define lua_assert(c) assert(c)
|
||||
#define api_check(L, o) lua_assert(o)
|
||||
|
||||
|
||||
/* to avoid warnings, and to make sure value is really unused */
|
||||
#define UNUSED(x) (x=0, (void)(x))
|
||||
|
||||
|
||||
/* memory allocator control variables */
|
||||
extern unsigned long memdebug_numblocks;
|
||||
extern unsigned long memdebug_total;
|
||||
extern unsigned long memdebug_maxmem;
|
||||
extern unsigned long memdebug_memlimit;
|
||||
|
||||
|
||||
#define l_malloc(s) debug_realloc(NULL, 0, s)
|
||||
#define l_realloc(b, os, s) debug_realloc(b, os, s)
|
||||
#define l_free(b, s) debug_realloc(b, s, 0)
|
||||
|
||||
void *debug_realloc (void *block, size_t oldsize, size_t size);
|
||||
|
||||
|
||||
|
||||
/* test for lock/unlock */
|
||||
#define LUA_USERSTATE int *lock;
|
||||
extern int islocked;
|
||||
#define lua_lock(L) lua_assert((**((int **)L))++ == 0)
|
||||
#define lua_unlock(L) lua_assert(--(**((int **)L)) == 0)
|
||||
|
||||
|
||||
extern lua_State *lua_state;
|
||||
|
||||
|
||||
void luaB_opentests (lua_State *L);
|
||||
|
||||
#define LUA_USERINIT(L) (luaB_opentests(L), openstdlibs(L))
|
||||
|
||||
|
||||
#endif
|
||||
192
ltm.c
192
ltm.c
@@ -1,192 +0,0 @@
|
||||
/*
|
||||
** $Id: ltm.c,v 1.75 2001/07/23 19:56:00 roberto Exp roberto $
|
||||
** Tag methods
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
|
||||
#define LUA_PRIVATE
|
||||
#include "lua.h"
|
||||
|
||||
#include "ldo.h"
|
||||
#include "lmem.h"
|
||||
#include "lobject.h"
|
||||
#include "lstate.h"
|
||||
#include "lstring.h"
|
||||
#include "ltable.h"
|
||||
#include "ltm.h"
|
||||
|
||||
|
||||
const l_char *const luaT_eventname[] = { /* ORDER TM */
|
||||
l_s("gettable"), l_s("settable"), l_s("index"), l_s("getglobal"),
|
||||
l_s("setglobal"), l_s("add"), l_s("sub"), l_s("mul"), l_s("div"),
|
||||
l_s("pow"), l_s("unm"), l_s("lt"), l_s("concat"), l_s("gc"),
|
||||
l_s("function"),
|
||||
NULL
|
||||
};
|
||||
|
||||
|
||||
static int findevent (const l_char *name) {
|
||||
int i;
|
||||
for (i=0; luaT_eventname[i]; i++)
|
||||
if (strcmp(luaT_eventname[i], name) == 0)
|
||||
return i;
|
||||
return -1; /* name not found */
|
||||
}
|
||||
|
||||
|
||||
static int luaI_checkevent (lua_State *L, const l_char *name) {
|
||||
int e = findevent(name);
|
||||
if (e < 0)
|
||||
luaO_verror(L, l_s("`%.50s' is not a valid event name"), name);
|
||||
return e;
|
||||
}
|
||||
|
||||
|
||||
|
||||
/* events in LUA_TNIL are all allowed, since this is used as a
|
||||
* `placeholder' for default fallbacks
|
||||
*/
|
||||
/* ORDER LUA_T, ORDER TM */
|
||||
static const lu_byte luaT_validevents[NUM_TAGS][TM_N] = {
|
||||
{1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1}, /* LUA_TUSERDATA */
|
||||
{1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}, /* LUA_TNIL */
|
||||
{1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1}, /* LUA_TNUMBER */
|
||||
{1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, /* LUA_TSTRING */
|
||||
{0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1}, /* LUA_TTABLE */
|
||||
{1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0} /* LUA_TFUNCTION */
|
||||
};
|
||||
|
||||
int luaT_validevent (int t, int e) { /* ORDER LUA_T */
|
||||
return (t >= NUM_TAGS) ? 1 : (int)luaT_validevents[t][e];
|
||||
}
|
||||
|
||||
|
||||
void luaT_init (lua_State *L) {
|
||||
static const l_char *const typenames[NUM_TAGS] = {
|
||||
l_s("userdata"), l_s("nil"), l_s("number"), l_s("string"),
|
||||
l_s("table"), l_s("function")
|
||||
};
|
||||
int i;
|
||||
for (i=0; i<NUM_TAGS; i++)
|
||||
luaT_newtag(L, typenames[i], i);
|
||||
}
|
||||
|
||||
|
||||
int luaT_newtag (lua_State *L, const l_char *name, int basictype) {
|
||||
int tag;
|
||||
int i;
|
||||
TString *ts = NULL;
|
||||
luaM_growvector(L, G(L)->TMtable, G(L)->ntag, G(L)->sizeTM, struct TM,
|
||||
MAX_INT, l_s("tag table overflow"));
|
||||
tag = G(L)->ntag;
|
||||
if (name) {
|
||||
TObject *v;
|
||||
ts = luaS_new(L, name);
|
||||
v = luaH_setstr(L, G(L)->type2tag, ts);
|
||||
if (ttype(v) == LUA_TNUMBER) return (int)nvalue(v);
|
||||
setnvalue(v, tag);
|
||||
}
|
||||
for (i=0; i<TM_N; i++)
|
||||
luaT_gettm(G(L), tag, i) = NULL;
|
||||
G(L)->TMtable[tag].collected = NULL;
|
||||
G(L)->TMtable[tag].name = ts;
|
||||
G(L)->TMtable[tag].basictype = basictype;
|
||||
G(L)->ntag++;
|
||||
return tag;
|
||||
}
|
||||
|
||||
|
||||
static void checktag (lua_State *L, int tag) {
|
||||
if (!(0 <= tag && tag < G(L)->ntag))
|
||||
luaO_verror(L, l_s("%d is not a valid tag"), tag);
|
||||
}
|
||||
|
||||
|
||||
LUA_API int lua_copytagmethods (lua_State *L, int tagto, int tagfrom) {
|
||||
int e;
|
||||
lua_lock(L);
|
||||
checktag(L, tagto);
|
||||
checktag(L, tagfrom);
|
||||
for (e=0; e<TM_N; e++) {
|
||||
if (luaT_validevent(tagto, e))
|
||||
luaT_gettm(G(L), tagto, e) = luaT_gettm(G(L), tagfrom, e);
|
||||
}
|
||||
lua_unlock(L);
|
||||
return tagto;
|
||||
}
|
||||
|
||||
|
||||
int luaT_tag (const TObject *o) {
|
||||
int t = ttype(o);
|
||||
switch (t) {
|
||||
case LUA_TUSERDATA: return uvalue(o)->uv.tag;
|
||||
case LUA_TTABLE: return hvalue(o)->htag;
|
||||
default: return t;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
const l_char *luaT_typename (global_State *G, const TObject *o) {
|
||||
int t = ttype(o);
|
||||
int tag;
|
||||
TString *ts;
|
||||
switch (t) {
|
||||
case LUA_TUSERDATA:
|
||||
tag = uvalue(o)->uv.tag;
|
||||
break;
|
||||
case LUA_TTABLE:
|
||||
tag = hvalue(o)->htag;
|
||||
break;
|
||||
default:
|
||||
tag = t;
|
||||
}
|
||||
ts = G->TMtable[tag].name;
|
||||
if (ts == NULL)
|
||||
ts = G->TMtable[t].name;
|
||||
return getstr(ts);
|
||||
}
|
||||
|
||||
|
||||
LUA_API void lua_gettagmethod (lua_State *L, int t, const l_char *event) {
|
||||
int e;
|
||||
lua_lock(L);
|
||||
e = luaI_checkevent(L, event);
|
||||
checktag(L, t);
|
||||
if (luaT_validevent(t, e) && luaT_gettm(G(L), t, e)) {
|
||||
setclvalue(L->top, luaT_gettm(G(L), t, e));
|
||||
}
|
||||
else
|
||||
setnilvalue(L->top);
|
||||
incr_top;
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
|
||||
LUA_API void lua_settagmethod (lua_State *L, int t, const l_char *event) {
|
||||
int e;
|
||||
lua_lock(L);
|
||||
e = luaI_checkevent(L, event);
|
||||
checktag(L, t);
|
||||
if (!luaT_validevent(t, e))
|
||||
luaO_verror(L, l_s("cannot change `%.20s' tag method for type `%.20s'%.20s"),
|
||||
luaT_eventname[e], typenamebytag(G(L), t),
|
||||
(t == LUA_TTABLE || t == LUA_TUSERDATA) ?
|
||||
l_s(" with default tag") : l_s(""));
|
||||
switch (ttype(L->top - 1)) {
|
||||
case LUA_TNIL:
|
||||
luaT_gettm(G(L), t, e) = NULL;
|
||||
break;
|
||||
case LUA_TFUNCTION:
|
||||
luaT_gettm(G(L), t, e) = clvalue(L->top - 1);
|
||||
break;
|
||||
default:
|
||||
luaD_error(L, l_s("tag method must be a function (or nil)"));
|
||||
}
|
||||
L->top--;
|
||||
lua_unlock(L);
|
||||
}
|
||||
|
||||
80
ltm.h
80
ltm.h
@@ -1,80 +0,0 @@
|
||||
/*
|
||||
** $Id: ltm.h,v 1.25 2001/06/06 18:00:19 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 TM"
|
||||
*/
|
||||
typedef enum {
|
||||
TM_GETTABLE = 0,
|
||||
TM_SETTABLE,
|
||||
TM_INDEX,
|
||||
TM_GETGLOBAL,
|
||||
TM_SETGLOBAL,
|
||||
TM_ADD,
|
||||
TM_SUB,
|
||||
TM_MUL,
|
||||
TM_DIV,
|
||||
TM_POW,
|
||||
TM_UNM,
|
||||
TM_LT,
|
||||
TM_CONCAT,
|
||||
TM_GC,
|
||||
TM_FUNCTION,
|
||||
TM_N /* number of elements in the enum */
|
||||
} TMS;
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** masks for allowable tag methods
|
||||
** (see `luaT_validevents')
|
||||
*/
|
||||
#define HAS_TM_GETGLOBAL(L,t) (1<<(t) & ((1<<LUA_TUSERDATA) | \
|
||||
(1<<LUA_TTABLE) | \
|
||||
(1<<LUA_TNIL)))
|
||||
|
||||
#define HAS_TM_SETGLOBAL(L,t) (1<<(t) & ((1<<LUA_TUSERDATA) | \
|
||||
(1<<LUA_TTABLE) | \
|
||||
(1<<LUA_TNIL) | \
|
||||
(1<<LUA_TFUNCTION)))
|
||||
|
||||
|
||||
|
||||
struct TM {
|
||||
Closure *method[TM_N];
|
||||
Udata *collected; /* list of garbage-collected udata with this tag */
|
||||
TString *name; /* type name */
|
||||
int basictype;
|
||||
};
|
||||
|
||||
|
||||
#define luaT_gettm(G,tag,event) (G->TMtable[tag].method[event])
|
||||
#define luaT_gettmbyObj(G,o,e) (luaT_gettm((G),luaT_tag(o),(e)))
|
||||
|
||||
#define typenamebytag(G, t) getstr(G->TMtable[t].name)
|
||||
|
||||
|
||||
#define validtag(G,t) (NUM_TAGS <= (t) && (t) < G->ntag)
|
||||
|
||||
extern const l_char *const luaT_eventname[];
|
||||
|
||||
|
||||
void luaT_init (lua_State *L);
|
||||
int luaT_newtag (lua_State *L, const l_char *name, int basictype);
|
||||
const l_char *luaT_typename (global_State *G, const TObject *o);
|
||||
int luaT_tag (const TObject *o);
|
||||
int luaT_validevent (int t, int e); /* used by compatibility module */
|
||||
|
||||
|
||||
#endif
|
||||
359
lua.c
359
lua.c
@@ -1,335 +1,54 @@
|
||||
/*
|
||||
** $Id: lua.c,v 1.67 2001/06/06 18:00:19 roberto Exp roberto $
|
||||
** Lua stand-alone interpreter
|
||||
** See Copyright Notice in lua.h
|
||||
** lua.c
|
||||
** Linguagem para Usuarios de Aplicacao
|
||||
** TeCGraf - PUC-Rio
|
||||
** 28 Apr 93
|
||||
*/
|
||||
|
||||
|
||||
#include <signal.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
#define LUA_PRIVATE
|
||||
#include "lua.h"
|
||||
|
||||
#include "luadebug.h"
|
||||
#include "lualib.h"
|
||||
|
||||
|
||||
#ifdef _POSIX_SOURCE
|
||||
#include <unistd.h>
|
||||
#else
|
||||
static int isatty (int x) { return x==0; } /* assume stdin is a tty */
|
||||
#endif
|
||||
|
||||
|
||||
|
||||
#ifndef PROMPT
|
||||
#define PROMPT l_s("> ")
|
||||
#endif
|
||||
|
||||
|
||||
#ifndef LUA_USERINIT
|
||||
#define LUA_USERINIT(L) openstdlibs(L)
|
||||
#endif
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** global options
|
||||
*/
|
||||
struct Options {
|
||||
int toclose;
|
||||
int stacksize;
|
||||
};
|
||||
|
||||
|
||||
static lua_State *L = NULL;
|
||||
|
||||
|
||||
typedef void (*handler)(int); /* type for signal actions */
|
||||
|
||||
static void laction (int i);
|
||||
|
||||
|
||||
static lua_Hook old_linehook = NULL;
|
||||
static lua_Hook old_callhook = NULL;
|
||||
|
||||
|
||||
|
||||
static handler lreset (void) {
|
||||
return signal(SIGINT, laction);
|
||||
void test (void)
|
||||
{
|
||||
lua_pushobject(lua_getparam(1));
|
||||
lua_call ("c", 1);
|
||||
}
|
||||
|
||||
|
||||
static void lstop (void) {
|
||||
lua_setlinehook(L, old_linehook);
|
||||
lua_setcallhook(L, old_callhook);
|
||||
lreset();
|
||||
lua_error(L, l_s("interrupted!"));
|
||||
static void callfunc (void)
|
||||
{
|
||||
lua_Object obj = lua_getparam (1);
|
||||
if (lua_isstring(obj)) lua_call(lua_getstring(obj),0);
|
||||
}
|
||||
|
||||
static void execstr (void)
|
||||
{
|
||||
lua_Object obj = lua_getparam (1);
|
||||
if (lua_isstring(obj)) lua_dostring(lua_getstring(obj));
|
||||
}
|
||||
|
||||
void main (int argc, char *argv[])
|
||||
{
|
||||
int i;
|
||||
if (argc < 2)
|
||||
{
|
||||
puts ("usage: lua filename [functionnames]");
|
||||
return;
|
||||
}
|
||||
lua_register ("callfunc", callfunc);
|
||||
lua_register ("execstr", execstr);
|
||||
lua_register ("test", test);
|
||||
iolib_open ();
|
||||
strlib_open ();
|
||||
mathlib_open ();
|
||||
lua_dofile (argv[1]);
|
||||
for (i=2; i<argc; i++)
|
||||
{
|
||||
lua_call (argv[i],0);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void laction (int i) {
|
||||
(void)i; /* to avoid warnings */
|
||||
signal(SIGINT, SIG_DFL); /* if another SIGINT happens before lstop,
|
||||
terminate process (default action) */
|
||||
old_linehook = lua_setlinehook(L, (lua_Hook)lstop);
|
||||
old_callhook = lua_setcallhook(L, (lua_Hook)lstop);
|
||||
}
|
||||
|
||||
|
||||
static int ldo (int (*f)(lua_State *l, const l_char *), const l_char *name) {
|
||||
int res;
|
||||
handler h = lreset();
|
||||
int top = lua_gettop(L);
|
||||
res = f(L, name); /* dostring | dofile */
|
||||
lua_settop(L, top); /* remove eventual results */
|
||||
signal(SIGINT, h); /* restore old action */
|
||||
/* Lua gives no message in such cases, so lua.c provides one */
|
||||
if (res == LUA_ERRMEM) {
|
||||
fprintf(stderr, l_s("lua: memory allocation error\n"));
|
||||
}
|
||||
else if (res == LUA_ERRERR)
|
||||
fprintf(stderr, l_s("lua: error in error message\n"));
|
||||
return res;
|
||||
}
|
||||
|
||||
|
||||
static void print_message (void) {
|
||||
fprintf(stderr,
|
||||
l_s("usage: lua [options]. Available options are:\n")
|
||||
l_s(" - execute stdin as a file\n")
|
||||
l_s(" -c close Lua when exiting\n")
|
||||
l_s(" -e stat execute string `stat'\n")
|
||||
l_s(" -f name execute file `name' with remaining arguments in table `arg'\n")
|
||||
l_s(" -i enter interactive mode with prompt\n")
|
||||
l_s(" -q enter interactive mode without prompt\n")
|
||||
l_s(" -sNUM set stack size to NUM (must be the first option)\n")
|
||||
l_s(" -v print version information\n")
|
||||
l_s(" a=b set global `a' to string `b'\n")
|
||||
l_s(" name execute file `name'\n")
|
||||
);
|
||||
}
|
||||
|
||||
|
||||
static void print_version (void) {
|
||||
printf(l_s("%.80s %.80s\n"), l_s(LUA_VERSION), l_s(LUA_COPYRIGHT));
|
||||
}
|
||||
|
||||
|
||||
static void assign (l_char *arg) {
|
||||
l_char *eq = strchr(arg, l_c('='));
|
||||
*eq = l_c('\0'); /* spilt `arg' in two strings (name & value) */
|
||||
lua_pushstring(L, eq+1);
|
||||
lua_setglobal(L, arg);
|
||||
}
|
||||
|
||||
|
||||
static void getargs (l_char *argv[]) {
|
||||
int i;
|
||||
lua_newtable(L);
|
||||
for (i=0; argv[i]; i++) {
|
||||
/* arg[i] = argv[i] */
|
||||
lua_pushnumber(L, i);
|
||||
lua_pushstring(L, argv[i]);
|
||||
lua_settable(L, -3);
|
||||
}
|
||||
/* arg.n = maximum index in table `arg' */
|
||||
lua_pushliteral(L, l_s("n"));
|
||||
lua_pushnumber(L, i-1);
|
||||
lua_settable(L, -3);
|
||||
}
|
||||
|
||||
|
||||
static int l_getargs (lua_State *l) {
|
||||
l_char **argv = (l_char **)lua_touserdata(l, -1);
|
||||
getargs(argv);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static int file_input (const l_char *argv) {
|
||||
int result = ldo(lua_dofile, argv);
|
||||
if (result) {
|
||||
if (result == LUA_ERRFILE) {
|
||||
fprintf(stderr, l_s("lua: cannot execute file "));
|
||||
perror(argv);
|
||||
}
|
||||
return EXIT_FAILURE;
|
||||
}
|
||||
else
|
||||
return EXIT_SUCCESS;
|
||||
}
|
||||
|
||||
|
||||
/* maximum length of an input line */
|
||||
#ifndef MAXINPUT
|
||||
#define MAXINPUT 512
|
||||
#endif
|
||||
|
||||
|
||||
static const l_char *get_prompt (int prompt) {
|
||||
if (!prompt)
|
||||
return l_s("");
|
||||
else {
|
||||
const l_char *s;
|
||||
lua_getglobal(L, l_s("_PROMPT"));
|
||||
s = lua_tostring(L, -1);
|
||||
if (!s) s = PROMPT;
|
||||
lua_pop(L, 1); /* remove global */
|
||||
return s;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void manual_input (int version, int prompt) {
|
||||
if (version) print_version();
|
||||
for (;;) {
|
||||
fputs(get_prompt(prompt), stdout); /* show prompt */
|
||||
for(;;) {
|
||||
l_char buffer[MAXINPUT];
|
||||
size_t l;
|
||||
if (fgets(buffer, sizeof(buffer), stdin) == NULL) {
|
||||
printf(l_s("\n"));
|
||||
return;
|
||||
}
|
||||
l = strlen(buffer);
|
||||
if (buffer[l-1] == l_c('\n') && buffer[l-2] == l_c('\\')) {
|
||||
buffer[l-2] = l_c('\n');
|
||||
lua_pushlstring(L, buffer, l-1);
|
||||
}
|
||||
else {
|
||||
lua_pushlstring(L, buffer, l);
|
||||
break;
|
||||
}
|
||||
}
|
||||
lua_concat(L, lua_gettop(L));
|
||||
ldo(lua_dostring, lua_tostring(L, -1));
|
||||
lua_settop(L, 0); /* remove eventual results */
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static int handle_argv (l_char *argv[], struct Options *opt) {
|
||||
if (opt->stacksize > 0) argv++; /* skip option `-s' (if present) */
|
||||
if (*argv == NULL) { /* no more arguments? */
|
||||
if (isatty(0)) {
|
||||
manual_input(1, 1);
|
||||
}
|
||||
else
|
||||
ldo(lua_dofile, NULL); /* executes stdin as a file */
|
||||
}
|
||||
else { /* other arguments; loop over them */
|
||||
int i;
|
||||
for (i = 0; argv[i] != NULL; i++) {
|
||||
if (argv[i][0] != l_c('-')) { /* not an option? */
|
||||
if (strchr(argv[i], l_c('=')))
|
||||
assign(argv[i]);
|
||||
else
|
||||
if (file_input(argv[i]) != EXIT_SUCCESS)
|
||||
return EXIT_FAILURE; /* stop if file fails */
|
||||
}
|
||||
else switch (argv[i][1]) { /* option */
|
||||
case 0: {
|
||||
ldo(lua_dofile, NULL); /* executes stdin as a file */
|
||||
break;
|
||||
}
|
||||
case l_c('i'): {
|
||||
manual_input(0, 1);
|
||||
break;
|
||||
}
|
||||
case l_c('q'): {
|
||||
manual_input(0, 0);
|
||||
break;
|
||||
}
|
||||
case l_c('c'): {
|
||||
opt->toclose = 1;
|
||||
break;
|
||||
}
|
||||
case l_c('v'): {
|
||||
print_version();
|
||||
break;
|
||||
}
|
||||
case l_c('e'): {
|
||||
i++;
|
||||
if (argv[i] == NULL) {
|
||||
print_message();
|
||||
return EXIT_FAILURE;
|
||||
}
|
||||
if (ldo(lua_dostring, argv[i]) != 0) {
|
||||
fprintf(stderr, l_s("lua: error running argument `%.99s'\n"), argv[i]);
|
||||
return EXIT_FAILURE;
|
||||
}
|
||||
break;
|
||||
}
|
||||
case l_c('f'): {
|
||||
i++;
|
||||
if (argv[i] == NULL) {
|
||||
print_message();
|
||||
return EXIT_FAILURE;
|
||||
}
|
||||
getargs(argv+i); /* collect remaining arguments */
|
||||
lua_setglobal(L, l_s("arg"));
|
||||
return file_input(argv[i]); /* stop scanning arguments */
|
||||
}
|
||||
case l_c('s'): {
|
||||
fprintf(stderr, l_s("lua: stack size (`-s') must be the first option\n"));
|
||||
return EXIT_FAILURE;
|
||||
}
|
||||
default: {
|
||||
print_message();
|
||||
return EXIT_FAILURE;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
return EXIT_SUCCESS;
|
||||
}
|
||||
|
||||
|
||||
static void getstacksize (int argc, l_char *argv[], struct Options *opt) {
|
||||
if (argc >= 2 && argv[1][0] == l_c('-') && argv[1][1] == l_c('s')) {
|
||||
int stacksize = strtol(&argv[1][2], NULL, 10);
|
||||
if (stacksize <= 0) {
|
||||
fprintf(stderr, l_s("lua: invalid stack size ('%.20s')\n"), &argv[1][2]);
|
||||
exit(EXIT_FAILURE);
|
||||
}
|
||||
opt->stacksize = stacksize;
|
||||
}
|
||||
else
|
||||
opt->stacksize = 0; /* no stack size */
|
||||
}
|
||||
|
||||
|
||||
static void register_getargs (l_char *argv[]) {
|
||||
lua_newuserdatabox(L, argv);
|
||||
lua_pushcclosure(L, l_getargs, 1);
|
||||
lua_setglobal(L, l_s("getargs"));
|
||||
}
|
||||
|
||||
|
||||
static void openstdlibs (lua_State *l) {
|
||||
lua_baselibopen(l);
|
||||
lua_iolibopen(l);
|
||||
lua_strlibopen(l);
|
||||
lua_mathlibopen(l);
|
||||
lua_dblibopen(l);
|
||||
}
|
||||
|
||||
|
||||
int main (int argc, l_char *argv[]) {
|
||||
struct Options opt;
|
||||
int status;
|
||||
opt.toclose = 0;
|
||||
getstacksize(argc, argv, &opt); /* handle option `-s' */
|
||||
L = lua_open(opt.stacksize); /* create state */
|
||||
LUA_USERINIT(L); /* open libraries */
|
||||
register_getargs(argv); /* create `getargs' function */
|
||||
status = handle_argv(argv+1, &opt);
|
||||
if (opt.toclose)
|
||||
lua_close(L);
|
||||
return status;
|
||||
}
|
||||
|
||||
|
||||
385
lua.h
385
lua.h
@@ -1,349 +1,54 @@
|
||||
/*
|
||||
** $Id: lua.h,v 1.101 2001/07/12 18:11:58 roberto Exp roberto $
|
||||
** Lua - An Extensible Extension Language
|
||||
** TeCGraf: Grupo de Tecnologia em Computacao Grafica, PUC-Rio, Brazil
|
||||
** e-mail: info@lua.org
|
||||
** www: http://www.lua.org
|
||||
** See Copyright Notice at the end of this file
|
||||
** LUA - Linguagem para Usuarios de Aplicacao
|
||||
** Grupo de Tecnologia em Computacao Grafica
|
||||
** TeCGraf - PUC-Rio
|
||||
** 19 May 93
|
||||
*/
|
||||
|
||||
|
||||
#ifndef lua_h
|
||||
#define lua_h
|
||||
|
||||
|
||||
/* definition of `size_t' */
|
||||
#include <stddef.h>
|
||||
|
||||
|
||||
|
||||
#define LUA_VERSION "Lua 4.1 (alpha)"
|
||||
#define LUA_COPYRIGHT "Copyright (C) 1994-2001 TeCGraf, PUC-Rio"
|
||||
#define LUA_AUTHORS "W. Celes, R. Ierusalimschy & L. H. de Figueiredo"
|
||||
|
||||
|
||||
/* name of global variable with error handler */
|
||||
#define LUA_ERRORMESSAGE "_ERRORMESSAGE"
|
||||
|
||||
|
||||
/* pre-defined references */
|
||||
#define LUA_NOREF (-2)
|
||||
#define LUA_REFNIL (-1)
|
||||
|
||||
|
||||
/* option for multiple returns in `lua_call' */
|
||||
#define LUA_MULTRET (-1)
|
||||
|
||||
|
||||
/* error codes for `lua_do*' and the like */
|
||||
#define LUA_ERRRUN 1
|
||||
#define LUA_ERRFILE 2
|
||||
#define LUA_ERRSYNTAX 3
|
||||
#define LUA_ERRMEM 4
|
||||
#define LUA_ERRERR 5
|
||||
|
||||
/* weak-table modes */
|
||||
#define LUA_WEAK_KEY 1
|
||||
#define LUA_WEAK_VALUE 2
|
||||
|
||||
|
||||
typedef struct lua_State lua_State;
|
||||
|
||||
typedef int (*lua_CFunction) (lua_State *L);
|
||||
|
||||
|
||||
/*
|
||||
** an invalid `tag'
|
||||
*/
|
||||
#define LUA_NOTAG (-1)
|
||||
|
||||
/*
|
||||
** tags for basic types
|
||||
*/
|
||||
#define LUA_TNONE LUA_NOTAG
|
||||
|
||||
#define LUA_TUSERDATA 0
|
||||
#define LUA_TNIL 1
|
||||
#define LUA_TNUMBER 2
|
||||
#define LUA_TSTRING 3
|
||||
#define LUA_TTABLE 4
|
||||
#define LUA_TFUNCTION 5
|
||||
|
||||
|
||||
/* minimum Lua stack available to a C function */
|
||||
#define LUA_MINSTACK 20
|
||||
|
||||
|
||||
/*
|
||||
** generic extra include file
|
||||
*/
|
||||
#ifdef LUA_USER_H
|
||||
#include LUA_USER_H
|
||||
#endif
|
||||
|
||||
|
||||
/* Lua numerical type */
|
||||
#ifndef LUA_NUMBER
|
||||
#define LUA_NUMBER double
|
||||
#endif
|
||||
typedef LUA_NUMBER lua_Number;
|
||||
|
||||
/* Lua character type */
|
||||
#ifndef L_CHAR
|
||||
#define L_CHAR char
|
||||
#endif
|
||||
typedef L_CHAR lua_char;
|
||||
|
||||
|
||||
/* mark for all API functions */
|
||||
#ifndef LUA_API
|
||||
#define LUA_API extern
|
||||
#endif
|
||||
|
||||
|
||||
/*
|
||||
** state manipulation
|
||||
*/
|
||||
LUA_API lua_State *lua_newthread (lua_State *L, int stacksize);
|
||||
LUA_API void lua_close (lua_State *L);
|
||||
|
||||
|
||||
/*
|
||||
** basic stack manipulation
|
||||
*/
|
||||
LUA_API int lua_gettop (lua_State *L);
|
||||
LUA_API void lua_settop (lua_State *L, int index);
|
||||
LUA_API void lua_pushvalue (lua_State *L, int index);
|
||||
LUA_API void lua_remove (lua_State *L, int index);
|
||||
LUA_API void lua_insert (lua_State *L, int index);
|
||||
LUA_API int lua_stackspace (lua_State *L);
|
||||
|
||||
|
||||
/*
|
||||
** access functions (stack -> C)
|
||||
*/
|
||||
|
||||
LUA_API const lua_char *lua_type (lua_State *L, int index);
|
||||
LUA_API int lua_isnumber (lua_State *L, int index);
|
||||
LUA_API int lua_isstring (lua_State *L, int index);
|
||||
LUA_API int lua_iscfunction (lua_State *L, int index);
|
||||
LUA_API int lua_tag (lua_State *L, int index);
|
||||
LUA_API int lua_rawtag (lua_State *L, int index);
|
||||
|
||||
LUA_API int lua_equal (lua_State *L, int index1, int index2);
|
||||
LUA_API int lua_lessthan (lua_State *L, int index1, int index2);
|
||||
|
||||
LUA_API lua_Number lua_tonumber (lua_State *L, int index);
|
||||
LUA_API const lua_char *lua_tostring (lua_State *L, int index);
|
||||
LUA_API size_t lua_strlen (lua_State *L, int index);
|
||||
LUA_API lua_CFunction lua_tocfunction (lua_State *L, int index);
|
||||
LUA_API void *lua_touserdata (lua_State *L, int index);
|
||||
LUA_API const void *lua_topointer (lua_State *L, int index);
|
||||
|
||||
|
||||
/*
|
||||
** push functions (C -> stack)
|
||||
*/
|
||||
LUA_API void lua_pushnil (lua_State *L);
|
||||
LUA_API void lua_pushnumber (lua_State *L, lua_Number n);
|
||||
LUA_API void lua_pushlstring (lua_State *L, const lua_char *s, size_t len);
|
||||
LUA_API void lua_pushstring (lua_State *L, const lua_char *s);
|
||||
LUA_API void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n);
|
||||
|
||||
|
||||
/*
|
||||
** get functions (Lua -> stack)
|
||||
*/
|
||||
LUA_API void lua_getglobal (lua_State *L, const lua_char *name);
|
||||
LUA_API void lua_gettable (lua_State *L, int index);
|
||||
LUA_API void lua_rawget (lua_State *L, int index);
|
||||
LUA_API void lua_rawgeti (lua_State *L, int index, int n);
|
||||
LUA_API void lua_getglobals (lua_State *L);
|
||||
LUA_API void lua_gettagmethod (lua_State *L, int tag, const lua_char *event);
|
||||
LUA_API int lua_getref (lua_State *L, int ref);
|
||||
LUA_API void lua_newtable (lua_State *L);
|
||||
LUA_API void lua_getregistry (lua_State *L);
|
||||
LUA_API void lua_getweakregistry (lua_State *L);
|
||||
|
||||
|
||||
/*
|
||||
** set functions (stack -> Lua)
|
||||
*/
|
||||
LUA_API void lua_setglobal (lua_State *L, const lua_char *name);
|
||||
LUA_API void lua_settable (lua_State *L, int index);
|
||||
LUA_API void lua_rawset (lua_State *L, int index);
|
||||
LUA_API void lua_rawseti (lua_State *L, int index, int n);
|
||||
LUA_API void lua_setglobals (lua_State *L);
|
||||
LUA_API void lua_settagmethod (lua_State *L, int tag, const lua_char *event);
|
||||
LUA_API int lua_ref (lua_State *L, int lock);
|
||||
|
||||
|
||||
/*
|
||||
** `load' and `do' functions (load and run Lua code)
|
||||
*/
|
||||
LUA_API int lua_call (lua_State *L, int nargs, int nresults);
|
||||
LUA_API void lua_rawcall (lua_State *L, int nargs, int nresults);
|
||||
LUA_API int lua_loadfile (lua_State *L, const lua_char *filename);
|
||||
LUA_API int lua_dofile (lua_State *L, const lua_char *filename);
|
||||
LUA_API int lua_dostring (lua_State *L, const lua_char *str);
|
||||
LUA_API int lua_loadbuffer (lua_State *L, const lua_char *buff, size_t size,
|
||||
const lua_char *name);
|
||||
LUA_API int lua_dobuffer (lua_State *L, const lua_char *buff, size_t size,
|
||||
const lua_char *name);
|
||||
|
||||
/*
|
||||
** Garbage-collection functions
|
||||
*/
|
||||
LUA_API int lua_getgcthreshold (lua_State *L);
|
||||
LUA_API int lua_getgccount (lua_State *L);
|
||||
LUA_API void lua_setgcthreshold (lua_State *L, int newthreshold);
|
||||
|
||||
/*
|
||||
** miscellaneous functions
|
||||
*/
|
||||
LUA_API int lua_newtype (lua_State *L, const lua_char *name, int basictype);
|
||||
LUA_API int lua_copytagmethods (lua_State *L, int tagto, int tagfrom);
|
||||
LUA_API void lua_settag (lua_State *L, int tag);
|
||||
|
||||
LUA_API int lua_name2tag (lua_State *L, const lua_char *name);
|
||||
LUA_API const lua_char *lua_tag2name (lua_State *L, int tag);
|
||||
|
||||
LUA_API void lua_error (lua_State *L, const lua_char *s);
|
||||
|
||||
LUA_API void lua_unref (lua_State *L, int ref);
|
||||
|
||||
LUA_API int lua_next (lua_State *L, int index);
|
||||
LUA_API int lua_getn (lua_State *L, int index);
|
||||
|
||||
LUA_API void lua_concat (lua_State *L, int n);
|
||||
|
||||
LUA_API void *lua_newuserdata (lua_State *L, size_t size);
|
||||
LUA_API void lua_newuserdatabox (lua_State *L, void *u);
|
||||
|
||||
LUA_API void lua_setweakmode (lua_State *L, int mode);
|
||||
LUA_API int lua_getweakmode (lua_State *L, int index);
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** ===============================================================
|
||||
** some useful macros
|
||||
** ===============================================================
|
||||
*/
|
||||
|
||||
#define lua_open(n) lua_newthread(NULL, (n))
|
||||
|
||||
#define lua_pop(L,n) lua_settop(L, -(n)-1)
|
||||
|
||||
#define lua_register(L,n,f) (lua_pushcfunction(L, f), lua_setglobal(L, n))
|
||||
#define lua_pushcfunction(L,f) lua_pushcclosure(L, f, 0)
|
||||
#define lua_clonetag(L,t) lua_copytagmethods(L, lua_newtag(L), (t))
|
||||
|
||||
#define lua_isfunction(L,n) (lua_rawtag(L,n) == LUA_TFUNCTION)
|
||||
#define lua_istable(L,n) (lua_rawtag(L,n) == LUA_TTABLE)
|
||||
#define lua_isuserdata(L,n) (lua_rawtag(L,n) == LUA_TUSERDATA)
|
||||
#define lua_isnil(L,n) (lua_rawtag(L,n) == LUA_TNIL)
|
||||
#define lua_isnull(L,n) (lua_rawtag(L,n) == LUA_TNONE)
|
||||
|
||||
#define lua_pushliteral(L, s) lua_pushlstring(L, s, \
|
||||
(sizeof(s)/sizeof(lua_char))-1)
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** compatibility macros
|
||||
*/
|
||||
#define lua_newtag(L) lua_newtype(L, NULL, LUA_TNONE)
|
||||
#define lua_typename lua_tag2name
|
||||
typedef void (*lua_CFunction) (void);
|
||||
typedef struct Object *lua_Object;
|
||||
|
||||
#define lua_register(n,f) (lua_pushcfunction(f), lua_storeglobal(n))
|
||||
|
||||
|
||||
void lua_errorfunction (void (*fn) (char *s));
|
||||
void lua_error (char *s);
|
||||
int lua_dofile (char *filename);
|
||||
int lua_dostring (char *string);
|
||||
int lua_call (char *functionname, int nparam);
|
||||
|
||||
lua_Object lua_getparam (int number);
|
||||
float lua_getnumber (lua_Object object);
|
||||
char *lua_getstring (lua_Object object);
|
||||
char *lua_copystring (lua_Object object);
|
||||
lua_CFunction lua_getcfunction (lua_Object object);
|
||||
void *lua_getuserdata (lua_Object object);
|
||||
lua_Object lua_getfield (lua_Object object, char *field);
|
||||
lua_Object lua_getindexed (lua_Object object, float index);
|
||||
lua_Object lua_getglobal (char *name);
|
||||
|
||||
lua_Object lua_pop (void);
|
||||
|
||||
int lua_pushnil (void);
|
||||
int lua_pushnumber (float n);
|
||||
int lua_pushstring (char *s);
|
||||
int lua_pushcfunction (lua_CFunction fn);
|
||||
int lua_pushuserdata (void *u);
|
||||
int lua_pushobject (lua_Object object);
|
||||
|
||||
int lua_storeglobal (char *name);
|
||||
int lua_storefield (lua_Object object, char *field);
|
||||
int lua_storeindexed (lua_Object object, float index);
|
||||
|
||||
int lua_isnil (lua_Object object);
|
||||
int lua_isnumber (lua_Object object);
|
||||
int lua_isstring (lua_Object object);
|
||||
int lua_istable (lua_Object object);
|
||||
int lua_iscfunction (lua_Object object);
|
||||
int lua_isuserdata (lua_Object object);
|
||||
|
||||
#endif
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** {======================================================================
|
||||
** useful definitions for Lua kernel and libraries
|
||||
*/
|
||||
#ifdef LUA_PRIVATE
|
||||
|
||||
#define l_char lua_char
|
||||
|
||||
/* macro to control type of literal strings */
|
||||
#ifndef l_s
|
||||
#define l_s(x) x
|
||||
#endif
|
||||
|
||||
/* macro to control type of literal chars */
|
||||
#ifndef l_c
|
||||
#define l_c(x) x
|
||||
#endif
|
||||
|
||||
/* macro to `unsign' a character */
|
||||
#ifndef uchar
|
||||
#define uchar(c) ((unsigned char)(c))
|
||||
#endif
|
||||
|
||||
/* integer type to hold the result of fgetc */
|
||||
#ifndef l_charint
|
||||
#define l_charint int
|
||||
#endif
|
||||
|
||||
/*
|
||||
** formats for Lua numbers
|
||||
*/
|
||||
#ifndef LUA_NUMBER_SCAN
|
||||
#define LUA_NUMBER_SCAN "%lf"
|
||||
#endif
|
||||
#ifndef LUA_NUMBER_FMT
|
||||
#define LUA_NUMBER_FMT "%.16g"
|
||||
#endif
|
||||
/* function to convert a lua_Number to a string */
|
||||
#ifndef lua_number2str
|
||||
#define lua_number2str(s,n) sprintf((s), l_s(LUA_NUMBER_FMT), (n))
|
||||
#endif
|
||||
|
||||
/* function to convert a string to a lua_Number */
|
||||
#ifndef lua_str2number
|
||||
#define lua_str2number(s,p) strtod((s), (p))
|
||||
#endif
|
||||
|
||||
#endif
|
||||
/* }====================================================================== */
|
||||
|
||||
|
||||
|
||||
/******************************************************************************
|
||||
* Copyright (C) 1994-2001 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.
|
||||
******************************************************************************/
|
||||
|
||||
|
||||
46
luadebug.h
46
luadebug.h
@@ -1,46 +0,0 @@
|
||||
/*
|
||||
** $Id: luadebug.h,v 1.19 2001/03/07 18:09:25 roberto Exp roberto $
|
||||
** Debugging API
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
#ifndef luadebug_h
|
||||
#define luadebug_h
|
||||
|
||||
|
||||
#include "lua.h"
|
||||
|
||||
typedef struct lua_Debug lua_Debug; /* activation record */
|
||||
typedef struct lua_Localvar lua_Localvar;
|
||||
|
||||
typedef void (*lua_Hook) (lua_State *L, lua_Debug *ar);
|
||||
|
||||
|
||||
LUA_API int lua_getstack (lua_State *L, int level, lua_Debug *ar);
|
||||
LUA_API int lua_getinfo (lua_State *L, const lua_char *what, lua_Debug *ar);
|
||||
LUA_API const lua_char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n);
|
||||
LUA_API const lua_char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n);
|
||||
|
||||
LUA_API lua_Hook lua_setcallhook (lua_State *L, lua_Hook func);
|
||||
LUA_API lua_Hook lua_setlinehook (lua_State *L, lua_Hook func);
|
||||
|
||||
|
||||
#define LUA_IDSIZE 60
|
||||
|
||||
struct lua_Debug {
|
||||
const lua_char *event; /* `call', `return' */
|
||||
int currentline; /* (l) */
|
||||
const lua_char *name; /* (n) */
|
||||
const lua_char *namewhat; /* (n) `global', `tag method', `local', `field' */
|
||||
int nups; /* (u) number of upvalues */
|
||||
int linedefined; /* (S) */
|
||||
const lua_char *what; /* (S) `Lua' function, `C' function, Lua `main' */
|
||||
const lua_char *source; /* (S) */
|
||||
lua_char short_src[LUA_IDSIZE]; /* (S) */
|
||||
/* private part */
|
||||
struct CallInfo *_ci; /* active function */
|
||||
};
|
||||
|
||||
|
||||
#endif
|
||||
27
lualib.h
27
lualib.h
@@ -1,28 +1,15 @@
|
||||
/*
|
||||
** $Id: lualib.h,v 1.20 2001/03/06 20:09:38 roberto Exp roberto $
|
||||
** Lua standard libraries
|
||||
** See Copyright Notice in lua.h
|
||||
** Libraries to use in LUA programs
|
||||
** Grupo de Tecnologia em Computacao Grafica
|
||||
** TeCGraf - PUC-Rio
|
||||
** 19 May 93
|
||||
*/
|
||||
|
||||
|
||||
#ifndef lualib_h
|
||||
#define lualib_h
|
||||
|
||||
#include "lua.h"
|
||||
|
||||
|
||||
#ifndef LUALIB_API
|
||||
#define LUALIB_API extern
|
||||
#endif
|
||||
|
||||
|
||||
#define LUA_ALERT "_ALERT"
|
||||
|
||||
LUALIB_API int lua_baselibopen (lua_State *L);
|
||||
LUALIB_API int lua_iolibopen (lua_State *L);
|
||||
LUALIB_API int lua_strlibopen (lua_State *L);
|
||||
LUALIB_API int lua_mathlibopen (lua_State *L);
|
||||
LUALIB_API int lua_dblibopen (lua_State *L);
|
||||
|
||||
void iolib_open (void);
|
||||
void strlib_open (void);
|
||||
void mathlib_open (void);
|
||||
|
||||
#endif
|
||||
|
||||
264
lundump.c
264
lundump.c
@@ -1,264 +0,0 @@
|
||||
/*
|
||||
** $Id: lundump.c,v 1.36 2001/07/19 14:34:06 lhf Exp lhf $
|
||||
** load pre-compiled Lua chunks
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
|
||||
#define LUA_PRIVATE
|
||||
#include "lua.h"
|
||||
|
||||
#include "ldebug.h"
|
||||
#include "lfunc.h"
|
||||
#include "lmem.h"
|
||||
#include "lopcodes.h"
|
||||
#include "lstring.h"
|
||||
#include "lundump.h"
|
||||
|
||||
#define LoadByte ezgetc
|
||||
#define LoadShort (short) LoadInt
|
||||
|
||||
static const l_char* ZNAME (ZIO* Z)
|
||||
{
|
||||
const l_char* s=zname(Z);
|
||||
return (*s==l_c('@')) ? s+1 : s;
|
||||
}
|
||||
|
||||
static void unexpectedEOZ (lua_State* L, ZIO* Z)
|
||||
{
|
||||
luaO_verror(L,l_s("unexpected end of file in `%.99s'"),ZNAME(Z));
|
||||
}
|
||||
|
||||
static int ezgetc (lua_State* L, ZIO* Z)
|
||||
{
|
||||
int c=zgetc(Z);
|
||||
if (c==EOZ) unexpectedEOZ(L,Z);
|
||||
return c;
|
||||
}
|
||||
|
||||
static void ezread (lua_State* L, ZIO* Z, void* b, int n)
|
||||
{
|
||||
int r=zread(Z,b,n);
|
||||
if (r!=0) unexpectedEOZ(L,Z);
|
||||
}
|
||||
|
||||
static void LoadBlock (lua_State* L, void* b, size_t size, ZIO* Z, int swap)
|
||||
{
|
||||
if (swap)
|
||||
{
|
||||
l_char *p=(l_char*) b+size-1;
|
||||
int n=size;
|
||||
while (n--) *p--=(l_char)ezgetc(L,Z);
|
||||
}
|
||||
else
|
||||
ezread(L,Z,b,size);
|
||||
}
|
||||
|
||||
static void LoadVector (lua_State* L, void* b, int m, size_t size, ZIO* Z, int swap)
|
||||
{
|
||||
if (swap)
|
||||
{
|
||||
l_char *q=(l_char*) b;
|
||||
while (m--)
|
||||
{
|
||||
l_char *p=q+size-1;
|
||||
int n=size;
|
||||
while (n--) *p--=(l_char)ezgetc(L,Z);
|
||||
q+=size;
|
||||
}
|
||||
}
|
||||
else
|
||||
ezread(L,Z,b,m*size);
|
||||
}
|
||||
|
||||
static int LoadInt (lua_State* L, ZIO* Z, int swap)
|
||||
{
|
||||
int x;
|
||||
LoadBlock(L,&x,sizeof(x),Z,swap);
|
||||
return x;
|
||||
}
|
||||
|
||||
static size_t LoadSize (lua_State* L, ZIO* Z, int swap)
|
||||
{
|
||||
size_t x;
|
||||
LoadBlock(L,&x,sizeof(x),Z,swap);
|
||||
return x;
|
||||
}
|
||||
|
||||
static lua_Number LoadNumber (lua_State* L, ZIO* Z, int swap)
|
||||
{
|
||||
lua_Number x;
|
||||
LoadBlock(L,&x,sizeof(x),Z,swap);
|
||||
return x;
|
||||
}
|
||||
|
||||
static TString* LoadString (lua_State* L, ZIO* Z, int swap)
|
||||
{
|
||||
size_t size=LoadSize(L,Z,swap);
|
||||
if (size==0)
|
||||
return NULL;
|
||||
else
|
||||
{
|
||||
l_char* s=luaO_openspace(L,size,l_char);
|
||||
LoadBlock(L,s,size,Z,0);
|
||||
return luaS_newlstr(L,s,size-1); /* remove trailing '\0' */
|
||||
}
|
||||
}
|
||||
|
||||
static void LoadCode (lua_State* L, Proto* f, ZIO* Z, int swap)
|
||||
{
|
||||
int size=LoadInt(L,Z,swap);
|
||||
f->code=luaM_newvector(L,size,Instruction);
|
||||
f->sizecode=size;
|
||||
LoadVector(L,f->code,size,sizeof(*f->code),Z,swap);
|
||||
}
|
||||
|
||||
static void LoadLocals (lua_State* L, Proto* f, ZIO* Z, int swap)
|
||||
{
|
||||
int i,n;
|
||||
n=LoadInt(L,Z,swap);
|
||||
f->locvars=luaM_newvector(L,n,LocVar);
|
||||
f->sizelocvars=n;
|
||||
for (i=0; i<n; i++)
|
||||
{
|
||||
f->locvars[i].varname=LoadString(L,Z,swap);
|
||||
f->locvars[i].startpc=LoadInt(L,Z,swap);
|
||||
f->locvars[i].endpc=LoadInt(L,Z,swap);
|
||||
}
|
||||
}
|
||||
|
||||
static void LoadLines (lua_State* L, Proto* f, ZIO* Z, int swap)
|
||||
{
|
||||
int n;
|
||||
n=LoadInt(L,Z,swap);
|
||||
f->lineinfo=luaM_newvector(L,n,int);
|
||||
f->sizelineinfo=n;
|
||||
LoadVector(L,f->lineinfo,n,sizeof(*f->lineinfo),Z,swap);
|
||||
}
|
||||
|
||||
static Proto* LoadFunction (lua_State* L, TString* p, ZIO* Z, int swap);
|
||||
|
||||
static void LoadConstants (lua_State* L, Proto* f, ZIO* Z, int swap)
|
||||
{
|
||||
int i,n;
|
||||
n=LoadInt(L,Z,swap);
|
||||
f->k=luaM_newvector(L,n,TObject);
|
||||
f->sizek=n;
|
||||
for (i=0; i<n; i++)
|
||||
{
|
||||
TObject* o=&f->k[i];
|
||||
ttype(o)=LoadByte(L,Z);
|
||||
switch (ttype(o))
|
||||
{
|
||||
case LUA_TNUMBER:
|
||||
nvalue(o)=LoadNumber(L,Z,swap);
|
||||
break;
|
||||
case LUA_TSTRING:
|
||||
tsvalue(o)=LoadString(L,Z,swap);
|
||||
break;
|
||||
default:
|
||||
luaO_verror(L,l_s("bad constant type (%d) in `%.99s'"),ttype(o),ZNAME(Z));
|
||||
break;
|
||||
}
|
||||
}
|
||||
n=LoadInt(L,Z,swap);
|
||||
f->p=luaM_newvector(L,n,Proto*);
|
||||
f->sizep=n;
|
||||
for (i=0; i<n; i++) f->p[i]=LoadFunction(L,f->source,Z,swap);
|
||||
}
|
||||
|
||||
static Proto* LoadFunction (lua_State* L, TString* p, ZIO* Z, int swap)
|
||||
{
|
||||
Proto* f=luaF_newproto(L);
|
||||
f->source=LoadString(L,Z,swap); if (f->source==NULL) f->source=p;
|
||||
f->lineDefined=LoadInt(L,Z,swap);
|
||||
f->nupvalues=LoadShort(L,Z,swap);
|
||||
f->numparams=LoadShort(L,Z,swap);
|
||||
f->is_vararg=LoadShort(L,Z,swap);
|
||||
f->maxstacksize=LoadShort(L,Z,swap);
|
||||
LoadLocals(L,f,Z,swap);
|
||||
LoadLines(L,f,Z,swap);
|
||||
LoadConstants(L,f,Z,swap);
|
||||
LoadCode(L,f,Z,swap);
|
||||
#ifndef TRUST_BINARIES
|
||||
if (!luaG_checkcode(f)) luaO_verror(L,l_s("bad code in `%.99s'"),ZNAME(Z));
|
||||
#endif
|
||||
return f;
|
||||
}
|
||||
|
||||
static void LoadSignature (lua_State* L, ZIO* Z)
|
||||
{
|
||||
const l_char* s=l_s(LUA_SIGNATURE);
|
||||
while (*s!=0 && ezgetc(L,Z)==*s)
|
||||
++s;
|
||||
if (*s!=0) luaO_verror(L,l_s("bad signature in `%.99s'"),ZNAME(Z));
|
||||
}
|
||||
|
||||
static void TestSize (lua_State* L, int s, const l_char* what, ZIO* Z)
|
||||
{
|
||||
int r=LoadByte(L,Z);
|
||||
if (r!=s)
|
||||
luaO_verror(L,l_s("virtual machine mismatch in `%.99s':\n")
|
||||
l_s(" size of %.20s is %d but read %d"),ZNAME(Z),what,s,r);
|
||||
}
|
||||
|
||||
#define TESTSIZE(s,w) TestSize(L,s,w,Z)
|
||||
#define V(v) v/16,v%16
|
||||
|
||||
static int LoadHeader (lua_State* L, ZIO* Z)
|
||||
{
|
||||
int version,swap;
|
||||
lua_Number x=0,tx=TEST_NUMBER;
|
||||
LoadSignature(L,Z);
|
||||
version=LoadByte(L,Z);
|
||||
if (version>VERSION)
|
||||
luaO_verror(L,l_s("`%.99s' too new:\n")
|
||||
l_s(" read version %d.%d; expected at most %d.%d"),
|
||||
ZNAME(Z),V(version),V(VERSION));
|
||||
if (version<VERSION0) /* check last major change */
|
||||
luaO_verror(L,l_s("`%.99s' too old:\n")
|
||||
l_s(" read version %d.%d; expected at least %d.%d"),
|
||||
ZNAME(Z),V(version),V(VERSION));
|
||||
swap=(luaU_endianness()!=LoadByte(L,Z)); /* need to swap bytes? */
|
||||
TESTSIZE(sizeof(int),l_s("int"));
|
||||
TESTSIZE(sizeof(size_t), l_s("size_t"));
|
||||
TESTSIZE(sizeof(Instruction), l_s("size_t"));
|
||||
TESTSIZE(SIZE_OP, l_s("OP"));
|
||||
TESTSIZE(SIZE_A, l_s("A"));
|
||||
TESTSIZE(SIZE_B, l_s("B"));
|
||||
TESTSIZE(SIZE_C, l_s("C"));
|
||||
TESTSIZE(sizeof(lua_Number), l_s("number"));
|
||||
x=LoadNumber(L,Z,swap);
|
||||
if ((long)x!=(long)tx) /* disregard errors in last bits of fraction */
|
||||
luaO_verror(L,l_s("unknown number format in `%.99s':\n")
|
||||
l_s(" read ") l_s(LUA_NUMBER_FMT) l_s("; expected ") l_s(LUA_NUMBER_FMT),
|
||||
ZNAME(Z),x,tx);
|
||||
return swap;
|
||||
}
|
||||
|
||||
static Proto* LoadChunk (lua_State* L, ZIO* Z)
|
||||
{
|
||||
return LoadFunction(L,NULL,Z,LoadHeader(L,Z));
|
||||
}
|
||||
|
||||
/*
|
||||
** load one chunk from a file or buffer
|
||||
*/
|
||||
Proto* luaU_undump (lua_State* L, ZIO* Z)
|
||||
{
|
||||
Proto* f=LoadChunk(L,Z);
|
||||
if (zgetc(Z)!=EOZ)
|
||||
luaO_verror(L,l_s("`%.99s' apparently contains more than one chunk"),ZNAME(Z));
|
||||
return f;
|
||||
}
|
||||
|
||||
/*
|
||||
** find byte order
|
||||
*/
|
||||
int luaU_endianness (void)
|
||||
{
|
||||
int x=1;
|
||||
return *(l_char*)&x;
|
||||
}
|
||||
28
lundump.h
28
lundump.h
@@ -1,28 +0,0 @@
|
||||
/*
|
||||
** $Id: lundump.h,v 1.23 2001/06/28 13:55:17 lhf Exp lhf $
|
||||
** load pre-compiled Lua chunks
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
#ifndef lundump_h
|
||||
#define lundump_h
|
||||
|
||||
#include "lobject.h"
|
||||
#include "lzio.h"
|
||||
|
||||
/* load one chunk */
|
||||
Proto* luaU_undump (lua_State* L, ZIO* Z);
|
||||
|
||||
/* find byte order */
|
||||
int luaU_endianness (void);
|
||||
|
||||
/* definitions for headers of binary files */
|
||||
#define VERSION 0x41 /* last format change was in 4.1 */
|
||||
#define VERSION0 0x41 /* last major change was in 4.1 */
|
||||
#define LUA_SIGNATURE "\033Lua" /* binary files start with <esc>Lua */
|
||||
|
||||
/* a multiple of PI for testing native format */
|
||||
/* multiplying by 1E8 gives non-trivial integer values */
|
||||
#define TEST_NUMBER 3.14159265358979323846E8
|
||||
|
||||
#endif
|
||||
658
lvm.c
658
lvm.c
@@ -1,658 +0,0 @@
|
||||
/*
|
||||
** $Id: lvm.c,v 1.189 2001/06/28 14:48:44 roberto Exp roberto $
|
||||
** Lua virtual machine
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
#include <stdarg.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
#define LUA_PRIVATE
|
||||
#include "lua.h"
|
||||
|
||||
#include "lapi.h"
|
||||
#include "ldebug.h"
|
||||
#include "ldo.h"
|
||||
#include "lfunc.h"
|
||||
#include "lgc.h"
|
||||
#include "lobject.h"
|
||||
#include "lopcodes.h"
|
||||
#include "lstate.h"
|
||||
#include "lstring.h"
|
||||
#include "ltable.h"
|
||||
#include "ltm.h"
|
||||
#include "lvm.h"
|
||||
|
||||
|
||||
|
||||
static void luaV_checkGC (lua_State *L, StkId top) {
|
||||
if (G(L)->nblocks >= G(L)->GCthreshold) {
|
||||
StkId temp = L->top;
|
||||
L->top = top;
|
||||
luaC_collectgarbage(L);
|
||||
L->top = temp; /* restore old top position */
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
const TObject *luaV_tonumber (const TObject *obj, TObject *n) {
|
||||
lua_Number num;
|
||||
if (ttype(obj) == LUA_TNUMBER) return obj;
|
||||
if (ttype(obj) == LUA_TSTRING && luaO_str2d(svalue(obj), &num)) {
|
||||
setnvalue(n, num);
|
||||
return n;
|
||||
}
|
||||
else
|
||||
return NULL;
|
||||
}
|
||||
|
||||
|
||||
int luaV_tostring (lua_State *L, TObject *obj) {
|
||||
if (ttype(obj) != LUA_TNUMBER)
|
||||
return 1;
|
||||
else {
|
||||
l_char s[32]; /* 16 digits, sign, point and \0 (+ some extra...) */
|
||||
lua_number2str(s, nvalue(obj)); /* convert `s' to number */
|
||||
setsvalue(obj, luaS_new(L, s));
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void traceexec (lua_State *L, lua_Hook linehook) {
|
||||
CallInfo *ci = L->ci;
|
||||
int *lineinfo = ci_func(ci)->f.l->lineinfo;
|
||||
int pc = (*ci->pc - ci_func(ci)->f.l->code) - 1;
|
||||
int newline;
|
||||
if (pc == 0) { /* may be first time? */
|
||||
ci->line = 1;
|
||||
ci->refi = 0;
|
||||
ci->lastpc = pc+1; /* make sure it will call linehook */
|
||||
}
|
||||
newline = luaG_getline(lineinfo, pc, ci->line, &ci->refi);
|
||||
/* calls linehook when enters a new line or jumps back (loop) */
|
||||
if (newline != ci->line || pc <= ci->lastpc) {
|
||||
ci->line = newline;
|
||||
luaD_lineHook(L, newline, linehook);
|
||||
}
|
||||
ci->lastpc = pc;
|
||||
}
|
||||
|
||||
|
||||
static Closure *luaV_closure (lua_State *L, int nelems) {
|
||||
Closure *c = luaF_newclosure(L, nelems);
|
||||
L->top -= nelems;
|
||||
while (nelems--)
|
||||
setobj(&c->upvalue[nelems], L->top+nelems);
|
||||
setclvalue(L->top, c);
|
||||
incr_top;
|
||||
return c;
|
||||
}
|
||||
|
||||
|
||||
void luaV_Cclosure (lua_State *L, lua_CFunction c, int nelems) {
|
||||
Closure *cl = luaV_closure(L, nelems);
|
||||
cl->f.c = c;
|
||||
cl->isC = 1;
|
||||
}
|
||||
|
||||
|
||||
void luaV_Lclosure (lua_State *L, Proto *l, int nelems) {
|
||||
Closure *cl = luaV_closure(L, nelems);
|
||||
cl->f.l = l;
|
||||
cl->isC = 0;
|
||||
}
|
||||
|
||||
|
||||
/* maximum stack used by a call to a tag method (func + args) */
|
||||
#define MAXSTACK_TM 4
|
||||
|
||||
static StkId callTM (lua_State *L, Closure *f, const l_char *fmt, ...) {
|
||||
va_list argp;
|
||||
StkId base = L->top;
|
||||
lua_assert(strlen(fmt)+1 <= MAXSTACK_TM);
|
||||
luaD_checkstack(L, MAXSTACK_TM);
|
||||
va_start(argp, fmt);
|
||||
setclvalue(L->top, f); /* push function */
|
||||
L->top++;
|
||||
while (*fmt) {
|
||||
if (*fmt++ == l_c('o')) {
|
||||
setobj(L->top, va_arg(argp, TObject *));
|
||||
}
|
||||
else {
|
||||
lua_assert(*(fmt-1) == l_c('s'));
|
||||
setsvalue(L->top, va_arg(argp, TString *));
|
||||
}
|
||||
L->top++;
|
||||
}
|
||||
luaD_call(L, base);
|
||||
va_end(argp);
|
||||
return base;
|
||||
}
|
||||
|
||||
|
||||
#define setTM(L, base) (L->top = (base))
|
||||
|
||||
static void setTMresult (lua_State *L, TObject *result, StkId base) {
|
||||
if (L->top == base) { /* are there valid results? */
|
||||
setnilvalue(result); /* function had no results */
|
||||
}
|
||||
else {
|
||||
setobj(result, base); /* get first result */
|
||||
}
|
||||
L->top = base; /* restore top */
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Function to index a table.
|
||||
** Receives the table at `t' and the key at the `key'.
|
||||
** leaves the result at `res'.
|
||||
*/
|
||||
void luaV_gettable (lua_State *L, StkId t, TObject *key, StkId res) {
|
||||
Closure *tm;
|
||||
if (ttype(t) == LUA_TTABLE) { /* `t' is a table? */
|
||||
int tg = hvalue(t)->htag;
|
||||
if (tg == LUA_TTABLE || /* with default tag? */
|
||||
(tm = luaT_gettm(G(L), tg, TM_GETTABLE)) == NULL) { /* or no TM? */
|
||||
const TObject *h = luaH_get(hvalue(t), key); /* do a primitive get */
|
||||
/* result is no nil or there is no `index' tag method? */
|
||||
if (ttype(h) != LUA_TNIL || /* no nil? */
|
||||
((tm=luaT_gettm(G(L), tg, TM_INDEX)) == NULL)) { /* or no index TM? */
|
||||
setobj(res, h); /* default get */
|
||||
return;
|
||||
}
|
||||
}
|
||||
/* else will call the tag method */
|
||||
} else { /* not a table; try a `gettable' tag method */
|
||||
tm = luaT_gettmbyObj(G(L), t, TM_GETTABLE);
|
||||
if (tm == NULL) /* no tag method? */
|
||||
luaG_typeerror(L, t, l_s("index"));
|
||||
}
|
||||
setTMresult(L, res, callTM(L, tm, l_s("oo"), t, key));
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** Receives table at `t', key at `key' and value at `val'.
|
||||
*/
|
||||
void luaV_settable (lua_State *L, StkId t, TObject *key, StkId val) {
|
||||
Closure *tm;
|
||||
if (ttype(t) == LUA_TTABLE) { /* `t' is a table? */
|
||||
int tg = hvalue(t)->htag;
|
||||
if (hvalue(t)->htag == LUA_TTABLE || /* with default tag? */
|
||||
(tm = luaT_gettm(G(L), tg, TM_SETTABLE)) == NULL) { /* or no TM? */
|
||||
setobj(luaH_set(L, hvalue(t), key), val); /* do a primitive set */
|
||||
return;
|
||||
}
|
||||
/* else will call the tag method */
|
||||
} else { /* not a table; try a `settable' tag method */
|
||||
tm = luaT_gettmbyObj(G(L), t, TM_SETTABLE);
|
||||
if (tm == NULL) /* no tag method? */
|
||||
luaG_typeerror(L, t, l_s("index"));
|
||||
}
|
||||
setTM(L, callTM(L, tm, l_s("ooo"), t, key, val));
|
||||
}
|
||||
|
||||
|
||||
void luaV_getglobal (lua_State *L, TString *name, StkId res) {
|
||||
const TObject *value = luaH_getstr(L->gt, name);
|
||||
Closure *tm;
|
||||
if (!HAS_TM_GETGLOBAL(L, ttype(value)) || /* is there a tag method? */
|
||||
(tm = luaT_gettmbyObj(G(L), value, TM_GETGLOBAL)) == NULL) {
|
||||
setobj(res, value); /* default behavior */
|
||||
}
|
||||
else
|
||||
setTMresult(L, res, callTM(L, tm, l_s("so"), name, value));
|
||||
}
|
||||
|
||||
|
||||
void luaV_setglobal (lua_State *L, TString *name, StkId val) {
|
||||
TObject *oldvalue = luaH_setstr(L, L->gt, name);
|
||||
Closure *tm;
|
||||
if (!HAS_TM_SETGLOBAL(L, ttype(oldvalue)) || /* no tag methods? */
|
||||
(tm = luaT_gettmbyObj(G(L), oldvalue, TM_SETGLOBAL)) == NULL) {
|
||||
setobj(oldvalue, val); /* raw set */
|
||||
}
|
||||
else
|
||||
setTM(L, callTM(L, tm, l_s("soo"), name, oldvalue, val));
|
||||
}
|
||||
|
||||
|
||||
static int call_binTM (lua_State *L, const TObject *p1, const TObject *p2,
|
||||
TObject *res, TMS event) {
|
||||
Closure *tm = luaT_gettmbyObj(G(L), p1, event); /* try first operand */
|
||||
if (tm == NULL) {
|
||||
tm = luaT_gettmbyObj(G(L), p2, event); /* try second operand */
|
||||
if (tm == NULL) {
|
||||
tm = luaT_gettm(G(L), 0, event); /* try a `global' method */
|
||||
if (tm == NULL)
|
||||
return 0; /* no tag method */
|
||||
}
|
||||
}
|
||||
setTMresult(L, res, callTM(L, tm, l_s("oo"), p1, p2));
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
static void call_arith (lua_State *L, StkId p1, TObject *p2,
|
||||
StkId res, TMS event) {
|
||||
if (!call_binTM(L, p1, p2, res, event))
|
||||
luaG_aritherror(L, p1, p2);
|
||||
}
|
||||
|
||||
|
||||
static int luaV_strlessthan (const TString *ls, const TString *rs) {
|
||||
const l_char *l = getstr(ls);
|
||||
size_t ll = ls->tsv.len;
|
||||
const l_char *r = getstr(rs);
|
||||
size_t lr = rs->tsv.len;
|
||||
for (;;) {
|
||||
int temp = strcoll(l, r);
|
||||
if (temp != 0) return (temp < 0);
|
||||
else { /* strings are equal up to a `\0' */
|
||||
size_t len = strlen(l); /* index of first `\0' in both strings */
|
||||
if (len == lr) /* r is finished? */
|
||||
return 0; /* l is equal or greater than r */
|
||||
else if (len == ll) /* l is finished? */
|
||||
return 1; /* l is smaller than r (because r is not finished) */
|
||||
/* both strings longer than `len'; go on comparing (after the `\0') */
|
||||
len++;
|
||||
l += len; ll -= len; r += len; lr -= len;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
int luaV_lessthan (lua_State *L, const TObject *l, const TObject *r) {
|
||||
if (ttype(l) == LUA_TNUMBER && ttype(r) == LUA_TNUMBER)
|
||||
return (nvalue(l) < nvalue(r));
|
||||
else if (ttype(l) == LUA_TSTRING && ttype(r) == LUA_TSTRING)
|
||||
return luaV_strlessthan(tsvalue(l), tsvalue(r));
|
||||
else { /* try TM */
|
||||
if (!call_binTM(L, l, r, L->top, TM_LT))
|
||||
luaG_ordererror(L, l, r);
|
||||
return (ttype(L->top) != LUA_TNIL);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
void luaV_strconc (lua_State *L, int total, StkId top) {
|
||||
luaV_checkGC(L, top);
|
||||
do {
|
||||
int n = 2; /* number of elements handled in this pass (at least 2) */
|
||||
if (tostring(L, top-2) || tostring(L, top-1)) {
|
||||
if (!call_binTM(L, top-2, top-1, top-2, TM_CONCAT))
|
||||
luaG_concaterror(L, top-2, top-1);
|
||||
} else if (tsvalue(top-1)->tsv.len > 0) { /* if len=0, do nothing */
|
||||
/* at least two string values; get as many as possible */
|
||||
lu_mem tl = (lu_mem)tsvalue(top-1)->tsv.len +
|
||||
(lu_mem)tsvalue(top-2)->tsv.len;
|
||||
l_char *buffer;
|
||||
int i;
|
||||
while (n < total && !tostring(L, top-n-1)) { /* collect total length */
|
||||
tl += tsvalue(top-n-1)->tsv.len;
|
||||
n++;
|
||||
}
|
||||
if (tl > MAX_SIZET) luaD_error(L, l_s("string size overflow"));
|
||||
buffer = luaO_openspace(L, tl, l_char);
|
||||
tl = 0;
|
||||
for (i=n; i>0; i--) { /* concat all strings */
|
||||
size_t l = tsvalue(top-i)->tsv.len;
|
||||
memcpy(buffer+tl, svalue(top-i), l);
|
||||
tl += l;
|
||||
}
|
||||
setsvalue(top-n, luaS_newlstr(L, buffer, tl));
|
||||
}
|
||||
total -= n-1; /* got `n' strings to create 1 new */
|
||||
top -= n-1;
|
||||
} while (total > 1); /* repeat until only 1 result left */
|
||||
}
|
||||
|
||||
|
||||
static void luaV_pack (lua_State *L, StkId firstelem) {
|
||||
int i;
|
||||
Hash *htab = luaH_new(L, 0);
|
||||
TObject *n;
|
||||
for (i=0; firstelem+i<L->top; i++)
|
||||
setobj(luaH_setnum(L, htab, i+1), firstelem+i);
|
||||
/* store counter in field `n' */
|
||||
n = luaH_setstr(L, htab, luaS_newliteral(L, l_s("n")));
|
||||
setnvalue(n, i);
|
||||
L->top = firstelem; /* remove elements from the stack */
|
||||
sethvalue(L->top, htab);
|
||||
incr_top;
|
||||
}
|
||||
|
||||
|
||||
static void adjust_varargs (lua_State *L, StkId base, int nfixargs) {
|
||||
int nvararg = (L->top-base) - nfixargs;
|
||||
StkId firstvar = base + nfixargs; /* position of first vararg */
|
||||
if (nvararg < 0) {
|
||||
luaD_checkstack(L, -nvararg);
|
||||
luaD_adjusttop(L, firstvar);
|
||||
}
|
||||
luaV_pack(L, firstvar);
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** some macros for common tasks in `luaV_execute'
|
||||
*/
|
||||
|
||||
#define runtime_check(L, c) { if (!(c)) return L->top; }
|
||||
|
||||
#define RA(i) (base+GETARG_A(i))
|
||||
#define RB(i) (base+GETARG_B(i))
|
||||
#define RC(i) (base+GETARG_C(i))
|
||||
#define RKC(i) ((GETARG_C(i) < MAXSTACK) ? \
|
||||
base+GETARG_C(i) : \
|
||||
tf->k+GETARG_C(i)-MAXSTACK)
|
||||
#define KBc(i) (tf->k+GETARG_Bc(i))
|
||||
|
||||
#define Arith(op, optm) { \
|
||||
const TObject *b = RB(i); const TObject *c = RKC(i); \
|
||||
TObject tempb, tempc; \
|
||||
if ((ttype(b) == LUA_TNUMBER || (b = luaV_tonumber(b, &tempb)) != NULL) && \
|
||||
(ttype(c) == LUA_TNUMBER || (c = luaV_tonumber(c, &tempc)) != NULL)) { \
|
||||
setnvalue(ra, nvalue(b) op nvalue(c)); \
|
||||
} else \
|
||||
call_arith(L, RB(i), RKC(i), ra, optm); \
|
||||
}
|
||||
|
||||
|
||||
#define dojump(pc, i) ((pc) += GETARG_sBc(i))
|
||||
|
||||
/*
|
||||
** Executes the given Lua function. Parameters are between [base,top).
|
||||
** Returns n such that the the results are between [n,top).
|
||||
*/
|
||||
StkId luaV_execute (lua_State *L, const Closure *cl, StkId base) {
|
||||
const Proto *const tf = cl->f.l;
|
||||
const Instruction *pc;
|
||||
lua_Hook linehook;
|
||||
if (tf->is_vararg) /* varargs? */
|
||||
adjust_varargs(L, base, tf->numparams);
|
||||
if (base > L->stack_last - tf->maxstacksize)
|
||||
luaD_stackerror(L);
|
||||
luaD_adjusttop(L, base + tf->maxstacksize);
|
||||
pc = tf->code;
|
||||
L->ci->pc = &pc;
|
||||
linehook = L->linehook;
|
||||
/* main loop of interpreter */
|
||||
for (;;) {
|
||||
const Instruction i = *pc++;
|
||||
const StkId ra = RA(i);
|
||||
if (linehook)
|
||||
traceexec(L, linehook);
|
||||
switch (GET_OPCODE(i)) {
|
||||
case OP_MOVE: {
|
||||
setobj(ra, RB(i));
|
||||
break;
|
||||
}
|
||||
case OP_LOADK: {
|
||||
setobj(ra, KBc(i));
|
||||
break;
|
||||
}
|
||||
case OP_LOADINT: {
|
||||
setnvalue(ra, (lua_Number)GETARG_sBc(i));
|
||||
break;
|
||||
}
|
||||
case OP_LOADUPVAL: {
|
||||
setobj(ra, cl->upvalue+GETARG_Bc(i));
|
||||
break;
|
||||
}
|
||||
case OP_LOADNIL: {
|
||||
TObject *rb = RB(i);
|
||||
do {
|
||||
setnilvalue(rb--);
|
||||
} while (rb >= ra);
|
||||
break;
|
||||
}
|
||||
case OP_GETGLOBAL: {
|
||||
lua_assert(ttype(KBc(i)) == LUA_TSTRING);
|
||||
luaV_getglobal(L, tsvalue(KBc(i)), ra);
|
||||
break;
|
||||
}
|
||||
case OP_GETTABLE: {
|
||||
luaV_gettable(L, RB(i), RKC(i), ra);
|
||||
break;
|
||||
}
|
||||
case OP_SETGLOBAL: {
|
||||
lua_assert(ttype(KBc(i)) == LUA_TSTRING);
|
||||
luaV_setglobal(L, tsvalue(KBc(i)), ra);
|
||||
break;
|
||||
}
|
||||
case OP_SETTABLE: {
|
||||
luaV_settable(L, RB(i), RKC(i), ra);
|
||||
break;
|
||||
}
|
||||
case OP_NEWTABLE: {
|
||||
sethvalue(ra, luaH_new(L, GETARG_Bc(i)));
|
||||
luaV_checkGC(L, ra+1);
|
||||
break;
|
||||
}
|
||||
case OP_SELF: {
|
||||
StkId rb = RB(i);
|
||||
setobj(ra+1, rb);
|
||||
luaV_gettable(L, rb, RKC(i), ra);
|
||||
break;
|
||||
}
|
||||
case OP_ADD: {
|
||||
Arith( + , TM_ADD);
|
||||
break;
|
||||
}
|
||||
case OP_SUB: {
|
||||
Arith( - , TM_SUB);
|
||||
break;
|
||||
}
|
||||
case OP_MUL: {
|
||||
Arith( * , TM_MUL);
|
||||
break;
|
||||
}
|
||||
case OP_DIV: {
|
||||
Arith( / , TM_DIV);
|
||||
break;
|
||||
}
|
||||
case OP_POW: {
|
||||
call_arith(L, RB(i), RKC(i), ra, TM_POW);
|
||||
break;
|
||||
}
|
||||
case OP_UNM: {
|
||||
const TObject *rb = RB(i);
|
||||
if (ttype(rb) == LUA_TNUMBER || (rb=luaV_tonumber(rb, ra)) != NULL) {
|
||||
setnvalue(ra, -nvalue(rb));
|
||||
}
|
||||
else {
|
||||
TObject temp;
|
||||
setnilvalue(&temp);
|
||||
call_arith(L, RB(i), &temp, ra, TM_UNM);
|
||||
}
|
||||
break;
|
||||
}
|
||||
case OP_NOT: {
|
||||
if (ttype(RB(i)) == LUA_TNIL) {
|
||||
setnvalue(ra, 1);
|
||||
} else {
|
||||
setnilvalue(ra);
|
||||
}
|
||||
break;
|
||||
}
|
||||
case OP_CONCAT: {
|
||||
StkId top = RC(i)+1;
|
||||
StkId rb = RB(i);
|
||||
luaV_strconc(L, top-rb, top);
|
||||
setobj(ra, rb);
|
||||
break;
|
||||
}
|
||||
case OP_CJMP:
|
||||
case OP_JMP: {
|
||||
dojump(pc, i);
|
||||
break;
|
||||
}
|
||||
case OP_TESTEQ: {
|
||||
lua_assert(GET_OPCODE(*pc) == OP_CJMP);
|
||||
if (luaO_equalObj(ra, RKC(i))) dojump(pc, *pc);
|
||||
pc++;
|
||||
break;
|
||||
}
|
||||
case OP_TESTNE: {
|
||||
lua_assert(GET_OPCODE(*pc) == OP_CJMP);
|
||||
if (!luaO_equalObj(ra, RKC(i))) dojump(pc, *pc);
|
||||
pc++;
|
||||
break;
|
||||
}
|
||||
case OP_TESTLT: {
|
||||
lua_assert(GET_OPCODE(*pc) == OP_CJMP);
|
||||
if (luaV_lessthan(L, ra, RKC(i))) dojump(pc, *pc);
|
||||
pc++;
|
||||
break;
|
||||
}
|
||||
case OP_TESTLE: { /* b <= c === !(c<b) */
|
||||
lua_assert(GET_OPCODE(*pc) == OP_CJMP);
|
||||
if (!luaV_lessthan(L, RKC(i), ra)) dojump(pc, *pc);
|
||||
pc++;
|
||||
break;
|
||||
}
|
||||
case OP_TESTGT: { /* b > c === (c<b) */
|
||||
lua_assert(GET_OPCODE(*pc) == OP_CJMP);
|
||||
if (luaV_lessthan(L, RKC(i), ra)) dojump(pc, *pc);
|
||||
pc++;
|
||||
break;
|
||||
}
|
||||
case OP_TESTGE: { /* b >= c === !(b<c) */
|
||||
lua_assert(GET_OPCODE(*pc) == OP_CJMP);
|
||||
if (!luaV_lessthan(L, ra, RKC(i))) dojump(pc, *pc);
|
||||
pc++;
|
||||
break;
|
||||
}
|
||||
case OP_TESTT: {
|
||||
StkId rb = RB(i);
|
||||
lua_assert(GET_OPCODE(*pc) == OP_CJMP);
|
||||
if (ttype(rb) != LUA_TNIL) {
|
||||
setobj(ra, rb);
|
||||
dojump(pc, *pc);
|
||||
}
|
||||
pc++;
|
||||
break;
|
||||
}
|
||||
case OP_TESTF: {
|
||||
lua_assert(GET_OPCODE(*pc) == OP_CJMP);
|
||||
if (ttype(RB(i)) == LUA_TNIL) {
|
||||
setnilvalue(ra);
|
||||
dojump(pc, *pc);
|
||||
}
|
||||
pc++;
|
||||
break;
|
||||
}
|
||||
case OP_NILJMP: {
|
||||
setnilvalue(ra);
|
||||
pc++;
|
||||
break;
|
||||
}
|
||||
case OP_CALL: {
|
||||
int c;
|
||||
int b = GETARG_B(i);
|
||||
if (b != NO_REG)
|
||||
L->top = ra+b+1;
|
||||
luaD_call(L, ra);
|
||||
c = GETARG_C(i);
|
||||
if (c != NO_REG) {
|
||||
while (L->top < ra+c) setnilvalue(L->top++);
|
||||
L->top = base + tf->maxstacksize;
|
||||
}
|
||||
break;
|
||||
}
|
||||
case OP_RETURN: {
|
||||
int b = GETARG_B(i);
|
||||
if (b != NO_REG)
|
||||
L->top = ra+b;
|
||||
return ra;
|
||||
}
|
||||
case OP_FORPREP: {
|
||||
if (luaV_tonumber(ra, ra) == NULL)
|
||||
luaD_error(L, l_s("`for' initial value must be a number"));
|
||||
if (luaV_tonumber(ra+1, ra+1) == NULL)
|
||||
luaD_error(L, l_s("`for' limit must be a number"));
|
||||
if (luaV_tonumber(ra+2, ra+2) == NULL)
|
||||
luaD_error(L, l_s("`for' step must be a number"));
|
||||
/* decrement index (to be incremented) */
|
||||
chgnvalue(ra, nvalue(ra) - nvalue(ra+2));
|
||||
pc += -GETARG_sBc(i); /* `jump' to loop end (delta is negated here) */
|
||||
/* store in `ra+1' total number of repetitions */
|
||||
chgnvalue(ra+1, (nvalue(ra+1)-nvalue(ra))/nvalue(ra+2));
|
||||
/* go through */
|
||||
}
|
||||
case OP_FORLOOP: {
|
||||
runtime_check(L, ttype(ra+1) == LUA_TNUMBER &&
|
||||
ttype(ra+2) == LUA_TNUMBER);
|
||||
if (ttype(ra) != LUA_TNUMBER)
|
||||
luaD_error(L, l_s("`for' index must be a number"));
|
||||
chgnvalue(ra+1, nvalue(ra+1) - 1); /* decrement counter */
|
||||
if (nvalue(ra+1) >= 0) {
|
||||
chgnvalue(ra, nvalue(ra) + nvalue(ra+2)); /* increment index */
|
||||
dojump(pc, i); /* repeat loop */
|
||||
}
|
||||
break;
|
||||
}
|
||||
case OP_TFORPREP: {
|
||||
if (ttype(ra) != LUA_TTABLE)
|
||||
luaD_error(L, l_s("`for' table must be a table"));
|
||||
setnvalue(ra+1, -1); /* initial index */
|
||||
setnilvalue(ra+2);
|
||||
setnilvalue(ra+3);
|
||||
pc += -GETARG_sBc(i); /* `jump' to loop end (delta is negated here) */
|
||||
/* go through */
|
||||
}
|
||||
case OP_TFORLOOP: {
|
||||
Hash *t;
|
||||
int n;
|
||||
runtime_check(L, ttype(ra) == LUA_TTABLE &&
|
||||
ttype(ra+1) == LUA_TNUMBER);
|
||||
t = hvalue(ra);
|
||||
n = (int)nvalue(ra+1);
|
||||
n = luaH_nexti(t, n);
|
||||
if (n != -1) { /* repeat loop? */
|
||||
Node *node = node(t, n);
|
||||
setnvalue(ra+1, n); /* index */
|
||||
setobj(ra+2, key(node));
|
||||
setobj(ra+3, val(node));
|
||||
dojump(pc, i); /* repeat loop */
|
||||
}
|
||||
break;
|
||||
}
|
||||
case OP_SETLIST:
|
||||
case OP_SETLISTO: {
|
||||
int bc;
|
||||
int n;
|
||||
Hash *h;
|
||||
runtime_check(L, ttype(ra) == LUA_TTABLE);
|
||||
h = hvalue(ra);
|
||||
bc = GETARG_Bc(i);
|
||||
if (GET_OPCODE(i) == OP_SETLIST)
|
||||
n = (bc&(LFIELDS_PER_FLUSH-1)) + 1;
|
||||
else
|
||||
n = L->top - ra - 1;
|
||||
bc &= ~(LFIELDS_PER_FLUSH-1); /* bc = bc - bc%FPF */
|
||||
for (; n > 0; n--)
|
||||
setobj(luaH_setnum(L, h, bc+n), ra+n);
|
||||
break;
|
||||
}
|
||||
case OP_CLOSURE: {
|
||||
Proto *p = tf->p[GETARG_Bc(i)];
|
||||
int nup = p->nupvalues;
|
||||
luaV_checkGC(L, ra+nup);
|
||||
L->top = ra+nup;
|
||||
luaV_Lclosure(L, p, nup);
|
||||
L->top = base + tf->maxstacksize;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
31
lvm.h
31
lvm.h
@@ -1,31 +0,0 @@
|
||||
/*
|
||||
** $Id: lvm.h,v 1.29 2001/02/07 18:13:49 roberto Exp roberto $
|
||||
** Lua virtual machine
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
#ifndef lvm_h
|
||||
#define lvm_h
|
||||
|
||||
|
||||
#include "ldo.h"
|
||||
#include "lobject.h"
|
||||
#include "ltm.h"
|
||||
|
||||
|
||||
#define tostring(L,o) ((ttype(o) != LUA_TSTRING) && (luaV_tostring(L, o) != 0))
|
||||
|
||||
|
||||
const TObject *luaV_tonumber (const TObject *obj, TObject *n);
|
||||
int luaV_tostring (lua_State *L, TObject *obj);
|
||||
void luaV_gettable (lua_State *L, StkId t, TObject *key, StkId res);
|
||||
void luaV_settable (lua_State *L, StkId t, TObject *key, StkId val);
|
||||
void luaV_getglobal (lua_State *L, TString *s, StkId res);
|
||||
void luaV_setglobal (lua_State *L, TString *s, StkId val);
|
||||
StkId luaV_execute (lua_State *L, const Closure *cl, StkId base);
|
||||
void luaV_Cclosure (lua_State *L, lua_CFunction c, int nelems);
|
||||
void luaV_Lclosure (lua_State *L, Proto *l, int nelems);
|
||||
int luaV_lessthan (lua_State *L, const TObject *l, const TObject *r);
|
||||
void luaV_strconc (lua_State *L, int total, StkId top);
|
||||
|
||||
#endif
|
||||
88
lzio.c
88
lzio.c
@@ -1,88 +0,0 @@
|
||||
/*
|
||||
** $Id: lzio.c,v 1.13 2000/06/12 13:52:05 roberto Exp roberto $
|
||||
** a generic input stream interface
|
||||
** See Copyright Notice in lua.h
|
||||
*/
|
||||
|
||||
|
||||
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
|
||||
#define LUA_PRIVATE
|
||||
#include "lua.h"
|
||||
|
||||
#include "lzio.h"
|
||||
|
||||
|
||||
|
||||
/* ----------------------------------------------------- memory buffers --- */
|
||||
|
||||
static int zmfilbuf (ZIO* z) {
|
||||
(void)z; /* to avoid warnings */
|
||||
return EOZ;
|
||||
}
|
||||
|
||||
|
||||
ZIO* zmopen (ZIO* z, const char* b, size_t size, const char *name) {
|
||||
if (b==NULL) return NULL;
|
||||
z->n = size;
|
||||
z->p = (const unsigned char *)b;
|
||||
z->filbuf = zmfilbuf;
|
||||
z->u = NULL;
|
||||
z->name = name;
|
||||
return z;
|
||||
}
|
||||
|
||||
/* ------------------------------------------------------------ strings --- */
|
||||
|
||||
ZIO* zsopen (ZIO* z, const char* s, const char *name) {
|
||||
if (s==NULL) return NULL;
|
||||
return zmopen(z, s, strlen(s), name);
|
||||
}
|
||||
|
||||
/* -------------------------------------------------------------- FILEs --- */
|
||||
|
||||
static int zffilbuf (ZIO* z) {
|
||||
size_t n;
|
||||
if (feof((FILE *)z->u)) return EOZ;
|
||||
n = fread(z->buffer, 1, ZBSIZE, (FILE *)z->u);
|
||||
if (n==0) return EOZ;
|
||||
z->n = n-1;
|
||||
z->p = z->buffer;
|
||||
return *(z->p++);
|
||||
}
|
||||
|
||||
|
||||
ZIO* zFopen (ZIO* z, FILE* f, const char *name) {
|
||||
if (f==NULL) return NULL;
|
||||
z->n = 0;
|
||||
z->p = z->buffer;
|
||||
z->filbuf = zffilbuf;
|
||||
z->u = f;
|
||||
z->name = name;
|
||||
return z;
|
||||
}
|
||||
|
||||
|
||||
/* --------------------------------------------------------------- read --- */
|
||||
size_t zread (ZIO *z, void *b, size_t n) {
|
||||
while (n) {
|
||||
size_t m;
|
||||
if (z->n == 0) {
|
||||
if (z->filbuf(z) == EOZ)
|
||||
return n; /* return number of missing bytes */
|
||||
else {
|
||||
++z->n; /* filbuf removed first byte; put back it */
|
||||
--z->p;
|
||||
}
|
||||
}
|
||||
m = (n <= z->n) ? n : z->n; /* min. between n and z->n */
|
||||
memcpy(b, z->p, m);
|
||||
z->n -= m;
|
||||
z->p += m;
|
||||
b = (char *)b + m;
|
||||
n -= m;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
52
lzio.h
52
lzio.h
@@ -1,52 +0,0 @@
|
||||
/*
|
||||
** $Id: lzio.h,v 1.7 2000/10/20 16:36:32 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, const char *name); /* open FILEs */
|
||||
ZIO* zsopen (ZIO* z, const char* s, const char *name); /* string */
|
||||
ZIO* zmopen (ZIO* z, const char* b, size_t size, const char *name); /* memory */
|
||||
|
||||
size_t zread (ZIO* z, void* b, size_t n); /* read next n bytes */
|
||||
|
||||
#define zgetc(z) (((z)->n--)>0 ? ((int)*(z)->p++): (z)->filbuf(z))
|
||||
#define zname(z) ((z)->name)
|
||||
|
||||
|
||||
|
||||
/* --------- Private Part ------------------ */
|
||||
|
||||
#ifndef ZBSIZE
|
||||
#define ZBSIZE 256 /* buffer size */
|
||||
#endif
|
||||
|
||||
struct zio {
|
||||
size_t n; /* bytes still unread */
|
||||
const unsigned char* p; /* current position in buffer */
|
||||
int (*filbuf)(ZIO* z);
|
||||
void* u; /* additional data */
|
||||
const char *name;
|
||||
unsigned char buffer[ZBSIZE]; /* buffer */
|
||||
};
|
||||
|
||||
|
||||
#endif
|
||||
158
makefile
158
makefile
@@ -1,158 +0,0 @@
|
||||
#
|
||||
## $Id: makefile,v 1.31 2001/07/24 17:25:30 roberto Exp roberto $
|
||||
## Makefile
|
||||
## See Copyright Notice in lua.h
|
||||
#
|
||||
|
||||
|
||||
#CONFIGURATION
|
||||
|
||||
# define (undefine) POPEN if your system (does not) support piped I/O
|
||||
#
|
||||
# define (undefine) _POSIX_SOURCE if your system is (not) POSIX compliant
|
||||
#
|
||||
# define (undefine) OLD_ANSI if your system does NOT have some new ANSI
|
||||
# facilities (e.g. strerror, locale.h, memmove). SunOS does not comply;
|
||||
# so, add "-DOLD_ANSI" on SunOS
|
||||
#
|
||||
# define LUA_NUM_TYPE if you need numbers to be different from double
|
||||
# (for instance, -DLUA_NUM_TYPE=float)
|
||||
# you may need to adapat the code, too.
|
||||
#
|
||||
|
||||
#EXTRA_H=-DLUA_USER_H='"ltests.h"'
|
||||
|
||||
CONFIG = -DPOPEN -D_POSIX_SOURCE $(EXTRA_H)
|
||||
#CONFIG = -DOLD_ANSI
|
||||
|
||||
|
||||
# Compilation parameters
|
||||
CC = gcc
|
||||
CWARNS = -Wall -W -pedantic \
|
||||
-Waggregate-return \
|
||||
-Wcast-align \
|
||||
-Wmissing-prototypes \
|
||||
-Wnested-externs \
|
||||
-Wpointer-arith \
|
||||
-Wshadow \
|
||||
-Wwrite-strings \
|
||||
# -Wcast-qual
|
||||
# -Wtraditional
|
||||
|
||||
CFLAGS = $(CONFIG) $(CWARNS) -ansi -O3 -fomit-frame-pointer
|
||||
|
||||
|
||||
# To make early versions
|
||||
CO_OPTIONS =
|
||||
|
||||
|
||||
AR = ar
|
||||
ARFLAGS = rvl
|
||||
|
||||
|
||||
# Aplication modules
|
||||
LUAOBJS = \
|
||||
lstate.o \
|
||||
lapi.o \
|
||||
lmem.o \
|
||||
lstring.o \
|
||||
ltable.o \
|
||||
ltm.o \
|
||||
lvm.o \
|
||||
ldo.o \
|
||||
lobject.o \
|
||||
lfunc.o \
|
||||
lgc.o \
|
||||
lcode.o \
|
||||
lparser.o \
|
||||
llex.o \
|
||||
lopcodes.o \
|
||||
lundump.o \
|
||||
lzio.o \
|
||||
ldebug.o \
|
||||
ltests.o
|
||||
|
||||
LIBOBJS = \
|
||||
lauxlib.o \
|
||||
lbaselib.o \
|
||||
liolib.o \
|
||||
lmathlib.o \
|
||||
lstrlib.o \
|
||||
ldblib.o
|
||||
|
||||
|
||||
lua : lua.o liblua.a liblualib.a
|
||||
$(CC) $(CFLAGS) -o $@ lua.o -L. -llua -llualib -lm
|
||||
|
||||
liblua.a : $(LUAOBJS)
|
||||
$(AR) $(ARFLAGS) $@ $?
|
||||
ranlib $@
|
||||
|
||||
liblualib.a : $(LIBOBJS)
|
||||
$(AR) $(ARFLAGS) $@ $?
|
||||
ranlib $@
|
||||
|
||||
liblua.so.1.0 : lua.o
|
||||
ld -o liblua.so.1.0 $(LUAOBJS)
|
||||
|
||||
|
||||
clear :
|
||||
rcsclean
|
||||
rm -f *.o *.a
|
||||
|
||||
|
||||
%.h : RCS/%.h,v
|
||||
co $(CO_OPTIONS) $@
|
||||
|
||||
%.c : RCS/%.c,v
|
||||
co $(CO_OPTIONS) $@
|
||||
|
||||
|
||||
lapi.o: lapi.c lua.h lapi.h lobject.h llimits.h ldo.h lstate.h \
|
||||
luadebug.h lfunc.h lgc.h lmem.h lstring.h ltable.h ltm.h lvm.h
|
||||
lauxlib.o: lauxlib.c lua.h lauxlib.h luadebug.h lualib.h
|
||||
lbaselib.o: lbaselib.c lua.h lauxlib.h luadebug.h lualib.h
|
||||
lcode.o: lcode.c lua.h lcode.h llex.h lobject.h llimits.h lzio.h \
|
||||
lopcodes.h lparser.h ldebug.h lstate.h luadebug.h ldo.h lmem.h
|
||||
ldblib.o: ldblib.c lua.h lauxlib.h luadebug.h lualib.h
|
||||
ldebug.o: ldebug.c lua.h lapi.h lobject.h llimits.h lcode.h llex.h \
|
||||
lzio.h lopcodes.h lparser.h ldebug.h lstate.h luadebug.h ldo.h \
|
||||
lfunc.h lstring.h ltable.h ltm.h lvm.h
|
||||
ldo.o: ldo.c lua.h ldebug.h lstate.h lobject.h llimits.h luadebug.h \
|
||||
ldo.h lgc.h lmem.h lparser.h lzio.h lstring.h ltable.h ltm.h \
|
||||
lundump.h lvm.h
|
||||
lfunc.o: lfunc.c lua.h lfunc.h lobject.h llimits.h lmem.h lstate.h \
|
||||
luadebug.h
|
||||
lgc.o: lgc.c lua.h ldo.h lobject.h llimits.h lstate.h luadebug.h \
|
||||
lfunc.h lgc.h lmem.h lstring.h ltable.h ltm.h
|
||||
liolib.o: liolib.c lua.h lauxlib.h luadebug.h lualib.h
|
||||
llex.o: llex.c lua.h llex.h lobject.h llimits.h lzio.h lparser.h \
|
||||
lstate.h luadebug.h lstring.h
|
||||
lmathlib.o: lmathlib.c lua.h lauxlib.h lualib.h
|
||||
lmem.o: lmem.c lua.h ldo.h lobject.h llimits.h lstate.h luadebug.h \
|
||||
lmem.h
|
||||
lobject.o: lobject.c lua.h ldo.h lobject.h llimits.h lstate.h \
|
||||
luadebug.h lmem.h
|
||||
lopcodes.o: lopcodes.c lua.h lopcodes.h llimits.h
|
||||
lparser.o: lparser.c lua.h lcode.h llex.h lobject.h llimits.h lzio.h \
|
||||
lopcodes.h lparser.h ldebug.h lstate.h luadebug.h lfunc.h lmem.h \
|
||||
lstring.h
|
||||
lstate.o: lstate.c lua.h ldo.h lobject.h llimits.h lstate.h luadebug.h \
|
||||
lgc.h llex.h lzio.h lmem.h lstring.h ltable.h ltm.h
|
||||
lstring.o: lstring.c lua.h lmem.h llimits.h lobject.h lstate.h \
|
||||
luadebug.h lstring.h
|
||||
lstrlib.o: lstrlib.c lua.h lauxlib.h lualib.h
|
||||
ltable.o: ltable.c lua.h ldo.h lobject.h llimits.h lstate.h luadebug.h \
|
||||
lmem.h ltable.h
|
||||
ltests.o: ltests.c lua.h lapi.h lobject.h llimits.h lauxlib.h lcode.h \
|
||||
llex.h lzio.h lopcodes.h lparser.h ldebug.h lstate.h luadebug.h ldo.h \
|
||||
lfunc.h lmem.h lstring.h ltable.h lualib.h
|
||||
ltm.o: ltm.c lua.h ldo.h lobject.h llimits.h lstate.h luadebug.h \
|
||||
lmem.h lstring.h ltable.h ltm.h
|
||||
lua.o: lua.c lua.h luadebug.h lualib.h
|
||||
lundump.o: lundump.c lua.h ldebug.h lstate.h lobject.h llimits.h \
|
||||
luadebug.h lfunc.h lmem.h lopcodes.h lstring.h lundump.h lzio.h
|
||||
lvm.o: lvm.c lua.h lapi.h lobject.h llimits.h ldebug.h lstate.h \
|
||||
luadebug.h ldo.h lfunc.h lgc.h lopcodes.h lstring.h ltable.h ltm.h \
|
||||
lvm.h
|
||||
lzio.o: lzio.c lua.h lzio.h
|
||||
4171
manual.tex
4171
manual.tex
File diff suppressed because it is too large
Load Diff
234
mathlib.c
Normal file
234
mathlib.c
Normal file
@@ -0,0 +1,234 @@
|
||||
/*
|
||||
** mathlib.c
|
||||
** Mathematica library to LUA
|
||||
**
|
||||
** Waldemar Celes Filho
|
||||
** TeCGraf - PUC-Rio
|
||||
** 19 May 93
|
||||
*/
|
||||
|
||||
#include <stdio.h> /* NULL */
|
||||
#include <math.h>
|
||||
|
||||
#include "lua.h"
|
||||
|
||||
static void math_abs (void)
|
||||
{
|
||||
double d;
|
||||
lua_Object o = lua_getparam (1);
|
||||
if (o == NULL)
|
||||
{ lua_error ("too few arguments to function `abs'"); return; }
|
||||
if (!lua_isnumber(o))
|
||||
{ lua_error ("incorrect arguments to function `abs'"); return; }
|
||||
d = lua_getnumber(o);
|
||||
if (d < 0) d = -d;
|
||||
lua_pushnumber (d);
|
||||
}
|
||||
|
||||
|
||||
static void math_sin (void)
|
||||
{
|
||||
double d;
|
||||
lua_Object o = lua_getparam (1);
|
||||
if (o == NULL)
|
||||
{ lua_error ("too few arguments to function `sin'"); return; }
|
||||
if (!lua_isnumber(o))
|
||||
{ lua_error ("incorrect arguments to function `sin'"); return; }
|
||||
d = lua_getnumber(o);
|
||||
lua_pushnumber (sin(d));
|
||||
}
|
||||
|
||||
|
||||
|
||||
static void math_cos (void)
|
||||
{
|
||||
double d;
|
||||
lua_Object o = lua_getparam (1);
|
||||
if (o == NULL)
|
||||
{ lua_error ("too few arguments to function `cos'"); return; }
|
||||
if (!lua_isnumber(o))
|
||||
{ lua_error ("incorrect arguments to function `cos'"); return; }
|
||||
d = lua_getnumber(o);
|
||||
lua_pushnumber (cos(d));
|
||||
}
|
||||
|
||||
|
||||
|
||||
static void math_tan (void)
|
||||
{
|
||||
double d;
|
||||
lua_Object o = lua_getparam (1);
|
||||
if (o == NULL)
|
||||
{ lua_error ("too few arguments to function `tan'"); return; }
|
||||
if (!lua_isnumber(o))
|
||||
{ lua_error ("incorrect arguments to function `tan'"); return; }
|
||||
d = lua_getnumber(o);
|
||||
lua_pushnumber (tan(d));
|
||||
}
|
||||
|
||||
|
||||
static void math_asin (void)
|
||||
{
|
||||
double d;
|
||||
lua_Object o = lua_getparam (1);
|
||||
if (o == NULL)
|
||||
{ lua_error ("too few arguments to function `asin'"); return; }
|
||||
if (!lua_isnumber(o))
|
||||
{ lua_error ("incorrect arguments to function `asin'"); return; }
|
||||
d = lua_getnumber(o);
|
||||
lua_pushnumber (asin(d));
|
||||
}
|
||||
|
||||
|
||||
static void math_acos (void)
|
||||
{
|
||||
double d;
|
||||
lua_Object o = lua_getparam (1);
|
||||
if (o == NULL)
|
||||
{ lua_error ("too few arguments to function `acos'"); return; }
|
||||
if (!lua_isnumber(o))
|
||||
{ lua_error ("incorrect arguments to function `acos'"); return; }
|
||||
d = lua_getnumber(o);
|
||||
lua_pushnumber (acos(d));
|
||||
}
|
||||
|
||||
|
||||
|
||||
static void math_atan (void)
|
||||
{
|
||||
double d;
|
||||
lua_Object o = lua_getparam (1);
|
||||
if (o == NULL)
|
||||
{ lua_error ("too few arguments to function `atan'"); return; }
|
||||
if (!lua_isnumber(o))
|
||||
{ lua_error ("incorrect arguments to function `atan'"); return; }
|
||||
d = lua_getnumber(o);
|
||||
lua_pushnumber (atan(d));
|
||||
}
|
||||
|
||||
|
||||
static void math_ceil (void)
|
||||
{
|
||||
double d;
|
||||
lua_Object o = lua_getparam (1);
|
||||
if (o == NULL)
|
||||
{ lua_error ("too few arguments to function `ceil'"); return; }
|
||||
if (!lua_isnumber(o))
|
||||
{ lua_error ("incorrect arguments to function `ceil'"); return; }
|
||||
d = lua_getnumber(o);
|
||||
lua_pushnumber (ceil(d));
|
||||
}
|
||||
|
||||
|
||||
static void math_floor (void)
|
||||
{
|
||||
double d;
|
||||
lua_Object o = lua_getparam (1);
|
||||
if (o == NULL)
|
||||
{ lua_error ("too few arguments to function `floor'"); return; }
|
||||
if (!lua_isnumber(o))
|
||||
{ lua_error ("incorrect arguments to function `floor'"); return; }
|
||||
d = lua_getnumber(o);
|
||||
lua_pushnumber (floor(d));
|
||||
}
|
||||
|
||||
static void math_mod (void)
|
||||
{
|
||||
int d1, d2;
|
||||
lua_Object o1 = lua_getparam (1);
|
||||
lua_Object o2 = lua_getparam (2);
|
||||
if (!lua_isnumber(o1) || !lua_isnumber(o2))
|
||||
{ lua_error ("incorrect arguments to function `mod'"); return; }
|
||||
d1 = (int) lua_getnumber(o1);
|
||||
d2 = (int) lua_getnumber(o2);
|
||||
lua_pushnumber (d1%d2);
|
||||
}
|
||||
|
||||
|
||||
static void math_sqrt (void)
|
||||
{
|
||||
double d;
|
||||
lua_Object o = lua_getparam (1);
|
||||
if (o == NULL)
|
||||
{ lua_error ("too few arguments to function `sqrt'"); return; }
|
||||
if (!lua_isnumber(o))
|
||||
{ lua_error ("incorrect arguments to function `sqrt'"); return; }
|
||||
d = lua_getnumber(o);
|
||||
lua_pushnumber (sqrt(d));
|
||||
}
|
||||
|
||||
static void math_pow (void)
|
||||
{
|
||||
double d1, d2;
|
||||
lua_Object o1 = lua_getparam (1);
|
||||
lua_Object o2 = lua_getparam (2);
|
||||
if (!lua_isnumber(o1) || !lua_isnumber(o2))
|
||||
{ lua_error ("incorrect arguments to function `pow'"); return; }
|
||||
d1 = lua_getnumber(o1);
|
||||
d2 = lua_getnumber(o2);
|
||||
lua_pushnumber (pow(d1,d2));
|
||||
}
|
||||
|
||||
static void math_min (void)
|
||||
{
|
||||
int i=1;
|
||||
double d, dmin;
|
||||
lua_Object o;
|
||||
if ((o = lua_getparam(i++)) == NULL)
|
||||
{ lua_error ("too few arguments to function `min'"); return; }
|
||||
if (!lua_isnumber(o))
|
||||
{ lua_error ("incorrect arguments to function `min'"); return; }
|
||||
dmin = lua_getnumber (o);
|
||||
while ((o = lua_getparam(i++)) != NULL)
|
||||
{
|
||||
if (!lua_isnumber(o))
|
||||
{ lua_error ("incorrect arguments to function `min'"); return; }
|
||||
d = lua_getnumber (o);
|
||||
if (d < dmin) dmin = d;
|
||||
}
|
||||
lua_pushnumber (dmin);
|
||||
}
|
||||
|
||||
|
||||
static void math_max (void)
|
||||
{
|
||||
int i=1;
|
||||
double d, dmax;
|
||||
lua_Object o;
|
||||
if ((o = lua_getparam(i++)) == NULL)
|
||||
{ lua_error ("too few arguments to function `max'"); return; }
|
||||
if (!lua_isnumber(o))
|
||||
{ lua_error ("incorrect arguments to function `max'"); return; }
|
||||
dmax = lua_getnumber (o);
|
||||
while ((o = lua_getparam(i++)) != NULL)
|
||||
{
|
||||
if (!lua_isnumber(o))
|
||||
{ lua_error ("incorrect arguments to function `max'"); return; }
|
||||
d = lua_getnumber (o);
|
||||
if (d > dmax) dmax = d;
|
||||
}
|
||||
lua_pushnumber (dmax);
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** 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 ("ceil", math_ceil);
|
||||
lua_register ("floor", math_floor);
|
||||
lua_register ("mod", math_mod);
|
||||
lua_register ("sqrt", math_sqrt);
|
||||
lua_register ("pow", math_pow);
|
||||
lua_register ("min", math_min);
|
||||
lua_register ("max", math_max);
|
||||
}
|
||||
933
opcode.c
Normal file
933
opcode.c
Normal file
@@ -0,0 +1,933 @@
|
||||
/*
|
||||
** opcode.c
|
||||
** TecCGraf - PUC-Rio
|
||||
** 26 Apr 93
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#ifdef __GNUC__
|
||||
#include <floatingpoint.h>
|
||||
#endif
|
||||
|
||||
#include "opcode.h"
|
||||
#include "hash.h"
|
||||
#include "inout.h"
|
||||
#include "table.h"
|
||||
#include "lua.h"
|
||||
|
||||
#define tonumber(o) ((tag(o) != T_NUMBER) && (lua_tonumber(o) != 0))
|
||||
#define tostring(o) ((tag(o) != T_STRING) && (lua_tostring(o) != 0))
|
||||
|
||||
#ifndef MAXSTACK
|
||||
#define MAXSTACK 256
|
||||
#endif
|
||||
static Object stack[MAXSTACK] = {{T_MARK, {NULL}}};
|
||||
static Object *top=stack+1, *base=stack+1;
|
||||
|
||||
|
||||
/*
|
||||
** Concatenate two given string, creating a mark space at the beginning.
|
||||
** Return the new string pointer.
|
||||
*/
|
||||
static char *lua_strconc (char *l, char *r)
|
||||
{
|
||||
char *s = calloc (strlen(l)+strlen(r)+2, sizeof(char));
|
||||
if (s == NULL)
|
||||
{
|
||||
lua_error ("not enough memory");
|
||||
return NULL;
|
||||
}
|
||||
*s++ = 0; /* create mark space */
|
||||
return strcat(strcpy(s,l),r);
|
||||
}
|
||||
|
||||
/*
|
||||
** Duplicate a string, creating a mark space at the beginning.
|
||||
** Return the new string pointer.
|
||||
*/
|
||||
char *lua_strdup (char *l)
|
||||
{
|
||||
char *s = calloc (strlen(l)+2, sizeof(char));
|
||||
if (s == NULL)
|
||||
{
|
||||
lua_error ("not enough memory");
|
||||
return NULL;
|
||||
}
|
||||
*s++ = 0; /* create mark space */
|
||||
return strcpy(s,l);
|
||||
}
|
||||
|
||||
/*
|
||||
** Convert, if possible, to a number tag.
|
||||
** Return 0 in success or not 0 on error.
|
||||
*/
|
||||
static int lua_tonumber (Object *obj)
|
||||
{
|
||||
char *ptr;
|
||||
if (tag(obj) != T_STRING)
|
||||
{
|
||||
lua_reportbug ("unexpected type at conversion to number");
|
||||
return 1;
|
||||
}
|
||||
nvalue(obj) = strtod(svalue(obj), &ptr);
|
||||
if (*ptr)
|
||||
{
|
||||
lua_reportbug ("string to number convertion failed");
|
||||
return 2;
|
||||
}
|
||||
tag(obj) = T_NUMBER;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
** Test if is possible to convert an object to a number one.
|
||||
** If possible, return the converted object, otherwise return nil object.
|
||||
*/
|
||||
static Object *lua_convtonumber (Object *obj)
|
||||
{
|
||||
static Object cvt;
|
||||
|
||||
if (tag(obj) == T_NUMBER)
|
||||
{
|
||||
cvt = *obj;
|
||||
return &cvt;
|
||||
}
|
||||
|
||||
tag(&cvt) = T_NIL;
|
||||
if (tag(obj) == T_STRING)
|
||||
{
|
||||
char *ptr;
|
||||
nvalue(&cvt) = strtod(svalue(obj), &ptr);
|
||||
if (*ptr == 0)
|
||||
tag(&cvt) = T_NUMBER;
|
||||
}
|
||||
return &cvt;
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*
|
||||
** Convert, if possible, to a string tag
|
||||
** Return 0 in success or not 0 on error.
|
||||
*/
|
||||
static int lua_tostring (Object *obj)
|
||||
{
|
||||
static char s[256];
|
||||
if (tag(obj) != T_NUMBER)
|
||||
{
|
||||
lua_reportbug ("unexpected type at conversion to string");
|
||||
return 1;
|
||||
}
|
||||
if ((int) nvalue(obj) == nvalue(obj))
|
||||
sprintf (s, "%d", (int) nvalue(obj));
|
||||
else
|
||||
sprintf (s, "%g", nvalue(obj));
|
||||
svalue(obj) = lua_createstring(lua_strdup(s));
|
||||
if (svalue(obj) == NULL)
|
||||
return 1;
|
||||
tag(obj) = T_STRING;
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Execute the given opcode. Return 0 in success or 1 on error.
|
||||
*/
|
||||
int lua_execute (Byte *pc)
|
||||
{
|
||||
while (1)
|
||||
{
|
||||
switch ((OpCode)*pc++)
|
||||
{
|
||||
case NOP: break;
|
||||
|
||||
case PUSHNIL: tag(top++) = T_NIL; break;
|
||||
|
||||
case PUSH0: tag(top) = T_NUMBER; nvalue(top++) = 0; break;
|
||||
case PUSH1: tag(top) = T_NUMBER; nvalue(top++) = 1; break;
|
||||
case PUSH2: tag(top) = T_NUMBER; nvalue(top++) = 2; break;
|
||||
|
||||
case PUSHBYTE: tag(top) = T_NUMBER; nvalue(top++) = *pc++; break;
|
||||
|
||||
case PUSHWORD:
|
||||
tag(top) = T_NUMBER; nvalue(top++) = *((Word *)(pc)); pc += sizeof(Word);
|
||||
break;
|
||||
|
||||
case PUSHFLOAT:
|
||||
tag(top) = T_NUMBER; nvalue(top++) = *((float *)(pc)); pc += sizeof(float);
|
||||
break;
|
||||
case PUSHSTRING:
|
||||
{
|
||||
int w = *((Word *)(pc));
|
||||
pc += sizeof(Word);
|
||||
tag(top) = T_STRING; svalue(top++) = lua_constant[w];
|
||||
}
|
||||
break;
|
||||
|
||||
case PUSHLOCAL0: *top++ = *(base + 0); break;
|
||||
case PUSHLOCAL1: *top++ = *(base + 1); break;
|
||||
case PUSHLOCAL2: *top++ = *(base + 2); break;
|
||||
case PUSHLOCAL3: *top++ = *(base + 3); break;
|
||||
case PUSHLOCAL4: *top++ = *(base + 4); break;
|
||||
case PUSHLOCAL5: *top++ = *(base + 5); break;
|
||||
case PUSHLOCAL6: *top++ = *(base + 6); break;
|
||||
case PUSHLOCAL7: *top++ = *(base + 7); break;
|
||||
case PUSHLOCAL8: *top++ = *(base + 8); break;
|
||||
case PUSHLOCAL9: *top++ = *(base + 9); break;
|
||||
|
||||
case PUSHLOCAL: *top++ = *(base + (*pc++)); break;
|
||||
|
||||
case PUSHGLOBAL:
|
||||
*top++ = s_object(*((Word *)(pc))); pc += sizeof(Word);
|
||||
break;
|
||||
|
||||
case PUSHINDEXED:
|
||||
--top;
|
||||
if (tag(top-1) != T_ARRAY)
|
||||
{
|
||||
lua_reportbug ("indexed expression not a table");
|
||||
return 1;
|
||||
}
|
||||
{
|
||||
Object *h = lua_hashdefine (avalue(top-1), top);
|
||||
if (h == NULL) return 1;
|
||||
*(top-1) = *h;
|
||||
}
|
||||
break;
|
||||
|
||||
case PUSHMARK: tag(top++) = T_MARK; break;
|
||||
|
||||
case PUSHOBJECT: *top = *(top-3); top++; break;
|
||||
|
||||
case STORELOCAL0: *(base + 0) = *(--top); break;
|
||||
case STORELOCAL1: *(base + 1) = *(--top); break;
|
||||
case STORELOCAL2: *(base + 2) = *(--top); break;
|
||||
case STORELOCAL3: *(base + 3) = *(--top); break;
|
||||
case STORELOCAL4: *(base + 4) = *(--top); break;
|
||||
case STORELOCAL5: *(base + 5) = *(--top); break;
|
||||
case STORELOCAL6: *(base + 6) = *(--top); break;
|
||||
case STORELOCAL7: *(base + 7) = *(--top); break;
|
||||
case STORELOCAL8: *(base + 8) = *(--top); break;
|
||||
case STORELOCAL9: *(base + 9) = *(--top); break;
|
||||
|
||||
case STORELOCAL: *(base + (*pc++)) = *(--top); break;
|
||||
|
||||
case STOREGLOBAL:
|
||||
s_object(*((Word *)(pc))) = *(--top); pc += sizeof(Word);
|
||||
break;
|
||||
|
||||
case STOREINDEXED0:
|
||||
if (tag(top-3) != T_ARRAY)
|
||||
{
|
||||
lua_reportbug ("indexed expression not a table");
|
||||
return 1;
|
||||
}
|
||||
{
|
||||
Object *h = lua_hashdefine (avalue(top-3), top-2);
|
||||
if (h == NULL) return 1;
|
||||
*h = *(top-1);
|
||||
}
|
||||
top -= 3;
|
||||
break;
|
||||
|
||||
case STOREINDEXED:
|
||||
{
|
||||
int n = *pc++;
|
||||
if (tag(top-3-n) != T_ARRAY)
|
||||
{
|
||||
lua_reportbug ("indexed expression not a table");
|
||||
return 1;
|
||||
}
|
||||
{
|
||||
Object *h = lua_hashdefine (avalue(top-3-n), top-2-n);
|
||||
if (h == NULL) return 1;
|
||||
*h = *(top-1);
|
||||
}
|
||||
--top;
|
||||
}
|
||||
break;
|
||||
|
||||
case STOREFIELD:
|
||||
if (tag(top-3) != T_ARRAY)
|
||||
{
|
||||
lua_error ("internal error - table expected");
|
||||
return 1;
|
||||
}
|
||||
*(lua_hashdefine (avalue(top-3), top-2)) = *(top-1);
|
||||
top -= 2;
|
||||
break;
|
||||
|
||||
case ADJUST:
|
||||
{
|
||||
Object *newtop = base + *(pc++);
|
||||
if (top != newtop)
|
||||
{
|
||||
while (top < newtop) tag(top++) = T_NIL;
|
||||
top = newtop;
|
||||
}
|
||||
}
|
||||
break;
|
||||
|
||||
case CREATEARRAY:
|
||||
if (tag(top-1) == T_NIL)
|
||||
nvalue(top-1) = 101;
|
||||
else
|
||||
{
|
||||
if (tonumber(top-1)) return 1;
|
||||
if (nvalue(top-1) <= 0) nvalue(top-1) = 101;
|
||||
}
|
||||
avalue(top-1) = lua_createarray(lua_hashcreate(nvalue(top-1)));
|
||||
if (avalue(top-1) == NULL)
|
||||
return 1;
|
||||
tag(top-1) = T_ARRAY;
|
||||
break;
|
||||
|
||||
case EQOP:
|
||||
{
|
||||
Object *l = top-2;
|
||||
Object *r = top-1;
|
||||
--top;
|
||||
if (tag(l) != tag(r))
|
||||
tag(top-1) = T_NIL;
|
||||
else
|
||||
{
|
||||
switch (tag(l))
|
||||
{
|
||||
case T_NIL: tag(top-1) = T_NUMBER; break;
|
||||
case T_NUMBER: tag(top-1) = (nvalue(l) == nvalue(r)) ? T_NUMBER : T_NIL; break;
|
||||
case T_ARRAY: tag(top-1) = (avalue(l) == avalue(r)) ? T_NUMBER : T_NIL; break;
|
||||
case T_FUNCTION: tag(top-1) = (bvalue(l) == bvalue(r)) ? T_NUMBER : T_NIL; break;
|
||||
case T_CFUNCTION: tag(top-1) = (fvalue(l) == fvalue(r)) ? T_NUMBER : T_NIL; break;
|
||||
case T_USERDATA: tag(top-1) = (uvalue(l) == uvalue(r)) ? T_NUMBER : T_NIL; break;
|
||||
case T_STRING: tag(top-1) = (strcmp (svalue(l), svalue(r)) == 0) ? T_NUMBER : T_NIL; break;
|
||||
case T_MARK: return 1;
|
||||
}
|
||||
}
|
||||
nvalue(top-1) = 1;
|
||||
}
|
||||
break;
|
||||
|
||||
case LTOP:
|
||||
{
|
||||
Object *l = top-2;
|
||||
Object *r = top-1;
|
||||
--top;
|
||||
if (tag(l) == T_NUMBER && tag(r) == T_NUMBER)
|
||||
tag(top-1) = (nvalue(l) < nvalue(r)) ? T_NUMBER : T_NIL;
|
||||
else
|
||||
{
|
||||
if (tostring(l) || tostring(r))
|
||||
return 1;
|
||||
tag(top-1) = (strcmp (svalue(l), svalue(r)) < 0) ? T_NUMBER : T_NIL;
|
||||
}
|
||||
nvalue(top-1) = 1;
|
||||
}
|
||||
break;
|
||||
|
||||
case LEOP:
|
||||
{
|
||||
Object *l = top-2;
|
||||
Object *r = top-1;
|
||||
--top;
|
||||
if (tag(l) == T_NUMBER && tag(r) == T_NUMBER)
|
||||
tag(top-1) = (nvalue(l) <= nvalue(r)) ? T_NUMBER : T_NIL;
|
||||
else
|
||||
{
|
||||
if (tostring(l) || tostring(r))
|
||||
return 1;
|
||||
tag(top-1) = (strcmp (svalue(l), svalue(r)) <= 0) ? T_NUMBER : T_NIL;
|
||||
}
|
||||
nvalue(top-1) = 1;
|
||||
}
|
||||
break;
|
||||
|
||||
case ADDOP:
|
||||
{
|
||||
Object *l = top-2;
|
||||
Object *r = top-1;
|
||||
if (tonumber(r) || tonumber(l))
|
||||
return 1;
|
||||
nvalue(l) += nvalue(r);
|
||||
--top;
|
||||
}
|
||||
break;
|
||||
|
||||
case SUBOP:
|
||||
{
|
||||
Object *l = top-2;
|
||||
Object *r = top-1;
|
||||
if (tonumber(r) || tonumber(l))
|
||||
return 1;
|
||||
nvalue(l) -= nvalue(r);
|
||||
--top;
|
||||
}
|
||||
break;
|
||||
|
||||
case MULTOP:
|
||||
{
|
||||
Object *l = top-2;
|
||||
Object *r = top-1;
|
||||
if (tonumber(r) || tonumber(l))
|
||||
return 1;
|
||||
nvalue(l) *= nvalue(r);
|
||||
--top;
|
||||
}
|
||||
break;
|
||||
|
||||
case DIVOP:
|
||||
{
|
||||
Object *l = top-2;
|
||||
Object *r = top-1;
|
||||
if (tonumber(r) || tonumber(l))
|
||||
return 1;
|
||||
nvalue(l) /= nvalue(r);
|
||||
--top;
|
||||
}
|
||||
break;
|
||||
|
||||
case CONCOP:
|
||||
{
|
||||
Object *l = top-2;
|
||||
Object *r = top-1;
|
||||
if (tostring(r) || tostring(l))
|
||||
return 1;
|
||||
svalue(l) = lua_createstring (lua_strconc(svalue(l),svalue(r)));
|
||||
if (svalue(l) == NULL)
|
||||
return 1;
|
||||
--top;
|
||||
}
|
||||
break;
|
||||
|
||||
case MINUSOP:
|
||||
if (tonumber(top-1))
|
||||
return 1;
|
||||
nvalue(top-1) = - nvalue(top-1);
|
||||
break;
|
||||
|
||||
case NOTOP:
|
||||
tag(top-1) = tag(top-1) == T_NIL ? T_NUMBER : T_NIL;
|
||||
break;
|
||||
|
||||
case ONTJMP:
|
||||
{
|
||||
int n = *((Word *)(pc));
|
||||
pc += sizeof(Word);
|
||||
if (tag(top-1) != T_NIL) pc += n;
|
||||
}
|
||||
break;
|
||||
|
||||
case ONFJMP:
|
||||
{
|
||||
int n = *((Word *)(pc));
|
||||
pc += sizeof(Word);
|
||||
if (tag(top-1) == T_NIL) pc += n;
|
||||
}
|
||||
break;
|
||||
|
||||
case JMP: pc += *((Word *)(pc)) + sizeof(Word); break;
|
||||
|
||||
case UPJMP: pc -= *((Word *)(pc)) - sizeof(Word); break;
|
||||
|
||||
case IFFJMP:
|
||||
{
|
||||
int n = *((Word *)(pc));
|
||||
pc += sizeof(Word);
|
||||
top--;
|
||||
if (tag(top) == T_NIL) pc += n;
|
||||
}
|
||||
break;
|
||||
|
||||
case IFFUPJMP:
|
||||
{
|
||||
int n = *((Word *)(pc));
|
||||
pc += sizeof(Word);
|
||||
top--;
|
||||
if (tag(top) == T_NIL) pc -= n;
|
||||
}
|
||||
break;
|
||||
|
||||
case POP: --top; break;
|
||||
|
||||
case CALLFUNC:
|
||||
{
|
||||
Byte *newpc;
|
||||
Object *b = top-1;
|
||||
while (tag(b) != T_MARK) b--;
|
||||
if (tag(b-1) == T_FUNCTION)
|
||||
{
|
||||
lua_debugline = 0; /* always reset debug flag */
|
||||
newpc = bvalue(b-1);
|
||||
bvalue(b-1) = pc; /* store return code */
|
||||
nvalue(b) = (base-stack); /* store base value */
|
||||
base = b+1;
|
||||
pc = newpc;
|
||||
if (MAXSTACK-(base-stack) < STACKGAP)
|
||||
{
|
||||
lua_error ("stack overflow");
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
else if (tag(b-1) == T_CFUNCTION)
|
||||
{
|
||||
int nparam;
|
||||
lua_debugline = 0; /* always reset debug flag */
|
||||
nvalue(b) = (base-stack); /* store base value */
|
||||
base = b+1;
|
||||
nparam = top-base; /* number of parameters */
|
||||
(fvalue(b-1))(); /* call C function */
|
||||
|
||||
/* shift returned values */
|
||||
{
|
||||
int i;
|
||||
int nretval = top - base - nparam;
|
||||
top = base - 2;
|
||||
base = stack + (int) nvalue(base-1);
|
||||
for (i=0; i<nretval; i++)
|
||||
{
|
||||
*top = *(top+nparam+2);
|
||||
++top;
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
lua_reportbug ("call expression not a function");
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
break;
|
||||
|
||||
case RETCODE:
|
||||
{
|
||||
int i;
|
||||
int shift = *pc++;
|
||||
int nretval = top - base - shift;
|
||||
top = base - 2;
|
||||
pc = bvalue(base-2);
|
||||
base = stack + (int) nvalue(base-1);
|
||||
for (i=0; i<nretval; i++)
|
||||
{
|
||||
*top = *(top+shift+2);
|
||||
++top;
|
||||
}
|
||||
}
|
||||
break;
|
||||
|
||||
case HALT:
|
||||
return 0; /* success */
|
||||
|
||||
case SETFUNCTION:
|
||||
{
|
||||
int file, func;
|
||||
file = *((Word *)(pc));
|
||||
pc += sizeof(Word);
|
||||
func = *((Word *)(pc));
|
||||
pc += sizeof(Word);
|
||||
if (lua_pushfunction (file, func))
|
||||
return 1;
|
||||
}
|
||||
break;
|
||||
|
||||
case SETLINE:
|
||||
lua_debugline = *((Word *)(pc));
|
||||
pc += sizeof(Word);
|
||||
break;
|
||||
|
||||
case RESET:
|
||||
lua_popfunction ();
|
||||
break;
|
||||
|
||||
default:
|
||||
lua_error ("internal error - opcode didn't match");
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Mark all strings and arrays used by any object stored at stack.
|
||||
*/
|
||||
void lua_markstack (void)
|
||||
{
|
||||
Object *o;
|
||||
for (o = top-1; o >= stack; o--)
|
||||
lua_markobject (o);
|
||||
}
|
||||
|
||||
/*
|
||||
** Open file, generate opcode and execute global statement. Return 0 on
|
||||
** success or 1 on error.
|
||||
*/
|
||||
int lua_dofile (char *filename)
|
||||
{
|
||||
if (lua_openfile (filename)) return 1;
|
||||
if (lua_parse ()) { lua_closefile (); return 1; }
|
||||
lua_closefile ();
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
** Generate opcode stored on string and execute global statement. Return 0 on
|
||||
** success or 1 on error.
|
||||
*/
|
||||
int lua_dostring (char *string)
|
||||
{
|
||||
if (lua_openstring (string)) return 1;
|
||||
if (lua_parse ()) return 1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
** Execute the given function. Return 0 on success or 1 on error.
|
||||
*/
|
||||
int lua_call (char *functionname, int nparam)
|
||||
{
|
||||
static Byte startcode[] = {CALLFUNC, HALT};
|
||||
int i;
|
||||
Object func = s_object(lua_findsymbol(functionname));
|
||||
if (tag(&func) != T_FUNCTION) return 1;
|
||||
for (i=1; i<=nparam; i++)
|
||||
*(top-i+2) = *(top-i);
|
||||
top += 2;
|
||||
tag(top-nparam-1) = T_MARK;
|
||||
*(top-nparam-2) = func;
|
||||
return (lua_execute (startcode));
|
||||
}
|
||||
|
||||
/*
|
||||
** Get a parameter, returning the object handle or NULL on error.
|
||||
** 'number' must be 1 to get the first parameter.
|
||||
*/
|
||||
Object *lua_getparam (int number)
|
||||
{
|
||||
if (number <= 0 || number > top-base) return NULL;
|
||||
return (base+number-1);
|
||||
}
|
||||
|
||||
/*
|
||||
** Given an object handle, return its number value. On error, return 0.0.
|
||||
*/
|
||||
real lua_getnumber (Object *object)
|
||||
{
|
||||
if (tonumber (object)) return 0.0;
|
||||
else return (nvalue(object));
|
||||
}
|
||||
|
||||
/*
|
||||
** Given an object handle, return its string pointer. On error, return NULL.
|
||||
*/
|
||||
char *lua_getstring (Object *object)
|
||||
{
|
||||
if (tostring (object)) return NULL;
|
||||
else return (svalue(object));
|
||||
}
|
||||
|
||||
/*
|
||||
** Given an object handle, return a copy of its string. On error, return NULL.
|
||||
*/
|
||||
char *lua_copystring (Object *object)
|
||||
{
|
||||
if (tostring (object)) return NULL;
|
||||
else return (strdup(svalue(object)));
|
||||
}
|
||||
|
||||
/*
|
||||
** Given an object handle, return its cfuntion pointer. On error, return NULL.
|
||||
*/
|
||||
lua_CFunction lua_getcfunction (Object *object)
|
||||
{
|
||||
if (tag(object) != T_CFUNCTION) return NULL;
|
||||
else return (fvalue(object));
|
||||
}
|
||||
|
||||
/*
|
||||
** Given an object handle, return its user data. On error, return NULL.
|
||||
*/
|
||||
void *lua_getuserdata (Object *object)
|
||||
{
|
||||
if (tag(object) != T_USERDATA) return NULL;
|
||||
else return (uvalue(object));
|
||||
}
|
||||
|
||||
/*
|
||||
** Given an object handle and a field name, return its field object.
|
||||
** On error, return NULL.
|
||||
*/
|
||||
Object *lua_getfield (Object *object, char *field)
|
||||
{
|
||||
if (tag(object) != T_ARRAY)
|
||||
return NULL;
|
||||
else
|
||||
{
|
||||
Object ref;
|
||||
tag(&ref) = T_STRING;
|
||||
svalue(&ref) = lua_createstring(lua_strdup(field));
|
||||
return (lua_hashdefine(avalue(object), &ref));
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
** Given an object handle and an index, return its indexed object.
|
||||
** On error, return NULL.
|
||||
*/
|
||||
Object *lua_getindexed (Object *object, float index)
|
||||
{
|
||||
if (tag(object) != T_ARRAY)
|
||||
return NULL;
|
||||
else
|
||||
{
|
||||
Object ref;
|
||||
tag(&ref) = T_NUMBER;
|
||||
nvalue(&ref) = index;
|
||||
return (lua_hashdefine(avalue(object), &ref));
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
** Get a global object. Return the object handle or NULL on error.
|
||||
*/
|
||||
Object *lua_getglobal (char *name)
|
||||
{
|
||||
int n = lua_findsymbol(name);
|
||||
if (n < 0) return NULL;
|
||||
return &s_object(n);
|
||||
}
|
||||
|
||||
/*
|
||||
** Pop and return an object
|
||||
*/
|
||||
Object *lua_pop (void)
|
||||
{
|
||||
if (top <= base) return NULL;
|
||||
top--;
|
||||
return top;
|
||||
}
|
||||
|
||||
/*
|
||||
** Push a nil object
|
||||
*/
|
||||
int lua_pushnil (void)
|
||||
{
|
||||
if ((top-stack) >= MAXSTACK-1)
|
||||
{
|
||||
lua_error ("stack overflow");
|
||||
return 1;
|
||||
}
|
||||
tag(top) = T_NIL;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
** Push an object (tag=number) to stack. Return 0 on success or 1 on error.
|
||||
*/
|
||||
int lua_pushnumber (real n)
|
||||
{
|
||||
if ((top-stack) >= MAXSTACK-1)
|
||||
{
|
||||
lua_error ("stack overflow");
|
||||
return 1;
|
||||
}
|
||||
tag(top) = T_NUMBER; nvalue(top++) = n;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
** Push an object (tag=string) to stack. Return 0 on success or 1 on error.
|
||||
*/
|
||||
int lua_pushstring (char *s)
|
||||
{
|
||||
if ((top-stack) >= MAXSTACK-1)
|
||||
{
|
||||
lua_error ("stack overflow");
|
||||
return 1;
|
||||
}
|
||||
tag(top) = T_STRING;
|
||||
svalue(top++) = lua_createstring(lua_strdup(s));
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
** Push an object (tag=cfunction) to stack. Return 0 on success or 1 on error.
|
||||
*/
|
||||
int lua_pushcfunction (lua_CFunction fn)
|
||||
{
|
||||
if ((top-stack) >= MAXSTACK-1)
|
||||
{
|
||||
lua_error ("stack overflow");
|
||||
return 1;
|
||||
}
|
||||
tag(top) = T_CFUNCTION; fvalue(top++) = fn;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
** Push an object (tag=userdata) to stack. Return 0 on success or 1 on error.
|
||||
*/
|
||||
int lua_pushuserdata (void *u)
|
||||
{
|
||||
if ((top-stack) >= MAXSTACK-1)
|
||||
{
|
||||
lua_error ("stack overflow");
|
||||
return 1;
|
||||
}
|
||||
tag(top) = T_USERDATA; uvalue(top++) = u;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
** Push an object to stack.
|
||||
*/
|
||||
int lua_pushobject (Object *o)
|
||||
{
|
||||
if ((top-stack) >= MAXSTACK-1)
|
||||
{
|
||||
lua_error ("stack overflow");
|
||||
return 1;
|
||||
}
|
||||
*top++ = *o;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
** Store top of the stack at a global variable array field.
|
||||
** Return 1 on error, 0 on success.
|
||||
*/
|
||||
int lua_storeglobal (char *name)
|
||||
{
|
||||
int n = lua_findsymbol (name);
|
||||
if (n < 0) return 1;
|
||||
if (tag(top-1) == T_MARK) return 1;
|
||||
s_object(n) = *(--top);
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
** Store top of the stack at an array field. Return 1 on error, 0 on success.
|
||||
*/
|
||||
int lua_storefield (lua_Object object, char *field)
|
||||
{
|
||||
if (tag(object) != T_ARRAY)
|
||||
return 1;
|
||||
else
|
||||
{
|
||||
Object ref, *h;
|
||||
tag(&ref) = T_STRING;
|
||||
svalue(&ref) = lua_createstring(lua_strdup(field));
|
||||
h = lua_hashdefine(avalue(object), &ref);
|
||||
if (h == NULL) return 1;
|
||||
if (tag(top-1) == T_MARK) return 1;
|
||||
*h = *(--top);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Store top of the stack at an array index. Return 1 on error, 0 on success.
|
||||
*/
|
||||
int lua_storeindexed (lua_Object object, float index)
|
||||
{
|
||||
if (tag(object) != T_ARRAY)
|
||||
return 1;
|
||||
else
|
||||
{
|
||||
Object ref, *h;
|
||||
tag(&ref) = T_NUMBER;
|
||||
nvalue(&ref) = index;
|
||||
h = lua_hashdefine(avalue(object), &ref);
|
||||
if (h == NULL) return 1;
|
||||
if (tag(top-1) == T_MARK) return 1;
|
||||
*h = *(--top);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Given an object handle, return if it is nil.
|
||||
*/
|
||||
int lua_isnil (Object *object)
|
||||
{
|
||||
return (object != NULL && tag(object) == T_NIL);
|
||||
}
|
||||
|
||||
/*
|
||||
** Given an object handle, return if it is a number one.
|
||||
*/
|
||||
int lua_isnumber (Object *object)
|
||||
{
|
||||
return (object != NULL && tag(object) == T_NUMBER);
|
||||
}
|
||||
|
||||
/*
|
||||
** Given an object handle, return if it is a string one.
|
||||
*/
|
||||
int lua_isstring (Object *object)
|
||||
{
|
||||
return (object != NULL && tag(object) == T_STRING);
|
||||
}
|
||||
|
||||
/*
|
||||
** Given an object handle, return if it is an array one.
|
||||
*/
|
||||
int lua_istable (Object *object)
|
||||
{
|
||||
return (object != NULL && tag(object) == T_ARRAY);
|
||||
}
|
||||
|
||||
/*
|
||||
** Given an object handle, return if it is a cfunction one.
|
||||
*/
|
||||
int lua_iscfunction (Object *object)
|
||||
{
|
||||
return (object != NULL && tag(object) == T_CFUNCTION);
|
||||
}
|
||||
|
||||
/*
|
||||
** Given an object handle, return if it is an user data one.
|
||||
*/
|
||||
int lua_isuserdata (Object *object)
|
||||
{
|
||||
return (object != NULL && tag(object) == T_USERDATA);
|
||||
}
|
||||
|
||||
/*
|
||||
** Internal function: return an object type.
|
||||
*/
|
||||
void lua_type (void)
|
||||
{
|
||||
Object *o = lua_getparam(1);
|
||||
lua_pushstring (lua_constant[tag(o)]);
|
||||
}
|
||||
|
||||
/*
|
||||
** Internal function: convert an object to a number
|
||||
*/
|
||||
void lua_obj2number (void)
|
||||
{
|
||||
Object *o = lua_getparam(1);
|
||||
lua_pushobject (lua_convtonumber(o));
|
||||
}
|
||||
|
||||
/*
|
||||
** Internal function: print object values
|
||||
*/
|
||||
void lua_print (void)
|
||||
{
|
||||
int i=1;
|
||||
void *obj;
|
||||
while ((obj=lua_getparam (i++)) != NULL)
|
||||
{
|
||||
if (lua_isnumber(obj)) printf("%g\n",lua_getnumber (obj));
|
||||
else if (lua_isstring(obj)) printf("%s\n",lua_getstring (obj));
|
||||
else if (lua_iscfunction(obj)) printf("cfunction: %p\n",lua_getcfunction (obj));
|
||||
else if (lua_isuserdata(obj)) printf("userdata: %p\n",lua_getuserdata (obj));
|
||||
else if (lua_istable(obj)) printf("table: %p\n",obj);
|
||||
else if (lua_isnil(obj)) printf("nil\n");
|
||||
else printf("invalid value to print\n");
|
||||
}
|
||||
}
|
||||
|
||||
144
opcode.h
Normal file
144
opcode.h
Normal file
@@ -0,0 +1,144 @@
|
||||
/*
|
||||
** opcode.h
|
||||
** TeCGraf - PUC-Rio
|
||||
** 16 Apr 92
|
||||
*/
|
||||
|
||||
#ifndef opcode_h
|
||||
#define opcode_h
|
||||
|
||||
#ifndef STACKGAP
|
||||
#define STACKGAP 128
|
||||
#endif
|
||||
|
||||
#ifndef real
|
||||
#define real float
|
||||
#endif
|
||||
|
||||
typedef unsigned char Byte;
|
||||
|
||||
typedef unsigned short Word;
|
||||
|
||||
typedef enum
|
||||
{
|
||||
NOP,
|
||||
PUSHNIL,
|
||||
PUSH0, PUSH1, PUSH2,
|
||||
PUSHBYTE,
|
||||
PUSHWORD,
|
||||
PUSHFLOAT,
|
||||
PUSHSTRING,
|
||||
PUSHLOCAL0, PUSHLOCAL1, PUSHLOCAL2, PUSHLOCAL3, PUSHLOCAL4,
|
||||
PUSHLOCAL5, PUSHLOCAL6, PUSHLOCAL7, PUSHLOCAL8, PUSHLOCAL9,
|
||||
PUSHLOCAL,
|
||||
PUSHGLOBAL,
|
||||
PUSHINDEXED,
|
||||
PUSHMARK,
|
||||
PUSHOBJECT,
|
||||
STORELOCAL0, STORELOCAL1, STORELOCAL2, STORELOCAL3, STORELOCAL4,
|
||||
STORELOCAL5, STORELOCAL6, STORELOCAL7, STORELOCAL8, STORELOCAL9,
|
||||
STORELOCAL,
|
||||
STOREGLOBAL,
|
||||
STOREINDEXED0,
|
||||
STOREINDEXED,
|
||||
STOREFIELD,
|
||||
ADJUST,
|
||||
CREATEARRAY,
|
||||
EQOP,
|
||||
LTOP,
|
||||
LEOP,
|
||||
ADDOP,
|
||||
SUBOP,
|
||||
MULTOP,
|
||||
DIVOP,
|
||||
CONCOP,
|
||||
MINUSOP,
|
||||
NOTOP,
|
||||
ONTJMP,
|
||||
ONFJMP,
|
||||
JMP,
|
||||
UPJMP,
|
||||
IFFJMP,
|
||||
IFFUPJMP,
|
||||
POP,
|
||||
CALLFUNC,
|
||||
RETCODE,
|
||||
HALT,
|
||||
SETFUNCTION,
|
||||
SETLINE,
|
||||
RESET
|
||||
} OpCode;
|
||||
|
||||
typedef enum
|
||||
{
|
||||
T_MARK,
|
||||
T_NIL,
|
||||
T_NUMBER,
|
||||
T_STRING,
|
||||
T_ARRAY,
|
||||
T_FUNCTION,
|
||||
T_CFUNCTION,
|
||||
T_USERDATA
|
||||
} Type;
|
||||
|
||||
typedef void (*Cfunction) (void);
|
||||
typedef int (*Input) (void);
|
||||
typedef void (*Unput) (int );
|
||||
|
||||
typedef union
|
||||
{
|
||||
Cfunction f;
|
||||
real n;
|
||||
char *s;
|
||||
Byte *b;
|
||||
struct Hash *a;
|
||||
void *u;
|
||||
} Value;
|
||||
|
||||
typedef struct Object
|
||||
{
|
||||
Type tag;
|
||||
Value value;
|
||||
} Object;
|
||||
|
||||
typedef struct
|
||||
{
|
||||
char *name;
|
||||
Object object;
|
||||
} Symbol;
|
||||
|
||||
/* Macros to access structure members */
|
||||
#define tag(o) ((o)->tag)
|
||||
#define nvalue(o) ((o)->value.n)
|
||||
#define svalue(o) ((o)->value.s)
|
||||
#define bvalue(o) ((o)->value.b)
|
||||
#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_name(i) (lua_table[i].name)
|
||||
#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_bvalue(i) (bvalue(&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)))
|
||||
|
||||
|
||||
/* Exported functions */
|
||||
int lua_execute (Byte *pc);
|
||||
void lua_markstack (void);
|
||||
char *lua_strdup (char *l);
|
||||
|
||||
void lua_setinput (Input fn); /* from "lua.lex" module */
|
||||
void lua_setunput (Unput fn); /* from "lua.lex" module */
|
||||
char *lua_lasttext (void); /* from "lua.lex" module */
|
||||
int lua_parse (void); /* from "lua.stx" module */
|
||||
void lua_type (void);
|
||||
void lua_obj2number (void);
|
||||
void lua_print (void);
|
||||
|
||||
#endif
|
||||
47
save.lua
Normal file
47
save.lua
Normal file
@@ -0,0 +1,47 @@
|
||||
$debug
|
||||
|
||||
|
||||
function savevar (n,v)
|
||||
if v = nil then return end;
|
||||
if type(v) = "number" then print(n.."="..v) return end
|
||||
if type(v) = "string" then print(n.."='"..v.."'") return end
|
||||
if type(v) = "table" then
|
||||
if v.__visited__ ~= nil then
|
||||
print(n .. "=" .. v.__visited__);
|
||||
else
|
||||
print(n.."=@()")
|
||||
v.__visited__ = n;
|
||||
local r,f;
|
||||
r,f = next(v,nil);
|
||||
while r ~= nil do
|
||||
if r ~= "__visited__" then
|
||||
if type(r) = 'string' then
|
||||
savevar(n.."['"..r.."']",f)
|
||||
else
|
||||
savevar(n.."["..r.."]",f)
|
||||
end
|
||||
end
|
||||
r,f = next(v,r)
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
function save ()
|
||||
local n,v
|
||||
n,v = nextvar(nil)
|
||||
while n ~= nil do
|
||||
savevar(n,v);
|
||||
n,v = nextvar(n)
|
||||
end
|
||||
end
|
||||
|
||||
a = 3
|
||||
x = @{a = 4, b = "name", l=@[4,5,67]}
|
||||
|
||||
b = @{t=5}
|
||||
x.next = b
|
||||
|
||||
|
||||
save()
|
||||
|
||||
56
sort.lua
Normal file
56
sort.lua
Normal file
@@ -0,0 +1,56 @@
|
||||
$debug
|
||||
|
||||
function quicksort(r,s)
|
||||
if s<=r then return end -- caso basico da recursao
|
||||
local v=x[r]
|
||||
local i=r
|
||||
local j=s+1
|
||||
i=i+1; while x[i]<v do i=i+1 end
|
||||
j=j-1; while x[j]>v do j=j-1 end
|
||||
x[i],x[j]=x[j],x[i]
|
||||
while j>i do -- separacao
|
||||
i=i+1; while x[i]<v do i=i+1 end
|
||||
j=j-1; while x[j]>v do j=j-1 end
|
||||
x[i],x[j]=x[j],x[i]
|
||||
end
|
||||
x[i],x[j]=x[j],x[i] -- undo last swap
|
||||
x[j],x[r]=x[r],x[j]
|
||||
quicksort(r,j-1) -- recursao
|
||||
quicksort(j+1,s)
|
||||
end
|
||||
|
||||
function sort(a,n) -- selection sort
|
||||
local i=1
|
||||
while i<=n do
|
||||
local m=i
|
||||
local j=i+1
|
||||
while j<=n do
|
||||
if a[j]<a[m] then m=j end
|
||||
j=j+1
|
||||
end
|
||||
a[i],a[m]=a[m],a[i] -- swap a[i] and a[m]
|
||||
i=i+1
|
||||
end
|
||||
end
|
||||
|
||||
function main()
|
||||
x=@()
|
||||
n=-1
|
||||
n=n+1; x[n]="a"
|
||||
n=n+1; x[n]="waldemar"
|
||||
n=n+1; x[n]="luiz"
|
||||
n=n+1; x[n]="lula"
|
||||
n=n+1; x[n]="peter"
|
||||
n=n+1; x[n]="raquel"
|
||||
n=n+1; x[n]="camilo"
|
||||
n=n+1; x[n]="andre"
|
||||
n=n+1; x[n]="marcelo"
|
||||
n=n+1; x[n]="sedrez"
|
||||
n=n+1; x[n]="z"
|
||||
-- quicksort(1,n-1)
|
||||
print(x[0]..","..x[1]..","..x[2]..","..x[3]..","..x[4]..","..x[5]..","..x[6]..","..x[7]..","..x[8]..","..x[9]..","..x[10])
|
||||
sort (x, n-1)
|
||||
print(x[0]..","..x[1]..","..x[2]..","..x[3]..","..x[4]..","..x[5]..","..x[6]..","..x[7]..","..x[8]..","..x[9]..","..x[10])
|
||||
end
|
||||
|
||||
|
||||
131
strlib.c
Normal file
131
strlib.c
Normal file
@@ -0,0 +1,131 @@
|
||||
/*
|
||||
** strlib.c
|
||||
** String library to LUA
|
||||
**
|
||||
** Waldemar Celes Filho
|
||||
** TeCGraf - PUC-Rio
|
||||
** 19 May 93
|
||||
*/
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <ctype.h>
|
||||
|
||||
|
||||
#include "lua.h"
|
||||
|
||||
/*
|
||||
** Return the position of the first caracter of a substring into a string
|
||||
** LUA interface:
|
||||
** n = strfind (string, substring)
|
||||
*/
|
||||
static void str_find (void)
|
||||
{
|
||||
int n;
|
||||
char *s1, *s2;
|
||||
lua_Object o1 = lua_getparam (1);
|
||||
lua_Object o2 = lua_getparam (2);
|
||||
if (!lua_isstring(o1) || !lua_isstring(o2))
|
||||
{ lua_error ("incorrect arguments to function `strfind'"); return; }
|
||||
s1 = lua_getstring(o1);
|
||||
s2 = lua_getstring(o2);
|
||||
n = strstr(s1,s2) - s1 + 1;
|
||||
lua_pushnumber (n);
|
||||
}
|
||||
|
||||
/*
|
||||
** Return the string length
|
||||
** LUA interface:
|
||||
** n = strlen (string)
|
||||
*/
|
||||
static void str_len (void)
|
||||
{
|
||||
lua_Object o = lua_getparam (1);
|
||||
if (!lua_isstring(o))
|
||||
{ lua_error ("incorrect arguments to function `strlen'"); return; }
|
||||
lua_pushnumber(strlen(lua_getstring(o)));
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Return the substring of a string, from start to end
|
||||
** LUA interface:
|
||||
** substring = strsub (string, start, end)
|
||||
*/
|
||||
static void str_sub (void)
|
||||
{
|
||||
int start, end;
|
||||
char *s;
|
||||
lua_Object o1 = lua_getparam (1);
|
||||
lua_Object o2 = lua_getparam (2);
|
||||
lua_Object o3 = lua_getparam (3);
|
||||
if (!lua_isstring(o1) || !lua_isnumber(o2) || !lua_isnumber(o3))
|
||||
{ lua_error ("incorrect arguments to function `strsub'"); return; }
|
||||
s = strdup (lua_getstring(o1));
|
||||
start = lua_getnumber (o2);
|
||||
end = lua_getnumber (o3);
|
||||
if (end < start || start < 1 || end > strlen(s))
|
||||
lua_pushstring ("");
|
||||
else
|
||||
{
|
||||
s[end] = 0;
|
||||
lua_pushstring (&s[start-1]);
|
||||
}
|
||||
free (s);
|
||||
}
|
||||
|
||||
/*
|
||||
** Convert a string to lower case.
|
||||
** LUA interface:
|
||||
** lowercase = strlower (string)
|
||||
*/
|
||||
static void str_lower (void)
|
||||
{
|
||||
char *s, *c;
|
||||
lua_Object o = lua_getparam (1);
|
||||
if (!lua_isstring(o))
|
||||
{ lua_error ("incorrect arguments to function `strlower'"); return; }
|
||||
c = s = strdup(lua_getstring(o));
|
||||
while (*c != 0)
|
||||
{
|
||||
*c = tolower(*c);
|
||||
c++;
|
||||
}
|
||||
lua_pushstring(s);
|
||||
free(s);
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Convert a string to upper case.
|
||||
** LUA interface:
|
||||
** uppercase = strupper (string)
|
||||
*/
|
||||
static void str_upper (void)
|
||||
{
|
||||
char *s, *c;
|
||||
lua_Object o = lua_getparam (1);
|
||||
if (!lua_isstring(o))
|
||||
{ lua_error ("incorrect arguments to function `strlower'"); return; }
|
||||
c = s = strdup(lua_getstring(o));
|
||||
while (*c != 0)
|
||||
{
|
||||
*c = toupper(*c);
|
||||
c++;
|
||||
}
|
||||
lua_pushstring(s);
|
||||
free(s);
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** 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);
|
||||
}
|
||||
351
table.c
Normal file
351
table.c
Normal file
@@ -0,0 +1,351 @@
|
||||
/*
|
||||
** table.c
|
||||
** Module to control static tables
|
||||
** TeCGraf - PUC-Rio
|
||||
** 11 May 93
|
||||
*/
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
#include "opcode.h"
|
||||
#include "hash.h"
|
||||
#include "inout.h"
|
||||
#include "table.h"
|
||||
#include "lua.h"
|
||||
|
||||
#define streq(s1,s2) (strcmp(s1,s2)==0)
|
||||
|
||||
#ifndef MAXSYMBOL
|
||||
#define MAXSYMBOL 512
|
||||
#endif
|
||||
static Symbol tablebuffer[MAXSYMBOL] = {
|
||||
{"type",{T_CFUNCTION,{lua_type}}},
|
||||
{"tonumber",{T_CFUNCTION,{lua_obj2number}}},
|
||||
{"next",{T_CFUNCTION,{lua_next}}},
|
||||
{"nextvar",{T_CFUNCTION,{lua_nextvar}}},
|
||||
{"print",{T_CFUNCTION,{lua_print}}}
|
||||
};
|
||||
Symbol *lua_table=tablebuffer;
|
||||
Word lua_ntable=5;
|
||||
|
||||
#ifndef MAXCONSTANT
|
||||
#define MAXCONSTANT 256
|
||||
#endif
|
||||
static char *constantbuffer[MAXCONSTANT] = {"mark","nil","number",
|
||||
"string","table",
|
||||
"function","cfunction"
|
||||
};
|
||||
char **lua_constant = constantbuffer;
|
||||
Word lua_nconstant=T_CFUNCTION+1;
|
||||
|
||||
#ifndef MAXSTRING
|
||||
#define MAXSTRING 512
|
||||
#endif
|
||||
static char *stringbuffer[MAXSTRING];
|
||||
char **lua_string = stringbuffer;
|
||||
Word lua_nstring=0;
|
||||
|
||||
#ifndef MAXARRAY
|
||||
#define MAXARRAY 512
|
||||
#endif
|
||||
static Hash *arraybuffer[MAXARRAY];
|
||||
Hash **lua_array = arraybuffer;
|
||||
Word lua_narray=0;
|
||||
|
||||
#define MAXFILE 20
|
||||
char *lua_file[MAXFILE];
|
||||
int lua_nfile;
|
||||
|
||||
|
||||
/*
|
||||
** Given a name, search it at symbol table and return its index. If not
|
||||
** found, allocate at end of table, checking oveflow and return its index.
|
||||
** On error, return -1.
|
||||
*/
|
||||
int lua_findsymbol (char *s)
|
||||
{
|
||||
int i;
|
||||
for (i=0; i<lua_ntable; i++)
|
||||
if (streq(s,s_name(i)))
|
||||
return i;
|
||||
if (lua_ntable >= MAXSYMBOL-1)
|
||||
{
|
||||
lua_error ("symbol table overflow");
|
||||
return -1;
|
||||
}
|
||||
s_name(lua_ntable) = strdup(s);
|
||||
if (s_name(lua_ntable) == NULL)
|
||||
{
|
||||
lua_error ("not enough memory");
|
||||
return -1;
|
||||
}
|
||||
s_tag(lua_ntable++) = T_NIL;
|
||||
|
||||
return (lua_ntable-1);
|
||||
}
|
||||
|
||||
/*
|
||||
** Given a constant string, eliminate its delimeters (" or '), search it at
|
||||
** constant table and return its index. If not found, allocate at end of
|
||||
** the table, checking oveflow and return its index.
|
||||
**
|
||||
** For each allocation, the function allocate a extra char to be used to
|
||||
** mark used string (it's necessary to deal with constant and string
|
||||
** uniformily). The function store at the table the second position allocated,
|
||||
** that represents the beginning of the real string. On error, return -1.
|
||||
**
|
||||
*/
|
||||
int lua_findenclosedconstant (char *s)
|
||||
{
|
||||
int i, j, l=strlen(s);
|
||||
char *c = calloc (l, sizeof(char)); /* make a copy */
|
||||
|
||||
c++; /* create mark space */
|
||||
|
||||
/* introduce scape characters */
|
||||
for (i=1,j=0; i<l-1; i++)
|
||||
{
|
||||
if (s[i] == '\\')
|
||||
{
|
||||
switch (s[++i])
|
||||
{
|
||||
case 'n': c[j++] = '\n'; break;
|
||||
case 't': c[j++] = '\t'; break;
|
||||
case 'r': c[j++] = '\r'; break;
|
||||
default : c[j++] = '\\'; c[j++] = c[i]; break;
|
||||
}
|
||||
}
|
||||
else
|
||||
c[j++] = s[i];
|
||||
}
|
||||
c[j++] = 0;
|
||||
|
||||
for (i=0; i<lua_nconstant; i++)
|
||||
if (streq(c,lua_constant[i]))
|
||||
{
|
||||
free (c-1);
|
||||
return i;
|
||||
}
|
||||
if (lua_nconstant >= MAXCONSTANT-1)
|
||||
{
|
||||
lua_error ("lua: constant string table overflow");
|
||||
return -1;
|
||||
}
|
||||
lua_constant[lua_nconstant++] = c;
|
||||
return (lua_nconstant-1);
|
||||
}
|
||||
|
||||
/*
|
||||
** Given a constant string, search it at constant table and return its index.
|
||||
** If not found, allocate at end of the table, checking oveflow and return
|
||||
** its index.
|
||||
**
|
||||
** For each allocation, the function allocate a extra char to be used to
|
||||
** mark used string (it's necessary to deal with constant and string
|
||||
** uniformily). The function store at the table the second position allocated,
|
||||
** that represents the beginning of the real string. On error, return -1.
|
||||
**
|
||||
*/
|
||||
int lua_findconstant (char *s)
|
||||
{
|
||||
int i;
|
||||
for (i=0; i<lua_nconstant; i++)
|
||||
if (streq(s,lua_constant[i]))
|
||||
return i;
|
||||
if (lua_nconstant >= MAXCONSTANT-1)
|
||||
{
|
||||
lua_error ("lua: constant string table overflow");
|
||||
return -1;
|
||||
}
|
||||
{
|
||||
char *c = calloc(strlen(s)+2,sizeof(char));
|
||||
c++; /* create mark space */
|
||||
lua_constant[lua_nconstant++] = strcpy(c,s);
|
||||
}
|
||||
return (lua_nconstant-1);
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Mark an object if it is a string or a unmarked array.
|
||||
*/
|
||||
void lua_markobject (Object *o)
|
||||
{
|
||||
if (tag(o) == T_STRING)
|
||||
lua_markstring (svalue(o)) = 1;
|
||||
else if (tag(o) == T_ARRAY && markarray(avalue(o)) == 0)
|
||||
lua_hashmark (avalue(o));
|
||||
}
|
||||
|
||||
/*
|
||||
** Mark all strings and arrays used by any object stored at symbol table.
|
||||
*/
|
||||
static void lua_marktable (void)
|
||||
{
|
||||
int i;
|
||||
for (i=0; i<lua_ntable; i++)
|
||||
lua_markobject (&s_object(i));
|
||||
}
|
||||
|
||||
/*
|
||||
** Simulate a garbage colection. When string table or array table overflows,
|
||||
** this function check if all allocated strings and arrays are in use. If
|
||||
** there are unused ones, pack (compress) the tables.
|
||||
*/
|
||||
static void lua_pack (void)
|
||||
{
|
||||
lua_markstack ();
|
||||
lua_marktable ();
|
||||
|
||||
{ /* pack string */
|
||||
int i, j;
|
||||
for (i=j=0; i<lua_nstring; i++)
|
||||
if (lua_markstring(lua_string[i]) == 1)
|
||||
{
|
||||
lua_string[j++] = lua_string[i];
|
||||
lua_markstring(lua_string[i]) = 0;
|
||||
}
|
||||
else
|
||||
{
|
||||
free (lua_string[i]-1);
|
||||
}
|
||||
lua_nstring = j;
|
||||
}
|
||||
|
||||
{ /* pack array */
|
||||
int i, j;
|
||||
for (i=j=0; i<lua_narray; i++)
|
||||
if (markarray(lua_array[i]) == 1)
|
||||
{
|
||||
lua_array[j++] = lua_array[i];
|
||||
markarray(lua_array[i]) = 0;
|
||||
}
|
||||
else
|
||||
{
|
||||
lua_hashdelete (lua_array[i]);
|
||||
}
|
||||
lua_narray = j;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
** Allocate a new string at string table. The given string is already
|
||||
** allocated with mark space and the function puts it at the end of the
|
||||
** table, checking overflow, and returns its own pointer, or NULL on error.
|
||||
*/
|
||||
char *lua_createstring (char *s)
|
||||
{
|
||||
if (s == NULL) return NULL;
|
||||
|
||||
if (lua_nstring >= MAXSTRING-1)
|
||||
{
|
||||
lua_pack ();
|
||||
if (lua_nstring >= MAXSTRING-1)
|
||||
{
|
||||
lua_error ("string table overflow");
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
lua_string[lua_nstring++] = s;
|
||||
return s;
|
||||
}
|
||||
|
||||
/*
|
||||
** Allocate a new array, already created, at array table. The function puts
|
||||
** it at the end of the table, checking overflow, and returns its own pointer,
|
||||
** or NULL on error.
|
||||
*/
|
||||
void *lua_createarray (void *a)
|
||||
{
|
||||
if (a == NULL) return NULL;
|
||||
|
||||
if (lua_narray >= MAXARRAY-1)
|
||||
{
|
||||
lua_pack ();
|
||||
if (lua_narray >= MAXARRAY-1)
|
||||
{
|
||||
lua_error ("indexed table overflow");
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
lua_array[lua_narray++] = a;
|
||||
return a;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
** Add a file name at file table, checking overflow. This function also set
|
||||
** the external variable "lua_filename" with the function filename set.
|
||||
** Return 0 on success or 1 on error.
|
||||
*/
|
||||
int lua_addfile (char *fn)
|
||||
{
|
||||
if (lua_nfile >= MAXFILE-1)
|
||||
{
|
||||
lua_error ("too many files");
|
||||
return 1;
|
||||
}
|
||||
if ((lua_file[lua_nfile++] = strdup (fn)) == NULL)
|
||||
{
|
||||
lua_error ("not enough memory");
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
** Return the last file name set.
|
||||
*/
|
||||
char *lua_filename (void)
|
||||
{
|
||||
return lua_file[lua_nfile-1];
|
||||
}
|
||||
|
||||
/*
|
||||
** Internal function: return next global variable
|
||||
*/
|
||||
void lua_nextvar (void)
|
||||
{
|
||||
int index;
|
||||
Object *o = lua_getparam (1);
|
||||
if (o == NULL)
|
||||
{ lua_error ("too few arguments to function `nextvar'"); return; }
|
||||
if (lua_getparam (2) != NULL)
|
||||
{ lua_error ("too many arguments to function `nextvar'"); return; }
|
||||
if (tag(o) == T_NIL)
|
||||
{
|
||||
index = 0;
|
||||
}
|
||||
else if (tag(o) != T_STRING)
|
||||
{
|
||||
lua_error ("incorrect argument to function `nextvar'");
|
||||
return;
|
||||
}
|
||||
else
|
||||
{
|
||||
for (index=0; index<lua_ntable; index++)
|
||||
if (streq(s_name(index),svalue(o))) break;
|
||||
if (index == lua_ntable)
|
||||
{
|
||||
lua_error ("name not found in function `nextvar'");
|
||||
return;
|
||||
}
|
||||
index++;
|
||||
while (index < lua_ntable-1 && tag(&s_object(index)) == T_NIL) index++;
|
||||
|
||||
if (index == lua_ntable-1)
|
||||
{
|
||||
lua_pushnil();
|
||||
lua_pushnil();
|
||||
return;
|
||||
}
|
||||
}
|
||||
{
|
||||
Object name;
|
||||
tag(&name) = T_STRING;
|
||||
svalue(&name) = lua_createstring(lua_strdup(s_name(index)));
|
||||
if (lua_pushobject (&name)) return;
|
||||
if (lua_pushobject (&s_object(index))) return;
|
||||
}
|
||||
}
|
||||
39
table.h
Normal file
39
table.h
Normal file
@@ -0,0 +1,39 @@
|
||||
/*
|
||||
** table.c
|
||||
** Module to control static tables
|
||||
** TeCGraf - PUC-Rio
|
||||
** 11 May 93
|
||||
*/
|
||||
|
||||
#ifndef table_h
|
||||
#define table_h
|
||||
|
||||
extern Symbol *lua_table;
|
||||
extern Word lua_ntable;
|
||||
|
||||
extern char **lua_constant;
|
||||
extern Word lua_nconstant;
|
||||
|
||||
extern char **lua_string;
|
||||
extern Word lua_nstring;
|
||||
|
||||
extern Hash **lua_array;
|
||||
extern Word lua_narray;
|
||||
|
||||
extern char *lua_file[];
|
||||
extern int lua_nfile;
|
||||
|
||||
#define lua_markstring(s) (*((s)-1))
|
||||
|
||||
|
||||
int lua_findsymbol (char *s);
|
||||
int lua_findenclosedconstant (char *s);
|
||||
int lua_findconstant (char *s);
|
||||
void lua_markobject (Object *o);
|
||||
char *lua_createstring (char *s);
|
||||
void *lua_createarray (void *a);
|
||||
int lua_addfile (char *fn);
|
||||
char *lua_filename (void);
|
||||
void lua_nextvar (void);
|
||||
|
||||
#endif
|
||||
15
test.lua
Normal file
15
test.lua
Normal file
@@ -0,0 +1,15 @@
|
||||
$debug
|
||||
|
||||
|
||||
function somaP (x1,y1,x2,y2)
|
||||
return x1+x2, y1+y2
|
||||
end
|
||||
|
||||
function norma (x,y)
|
||||
return x*x+y*y
|
||||
end
|
||||
|
||||
function retorno_multiplo ()
|
||||
print (norma(somaP(2,3,4,5)))
|
||||
end
|
||||
|
||||
35
type.lua
Normal file
35
type.lua
Normal file
@@ -0,0 +1,35 @@
|
||||
$debug
|
||||
|
||||
function check (object, class)
|
||||
local v = next(object,nil);
|
||||
while v ~= nil do
|
||||
if class[v] = nil then print("unknown field: " .. v)
|
||||
elseif type(object[v]) ~= class[v].type
|
||||
then print("wrong type for field " .. v)
|
||||
end
|
||||
v = next(object,v);
|
||||
end
|
||||
v = next(class,nil);
|
||||
while v ~= nil do
|
||||
if object[v] = nil then
|
||||
if class[v].default ~= nil then
|
||||
object[v] = class[v].default
|
||||
else print("field "..v.." not initialized")
|
||||
end
|
||||
end
|
||||
v = next(class,v);
|
||||
end
|
||||
end
|
||||
|
||||
typetrilha = @{x = @{default = 0, type = "number"},
|
||||
y = @{default = 0, type = "number"},
|
||||
name = @{type = "string"}
|
||||
}
|
||||
|
||||
function trilha (t) check(t,typetrilha) end
|
||||
|
||||
t1 = @trilha{ x = 4, name = "3"}
|
||||
|
||||
a = "na".."me"
|
||||
|
||||
|
||||
35
y_tab.h
Normal file
35
y_tab.h
Normal file
@@ -0,0 +1,35 @@
|
||||
|
||||
typedef union
|
||||
{
|
||||
int vInt;
|
||||
long vLong;
|
||||
float vFloat;
|
||||
Word vWord;
|
||||
Byte *pByte;
|
||||
} YYSTYPE;
|
||||
extern YYSTYPE yylval;
|
||||
# define NIL 257
|
||||
# define IF 258
|
||||
# define THEN 259
|
||||
# define ELSE 260
|
||||
# define ELSEIF 261
|
||||
# define WHILE 262
|
||||
# define DO 263
|
||||
# define REPEAT 264
|
||||
# define UNTIL 265
|
||||
# define END 266
|
||||
# define RETURN 267
|
||||
# define LOCAL 268
|
||||
# define NUMBER 269
|
||||
# define FUNCTION 270
|
||||
# define NAME 271
|
||||
# define STRING 272
|
||||
# define DEBUG 273
|
||||
# define NOT 274
|
||||
# define AND 275
|
||||
# define OR 276
|
||||
# define NE 277
|
||||
# define LE 278
|
||||
# define GE 279
|
||||
# define CONC 280
|
||||
# define UNARY 281
|
||||
Reference in New Issue
Block a user