Compare commits

..

1 Commits

Author SHA1 Message Date
The Lua team
b9dde086db 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
2003-10-09 23:44:30 -03:00
82 changed files with 7025 additions and 14526 deletions

29
Makefile Normal file
View 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
View 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
View 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

172
bugs
View File

@@ -1,172 +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)

402
fixed/iolib.c Normal file
View 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
View 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
View 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
View File

@@ -0,0 +1 @@
/* empty file to please silly code in iolib.c and opcode.c */

5
globals.lua Normal file
View File

@@ -0,0 +1,5 @@
k,v=nextvar(k)
while k do
print(k)
k,v=nextvar(k)
end

259
hash.c Normal file
View 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
View 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
View 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
View 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
View 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);
}

393
lapi.c
View File

@@ -1,393 +0,0 @@
/*
** $Id: lapi.c,v 1.77 2000/03/29 20:19:20 roberto Exp roberto $
** Lua API
** See Copyright Notice in lua.h
*/
#include <string.h>
#define LUA_REENTRANT
#include "lapi.h"
#include "lauxlib.h"
#include "ldo.h"
#include "lfunc.h"
#include "lgc.h"
#include "lmem.h"
#include "lobject.h"
#include "lref.h"
#include "lstate.h"
#include "lstring.h"
#include "ltable.h"
#include "ltm.h"
#include "lua.h"
#include "lvm.h"
const char lua_ident[] = "$Lua: " LUA_VERSION " " LUA_COPYRIGHT " $\n"
"$Authors: " LUA_AUTHORS " $";
void luaA_checkCargs (lua_State *L, int nargs) {
if (nargs > L->top-L->Cstack.base)
luaL_verror(L, "Lua API error - "
"expected at least %d arguments in C2lua stack", nargs);
}
lua_Object luaA_putluaObject (lua_State *L, const TObject *o) {
luaD_openstack(L, L->Cstack.base);
*L->Cstack.base++ = *o;
return L->Cstack.base-1;
}
lua_Object luaA_putObjectOnTop (lua_State *L) {
luaD_openstack(L, L->Cstack.base);
*L->Cstack.base++ = *(--L->top);
return L->Cstack.base-1;
}
static void top2LC (lua_State *L, int n) {
/* Put the `n' elements on the top as the Lua2C contents */
L->Cstack.base = L->top; /* new base */
L->Cstack.lua2C = L->Cstack.base-n; /* position of the new results */
L->Cstack.num = n; /* number of results */
}
lua_Object lua_pop (lua_State *L) {
luaA_checkCargs(L, 1);
return luaA_putObjectOnTop(L);
}
/*
** Get a parameter, returning the object handle or LUA_NOOBJECT on error.
** `number' must be 1 to get the first parameter.
*/
lua_Object lua_lua2C (lua_State *L, int number) {
if (number <= 0 || number > L->Cstack.num) return LUA_NOOBJECT;
return L->Cstack.lua2C+number-1;
}
int lua_callfunction (lua_State *L, lua_Object function) {
if (function == LUA_NOOBJECT)
return 1;
else {
luaD_openstack(L, L->Cstack.base);
*L->Cstack.base = *function;
return luaD_protectedrun(L);
}
}
lua_Object lua_gettagmethod (lua_State *L, int tag, const char *event) {
return luaA_putluaObject(L, luaT_gettagmethod(L, tag, event));
}
lua_Object lua_settagmethod (lua_State *L, int tag, const char *event) {
TObject *method;
luaA_checkCargs(L, 1);
method = L->top-1;
if ((ttype(method) != TAG_NIL) && (*lua_type(L, method) != 'f'))
lua_error(L, "Lua API error - tag method must be a function or nil");
luaT_settagmethod(L, tag, event, method);
return luaA_putObjectOnTop(L);
}
lua_Object lua_gettable (lua_State *L) {
luaA_checkCargs(L, 2);
luaV_gettable(L, L->top--);
return luaA_putObjectOnTop(L);
}
lua_Object lua_rawgettable (lua_State *L) {
lua_Object res;
luaA_checkCargs(L, 2);
if (ttype(L->top-2) != TAG_TABLE)
lua_error(L, "indexed expression not a table in rawgettable");
res = luaA_putluaObject(L, luaH_get(L, avalue(L->top-2), L->top-1));
L->top -= 2;
return res;
}
void lua_settable (lua_State *L) {
StkId top;
luaA_checkCargs(L, 3);
top = L->top;
luaV_settable(L, top-3, top);
L->top = top-3; /* pop table, index, and value */
}
void lua_rawsettable (lua_State *L) {
luaA_checkCargs(L, 3);
luaV_rawsettable(L, L->top-3);
}
lua_Object lua_createtable (lua_State *L) {
TObject o;
luaC_checkGC(L);
avalue(&o) = luaH_new(L, 0);
ttype(&o) = TAG_TABLE;
return luaA_putluaObject(L, &o);
}
lua_Object lua_getglobal (lua_State *L, const char *name) {
luaV_getglobal(L, luaS_assertglobalbyname(L, name), L->top++);
return luaA_putObjectOnTop(L);
}
lua_Object lua_rawgetglobal (lua_State *L, const char *name) {
GlobalVar *gv = luaS_assertglobalbyname(L, name);
return luaA_putluaObject(L, &gv->value);
}
void lua_setglobal (lua_State *L, const char *name) {
luaA_checkCargs(L, 1);
luaV_setglobal(L, luaS_assertglobalbyname(L, name), L->top--);
}
void lua_rawsetglobal (lua_State *L, const char *name) {
GlobalVar *gv = luaS_assertglobalbyname(L, name);
luaA_checkCargs(L, 1);
gv->value = *(--L->top);
}
const char *lua_type (lua_State *L, lua_Object o) {
UNUSED(L);
return (o == LUA_NOOBJECT) ? "NOOBJECT" : luaO_typename(o);
}
int lua_isnil (lua_State *L, lua_Object o) {
UNUSED(L);
return (o != LUA_NOOBJECT) && (ttype(o) == TAG_NIL);
}
int lua_istable (lua_State *L, lua_Object o) {
UNUSED(L);
return (o != LUA_NOOBJECT) && (ttype(o) == TAG_TABLE);
}
int lua_isuserdata (lua_State *L, lua_Object o) {
UNUSED(L);
return (o != LUA_NOOBJECT) && (ttype(o) == TAG_USERDATA);
}
int lua_iscfunction (lua_State *L, lua_Object o) {
UNUSED(L);
return (o != LUA_NOOBJECT) && (ttype(o) == TAG_CCLOSURE);
}
int lua_isnumber (lua_State *L, lua_Object o) {
UNUSED(L);
return (o != LUA_NOOBJECT) && (tonumber(o) == 0);
}
int lua_isstring (lua_State *L, lua_Object o) {
UNUSED(L);
return (o != LUA_NOOBJECT && (ttype(o) == TAG_STRING ||
ttype(o) == TAG_NUMBER));
}
int lua_isfunction (lua_State *L, lua_Object o) {
return *lua_type(L, o) == 'f';
}
int lua_equal(lua_State *L, lua_Object o1, lua_Object o2) {
UNUSED(L);
if (o1 == LUA_NOOBJECT || o2 == LUA_NOOBJECT)
return (o1 == o2);
else return luaO_equalObj(o1, o2);
}
double lua_getnumber (lua_State *L, lua_Object obj) {
UNUSED(L);
if (obj == LUA_NOOBJECT || tonumber(obj))
return 0.0;
else return (nvalue(obj));
}
const char *lua_getstring (lua_State *L, lua_Object obj) {
luaC_checkGC(L); /* `tostring' may create a new string */
if (obj == LUA_NOOBJECT || tostring(L, obj))
return NULL;
else return (svalue(obj));
}
long lua_strlen (lua_State *L, lua_Object obj) {
if (obj == LUA_NOOBJECT || tostring(L, obj))
return 0L;
else return (tsvalue(obj)->u.s.len);
}
void *lua_getuserdata (lua_State *L, lua_Object obj) {
UNUSED(L);
if (obj == LUA_NOOBJECT || ttype(obj) != TAG_USERDATA)
return NULL;
else return tsvalue(obj)->u.d.value;
}
lua_CFunction lua_getcfunction (lua_State *L, lua_Object obj) {
if (!lua_iscfunction(L, obj))
return NULL;
else return clvalue(obj)->f.c;
}
void lua_pushnil (lua_State *L) {
ttype(L->top) = TAG_NIL;
incr_top;
}
void lua_pushnumber (lua_State *L, double n) {
ttype(L->top) = TAG_NUMBER;
nvalue(L->top) = n;
incr_top;
}
void lua_pushlstring (lua_State *L, const char *s, long len) {
tsvalue(L->top) = luaS_newlstr(L, s, len);
ttype(L->top) = TAG_STRING;
incr_top;
luaC_checkGC(L);
}
void lua_pushstring (lua_State *L, const char *s) {
if (s == NULL)
lua_pushnil(L);
else
lua_pushlstring(L, s, strlen(s));
}
void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n) {
if (fn == NULL)
lua_error(L, "Lua API error - attempt to push a NULL Cfunction");
luaA_checkCargs(L, n);
luaV_Cclosure(L, fn, n);
luaC_checkGC(L);
}
void lua_pushusertag (lua_State *L, void *u, int tag) { /* ORDER LUA_T */
if (tag != LUA_ANYTAG && tag != TAG_USERDATA && tag < NUM_TAGS)
luaL_verror(L, "invalid tag for a userdata (%d)", tag);
tsvalue(L->top) = luaS_createudata(L, u, tag);
ttype(L->top) = TAG_USERDATA;
incr_top;
luaC_checkGC(L);
}
void luaA_pushobject (lua_State *L, const TObject *o) {
*L->top = *o;
incr_top;
}
void lua_pushobject (lua_State *L, lua_Object o) {
if (o == LUA_NOOBJECT)
lua_error(L, "Lua API error - attempt to push a NOOBJECT");
*L->top = *o;
incr_top;
}
int lua_tag (lua_State *L, lua_Object o) {
if (o == LUA_NOOBJECT)
return TAG_NIL;
else if (ttype(o) == TAG_USERDATA) /* to allow `old' tags (deprecated) */
return o->value.ts->u.d.tag;
else
return luaT_effectivetag(L, o);
}
void lua_settag (lua_State *L, int tag) {
luaA_checkCargs(L, 1);
luaT_realtag(L, tag);
switch (ttype(L->top-1)) {
case TAG_TABLE:
(L->top-1)->value.a->htag = tag;
break;
case TAG_USERDATA:
(L->top-1)->value.ts->u.d.tag = tag;
break;
default:
luaL_verror(L, "cannot change the tag of a %.20s",
luaO_typename(L->top-1));
}
L->top--;
}
GlobalVar *luaA_nextvar (lua_State *L, TString *ts) {
GlobalVar *gv;
if (ts == NULL)
gv = L->rootglobal; /* first variable */
else {
/* check whether name is in global var list */
luaL_arg_check(L, ts->u.s.gv, 1, "variable name expected");
gv = ts->u.s.gv->next; /* get next */
}
while (gv && gv->value.ttype == TAG_NIL) /* skip globals with nil */
gv = gv->next;
if (gv) {
ttype(L->top) = TAG_STRING; tsvalue(L->top) = gv->name;
incr_top;
luaA_pushobject(L, &gv->value);
}
return gv;
}
const char *lua_nextvar (lua_State *L, const char *varname) {
TString *ts = (varname == NULL) ? NULL : luaS_new(L, varname);
GlobalVar *gv = luaA_nextvar(L, ts);
if (gv) {
top2LC(L, 2);
return gv->name->str;
}
else {
top2LC(L, 0);
return NULL;
}
}
int luaA_next (lua_State *L, const Hash *t, int i) {
int tsize = t->size;
for (; i<tsize; i++) {
Node *n = node(t, i);
if (ttype(val(n)) != TAG_NIL) {
luaA_pushobject(L, key(n));
luaA_pushobject(L, val(n));
return i+1; /* index to be used next time */
}
}
return 0; /* no more elements */
}
int lua_next (lua_State *L, lua_Object t, int i) {
if (ttype(t) != TAG_TABLE)
lua_error(L, "Lua API error - object is not a table in `lua_next'");
i = luaA_next(L, avalue(t), i);
top2LC(L, (i==0) ? 0 : 2);
return i;
}

21
lapi.h
View File

@@ -1,21 +0,0 @@
/*
** $Id: lapi.h,v 1.15 2000/03/10 18:37:44 roberto Exp roberto $
** Auxiliary functions from Lua API
** See Copyright Notice in lua.h
*/
#ifndef lapi_h
#define lapi_h
#include "lobject.h"
void luaA_checkCargs (lua_State *L, int nargs);
void luaA_pushobject (lua_State *L, const TObject *o);
GlobalVar *luaA_nextvar (lua_State *L, TString *g);
int luaA_next (lua_State *L, const Hash *t, int i);
lua_Object luaA_putluaObject (lua_State *L, const TObject *o);
lua_Object luaA_putObjectOnTop (lua_State *L);
#endif

151
lauxlib.c
View File

@@ -1,151 +0,0 @@
/*
** $Id: lauxlib.c,v 1.26 2000/02/08 16:34:31 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_REENTRANT
#include "lauxlib.h"
#include "lua.h"
#include "luadebug.h"
int luaL_findstring (const char *name, const char *const list[]) {
int i;
for (i=0; list[i]; i++)
if (strcmp(list[i], name) == 0)
return i;
return -1; /* name not found */
}
void luaL_argerror (lua_State *L, int narg, const char *extramsg) {
lua_Debug ar;
lua_getstack(L, 0, &ar);
lua_getinfo(L, "nu", &ar);
narg -= ar.nups;
if (ar.name == NULL)
ar.name = "?";
luaL_verror(L, "bad argument #%d to `%.50s' (%.100s)",
narg, ar.name, extramsg);
}
static void type_error (lua_State *L, int narg, const char *type_name,
lua_Object o) {
char buff[100];
const char *otype = (o == LUA_NOOBJECT) ? "no value" : lua_type(L, o);
sprintf(buff, "%.10s expected, got %.10s", type_name, otype);
luaL_argerror(L, narg, buff);
}
static const char *checkstr (lua_State *L, lua_Object o, int narg, long *len) {
const char *s = lua_getstring(L, o);
if (!s) type_error(L, narg, "string", o);
if (len) *len = lua_strlen(L, o);
return s;
}
const char *luaL_check_lstr (lua_State *L, int narg, long *len) {
return checkstr(L, lua_getparam(L, narg), narg, len);
}
const char *luaL_opt_lstr (lua_State *L, int narg, const char *def, long *len) {
lua_Object o = lua_getparam(L, narg);
if (o == LUA_NOOBJECT) {
if (len) *len = def ? strlen(def) : 0;
return def;
}
else return checkstr(L, o, narg, len);
}
double luaL_check_number (lua_State *L, int narg) {
lua_Object o = lua_getparam(L, narg);
if (!lua_isnumber(L, o)) type_error(L, narg, "number", o);
return lua_getnumber(L, o);
}
double luaL_opt_number (lua_State *L, int narg, double def) {
lua_Object o = lua_getparam(L, narg);
if (o == LUA_NOOBJECT) return def;
else {
if (!lua_isnumber(L, o)) type_error(L, narg, "number", o);
return lua_getnumber(L, o);
}
}
lua_Object luaL_tablearg (lua_State *L, int narg) {
lua_Object o = lua_getparam(L, narg);
if (!lua_istable(L, o)) type_error(L, narg, "table", o);
return o;
}
lua_Object luaL_functionarg (lua_State *L, int narg) {
lua_Object o = lua_getparam(L, narg);
if (!lua_isfunction(L, o)) type_error(L, narg, "function", o);
return o;
}
lua_Object luaL_nonnullarg (lua_State *L, int narg) {
lua_Object o = lua_getparam(L, narg);
luaL_arg_check(L, o != LUA_NOOBJECT, narg, "value expected");
return o;
}
void luaL_openlib (lua_State *L, const struct luaL_reg *l, int n) {
int i;
for (i=0; i<n; i++)
lua_register(L, l[i].name, l[i].func);
}
void luaL_verror (lua_State *L, const char *fmt, ...) {
char buff[500];
va_list argp;
va_start(argp, fmt);
vsprintf(buff, fmt, argp);
va_end(argp);
lua_error(L, buff);
}
#define EXTRALEN sizeof("string \"...\"0")
void luaL_chunkid (char *out, const char *source, int len) {
if (*source == '(') {
strncpy(out, source+1, len-1); /* remove first char */
out[len-1] = '\0'; /* make sure `out' has an end */
out[strlen(out)-1] = '\0'; /* remove last char */
}
else {
len -= EXTRALEN;
if (*source == '@')
sprintf(out, "file `%.*s'", len, source+1);
else {
const char *b = strchr(source , '\n'); /* stop at first new line */
int lim = (b && (b-source)<len) ? b-source : len;
sprintf(out, "string \"%.*s\"", lim, source);
strcpy(out+lim+(EXTRALEN-sizeof("...\"0")), "...\"");
}
}
}
void luaL_filesource (char *out, const char *filename, int len) {
if (filename == NULL) filename = "(stdin)";
sprintf(out, "@%.*s", len-2, filename); /* -2 for '@' and '\0' */
}

105
lauxlib.h
View File

@@ -1,105 +0,0 @@
/*
** $Id: lauxlib.h,v 1.16 1999/12/03 11:26:23 roberto Exp roberto $
** Auxiliary functions for building Lua libraries
** See Copyright Notice in lua.h
*/
#ifndef lauxlib_h
#define lauxlib_h
#include "lua.h"
struct luaL_reg {
const char *name;
lua_CFunction func;
};
void luaL_openlib (lua_State *L, const struct luaL_reg *l, int n);
void luaL_argerror (lua_State *L, int numarg, const char *extramsg);
const char *luaL_check_lstr (lua_State *L, int numArg, long *len);
const char *luaL_opt_lstr (lua_State *L, int numArg, const char *def, long *len);
double luaL_check_number (lua_State *L, int numArg);
double luaL_opt_number (lua_State *L, int numArg, double def);
lua_Object luaL_functionarg (lua_State *L, int arg);
lua_Object luaL_tablearg (lua_State *L, int arg);
lua_Object luaL_nonnullarg (lua_State *L, int numArg);
void luaL_verror (lua_State *L, const char *fmt, ...);
char *luaL_openspace (lua_State *L, int size);
void luaL_resetbuffer (lua_State *L);
void luaL_addchar (lua_State *L, int c);
int luaL_getsize (lua_State *L);
void luaL_addsize (lua_State *L, int n);
int luaL_newbuffer (lua_State *L, int size);
void luaL_oldbuffer (lua_State *L, int old);
char *luaL_buffer (lua_State *L);
int luaL_findstring (const char *name, const char *const list[]);
void luaL_chunkid (char *out, const char *source, int len);
void luaL_filesource (char *out, const char *filename, int len);
#ifdef LUA_REENTRANT
/*
** ===============================================================
** 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])))
#else
/*
** ===============================================================
** Macros for single-state use
** ===============================================================
*/
#define luaL_arg_check(cond,numarg,extramsg) if (!(cond)) \
luaL_argerror(numarg,extramsg)
#define luaL_check_string(n) (luaL_check_lstr((n), NULL))
#define luaL_opt_string(n, d) (luaL_opt_lstr((n), (d), NULL))
#define luaL_check_int(n) ((int)luaL_check_number(n))
#define luaL_check_long(n) ((long)luaL_check_number(n))
#define luaL_opt_int(n,d) ((int)luaL_opt_number(n,d))
#define luaL_opt_long(n,d) ((long)luaL_opt_number(n,d))
#define luaL_openl(a) luaL_openlib(a, (sizeof(a)/sizeof(a[0])))
#define luaL_openlib(l,n) (luaL_openlib)(lua_state,l,n)
#define luaL_argerror(numarg,extramsg) \
(luaL_argerror)(lua_state,numarg,extramsg)
#define luaL_check_lstr(numArg,len) (luaL_check_lstr)(lua_state,numArg,len)
#define luaL_opt_lstr(numArg,def,len) \
(luaL_opt_lstr)(lua_state,numArg,def,len)
#define luaL_check_number(numArg) (luaL_check_number)(lua_state,numArg)
#define luaL_opt_number(numArg,def) (luaL_opt_number)(lua_state,numArg,def)
#define luaL_functionarg(arg) (luaL_functionarg)(lua_state,arg)
#define luaL_tablearg(arg) (luaL_tablearg)(lua_state,arg)
#define luaL_nonnullarg(numArg) (luaL_nonnullarg)(lua_state,numArg)
#define luaL_openspace(size) (luaL_openspace)(lua_state,size)
#define luaL_resetbuffer() (luaL_resetbuffer)(lua_state)
#define luaL_addchar(c) (luaL_addchar)(lua_state,c)
#define luaL_getsize() (luaL_getsize)(lua_state)
#define luaL_addsize(n) (luaL_addsize)(lua_state,n)
#define luaL_newbuffer(size) (luaL_newbuffer)(lua_state,size)
#define luaL_oldbuffer(old) (luaL_oldbuffer)(lua_state,old)
#define luaL_buffer() (luaL_buffer)(lua_state)
#endif
#endif

View File

@@ -1,79 +0,0 @@
/*
** $Id: lbuffer.c,v 1.11 1999/11/22 13:12:07 roberto Exp roberto $
** Auxiliary functions for building Lua libraries
** See Copyright Notice in lua.h
*/
#include <stdio.h>
#define LUA_REENTRANT
#include "lauxlib.h"
#include "lmem.h"
#include "lstate.h"
/*-------------------------------------------------------
** Auxiliary buffer
-------------------------------------------------------*/
/*
** amount of extra space (pre)allocated when buffer is reallocated
*/
#define EXTRABUFF 32
#define openspace(L, size) if (L->Mbuffnext+(size) > L->Mbuffsize) \
Openspace(L, size)
static void Openspace (lua_State *L, int size) {
L->Mbuffsize = (L->Mbuffnext+size+EXTRABUFF)*2;
luaM_reallocvector(L, L->Mbuffer, L->Mbuffsize, char);
}
char *luaL_openspace (lua_State *L, int size) {
openspace(L, size);
return L->Mbuffer+L->Mbuffnext;
}
void luaL_addchar (lua_State *L, int c) {
openspace(L, 1);
L->Mbuffer[L->Mbuffnext++] = (char)c;
}
void luaL_resetbuffer (lua_State *L) {
L->Mbuffnext = L->Mbuffbase;
}
void luaL_addsize (lua_State *L, int n) {
L->Mbuffnext += n;
}
int luaL_getsize (lua_State *L) {
return L->Mbuffnext-L->Mbuffbase;
}
int luaL_newbuffer (lua_State *L, int size) {
int old = L->Mbuffbase;
openspace(L, size);
L->Mbuffbase = L->Mbuffnext;
return old;
}
void luaL_oldbuffer (lua_State *L, int old) {
L->Mbuffnext = L->Mbuffbase;
L->Mbuffbase = old;
}
char *luaL_buffer (lua_State *L) {
return L->Mbuffer+L->Mbuffbase;
}

View File

@@ -1,662 +0,0 @@
/*
** $Id: lbuiltin.c,v 1.105 2000/04/14 17:44:20 roberto Exp roberto $
** Built-in functions
** See Copyright Notice in lua.h
*/
/*
** =========================================================================
** All built-in functions are public (i.e. not static) and are named luaB_f,
** where f is the function name in Lua. So, if you do not need all these
** functions, you may register manually only the ones that you need.
** =========================================================================
*/
#include <ctype.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#define LUA_REENTRANT
#include "lapi.h"
#include "lauxlib.h"
#include "lbuiltin.h"
#include "ldo.h"
#include "lfunc.h"
#include "lmem.h"
#include "lobject.h"
#include "lstate.h"
#include "lstring.h"
#include "ltable.h"
#include "ltm.h"
#include "lua.h"
#include "lundump.h"
#include "lvm.h"
/*
** function defined in ltests.c, to open some internal-test functions
*/
void luaB_opentests (lua_State *L);
/*
** {======================================================
** Auxiliary functions
** =======================================================
*/
static void pushtagstring (lua_State *L, TString *s) {
ttype(L->top) = TAG_STRING;
tsvalue(L->top) = s;
incr_top;
}
static Number getsize (const Hash *h) {
Number max = 0;
int i = h->size;
Node *n = h->node;
while (i--) {
if (ttype(key(n)) == TAG_NUMBER &&
ttype(val(n)) != TAG_NIL &&
nvalue(key(n)) > max)
max = nvalue(key(n));
n++;
}
return max;
}
static Number getnarg (lua_State *L, const Hash *a) {
TObject index;
const TObject *value;
/* value = table.n */
ttype(&index) = TAG_STRING;
tsvalue(&index) = luaS_new(L, "n");
value = luaH_get(L, a, &index);
return (ttype(value) == TAG_NUMBER) ? nvalue(value) : getsize(a);
}
static Hash *gettable (lua_State *L, int arg) {
return avalue(luaL_tablearg(L, arg));
}
/* }====================================================== */
/*
** {======================================================
** Functions that use only the official API
** =======================================================
*/
/*
** If your system does not support `stderr', redefine this function, or
** redefine _ERRORMESSAGE so that it won't need _ALERT.
*/
void luaB__ALERT (lua_State *L) {
fputs(luaL_check_string(L, 1), stderr);
}
/*
** Standard implementation of _ERRORMESSAGE.
** The library `liolib' redefines _ERRORMESSAGE for better error information.
*/
void luaB__ERRORMESSAGE (lua_State *L) {
lua_Object al = lua_rawgetglobal(L, "_ALERT");
if (lua_isfunction(L, al)) { /* avoid error loop if _ALERT is not defined */
const char *s = luaL_check_string(L, 1);
char *buff = luaL_openspace(L, strlen(s)+sizeof("error: \n"));
strcpy(buff, "error: "); strcat(buff, s); strcat(buff, "\n");
lua_pushstring(L, buff);
lua_callfunction(L, al);
}
}
/*
** 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).
*/
void luaB_print (lua_State *L) {
lua_Object args[MAXPRINT];
lua_Object obj;
int n = 0;
int i;
while ((obj = lua_getparam(L, n+1)) != LUA_NOOBJECT) {
luaL_arg_check(L, n < MAXPRINT, n+1, "too many arguments");
args[n++] = obj;
}
for (i=0; i<n; i++) {
lua_pushobject(L, args[i]);
if (lua_call(L, "tostring"))
lua_error(L, "error in `tostring' called by `print'");
obj = lua_getresult(L, 1);
if (!lua_isstring(L, obj))
lua_error(L, "`tostring' must return a string to `print'");
if (i>0) fputs("\t", stdout);
fputs(lua_getstring(L, obj), stdout);
}
fputs("\n", stdout);
}
void luaB_tonumber (lua_State *L) {
int base = luaL_opt_int(L, 2, 10);
if (base == 10) { /* standard conversion */
lua_Object o = luaL_nonnullarg(L, 1);
if (lua_isnumber(L, o)) {
lua_pushnumber(L, lua_getnumber(L, o));
return;
}
}
else {
const char *s1 = luaL_check_string(L, 1);
char *s2;
Number n;
luaL_arg_check(L, 2 <= base && base <= 36, 2, "base out of range");
n = strtoul(s1, &s2, base);
if (s1 != s2) { /* at least one valid digit? */
while (isspace((unsigned char)*s2)) s2++; /* skip trailing spaces */
if (*s2 == '\0') { /* no invalid trailing characters? */
lua_pushnumber(L, n);
return;
}
}
}
lua_pushnil(L); /* else not a number */
}
void luaB_error (lua_State *L) {
lua_error(L, luaL_opt_string(L, 1, NULL));
}
void luaB_setglobal (lua_State *L) {
const char *name = luaL_check_string(L, 1);
lua_Object value = luaL_nonnullarg(L, 2);
lua_pushobject(L, value);
lua_setglobal(L, name);
}
void luaB_rawsetglobal (lua_State *L) {
const char *name = luaL_check_string(L, 1);
lua_Object value = luaL_nonnullarg(L, 2);
lua_pushobject(L, value);
lua_rawsetglobal(L, name);
}
void luaB_getglobal (lua_State *L) {
lua_pushobject(L, lua_getglobal(L, luaL_check_string(L, 1)));
}
void luaB_rawgetglobal (lua_State *L) {
lua_pushobject(L, lua_rawgetglobal(L, luaL_check_string(L, 1)));
}
void luaB_tag (lua_State *L) {
lua_pushnumber(L, lua_tag(L, luaL_nonnullarg(L, 1)));
}
void luaB_settag (lua_State *L) {
lua_Object o = luaL_tablearg(L, 1);
lua_pushobject(L, o);
lua_settag(L, luaL_check_int(L, 2));
lua_pushobject(L, o); /* return first argument */
}
void luaB_newtag (lua_State *L) {
lua_pushnumber(L, lua_newtag(L));
}
void luaB_copytagmethods (lua_State *L) {
lua_pushnumber(L, lua_copytagmethods(L, luaL_check_int(L, 1),
luaL_check_int(L, 2)));
}
void luaB_rawgettable (lua_State *L) {
lua_pushobject(L, luaL_nonnullarg(L, 1));
lua_pushobject(L, luaL_nonnullarg(L, 2));
lua_pushobject(L, lua_rawgettable(L));
}
void luaB_rawsettable (lua_State *L) {
lua_pushobject(L, luaL_nonnullarg(L, 1));
lua_pushobject(L, luaL_nonnullarg(L, 2));
lua_pushobject(L, luaL_nonnullarg(L, 3));
lua_rawsettable(L);
}
void luaB_settagmethod (lua_State *L) {
int tag = luaL_check_int(L, 1);
const char *event = luaL_check_string(L, 2);
lua_Object nf = luaL_nonnullarg(L, 3);
luaL_arg_check(L, lua_isnil(L, nf) || lua_isfunction(L, nf), 3,
"function or nil expected");
if (strcmp(event, "gc") == 0 && tag != TAG_NIL)
lua_error(L, "deprecated use: cannot set the `gc' tag method from Lua");
lua_pushobject(L, nf);
lua_pushobject(L, lua_settagmethod(L, tag, event));
}
void luaB_gettagmethod (lua_State *L) {
lua_pushobject(L, lua_gettagmethod(L, luaL_check_int(L, 1),
luaL_check_string(L, 2)));
}
void luaB_collectgarbage (lua_State *L) {
lua_pushnumber(L, lua_collectgarbage(L, luaL_opt_int(L, 1, 0)));
}
void luaB_type (lua_State *L) {
lua_Object o = luaL_nonnullarg(L, 1);
lua_pushstring(L, lua_type(L, o));
}
/* }====================================================== */
/*
** {======================================================
** Functions that could use only the official API but
** do not, for efficiency.
** =======================================================
*/
static void passresults (lua_State *L) {
L->Cstack.base = L->Cstack.lua2C; /* position of first result */
if (L->Cstack.num == 0)
lua_pushuserdata(L, NULL); /* at least one result to signal no errors */
}
void luaB_dostring (lua_State *L) {
long l;
const char *s = luaL_check_lstr(L, 1, &l);
if (*s == ID_CHUNK)
lua_error(L, "`dostring' cannot run pre-compiled code");
if (lua_dobuffer(L, s, l, luaL_opt_string(L, 2, s)) == 0)
passresults(L);
else
lua_pushnil(L);
}
void luaB_dofile (lua_State *L) {
const char *fname = luaL_opt_string(L, 1, NULL);
if (lua_dofile(L, fname) == 0)
passresults(L);
else
lua_pushnil(L);
}
void luaB_call (lua_State *L) {
lua_Object f = luaL_nonnullarg(L, 1);
const Hash *arg = gettable(L, 2);
const char *options = luaL_opt_string(L, 3, "");
lua_Object err = lua_getparam(L, 4);
int narg = (int)getnarg(L, arg);
int i, status;
if (err != LUA_NOOBJECT) { /* set new error method */
lua_Object oldem = lua_getglobal(L, "_ERRORMESSAGE");
lua_pushobject(L, err);
lua_setglobal(L, "_ERRORMESSAGE");
err = oldem;
}
/* push arg[1...n] */
luaD_checkstack(L, narg);
for (i=0; i<narg; i++)
*(L->top++) = *luaH_getint(L, arg, i+1);
status = lua_callfunction(L, f);
if (err != LUA_NOOBJECT) { /* restore old error method */
lua_pushobject(L, err);
lua_setglobal(L, "_ERRORMESSAGE");
}
if (status != 0) { /* error in call? */
if (strchr(options, 'x')) {
lua_pushnil(L);
return; /* return nil to signal the error */
}
else
lua_error(L, NULL); /* propagate error without additional messages */
}
else { /* no errors */
if (strchr(options, 'p')) { /* pack results? */
luaV_pack(L, L->Cstack.lua2C, L->Cstack.num, L->top);
incr_top;
}
else
L->Cstack.base = L->Cstack.lua2C; /* position of first result */
}
}
void luaB_nextvar (lua_State *L) {
lua_Object o = lua_getparam(L, 1);
TString *name;
if (o == LUA_NOOBJECT || ttype(o) == TAG_NIL)
name = NULL;
else {
luaL_arg_check(L, ttype(o) == TAG_STRING, 1, "variable name expected");
name = tsvalue(o);
}
if (!luaA_nextvar(L, name))
lua_pushnil(L);
}
void luaB_next (lua_State *L) {
const Hash *a = gettable(L, 1);
lua_Object k = lua_getparam(L, 2);
int i; /* `luaA_next' gets first element after `i' */
if (k == LUA_NOOBJECT || ttype(k) == TAG_NIL)
i = 0; /* get first */
else {
i = luaH_pos(L, a, k)+1;
luaL_arg_check(L, i != 0, 2, "key not found");
}
if (luaA_next(L, a, i) == 0)
lua_pushnil(L);
}
void luaB_tostring (lua_State *L) {
lua_Object o = luaL_nonnullarg(L, 1);
char buff[64];
switch (ttype(o)) {
case TAG_NUMBER:
lua_pushstring(L, lua_getstring(L, o));
return;
case TAG_STRING:
lua_pushobject(L, o);
return;
case TAG_TABLE:
sprintf(buff, "table: %p", o->value.a);
break;
case TAG_LCLOSURE: case TAG_CCLOSURE:
sprintf(buff, "function: %p", o->value.cl);
break;
case TAG_USERDATA:
sprintf(buff, "userdata: %p(%d)", o->value.ts->u.d.value,
o->value.ts->u.d.tag);
break;
case TAG_NIL:
lua_pushstring(L, "nil");
return;
default:
LUA_INTERNALERROR(L, "invalid type");
}
lua_pushstring(L, buff);
}
/* }====================================================== */
/*
** {======================================================
** "Extra" functions
** These functions can be written in Lua, so you can
** delete them if you need a tiny Lua implementation.
** If you delete them, remove their entries in array
** "builtin_funcs".
** =======================================================
*/
void luaB_assert (lua_State *L) {
lua_Object p = luaL_nonnullarg(L, 1);
if (lua_isnil(L, p))
luaL_verror(L, "assertion failed! %.90s", luaL_opt_string(L, 2, ""));
}
void luaB_foreachi (lua_State *L) {
const Hash *t = gettable(L, 1);
int n = (int)getnarg(L, t);
int i;
lua_Object f = luaL_functionarg(L, 2);
luaD_checkstack(L, 3); /* for f, key, and val */
for (i=1; i<=n; i++) {
*(L->top++) = *f;
ttype(L->top) = TAG_NUMBER; nvalue(L->top++) = i;
*(L->top++) = *luaH_getint(L, t, i);
luaD_call(L, L->top-3, 1);
if (ttype(L->top-1) != TAG_NIL)
return;
L->top--; /* remove nil result */
}
}
void luaB_foreach (lua_State *L) {
const Hash *a = gettable(L, 1);
lua_Object f = luaL_functionarg(L, 2);
int i;
luaD_checkstack(L, 3); /* for f, key, and val */
for (i=0; i<a->size; i++) {
const Node *nd = &(a->node[i]);
if (ttype(val(nd)) != TAG_NIL) {
*(L->top++) = *f;
*(L->top++) = *key(nd);
*(L->top++) = *val(nd);
luaD_call(L, L->top-3, 1);
if (ttype(L->top-1) != TAG_NIL)
return;
L->top--; /* remove result */
}
}
}
void luaB_foreachvar (lua_State *L) {
lua_Object f = luaL_functionarg(L, 1);
GlobalVar *gv;
luaD_checkstack(L, 4); /* for extra var name, f, var name, and globalval */
for (gv = L->rootglobal; gv; gv = gv->next) {
if (gv->value.ttype != TAG_NIL) {
pushtagstring(L, gv->name); /* keep (extra) name on stack to avoid GC */
*(L->top++) = *f;
pushtagstring(L, gv->name);
*(L->top++) = gv->value;
luaD_call(L, L->top-3, 1);
if (ttype(L->top-1) != TAG_NIL) {
*(L->top-2) = *(L->top-1); /* remove extra name */
L->top--;
return;
}
L->top-=2; /* remove result and extra name */
}
}
}
void luaB_getn (lua_State *L) {
lua_pushnumber(L, getnarg(L, gettable(L, 1)));
}
void luaB_tinsert (lua_State *L) {
Hash *a = gettable(L, 1);
lua_Object v = lua_getparam(L, 3);
int n = (int)getnarg(L, a);
int pos;
if (v != LUA_NOOBJECT)
pos = luaL_check_int(L, 2);
else { /* called with only 2 arguments */
v = luaL_nonnullarg(L, 2);
pos = n+1;
}
luaV_setn(L, a, n+1); /* a.n = n+1 */
for (; n>=pos; n--)
luaH_move(L, a, n, n+1); /* a[n+1] = a[n] */
luaH_setint(L, a, pos, v); /* a[pos] = v */
}
void luaB_tremove (lua_State *L) {
Hash *a = gettable(L, 1);
int n = (int)getnarg(L, a);
int pos = luaL_opt_int(L, 2, n);
if (n <= 0) return; /* table is "empty" */
luaA_pushobject(L, luaH_getint(L, a, pos)); /* result = a[pos] */
for ( ;pos<n; pos++)
luaH_move(L, a, pos+1, pos); /* a[pos] = a[pos+1] */
luaV_setn(L, a, n-1); /* a.n = n-1 */
luaH_setint(L, a, n, &luaO_nilobject); /* a[n] = nil */
}
/*
** {======================================================
** Quicksort
** (based on `Algorithms in MODULA-3', Robert Sedgewick; Addison-Wesley, 1993.)
*/
static void swap (lua_State *L, Hash *a, int i, int j) {
TObject temp;
temp = *luaH_getint(L, a, i);
luaH_move(L, a, j, i);
luaH_setint(L, a, j, &temp);
}
static int sort_comp (lua_State *L, lua_Object f, const TObject *a,
const TObject *b) {
/* WARNING: the caller (auxsort) must ensure stack space */
if (f != LUA_NOOBJECT) {
*(L->top) = *f;
*(L->top+1) = *a;
*(L->top+2) = *b;
L->top += 3;
luaD_call(L, L->top-3, 1);
L->top--;
return (ttype(L->top) != TAG_NIL);
}
else /* a < b? */
return luaV_lessthan(L, a, b, L->top);
}
static void auxsort (lua_State *L, Hash *a, int l, int u, lua_Object f) {
StkId P = L->top++; /* temporary place for pivot */
ttype(P) = TAG_NIL;
while (l < u) { /* for tail recursion */
int i, j;
/* sort elements a[l], a[(l+u)/2] and a[u] */
if (sort_comp(L, f, luaH_getint(L, a, u), luaH_getint(L, a, l)))
swap(L, a, l, u); /* a[u]<a[l] */
if (u-l == 1) break; /* only 2 elements */
i = (l+u)/2;
*P = *luaH_getint(L, a, i); /* P = a[i] */
if (sort_comp(L, f, P, luaH_getint(L, a, l))) /* a[i]<a[l]? */
swap(L, a, l, i);
else if (sort_comp(L, f, luaH_getint(L, a, u), P)) /* a[u]<a[i]? */
swap(L, a, i, u);
if (u-l == 2) break; /* only 3 elements */
*P = *luaH_getint(L, a, i); /* save pivot on stack (GC) */
swap(L, a, i, u-1); /* put median element as pivot (a[u-1]) */
/* a[l] <= P == a[u-1] <= a[u], only needs 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 (sort_comp(L, f, luaH_getint(L, a, ++i), P))
if (i>u) lua_error(L, "invalid order function for sorting");
/* repeat j-- until a[j] <= P */
while (sort_comp(L, f, P, luaH_getint(L, a, --j)))
if (j<l) lua_error(L, "invalid order function for sorting");
if (j<i) break;
swap(L, a, i, j);
}
swap(L, a, 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, a, j, i, f); /* call recursively the smaller one */
} /* repeat the routine for the larger one */
L->top--; /* remove pivot from stack */
}
void luaB_sort (lua_State *L) {
Hash *a = gettable(L, 1);
int n = (int)getnarg(L, a);
lua_Object func = lua_getparam(L, 2);
luaL_arg_check(L, func == LUA_NOOBJECT || lua_isfunction(L, func), 2,
"function expected");
luaD_checkstack(L, 4); /* for pivot, f, a, b (sort_comp) */
auxsort(L, a, 1, n, func);
}
/* }====================================================== */
/* }====================================================== */
static const struct luaL_reg builtin_funcs[] = {
{"_ALERT", luaB__ALERT},
{"_ERRORMESSAGE", luaB__ERRORMESSAGE},
{"call", luaB_call},
{"collectgarbage", luaB_collectgarbage},
{"copytagmethods", luaB_copytagmethods},
{"dofile", luaB_dofile},
{"dostring", luaB_dostring},
{"error", luaB_error},
{"getglobal", luaB_getglobal},
{"gettagmethod", luaB_gettagmethod},
{"newtag", luaB_newtag},
{"next", luaB_next},
{"nextvar", luaB_nextvar},
{"print", luaB_print},
{"rawgetglobal", luaB_rawgetglobal},
{"rawgettable", luaB_rawgettable},
{"rawsetglobal", luaB_rawsetglobal},
{"rawsettable", luaB_rawsettable},
{"setglobal", luaB_setglobal},
{"settag", luaB_settag},
{"settagmethod", luaB_settagmethod},
{"tag", luaB_tag},
{"tonumber", luaB_tonumber},
{"tostring", luaB_tostring},
{"type", luaB_type},
/* "Extra" functions */
{"assert", luaB_assert},
{"foreach", luaB_foreach},
{"foreachi", luaB_foreachi},
{"foreachvar", luaB_foreachvar},
{"getn", luaB_getn},
{"sort", luaB_sort},
{"tinsert", luaB_tinsert},
{"tremove", luaB_tremove}
};
void luaB_predefine (lua_State *L) {
/* pre-register mem error messages, to avoid loop when error arises */
luaS_newfixed(L, tableEM);
luaS_newfixed(L, memEM);
luaL_openl(L, builtin_funcs);
#ifdef DEBUG
luaB_opentests(L); /* internal test functions */
#endif
lua_pushstring(L, LUA_VERSION);
lua_setglobal(L, "_VERSION");
}

View File

@@ -1,49 +0,0 @@
/*
** $Id: lbuiltin.h,v 1.6 2000/03/03 14:58:26 roberto Exp roberto $
** Built-in functions
** See Copyright Notice in lua.h
*/
#ifndef lbuiltin_h
#define lbuiltin_h
#include "lua.h"
void luaB__ALERT (lua_State *L);
void luaB__ERRORMESSAGE (lua_State *L);
void luaB_assert (lua_State *L);
void luaB_call (lua_State *L);
void luaB_collectgarbage (lua_State *L);
void luaB_copytagmethods (lua_State *L);
void luaB_dofile (lua_State *L);
void luaB_dostring (lua_State *L);
void luaB_error (lua_State *L);
void luaB_foreach (lua_State *L);
void luaB_foreachi (lua_State *L);
void luaB_foreachvar (lua_State *L);
void luaB_getglobal (lua_State *L);
void luaB_getn (lua_State *L);
void luaB_gettagmethod (lua_State *L);
void luaB_newtag (lua_State *L);
void luaB_next (lua_State *L);
void luaB_nextvar (lua_State *L);
void luaB_print (lua_State *L);
void luaB_rawgetglobal (lua_State *L);
void luaB_rawgettable (lua_State *L);
void luaB_rawsetglobal (lua_State *L);
void luaB_rawsettable (lua_State *L);
void luaB_setglobal (lua_State *L);
void luaB_settag (lua_State *L);
void luaB_settagmethod (lua_State *L);
void luaB_sort (lua_State *L);
void luaB_tag (lua_State *L);
void luaB_tinsert (lua_State *L);
void luaB_tonumber (lua_State *L);
void luaB_tostring (lua_State *L);
void luaB_tremove (lua_State *L);
void luaB_type (lua_State *L);
void luaB_predefine (lua_State *L);
#endif

643
lcode.c
View File

@@ -1,643 +0,0 @@
/*
** $Id: lcode.c,v 1.27 2000/04/17 14:05:34 roberto Exp roberto $
** Code generator for Lua
** See Copyright Notice in lua.h
*/
#include "stdlib.h"
#define LUA_REENTRANT
#include "lcode.h"
#include "ldo.h"
#include "llex.h"
#include "lmem.h"
#include "lobject.h"
#include "lopcodes.h"
#include "lparser.h"
#include "lstring.h"
void luaK_error (LexState *ls, const char *msg) {
luaX_error(ls, msg, ls->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 CREATE_0(OP_END); /* no optimizations after an `END' */
}
int luaK_jump (FuncState *fs) {
int j = luaK_code0(fs, OP_JMP);
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 void luaK_fixjump (FuncState *fs, int pc, int dest) {
Instruction *jmp = &fs->f->code[pc];
if (dest == NO_JUMP)
SETARG_S(*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_S)
luaK_error(fs->ls, "control structure too long");
SETARG_S(*jmp, offset);
}
}
static int luaK_getjump (FuncState *fs, int pc) {
int offset = GETARG_S(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 */
}
/*
** discharge list of jumps to last target.
** returns current `pc' and marks it as a jump target (to avoid wrong
** optimizations with consecutive instructions not in the same basic block).
*/
int luaK_getlabel (FuncState *fs) {
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 (till now) */
}
return fs->pc;
}
void luaK_deltastack (FuncState *fs, int delta) {
fs->stacklevel += delta;
if (delta > 0 && fs->stacklevel > fs->f->maxstacksize) {
if (fs->stacklevel > MAXSTACK)
luaK_error(fs->ls, "function or expression too complex");
fs->f->maxstacksize = fs->stacklevel;
}
}
void luaK_kstr (LexState *ls, int c) {
luaK_code1(ls->fs, OP_PUSHSTRING, c);
}
static int real_constant (FuncState *fs, Number r) {
/* check whether `r' has appeared within the last LOOKBACKNUMS entries */
Proto *f = fs->f;
int c = f->nknum;
int lim = c < LOOKBACKNUMS ? 0 : c-LOOKBACKNUMS;
while (--c >= lim)
if (f->knum[c] == r) return c;
/* not found; create a new entry */
luaM_growvector(fs->L, f->knum, f->nknum, 1, Number, constantEM, MAXARG_U);
c = f->nknum++;
f->knum[c] = r;
return c;
}
void luaK_number (FuncState *fs, Number f) {
if (f <= (Number)MAXARG_S && (int)f == f)
luaK_code1(fs, OP_PUSHINT, (int)f); /* f has a short integer value */
else
luaK_code1(fs, OP_PUSHNUM, real_constant(fs, f));
}
void luaK_adjuststack (FuncState *fs, int n) {
if (n > 0)
luaK_code1(fs, OP_POP, n);
else if (n < 0)
luaK_code1(fs, OP_PUSHNIL, -n);
}
int luaK_lastisopen (FuncState *fs) {
/* check whether last instruction is an open function call */
Instruction i = previous_instruction(fs);
if (GET_OPCODE(i) == OP_CALL && GETARG_B(i) == MULT_RET)
return 1;
else return 0;
}
void luaK_setcallreturns (FuncState *fs, int nresults) {
if (luaK_lastisopen(fs)) { /* expression is an open function call? */
SETARG_B(fs->f->code[fs->pc-1], nresults); /* set number of results */
luaK_deltastack(fs, nresults); /* push results */
}
}
static void assertglobal (FuncState *fs, int index) {
luaS_assertglobal(fs->L, fs->f->kstr[index]);
}
static int discharge (FuncState *fs, expdesc *var) {
switch (var->k) {
case VLOCAL:
luaK_code1(fs, OP_GETLOCAL, var->u.index);
break;
case VGLOBAL:
luaK_code1(fs, OP_GETGLOBAL, var->u.index);
assertglobal(fs, var->u.index); /* make sure that there is a global */
break;
case VINDEXED:
luaK_code0(fs, OP_GETTABLE);
break;
case VEXP:
return 0; /* nothing to do */
}
var->k = VEXP;
var->u.l.t = var->u.l.f = NO_JUMP;
return 1;
}
static void discharge1 (FuncState *fs, expdesc *var) {
discharge(fs, var);
/* if it has jumps it is already discharged */
if (var->u.l.t == NO_JUMP && var->u.l.f == NO_JUMP)
luaK_setcallreturns(fs, 1); /* call must return 1 value */
}
void luaK_storevar (LexState *ls, const expdesc *var) {
FuncState *fs = ls->fs;
switch (var->k) {
case VLOCAL:
luaK_code1(fs, OP_SETLOCAL, var->u.index);
break;
case VGLOBAL:
luaK_code1(fs, OP_SETGLOBAL, var->u.index);
assertglobal(fs, var->u.index); /* make sure that there is a global */
break;
case VINDEXED: /* table is at top-3; pop 3 elements after operation */
luaK_code2(fs, OP_SETTABLE, 3, 3);
break;
default:
LUA_INTERNALERROR(ls->L, "invalid var kind to store");
}
}
static OpCode invertjump (OpCode op) {
switch (op) {
case OP_JMPNE: return OP_JMPEQ;
case OP_JMPEQ: return OP_JMPNE;
case OP_JMPLT: return OP_JMPGE;
case OP_JMPLE: return OP_JMPGT;
case OP_JMPGT: return OP_JMPLE;
case OP_JMPGE: return OP_JMPLT;
case OP_JMPT: case OP_JMPONT: return OP_JMPF;
case OP_JMPF: case OP_JMPONF: return OP_JMPT;
default:
LUA_INTERNALERROR(NULL, "invalid jump instruction");
return OP_END; /* to avoid warnings */
}
}
static void luaK_patchlistaux (FuncState *fs, int list, int target,
OpCode special, int special_target) {
Instruction *code = fs->f->code;
while (list != NO_JUMP) {
int next = luaK_getjump(fs, list);
Instruction *i = &code[list];
OpCode op = GET_OPCODE(*i);
if (op == special) /* this `op' already has a value */
luaK_fixjump(fs, list, special_target);
else {
luaK_fixjump(fs, list, target); /* do the patch */
if (op == OP_JMPONT) /* remove eventual values */
SET_OPCODE(*i, OP_JMPT);
else if (op == OP_JMPONF)
SET_OPCODE(*i, OP_JMPF);
}
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, OP_END, 0);
}
static int need_value (FuncState *fs, int list, OpCode hasvalue) {
/* check whether list has a jump without a value */
for (; list != NO_JUMP; list = luaK_getjump(fs, list))
if (GET_OPCODE(fs->f->code[list]) != hasvalue) return 1;
return 0; /* not found */
}
void luaK_concat (FuncState *fs, int *l1, int l2) {
if (*l1 == NO_JUMP)
*l1 = l2;
else {
int list = *l1;
for (;;) { /* traverse `l1' */
int next = luaK_getjump(fs, list);
if (next == NO_JUMP) { /* end of list? */
luaK_fixjump(fs, list, l2);
return;
}
list = next;
}
}
}
static void luaK_testgo (FuncState *fs, expdesc *v, int invert, OpCode jump) {
Instruction *previous;
int *golist = &v->u.l.f;
int *exitlist = &v->u.l.t;
if (invert) { /* interchange `golist' and `exitlist' */
int *temp = golist; golist = exitlist; exitlist = temp;
}
discharge1(fs, v);
previous = &fs->f->code[fs->pc-1];
LUA_ASSERT(L, GET_OPCODE(*previous) != OP_SETLINE, "bad place to set line");
if (ISJUMP(GET_OPCODE(*previous))) {
if (invert)
SET_OPCODE(*previous, invertjump(GET_OPCODE(*previous)));
}
else
luaK_code0(fs, jump);
luaK_concat(fs, exitlist, fs->pc-1); /* insert last jump in `exitlist' */
luaK_patchlist(fs, *golist, luaK_getlabel(fs));
*golist = NO_JUMP;
}
void luaK_goiftrue (FuncState *fs, expdesc *v, int keepvalue) {
luaK_testgo(fs, v, 1, keepvalue ? OP_JMPONF : OP_JMPF);
}
void luaK_goiffalse (FuncState *fs, expdesc *v, int keepvalue) {
luaK_testgo(fs, v, 0, keepvalue ? OP_JMPONT : OP_JMPT);
}
static int code_label (FuncState *fs, OpCode op, int arg) {
int j = luaK_getlabel(fs);
luaK_code1(fs, op, arg);
return j;
}
void luaK_tostack (LexState *ls, expdesc *v, int onlyone) {
FuncState *fs = ls->fs;
if (!discharge(fs, v)) { /* `v' is an expression? */
OpCode previous = GET_OPCODE(fs->f->code[fs->pc-1]);
LUA_ASSERT(L, previous != OP_SETLINE, "bad place to set line");
if (!ISJUMP(previous) && v->u.l.f == NO_JUMP && v->u.l.t == NO_JUMP) {
/* expression has no jumps */
if (onlyone)
luaK_setcallreturns(fs, 1); /* call must return 1 value */
}
else { /* expression has jumps */
int final; /* position after whole expression */
int j = NO_JUMP; /* eventual jump over values */
int p_nil = NO_JUMP; /* position of an eventual PUSHNIL */
int p_1 = NO_JUMP; /* position of an eventual PUSHINT */
if (ISJUMP(previous) || need_value(fs, v->u.l.f, OP_JMPONF) ||
need_value(fs, v->u.l.t, OP_JMPONT)) {
/* expression needs values */
if (ISJUMP(previous))
luaK_concat(fs, &v->u.l.t, fs->pc-1); /* put `previous' in t. list */
else {
j = code_label(fs, OP_JMP, 0); /* to jump over both pushes */
luaK_deltastack(fs, -1); /* next PUSHes may be skipped */
}
p_nil = code_label(fs, OP_PUSHNILJMP, 0);
p_1 = code_label(fs, OP_PUSHINT, 1);
luaK_patchlist(fs, j, luaK_getlabel(fs));
}
final = luaK_getlabel(fs);
luaK_patchlistaux(fs, v->u.l.f, p_nil, OP_JMPONF, final);
luaK_patchlistaux(fs, v->u.l.t, p_1, OP_JMPONT, final);
v->u.l.f = v->u.l.t = NO_JUMP;
}
}
}
void luaK_prefix (LexState *ls, int op, expdesc *v) {
FuncState *fs = ls->fs;
if (op == '-') {
luaK_tostack(ls, v, 1);
luaK_code0(fs, OP_MINUS);
}
else { /* op == NOT */
Instruction *previous;
discharge1(fs, v);
previous = &fs->f->code[fs->pc-1];
if (ISJUMP(GET_OPCODE(*previous)))
SET_OPCODE(*previous, invertjump(GET_OPCODE(*previous)));
else
luaK_code0(fs, OP_NOT);
/* interchange true and false lists */
{ int temp = v->u.l.f; v->u.l.f = v->u.l.t; v->u.l.t = temp; }
}
}
void luaK_infix (LexState *ls, int op, expdesc *v) {
FuncState *fs = ls->fs;
if (op == TK_AND)
luaK_goiftrue(fs, v, 1);
else if (op == TK_OR)
luaK_goiffalse(fs, v, 1);
else
luaK_tostack(ls, v, 1); /* all other binary operators need a value */
}
void luaK_posfix (LexState *ls, int op, expdesc *v1, expdesc *v2) {
FuncState *fs = ls->fs;
if (op == TK_AND) {
LUA_ASSERT(ls->L, v1->u.l.t == NO_JUMP, "list must be closed");
discharge1(fs, v2);
v1->u.l.t = v2->u.l.t;
luaK_concat(fs, &v1->u.l.f, v2->u.l.f);
}
else if (op == TK_OR) {
LUA_ASSERT(ls->L, v1->u.l.f == NO_JUMP, "list must be closed");
discharge1(fs, v2);
v1->u.l.f = v2->u.l.f;
luaK_concat(fs, &v1->u.l.t, v2->u.l.t);
}
else {
luaK_tostack(ls, v2, 1); /* `v2' must be a value */
switch (op) {
case '+': luaK_code0(fs, OP_ADD); break;
case '-': luaK_code0(fs, OP_SUB); break;
case '*': luaK_code0(fs, OP_MULT); break;
case '/': luaK_code0(fs, OP_DIV); break;
case '^': luaK_code0(fs, OP_POW); break;
case TK_CONCAT: luaK_code1(fs, OP_CONCAT, 2); break;
case TK_EQ: luaK_code0(fs, OP_JMPEQ); break;
case TK_NE: luaK_code0(fs, OP_JMPNE); break;
case '>': luaK_code0(fs, OP_JMPGT); break;
case '<': luaK_code0(fs, OP_JMPLT); break;
case TK_GE: luaK_code0(fs, OP_JMPGE); break;
case TK_LE: luaK_code0(fs, OP_JMPLE); break;
}
}
}
int luaK_code0 (FuncState *fs, OpCode o) {
return luaK_code2(fs, o, 0, 0);
}
int luaK_code1 (FuncState *fs, OpCode o, int arg1) {
return luaK_code2(fs, o, arg1, 0);
}
int luaK_code2 (FuncState *fs, OpCode o, int arg1, int arg2) {
Instruction i = previous_instruction(fs);
int delta = 0;
enum {iO, iU, iS, iAB, iP} mode; /* instruction format (or iP to optimize) */
mode = iP;
switch (o) {
case OP_CLOSURE:
delta = -arg2+1;
mode = iAB;
break;
case OP_SETLINE:
mode = iU;
break;
case OP_CALL:
mode = iAB;
break;
case OP_PUSHINT:
delta = 1;
mode = iS;
break;
case OP_SETTABLE:
delta = -arg2;
mode = iAB;
break;
case OP_SETLIST:
delta = -(arg2+1);
mode = iAB;
break;
case OP_SETMAP:
delta = -2*(arg1+1);
mode = iU;
break;
case OP_FORLOOP:
delta = -3;
arg1 = NO_JUMP;
mode = iS;
break;
case OP_SETLOCAL:
case OP_SETGLOBAL:
delta = -1;
mode = iU;
break;
case OP_FORPREP:
case OP_JMP:
arg1 = NO_JUMP;
mode = iS;
break;
case OP_END:
case OP_PUSHNILJMP:
case OP_NOT:
mode = iO;
break;
case OP_PUSHSTRING:
case OP_PUSHNUM:
case OP_PUSHNEGNUM:
case OP_PUSHUPVALUE:
case OP_GETLOCAL:
case OP_GETGLOBAL:
case OP_PUSHSELF:
case OP_CREATETABLE:
delta = 1;
mode = iU;
break;
case OP_JMPLT:
case OP_JMPLE:
case OP_JMPGT:
case OP_JMPGE:
delta = -2;
arg1 = NO_JUMP;
mode = iS;
break;
case OP_MULT:
case OP_DIV:
case OP_POW:
delta = -1;
mode = iO;
break;
case OP_RETURN:
if (GET_OPCODE(i) == OP_CALL && GETARG_B(i) == MULT_RET) {
SET_OPCODE(i, OP_TAILCALL);
SETARG_B(i, arg1);
}
else mode = iU;
break;
case OP_PUSHNIL:
delta = arg1;
switch(GET_OPCODE(i)) {
case OP_PUSHNIL: SETARG_U(i, GETARG_U(i)+arg1); break;
default: mode = iU; break;
}
break;
case OP_POP:
delta = -arg1;
switch(GET_OPCODE(i)) {
case OP_SETTABLE: SETARG_B(i, GETARG_B(i)+arg1); break;
default: mode = iU; break;
}
break;
case OP_GETTABLE:
delta = -1;
switch(GET_OPCODE(i)) {
case OP_PUSHSTRING: SET_OPCODE(i, OP_GETDOTTED); break; /* `t.x' */
case OP_GETLOCAL: SET_OPCODE(i, OP_GETINDEXED); break; /* `t[i]' */
default: mode = iO; break;
}
break;
case OP_ADD:
delta = -1;
switch(GET_OPCODE(i)) {
case OP_PUSHINT: SET_OPCODE(i, OP_ADDI); break; /* `a+k' */
default: mode = iO; break;
}
break;
case OP_SUB:
delta = -1;
switch(GET_OPCODE(i)) {
case OP_PUSHINT: i = CREATE_S(OP_ADDI, -GETARG_S(i)); break; /* `a-k' */
default: mode = iO; break;
}
break;
case OP_CONCAT:
delta = -arg1+1;
switch(GET_OPCODE(i)) {
case OP_CONCAT: SETARG_U(i, GETARG_U(i)+1); break; /* `a..b..c' */
default: mode = iU; break;
}
break;
case OP_MINUS:
switch(GET_OPCODE(i)) {
case OP_PUSHINT: SETARG_S(i, -GETARG_S(i)); break; /* `-k' */
case OP_PUSHNUM: SET_OPCODE(i, OP_PUSHNEGNUM); break; /* `-k' */
default: mode = iO; break;
}
break;
case OP_JMPNE:
delta = -2;
if (i == CREATE_U(OP_PUSHNIL, 1)) /* `a~=nil' */
i = CREATE_S(OP_JMPT, NO_JUMP);
else {
arg1 = NO_JUMP;
mode = iS;
}
break;
case OP_JMPEQ:
delta = -2;
if (i == CREATE_U(OP_PUSHNIL, 1)) { /* `a==nil' */
i = CREATE_0(OP_NOT);
delta = -1; /* just undo effect of previous PUSHNIL */
}
else {
arg1 = NO_JUMP;
mode = iS;
}
break;
case OP_JMPT:
case OP_JMPF:
case OP_JMPONT:
case OP_JMPONF:
delta = -1;
arg1 = NO_JUMP;
switch (GET_OPCODE(i)) {
case OP_NOT: i = CREATE_S(invertjump(o), NO_JUMP); break;
default: mode = iS; break;
}
break;
case OP_GETDOTTED:
case OP_GETINDEXED:
case OP_TAILCALL:
case OP_ADDI:
LUA_INTERNALERROR(L, "instruction used only for optimizations");
return 0; /* to avoid warnings */
}
luaK_deltastack(fs, delta);
switch (mode) { /* handle instruction formats */
case iO: i = CREATE_0(o); break;
case iU: i = CREATE_U(o, arg1); break;
case iS: i = CREATE_S(o, arg1); break;
case iAB: i = CREATE_AB(o, arg1, arg2); break;
case iP: { /* optimize: put instruction in place of last one */
fs->f->code[fs->pc-1] = i; /* change previous instruction */
return fs->pc-1;
}
}
/* actually create the new instruction */
luaM_growvector(fs->L, fs->f->code, fs->pc, 1, Instruction, codeEM, MAX_INT);
fs->f->code[fs->pc] = i;
return fs->pc++;
}

46
lcode.h
View File

@@ -1,46 +0,0 @@
/*
** $Id: lcode.h,v 1.11 2000/04/07 19:35:20 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)
void luaK_error (LexState *ls, const char *msg);
int luaK_code0 (FuncState *fs, OpCode o);
int luaK_code1 (FuncState *fs, OpCode o, int arg1);
int luaK_code2 (FuncState *fs, OpCode o, int arg1, int arg2);
int luaK_jump (FuncState *fs);
void luaK_patchlist (FuncState *fs, int list, int target);
void luaK_concat (FuncState *fs, int *l1, int l2);
void luaK_goiftrue (FuncState *fs, expdesc *v, int keepvalue);
void luaK_goiffalse (FuncState *fs, expdesc *v, int keepvalue);
int luaK_getlabel (FuncState *fs);
void luaK_deltastack (FuncState *fs, int delta);
void luaK_kstr (LexState *ls, int c);
void luaK_number (FuncState *fs, Number f);
void luaK_adjuststack (FuncState *fs, int n);
int luaK_lastisopen (FuncState *fs);
void luaK_setcallreturns (FuncState *fs, int nresults);
void luaK_tostack (LexState *ls, expdesc *v, int onlyone);
void luaK_storevar (LexState *ls, const expdesc *var);
void luaK_prefix (LexState *ls, int op, expdesc *v);
void luaK_infix (LexState *ls, int op, expdesc *v);
void luaK_posfix (LexState *ls, int op, expdesc *v1, expdesc *v2);
#endif

176
ldblib.c
View File

@@ -1,176 +0,0 @@
/*
** $Id: ldblib.c,v 1.12 2000/03/30 17:19:48 roberto Exp roberto $
** Interface from Lua to its debug API
** See Copyright Notice in lua.h
*/
#include <stdlib.h>
#include <string.h>
#define LUA_REENTRANT
#include "lauxlib.h"
#include "lua.h"
#include "luadebug.h"
#include "lualib.h"
static void settabss (lua_State *L, lua_Object t, const char *i, const char *v) {
lua_pushobject(L, t);
lua_pushstring(L, i);
lua_pushstring(L, v);
lua_settable(L);
}
static void settabsi (lua_State *L, lua_Object t, const char *i, int v) {
lua_pushobject(L, t);
lua_pushstring(L, i);
lua_pushnumber(L, v);
lua_settable(L);
}
static void settabso (lua_State *L, lua_Object t, const char *i, lua_Object v) {
lua_pushobject(L, t);
lua_pushstring(L, i);
lua_pushobject(L, v);
lua_settable(L);
}
static void getstack (lua_State *L) {
lua_Debug ar;
if (!lua_getstack(L, luaL_check_int(L, 1), &ar)) /* level out of range? */
return;
else {
const char *options = luaL_check_string(L, 2);
lua_Object res = lua_createtable(L);
if (!lua_getinfo(L, options, &ar))
luaL_argerror(L, 2, "invalid option");
for (; *options; options++) {
switch (*options) {
case 'S':
settabss(L, res, "source", ar.source);
settabsi(L, res, "linedefined", ar.linedefined);
settabss(L, res, "what", ar.what);
break;
case 'l':
settabsi(L, res, "currentline", ar.currentline);
break;
case 'u':
settabsi(L, res, "nups", ar.nups);
break;
case 'n':
settabss(L, res, "name", ar.name);
settabss(L, res, "namewhat", ar.namewhat);
break;
case 'f':
settabso(L, res, "func", ar.func);
break;
}
}
lua_pushobject(L, res);
}
}
static void getlocal (lua_State *L) {
lua_Debug ar;
lua_Localvar lvar;
if (!lua_getstack(L, luaL_check_int(L, 1), &ar)) /* level out of range? */
luaL_argerror(L, 1, "level out of range");
lvar.index = luaL_check_int(L, 2);
if (lua_getlocal(L, &ar, &lvar)) {
lua_pushstring(L, lvar.name);
lua_pushobject(L, lvar.value);
}
else lua_pushnil(L);
}
static void setlocal (lua_State *L) {
lua_Debug ar;
lua_Localvar lvar;
if (!lua_getstack(L, luaL_check_int(L, 1), &ar)) /* level out of range? */
luaL_argerror(L, 1, "level out of range");
lvar.index = luaL_check_int(L, 2);
lvar.value = luaL_nonnullarg(L, 3);
if (lua_setlocal(L, &ar, &lvar))
lua_pushstring(L, lvar.name);
else lua_pushnil(L);
}
/*
** because of these variables, this module is not reentrant, and should
** not be used in multiple states
*/
static int linehook = LUA_NOREF; /* Lua reference to line hook function */
static int callhook = LUA_NOREF; /* Lua reference to call hook function */
static void linef (lua_State *L, lua_Debug *ar) {
if (linehook != LUA_NOREF) {
lua_pushnumber(L, ar->currentline);
lua_callfunction(L, lua_getref(L, linehook));
}
}
static void callf (lua_State *L, lua_Debug *ar) {
if (callhook != LUA_NOREF) {
lua_pushstring(L, ar->event);
lua_callfunction(L, lua_getref(L, callhook));
}
}
static void setcallhook (lua_State *L) {
lua_Object f = lua_getparam(L, 1);
lua_unref(L, callhook);
if (f == LUA_NOOBJECT) {
callhook = LUA_NOREF;
lua_setcallhook(L, NULL);
}
else {
lua_pushobject(L, f);
callhook = lua_ref(L, 1);
lua_setcallhook(L, callf);
}
}
static void setlinehook (lua_State *L) {
lua_Object f = lua_getparam(L, 1);
lua_unref(L, linehook);
if (f == LUA_NOOBJECT) {
linehook = LUA_NOREF;
lua_setlinehook(L, NULL);
}
else {
lua_pushobject(L, f);
linehook = lua_ref(L, 1);
lua_setlinehook(L, linef);
}
}
static const struct luaL_reg dblib[] = {
{"getlocal", getlocal},
{"getstack", getstack},
{"setcallhook", setcallhook},
{"setlinehook", setlinehook},
{"setlocal", setlocal}
};
void lua_dblibopen (lua_State *L) {
luaL_openl(L, dblib);
}

221
ldebug.c
View File

@@ -1,221 +0,0 @@
/*
** $Id: ldebug.c,v 1.15 2000/03/30 17:19:48 roberto Exp roberto $
** Debug Interface
** See Copyright Notice in lua.h
*/
#include <stdlib.h>
#define LUA_REENTRANT
#include "lapi.h"
#include "lauxlib.h"
#include "ldebug.h"
#include "ldo.h"
#include "lfunc.h"
#include "lobject.h"
#include "lstate.h"
#include "ltable.h"
#include "ltm.h"
#include "lua.h"
#include "luadebug.h"
static const lua_Type normtype[] = { /* ORDER LUA_T */
TAG_USERDATA, TAG_NUMBER, TAG_STRING, TAG_TABLE,
TAG_LCLOSURE, TAG_CCLOSURE, TAG_NIL,
TAG_LCLOSURE, TAG_CCLOSURE /* TAG_LMARK, TAG_CMARK */
};
static void setnormalized (TObject *d, const TObject *s) {
d->value = s->value;
d->ttype = normtype[ttype(s)];
}
static int hasdebuginfo (lua_State *L, StkId f) {
return (f+1 < L->top && (f+1)->ttype == TAG_LINE);
}
lua_Hook lua_setcallhook (lua_State *L, lua_Hook func) {
lua_Hook oldhook = L->callhook;
L->callhook = func;
return oldhook;
}
lua_Hook lua_setlinehook (lua_State *L, lua_Hook func) {
lua_Hook oldhook = L->linehook;
L->linehook = func;
return oldhook;
}
int lua_setdebug (lua_State *L, int debug) {
int old = L->debug;
L->debug = debug;
return old;
}
static StkId aux_stackedfunction (lua_State *L, int level, StkId top) {
int i;
for (i = (top-1)-L->stack; i>=0; i--) {
if (is_T_MARK(L->stack[i].ttype)) {
if (level == 0)
return L->stack+i;
level--;
}
}
return NULL;
}
int lua_getstack (lua_State *L, int level, lua_Debug *ar) {
StkId f = aux_stackedfunction(L, level, L->top);
if (f == NULL) return 0; /* there is no such level */
else {
ar->_func = f;
return 1;
}
}
static int lua_nups (StkId f) {
switch (ttype(f)) {
case TAG_LCLOSURE: case TAG_CCLOSURE:
case TAG_LMARK: case TAG_CMARK:
return f->value.cl->nelems;
default:
return 0;
}
}
static int lua_currentline (lua_State *L, StkId f) {
return hasdebuginfo(L, f) ? (f+1)->value.i : -1;
}
static Proto *getluaproto (StkId f) {
return (ttype(f) == TAG_LMARK) ? clvalue(f)->f.l : NULL;
}
int lua_getlocal (lua_State *L, const lua_Debug *ar, lua_Localvar *v) {
StkId f = ar->_func;
Proto *fp = getluaproto(f);
if (!fp) return 0; /* `f' is not a Lua function? */
v->name = luaF_getlocalname(fp, v->index, lua_currentline(L, f));
if (!v->name) return 0;
/* if `name', there must be a TAG_LINE */
/* therefore, f+2 points to function base */
LUA_ASSERT(L, ttype(f+1) == TAG_LINE, "");
v->value = luaA_putluaObject(L, (f+2)+(v->index-1));
return 1;
}
int lua_setlocal (lua_State *L, const lua_Debug *ar, lua_Localvar *v) {
StkId f = ar->_func;
Proto *fp = getluaproto(f);
if (!fp) return 0; /* `f' is not a Lua function? */
v->name = luaF_getlocalname(fp, v->index, lua_currentline(L, f));
if (!v->name) return 0;
LUA_ASSERT(L, ttype(f+1) == TAG_LINE, "");
*((f+2)+(v->index-1)) = *v->value;
return 1;
}
static void lua_funcinfo (lua_Debug *ar) {
StkId func = ar->_func;
switch (ttype(func)) {
case TAG_LCLOSURE: case TAG_LMARK:
ar->source = clvalue(func)->f.l->source->str;
ar->linedefined = clvalue(func)->f.l->lineDefined;
ar->what = "Lua";
break;
case TAG_CCLOSURE: case TAG_CMARK:
ar->source = "(C)";
ar->linedefined = -1;
ar->what = "C";
break;
default:
LUA_INTERNALERROR(L, "invalid `func' value");
}
if (ar->linedefined == 0)
ar->what = "main";
}
static int checkfunc (lua_State *L, TObject *o) {
return luaO_equalObj(o, L->top);
}
static void lua_getobjname (lua_State *L, StkId f, lua_Debug *ar) {
GlobalVar *g;
/* try to find a name for given function */
setnormalized(L->top, f); /* to be used by `checkfunc' */
for (g=L->rootglobal; g; g=g->next) {
if (checkfunc(L, &g->value)) {
ar->name = g->name->str;
ar->namewhat = "global";
return;
}
}
/* not found: try tag methods */
if ((ar->name = luaT_travtagmethods(L, checkfunc)) != NULL)
ar->namewhat = "tag-method";
else ar->namewhat = ""; /* not found at all */
}
int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) {
StkId func = ar->_func;
LUA_ASSERT(L, is_T_MARK(ttype(func)), "invalid activation record");
for (; *what; what++) {
switch (*what) {
case 'S':
lua_funcinfo(ar);
break;
case 'l':
ar->currentline = lua_currentline(L, func);
break;
case 'u':
ar->nups = lua_nups(func);
break;
case 'n':
lua_getobjname(L, func, ar);
break;
case 'f':
setnormalized(L->top, func);
incr_top;
ar->func = luaA_putObjectOnTop(L);
break;
default: return 0; /* invalid option */
}
}
return 1;
}
static void call_index_error (lua_State *L, TObject *o, const char *v) {
luaL_verror(L, "attempt to %.10s a %.10s value", v, lua_type(L, o));
}
void luaG_callerror (lua_State *L, TObject *func) {
call_index_error(L, func, "call");
}
void luaG_indexerror (lua_State *L, TObject *t) {
call_index_error(L, t, "index");
}

View File

@@ -1,19 +0,0 @@
/*
** $Id: $
** Auxiliary functions from Debug Interface module
** See Copyright Notice in lua.h
*/
#ifndef ldebug_h
#define ldebug_h
#include "lobject.h"
#include "luadebug.h"
void luaG_callerror (lua_State *L, TObject *func);
void luaG_indexerror (lua_State *L, TObject *t);
#endif

366
ldo.c
View File

@@ -1,366 +0,0 @@
/*
** $Id: ldo.c,v 1.72 2000/03/30 20:55:50 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_REENTRANT
#include "lauxlib.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 "ltm.h"
#include "lua.h"
#include "luadebug.h"
#include "lundump.h"
#include "lvm.h"
#include "lzio.h"
#define EXTRA_STACK 32 /* space to handle stack overflow errors */
/*
** typical numer of stack slots used by a (big) function
** (this constant is used only for choosing error messages)
*/
#define SLOTS_PER_F 20
void luaD_init (lua_State *L, int stacksize) {
L->stack = luaM_newvector(L, stacksize+EXTRA_STACK, TObject);
L->stack_last = L->stack+(stacksize-1);
L->stacksize = stacksize;
L->Cstack.base = L->Cstack.lua2C = L->top = L->stack;
L->Cstack.num = 0;
}
void luaD_checkstack (lua_State *L, int n) {
if (L->stack_last-L->top <= n) { /* stack overflow? */
if (L->stack_last-L->stack > (L->stacksize-1)) {
/* overflow while handling overflow: do what?? */
L->top -= EXTRA_STACK;
lua_error(L, "BAD STACK OVERFLOW! DATA CORRUPTED!");
}
else {
lua_Debug dummy;
L->stack_last += EXTRA_STACK; /* to be used by error message */
if (lua_getstack(L, L->stacksize/SLOTS_PER_F, &dummy) == 0) {
/* too few funcs on stack: doesn't look like a recursion loop */
lua_error(L, "Lua2C - C2Lua overflow");
}
else
lua_error(L, "stack overflow; possible recursion loop");
}
}
}
static void restore_stack_limit (lua_State *L) {
if (L->top-L->stack < L->stacksize-1)
L->stack_last = L->stack+(L->stacksize-1);
}
/*
** Adjust stack. Set top to base+extra, pushing NILs if needed.
** (we cannot add base+extra unless we are sure it fits in the stack;
** otherwise the result of such operation on pointers is undefined)
*/
void luaD_adjusttop (lua_State *L, StkId base, int extra) {
int diff = extra-(L->top-base);
if (diff <= 0)
L->top = base+extra;
else {
luaD_checkstack(L, diff);
while (diff--)
ttype(L->top++) = TAG_NIL;
}
}
/*
** Open a hole inside the stack at `pos'
*/
void luaD_openstack (lua_State *L, StkId pos) {
int i = L->top-pos;
while (i--) pos[i+1] = pos[i];
incr_top;
}
void luaD_lineHook (lua_State *L, StkId func, int line) {
if (L->allowhooks) {
lua_Debug ar;
struct C_Lua_Stack oldCLS = L->Cstack;
StkId old_top = L->Cstack.lua2C = L->Cstack.base = L->top;
L->Cstack.num = 0;
ar._func = func;
ar.event = "line";
ar.currentline = line;
L->allowhooks = 0; /* cannot call hooks inside a hook */
(*L->linehook)(L, &ar);
L->allowhooks = 1;
L->top = old_top;
L->Cstack = oldCLS;
}
}
static void luaD_callHook (lua_State *L, StkId func, lua_Hook callhook,
const char *event) {
if (L->allowhooks) {
lua_Debug ar;
struct C_Lua_Stack oldCLS = L->Cstack;
StkId old_top = L->Cstack.lua2C = L->Cstack.base = L->top;
L->Cstack.num = 0;
ar._func = func;
ar.event = event;
L->allowhooks = 0; /* cannot call hooks inside a hook */
callhook(L, &ar);
L->allowhooks = 1;
L->top = old_top;
L->Cstack = oldCLS;
}
}
static StkId callCclosure (lua_State *L, const struct Closure *cl, StkId base) {
int nup = cl->nelems; /* number of upvalues */
int numarg = L->top-base;
struct C_Lua_Stack oldCLS = L->Cstack;
StkId firstResult;
if (nup > 0) {
int n = numarg;
luaD_checkstack(L, nup);
/* open space for upvalues as extra arguments */
while (n--) *(base+nup+n) = *(base+n);
L->top += nup;
numarg += nup;
/* copy upvalues into stack */
while (nup--) *(base+nup) = cl->consts[nup];
}
L->Cstack.num = numarg;
L->Cstack.lua2C = base;
L->Cstack.base = L->top;
(*cl->f.c)(L); /* do the actual call */
firstResult = L->Cstack.base;
L->Cstack = oldCLS;
return firstResult;
}
void luaD_callTM (lua_State *L, const TObject *f, int nParams, int nResults) {
StkId base = L->top - nParams;
luaD_openstack(L, base);
*base = *f;
luaD_call(L, base, nResults);
}
/*
** 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, the results are on the stack, starting at the original
** function position.
** The number of results is nResults, unless nResults=MULT_RET.
*/
void luaD_call (lua_State *L, StkId func, int nResults) {
StkId firstResult;
lua_Hook callhook = L->callhook;
retry: /* for `function' tag method */
switch (ttype(func)) {
case TAG_LCLOSURE: {
ttype(func) = TAG_LMARK;
if (callhook)
luaD_callHook(L, func, callhook, "call");
firstResult = luaV_execute(L, clvalue(func), func+1);
break;
}
case TAG_CCLOSURE: {
ttype(func) = TAG_CMARK;
if (callhook)
luaD_callHook(L, func, callhook, "call");
firstResult = callCclosure(L, clvalue(func), func+1);
break;
}
default: { /* `func' is not a function; check the `function' tag method */
const TObject *im = luaT_getimbyObj(L, func, IM_FUNCTION);
if (ttype(im) == TAG_NIL)
luaG_callerror(L, func);
luaD_openstack(L, func);
*func = *im; /* tag method is the new function to be called */
goto retry; /* retry the call */
}
}
if (callhook) /* same hook that was active at entry */
luaD_callHook(L, func, callhook, "return");
/* adjust the number of results */
if (nResults == MULT_RET)
nResults = L->top - firstResult;
else
luaD_adjusttop(L, firstResult, nResults);
/* move results to `func' (to erase parameters and function) */
while (nResults) {
*func++ = *(L->top - nResults);
nResults--;
}
L->top = func;
}
static void message (lua_State *L, const char *s) {
const TObject *em = &(luaS_assertglobalbyname(L, "_ERRORMESSAGE")->value);
if (*luaO_typename(em) == 'f') {
*L->top = *em;
incr_top;
lua_pushstring(L, s);
luaD_call(L, L->top-2, 0);
}
}
/*
** Reports an error, and jumps up to the available recovery label
*/
void lua_error (lua_State *L, const char *s) {
if (s) message(L, s);
if (L->errorJmp)
longjmp(L->errorJmp->b, 1);
else {
message(L, "unable to recover; exiting\n");
exit(1);
}
}
/*
** Execute a protected call. Assumes that function is at Cstack.base and
** parameters are on top of it.
*/
int luaD_protectedrun (lua_State *L) {
struct lua_longjmp myErrorJmp;
StkId base = L->Cstack.base;
int numCblocks = L->numCblocks;
int status;
struct lua_longjmp *volatile oldErr = L->errorJmp;
L->errorJmp = &myErrorJmp;
if (setjmp(myErrorJmp.b) == 0) {
luaD_call(L, base, MULT_RET);
L->Cstack.lua2C = base; /* position of the new results */
L->Cstack.num = L->top - base;
L->Cstack.base = base + L->Cstack.num; /* incorporate results on stack */
status = 0;
}
else { /* an error occurred: restore the stack */
L->Cstack.num = 0; /* no results */
L->top = L->Cstack.base = L->Cstack.lua2C = base;
L->numCblocks = numCblocks;
restore_stack_limit(L);
status = 1;
}
L->errorJmp = oldErr;
return status;
}
/*
** returns 0 = chunk loaded; 1 = error; 2 = no more chunks to load
*/
static int protectedparser (lua_State *L, ZIO *z, int bin) {
struct lua_longjmp myErrorJmp;
StkId base = L->Cstack.base;
int numCblocks = L->numCblocks;
int status;
Proto *volatile tf;
struct lua_longjmp *volatile oldErr = L->errorJmp;
L->errorJmp = &myErrorJmp;
L->top = base; /* clear C2Lua */
if (setjmp(myErrorJmp.b) == 0) {
tf = bin ? luaU_undump1(L, z) : luaY_parser(L, z);
status = 0;
}
else { /* an error occurred: restore Cstack and top */
L->Cstack.num = 0; /* no results */
L->top = L->Cstack.base = L->Cstack.lua2C = base;
L->numCblocks = numCblocks;
tf = NULL;
status = 1;
}
L->errorJmp = oldErr;
if (status) return 1; /* error code */
if (tf == NULL) return 2; /* `natural' end */
luaV_Lclosure(L, tf, 0);
return 0;
}
static int do_main (lua_State *L, ZIO *z, int bin) {
int status;
int debug = L->debug; /* save debug status */
do {
long old_blocks = (luaC_checkGC(L), L->nblocks);
status = protectedparser(L, z, bin);
if (status == 1) return 1; /* error */
else if (status == 2) return 0; /* `natural' end */
else {
unsigned long newelems2 = 2*(L->nblocks-old_blocks);
L->GCthreshold += newelems2;
status = luaD_protectedrun(L);
L->GCthreshold -= newelems2;
}
} while (bin && status == 0);
L->debug = debug; /* restore debug status */
return status;
}
#define MAXFILENAME 260 /* maximum part of a file name kept */
int lua_dofile (lua_State *L, const char *filename) {
ZIO z;
int status;
int bin; /* flag for file mode */
int c; /* look ahead char */
char source[MAXFILENAME];
FILE *f = (filename == NULL) ? stdin : fopen(filename, "r");
if (f == NULL) return 2; /* unable to open file */
luaL_filesource(source, filename, sizeof(source));
c = fgetc(f);
ungetc(c, f);
bin = (c == ID_CHUNK);
if (bin && f != stdin) {
f = freopen(filename, "rb", f); /* set binary mode */
if (f == NULL) return 2; /* unable to reopen file */
}
luaZ_Fopen(&z, f, source);
status = do_main(L, &z, bin);
if (f != stdin)
fclose(f);
return status;
}
int lua_dostring (lua_State *L, const char *str) {
return lua_dobuffer(L, str, strlen(str), str);
}
int lua_dobuffer (lua_State *L, const char *buff, int size, const char *name) {
ZIO z;
if (!name) name = "?";
luaZ_mopen(&z, buff, size, name);
return do_main(L, &z, buff[0]==ID_CHUNK);
}

32
ldo.h
View File

@@ -1,32 +0,0 @@
/*
** $Id: ldo.h,v 1.19 2000/03/29 20:19:20 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++;}
void luaD_init (lua_State *L, int stacksize);
void luaD_adjusttop (lua_State *L, StkId base, int extra);
void luaD_openstack (lua_State *L, StkId pos);
void luaD_lineHook (lua_State *L, StkId func, int line);
void luaD_call (lua_State *L, StkId func, int nResults);
void luaD_callTM (lua_State *L, const TObject *f, int nParams, int nResults);
int luaD_protectedrun (lua_State *L);
void luaD_checkstack (lua_State *L, int n);
#endif

923
lex_yy.c Normal file
View 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);
}

92
lfunc.c
View File

@@ -1,92 +0,0 @@
/*
** $Id: lfunc.c,v 1.20 2000/03/10 18:37:44 roberto Exp roberto $
** Auxiliary functions to manipulate prototypes and closures
** See Copyright Notice in lua.h
*/
#include <stdlib.h>
#define LUA_REENTRANT
#include "lfunc.h"
#include "lmem.h"
#include "lstate.h"
#define gcsizeproto(L, p) numblocks(L, 0, sizeof(Proto))
#define gcsizeclosure(L, c) numblocks(L, c->nelems, sizeof(Closure))
Closure *luaF_newclosure (lua_State *L, int nelems) {
Closure *c = (Closure *)luaM_malloc(L, sizeof(Closure) +
sizeof(TObject)*(nelems-1));
c->next = L->rootcl;
L->rootcl = c;
c->marked = 0;
c->nelems = nelems;
L->nblocks += gcsizeclosure(L, c);
return c;
}
Proto *luaF_newproto (lua_State *L) {
Proto *f = luaM_new(L, Proto);
f->code = NULL;
f->lineDefined = 0;
f->source = NULL;
f->kstr = NULL;
f->nkstr = 0;
f->knum = NULL;
f->nknum = 0;
f->kproto = NULL;
f->nkproto = 0;
f->locvars = NULL;
f->next = L->rootproto;
L->rootproto = f;
f->marked = 0;
L->nblocks += gcsizeproto(L, f);
return f;
}
void luaF_freeproto (lua_State *L, Proto *f) {
L->nblocks -= gcsizeproto(L, f);
luaM_free(L, f->code);
luaM_free(L, f->locvars);
luaM_free(L, f->kstr);
luaM_free(L, f->knum);
luaM_free(L, f->kproto);
luaM_free(L, f);
}
void luaF_freeclosure (lua_State *L, Closure *c) {
L->nblocks -= gcsizeclosure(L, c);
luaM_free(L, c);
}
/*
** Look for n-th local variable at line `line' in function `func'.
** Returns NULL if not found.
*/
const char *luaF_getlocalname (const Proto *func,
int local_number, int line) {
int count = 0;
const char *varname = NULL;
LocVar *lv = func->locvars;
if (lv == NULL)
return NULL;
for (; lv->line != -1 && lv->line < line; lv++) {
if (lv->varname) { /* register */
if (++count == local_number)
varname = lv->varname->str;
}
else /* unregister */
if (--count < local_number)
varname = NULL;
}
return varname;
}

24
lfunc.h
View File

@@ -1,24 +0,0 @@
/*
** $Id: lfunc.h,v 1.10 1999/12/27 17:33:22 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 char *luaF_getlocalname (const Proto *func,
int local_number, int line);
#endif

269
lgc.c
View File

@@ -1,269 +0,0 @@
/*
** $Id: lgc.c,v 1.46 2000/03/30 20:55:50 roberto Exp roberto $
** Garbage Collector
** See Copyright Notice in lua.h
*/
#define LUA_REENTRANT
#include "ldo.h"
#include "lfunc.h"
#include "lgc.h"
#include "lmem.h"
#include "lobject.h"
#include "lref.h"
#include "lstate.h"
#include "lstring.h"
#include "ltable.h"
#include "ltm.h"
#include "lua.h"
static void luaD_gcTM (lua_State *L, const TObject *o) {
const TObject *im = luaT_getimbyObj(L, o, IM_GC);
if (ttype(im) != TAG_NIL) {
luaD_checkstack(L, 2);
*(L->top++) = *im;
*(L->top++) = *o;
luaD_call(L, L->top-2, 0);
}
}
static int markobject (lua_State *L, TObject *o);
/* mark a string; marks larger than 1 cannot be changed */
#define strmark(L, s) {if ((s)->marked == 0) (s)->marked = 1;}
static void protomark (lua_State *L, Proto *f) {
if (!f->marked) {
int i;
f->marked = 1;
strmark(L, f->source);
for (i=f->nkstr-1; i>=0; i--)
strmark(L, f->kstr[i]);
for (i=f->nkproto-1; i>=0; i--)
protomark(L, f->kproto[i]);
}
}
static void closuremark (lua_State *L, Closure *f) {
if (!f->marked) {
int i = f->nelems;
f->marked = 1;
while (i--)
markobject(L, &f->consts[i]);
}
}
static void hashmark (lua_State *L, Hash *h) {
if (!h->marked) {
int i;
h->marked = 1;
for (i=h->size-1; i>=0; i--) {
Node *n = node(h,i);
if (ttype(key(n)) != TAG_NIL) {
markobject(L, &n->key);
markobject(L, &n->val);
}
}
}
}
static void travglobal (lua_State *L) {
GlobalVar *gv;
for (gv=L->rootglobal; gv; gv=gv->next) {
LUA_ASSERT(L, gv->name->u.s.gv == gv, "inconsistent global name");
if (gv->value.ttype != TAG_NIL) {
strmark(L, gv->name); /* cannot collect non nil global variables */
markobject(L, &gv->value);
}
}
}
static void travstack (lua_State *L) {
int i;
for (i = (L->top-1)-L->stack; i>=0; i--)
markobject(L, L->stack+i);
}
static void travlock (lua_State *L) {
int i;
for (i=0; i<L->refSize; i++) {
if (L->refArray[i].st == LOCK)
markobject(L, &L->refArray[i].o);
}
}
static int markobject (lua_State *L, TObject *o) {
switch (ttype(o)) {
case TAG_USERDATA: case TAG_STRING:
strmark(L, tsvalue(o));
break;
case TAG_TABLE:
hashmark(L, avalue(o));
break;
case TAG_LCLOSURE: case TAG_LMARK:
protomark(L, clvalue(o)->f.l);
/* go trhough */
case TAG_CCLOSURE: case TAG_CMARK:
closuremark(L, clvalue(o));
break;
default: break; /* numbers, etc */
}
return 0;
}
static void collectproto (lua_State *L) {
Proto **p = &L->rootproto;
Proto *next;
while ((next = *p) != NULL) {
if (next->marked) {
next->marked = 0;
p = &next->next;
}
else {
*p = next->next;
luaF_freeproto(L, next);
}
}
}
static void collectclosure (lua_State *L) {
Closure **p = &L->rootcl;
Closure *next;
while ((next = *p) != NULL) {
if (next->marked) {
next->marked = 0;
p = &next->next;
}
else {
*p = next->next;
luaF_freeclosure(L, next);
}
}
}
static void collecttable (lua_State *L) {
Hash **p = &L->roottable;
Hash *next;
while ((next = *p) != NULL) {
if (next->marked) {
next->marked = 0;
p = &next->next;
}
else {
*p = next->next;
luaH_free(L, next);
}
}
}
/*
** remove from the global list globals whose names will be collected
** (the global itself is freed when its name is freed)
*/
static void clear_global_list (lua_State *L, int limit) {
GlobalVar **p = &L->rootglobal;
GlobalVar *next;
while ((next = *p) != NULL) {
if (next->name->marked >= limit) p = &next->next;
else *p = next->next;
}
}
/*
** collect all elements with `marked' < `limit'.
** with limit=1, that means all unmarked elements;
** with limit=MAX_INT, that means all elements.
*/
static void collectstring (lua_State *L, int limit) {
TObject o; /* to call userdata `gc' tag method */
int i;
ttype(&o) = TAG_USERDATA;
clear_global_list(L, limit);
for (i=0; i<NUM_HASHS; i++) { /* for each hash table */
stringtable *tb = &L->string_root[i];
int j;
for (j=0; j<tb->size; j++) { /* for each list */
TString **p = &tb->hash[j];
TString *next;
while ((next = *p) != NULL) {
if (next->marked >= limit) {
if (next->marked < FIXMARK) /* does not change FIXMARKs */
next->marked = 0;
p = &next->nexthash;
}
else { /* collect */
if (next->constindex == -1) { /* is userdata? */
tsvalue(&o) = next;
luaD_gcTM(L, &o);
}
*p = next->nexthash;
luaS_free(L, next);
tb->nuse--;
}
}
}
if ((tb->nuse+1)*6 < tb->size)
luaS_resize(L, tb, tb->size/2); /* table is too big */
}
}
static void markall (lua_State *L) {
travstack(L); /* mark stack objects */
travglobal(L); /* mark global variable values and names */
travlock(L); /* mark locked objects */
luaT_travtagmethods(L, markobject); /* mark tag methods */
}
void luaC_collect (lua_State *L, int all) {
int oldah = L->allowhooks;
L->allowhooks = 0; /* stop debug hooks during GC */
L->GCthreshold *= 4; /* to avoid GC during GC */
collecttable(L);
collectstring(L, all?MAX_INT:1);
collectproto(L);
collectclosure(L);
L->allowhooks = oldah; /* restore hooks */
}
long lua_collectgarbage (lua_State *L, long limit) {
unsigned long recovered = L->nblocks; /* to subtract `nblocks' after gc */
markall(L);
luaR_invalidaterefs(L);
luaC_collect(L, 0);
recovered = recovered - L->nblocks;
L->GCthreshold = (limit == 0) ? 2*L->nblocks : L->nblocks+limit;
if (L->Mbuffsize > L->Mbuffnext*4) { /* is buffer too big? */
L->Mbuffsize /= 2; /* still larger than Mbuffnext*2 */
luaM_reallocvector(L, L->Mbuffer, L->Mbuffsize, char);
}
luaD_gcTM(L, &luaO_nilobject);
return recovered;
}
void luaC_checkGC (lua_State *L) {
if (L->nblocks >= L->GCthreshold)
lua_collectgarbage(L, 0);
}

18
lgc.h
View File

@@ -1,18 +0,0 @@
/*
** $Id: lgc.h,v 1.6 1999/10/04 17:51:04 roberto Exp roberto $
** Garbage Collector
** See Copyright Notice in lua.h
*/
#ifndef lgc_h
#define lgc_h
#include "lobject.h"
void luaC_checkGC (lua_State *L);
void luaC_collect (lua_State *L, int all);
#endif

21
linit.c
View File

@@ -1,21 +0,0 @@
/*
** $Id: linit.c,v 1.2 1999/11/22 13:12:07 roberto Exp roberto $
** Initialization of libraries for lua.c
** See Copyright Notice in lua.h
*/
#define LUA_REENTRANT
#include "lua.h"
#include "lualib.h"
void lua_userinit (lua_State *L) {
lua_beginblock(L);
lua_iolibopen(L);
lua_strlibopen(L);
lua_mathlibopen(L);
lua_dblibopen(L);
lua_endblock(L);
}

649
liolib.c
View File

@@ -1,649 +0,0 @@
/*
** $Id: liolib.c,v 1.61 2000/03/30 17:19:48 roberto Exp roberto $
** Standard I/O (and system) library
** See Copyright Notice in lua.h
*/
#include <ctype.h>
#include <errno.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#define LUA_REENTRANT
#include "lauxlib.h"
#include "lua.h"
#include "luadebug.h"
#include "lualib.h"
#ifndef OLD_ANSI
#include <locale.h>
#else
/* no support for locale and for strerror: fake them */
#define setlocale(a,b) ((void)a, strcmp((b),"C")==0?"C":NULL)
#define LC_ALL 0
#define LC_COLLATE 0
#define LC_CTYPE 0
#define LC_MONETARY 0
#define LC_NUMERIC 0
#define LC_TIME 0
#define strerror(e) "(no error message provided by operating system)"
#endif
#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
typedef struct IOCtrl {
FILE *file[2]; /* values of _INPUT and _OUTPUT */
int iotag; /* tag for file handles */
int closedtag; /* tag for closed handles */
} IOCtrl;
static const char *const filenames[] = {"_INPUT", "_OUTPUT", NULL};
static void atribTM (lua_State *L) {
IOCtrl *ctrl = (IOCtrl *)lua_getuserdata(L, lua_getparam(L, 1));
const char *varname = luaL_check_string(L, 2);
lua_Object newvalue = lua_getparam(L, 4);
int inout;
if ((inout = luaL_findstring(varname, filenames)) != -1) {
if (lua_tag(L, newvalue) != ctrl->iotag)
luaL_verror(L, "%.20s value must be a valid file handle",
filenames[inout]);
ctrl->file[inout] = (FILE *)lua_getuserdata(L, newvalue);
}
/* set the actual variable */
lua_pushobject(L, newvalue);
lua_rawsetglobal(L, varname);
}
static void ctrl_collect (lua_State *L) {
IOCtrl *ctrl = (IOCtrl *)lua_getuserdata(L, lua_getparam(L, 1));
free(ctrl);
}
static void pushresult (lua_State *L, int i) {
if (i)
lua_pushuserdata(L, NULL);
else {
lua_pushnil(L);
lua_pushstring(L, strerror(errno));
lua_pushnumber(L, errno);
}
}
/*
** {======================================================
** FILE Operations
** =======================================================
*/
static FILE *gethandle (lua_State *L, IOCtrl *ctrl, lua_Object f) {
if (lua_isuserdata(L, f)) {
int ftag = lua_tag(L, f);
if (ftag == ctrl->iotag)
return (FILE *)lua_getuserdata(L, f);
else if (ftag == ctrl->closedtag)
lua_error(L, "cannot access a closed file");
/* else go through */
}
return NULL;
}
static FILE *getnonullfile (lua_State *L, IOCtrl *ctrl, int arg) {
FILE *f = gethandle(L, ctrl, lua_getparam(L, arg));
luaL_arg_check(L, f, arg, "invalid file handle");
return f;
}
static FILE *getfileparam (lua_State *L, IOCtrl *ctrl, int *arg, int inout) {
FILE *f = gethandle(L, ctrl, lua_getparam(L, *arg));
if (f) {
(*arg)++;
return f;
}
else
return ctrl->file[inout];
}
static void setfilebyname (lua_State *L, IOCtrl *ctrl, FILE *f,
const char *name) {
lua_pushusertag(L, f, ctrl->iotag);
lua_setglobal(L, name);
}
static void setfile (lua_State *L, IOCtrl *ctrl, FILE *f, int inout) {
ctrl->file[inout] = f;
lua_pushusertag(L, f, ctrl->iotag);
lua_setglobal(L, filenames[inout]);
}
static void setreturn (lua_State *L, IOCtrl *ctrl, FILE *f, int inout) {
if (f == NULL)
pushresult(L, 0);
else {
setfile(L, ctrl, f, inout);
lua_pushusertag(L, f, ctrl->iotag);
}
}
static int closefile (lua_State *L, IOCtrl *ctrl, FILE *f) {
if (f == stdin || f == stdout)
return 1;
else {
if (f == ctrl->file[INFILE])
setfile(L, ctrl, stdin, INFILE);
else if (f == ctrl->file[OUTFILE])
setfile(L, ctrl, stdout, OUTFILE);
lua_pushusertag(L, f, ctrl->iotag);
lua_settag(L, ctrl->closedtag);
return (CLOSEFILE(L, f) == 0);
}
}
static void io_close (lua_State *L) {
IOCtrl *ctrl = (IOCtrl *)lua_getuserdata(L, lua_getparam(L, 1));
pushresult(L, closefile(L, ctrl, getnonullfile(L, ctrl, 2)));
}
static void io_open (lua_State *L) {
IOCtrl *ctrl = (IOCtrl *)lua_getuserdata(L, lua_getparam(L, 1));
FILE *f = fopen(luaL_check_string(L, 2), luaL_check_string(L, 3));
if (f) lua_pushusertag(L, f, ctrl->iotag);
else pushresult(L, 0);
}
static void io_fromto (lua_State *L, int inout, const char *mode) {
IOCtrl *ctrl = (IOCtrl *)lua_getuserdata(L, lua_getparam(L, 1));
lua_Object f = lua_getparam(L, 2);
FILE *current;
if (f == LUA_NOOBJECT) {
pushresult(L, closefile(L, ctrl, ctrl->file[inout]));
return;
}
else if (lua_tag(L, f) == ctrl->iotag) /* deprecated option */
current = (FILE *)lua_getuserdata(L, f);
else {
const char *s = luaL_check_string(L, 2);
current = (*s == '|') ? popen(s+1, mode) : fopen(s, mode);
}
setreturn(L, ctrl, current, inout);
}
static void io_readfrom (lua_State *L) {
io_fromto(L, INFILE, "r");
}
static void io_writeto (lua_State *L) {
io_fromto(L, OUTFILE, "w");
}
static void io_appendto (lua_State *L) {
IOCtrl *ctrl = (IOCtrl *)lua_getuserdata(L, lua_getparam(L, 1));
FILE *current = fopen(luaL_check_string(L, 2), "a");
setreturn(L, ctrl, current, OUTFILE);
}
/*
** {======================================================
** READ
** =======================================================
*/
#ifdef LUA_COMPAT_READPATTERN
/*
** We cannot lookahead without need, because this can lock stdin.
** This flag signals when we need to read a next char.
*/
#define NEED_OTHER (EOF-1) /* just some flag different from EOF */
static int read_pattern (lua_State *L, FILE *f, const char *p) {
int inskip = 0; /* {skip} level */
int c = NEED_OTHER;
while (*p != '\0') {
switch (*p) {
case '{':
inskip++;
p++;
continue;
case '}':
if (!inskip) lua_error(L, "unbalanced braces in read pattern");
inskip--;
p++;
continue;
default: {
const char *ep = luaI_classend(L, p); /* get what is next */
int m; /* match result */
if (c == NEED_OTHER) c = getc(f);
m = (c==EOF) ? 0 : luaI_singlematch(c, p, ep);
if (m) {
if (!inskip) luaL_addchar(L, c);
c = NEED_OTHER;
}
switch (*ep) {
case '+': /* repetition (1 or more) */
if (!m) goto break_while; /* pattern fails? */
/* else go through */
case '*': /* repetition (0 or more) */
while (m) { /* reads the same item until it fails */
c = getc(f);
m = (c==EOF) ? 0 : luaI_singlematch(c, p, ep);
if (m && !inskip) luaL_addchar(L, c);
}
/* go through to continue reading the pattern */
case '?': /* optional */
p = ep+1; /* continues reading the pattern */
continue;
default:
if (!m) goto break_while; /* pattern fails? */
p = ep; /* else continues reading the pattern */
}
}
}
} break_while:
if (c != NEED_OTHER) ungetc(c, f);
return (*p == '\0');
}
#else
#define read_pattern(L, f, p) (lua_error(L, "read patterns are deprecated"), 0)
#endif
static int read_number (lua_State *L, FILE *f) {
double d;
if (fscanf(f, "%lf", &d) == 1) {
lua_pushnumber(L, d);
return 1;
}
else return 0; /* read fails */
}
static void read_word (lua_State *L, FILE *f) {
int c;
do { c = fgetc(f); } while (isspace(c)); /* skip spaces */
while (c != EOF && !isspace(c)) {
luaL_addchar(L, c);
c = fgetc(f);
}
ungetc(c, f);
}
#define HUNK_LINE 256
#define HUNK_FILE BUFSIZ
static int read_line (lua_State *L, FILE *f) {
int n;
char *b;
do {
b = luaL_openspace(L, HUNK_LINE);
if (!fgets(b, HUNK_LINE, f)) return 0; /* read fails */
n = strlen(b);
luaL_addsize(L, n);
} while (b[n-1] != '\n');
luaL_addsize(L, -1); /* remove '\n' */
return 1;
}
static void read_file (lua_State *L, FILE *f) {
int n;
do {
char *b = luaL_openspace(L, HUNK_FILE);
n = fread(b, sizeof(char), HUNK_FILE, f);
luaL_addsize(L, n);
} while (n==HUNK_FILE);
}
static int read_chars (lua_State *L, FILE *f, int n) {
char *b = luaL_openspace(L, n);
int n1 = fread(b, sizeof(char), n, f);
luaL_addsize(L, n1);
return (n == n1);
}
static void io_read (lua_State *L) {
IOCtrl *ctrl = (IOCtrl *)lua_getuserdata(L, lua_getparam(L, 1));
int arg = 2;
FILE *f = getfileparam(L, ctrl, &arg, INFILE);
lua_Object op = lua_getparam(L, arg);
do { /* repeat for each part */
long l;
int success;
luaL_resetbuffer(L);
if (lua_isnumber(L, op))
success = read_chars(L, f, (int)lua_getnumber(L, op));
else {
const char *p = luaL_opt_string(L, arg, "*l");
if (p[0] != '*')
success = read_pattern(L, f, p); /* deprecated! */
else {
switch (p[1]) {
case 'n': /* number */
if (!read_number(L, f)) return; /* read fails */
continue; /* number is already pushed; avoid the "pushstring" */
case 'l': /* line */
success = read_line(L, f);
break;
case 'a': /* file */
read_file(L, f);
success = 1; /* always success */
break;
case 'w': /* word */
read_word(L, f);
success = 0; /* must read something to succeed */
break;
default:
luaL_argerror(L, arg, "invalid format");
success = 0; /* to avoid warnings */
}
}
}
l = luaL_getsize(L);
if (!success && l==0) return; /* read fails */
lua_pushlstring(L, luaL_buffer(L), l);
} while ((op = lua_getparam(L, ++arg)) != LUA_NOOBJECT);
}
/* }====================================================== */
static void io_write (lua_State *L) {
IOCtrl *ctrl = (IOCtrl *)lua_getuserdata(L, lua_getparam(L, 1));
int arg = 2;
FILE *f = getfileparam(L, ctrl, &arg, OUTFILE);
int status = 1;
lua_Object o;
while ((o = lua_getparam(L, arg)) != LUA_NOOBJECT) {
if (lua_type(L, o)[2] == 'm') { /* nuMber? */ /* LUA_NUMBER */
/* optimization: could be done exactly as for strings */
status = status && fprintf(f, "%.16g", lua_getnumber(L, o)) > 0;
}
else {
long l;
const char *s = luaL_check_lstr(L, arg, &l);
status = status && ((long)fwrite(s, sizeof(char), l, f) == l);
}
arg++;
}
pushresult(L, status);
}
static void io_seek (lua_State *L) {
static const int mode[] = {SEEK_SET, SEEK_CUR, SEEK_END};
static const char *const modenames[] = {"set", "cur", "end", NULL};
IOCtrl *ctrl = (IOCtrl *)lua_getuserdata(L, lua_getparam(L, 1));
FILE *f = getnonullfile(L, ctrl, 2);
int op = luaL_findstring(luaL_opt_string(L, 3, "cur"), modenames);
long offset = luaL_opt_long(L, 4, 0);
luaL_arg_check(L, op != -1, 3, "invalid mode");
op = fseek(f, offset, mode[op]);
if (op)
pushresult(L, 0); /* error */
else
lua_pushnumber(L, ftell(f));
}
static void io_flush (lua_State *L) {
IOCtrl *ctrl = (IOCtrl *)lua_getuserdata(L, lua_getparam(L, 1));
lua_Object of = lua_getparam(L, 2);
FILE *f = gethandle(L, ctrl, of);
luaL_arg_check(L, f || of == LUA_NOOBJECT, 2, "invalid file handle");
pushresult(L, fflush(f) == 0);
}
/* }====================================================== */
/*
** {======================================================
** Other O.S. Operations
** =======================================================
*/
static void io_execute (lua_State *L) {
lua_pushnumber(L, system(luaL_check_string(L, 1)));
}
static void io_remove (lua_State *L) {
pushresult(L, remove(luaL_check_string(L, 1)) == 0);
}
static void io_rename (lua_State *L) {
pushresult(L, rename(luaL_check_string(L, 1),
luaL_check_string(L, 2)) == 0);
}
static void io_tmpname (lua_State *L) {
lua_pushstring(L, tmpnam(NULL));
}
static void io_getenv (lua_State *L) {
lua_pushstring(L, getenv(luaL_check_string(L, 1))); /* if NULL push nil */
}
static void io_clock (lua_State *L) {
lua_pushnumber(L, ((double)clock())/CLOCKS_PER_SEC);
}
static void io_date (lua_State *L) {
char b[256];
const char *s = luaL_opt_string(L, 1, "%c");
struct tm *stm;
time_t t;
time(&t); stm = localtime(&t);
if (strftime(b, sizeof(b), s, stm))
lua_pushstring(L, b);
else
lua_error(L, "invalid `date' format");
}
static void setloc (lua_State *L) {
static const int cat[] = {LC_ALL, LC_COLLATE, LC_CTYPE, LC_MONETARY,
LC_NUMERIC, LC_TIME};
static const char *const catnames[] = {"all", "collate", "ctype", "monetary",
"numeric", "time", NULL};
int op = luaL_findstring(luaL_opt_string(L, 2, "all"), catnames);
luaL_arg_check(L, op != -1, 2, "invalid option");
lua_pushstring(L, setlocale(cat[op], luaL_check_string(L, 1)));
}
static void io_exit (lua_State *L) {
exit(luaL_opt_int(L, 1, EXIT_SUCCESS));
}
/* }====================================================== */
static void io_debug (lua_State *L) {
for (;;) {
char buffer[250];
fprintf(stderr, "lua_debug> ");
if (fgets(buffer, sizeof(buffer), stdin) == 0 ||
strcmp(buffer, "cont\n") == 0)
return;
lua_dostring(L, buffer);
}
}
#define MESSAGESIZE 150
#define MAXMESSAGE (MESSAGESIZE*10)
static void errorfb (lua_State *L) {
char buff[MAXMESSAGE];
int level = 1; /* skip level 0 (it's this function) */
lua_Debug ar;
lua_Object alertfunc = lua_rawgetglobal(L, "_ALERT");
sprintf(buff, "error: %.200s\n", lua_getstring(L, lua_getparam(L, 1)));
while (lua_getstack(L, level++, &ar)) {
char buffchunk[60];
lua_getinfo(L, "Snl", &ar);
luaL_chunkid(buffchunk, ar.source, sizeof(buffchunk));
if (level == 2) strcat(buff, "stack traceback:\n");
strcat(buff, " ");
if (strlen(buff) > MAXMESSAGE-MESSAGESIZE) {
strcat(buff, "...\n");
break; /* buffer is full */
}
switch (*ar.namewhat) {
case 'g': case 'l': /* global, local */
sprintf(buff+strlen(buff), "function `%.50s'", ar.name);
break;
case 'f': /* field */
sprintf(buff+strlen(buff), "method `%.50s'", ar.name);
break;
case 't': /* tag method */
sprintf(buff+strlen(buff), "`%.50s' tag method", ar.name);
break;
default: {
if (*ar.what == 'm') /* main? */
sprintf(buff+strlen(buff), "main of %.70s", buffchunk);
else if (*ar.what == 'C') /* C function? */
sprintf(buff+strlen(buff), "%.70s", buffchunk);
else
sprintf(buff+strlen(buff), "function <%d:%.70s>",
ar.linedefined, buffchunk);
ar.source = NULL;
}
}
if (ar.currentline > 0)
sprintf(buff+strlen(buff), " at line %d", ar.currentline);
if (ar.source)
sprintf(buff+strlen(buff), " [%.70s]", buffchunk);
strcat(buff, "\n");
}
if (lua_isfunction(L, alertfunc)) { /* avoid loop if _ALERT is not defined */
lua_pushstring(L, buff);
lua_callfunction(L, alertfunc);
}
}
static const struct luaL_reg iolib[] = {
{"_ERRORMESSAGE", errorfb},
{"clock", io_clock},
{"date", io_date},
{"debug", io_debug},
{"execute", io_execute},
{"exit", io_exit},
{"getenv", io_getenv},
{"remove", io_remove},
{"rename", io_rename},
{"setlocale", setloc},
{"tmpname", io_tmpname}
};
static const struct luaL_reg iolibtag[] = {
{"appendto", io_appendto},
{"closefile", io_close},
{"flush", io_flush},
{"openfile", io_open},
{"read", io_read},
{"readfrom", io_readfrom},
{"seek", io_seek},
{"write", io_write},
{"writeto", io_writeto}
};
static void openwithcontrol (lua_State *L) {
IOCtrl *ctrl = (IOCtrl *)malloc(sizeof(IOCtrl));
unsigned int i;
int ctrltag = lua_newtag(L);
ctrl->iotag = lua_newtag(L);
ctrl->closedtag = lua_newtag(L);
for (i=0; i<sizeof(iolibtag)/sizeof(iolibtag[0]); i++) {
/* put `ctrl' as upvalue for these functions */
lua_pushusertag(L, ctrl, ctrltag);
lua_pushcclosure(L, iolibtag[i].func, 1);
lua_setglobal(L, iolibtag[i].name);
}
/* predefined file handles */
ctrl->file[INFILE] = stdin;
setfile(L, ctrl, stdin, INFILE);
ctrl->file[OUTFILE] = stdout;
setfile(L, ctrl, stdout, OUTFILE);
setfilebyname(L, ctrl, stdin, "_STDIN");
setfilebyname(L, ctrl, stdout, "_STDOUT");
setfilebyname(L, ctrl, stderr, "_STDERR");
/* change file when assigned */
lua_pushusertag(L, ctrl, ctrltag);
lua_pushcclosure(L, atribTM, 1);
lua_settagmethod(L, ctrl->iotag, "setglobal");
/* delete `ctrl' when collected */
lua_pushusertag(L, ctrl, ctrltag);
lua_pushcclosure(L, ctrl_collect, 1);
lua_settagmethod(L, ctrltag, "gc");
}
void lua_iolibopen (lua_State *L) {
luaL_openl(L, iolib);
openwithcontrol(L);
}

446
llex.c
View File

@@ -1,446 +0,0 @@
/*
** $Id: llex.c,v 1.56 2000/04/07 13:11:49 roberto Exp roberto $
** Lexical Analyzer
** See Copyright Notice in lua.h
*/
#include <ctype.h>
#include <stdio.h>
#include <string.h>
#define LUA_REENTRANT
#include "lauxlib.h"
#include "llex.h"
#include "lmem.h"
#include "lobject.h"
#include "lparser.h"
#include "lstate.h"
#include "lstring.h"
#include "luadebug.h"
#include "lzio.h"
#define next(LS) (LS->current = zgetc(LS->z))
#define save(L, c) luaL_addchar(L, c)
#define save_and_next(L, LS) (save(L, LS->current), next(LS))
/* ORDER RESERVED */
static const char *const token2string [] = {
"and", "break", "do", "else", "elseif", "end", "for",
"function", "if", "local", "nil", "not", "or", "repeat", "return", "then",
"until", "while", "", "..", "...", "==", ">=", "<=", "~=", "", "", "<eof>"};
void luaX_init (lua_State *L) {
int i;
for (i=0; i<NUM_RESERVED; i++) {
TString *ts = luaS_new(L, token2string[i]);
ts->marked = (unsigned char)(RESERVEDMARK+i); /* reserved word */
}
}
#define MAXSRC 80
void luaX_syntaxerror (LexState *ls, const char *s, const char *token) {
char buff[MAXSRC];
luaL_chunkid(buff, zname(ls->z), sizeof(buff));
luaL_verror(ls->L, "%.100s;\n last token read: `%.50s' at line %d in %.80s",
s, token, ls->linenumber, buff);
}
void luaX_error (LexState *ls, const char *s, int token) {
char buff[TOKEN_LEN];
luaX_token2str(token, buff);
if (buff[0] == '\0') {
save(ls->L, '\0');
luaX_syntaxerror(ls, s, luaL_buffer(ls->L));
}
else
luaX_syntaxerror(ls, s, buff);
}
void luaX_token2str (int token, char *s) {
if (token < 256) {
s[0] = (char)token;
s[1] = '\0';
}
else
strcpy(s, token2string[token-FIRST_RESERVED]);
}
static void luaX_invalidchar (LexState *ls, int c) {
char buff[8];
sprintf(buff, "0x%02X", c);
luaX_syntaxerror(ls, "invalid control char", buff);
}
static void firstline (LexState *LS)
{
int c = zgetc(LS->z);
if (c == '#')
while ((c=zgetc(LS->z)) != '\n' && c != EOZ) /* skip first line */;
zungetc(LS->z);
}
void luaX_setinput (lua_State *L, LexState *LS, ZIO *z) {
LS->L = L;
LS->current = '\n';
LS->linenumber = 0;
LS->iflevel = 0;
LS->ifstate[0].skip = 0;
LS->ifstate[0].elsepart = 1; /* to avoid a free $else */
LS->z = z;
LS->fs = NULL;
firstline(LS);
luaL_resetbuffer(L);
}
/*
** =======================================================
** PRAGMAS
** =======================================================
*/
static void skipspace (LexState *LS) {
while (LS->current == ' ' || LS->current == '\t' || LS->current == '\r')
next(LS);
}
static int checkcond (lua_State *L, LexState *LS, const char *buff) {
static const char *const opts[] = {"nil", "1", NULL};
int i = luaL_findstring(buff, opts);
if (i >= 0) return i;
else if (isalpha((unsigned char)buff[0]) || buff[0] == '_')
return luaS_globaldefined(L, buff);
else {
luaX_syntaxerror(LS, "invalid $if condition", buff);
return 0; /* to avoid warnings */
}
}
static void readname (LexState *LS, char *buff) {
int i = 0;
skipspace(LS);
while (isalnum(LS->current) || LS->current == '_') {
if (i >= PRAGMASIZE) {
buff[PRAGMASIZE] = 0;
luaX_syntaxerror(LS, "pragma too long", buff);
}
buff[i++] = (char)LS->current;
next(LS);
}
buff[i] = 0;
}
static void inclinenumber (lua_State *L, LexState *LS);
static void ifskip (lua_State *L, LexState *LS) {
while (LS->ifstate[LS->iflevel].skip) {
if (LS->current == '\n')
inclinenumber(L, LS);
else if (LS->current == EOZ)
luaX_error(LS, "input ends inside a $if", TK_EOS);
else next(LS);
}
}
static void inclinenumber (lua_State *L, LexState *LS) {
static const char *const pragmas [] =
{"debug", "nodebug", "endinput", "end", "ifnot", "if", "else", NULL};
next(LS); /* skip '\n' */
++LS->linenumber;
if (LS->current == '$') { /* is a pragma? */
char buff[PRAGMASIZE+1];
int ifnot = 0;
int skip = LS->ifstate[LS->iflevel].skip;
next(LS); /* skip $ */
readname(LS, buff);
switch (luaL_findstring(buff, pragmas)) {
case 0: /* debug */
if (!skip) L->debug = 1;
break;
case 1: /* nodebug */
if (!skip) L->debug = 0;
break;
case 2: /* endinput */
if (!skip) {
LS->current = EOZ;
LS->iflevel = 0; /* to allow $endinput inside a $if */
}
break;
case 3: /* end */
if (LS->iflevel-- == 0)
luaX_syntaxerror(LS, "unmatched $end", "$end");
break;
case 4: /* ifnot */
ifnot = 1;
/* go through */
case 5: /* if */
if (LS->iflevel == MAX_IFS-1)
luaX_syntaxerror(LS, "too many nested $ifs", "$if");
readname(LS, buff);
LS->iflevel++;
LS->ifstate[LS->iflevel].elsepart = 0;
LS->ifstate[LS->iflevel].condition = checkcond(L, LS, buff) ? !ifnot : ifnot;
LS->ifstate[LS->iflevel].skip = skip || !LS->ifstate[LS->iflevel].condition;
break;
case 6: /* else */
if (LS->ifstate[LS->iflevel].elsepart)
luaX_syntaxerror(LS, "unmatched $else", "$else");
LS->ifstate[LS->iflevel].elsepart = 1;
LS->ifstate[LS->iflevel].skip = LS->ifstate[LS->iflevel-1].skip ||
LS->ifstate[LS->iflevel].condition;
break;
default:
luaX_syntaxerror(LS, "unknown pragma", buff);
}
skipspace(LS);
if (LS->current == '\n') /* pragma must end with a '\n' ... */
inclinenumber(L, LS);
else if (LS->current != EOZ) /* or eof */
luaX_syntaxerror(LS, "invalid pragma format", buff);
ifskip(L, LS);
}
}
/*
** =======================================================
** LEXICAL ANALYZER
** =======================================================
*/
static void read_long_string (lua_State *L, LexState *LS) {
int cont = 0;
for (;;) {
switch (LS->current) {
case EOZ:
luaX_error(LS, "unfinished long string", TK_STRING);
break; /* to avoid warnings */
case '[':
save_and_next(L, LS);
if (LS->current == '[') {
cont++;
save_and_next(L, LS);
}
continue;
case ']':
save_and_next(L, LS);
if (LS->current == ']') {
if (cont == 0) goto endloop;
cont--;
save_and_next(L, LS);
}
continue;
case '\n':
save(L, '\n');
inclinenumber(L, LS);
continue;
default:
save_and_next(L, LS);
}
} endloop:
save_and_next(L, LS); /* skip the second ']' */
LS->seminfo.ts = luaS_newlstr(L, L->Mbuffer+(L->Mbuffbase+2),
L->Mbuffnext-L->Mbuffbase-4);
}
static void read_string (lua_State *L, LexState *LS, int del) {
save_and_next(L, LS);
while (LS->current != del) {
switch (LS->current) {
case EOZ: case '\n':
luaX_error(LS, "unfinished string", TK_STRING);
break; /* to avoid warnings */
case '\\':
next(LS); /* do not save the '\' */
switch (LS->current) {
case 'a': save(L, '\a'); next(LS); break;
case 'b': save(L, '\b'); next(LS); break;
case 'f': save(L, '\f'); next(LS); break;
case 'n': save(L, '\n'); next(LS); break;
case 'r': save(L, '\r'); next(LS); break;
case 't': save(L, '\t'); next(LS); break;
case 'v': save(L, '\v'); next(LS); break;
case '\n': save(L, '\n'); inclinenumber(L, LS); break;
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9': {
int c = 0;
int i = 0;
do {
c = 10*c + (LS->current-'0');
next(LS);
} while (++i<3 && isdigit(LS->current));
if (c != (unsigned char)c)
luaX_error(LS, "escape sequence too large", TK_STRING);
save(L, c);
break;
}
default: /* handles \\, \", \', and \? */
save(L, LS->current);
next(LS);
}
break;
default:
save_and_next(L, LS);
}
}
save_and_next(L, LS); /* skip delimiter */
LS->seminfo.ts = luaS_newlstr(L, L->Mbuffer+(L->Mbuffbase+1),
L->Mbuffnext-L->Mbuffbase-2);
}
int luaX_lex (LexState *LS) {
lua_State *L = LS->L;
for (;;) {
switch (LS->current) {
case ' ': case '\t': case '\r': /* `\r' to avoid problems with DOS */
next(LS);
continue;
case '\n':
inclinenumber(L, LS);
continue;
case '-':
next(LS);
if (LS->current != '-') return '-';
do { next(LS); } while (LS->current != '\n' && LS->current != EOZ);
continue;
case '[':
luaL_resetbuffer(L);
save_and_next(L, LS);
if (LS->current != '[') return '[';
else {
save_and_next(L, LS); /* pass the second '[' */
read_long_string(L, LS);
return TK_STRING;
}
case '=':
next(LS);
if (LS->current != '=') return '=';
else { next(LS); return TK_EQ; }
case '<':
next(LS);
if (LS->current != '=') return '<';
else { next(LS); return TK_LE; }
case '>':
next(LS);
if (LS->current != '=') return '>';
else { next(LS); return TK_GE; }
case '~':
next(LS);
if (LS->current != '=') return '~';
else { next(LS); return TK_NE; }
case '"':
case '\'':
luaL_resetbuffer(L);
read_string(L, LS, LS->current);
return TK_STRING;
case '.':
luaL_resetbuffer(L);
save_and_next(L, LS);
if (LS->current == '.') {
next(LS);
if (LS->current == '.') {
next(LS);
return TK_DOTS; /* ... */
}
else return TK_CONCAT; /* .. */
}
else if (!isdigit(LS->current)) return '.';
else goto fraction; /* LS->current is a digit */
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
luaL_resetbuffer(L);
do {
save_and_next(L, LS);
} while (isdigit(LS->current));
if (LS->current == '.') {
save_and_next(L, LS);
if (LS->current == '.') {
save(L, '.');
luaX_error(LS, "ambiguous syntax"
" (decimal point x string concatenation)", TK_NUMBER);
}
}
fraction: /* LUA_NUMBER */
while (isdigit(LS->current))
save_and_next(L, LS);
if (LS->current == 'e' || LS->current == 'E') {
save_and_next(L, LS); /* read 'E' */
if (LS->current == '+' || LS->current == '-')
save_and_next(L, LS); /* optional exponent sign */
while (isdigit(LS->current))
save_and_next(L, LS);
}
save(L, '\0');
if (!luaO_str2d(L->Mbuffer+L->Mbuffbase, &LS->seminfo.r))
luaX_error(LS, "malformed number", TK_NUMBER);
return TK_NUMBER;
case EOZ:
if (LS->iflevel > 0)
luaX_error(LS, "input ends inside a $if", TK_EOS);
return TK_EOS;
case '_': goto tname;
default:
if (!isalpha(LS->current)) {
int c = LS->current;
if (iscntrl(c))
luaX_invalidchar(LS, c);
next(LS);
return c;
}
tname: { /* identifier or reserved word */
TString *ts;
luaL_resetbuffer(L);
do {
save_and_next(L, LS);
} while (isalnum(LS->current) || LS->current == '_');
save(L, '\0');
ts = luaS_new(L, L->Mbuffer+L->Mbuffbase);
if (ts->marked >= RESERVEDMARK) /* reserved word? */
return ts->marked-RESERVEDMARK+FIRST_RESERVED;
LS->seminfo.ts = ts;
return TK_NAME;
}
}
}
}

71
llex.h
View File

@@ -1,71 +0,0 @@
/*
** $Id: llex.h,v 1.23 2000/04/07 13:11:49 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 (+1 for final 0) */
#define TOKEN_LEN 15
/*
* 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_IF, 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))
/* `ifState' keeps the state of each nested $if the lexical is dealing with. */
struct ifState {
int elsepart; /* true if it's in the $else part */
int condition; /* true if $if condition is true */
int skip; /* true if part must be skipped */
};
typedef struct LexState {
int current; /* look ahead character */
int token; /* look ahead token */
struct FuncState *fs; /* `FuncState' is private to the parser */
struct lua_State *L;
union {
Number r;
TString *ts;
} seminfo; /* semantics information */
struct zio *z; /* input stream */
int linenumber; /* input line counter */
int iflevel; /* level of nested $if's (for lexical analysis) */
struct ifState ifstate[MAX_IFS];
} LexState;
void luaX_init (lua_State *L);
void luaX_setinput (lua_State *L, LexState *LS, ZIO *z);
int luaX_lex (LexState *LS);
void luaX_syntaxerror (LexState *ls, const char *s, const char *token);
void luaX_error (LexState *ls, const char *s, int token);
void luaX_token2str (int token, char *s);
#endif

194
llimits.h
View File

@@ -1,194 +0,0 @@
/*
** $Id: llimits.h,v 1.4 2000/03/31 16:28:45 roberto Exp roberto $
** Limits, basic types, and some other "instalation-dependent" definitions
** See Copyright Notice in lua.h
*/
#ifndef llimits_h
#define llimits_h
#include <limits.h>
/*
** Define the type `number' of Lua
** GREP LUA_NUMBER to change that
*/
#ifndef LUA_NUM_TYPE
#define LUA_NUM_TYPE double
#endif
typedef LUA_NUM_TYPE Number;
#define MAX_INT (INT_MAX-2) /* maximum value of an int (-2 for safety) */
/*
** conversion of pointer to int (for hashing only)
** (the shift removes bits that are usually 0 because of alignment)
*/
#define IntPoint(L, p) (((unsigned long)(p)) >> 3)
/*
** number of `blocks' for garbage collection: each reference to other
** objects count 1, and each 32 bytes of `raw' memory count 1; we add
** 2 to the total as a minimum (and also to count the overhead of malloc)
*/
#define numblocks(L, o,b) ((o)+((b)>>5)+2)
#define MINPOWER2 4 /* minimum size for "growing" vectors */
#ifndef DEFAULT_STACK_SIZE
#define DEFAULT_STACK_SIZE 1024
#endif
/*
** type for virtual-machine instructions
** must be an unsigned with 4 bytes (see details in lopcodes.h)
** For a very small machine, you may change that to 2 bytes (and adjust
** the following limits accordingly)
*/
typedef unsigned long Instruction;
/*
** limits for opcode arguments.
** For an instruction with 2 bytes, size is 16, and size_b can be 5
*/
#define SIZE_INSTRUCTION 32
#define SIZE_OP 6
#define SIZE_B 9
#define SIZE_U (SIZE_INSTRUCTION-SIZE_OP)
#define POS_U SIZE_OP
#define POS_B SIZE_OP
#define SIZE_A (SIZE_INSTRUCTION-(SIZE_OP+SIZE_B))
#define POS_A (SIZE_OP+SIZE_B)
#define MAXARG_U ((1<<SIZE_U)-1)
#define MAXARG_S (MAXARG_U>>1) /* `S' is signed */
#define MAXARG_A ((1<<SIZE_A)-1)
#define MAXARG_B ((1<<SIZE_B)-1)
/*
** we use int to manipulate most arguments, so they must fit
*/
#if MAXARG_U > MAX_INT
#undef MAXARG_U
#define MAXARG_U MAX_INT
#endif
#if MAXARG_S > MAX_INT
#undef MAXARG_S
#define MAXARG_S MAX_INT
#endif
#if MAXARG_A > MAX_INT
#undef MAXARG_A
#define MAXARG_A MAX_INT
#endif
#if MAXARG_B > MAX_INT
#undef MAXARG_B
#define MAXARG_B MAX_INT
#endif
/* maximum stack size in a function */
#define MAXSTACK MAXARG_B
/* maximum number of local variables */
#ifndef MAXLOCALS
#define MAXLOCALS 200 /* arbitrary limit (<MAXSTACK) */
#endif
#if MAXLOCALS>=MAXSTACK
#undef MAXLOCALS
#define MAXLOCALS (MAXSTACK-1)
#endif
/* maximum number of upvalues */
#ifndef MAXUPVALUES
#define MAXUPVALUES 32 /* arbitrary limit (<=MAXARG_B) */
#endif
#if MAXUPVALUES>MAXARG_B
#undef MAXUPVALUES
#define MAXUPVALUES MAXARG_B
#endif
/* special code for multiple returns */
#define MULT_RET 255 /* (<=MAXARG_B) */
#if MULT_RET>MAXARG_B
#undef MULT_RET
#define MULT_RET MAXARG_B
#endif
/* maximum number of variables in the left side of an assignment */
#ifndef MAXVARSLH
#define MAXVARSLH 100 /* arbitrary limit (<MULT_RET) */
#endif
#if MAXVARSLH>=MULT_RET
#undef MAXVARSLH
#define MAXVARSLH (MULT_RET-1)
#endif
/* maximum number of parameters in a function */
#ifndef MAXPARAMS
#define MAXPARAMS 100 /* arbitrary limit (<MAXLOCALS) */
#endif
#if MAXPARAMS>=MAXLOCALS
#undef MAXPARAMS
#define MAXPARAMS (MAXLOCALS-1)
#endif
/* number of list items to accumulate before a SETLIST instruction */
#define LFIELDS_PER_FLUSH 64
#if LFIELDS_PER_FLUSH>(MAXSTACK/4)
#undef LFIELDS_PER_FLUSH
#define LFIELDS_PER_FLUSH (MAXSTACK/4)
#endif
/* number of record items to accumulate before a SETMAP instruction */
/* (each item counts 2 elements on the stack: an index and a value) */
#define RFIELDS_PER_FLUSH (LFIELDS_PER_FLUSH/2)
/* maximum number of values printed in one call to `print' */
#ifndef MAXPRINT
#define MAXPRINT 40 /* arbitrary limit */
#endif
/* maximum depth of nested $ifs */
#ifndef MAX_IFS
#define MAX_IFS 5 /* arbitrary limit */
#endif
/* maximum size of a pragma line */
#ifndef PRAGMASIZE
#define PRAGMASIZE 80 /* arbitrary limit */
#endif
/* maximum lookback to find a real constant (for code generation) */
#ifndef LOOKBACKNUMS
#define LOOKBACKNUMS 20 /* arbitrary constant */
#endif
#endif

View File

@@ -1,208 +0,0 @@
/*
** $Id: lmathlib.c,v 1.23 1999/12/27 17:33:22 roberto Exp roberto $
** Standard mathematical library
** See Copyright Notice in lua.h
*/
#include <stdlib.h>
#include <math.h>
#define LUA_REENTRANT
#include "lauxlib.h"
#include "lua.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 void math_abs (lua_State *L) {
lua_pushnumber(L, fabs(luaL_check_number(L, 1)));
}
static void math_sin (lua_State *L) {
lua_pushnumber(L, sin(TORAD(luaL_check_number(L, 1))));
}
static void math_cos (lua_State *L) {
lua_pushnumber(L, cos(TORAD(luaL_check_number(L, 1))));
}
static void math_tan (lua_State *L) {
lua_pushnumber(L, tan(TORAD(luaL_check_number(L, 1))));
}
static void math_asin (lua_State *L) {
lua_pushnumber(L, FROMRAD(asin(luaL_check_number(L, 1))));
}
static void math_acos (lua_State *L) {
lua_pushnumber(L, FROMRAD(acos(luaL_check_number(L, 1))));
}
static void math_atan (lua_State *L) {
lua_pushnumber(L, FROMRAD(atan(luaL_check_number(L, 1))));
}
static void math_atan2 (lua_State *L) {
lua_pushnumber(L, FROMRAD(atan2(luaL_check_number(L, 1), luaL_check_number(L, 2))));
}
static void math_ceil (lua_State *L) {
lua_pushnumber(L, ceil(luaL_check_number(L, 1)));
}
static void math_floor (lua_State *L) {
lua_pushnumber(L, floor(luaL_check_number(L, 1)));
}
static void math_mod (lua_State *L) {
lua_pushnumber(L, fmod(luaL_check_number(L, 1), luaL_check_number(L, 2)));
}
static void math_sqrt (lua_State *L) {
lua_pushnumber(L, sqrt(luaL_check_number(L, 1)));
}
static void math_pow (lua_State *L) {
lua_pushnumber(L, pow(luaL_check_number(L, 1), luaL_check_number(L, 2)));
}
static void math_log (lua_State *L) {
lua_pushnumber(L, log(luaL_check_number(L, 1)));
}
static void math_log10 (lua_State *L) {
lua_pushnumber(L, log10(luaL_check_number(L, 1)));
}
static void math_exp (lua_State *L) {
lua_pushnumber(L, exp(luaL_check_number(L, 1)));
}
static void math_deg (lua_State *L) {
lua_pushnumber(L, luaL_check_number(L, 1)/RADIANS_PER_DEGREE);
}
static void math_rad (lua_State *L) {
lua_pushnumber(L, luaL_check_number(L, 1)*RADIANS_PER_DEGREE);
}
static void math_frexp (lua_State *L) {
int e;
lua_pushnumber(L, frexp(luaL_check_number(L, 1), &e));
lua_pushnumber(L, e);
}
static void math_ldexp (lua_State *L) {
lua_pushnumber(L, ldexp(luaL_check_number(L, 1), luaL_check_int(L, 2)));
}
static void math_min (lua_State *L) {
int i = 1;
double dmin = luaL_check_number(L, i);
while (lua_getparam(L, ++i) != LUA_NOOBJECT) {
double d = luaL_check_number(L, i);
if (d < dmin)
dmin = d;
}
lua_pushnumber(L, dmin);
}
static void math_max (lua_State *L) {
int i = 1;
double dmax = luaL_check_number(L, i);
while (lua_getparam(L, ++i) != LUA_NOOBJECT) {
double d = luaL_check_number(L, i);
if (d > dmax)
dmax = d;
}
lua_pushnumber(L, dmax);
}
static void 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 */
double r = (double)(rand()%RAND_MAX) / (double)RAND_MAX;
if (lua_getparam(L, 1) == LUA_NOOBJECT) /* no arguments? */
lua_pushnumber(L, r); /* Number between 0 and 1 */
else {
int l, u; /* lower & upper limits */
if (lua_getparam(L, 2) == LUA_NOOBJECT) { /* only one argument? */
l = 1;
u = luaL_check_int(L, 1);
}
else { /* two arguments */
l = luaL_check_int(L, 1);
u = luaL_check_int(L, 2);
}
luaL_arg_check(L, l<=u, 1, "interval is empty");
lua_pushnumber(L, (int)(r*(u-l+1))+l); /* integer between `l' and `u' */
}
}
static void math_randomseed (lua_State *L) {
srand(luaL_check_int(L, 1));
}
static const struct luaL_reg mathlib[] = {
{"abs", math_abs},
{"sin", math_sin},
{"cos", math_cos},
{"tan", math_tan},
{"asin", math_asin},
{"acos", math_acos},
{"atan", math_atan},
{"atan2", math_atan2},
{"ceil", math_ceil},
{"floor", math_floor},
{"mod", math_mod},
{"frexp", math_frexp},
{"ldexp", math_ldexp},
{"sqrt", math_sqrt},
{"min", math_min},
{"max", math_max},
{"log", math_log},
{"log10", math_log10},
{"exp", math_exp},
{"deg", math_deg},
{"rad", math_rad},
{"random", math_random},
{"randomseed", math_randomseed}
};
/*
** Open math library
*/
void lua_mathlibopen (lua_State *L) {
luaL_openl(L, mathlib);
lua_pushcfunction(L, math_pow);
lua_pushnumber(L, 0); /* to get its tag */
lua_settagmethod(L, lua_tag(L, lua_pop(L)), "pow");
lua_pushnumber(L, PI); lua_setglobal(L, "PI");
}

142
lmem.c
View File

@@ -1,142 +0,0 @@
/*
** $Id: lmem.c,v 1.28 2000/03/10 18:37:44 roberto Exp roberto $
** Interface to Memory Manager
** See Copyright Notice in lua.h
*/
#include <stdlib.h>
#define LUA_REENTRANT
#include "lmem.h"
#include "lobject.h"
#include "lstate.h"
#include "lua.h"
/*
** Number ANSI systems do not need these tests;
** but some systems (Sun OS) are not that ANSI...
*/
#ifdef OLD_ANSI
#define realloc(b,s) ((b) == NULL ? malloc(s) : (realloc)(b, s))
#define free(b) if (b) (free)(b)
#endif
#ifdef DEBUG
/*
** {======================================================================
** Controlled version for realloc.
** =======================================================================
*/
#include <assert.h>
#include <string.h>
#define realloc(b, s) debug_realloc(b, s)
#define malloc(b) debug_realloc(NULL, 0)
#define free(b) debug_realloc(b, 0)
/* ensures maximum alignment for HEADER */
#define HEADER (sizeof(double)>sizeof(long) ? sizeof(double) : sizeof(long))
#define MARKSIZE 16
#define MARK 0x55 /* 01010101 (a nice pattern) */
#define blocksize(b) ((unsigned long *)((char *)(b) - HEADER))
unsigned long memdebug_numblocks = 0;
unsigned long memdebug_total = 0;
unsigned long memdebug_maxmem = 0;
static void *checkblock (void *block) {
unsigned long *b = blocksize(block);
unsigned long size = *b;
int i;
for (i=0;i<MARKSIZE;i++)
assert(*(((char *)b)+HEADER+size+i) == MARK+i); /* corrupted block? */
memdebug_numblocks--;
memdebug_total -= size;
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 */
}
}
static void *debug_realloc (void *block, size_t size) {
if (size == 0) {
freeblock(block);
return NULL;
}
else {
size_t realsize = HEADER+size+MARKSIZE;
char *newblock = (char *)(malloc)(realsize); /* alloc a new block */
int i;
if (newblock == NULL) return NULL;
if (block) {
size_t oldsize = *blocksize(block);
if (oldsize > size) oldsize = size;
memcpy(newblock+HEADER, block, oldsize);
freeblock(block); /* erase (and check) old copy */
}
memdebug_total += size;
if (memdebug_total > memdebug_maxmem) memdebug_maxmem = memdebug_total;
memdebug_numblocks++;
*(unsigned long *)newblock = size;
for (i=0;i<MARKSIZE;i++)
*(newblock+HEADER+size+i) = (char)(MARK+i);
return newblock+HEADER;
}
}
/* }====================================================================== */
#endif
void *luaM_growaux (lua_State *L, void *block, unsigned long nelems,
int inc, int size, const char *errormsg, unsigned long limit) {
unsigned long newn = nelems+inc;
if (newn >= limit) lua_error(L, errormsg);
if ((newn ^ nelems) <= nelems || /* still the same power-of-2 limit? */
(nelems > 0 && newn < MINPOWER2)) /* or block already is MINPOWER2? */
return block; /* do not need to reallocate */
else /* it crossed a power-of-2 boundary; grow to next power */
return luaM_realloc(L, block, luaO_power2(newn)*size);
}
/*
** generic allocation routine.
*/
void *luaM_realloc (lua_State *L, void *block, unsigned long size) {
if (size == 0) {
free(block); /* block may be NULL; that is OK for free */
return NULL;
}
else if ((size_t)size != size)
lua_error(L, "memory allocation error: block too big");
block = realloc(block, size);
if (block == NULL)
lua_error(L, memEM);
return block;
}

44
lmem.h
View File

@@ -1,44 +0,0 @@
/*
** $Id: lmem.h,v 1.12 2000/01/13 16:30:47 roberto Exp roberto $
** Interface to Memory Manager
** See Copyright Notice in lua.h
*/
#ifndef lmem_h
#define lmem_h
#include <stdlib.h>
#include "lua.h"
/* memory error messages */
#define codeEM "code size overflow"
#define constantEM "constant table overflow"
#define refEM "reference table overflow"
#define tableEM "table overflow"
#define memEM "not enough memory"
#define arrEM "internal array larger than `int' limit"
void *luaM_realloc (lua_State *L, void *oldblock, unsigned long size);
void *luaM_growaux (lua_State *L, void *block, unsigned long nelems, int inc, int size,
const char *errormsg, unsigned long limit);
#define luaM_free(L, b) luaM_realloc(L, (b), 0)
#define luaM_malloc(L, t) luaM_realloc(L, NULL, (t))
#define luaM_new(L, t) ((t *)luaM_malloc(L, sizeof(t)))
#define luaM_newvector(L, n,t) ((t *)luaM_malloc(L, (n)*sizeof(t)))
#define luaM_growvector(L, v,nelems,inc,t,e,l) \
((v)=(t *)luaM_growaux(L, v,nelems,inc,sizeof(t),e,l))
#define luaM_reallocvector(L, v,n,t) ((v)=(t *)luaM_realloc(L, v,(n)*sizeof(t)))
#ifdef DEBUG
extern unsigned long memdebug_numblocks;
extern unsigned long memdebug_total;
extern unsigned long memdebug_maxmem;
#endif
#endif

110
lobject.c
View File

@@ -1,110 +0,0 @@
/*
** $Id: lobject.c,v 1.35 2000/03/29 20:19:20 roberto Exp roberto $
** Some generic functions over Lua objects
** See Copyright Notice in lua.h
*/
#include <ctype.h>
#include <stdlib.h>
#define LUA_REENTRANT
#include "lobject.h"
#include "lua.h"
const char *const luaO_typenames[] = { /* ORDER LUA_T */
"userdata", "number", "string", "table", "function", "function", "nil",
"function", "function", "line"
};
const TObject luaO_nilobject = {TAG_NIL, {NULL}};
/*
** returns smaller power of 2 larger than `n' (minimum is MINPOWER2)
*/
unsigned long luaO_power2 (unsigned long n) {
unsigned long p = MINPOWER2;
while (p<=n) p<<=1;
return p;
}
int luaO_equalval (const TObject *t1, const TObject *t2) {
switch (ttype(t1)) {
case TAG_NUMBER:
return nvalue(t1) == nvalue(t2);
case TAG_STRING: case TAG_USERDATA:
return svalue(t1) == svalue(t2);
case TAG_TABLE:
return avalue(t1) == avalue(t2);
case TAG_CCLOSURE: case TAG_LCLOSURE:
return clvalue(t1) == clvalue(t2);
default:
LUA_ASSERT(L, ttype(t1) == TAG_NIL, "invalid type");
return 1; /* TAG_NIL */
}
}
static double expten (unsigned int e) {
double exp = 10.0;
double res = 1.0;
for (; e; e>>=1) {
if (e & 1) res *= exp;
exp *= exp;
}
return res;
}
int luaO_str2d (const char *s, Number *result) { /* LUA_NUMBER */
double a = 0.0;
int point = 0; /* number of decimal digits */
int sig;
while (isspace((unsigned char)*s)) s++;
sig = 0;
switch (*s) {
case '-': sig = 1; /* go through */
case '+': s++;
}
if (! (isdigit((unsigned char)*s) ||
(*s == '.' && isdigit((unsigned char)*(s+1)))))
return 0; /* not (at least one digit before or after the point) */
while (isdigit((unsigned char)*s))
a = 10.0*a + (*(s++)-'0');
if (*s == '.') {
s++;
while (isdigit((unsigned char)*s)) {
a = 10.0*a + (*(s++)-'0');
point++;
}
}
if (sig) a = -a;
if (*s == 'e' || *s == 'E') {
int e = 0;
s++;
sig = 0;
switch (*s) {
case '-': sig = 1; /* go through */
case '+': s++;
}
if (!isdigit((unsigned char)*s)) return 0; /* no digit in the exponent? */
do {
e = 10*e + (*(s++)-'0');
} while (isdigit((unsigned char)*s));
if (sig) e = -e;
point -= e;
}
while (isspace((unsigned char)*s)) s++;
if (*s != '\0') return 0; /* invalid trailing characters? */
if (point != 0) {
if (point > 0) a /= expten(point);
else a *= expten(-point);
}
*result = a;
return 1;
}

189
lobject.h
View File

@@ -1,189 +0,0 @@
/*
** $Id: lobject.h,v 1.59 2000/03/31 16:28:45 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"
#ifdef DEBUG
#undef NDEBUG
#include <assert.h>
#define LUA_INTERNALERROR(L,s) assert(((void)s,0))
#define LUA_ASSERT(L,c,s) assert(((void)s,(c)))
#else
#define LUA_INTERNALERROR(L,s) /* empty */
#define LUA_ASSERT(L,c,s) /* empty */
#endif
#ifdef DEBUG
/* to avoid warnings, and make sure value is really unused */
#define UNUSED(x) (x=0, (void)(x))
#else
#define UNUSED(x) ((void)(x)) /* to avoid warnings */
#endif
/*
** Lua TYPES
** WARNING: if you change the order of this enumeration,
** grep "ORDER LUA_T"
*/
typedef enum {
TAG_USERDATA = 0, /* default tag for userdata */
TAG_NUMBER, /* fixed tag for numbers */
TAG_STRING, /* fixed tag for strings */
TAG_TABLE, /* default tag for tables */
TAG_LCLOSURE, /* fixed tag for Lua closures */
TAG_CCLOSURE, /* fixed tag for C closures */
TAG_NIL, /* last "pre-defined" tag */
TAG_LMARK, /* mark for Lua closures */
TAG_CMARK, /* mark for C closures */
TAG_LINE
} lua_Type;
/* tags for values visible from Lua == first user-created tag */
#define NUM_TAGS 7
/*
** check whether `t' is a mark
*/
#define is_T_MARK(t) ((t) == TAG_LMARK || (t) == TAG_CMARK)
typedef union {
struct TString *ts; /* TAG_STRING, TAG_USERDATA */
struct Closure *cl; /* TAG_[CL]CLOSURE, TAG_[CL]MARK */
struct Hash *a; /* TAG_TABLE */
Number n; /* TAG_NUMBER */
int i; /* TAG_LINE */
} Value;
/* Macros to access values */
#define ttype(o) ((o)->ttype)
#define nvalue(o) ((o)->value.n)
#define svalue(o) ((o)->value.ts->str)
#define tsvalue(o) ((o)->value.ts)
#define clvalue(o) ((o)->value.cl)
#define avalue(o) ((o)->value.a)
typedef struct TObject {
lua_Type ttype;
Value value;
} TObject;
typedef struct GlobalVar {
TObject value;
struct GlobalVar *next;
struct TString *name;
} GlobalVar;
/*
** String headers for string table
*/
typedef struct TString {
union {
struct { /* for strings */
GlobalVar *gv; /* eventual global value with this name */
long len;
} s;
struct { /* for userdata */
int tag;
void *value;
} d;
} u;
struct TString *nexthash; /* chain for hash table */
unsigned long hash;
int constindex; /* hint to reuse constants (= -1 if this is a userdata) */
unsigned char marked;
char str[1]; /* variable length string!! must be the last field! */
} TString;
/*
** Function Prototypes
*/
typedef struct Proto {
struct Proto *next;
int marked;
struct TString **kstr; /* strings used by the function */
int nkstr; /* size of `kstr' */
Number *knum; /* Number numbers used by the function */
int nknum; /* size of `knum' */
struct Proto **kproto; /* functions defined inside the function */
int nkproto; /* size of `kproto' */
Instruction *code; /* ends with opcode ENDCODE */
int lineDefined;
TString *source;
int numparams;
int is_vararg;
int maxstacksize;
struct LocVar *locvars; /* ends with line = -1 */
} Proto;
typedef struct LocVar {
TString *varname; /* NULL signals end of scope */
int line;
} LocVar;
/*
** Closures
*/
typedef struct Closure {
struct Closure *next;
int marked;
union {
lua_CFunction c; /* C functions */
struct Proto *l; /* Lua functions */
} f;
int nelems;
TObject consts[1];
} Closure;
typedef struct Node {
TObject key;
TObject val;
struct Node *next; /* for chaining */
} Node;
typedef struct Hash {
int htag;
Node *node;
int size;
Node *firstfree; /* this position is free; all positions after it are full */
struct Hash *next;
int marked;
} Hash;
extern const char *const luaO_typenames[];
extern const TObject luaO_nilobject;
#define luaO_typename(o) luaO_typenames[ttype(o)]
unsigned long luaO_power2 (unsigned long n);
#define luaO_equalObj(t1,t2) (ttype(t1) == ttype(t2) && luaO_equalval(t1,t2))
int luaO_equalval (const TObject *t1, const TObject *t2);
int luaO_redimension (lua_State *L, int oldsize);
int luaO_str2d (const char *s, Number *result);
#endif

View File

@@ -1,157 +0,0 @@
/*
** $Id: lopcodes.h,v 1.58 2000/04/13 16:51:01 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. Moreover,
an instruction can have 0, 1, or 2 arguments. Instructions can
have the following types:
type 0: no arguments
type 1: 1 unsigned argument in the higher bits (called `U')
type 2: 1 signed argument in the higher bits (`S')
type 3: 1st unsigned argument in the higher bits (`A')
2nd unsigned argument in the middle bits (`B')
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.
The size of each argument is defined in `llimits.h'. The usual is an
instruction with 32 bits, U arguments with 26 bits (32-6), B arguments
with 9 bits, and A arguments with 17 bits (32-6-9). For small
instalations, the instruction size can be 16, so U has 10 bits,
and A and B have 5 bits each.
===========================================================================*/
/* 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 CREATE_0(o) ((Instruction)(o))
#define GET_OPCODE(i) ((OpCode)((i)&MASK1(SIZE_OP,0)))
#define SET_OPCODE(i,o) ((i) = (((i)&MASK0(SIZE_OP,0)) | (Instruction)(o)))
#define CREATE_U(o,u) ((Instruction)(o) | (Instruction)(u)<<POS_U)
#define GETARG_U(i) ((int)((i)>>POS_U))
#define SETARG_U(i,u) ((i) = (((i)&MASK0(SIZE_U,POS_U)) | \
((Instruction)(u)<<POS_U)))
#define CREATE_S(o,s) CREATE_U((o),(s)+MAXARG_S)
#define GETARG_S(i) (GETARG_U(i)-MAXARG_S)
#define SETARG_S(i,s) SETARG_U((i),(s)+MAXARG_S)
#define CREATE_AB(o,a,b) ((Instruction)(o) | ((Instruction)(a)<<POS_A) \
| ((Instruction)(b)<<POS_B))
#define GETARG_A(i) ((int)((i)>>POS_A))
#define SETARG_A(i,a) ((i) = (((i)&MASK0(SIZE_A,POS_A)) | \
((Instruction)(a)<<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)))
/*
** K = U argument used as index to `kstr'
** J = S argument used as jump offset (relative to pc of next instruction)
** L = unsigned argument used as index of local variable
** N = U argument used as index to `knum'
*/
typedef enum {
/*----------------------------------------------------------------------
name args stack before stack after side effects
------------------------------------------------------------------------*/
OP_END,/* - - (return) no results */
OP_RETURN,/* U v_n-v_x(at u) (return) returns v_x-v_n */
OP_CALL,/* A B v_n-v_1 f(at a) r_b-r_1 f(v1,...,v_n) */
OP_TAILCALL,/* A B v_n-v_1 f(at a) (return) f(v1,...,v_n) */
OP_PUSHNIL,/* U - nil_1-nil_u */
OP_POP,/* U a_u-a_1 - */
OP_PUSHINT,/* S - (Number)s */
OP_PUSHSTRING,/* K - KSTR[k] */
OP_PUSHNUM,/* N - KNUM[n] */
OP_PUSHNEGNUM,/* N - -KNUM[n] */
OP_PUSHUPVALUE,/* U - Closure[u] */
OP_GETLOCAL,/* L - LOC[l] */
OP_GETGLOBAL,/* K - VAR[KSTR[k]] */
OP_GETTABLE,/* - i t t[i] */
OP_GETDOTTED,/* K t t[KSTR[k]] */
OP_GETINDEXED,/* L t t[LOC[l]] */
OP_PUSHSELF,/* K t t t[KSTR[k]] */
OP_CREATETABLE,/* U - newarray(size = u) */
OP_SETLOCAL,/* L x - LOC[l]=x */
OP_SETGLOBAL,/* K x - VAR[KSTR[k]]=x */
OP_SETTABLE,/* A B v a_a-a_1 i t (pops b values) t[i]=v */
OP_SETLIST,/* A B v_b-v_0 t t t[i+a*FPF]=v_i */
OP_SETMAP,/* U v_u k_u - v_0 k_0 t t t[k_i]=v_i */
OP_ADD,/* - y x x+y */
OP_ADDI,/* S x x+s */
OP_SUB,/* - y x x-y */
OP_MULT,/* - y x x*y */
OP_DIV,/* - y x x/y */
OP_POW,/* - y x x^y */
OP_CONCAT,/* U v_u-v_1 v1..-..v_u */
OP_MINUS,/* - x -x */
OP_NOT,/* - x (x==nil)? 1 : nil */
OP_JMPNE,/* J y x - (x~=y)? PC+=s */
OP_JMPEQ,/* J y x - (x==y)? PC+=s */
OP_JMPLT,/* J y x - (x<y)? PC+=s */
OP_JMPLE,/* J y x - (x<y)? PC+=s */
OP_JMPGT,/* J y x - (x>y)? PC+=s */
OP_JMPGE,/* J y x - (x>=y)? PC+=s */
OP_JMPT,/* J x - (x~=nil)? PC+=s */
OP_JMPF,/* J x - (x==nil)? PC+=s */
OP_JMPONT,/* J x (x~=nil)? x : - (x~=nil)? PC+=s */
OP_JMPONF,/* J x (x==nil)? x : - (x==nil)? PC+=s */
OP_JMP,/* J - - PC+=s */
OP_PUSHNILJMP,/* - - nil PC++; */
OP_FORPREP,/* J */
OP_FORLOOP,/* J */
OP_CLOSURE,/* A B v_b-v_1 closure(KPROTO[a], v_1-v_b) */
OP_SETLINE/* U - - LINE=u */
} OpCode;
#define ISJUMP(o) (OP_JMPNE <= (o) && (o) <= OP_JMP)
#endif

1217
lparser.c

File diff suppressed because it is too large Load Diff

View File

@@ -1,61 +0,0 @@
/*
** $Id: lparser.h,v 1.15 2000/04/05 17:51:58 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 {
VGLOBAL,
VLOCAL,
VINDEXED,
VEXP
} expkind;
typedef struct expdesc {
expkind k;
union {
int index; /* VGLOBAL: `kstr' index of global name; VLOCAL: stack index */
struct {
int t; /* patch list of `exit when true' */
int f; /* patch list of `exit when false' */
} l;
} u;
} 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 */
int lasttarget; /* `pc' of last `jump target' */
int jlt; /* list of jumps to `lasttarged' */
int stacklevel; /* number of values on activation register */
int nlocalvar; /* number of active local variables */
int nupvalues; /* number of upvalues */
int nvars; /* number of entries in f->locvars (-1 if no debug information) */
int lastsetline; /* line where last SETLINE was issued */
struct Breaklabel *bl; /* chain of breakable blocks */
expdesc upvalues[MAXUPVALUES]; /* upvalues */
TString *localvar[MAXLOCALS]; /* store local variable names */
} FuncState;
Proto *luaY_parser (lua_State *L, ZIO *z);
#endif

115
lref.c
View File

@@ -1,115 +0,0 @@
/*
** $Id: lref.c,v 1.10 2000/03/27 20:10:21 roberto Exp roberto $
** reference mechanism
** See Copyright Notice in lua.h
*/
#define LUA_REENTRANT
#include "lapi.h"
#include "lmem.h"
#include "lref.h"
#include "lstate.h"
#include "lua.h"
int lua_ref (lua_State *L, int lock) {
int ref;
luaA_checkCargs(L, 1);
if (ttype(L->top-1) == TAG_NIL)
ref = LUA_REFNIL;
else {
if (L->refFree != NONEXT) { /* is there a free place? */
ref = L->refFree;
L->refFree = L->refArray[ref].st;
}
else { /* no more free places */
luaM_growvector(L, L->refArray, L->refSize, 1, struct Ref, refEM, MAX_INT);
ref = L->refSize++;
}
L->refArray[ref].o = *(L->top-1);
L->refArray[ref].st = lock ? LOCK : HOLD;
}
L->top--;
return ref;
}
void lua_unref (lua_State *L, int ref) {
if (ref >= 0) {
if (ref >= L->refSize || L->refArray[ref].st >= 0)
lua_error(L, "Lua API error - "
"invalid argument for function `lua_unref'");
L->refArray[ref].st = L->refFree;
L->refFree = ref;
}
}
lua_Object lua_getref (lua_State *L, int ref) {
if (ref == LUA_REFNIL)
return luaA_putluaObject(L, &luaO_nilobject);
else if (0 <= ref && ref < L->refSize &&
(L->refArray[ref].st == LOCK || L->refArray[ref].st == HOLD))
return luaA_putluaObject(L, &L->refArray[ref].o);
else
return LUA_NOOBJECT;
}
void lua_beginblock (lua_State *L) {
luaM_growvector(L, L->Cblocks, L->numCblocks, 1, struct C_Lua_Stack,
"too many nested blocks", L->stacksize);
L->Cblocks[L->numCblocks] = L->Cstack;
L->numCblocks++;
}
void lua_endblock (lua_State *L) {
if (L->numCblocks <= 0)
lua_error(L, "Lua API error - no block to end");
--L->numCblocks;
L->Cstack = L->Cblocks[L->numCblocks];
L->top = L->Cstack.base;
}
static int ismarked (const TObject *o) {
/* valid only for locked objects */
switch (o->ttype) {
case TAG_STRING: case TAG_USERDATA:
return o->value.ts->marked;
case TAG_TABLE:
return o->value.a->marked;
case TAG_LCLOSURE: case TAG_CCLOSURE:
return o->value.cl->marked;
default: /* number */
return 1;
}
}
/* for internal debugging only; check if a link of free refs is valid */
#define VALIDLINK(L, st,n) (NONEXT <= (st) && (st) < (n))
void luaR_invalidaterefs (lua_State *L) {
int n = L->refSize;
int i;
for (i=0; i<n; i++) {
struct Ref *r = &L->refArray[i];
if (r->st == HOLD && !ismarked(&r->o))
r->st = COLLECTED;
LUA_ASSERT(L, (r->st == LOCK && ismarked(&r->o)) ||
r->st == COLLECTED ||
r->st == NONEXT ||
(r->st < n && VALIDLINK(L, L->refArray[r->st].st, n)),
"inconsistent ref table");
}
LUA_ASSERT(L, VALIDLINK(L, L->refFree, n), "inconsistent ref table");
}

27
lref.h
View File

@@ -1,27 +0,0 @@
/*
** $Id: lref.h,v 1.5 1999/12/27 17:33:22 roberto Exp roberto $
** reference mechanism
** See Copyright Notice in lua.h
*/
#ifndef lref_h
#define lref_h
#include "lobject.h"
#define NONEXT -1 /* to end the free list */
#define HOLD -2
#define COLLECTED -3
#define LOCK -4
struct Ref {
TObject o;
int st; /* can be LOCK, HOLD, COLLECTED, or next (for free list) */
};
void luaR_invalidaterefs (lua_State *L);
#endif

108
lstate.c
View File

@@ -1,108 +0,0 @@
/*
** $Id: lstate.c,v 1.24 2000/01/13 16:30:47 roberto Exp roberto $
** Global State
** See Copyright Notice in lua.h
*/
#include <stdarg.h>
#define LUA_REENTRANT
#include "lauxlib.h"
#include "lbuiltin.h"
#include "ldo.h"
#include "lgc.h"
#include "llex.h"
#include "lmem.h"
#include "lref.h"
#include "lstate.h"
#include "lstring.h"
#include "ltm.h"
lua_State *lua_state = NULL;
static lua_State *newstate_aux (int stacksize, int put_builtin) {
lua_State *L = luaM_new(NULL, lua_State);
L->errorJmp = NULL;
L->Mbuffer = NULL;
L->Mbuffbase = 0;
L->Mbuffsize = 0;
L->Mbuffnext = 0;
L->Cblocks = NULL;
L->numCblocks = 0;
L->rootproto = NULL;
L->rootcl = NULL;
L->rootglobal = NULL;
L->roottable = NULL;
L->IMtable = NULL;
L->refArray = NULL;
L->refSize = 0;
L->refFree = NONEXT;
L->nblocks = 0;
L->GCthreshold = MAX_INT; /* to avoid GC during pre-definitions */
L->debug = 0;
L->callhook = NULL;
L->linehook = NULL;
L->allowhooks = 1;
luaD_init(L, stacksize);
luaS_init(L);
luaX_init(L);
luaT_init(L);
if (put_builtin)
luaB_predefine(L);
L->GCthreshold = L->nblocks*4;
return L;
}
lua_State *lua_newstate (const char *s, ...) {
static const char *const ops[] = {"stack", "builtin", NULL};
va_list ap;
int stacksize = DEFAULT_STACK_SIZE;
int put_builtin = 1;
va_start(ap, s);
while (s) {
switch (luaL_findstring(s, ops)) {
case 0: /* stack */
stacksize = va_arg(ap, int);
break;
case 1: /* builtin */
put_builtin = va_arg(ap, int);
break;
default: /* invalid argument */
va_end(ap);
return NULL;
}
s = va_arg(ap, const char *);
}
va_end(ap);
return newstate_aux(stacksize, put_builtin);
}
void lua_close (lua_State *L) {
luaC_collect(L, 1); /* collect all elements */
LUA_ASSERT(L, L->rootproto == NULL, "list should be empty");
LUA_ASSERT(L, L->rootcl == NULL, "list should be empty");
LUA_ASSERT(L, L->rootglobal == NULL, "list should be empty");
LUA_ASSERT(L, L->roottable == NULL, "list should be empty");
luaS_freeall(L);
luaM_free(L, L->stack);
luaM_free(L, L->IMtable);
luaM_free(L, L->refArray);
luaM_free(L, L->Mbuffer);
luaM_free(L, L->Cblocks);
LUA_ASSERT(L, L->numCblocks == 0, "Cblocks still open");
LUA_ASSERT(L, L->nblocks == 0, "wrong count for nblocks");
LUA_ASSERT(L, L->Cstack.base == L->top, "C2Lua not empty");
luaM_free(L, L);
if (L == lua_state) {
LUA_ASSERT(L, memdebug_numblocks == 0, "memory leak!");
LUA_ASSERT(L, memdebug_total == 0,"memory leak!");
lua_state = NULL;
}
}

View File

@@ -1,89 +0,0 @@
/*
** $Id: lstate.h,v 1.30 2000/03/10 18:37:44 roberto Exp roberto $
** Global State
** See Copyright Notice in lua.h
*/
#ifndef lstate_h
#define lstate_h
#include <setjmp.h>
#include "lobject.h"
#include "lua.h"
#include "luadebug.h"
typedef TObject *StkId; /* index to stack elements */
/*
** `jmp_buf' may be an array, so it is better to make sure it has an
** address (and not that it *is* an address...)
*/
struct lua_longjmp {
jmp_buf b;
};
/*
** stack layout for C point of view:
** [lua2C, lua2C+num) - `array' lua2C
** [lua2C+num, base) - space for extra lua_Objects (limbo)
** [base, L->top) - `stack' C2Lua
*/
struct C_Lua_Stack {
StkId base;
StkId lua2C;
int num;
};
typedef struct stringtable {
int size;
int nuse; /* number of elements (including EMPTYs) */
TString **hash;
} stringtable;
struct lua_State {
/* thread-specific state */
StkId top; /* first free slot in the stack */
StkId stack; /* stack base */
StkId stack_last; /* last free slot in the stack */
int stacksize;
struct C_Lua_Stack Cstack; /* C2lua struct */
struct lua_longjmp *errorJmp; /* current error recover point */
char *Mbuffer; /* global buffer */
int Mbuffbase; /* current first position of Mbuffer */
int Mbuffsize; /* size of Mbuffer */
int Mbuffnext; /* next position to fill in Mbuffer */
struct C_Lua_Stack *Cblocks;
int numCblocks; /* number of nested Cblocks */
/* global state */
Proto *rootproto; /* list of all prototypes */
Closure *rootcl; /* list of all closures */
Hash *roottable; /* list of all tables */
GlobalVar *rootglobal; /* list of global variables */
stringtable *string_root; /* array of hash tables for strings and udata */
struct IM *IMtable; /* table for tag methods */
int last_tag; /* last used tag in IMtable */
struct Ref *refArray; /* locked objects */
int refSize; /* size of refArray */
int refFree; /* list of free positions in refArray */
unsigned long GCthreshold;
unsigned long nblocks; /* number of `blocks' currently allocated */
int debug;
lua_Hook callhook;
lua_Hook linehook;
int allowhooks;
};
#endif

205
lstring.c
View File

@@ -1,205 +0,0 @@
/*
** $Id: lstring.c,v 1.33 2000/03/10 14:38:10 roberto Exp roberto $
** String table (keeps all strings handled by Lua)
** See Copyright Notice in lua.h
*/
#include <string.h>
#define LUA_REENTRANT
#include "lmem.h"
#include "lobject.h"
#include "lstate.h"
#include "lstring.h"
#include "lua.h"
#define gcsizestring(L, l) numblocks(L, 0, sizeof(TString)+l)
#define gcsizeudata gcsizestring(L, 0)
void luaS_init (lua_State *L) {
int i;
L->string_root = luaM_newvector(L, NUM_HASHS, stringtable);
for (i=0; i<NUM_HASHS; i++) {
L->string_root[i].size = 1;
L->string_root[i].nuse = 0;
L->string_root[i].hash = luaM_newvector(L, 1, TString *);;
L->string_root[i].hash[0] = NULL;
}
}
void luaS_freeall (lua_State *L) {
int i;
for (i=0; i<NUM_HASHS; i++) {
LUA_ASSERT(L, L->string_root[i].nuse==0, "non-empty string table");
luaM_free(L, L->string_root[i].hash);
}
luaM_free(L, L->string_root);
}
static unsigned long hash_s (const char *s, long l) {
unsigned long h = l; /* seed */
long step = (l>>6)+1; /* if string is too long, don't hash all its chars */
for (; l>0; l-=step)
h = h ^ ((h<<5)+(h>>2)+(unsigned char)*(s++));
return h;
}
void luaS_resize (lua_State *L, stringtable *tb, int newsize) {
TString **newhash = luaM_newvector(L, newsize, TString *);
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->nexthash; /* save next */
int h = p->hash&(newsize-1); /* new position */
LUA_ASSERT(L, p->hash%newsize == (p->hash&(newsize-1)),
"a&(x-1) == a%x, for x power of 2");
p->nexthash = newhash[h]; /* chain it in new position */
newhash[h] = p;
p = next;
}
}
luaM_free(L, tb->hash);
tb->size = newsize;
tb->hash = newhash;
}
static TString *newone (lua_State *L, long l, unsigned long h) {
TString *ts = (TString *)luaM_malloc(L,
sizeof(TString)+l*sizeof(char));
ts->marked = 0;
ts->nexthash = NULL;
ts->hash = h;
return ts;
}
static TString *newone_s (lua_State *L, const char *str,
long l, unsigned long h) {
TString *ts = newone(L, l, h);
memcpy(ts->str, str, l);
ts->str[l] = 0; /* ending 0 */
ts->u.s.gv = NULL; /* no global value */
ts->u.s.len = l;
ts->constindex = 0;
L->nblocks += gcsizestring(L, l);
return ts;
}
static TString *newone_u (lua_State *L, void *buff,
int tag, unsigned long h) {
TString *ts = newone(L, 0, h);
ts->u.d.value = buff;
ts->u.d.tag = (tag == LUA_ANYTAG) ? 0 : tag;
ts->constindex = -1; /* tag -> this is a userdata */
L->nblocks += gcsizeudata;
return ts;
}
static void newentry (lua_State *L, stringtable *tb, TString *ts, int h) {
ts->nexthash = tb->hash[h]; /* chain new entry */
tb->hash[h] = ts;
tb->nuse++;
if (tb->nuse > tb->size) /* too crowded? */
luaS_resize(L, tb, tb->size*2);
}
TString *luaS_newlstr (lua_State *L, const char *str, long l) {
unsigned long h = hash_s(str, l);
stringtable *tb = &L->string_root[(l==0) ? 0 :
((unsigned int)(str[0]+str[l-1]))&(NUM_HASHSTR-1)];
int h1 = h&(tb->size-1);
TString *ts;
for (ts = tb->hash[h1]; ts; ts = ts->nexthash) {
if (ts->u.s.len == l && (memcmp(str, ts->str, l) == 0))
return ts;
}
/* not found */
ts = newone_s(L, str, l, h); /* create new entry */
newentry(L, tb, ts, h1); /* insert it on table */
return ts;
}
/*
** uses '%' for one hashing with userdata because addresses are too regular,
** so two '&' operations would be highly correlated
*/
TString *luaS_createudata (lua_State *L, void *udata, int tag) {
unsigned long h = IntPoint(L, udata);
stringtable *tb = &L->string_root[(h%NUM_HASHUDATA)+NUM_HASHSTR];
int h1 = h&(tb->size-1);
TString *ts;
for (ts = tb->hash[h1]; ts; ts = ts->nexthash) {
if (udata == ts->u.d.value && (tag == ts->u.d.tag || tag == LUA_ANYTAG))
return ts;
}
/* not found */
ts = newone_u(L, udata, tag, h);
newentry(L, tb, ts, h1);
return ts;
}
TString *luaS_new (lua_State *L, const char *str) {
return luaS_newlstr(L, str, strlen(str));
}
TString *luaS_newfixed (lua_State *L, const char *str) {
TString *ts = luaS_new(L, str);
if (ts->marked == 0) ts->marked = FIXMARK; /* avoid GC */
return ts;
}
void luaS_free (lua_State *L, TString *t) {
if (t->constindex == -1) /* is userdata? */
L->nblocks -= gcsizeudata;
else { /* is string */
L->nblocks -= gcsizestring(L, t->u.s.len);
luaM_free(L, t->u.s.gv);
}
luaM_free(L, t);
}
GlobalVar *luaS_assertglobal (lua_State *L, TString *ts) {
GlobalVar *gv = ts->u.s.gv;
if (!gv) { /* no global value yet? */
gv = luaM_new(L, GlobalVar);
gv->value.ttype = TAG_NIL; /* initial value */
gv->name = ts;
gv->next = L->rootglobal; /* chain in global list */
L->rootglobal = gv;
ts->u.s.gv = gv;
}
return gv;
}
GlobalVar *luaS_assertglobalbyname (lua_State *L, const char *name) {
return luaS_assertglobal(L, luaS_new(L, name));
}
int luaS_globaldefined (lua_State *L, const char *name) {
TString *ts = luaS_new(L, name);
return ts->u.s.gv && ts->u.s.gv->value.ttype != TAG_NIL;
}

View File

@@ -1,41 +0,0 @@
/*
** $Id: lstring.h,v 1.17 2000/03/10 14:38:10 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"
#define NUM_HASHSTR 32
#define NUM_HASHUDATA 31
#define NUM_HASHS (NUM_HASHSTR+NUM_HASHUDATA)
/*
** any taggedstring with mark>=FIXMARK is never collected.
** Marks>=RESERVEDMARK are used to identify reserved words.
*/
#define FIXMARK 2
#define RESERVEDMARK 3
void luaS_init (lua_State *L);
void luaS_resize (lua_State *L, stringtable *tb, int newsize);
TString *luaS_createudata (lua_State *L, void *udata, int tag);
void luaS_freeall (lua_State *L);
void luaS_free (lua_State *L, TString *ts);
TString *luaS_newlstr (lua_State *L, const char *str, long l);
TString *luaS_new (lua_State *L, const char *str);
TString *luaS_newfixed (lua_State *L, const char *str);
GlobalVar *luaS_assertglobal (lua_State *L, TString *ts);
GlobalVar *luaS_assertglobalbyname (lua_State *L, const char *name);
int luaS_globaldefined (lua_State *L, const char *name);
#endif

619
lstrlib.c
View File

@@ -1,619 +0,0 @@
/*
** $Id: lstrlib.c,v 1.40 2000/02/08 16:34:31 roberto Exp roberto $
** Standard library for string operations and pattern-matching
** See Copyright Notice in lua.h
*/
#include <ctype.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#define LUA_REENTRANT
#include "lauxlib.h"
#include "lua.h"
#include "lualib.h"
static void addnchar (lua_State *L, const char *s, int n) {
char *b = luaL_openspace(L, n);
memcpy(b, s, n);
luaL_addsize(L, n);
}
static void str_len (lua_State *L) {
long l;
luaL_check_lstr(L, 1, &l);
lua_pushnumber(L, l);
}
static void closeandpush (lua_State *L) {
lua_pushlstring(L, luaL_buffer(L), luaL_getsize(L));
}
static long posrelat (long pos, long len) {
/* relative string position: negative means back from end */
return (pos>=0) ? pos : len+pos+1;
}
static void str_sub (lua_State *L) {
long l;
const char *s = luaL_check_lstr(L, 1, &l);
long start = posrelat(luaL_check_long(L, 2), l);
long end = posrelat(luaL_opt_long(L, 3, -1), l);
if (start < 1) start = 1;
if (end > l) end = l;
if (start <= end)
lua_pushlstring(L, s+start-1, end-start+1);
else lua_pushstring(L, "");
}
static void str_lower (lua_State *L) {
long l;
int i;
const char *s = luaL_check_lstr(L, 1, &l);
luaL_resetbuffer(L);
for (i=0; i<l; i++)
luaL_addchar(L, tolower((unsigned char)(s[i])));
closeandpush(L);
}
static void str_upper (lua_State *L) {
long l;
int i;
const char *s = luaL_check_lstr(L, 1, &l);
luaL_resetbuffer(L);
for (i=0; i<l; i++)
luaL_addchar(L, toupper((unsigned char)(s[i])));
closeandpush(L);
}
static void str_rep (lua_State *L) {
long l;
const char *s = luaL_check_lstr(L, 1, &l);
int n = luaL_check_int(L, 2);
luaL_resetbuffer(L);
while (n-- > 0)
addnchar(L, s, l);
closeandpush(L);
}
static void str_byte (lua_State *L) {
long l;
const char *s = luaL_check_lstr(L, 1, &l);
long pos = posrelat(luaL_opt_long(L, 2, 1), l);
luaL_arg_check(L, 0<pos && pos<=l, 2, "out of range");
lua_pushnumber(L, (unsigned char)s[pos-1]);
}
static void str_char (lua_State *L) {
int i = 0;
luaL_resetbuffer(L);
while (lua_getparam(L, ++i) != LUA_NOOBJECT) {
int c = luaL_check_int(L, i);
luaL_arg_check(L, (unsigned char)c == c, i, "invalid value");
luaL_addchar(L, (unsigned char)c);
}
closeandpush(L);
}
/*
** {======================================================
** PATTERN MATCHING
** =======================================================
*/
#ifndef MAX_CAPTURES
#define MAX_CAPTURES 32 /* arbitrary limit */
#endif
struct Capture {
const char *src_end; /* end ('\0') of source string */
int level; /* total number of captures (finished or unfinished) */
struct {
const char *init;
int len; /* -1 signals unfinished capture */
} capture[MAX_CAPTURES];
};
#define ESC '%'
#define SPECIALS "^$*+?.([%-"
static void push_captures (lua_State *L, struct Capture *cap) {
int i;
for (i=0; i<cap->level; i++) {
int l = cap->capture[i].len;
if (l == -1) lua_error(L, "unfinished capture");
lua_pushlstring(L, cap->capture[i].init, l);
}
}
static int check_capture (lua_State *L, int l, struct Capture *cap) {
l -= '1';
if (!(0 <= l && l < cap->level && cap->capture[l].len != -1))
lua_error(L, "invalid capture index");
return l;
}
static int capture_to_close (lua_State *L, struct Capture *cap) {
int level = cap->level;
for (level--; level>=0; level--)
if (cap->capture[level].len == -1) return level;
lua_error(L, "invalid pattern capture");
return 0; /* to avoid warnings */
}
const char *luaI_classend (lua_State *L, const char *p) {
switch (*p++) {
case ESC:
if (*p == '\0') lua_error(L, "malformed pattern (ends with `%')");
return p+1;
case '[':
if (*p == '^') p++;
do { /* look for a ']' */
if (*p == '\0') lua_error(L, "malformed pattern (missing `]')");
if (*(p++) == ESC && *p != '\0') p++; /* skip escapes (e.g. '%]') */
} while (*p != ']');
return p+1;
default:
return p;
}
}
static int match_class (int c, int cl) {
int res;
switch (tolower(cl)) {
case 'a' : res = isalpha(c); break;
case 'c' : res = iscntrl(c); break;
case 'd' : res = isdigit(c); break;
case 'l' : res = islower(c); break;
case 'p' : res = ispunct(c); break;
case 's' : res = isspace(c); break;
case 'u' : res = isupper(c); break;
case 'w' : res = isalnum(c); break;
case 'x' : res = isxdigit(c); break;
case 'z' : res = (c == '\0'); break;
default: return (cl == c);
}
return (islower(cl) ? res : !res);
}
static int matchbracketclass (int c, const char *p, const char *endclass) {
int sig = 1;
if (*(p+1) == '^') {
sig = 0;
p++; /* skip the '^' */
}
while (++p < endclass) {
if (*p == ESC) {
p++;
if (match_class(c, (unsigned char)*p))
return sig;
}
else if ((*(p+1) == '-') && (p+2 < endclass)) {
p+=2;
if ((int)(unsigned char)*(p-2) <= c && c <= (int)(unsigned char)*p)
return sig;
}
else if ((int)(unsigned char)*p == c) return sig;
}
return !sig;
}
int luaI_singlematch (int c, const char *p, const char *ep) {
switch (*p) {
case '.': /* matches any char */
return 1;
case ESC:
return match_class(c, (unsigned char)*(p+1));
case '[':
return matchbracketclass(c, p, ep-1);
default:
return ((unsigned char)*p == c);
}
}
static const char *match (lua_State *L, const char *s, const char *p, struct Capture *cap);
static const char *matchbalance (lua_State *L, const char *s, const char *p,
struct Capture *cap) {
if (*p == 0 || *(p+1) == 0)
lua_error(L, "unbalanced pattern");
if (*s != *p) return NULL;
else {
int b = *p;
int e = *(p+1);
int cont = 1;
while (++s < cap->src_end) {
if (*s == e) {
if (--cont == 0) return s+1;
}
else if (*s == b) cont++;
}
}
return NULL; /* string ends out of balance */
}
static const char *max_expand (lua_State *L, const char *s, const char *p, const char *ep,
struct Capture *cap) {
int i = 0; /* counts maximum expand for item */
while ((s+i)<cap->src_end && luaI_singlematch((unsigned char)*(s+i), p, ep))
i++;
/* keeps trying to match mith the maximum repetitions */
while (i>=0) {
const char *res = match(L, (s+i), ep+1, cap);
if (res) return res;
i--; /* else didn't match; reduce 1 repetition to try again */
}
return NULL;
}
static const char *min_expand (lua_State *L, const char *s, const char *p, const char *ep,
struct Capture *cap) {
for (;;) {
const char *res = match(L, s, ep+1, cap);
if (res != NULL)
return res;
else if (s<cap->src_end && luaI_singlematch((unsigned char)*s, p, ep))
s++; /* try with one more repetition */
else return NULL;
}
}
static const char *start_capture (lua_State *L, const char *s, const char *p,
struct Capture *cap) {
const char *res;
int level = cap->level;
if (level >= MAX_CAPTURES) lua_error(L, "too many captures");
cap->capture[level].init = s;
cap->capture[level].len = -1;
cap->level = level+1;
if ((res=match(L, s, p+1, cap)) == NULL) /* match failed? */
cap->level--; /* undo capture */
return res;
}
static const char *end_capture (lua_State *L, const char *s, const char *p,
struct Capture *cap) {
int l = capture_to_close(L, cap);
const char *res;
cap->capture[l].len = s - cap->capture[l].init; /* close capture */
if ((res = match(L, s, p+1, cap)) == NULL) /* match failed? */
cap->capture[l].len = -1; /* undo capture */
return res;
}
static const char *match_capture (lua_State *L, const char *s, int level,
struct Capture *cap) {
int l = check_capture(L, level, cap);
int len = cap->capture[l].len;
if (cap->src_end-s >= len &&
memcmp(cap->capture[l].init, s, len) == 0)
return s+len;
else return NULL;
}
static const char *match (lua_State *L, const char *s, const char *p, struct Capture *cap) {
init: /* using goto's to optimize tail recursion */
switch (*p) {
case '(': /* start capture */
return start_capture(L, s, p, cap);
case ')': /* end capture */
return end_capture(L, s, p, cap);
case ESC: /* may be %[0-9] or %b */
if (isdigit((unsigned char)(*(p+1)))) { /* capture? */
s = match_capture(L, s, *(p+1), cap);
if (s == NULL) return NULL;
p+=2; goto init; /* else return match(L, s, p+2, cap) */
}
else if (*(p+1) == 'b') { /* balanced string? */
s = matchbalance(L, s, p+2, cap);
if (s == NULL) return NULL;
p+=4; goto init; /* else return match(L, s, p+4, cap); */
}
else goto dflt; /* case default */
case '\0': /* end of pattern */
return s; /* match succeeded */
case '$':
if (*(p+1) == '\0') /* is the '$' the last char in pattern? */
return (s == cap->src_end) ? s : NULL; /* check end of string */
else goto dflt;
default: dflt: { /* it is a pattern item */
const char *ep = luaI_classend(L, p); /* points to what is next */
int m = s<cap->src_end && luaI_singlematch((unsigned char)*s, p, ep);
switch (*ep) {
case '?': { /* optional */
const char *res;
if (m && ((res=match(L, s+1, ep+1, cap)) != NULL))
return res;
p=ep+1; goto init; /* else return match(L, s, ep+1, cap); */
}
case '*': /* 0 or more repetitions */
return max_expand(L, s, p, ep, cap);
case '+': /* 1 or more repetitions */
return (m ? max_expand(L, s+1, p, ep, cap) : NULL);
case '-': /* 0 or more repetitions (minimum) */
return min_expand(L, s, p, ep, cap);
default:
if (!m) return NULL;
s++; p=ep; goto init; /* else return match(L, s+1, ep, cap); */
}
}
}
}
static const char *memfind (const char *s1, long l1, const char *s2, long l2) {
if (l2 == 0) return s1; /* empty strings are everywhere ;-) */
else {
const char *init; /* to search for a `*s2' inside `s1' */
l2--; /* 1st char will be checked by `memchr' */
l1 = l1-l2; /* `s2' cannot be found after that */
while (l1 > 0 && (init = (const char *)memchr(s1, *s2, l1)) != NULL) {
init++; /* 1st char is already checked */
if (memcmp(init, s2+1, l2) == 0)
return init-1;
else { /* correct `l1' and `s1' to try again */
l1 -= init-s1;
s1 = init;
}
}
return NULL; /* not found */
}
}
static void str_find (lua_State *L) {
long l1, l2;
const char *s = luaL_check_lstr(L, 1, &l1);
const char *p = luaL_check_lstr(L, 2, &l2);
long init = posrelat(luaL_opt_long(L, 3, 1), l1) - 1;
struct Capture cap;
luaL_arg_check(L, 0 <= init && init <= l1, 3, "out of range");
if (lua_getparam(L, 4) != LUA_NOOBJECT ||
strpbrk(p, SPECIALS) == NULL) { /* no special characters? */
const char *s2 = memfind(s+init, l1, p, l2);
if (s2) {
lua_pushnumber(L, s2-s+1);
lua_pushnumber(L, s2-s+l2);
return;
}
}
else {
int anchor = (*p == '^') ? (p++, 1) : 0;
const char *s1=s+init;
cap.src_end = s+l1;
do {
const char *res;
cap.level = 0;
if ((res=match(L, s1, p, &cap)) != NULL) {
lua_pushnumber(L, s1-s+1); /* start */
lua_pushnumber(L, res-s); /* end */
push_captures(L, &cap);
return;
}
} while (s1++<cap.src_end && !anchor);
}
lua_pushnil(L); /* not found */
}
static void add_s (lua_State *L, lua_Object newp, struct Capture *cap) {
if (lua_isstring(L, newp)) {
const char *news = lua_getstring(L, newp);
int l = lua_strlen(L, newp);
int i;
for (i=0; i<l; i++) {
if (news[i] != ESC)
luaL_addchar(L, news[i]);
else {
i++; /* skip ESC */
if (!isdigit((unsigned char)news[i]))
luaL_addchar(L, news[i]);
else {
int level = check_capture(L, news[i], cap);
addnchar(L, cap->capture[level].init, cap->capture[level].len);
}
}
}
}
else { /* is a function */
lua_Object res;
int status;
int oldbuff;
lua_beginblock(L);
push_captures(L, cap);
/* function may use buffer, so save it and create a new one */
oldbuff = luaL_newbuffer(L, 0);
status = lua_callfunction(L, newp);
/* restore old buffer */
luaL_oldbuffer(L, oldbuff);
if (status != 0) {
lua_endblock(L);
lua_error(L, NULL);
}
res = lua_getresult(L, 1);
if (lua_isstring(L, res))
addnchar(L, lua_getstring(L, res), lua_strlen(L, res));
lua_endblock(L);
}
}
static void str_gsub (lua_State *L) {
long srcl;
const char *src = luaL_check_lstr(L, 1, &srcl);
const char *p = luaL_check_string(L, 2);
lua_Object newp = lua_getparam(L, 3);
int max_s = luaL_opt_int(L, 4, srcl+1);
int anchor = (*p == '^') ? (p++, 1) : 0;
int n = 0;
struct Capture cap;
luaL_arg_check(L, lua_isstring(L, newp) || lua_isfunction(L, newp), 3,
"string or function expected");
luaL_resetbuffer(L);
cap.src_end = src+srcl;
while (n < max_s) {
const char *e;
cap.level = 0;
e = match(L, src, p, &cap);
if (e) {
n++;
add_s(L, newp, &cap);
}
if (e && e>src) /* non empty match? */
src = e; /* skip it */
else if (src < cap.src_end)
luaL_addchar(L, *src++);
else break;
if (anchor) break;
}
addnchar(L, src, cap.src_end-src);
closeandpush(L);
lua_pushnumber(L, n); /* number of substitutions */
}
/* }====================================================== */
static void luaI_addquoted (lua_State *L, int arg) {
long l;
const char *s = luaL_check_lstr(L, arg, &l);
luaL_addchar(L, '"');
while (l--) {
switch (*s) {
case '"': case '\\': case '\n':
luaL_addchar(L, '\\');
luaL_addchar(L, *s);
break;
case '\0': addnchar(L, "\\000", 4); break;
default: luaL_addchar(L, *s);
}
s++;
}
luaL_addchar(L, '"');
}
/* maximum size of each format specification (such as '%-099.99d') */
#define MAX_FORMAT 20 /* arbitrary limit */
static void str_format (lua_State *L) {
int arg = 1;
const char *strfrmt = luaL_check_string(L, arg);
luaL_resetbuffer(L);
while (*strfrmt) {
if (*strfrmt != '%')
luaL_addchar(L, *strfrmt++);
else if (*++strfrmt == '%')
luaL_addchar(L, *strfrmt++); /* %% */
else { /* format item */
struct Capture cap;
char form[MAX_FORMAT]; /* to store the format ('%...') */
char *buff; /* to store the formatted item */
const char *initf = strfrmt;
form[0] = '%';
if (isdigit((unsigned char)*initf) && *(initf+1) == '$') {
arg = *initf - '0';
initf += 2; /* skip the 'n$' */
}
arg++;
cap.src_end = strfrmt+strlen(strfrmt)+1;
cap.level = 0;
strfrmt = match(L, initf, "[-+ #0]*(%d*)%.?(%d*)", &cap);
if (cap.capture[0].len > 2 || cap.capture[1].len > 2 || /* < 100? */
strfrmt-initf > MAX_FORMAT-2)
lua_error(L, "invalid format (width or precision too long)");
strncpy(form+1, initf, strfrmt-initf+1); /* +1 to include conversion */
form[strfrmt-initf+2] = 0;
buff = luaL_openspace(L, 512); /* 512 > len(format('%99.99f', -1e308)) */
switch (*strfrmt++) {
case 'c': case 'd': case 'i':
sprintf(buff, form, luaL_check_int(L, arg));
break;
case 'o': case 'u': case 'x': case 'X':
sprintf(buff, form, (unsigned int)luaL_check_number(L, arg));
break;
case 'e': case 'E': case 'f': case 'g': case 'G':
sprintf(buff, form, luaL_check_number(L, arg));
break;
case 'q':
luaI_addquoted(L, arg);
continue; /* skip the "addsize" at the end */
case 's': {
long l;
const char *s = luaL_check_lstr(L, arg, &l);
if (cap.capture[1].len == 0 && l >= 100) {
/* no precision and string is too long to be formatted;
keep original string */
addnchar(L, s, l);
continue; /* skip the "addsize" at the end */
}
else {
sprintf(buff, form, s);
break;
}
}
default: /* also treat cases 'pnLlh' */
lua_error(L, "invalid option in `format'");
}
luaL_addsize(L, strlen(buff));
}
}
closeandpush(L); /* push the result */
}
static const struct luaL_reg strlib[] = {
{"strlen", str_len},
{"strsub", str_sub},
{"strlower", str_lower},
{"strupper", str_upper},
{"strchar", str_char},
{"strrep", str_rep},
{"ascii", str_byte}, /* for compatibility with 3.0 and earlier */
{"strbyte", str_byte},
{"format", str_format},
{"strfind", str_find},
{"gsub", str_gsub}
};
/*
** Open string library
*/
void lua_strlibopen (lua_State *L) {
luaL_openl(L, strlib);
}

224
ltable.c
View File

@@ -1,224 +0,0 @@
/*
** $Id: ltable.c,v 1.38 2000/03/29 20:19:20 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_REENTRANT
#include "lauxlib.h"
#include "lmem.h"
#include "lobject.h"
#include "lstate.h"
#include "ltable.h"
#include "lua.h"
#define gcsize(L, n) numblocks(L, n*2, sizeof(Hash))
#define TagDefault TAG_TABLE
/*
** 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) {
unsigned long h;
switch (ttype(key)) {
case TAG_NUMBER:
h = (unsigned long)(long)nvalue(key);
break;
case TAG_STRING: case TAG_USERDATA:
h = tsvalue(key)->hash;
break;
case TAG_TABLE:
h = IntPoint(L, avalue(key));
break;
case TAG_LCLOSURE: case TAG_CCLOSURE:
h = IntPoint(L, clvalue(key));
break;
default:
return NULL; /* invalid key */
}
LUA_ASSERT(L, h%(unsigned int)t->size == (h&((unsigned int)t->size-1)),
"a&(x-1) == a%x, for x power of 2");
return &t->node[h&((unsigned int)t->size-1)];
}
const TObject *luaH_get (lua_State *L, const Hash *t, const TObject *key) {
Node *n = luaH_mainposition(t, key);
if (!n)
lua_error(L, "unexpected type to index table");
else do {
if (luaO_equalObj(key, &n->key))
return &n->val;
n = n->next;
} while (n);
return &luaO_nilobject; /* key not found */
}
int luaH_pos (lua_State *L, const Hash *t, const TObject *key) {
const TObject *v = luaH_get(L, t, key);
return (v == &luaO_nilobject) ? -1 : /* key not found */
(int)(((const char *)v - (const char *)(&t->node[0].val))/sizeof(Node));
}
static Node *hashnodecreate (lua_State *L, int nhash) {
Node *v = luaM_newvector(L, nhash, Node);
int i;
for (i=0; i<nhash; i++) {
ttype(&v[i].key) = ttype(&v[i].val) = TAG_NIL;
v[i].next = NULL;
}
return v;
}
static void setnodevector (lua_State *L, Hash *t, int size) {
t->node = hashnodecreate(L, size);
t->size = size;
t->firstfree = &t->node[size-1]; /* first free position to be used */
L->nblocks += gcsize(L, size);
}
Hash *luaH_new (lua_State *L, int size) {
Hash *t = luaM_new(L, Hash);
setnodevector(L, t, luaO_power2(size));
t->htag = TagDefault;
t->next = L->roottable;
L->roottable = t;
t->marked = 0;
return t;
}
void luaH_free (lua_State *L, Hash *t) {
L->nblocks -= gcsize(L, t->size);
luaM_free(L, t->node);
luaM_free(L, t);
}
static int newsize (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) != TAG_NIL)
realuse++;
}
return luaO_power2(realuse+realuse/4+1);
}
static void rehash (lua_State *L, Hash *t) {
int oldsize = t->size;
Node *nold = t->node;
int i;
L->nblocks -= gcsize(L, oldsize);
setnodevector(L, t, newsize(t)); /* create new array of nodes */
for (i=0; i<oldsize; i++) {
Node *old = nold+i;
if (ttype(&old->val) != TAG_NIL)
luaH_set(L, t, &old->key, &old->val);
}
luaM_free(L, nold); /* free old array */
}
/*
** sets a pair key-value in a hash table; first, check whether key is
** already present; if not, 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 pair
** in its main position; otherwise (colliding node is in its main position),
** new pair goes to an empty position.
** Tricky point: the only place where an old element is moved is when
** we move the colliding node to an empty place; nevertheless, its old
** value is still in that position until we set the value for the new
** pair; therefore, even when `val' points to an element of this table
** (this happens when we use `luaH_move'), there is no problem.
*/
void luaH_set (lua_State *L, Hash *t, const TObject *key, const TObject *val) {
Node *mp = luaH_mainposition(t, key);
Node *n = mp;
if (!mp)
lua_error(L, "unexpected type to index table");
do { /* check whether `key' is somewhere in the chain */
if (luaO_equalObj(key, &n->key)) {
n->val = *val; /* update value */
return; /* that's all */
}
else n = n->next;
} while (n);
/* `key' not found; must insert it */
if (ttype(&mp->key) != TAG_NIL) { /* main position is not free? */
Node *othern; /* main position of colliding node */
n = t->firstfree; /* get a free place */
/* is colliding node out of its main position? (can only happens if
its position if after "firstfree") */
if (mp > n && (othern=luaH_mainposition(t, &mp->key)) != mp) {
/* 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 */
}
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;
}
}
mp->key = *key;
mp->val = *val;
for (;;) { /* check free places */
if (ttype(&t->firstfree->key) == TAG_NIL)
return; /* 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 */
}
void luaH_setint (lua_State *L, Hash *t, int key, const TObject *val) {
TObject index;
ttype(&index) = TAG_NUMBER;
nvalue(&index) = key;
luaH_set(L, t, &index, val);
}
const TObject *luaH_getint (lua_State *L, const Hash *t, int key) {
TObject index;
ttype(&index) = TAG_NUMBER;
nvalue(&index) = key;
return luaH_get(L, t, &index);
}

View File

@@ -1,32 +0,0 @@
/*
** $Id: ltable.h,v 1.17 1999/11/23 13:58:02 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)
#define luaH_move(L, t,from,to) (luaH_setint(L, t, to, luaH_getint(L, t, from)))
Hash *luaH_new (lua_State *L, int nhash);
void luaH_free (lua_State *L, Hash *t);
const TObject *luaH_get (lua_State *L, const Hash *t, const TObject *key);
void luaH_set (lua_State *L, Hash *t, const TObject *key, const TObject *val);
int luaH_pos (lua_State *L, const Hash *t, const TObject *r);
void luaH_setint (lua_State *L, Hash *t, int key, const TObject *val);
const TObject *luaH_getint (lua_State *L, const Hash *t, int key);
unsigned long luaH_hash (lua_State *L, const TObject *key);
/* exported only for debugging */
Node *luaH_mainposition (const Hash *t, const TObject *key);
#endif

417
ltests.c
View File

@@ -1,417 +0,0 @@
/*
** $Id: ltests.c,v 1.15 2000/04/13 16:51:01 roberto Exp roberto $
** Internal Module for Debugging of the Lua Implementation
** See Copyright Notice in lua.h
*/
#include <ctype.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#define LUA_REENTRANT
#include "lapi.h"
#include "lauxlib.h"
#include "lmem.h"
#include "lopcodes.h"
#include "lstate.h"
#include "lstring.h"
#include "ltable.h"
#include "lua.h"
#include "luadebug.h"
void luaB_opentests (lua_State *L);
/*
** The whole module only makes sense with DEBUG on
*/
#ifdef DEBUG
static void setnameval (lua_State *L, lua_Object t, const char *name, int val) {
lua_pushobject(L, t);
lua_pushstring(L, name);
lua_pushnumber(L, val);
lua_settable(L);
}
/*
** {======================================================
** Disassembler
** =======================================================
*/
#define O(o) sprintf(buff, "%s", o)
#define U(o) sprintf(buff, "%-12s%4u", o, GETARG_U(i))
#define S(o) sprintf(buff, "%-12s%4d", o, GETARG_S(i))
#define AB(o) sprintf(buff, "%-12s%4d %4d", o, GETARG_A(i), GETARG_B(i))
static int pushop (lua_State *L, Instruction i) {
char buff[100];
switch (GET_OPCODE(i)) {
case OP_END: O("END"); lua_pushstring(L, buff); return 0;
case OP_RETURN: U("RETURN"); break;
case OP_CALL: AB("CALL"); break;
case OP_TAILCALL: AB("TAILCALL"); break;
case OP_PUSHNIL: U("PUSHNIL"); break;
case OP_POP: U("POP"); break;
case OP_PUSHINT: S("PUSHINT"); break;
case OP_PUSHSTRING: U("PUSHSTRING"); break;
case OP_PUSHNUM: U("PUSHNUM"); break;
case OP_PUSHNEGNUM: U("PUSHNEGNUM"); break;
case OP_PUSHUPVALUE: U("PUSHUPVALUE"); break;
case OP_GETLOCAL: U("GETLOCAL"); break;
case OP_GETGLOBAL: U("GETGLOBAL"); break;
case OP_GETTABLE: O("GETTABLE"); break;
case OP_GETDOTTED: U("GETDOTTED"); break;
case OP_GETINDEXED: U("GETINDEXED"); break;
case OP_PUSHSELF: U("PUSHSELF"); break;
case OP_CREATETABLE: U("CREATETABLE"); break;
case OP_SETLOCAL: U("SETLOCAL"); break;
case OP_SETGLOBAL: U("SETGLOBAL"); break;
case OP_SETTABLE: AB("SETTABLE"); break;
case OP_SETLIST: AB("SETLIST"); break;
case OP_SETMAP: U("SETMAP"); break;
case OP_ADD: O("ADD"); break;
case OP_ADDI: S("ADDI"); break;
case OP_SUB: O("SUB"); break;
case OP_MULT: O("MULT"); break;
case OP_DIV: O("DIV"); break;
case OP_POW: O("POW"); break;
case OP_CONCAT: U("CONCAT"); break;
case OP_MINUS: O("MINUS"); break;
case OP_NOT: O("NOT"); break;
case OP_JMPNE: S("JMPNE"); break;
case OP_JMPEQ: S("JMPEQ"); break;
case OP_JMPLT: S("JMPLT"); break;
case OP_JMPLE: S("JMPLE"); break;
case OP_JMPGT: S("JMPGT"); break;
case OP_JMPGE: S("JMPGE"); break;
case OP_JMPT: S("JMPT"); break;
case OP_JMPF: S("JMPF"); break;
case OP_JMPONT: S("JMPONT"); break;
case OP_JMPONF: S("JMPONF"); break;
case OP_JMP: S("JMP"); break;
case OP_PUSHNILJMP: O("PUSHNILJMP"); break;
case OP_FORPREP: S("OP_FORPREP"); break;
case OP_FORLOOP: S("OP_FORLOOP"); break;
case OP_CLOSURE: AB("CLOSURE"); break;
case OP_SETLINE: U("SETLINE"); break;
}
lua_pushstring(L, buff);
return 1;
}
static void listcode (lua_State *L) {
lua_Object o = luaL_nonnullarg(L, 1);
lua_Object t = lua_createtable(L);
Instruction *pc;
Proto *p;
int res;
luaL_arg_check(L, ttype(o) == TAG_LCLOSURE, 1, "Lua function expected");
p = clvalue(o)->f.l;
setnameval(L, t, "maxstack", p->maxstacksize);
setnameval(L, t, "numparams", p->numparams);
pc = p->code;
do {
lua_pushobject(L, t);
lua_pushnumber(L, pc - p->code + 1);
res = pushop(L, *pc++);
lua_settable(L);
} while (res);
lua_pushobject(L, t);
}
/* }====================================================== */
static void get_limits (lua_State *L) {
lua_Object t = lua_createtable(L);
setnameval(L, t, "SIZE_OP", SIZE_OP);
setnameval(L, t, "SIZE_U", SIZE_U);
setnameval(L, t, "SIZE_A", SIZE_A);
setnameval(L, t, "SIZE_B", SIZE_B);
setnameval(L, t, "MAXARG_U", MAXARG_U);
setnameval(L, t, "MAXARG_S", MAXARG_S);
setnameval(L, t, "MAXARG_A", MAXARG_A);
setnameval(L, t, "MAXARG_B", MAXARG_B);
setnameval(L, t, "MAXSTACK", MAXSTACK);
setnameval(L, t, "MAXLOCALS", MAXLOCALS);
setnameval(L, t, "MAXUPVALUES", MAXUPVALUES);
setnameval(L, t, "MAXVARSLH", MAXVARSLH);
setnameval(L, t, "MAXPARAMS", MAXPARAMS);
setnameval(L, t, "LFPF", LFIELDS_PER_FLUSH);
setnameval(L, t, "RFPF", RFIELDS_PER_FLUSH);
lua_pushobject(L, t);
}
static void mem_query (lua_State *L) {
lua_pushnumber(L, memdebug_total);
lua_pushnumber(L, memdebug_numblocks);
lua_pushnumber(L, memdebug_maxmem);
}
static void hash_query (lua_State *L) {
lua_Object o = luaL_nonnullarg(L, 1);
if (lua_getparam(L, 2) == LUA_NOOBJECT) {
luaL_arg_check(L, ttype(o) == TAG_STRING, 1, "string expected");
lua_pushnumber(L, tsvalue(o)->hash);
}
else {
const Hash *t = avalue(luaL_tablearg(L, 2));
lua_pushnumber(L, luaH_mainposition(t, o) - t->node);
}
}
static void table_query (lua_State *L) {
const Hash *t = avalue(luaL_tablearg(L, 1));
int i = luaL_opt_int(L, 2, -1);
if (i == -1) {
lua_pushnumber(L, t->size);
lua_pushnumber(L, t->firstfree - t->node);
}
else if (i < t->size) {
luaA_pushobject(L, &t->node[i].key);
luaA_pushobject(L, &t->node[i].val);
if (t->node[i].next)
lua_pushnumber(L, t->node[i].next - t->node);
}
}
static void string_query (lua_State *L) {
int h = luaL_check_int(L, 1) - 1;
int s = luaL_opt_int(L, 2, 0) - 1;
if (s==-1) {
if (h < NUM_HASHS) {
lua_pushnumber(L, L->string_root[h].nuse);
lua_pushnumber(L, L->string_root[h].size);
}
}
else {
TString *ts = L->string_root[h].hash[s];
for (ts = L->string_root[h].hash[s]; ts; ts = ts->nexthash) {
if (ts->constindex == -1) lua_pushstring(L, "<USERDATA>");
else lua_pushstring(L, ts->str);
}
}
}
/*
** {======================================================
** 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 char *const delimits = " \t\n,;";
static void skip (const char **pc) {
while (**pc != '\0' && strchr(delimits, **pc)) (*pc)++;
}
static int getnum (const char **pc) {
int res = 0;
skip(pc);
while (isdigit(**pc)) res = res*10 + (*(*pc)++) - '0';
return res;
}
static int getreg (lua_State *L, const char **pc) {
skip(pc);
if (*(*pc)++ != 'r') lua_error(L, "`testC' expecting a register");
return getnum(pc);
}
static const char *getname (const char **pc) {
static char buff[30];
int i = 0;
skip(pc);
while (**pc != '\0' && !strchr(delimits, **pc))
buff[i++] = *(*pc)++;
buff[i] = '\0';
return buff;
}
#define EQ(s1) (strcmp(s1, inst) == 0)
static void testC (lua_State *L) {
lua_Object reg[10];
const char *pc = luaL_check_string(L, 1);
for (;;) {
const char *inst = getname(&pc);
if EQ("") return;
else if EQ("pushnum") {
lua_pushnumber(L, getnum(&pc));
}
else if EQ("createtable") {
reg[getreg(L, &pc)] = lua_createtable(L);
}
else if EQ("closure") {
lua_CFunction f = lua_getcfunction(L, lua_getglobal(L, getname(&pc)));
lua_pushcclosure(L, f, getnum(&pc));
}
else if EQ("pop") {
reg[getreg(L, &pc)] = lua_pop(L);
}
else if EQ("getglobal") {
int n = getreg(L, &pc);
reg[n] = lua_getglobal(L, getname(&pc));
}
else if EQ("rawgetglobal") {
int n = getreg(L, &pc);
reg[n] = lua_rawgetglobal(L, getname(&pc));
}
else if EQ("ref") {
lua_pushnumber(L, lua_ref(L, 0));
reg[getreg(L, &pc)] = lua_pop(L);
}
else if EQ("reflock") {
lua_pushnumber(L, lua_ref(L, 1));
reg[getreg(L, &pc)] = lua_pop(L);
}
else if EQ("getref") {
int n = getreg(L, &pc);
reg[n] = lua_getref(L, (int)lua_getnumber(L, reg[getreg(L, &pc)]));
}
else if EQ("unref") {
lua_unref(L, (int)lua_getnumber(L, reg[getreg(L, &pc)]));
}
else if EQ("getparam") {
int n = getreg(L, &pc);
reg[n] = lua_getparam(L, getnum(&pc)+1); /* skips the command itself */
}
else if EQ("getresult") {
int n = getreg(L, &pc);
reg[n] = lua_getparam(L, getnum(&pc));
}
else if EQ("setglobal") {
lua_setglobal(L, getname(&pc));
}
else if EQ("rawsetglobal") {
lua_rawsetglobal(L, getname(&pc));
}
else if EQ("pushstring") {
lua_pushstring(L, getname(&pc));
}
else if EQ("pushreg") {
lua_pushobject(L, reg[getreg(L, &pc)]);
}
else if EQ("call") {
if (lua_call(L, getname(&pc))) lua_error(L, NULL);
}
else if EQ("gettable") {
reg[getreg(L, &pc)] = lua_gettable(L);
}
else if EQ("rawgettable") {
reg[getreg(L, &pc)] = lua_rawgettable(L);
}
else if EQ("settable") {
lua_settable(L);
}
else if EQ("rawsettable") {
lua_rawsettable(L);
}
else if EQ("tag") {
lua_pushnumber(L, lua_tag(L, reg[getreg(L, &pc)]));
}
else if EQ("type") {
lua_pushstring(L, lua_type(L, reg[getreg(L, &pc)]));
}
else if EQ("nextvar") {
lua_pushstring(L, lua_nextvar(L, lua_getstring(L, reg[getreg(L, &pc)])));
}
else if EQ("next") {
int n = getreg(L, &pc);
n = lua_next(L, reg[n], (int)lua_getnumber(L, reg[getreg(L, &pc)]));
lua_pushnumber(L, n);
}
else if EQ("equal") {
int n1 = getreg(L, &pc);
int n2 = getreg(L, &pc);
lua_pushnumber(L, lua_equal(L, reg[n1], reg[n2]));
}
else if EQ("pushusertag") {
int val = getreg(L, &pc);
int tag = getreg(L, &pc);
lua_pushusertag(L, (void *)(int)lua_getnumber(L, reg[val]),
(int)lua_getnumber(L, reg[tag]));
}
else if EQ("udataval") {
int n = getreg(L, &pc);
lua_pushnumber(L, (int)lua_getuserdata(L, reg[getreg(L, &pc)]));
reg[n] = lua_pop(L);
}
else if EQ("settagmethod") {
int n = getreg(L, &pc);
lua_settagmethod(L, (int)lua_getnumber(L, reg[n]), getname(&pc));
}
else if EQ("beginblock") {
lua_beginblock(L);
}
else if EQ("endblock") {
lua_endblock(L);
}
else if EQ("newstate") {
int stacksize = getnum(&pc);
lua_State *L1 = lua_newstate("stack", stacksize,
"builtin", getnum(&pc), NULL);
lua_pushuserdata(L, L1);
}
else if EQ("closestate") {
lua_close((lua_State *)lua_getuserdata(L, reg[getreg(L, &pc)]));
}
else if EQ("doremote") {
lua_Object ol1 = reg[getreg(L, &pc)];
lua_Object str = reg[getreg(L, &pc)];
lua_State *L1;
lua_Object temp;
int i;
if (!lua_isuserdata(L, ol1) || !lua_isstring(L, str))
lua_error(L, "bad arguments for `doremote'");
L1 = (lua_State *)lua_getuserdata(L, ol1);
lua_dostring(L1, lua_getstring(L, str));
i = 1;
while ((temp = lua_getresult(L1, i++)) != LUA_NOOBJECT)
lua_pushstring(L, lua_getstring(L1, temp));
}
else luaL_verror(L, "unknown command in `testC': %.20s", inst);
}
}
/* }====================================================== */
static const struct luaL_reg tests_funcs[] = {
{"hash", hash_query},
{"limits", get_limits},
{"listcode", listcode},
{"querystr", string_query},
{"querytab", table_query},
{"testC", testC},
{"totalmem", mem_query}
};
void luaB_opentests (lua_State *L) {
luaL_openl(L, tests_funcs);
}
#endif

158
ltm.c
View File

@@ -1,158 +0,0 @@
/*
** $Id: ltm.c,v 1.38 2000/03/29 20:19:20 roberto Exp roberto $
** Tag methods
** See Copyright Notice in lua.h
*/
#include <stdio.h>
#include <string.h>
#define LUA_REENTRANT
#include "lauxlib.h"
#include "lmem.h"
#include "lobject.h"
#include "lstate.h"
#include "ltm.h"
const char *const luaT_eventname[] = { /* ORDER IM */
"gettable", "settable", "index", "getglobal", "setglobal", "add", "sub",
"mul", "div", "pow", "unm", "lt", "concat", "gc", "function",
"le", "gt", "ge", /* deprecated options!! */
NULL
};
static int luaI_checkevent (lua_State *L, const char *name, int t) {
int e = luaL_findstring(name, luaT_eventname);
if (e >= IM_N)
luaL_verror(L, "event `%.50s' is deprecated", name);
if (e == IM_GC && t == TAG_TABLE)
luaL_verror(L, "event `gc' for tables is deprecated");
if (e < 0)
luaL_verror(L, "`%.50s' is not a valid event name", name);
return e;
}
/* events in TAG_NIL are all allowed, since this is used as a
* 'placeholder' for "default" fallbacks
*/
/* ORDER LUA_T, ORDER IM */
static const char luaT_validevents[NUM_TAGS][IM_N] = {
{1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1}, /* TAG_USERDATA */
{1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1}, /* TAG_NUMBER */
{1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, /* TAG_STRING */
{0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1}, /* TAG_TABLE */
{1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0}, /* TAG_LCLOSURE */
{1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0}, /* TAG_CCLOSURE */
{1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1} /* TAG_NIL */
};
int luaT_validevent (int t, int e) { /* ORDER LUA_T */
return (t > TAG_NIL) ? 1 : luaT_validevents[t][e];
}
static void init_entry (lua_State *L, int tag) {
int i;
for (i=0; i<IM_N; i++)
ttype(luaT_getim(L, tag, i)) = TAG_NIL;
}
void luaT_init (lua_State *L) {
int t;
L->last_tag = NUM_TAGS-1;
luaM_growvector(L, L->IMtable, 0, NUM_TAGS, struct IM, arrEM, MAX_INT);
for (t=0; t<=L->last_tag; t++)
init_entry(L, t);
}
int lua_newtag (lua_State *L) {
++L->last_tag;
luaM_growvector(L, L->IMtable, L->last_tag, 1, struct IM, arrEM, MAX_INT);
init_entry(L, L->last_tag);
return L->last_tag;
}
static void checktag (lua_State *L, int tag) {
if (!(0 <= tag && tag <= L->last_tag))
luaL_verror(L, "%d is not a valid tag", tag);
}
void luaT_realtag (lua_State *L, int tag) {
if (!(NUM_TAGS <= tag && tag <= L->last_tag))
luaL_verror(L, "tag %d was not created by `newtag'", tag);
}
int lua_copytagmethods (lua_State *L, int tagto, int tagfrom) {
int e;
checktag(L, tagto);
checktag(L, tagfrom);
for (e=0; e<IM_N; e++) {
if (luaT_validevent(tagto, e))
*luaT_getim(L, tagto, e) = *luaT_getim(L, tagfrom, e);
}
return tagto;
}
int luaT_effectivetag (lua_State *L, const TObject *o) {
lua_Type t = ttype(o);
switch (t) {
case TAG_USERDATA: {
int tag = o->value.ts->u.d.tag;
return (tag > L->last_tag) ? TAG_USERDATA : tag; /* deprecated test */
}
case TAG_TABLE: return o->value.a->htag;
default: return t;
}
}
const TObject *luaT_gettagmethod (lua_State *L, int t, const char *event) {
int e;
e = luaI_checkevent(L, event, t);
checktag(L, t);
if (luaT_validevent(t, e))
return luaT_getim(L, t,e);
else
return &luaO_nilobject;
}
void luaT_settagmethod (lua_State *L, int t, const char *event, TObject *func) {
TObject temp;
int e;
e = luaI_checkevent(L, event, t);
checktag(L, t);
if (!luaT_validevent(t, e))
luaL_verror(L, "cannot change `%.20s' tag method for type `%.20s'%.20s",
luaT_eventname[e], luaO_typenames[t],
(t == TAG_TABLE || t == TAG_USERDATA) ? " with default tag"
: "");
temp = *func;
*func = *luaT_getim(L, t,e);
*luaT_getim(L, t, e) = temp;
}
const char *luaT_travtagmethods (lua_State *L,
int (*fn)(lua_State *, TObject *)) { /* ORDER IM */
int e;
for (e=IM_GETTABLE; e<=IM_FUNCTION; e++) {
int t;
for (t=0; t<=L->last_tag; t++)
if (fn(L, luaT_getim(L, t,e)))
return luaT_eventname[e];
}
return NULL;
}

58
ltm.h
View File

@@ -1,58 +0,0 @@
/*
** $Id: ltm.h,v 1.11 2000/03/20 19:14:54 roberto Exp roberto $
** Tag methods
** See Copyright Notice in lua.h
*/
#ifndef ltm_h
#define ltm_h
#include "lobject.h"
#include "lstate.h"
/*
* WARNING: if you change the order of this enumeration,
* grep "ORDER IM"
*/
typedef enum {
IM_GETTABLE = 0,
IM_SETTABLE,
IM_INDEX,
IM_GETGLOBAL,
IM_SETGLOBAL,
IM_ADD,
IM_SUB,
IM_MUL,
IM_DIV,
IM_POW,
IM_UNM,
IM_LT,
IM_CONCAT,
IM_GC,
IM_FUNCTION,
IM_N /* number of elements in the enum */
} IMS;
struct IM {
TObject int_method[IM_N];
};
#define luaT_getim(L,tag,event) (&L->IMtable[tag].int_method[event])
#define luaT_getimbyObj(L,o,e) (luaT_getim(L, luaT_effectivetag(L, o),(e)))
extern const char *const luaT_eventname[];
void luaT_init (lua_State *L);
void luaT_realtag (lua_State *L, int tag);
int luaT_effectivetag (lua_State *L, const TObject *o);
void luaT_settagmethod (lua_State *L, int t, const char *event, TObject *func);
const TObject *luaT_gettagmethod (lua_State *L, int t, const char *event);
const char *luaT_travtagmethods (lua_State *L, int (*fn)(lua_State *, TObject *));
int luaT_validevent (int t, int e); /* used by compatibility module */
#endif

278
lua.c
View File

@@ -1,254 +1,54 @@
/*
** $Id: lua.c,v 1.36 2000/03/30 17:19:48 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>
#include "lua.h"
#include "luadebug.h"
#include "lualib.h"
#ifndef PROMPT
#define PROMPT "> "
#endif
#ifdef _POSIX_SOURCE
#include <unistd.h>
#else
static int isatty (int x) { return x==0; } /* assume stdin is a tty */
#endif
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(lua_state, old_linehook);
lua_setcallhook(lua_state, old_callhook);
lreset();
lua_error("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(lua_state, (lua_Hook)lstop);
old_callhook = lua_setcallhook(lua_state, (lua_Hook)lstop);
}
static int ldo (int (*f)(lua_State *L, const char *), const char *name) {
int res;
handler h = lreset();
res = f(lua_state, name); /* dostring | dofile */
signal(SIGINT, h); /* restore old action */
return res;
}
static void print_message (void) {
fprintf(stderr,
"usage: lua [options]. Available options are:\n"
" - execute stdin as a file\n"
" -d turn debug on\n"
" -e stat execute string `stat'\n"
" -f name execute file `name' with remaining arguments in table `arg'\n"
" -i enter interactive mode with prompt\n"
" -q enter interactive mode without prompt\n"
" -sNUM set stack size to NUM (must be first option)\n"
" -v print version information\n"
" a=b set global `a' to string `b'\n"
" name execute file `name'\n"
);
}
static void print_version (void) {
printf("%s %s\n", LUA_VERSION, LUA_COPYRIGHT);
}
static void assign (char *arg) {
char *eq = strchr(arg, '=');
*eq = '\0'; /* spilt `arg' in two strings (name & value) */
lua_pushstring(eq+1);
lua_setglobal(arg);
}
static lua_Object getargs (char *argv[]) {
lua_Object args = lua_createtable();
int i;
for (i=0; argv[i]; i++) {
/* arg[i] = argv[i] */
lua_pushobject(args); lua_pushnumber(i);
lua_pushstring(argv[i]); lua_settable();
}
/* arg.n = maximum index in table `arg' */
lua_pushobject(args); lua_pushstring("n");
lua_pushnumber(i-1); lua_settable();
return args;
}
static void l_getargs (void) {
char **argv = (char **)lua_getuserdata(lua_getparam(1));
lua_pushobject(getargs(argv));
}
static void file_input (const char *argv) {
int result = ldo(lua_dofile, argv);
if (result) {
if (result == 2) {
fprintf(stderr, "lua: cannot execute file ");
perror(argv);
}
exit(1);
}
}
static void manual_input (int version, int prompt) {
int cont = 1;
if (version) print_version();
while (cont) {
char buffer[BUFSIZ];
int i = 0;
lua_beginblock();
if (prompt) {
const char *s = lua_getstring(lua_getglobal("_PROMPT"));
if (!s) s = PROMPT;
fputs(s, stdout);
}
for(;;) {
int c = getchar();
if (c == EOF) {
cont = 0;
break;
}
else if (c == '\n') {
if (i>0 && buffer[i-1] == '\\')
buffer[i-1] = '\n';
else break;
}
else if (i >= BUFSIZ-1) {
fprintf(stderr, "lua: input line too long\n");
break;
}
else buffer[i++] = (char)c;
}
buffer[i] = '\0';
ldo(lua_dostring, buffer);
lua_endblock();
}
printf("\n");
}
int main (int argc, char *argv[]) {
int i = 1;
if (i < argc && argv[1][0] == '-' && argv[1][1] == 's') {
int stacksize = atoi(&argv[1][2]);
if (stacksize == 0) {
fprintf(stderr, "lua: invalid stack size ('%s')\n", &argv[1][2]);
exit(1);
}
i++;
lua_state = lua_newstate("stack", stacksize, NULL);
}
else
lua_state = lua_newstate(NULL);
lua_userinit();
lua_pushuserdata(argv);
lua_pushcclosure(l_getargs, 1);
lua_setglobal("getargs");
if (i >= argc) { /* no other arguments? */
if (isatty(0)) {
manual_input(1, 1);
}
else
ldo(lua_dofile, NULL); /* executes stdin as a file */
}
else for (; i<argc; i++) {
if (argv[i][0] == '-') { /* option? */
switch (argv[i][1]) {
case 0:
ldo(lua_dofile, NULL); /* executes stdin as a file */
break;
case 'i':
manual_input(0, 1);
break;
case 'q':
manual_input(0, 0);
break;
case 'd':
lua_setdebug(lua_state, 1);
if (i+1 >= argc) { /* last argument? */
manual_input(1, 1);
}
break;
case 'v':
print_version();
break;
case 'e':
i++;
if (i >= argc) {
print_message();
exit(1);
}
if (ldo(lua_dostring, argv[i]) != 0) {
fprintf(stderr, "lua: error running argument `%s'\n", argv[i]);
exit(1);
}
break;
case 'f':
i++;
if (i >= argc) {
print_message();
exit(1);
}
lua_pushobject(getargs(argv+i)); /* collect remaining arguments */
lua_setglobal("arg");
file_input(argv[i]);
goto endloop; /* stop scanning arguments */
break;
case 's':
fprintf(stderr, "lua: stack size (`-s') must be the first option\n");
exit(1);
default:
print_message();
exit(1);
}
}
else if (strchr(argv[i], '='))
assign(argv[i]);
else
file_input(argv[i]);
}
endloop:
#ifdef DEBUG
lua_close();
#endif
return 0;
}

278
lua.h
View File

@@ -1,256 +1,54 @@
/*
** $Id: lua.h,v 1.47 2000/04/14 17:48:20 roberto Exp roberto $
** Lua - An Extensible Extension Language
** TeCGraf: Grupo de Tecnologia em Computacao Grafica, PUC-Rio, Brazil
** e-mail: lua@tecgraf.puc-rio.br
** www: http://www.tecgraf.puc-rio.br/lua/
** See Copyright Notice at the end of this file
** LUA - Linguagem para Usuarios de Aplicacao
** Grupo de Tecnologia em Computacao Grafica
** TeCGraf - PUC-Rio
** 19 May 93
*/
#ifndef lua_h
#define lua_h
#define LUA_VERSION "Lua 4.0 (alpha)"
#define LUA_COPYRIGHT "Copyright (C) 1994-2000 TeCGraf, PUC-Rio"
#define LUA_AUTHORS "W. Celes, R. Ierusalimschy & L. H. de Figueiredo"
typedef void (*lua_CFunction) (void);
typedef struct Object *lua_Object;
#define lua_register(n,f) (lua_pushcfunction(f), lua_storeglobal(n))
#define LUA_NOREF (-2)
#define LUA_REFNIL (-1)
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);
#define LUA_ANYTAG (-1)
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);
typedef struct lua_State lua_State;
lua_Object lua_pop (void);
typedef void (*lua_CFunction) (lua_State *L);
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);
typedef struct TObject *lua_Object;
int lua_storeglobal (char *name);
int lua_storefield (lua_Object object, char *field);
int lua_storeindexed (lua_Object object, float index);
#define LUA_NOOBJECT ((lua_Object)0)
lua_State *lua_newstate (const char *s, ...);
void lua_close (lua_State *L);
lua_Object lua_settagmethod (lua_State *L, int tag, const char *event);
/* In: new method */
lua_Object lua_gettagmethod (lua_State *L, int tag, const char *event);
int lua_newtag (lua_State *L);
int lua_copytagmethods (lua_State *L, int tagto, int tagfrom);
void lua_settag (lua_State *L, int tag); /* In: object */
void lua_error (lua_State *L, const char *s);
int lua_dofile (lua_State *L, const char *filename);
/* Out: returns */
int lua_dostring (lua_State *L, const char *str);
/* Out: returns */
int lua_dobuffer (lua_State *L, const char *buff, int size,
const char *name); /* Out: returns */
int lua_callfunction (lua_State *L, lua_Object f);
/* In: parameters; Out: returns */
void lua_beginblock (lua_State *L);
void lua_endblock (lua_State *L);
lua_Object lua_lua2C (lua_State *L, int number);
#define lua_getparam lua_lua2C
#define lua_getresult lua_lua2C
const char *lua_type (lua_State *L, lua_Object obj);
int lua_isnil (lua_State *L, lua_Object obj);
int lua_istable (lua_State *L, lua_Object obj);
int lua_isuserdata (lua_State *L, lua_Object obj);
int lua_iscfunction (lua_State *L, lua_Object obj);
int lua_isnumber (lua_State *L, lua_Object obj);
int lua_isstring (lua_State *L, lua_Object obj);
int lua_isfunction (lua_State *L, lua_Object obj);
int lua_equal (lua_State *L, lua_Object o1, lua_Object o2);
double lua_getnumber (lua_State *L, lua_Object obj);
const char *lua_getstring (lua_State *L, lua_Object obj);
long lua_strlen (lua_State *L, lua_Object obj);
lua_CFunction lua_getcfunction (lua_State *L, lua_Object obj);
void *lua_getuserdata (lua_State *L, lua_Object obj);
void lua_pushnil (lua_State *L);
void lua_pushnumber (lua_State *L, double n);
void lua_pushlstring (lua_State *L, const char *s, long len);
void lua_pushstring (lua_State *L, const char *s);
void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n);
void lua_pushusertag (lua_State *L, void *u, int tag);
void lua_pushobject (lua_State *L, lua_Object obj);
lua_Object lua_pop (lua_State *L);
lua_Object lua_getglobal (lua_State *L, const char *name);
lua_Object lua_rawgetglobal (lua_State *L, const char *name);
void lua_setglobal (lua_State *L, const char *name); /* In: value */
void lua_rawsetglobal (lua_State *L, const char *name);/* In: value */
void lua_settable (lua_State *L); /* In: table, index, value */
void lua_rawsettable (lua_State *L); /* In: table, index, value */
lua_Object lua_gettable (lua_State *L); /* In: table, index */
lua_Object lua_rawgettable (lua_State *L); /* In: table, index */
int lua_tag (lua_State *L, lua_Object obj);
const char *lua_nextvar (lua_State *L, const char *varname); /* Out: value */
int lua_next (lua_State *L, lua_Object o, int i);
/* Out: ref, value */
int lua_ref (lua_State *L, int lock); /* In: value */
lua_Object lua_getref (lua_State *L, int ref);
void lua_unref (lua_State *L, int ref);
lua_Object lua_createtable (lua_State *L);
long lua_collectgarbage (lua_State *L, long limit);
/*
** ===============================================================
** some useful macros
** ===============================================================
*/
#ifdef LUA_REENTRANT
#define lua_call(L,name) lua_callfunction(L, lua_getglobal(L, name))
#define lua_pushref(L,ref) lua_pushobject(L, lua_getref(L, ref))
#define lua_refobject(L,o,l) (lua_pushobject(L, o), lua_ref(L, l))
#define lua_register(L,n,f) (lua_pushcfunction(L, f), lua_setglobal(L, n))
#define lua_pushuserdata(L,u) lua_pushusertag(L, u, 0)
#define lua_pushcfunction(L,f) lua_pushcclosure(L, f, 0)
#define lua_clonetag(L,t) lua_copytagmethods(L, lua_newtag(L), (t))
#else
#define lua_call(name) lua_callfunction(lua_getglobal(name))
#define lua_pushref(ref) lua_pushobject(lua_getref(ref))
#define lua_refobject(o,l) (lua_pushobject(o), lua_ref(l))
#define lua_register(n,f) (lua_pushcfunction(f), lua_setglobal(n))
#define lua_pushuserdata(u) lua_pushusertag(u, 0)
#define lua_pushcfunction(f) lua_pushcclosure(f, 0)
#define lua_clonetag(t) lua_copytagmethods(lua_newtag(), (t))
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
#ifndef LUA_REENTRANT
/*
** ===============================================================
** Macros for single-state use
** ===============================================================
*/
extern lua_State *lua_state;
#define lua_open() ((void)(lua_state?0:(lua_state=lua_newstate(0))))
#define lua_close() (lua_close)(lua_state)
#define lua_settagmethod(tag,event) (lua_settagmethod)(lua_state, tag,event)
#define lua_gettagmethod(tag,event) (lua_gettagmethod)(lua_state, tag,event)
#define lua_newtag() (lua_newtag)(lua_state)
#define lua_copytagmethods(tagto,tagfrom) \
(lua_copytagmethods)(lua_state, tagto,tagfrom)
#define lua_settag(tag) (lua_settag)(lua_state, tag)
#define lua_error(s) (lua_error)(lua_state, s)
#define lua_dofile(filename) (lua_dofile)(lua_state, filename)
#define lua_dostring(str) (lua_dostring)(lua_state, str)
#define lua_callfunction(f) (lua_callfunction)(lua_state, f)
#define lua_beginblock() (lua_beginblock)(lua_state)
#define lua_endblock() (lua_endblock)(lua_state)
#define lua_lua2C(number) (lua_lua2C)(lua_state, number)
#define lua_type(obj) (lua_type)(lua_state, obj)
#define lua_isnil(obj) (lua_isnil)(lua_state, obj)
#define lua_istable(obj) (lua_istable)(lua_state, obj)
#define lua_isuserdata(obj) (lua_isuserdata)(lua_state, obj)
#define lua_iscfunction(obj) (lua_iscfunction)(lua_state, obj)
#define lua_isnumber(obj) (lua_isnumber)(lua_state, obj)
#define lua_isstring(obj) (lua_isstring)(lua_state, obj)
#define lua_isfunction(obj) (lua_isfunction)(lua_state, obj)
#define lua_equal(o1,o2) (lua_equal)(lua_state, o1,o2)
#define lua_getnumber(obj) (lua_getnumber)(lua_state, obj)
#define lua_getstring(obj) (lua_getstring)(lua_state, obj)
#define lua_strlen(obj) (lua_strlen)(lua_state, obj)
#define lua_getcfunction(obj) (lua_getcfunction)(lua_state, obj)
#define lua_getuserdata(obj) (lua_getuserdata)(lua_state, obj)
#define lua_pushnil() (lua_pushnil)(lua_state)
#define lua_pushnumber(n) (lua_pushnumber)(lua_state, n)
#define lua_pushlstring(s,len) (lua_pushlstring)(lua_state, s,len)
#define lua_pushstring(s) (lua_pushstring)(lua_state, s)
#define lua_pushusertag(u,tag) (lua_pushusertag)(lua_state, u,tag)
#define lua_pushobject(obj) (lua_pushobject)(lua_state, obj)
#define lua_pop() (lua_pop)(lua_state)
#define lua_getglobal(name) (lua_getglobal)(lua_state, name)
#define lua_rawgetglobal(name) (lua_rawgetglobal)(lua_state, name)
#define lua_setglobal(name) (lua_setglobal)(lua_state, name)
#define lua_rawsetglobal(name) (lua_rawsetglobal)(lua_state, name)
#define lua_settable() (lua_settable)(lua_state)
#define lua_rawsettable() (lua_rawsettable)(lua_state)
#define lua_gettable() (lua_gettable)(lua_state)
#define lua_rawgettable() (lua_rawgettable)(lua_state)
#define lua_tag(obj) (lua_tag)(lua_state, obj)
#define lua_nextvar(varname) (lua_nextvar)(lua_state, varname)
#define lua_next(o,i) (lua_next)(lua_state, o,i)
#define lua_ref(lock) (lua_ref)(lua_state, lock)
#define lua_getref(ref) (lua_getref)(lua_state, ref)
#define lua_unref(ref) (lua_unref)(lua_state, ref)
#define lua_createtable() (lua_createtable)(lua_state)
#define lua_collectgarbage(limit) (lua_collectgarbage)(lua_state, limit)
/*
** the following typecast is a little dirty, but we know of no other
** way to keep compatibility with old definition of `lua_CFunction'
*/
#define lua_pushcclosure(fn,n) \
(lua_pushcclosure)(lua_state, (lua_CFunction)(fn), n)
#endif
#endif
/******************************************************************************
* Copyright (C) 1994-2000 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.
******************************************************************************/

View File

@@ -1,54 +0,0 @@
/*
** $Id: luadebug.h,v 1.9 2000/01/19 12:00:45 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);
int lua_getstack (lua_State *L, int level, lua_Debug *ar);
int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar);
int lua_getlocal (lua_State *L, const lua_Debug *ar, lua_Localvar *v);
int lua_setlocal (lua_State *L, const lua_Debug *ar, lua_Localvar *v);
int lua_setdebug (lua_State *L, int debug);
lua_Hook lua_setcallhook (lua_State *L, lua_Hook func);
lua_Hook lua_setlinehook (lua_State *L, lua_Hook func);
struct lua_Debug {
const char *event; /* `call', `return' */
const char *source; /* (S) */
int linedefined; /* (S) */
const char *what; /* (S) `Lua' function, `C' function, Lua `main' */
int currentline; /* (l) */
const char *name; /* (n) */
const char *namewhat; /* (n) global, tag method, local, field */
int nups; /* (u) number of upvalues */
lua_Object func; /* (f) function being executed */
/* private part */
lua_Object _func; /* active function */
};
struct lua_Localvar {
int index;
const char *name;
lua_Object value;
};
#endif

View File

@@ -1,45 +1,15 @@
/*
** $Id: lualib.h,v 1.7 1999/08/16 20:52:00 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"
void lua_iolibopen (lua_State *L);
void lua_strlibopen (lua_State *L);
void lua_mathlibopen (lua_State *L);
void lua_dblibopen (lua_State *L);
void lua_userinit (lua_State *L);
/*
** ===============================================================
** Macros for single-state use
** ===============================================================
*/
#ifndef LUA_REENTRANT
#define lua_iolibopen() (lua_iolibopen)(lua_state)
#define lua_strlibopen() (lua_strlibopen)(lua_state)
#define lua_mathlibopen() (lua_mathlibopen)(lua_state)
#define lua_dblibopen() (lua_dblibopen)(lua_state)
#define lua_userinit() (lua_userinit)(lua_state)
#endif
/* Auxiliary functions (private) */
const char *luaI_classend (lua_State *L, const char *p);
int luaI_singlematch (int c, const char *p, const char *ep);
void iolib_open (void);
void strlib_open (void);
void mathlib_open (void);
#endif

278
lundump.c
View File

@@ -1,278 +0,0 @@
/*
** $Id: lundump.c,v 1.28 2000/04/24 19:32:58 lhf Exp $
** load bytecodes from files
** See Copyright Notice in lua.h
*/
#include <stdio.h>
#include <string.h>
#define LUA_REENTRANT
#include "lauxlib.h"
#include "lfunc.h"
#include "lmem.h"
#include "lopcodes.h"
#include "lstring.h"
#include "lundump.h"
#define LoadBlock(L,b,size,Z) ezread(L,Z,b,size)
#define LoadByte ezgetc
static const char* ZNAME(ZIO* Z)
{
const char* s=zname(Z);
return (*s=='@') ? s+1 : s;
}
static void unexpectedEOZ (lua_State* L, ZIO* Z)
{
luaL_verror(L,"unexpected end of file in `%.255s'",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 unsigned int LoadWord (lua_State* L, ZIO* Z)
{
unsigned int hi=ezgetc(L,Z);
unsigned int lo=ezgetc(L,Z);
return (hi<<8)|lo;
}
static unsigned long LoadLong (lua_State* L, ZIO* Z)
{
unsigned long hi=LoadWord(L,Z);
unsigned long lo=LoadWord(L,Z);
return (hi<<16)|lo;
}
static Number LoadNumber (lua_State* L, ZIO* Z)
{
char b[256];
int size=ezgetc(L,Z);
LoadBlock(L,b,size,Z);
b[size]=0;
return luaU_str2d(L,b,ZNAME(Z));
}
static int LoadInt (lua_State* L, ZIO* Z, const char* message)
{
unsigned long l=LoadLong(L,Z);
unsigned int i=l;
if (i!=l) luaL_verror(L,"%s in `%.255s';\n"
" read %lu; expected %u",message,ZNAME(Z),l,-1);
return i;
}
static TString* LoadString (lua_State* L, ZIO* Z)
{
long size=LoadLong(L,Z);
if (size==0)
return NULL;
else
{
char* s=luaL_openspace(L,size);
LoadBlock(L,s,size,Z);
return luaS_newlstr(L,s,size-1); /* remove trailing '\0' */
}
}
static void SwapCode (lua_State* L, Instruction* code, int size, ZIO* Z)
{
unsigned char* p;
int c;
if (sizeof(Instruction)==4)
while (size--)
{
p=(unsigned char *) code++;
c=p[0]; p[0]=p[3]; p[3]=c;
c=p[1]; p[1]=p[2]; p[2]=c;
}
else if (sizeof(Instruction)==2)
while (size--)
{
p=(unsigned char *) code++;
c=p[0]; p[0]=p[1]; p[1]=c;
}
else
luaL_verror(L,"cannot swap code with %d-byte instructions in `%.255s'",
(int)sizeof(Instruction),ZNAME(Z));
}
static void LoadCode (lua_State* L, Proto* tf, ZIO* Z)
{
int size=LoadInt(L,Z,"code too long");
Instruction t=0,tt=TEST_CODE;
tf->code=luaM_newvector(L,size,Instruction);
LoadBlock(L,tf->code,size*sizeof(*tf->code),Z);
if (tf->code[size-1]!=OP_END) luaL_verror(L,"bad code in `%.255s'",ZNAME(Z));
LoadBlock(L,&t,sizeof(t),Z);
if (t!=tt)
{
Instruction ot=t;
SwapCode(L,&t,1,Z);
if (t!=tt) luaL_verror(L,"cannot swap code in `%.255s';\n"
" read 0x%08X; swapped to 0x%08X; expected 0x%08X",
ZNAME(Z),(unsigned long)ot,(unsigned long)t,(unsigned long)tt);
SwapCode(L,tf->code,size,Z);
}
}
static void LoadLocals (lua_State* L, Proto* tf, ZIO* Z)
{
int i,n=LoadInt(L,Z,"too many locals");
if (n==0) return;
tf->locvars=luaM_newvector(L,n+1,LocVar);
for (i=0; i<n; i++)
{
tf->locvars[i].line=LoadInt(L,Z,"too many lines");
tf->locvars[i].varname=LoadString(L,Z);
}
tf->locvars[i].line=-1; /* flag end of vector */
tf->locvars[i].varname=NULL;
}
static Proto* LoadFunction (lua_State* L, ZIO* Z, int native);
static void LoadConstants (lua_State* L, Proto* tf, ZIO* Z, int native)
{
int i,n;
tf->nkstr=n=LoadInt(L,Z,"too many strings");
if (n>0)
{
tf->kstr=luaM_newvector(L,n,TString*);
for (i=0; i<n; i++)
{
TString* s=LoadString(L,Z);
int isglobal=LoadByte(L,Z);
if (isglobal) luaS_assertglobal(L,s);
tf->kstr[i]=s;
}
}
tf->nknum=n=LoadInt(L,Z,"too many numbers");
if (n>0)
{
tf->knum=luaM_newvector(L,n,Number);
if (native)
LoadBlock(L,tf->knum,n*sizeof(*tf->knum),Z);
else
for (i=0; i<n; i++) tf->knum[i]=LoadNumber(L,Z);
}
tf->nkproto=n=LoadInt(L,Z,"too many functions");
if (n>0)
{
tf->kproto=luaM_newvector(L,n,Proto*);
for (i=0; i<n; i++) tf->kproto[i]=LoadFunction(L,Z,native);
}
}
static Proto* LoadFunction (lua_State* L, ZIO* Z, int native)
{
Proto* tf=luaF_newproto(L);
tf->source=LoadString(L,Z);
if (tf->source==NULL) tf->source=luaS_new(L,zname(Z));
tf->lineDefined=LoadInt(L,Z,"lineDefined too large");
tf->numparams=LoadInt(L,Z,"too many parameters");
tf->is_vararg=LoadByte(L,Z);
tf->maxstacksize=LoadInt(L,Z,"too much stack needed");
LoadCode(L,tf,Z);
LoadLocals(L,tf,Z);
LoadConstants(L,tf,Z,native);
return tf;
}
static void LoadSignature (lua_State* L, ZIO* Z)
{
const char* s=SIGNATURE;
while (*s!=0 && ezgetc(L,Z)==*s)
++s;
if (*s!=0) luaL_verror(L,"bad signature in `%.255s'",ZNAME(Z));
}
#define V(v) v/16,v%16
static int LoadHeader (lua_State* L, ZIO* Z)
{
int version,sizeofR,native;
LoadSignature(L,Z);
version=ezgetc(L,Z);
if (version>VERSION)
luaL_verror(L,"`%.255s' too new:\n"
" read version %d.%d; expected at most %d.%d",
ZNAME(Z),V(version),V(VERSION));
if (version<VERSION0) /* check last major change */
luaL_verror(L,"`%.255s' too old:\n"
" read version %d.%d; expected at least %d.%d",
ZNAME(Z),V(version),V(VERSION));
{
int I=ezgetc(L,Z);
int i=ezgetc(L,Z);
int op=ezgetc(L,Z);
int b=ezgetc(L,Z);
if (I!=sizeof(Instruction) || i!=SIZE_INSTRUCTION || op!=SIZE_OP || b!=SIZE_B)
luaL_verror(L,"virtual machine mismatch in `%.255s':\n"
" read %d-bit,%d-byte instructions, %d-bit opcodes, %d-bit b-arguments;\n"
" expected %d-bit,%d-byte instructions, %d-bit opcodes, %d-bit b-arguments",
ZNAME(Z),i,I,op,b,SIZE_INSTRUCTION,(int)sizeof(Instruction),SIZE_OP,SIZE_B);
}
sizeofR=ezgetc(L,Z);
native=(sizeofR!=0);
if (native) /* test number representation */
{
if (sizeofR!=sizeof(Number))
luaL_verror(L,"native number size mismatch in `%.255s':\n"
" read %d; expected %d",
ZNAME(Z),sizeofR,(int)sizeof(Number));
else
{
Number f=0,tf=TEST_NUMBER;
LoadBlock(L,&f,sizeof(f),Z);
if ((long)f!=(long)tf) /* disregard errors in last bit of fraction */
luaL_verror(L,"unknown number format in `%.255s':\n"
" read " NUMBER_FMT "; expected " NUMBER_FMT,
ZNAME(Z),f,tf);
}
}
return native;
}
static Proto* LoadChunk (lua_State* L, ZIO* Z)
{
return LoadFunction(L,Z,LoadHeader(L,Z));
}
/*
** load one chunk from a file or buffer
** return main if ok and NULL at EOF
*/
Proto* luaU_undump1 (lua_State* L, ZIO* Z)
{
int c=zgetc(Z);
if (c==ID_CHUNK)
return LoadChunk(L,Z);
else if (c!=EOZ)
luaL_verror(L,"`%.255s' is not a Lua binary file",ZNAME(Z));
return NULL;
}
/*
* convert number from text
*/
double luaU_str2d (lua_State* L, const char* b, const char* where)
{
double x;
if (!luaO_str2d(b,&x))
luaL_verror(L,"cannot convert number `%.255s' in `%.255s'",b,where);
return x;
}

View File

@@ -1,43 +0,0 @@
/*
** $Id: lundump.h,v 1.19 2000/04/24 17:32:29 lhf Exp $
** load pre-compiled Lua chunks
** See Copyright Notice in lua.h
*/
#ifndef lundump_h
#define lundump_h
#include "lobject.h"
#include "lzio.h"
/* load one chunk */
Proto* luaU_undump1 (lua_State* L, ZIO* Z);
/* convert number from text */
double luaU_str2d (lua_State* L, const char* b, const char* where);
/* definitions for headers of binary files */
#define VERSION 0x40 /* last format change was in 4.0 */
#define VERSION0 0x40 /* last major change was in 4.0 */
#define ID_CHUNK 27 /* binary files start with ESC... */
#define SIGNATURE "Lua" /* ...followed by this signature */
/* formats for error messages */
#define xSOURCE "<%d:%.255s>"
#define SOURCE "<%.255s:%d>"
#define IN " in %p " SOURCE
#define INLOC tf,tf->source->str,tf->lineDefined
/* format for numbers in listings and error messages */
#ifndef NUMBER_FMT
#define NUMBER_FMT "%.16g" /* LUA_NUMBER */
#endif
/* a multiple of PI for testing native format */
/* multiplying by 1E8 gives non-trivial integer values */
#define TEST_NUMBER 3.14159265358979323846E8
/* something for testing byte order in instructions */
#define TEST_CODE 0x01020304
#endif

673
lvm.c
View File

@@ -1,673 +0,0 @@
/*
** $Id: lvm.c,v 1.103 2000/04/14 17:45:25 roberto Exp roberto $
** Lua virtual machine
** See Copyright Notice in lua.h
*/
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#define LUA_REENTRANT
#include "lauxlib.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"
#ifdef OLD_ANSI
#define strcoll(a,b) strcmp(a,b)
#endif
/*
** Extra stack size to run a function:
** TAG_LINE(1), NAME(1), TM calls(3) (plus some extra...)
*/
#define EXTRA_STACK 8
int luaV_tonumber (TObject *obj) { /* LUA_NUMBER */
if (ttype(obj) != TAG_STRING)
return 1;
else {
if (!luaO_str2d(svalue(obj), &nvalue(obj)))
return 2;
ttype(obj) = TAG_NUMBER;
return 0;
}
}
int luaV_tostring (lua_State *L, TObject *obj) { /* LUA_NUMBER */
if (ttype(obj) != TAG_NUMBER)
return 1;
else {
char s[32]; /* 16 digits, sign, point and \0 (+ some extra...) */
sprintf(s, "%.16g", (double)nvalue(obj));
tsvalue(obj) = luaS_new(L, s);
ttype(obj) = TAG_STRING;
return 0;
}
}
void luaV_setn (lua_State *L, Hash *t, int val) {
TObject index, value;
ttype(&index) = TAG_STRING; tsvalue(&index) = luaS_new(L, "n");
ttype(&value) = TAG_NUMBER; nvalue(&value) = val;
luaH_set(L, t, &index, &value);
}
static Closure *luaV_closure (lua_State *L, lua_Type t, int nelems) {
Closure *c = luaF_newclosure(L, nelems);
L->top -= nelems;
while (nelems--)
c->consts[nelems] = *(L->top+nelems);
ttype(L->top) = t;
clvalue(L->top) = c;
incr_top;
return c;
}
void luaV_Cclosure (lua_State *L, lua_CFunction c, int nelems) {
Closure *cl = luaV_closure(L, TAG_CCLOSURE, nelems);
cl->f.c = c;
}
void luaV_Lclosure (lua_State *L, Proto *l, int nelems) {
Closure *cl = luaV_closure(L, TAG_LCLOSURE, nelems);
cl->f.l = l;
}
/*
** Function to index a table.
** Receives the table at top-2 and the index at top-1.
*/
void luaV_gettable (lua_State *L, StkId top) {
TObject *table = top-2;
const TObject *im;
if (ttype(table) != TAG_TABLE) { /* not a table, get gettable TM */
im = luaT_getimbyObj(L, table, IM_GETTABLE);
if (ttype(im) == TAG_NIL) {
L->top = top;
luaG_indexerror(L, table);
}
}
else { /* object is a table... */
int tg = table->value.a->htag;
im = luaT_getim(L, tg, IM_GETTABLE);
if (ttype(im) == TAG_NIL) { /* and does not have a `gettable' TM */
const TObject *h = luaH_get(L, avalue(table), table+1);
if (ttype(h) == TAG_NIL &&
(ttype(im=luaT_getim(L, tg, IM_INDEX)) != TAG_NIL)) {
/* result is nil and there is an `index' tag method */
L->top = top;
luaD_callTM(L, im, 2, 1); /* calls it */
}
else
*table = *h; /* `push' result into table position */
return;
}
/* else it has a `gettable' TM, go through to next command */
}
/* object is not a table, or it has a `gettable' TM */
L->top = top;
luaD_callTM(L, im, 2, 1);
}
/*
** Receives table at *t, index at *(t+1) and value at `top'.
*/
void luaV_settable (lua_State *L, StkId t, StkId top) {
const TObject *im;
if (ttype(t) != TAG_TABLE) { /* not a table, get `settable' method */
L->top = top;
im = luaT_getimbyObj(L, t, IM_SETTABLE);
if (ttype(im) == TAG_NIL)
luaG_indexerror(L, t);
}
else { /* object is a table... */
im = luaT_getim(L, avalue(t)->htag, IM_SETTABLE);
if (ttype(im) == TAG_NIL) { /* and does not have a `settable' method */
luaH_set(L, avalue(t), t+1, top-1);
return;
}
/* else it has a `settable' method, go through to next command */
}
/* object is not a table, or it has a `settable' method */
/* prepare arguments and call the tag method */
luaD_checkstack(L, 3);
*(top+2) = *(top-1);
*(top+1) = *(t+1);
*(top) = *t;
*(top-1) = *im;
L->top = top+3;
luaD_call(L, top-1, 0);
}
void luaV_rawsettable (lua_State *L, StkId t) {
if (ttype(t) != TAG_TABLE)
lua_error(L, "indexed expression not a table");
else {
luaH_set(L, avalue(t), t+1, L->top-1);
L->top -= 3;
}
}
void luaV_getglobal (lua_State *L, GlobalVar *gv, StkId top) {
const TObject *value = &gv->value;
TObject *im = luaT_getimbyObj(L, value, IM_GETGLOBAL);
if (ttype(im) == TAG_NIL) /* is there a tag method? */
*top = *value; /* default behavior */
else { /* tag method */
luaD_checkstack(L, 3);
*top = *im;
ttype(top+1) = TAG_STRING;
tsvalue(top+1) = gv->name; /* global name */
*(top+2) = *value;
L->top = top+3;
luaD_call(L, top, 1);
}
}
void luaV_setglobal (lua_State *L, GlobalVar *gv, StkId top) {
const TObject *oldvalue = &gv->value;
const TObject *im = luaT_getimbyObj(L, oldvalue, IM_SETGLOBAL);
if (ttype(im) == TAG_NIL) /* is there a tag method? */
gv->value = *(top-1);
else {
luaD_checkstack(L, 3);
*(top+2) = *(top-1); /* new value */
*(top+1) = *oldvalue;
ttype(top) = TAG_STRING;
tsvalue(top) = gv->name;
*(top-1) = *im;
L->top = top+3;
luaD_call(L, top-1, 0);
}
}
static void call_binTM (lua_State *L, StkId top, IMS event, const char *msg) {
/* try first operand */
const TObject *im = luaT_getimbyObj(L, top-2, event);
L->top = top;
if (ttype(im) == TAG_NIL) {
im = luaT_getimbyObj(L, top-1, event); /* try second operand */
if (ttype(im) == TAG_NIL) {
im = luaT_getim(L, 0, event); /* try a `global' method */
if (ttype(im) == TAG_NIL)
lua_error(L, msg);
}
}
lua_pushstring(L, luaT_eventname[event]);
luaD_callTM(L, im, 3, 1);
}
static void call_arith (lua_State *L, StkId top, IMS event) {
call_binTM(L, top, event, "unexpected type in arithmetic operation");
}
static void addK (lua_State *L, StkId top, int k) {
ttype(top) = TAG_NUMBER;
nvalue(top) = (Number)k;
call_arith(L, top+1, IM_ADD);
}
static int luaV_strcomp (const TString *ls, const TString *rs) {
const char *l = ls->str;
long ll = ls->u.s.len;
const char *r = rs->str;
long lr = rs->u.s.len;
for (;;) {
long temp = strcoll(l, r);
if (temp != 0) return temp;
/* strings are equal up to a '\0' */
temp = strlen(l); /* index of first '\0' in both strings */
if (temp == ll) /* l is finished? */
return (temp == lr) ? 0 : -1; /* l is equal or smaller than r */
else if (temp == lr) /* r is finished? */
return 1; /* l is greater than r (because l is not finished) */
/* both strings longer than temp; go on comparing (after the '\0') */
temp++;
l += temp; ll -= temp; r += temp; lr -= temp;
}
}
int luaV_lessthan (lua_State *L, const TObject *l, const TObject *r, StkId top) {
if (ttype(l) == TAG_NUMBER && ttype(r) == TAG_NUMBER)
return (nvalue(l) < nvalue(r));
else if (ttype(l) == TAG_STRING && ttype(r) == TAG_STRING)
return (luaV_strcomp(tsvalue(l), tsvalue(r)) < 0);
else { /* call TM */
luaD_checkstack(L, 2);
*top++ = *l;
*top++ = *r;
call_binTM(L, top, IM_LT, "unexpected type in comparison");
L->top--;
return (ttype(L->top) != TAG_NIL);
}
}
static void strconc (lua_State *L, int total, StkId top) {
do {
int n = 2; /* number of elements handled in this pass (at least 2) */
if (tostring(L, top-2) || tostring(L, top-1))
call_binTM(L, top, IM_CONCAT, "unexpected type for concatenation");
else if (tsvalue(top-1)->u.s.len > 0) { /* if len=0, do nothing */
/* at least two string values; get as many as possible */
long tl = tsvalue(top-1)->u.s.len + tsvalue(top-2)->u.s.len;
char *buffer;
int i;
while (n < total && !tostring(L, top-n-1)) { /* collect total length */
tl += tsvalue(top-n-1)->u.s.len;
n++;
}
buffer = luaL_openspace(L, tl);
tl = 0;
for (i=n; i>0; i--) { /* concat all strings */
long l = tsvalue(top-i)->u.s.len;
memcpy(buffer+tl, tsvalue(top-i)->str, l);
tl += l;
}
tsvalue(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 */
}
void luaV_pack (lua_State *L, StkId firstelem, int nvararg, TObject *tab) {
int i;
Hash *htab;
htab = avalue(tab) = luaH_new(L, nvararg+1); /* +1 for field `n' */
ttype(tab) = TAG_TABLE;
for (i=0; i<nvararg; i++)
luaH_setint(L, htab, i+1, firstelem+i);
luaV_setn(L, htab, nvararg); /* store counter in field `n' */
}
static void adjust_varargs (lua_State *L, StkId base, int nfixargs) {
TObject arg;
int nvararg = (L->top-base) - nfixargs;
if (nvararg < 0) {
luaV_pack(L, base, 0, &arg);
luaD_adjusttop(L, base, nfixargs);
}
else {
luaV_pack(L, base+nfixargs, nvararg, &arg);
L->top = base+nfixargs;
}
*L->top++ = arg;
}
/*
** 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 *tf = cl->f.l;
StkId top; /* keep top local, for performance */
const Instruction *pc = tf->code;
TString **kstr = tf->kstr;
luaD_checkstack(L, tf->maxstacksize+EXTRA_STACK);
if (tf->is_vararg) { /* varargs? */
adjust_varargs(L, base, tf->numparams);
luaC_checkGC(L);
}
else
luaD_adjusttop(L, base, tf->numparams);
top = L->top;
for (;;) {
Instruction i = *pc++;
switch (GET_OPCODE(i)) {
case OP_END:
return L->top; /* no results */
case OP_RETURN:
L->top = top;
return base+GETARG_U(i);
case OP_CALL:
L->top = top;
luaD_call(L, base+GETARG_A(i), GETARG_B(i));
top = L->top;
break;
case OP_TAILCALL:
L->top = top;
luaD_call(L, base+GETARG_A(i), MULT_RET);
return base+GETARG_B(i);
case OP_PUSHNIL: {
int n = GETARG_U(i);
LUA_ASSERT(L, n>0, "invalid argument");
do {
ttype(top++) = TAG_NIL;
} while (--n > 0);
break;
}
case OP_POP:
top -= GETARG_U(i);
break;
case OP_PUSHINT:
ttype(top) = TAG_NUMBER;
nvalue(top) = (Number)GETARG_S(i);
top++;
break;
case OP_PUSHSTRING:
ttype(top) = TAG_STRING;
tsvalue(top) = kstr[GETARG_U(i)];
top++;
break;
case OP_PUSHNUM:
ttype(top) = TAG_NUMBER;
nvalue(top) = tf->knum[GETARG_U(i)];
top++;
break;
case OP_PUSHNEGNUM:
ttype(top) = TAG_NUMBER;
nvalue(top) = -tf->knum[GETARG_U(i)];
top++;
break;
case OP_PUSHUPVALUE:
*top++ = cl->consts[GETARG_U(i)];
break;
case OP_GETLOCAL:
*top++ = *(base+GETARG_U(i));
break;
case OP_GETGLOBAL:
luaV_getglobal(L, kstr[GETARG_U(i)]->u.s.gv, top);
top++;
break;
case OP_GETTABLE:
luaV_gettable(L, top);
top--;
break;
case OP_GETDOTTED:
ttype(top) = TAG_STRING;
tsvalue(top++) = kstr[GETARG_U(i)];
luaV_gettable(L, top);
top--;
break;
case OP_GETINDEXED:
*top++ = *(base+GETARG_U(i));
luaV_gettable(L, top);
top--;
break;
case OP_PUSHSELF: {
TObject receiver;
receiver = *(top-1);
ttype(top) = TAG_STRING;
tsvalue(top++) = kstr[GETARG_U(i)];
luaV_gettable(L, top);
*(top-1) = receiver;
break;
}
case OP_CREATETABLE:
L->top = top;
luaC_checkGC(L);
avalue(top) = luaH_new(L, GETARG_U(i));
ttype(top) = TAG_TABLE;
top++;
break;
case OP_SETLOCAL:
*(base+GETARG_U(i)) = *(--top);
break;
case OP_SETGLOBAL:
luaV_setglobal(L, kstr[GETARG_U(i)]->u.s.gv, top);
top--;
break;
case OP_SETTABLE:
luaV_settable(L, top-GETARG_A(i), top);
top -= GETARG_B(i); /* pop values */
break;
case OP_SETLIST: {
int aux = GETARG_A(i) * LFIELDS_PER_FLUSH;
int n = GETARG_B(i)+1;
Hash *arr = avalue(top-n-1);
L->top = top-n; /* final value of `top' (in case of errors) */
for (; n; n--)
luaH_setint(L, arr, n+aux, --top);
break;
}
case OP_SETMAP: {
int n = GETARG_U(i);
StkId finaltop = top-2*(n+1);
Hash *arr = avalue(finaltop-1);
L->top = finaltop; /* final value of `top' (in case of errors) */
do {
luaH_set(L, arr, top-2, top-1);
top-=2;
} while (n--);
break;
}
case OP_ADD:
if (tonumber(top-1) || tonumber(top-2))
call_arith(L, top, IM_ADD);
else
nvalue(top-2) += nvalue(top-1);
top--;
break;
case OP_ADDI:
if (tonumber(top-1))
addK(L, top, GETARG_S(i));
else
nvalue(top-1) += (Number)GETARG_S(i);
break;
case OP_SUB:
if (tonumber(top-1) || tonumber(top-2))
call_arith(L, top, IM_SUB);
else
nvalue(top-2) -= nvalue(top-1);
top--;
break;
case OP_MULT:
if (tonumber(top-1) || tonumber(top-2))
call_arith(L, top, IM_MUL);
else
nvalue(top-2) *= nvalue(top-1);
top--;
break;
case OP_DIV:
if (tonumber(top-1) || tonumber(top-2))
call_arith(L, top, IM_DIV);
else
nvalue(top-2) /= nvalue(top-1);
top--;
break;
case OP_POW:
call_binTM(L, top, IM_POW, "undefined operation");
top--;
break;
case OP_CONCAT: {
int n = GETARG_U(i);
strconc(L, n, top);
top -= n-1;
L->top = top;
luaC_checkGC(L);
break;
}
case OP_MINUS:
if (tonumber(top-1)) {
ttype(top) = TAG_NIL;
call_arith(L, top+1, IM_UNM);
}
else
nvalue(top-1) = -nvalue(top-1);
break;
case OP_NOT:
ttype(top-1) =
(ttype(top-1) == TAG_NIL) ? TAG_NUMBER : TAG_NIL;
nvalue(top-1) = 1;
break;
case OP_JMPNE:
top -= 2;
if (!luaO_equalObj(top, top+1)) pc += GETARG_S(i);
break;
case OP_JMPEQ:
top -= 2;
if (luaO_equalObj(top, top+1)) pc += GETARG_S(i);
break;
case OP_JMPLT:
top -= 2;
if (luaV_lessthan(L, top, top+1, top+2)) pc += GETARG_S(i);
break;
case OP_JMPLE: /* a <= b === !(b<a) */
top -= 2;
if (!luaV_lessthan(L, top+1, top, top+2)) pc += GETARG_S(i);
break;
case OP_JMPGT: /* a > b === (b<a) */
top -= 2;
if (luaV_lessthan(L, top+1, top, top+2)) pc += GETARG_S(i);
break;
case OP_JMPGE: /* a >= b === !(a<b) */
top -= 2;
if (!luaV_lessthan(L, top, top+1, top+2)) pc += GETARG_S(i);
break;
case OP_JMPT:
if (ttype(--top) != TAG_NIL) pc += GETARG_S(i);
break;
case OP_JMPF:
if (ttype(--top) == TAG_NIL) pc += GETARG_S(i);
break;
case OP_JMPONT:
if (ttype(top-1) != TAG_NIL) pc += GETARG_S(i);
else top--;
break;
case OP_JMPONF:
if (ttype(top-1) == TAG_NIL) pc += GETARG_S(i);
else top--;
break;
case OP_JMP:
pc += GETARG_S(i);
break;
case OP_PUSHNILJMP:
ttype(top++) = TAG_NIL;
pc++;
break;
case OP_FORPREP:
if (tonumber(top-1))
lua_error(L, "`for' step must be a number");
if (tonumber(top-2))
lua_error(L, "`for' limit must be a number");
if (tonumber(top-3))
lua_error(L, "`for' initial value must be a number");
nvalue(top-3) -= nvalue(top-1); /* to be undone by first FORLOOP */
pc += GETARG_S(i);
break;
case OP_FORLOOP: {
Number step = nvalue(top-1);
Number limit = nvalue(top-2);
Number index;
LUA_ASSERT(L, ttype(top-1) == TAG_NUMBER, "invalid step");
LUA_ASSERT(L, ttype(top-2) == TAG_NUMBER, "invalid limit");
if (ttype(top-3) != TAG_NUMBER)
lua_error(L, "`for' index must be a number");
index = nvalue(top-3)+step;
if ((step>0) ? index<=limit : index>=limit) {
nvalue(top-3) = index;
pc += GETARG_S(i);
}
else /* end of `for': remove control variables */
top -= 3;
break;
}
case OP_CLOSURE:
L->top = top;
luaV_Lclosure(L, tf->kproto[GETARG_A(i)], GETARG_B(i));
top = L->top;
luaC_checkGC(L);
break;
case OP_SETLINE:
if ((base-1)->ttype != TAG_LINE) {
/* open space for LINE value */
int n = top-base;
while (n--) base[n+1] = base[n];
base++;
top++;
(base-1)->ttype = TAG_LINE;
}
(base-1)->value.i = GETARG_U(i);
if (L->linehook) {
L->top = top;
luaD_lineHook(L, base-2, GETARG_U(i));
}
break;
}
}
}

34
lvm.h
View File

@@ -1,34 +0,0 @@
/*
** $Id: lvm.h,v 1.20 2000/03/29 20:19:20 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 tonumber(o) ((ttype(o) != TAG_NUMBER) && (luaV_tonumber(o) != 0))
#define tostring(L,o) ((ttype(o) != TAG_STRING) && (luaV_tostring(L, o) != 0))
void luaV_pack (lua_State *L, StkId firstel, int nvararg, TObject *tab);
int luaV_tonumber (TObject *obj);
int luaV_tostring (lua_State *L, TObject *obj);
void luaV_setn (lua_State *L, Hash *t, int val);
void luaV_gettable (lua_State *L, StkId top);
void luaV_settable (lua_State *L, StkId t, StkId top);
void luaV_rawsettable (lua_State *L, StkId t);
void luaV_getglobal (lua_State *L, GlobalVar *gv, StkId top);
void luaV_setglobal (lua_State *L, GlobalVar *gv, StkId top);
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, StkId top);
#endif

82
lzio.c
View File

@@ -1,82 +0,0 @@
/*
** $Id: lzio.c,v 1.10 2000/02/08 16:39:42 roberto Exp roberto $
** a generic input stream interface
** See Copyright Notice in lua.h
*/
#include <stdio.h>
#include <string.h>
#include "lzio.h"
/* ----------------------------------------------------- memory buffers --- */
static int zmfilbuf (ZIO* z) {
(void)z; /* to avoid warnings */
return EOZ;
}
ZIO* zmopen (ZIO* z, const char* b, int 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) {
int 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 --- */
int zread (ZIO *z, void *b, int n) {
while (n) {
int m;
if (z->n == 0) {
if (z->filbuf(z) == EOZ)
return n; /* return number of missing bytes */
zungetc(z); /* put result from `filbuf' in the buffer */
}
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;
}

50
lzio.h
View File

@@ -1,50 +0,0 @@
/*
** $Id: lzio.h,v 1.4 1998/01/09 14:57:43 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, int size, const char *name); /* memory */
int zread (ZIO* z, void* b, int n); /* read next n bytes */
#define zgetc(z) (--(z)->n>=0 ? ((int)*(z)->p++): (z)->filbuf(z))
#define zungetc(z) (++(z)->n,--(z)->p)
#define zname(z) ((z)->name)
/* --------- Private Part ------------------ */
#define ZBSIZE 256 /* buffer size */
struct zio {
int n; /* bytes still unread */
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

154
makefile
View File

@@ -1,154 +0,0 @@
#
## $Id: makefile,v 1.24 2000/04/14 17:52:09 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)
#
# define LUA_COMPAT_READPATTERN if you need read patterns
# (only for compatibility with previous versions)
CONFIG = -DPOPEN -D_POSIX_SOURCE
#CONFIG = -DOLD_ANSI -DDEBUG -DLUA_COMPAT_READPATTERN
# Compilation parameters
CC = gcc
CWARNS = -Wall -W -Wmissing-prototypes -Wshadow -pedantic -Wpointer-arith -Wcast-align -Waggregate-return -Wcast-qual -Wnested-externs -Wwrite-strings
CFLAGS = $(CONFIG) $(CWARNS) -ansi -O2
# To make early versions
CO_OPTIONS =
AR = ar
ARFLAGS = rvl
# Aplication modules
LUAOBJS = \
lstate.o \
lref.o \
lapi.o \
lauxlib.o \
lbuiltin.o \
lmem.o \
lstring.o \
ltable.o \
ltm.o \
lvm.o \
ldo.o \
lobject.o \
lbuffer.o \
lfunc.o \
lgc.o \
lcode.o \
lparser.o \
llex.o \
lundump.o \
lzio.o \
ldebug.o \
ltests.o
LIBOBJS = \
liolib.o \
lmathlib.o \
lstrlib.o \
ldblib.o \
linit.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 lapi.h lobject.h llimits.h lua.h lauxlib.h ldo.h \
lstate.h luadebug.h lfunc.h lgc.h lmem.h lref.h lstring.h ltable.h \
ltm.h lvm.h
lauxlib.o: lauxlib.c lauxlib.h lua.h luadebug.h
lbuffer.o: lbuffer.c lauxlib.h lua.h lmem.h lstate.h lobject.h \
llimits.h luadebug.h
lbuiltin.o: lbuiltin.c lapi.h lobject.h llimits.h lua.h lauxlib.h \
lbuiltin.h ldo.h lstate.h luadebug.h lfunc.h lmem.h lstring.h \
ltable.h ltm.h lundump.h lzio.h lvm.h
lcode.o: lcode.c /usr/include/stdlib.h lcode.h llex.h lobject.h \
llimits.h lua.h lzio.h lopcodes.h lparser.h ldo.h lstate.h luadebug.h \
lmem.h lstring.h
ldblib.o: ldblib.c lauxlib.h lua.h luadebug.h lualib.h
ldebug.o: ldebug.c lapi.h lobject.h llimits.h lua.h lauxlib.h ldebug.h \
luadebug.h ldo.h lstate.h lfunc.h ltable.h ltm.h
ldo.o: ldo.c lauxlib.h lua.h ldebug.h lobject.h llimits.h luadebug.h \
ldo.h lstate.h lgc.h lmem.h lparser.h lzio.h lstring.h ltm.h \
lundump.h lvm.h
lfunc.o: lfunc.c lfunc.h lobject.h llimits.h lua.h lmem.h lstate.h \
luadebug.h
lgc.o: lgc.c ldo.h lobject.h llimits.h lua.h lstate.h luadebug.h \
lfunc.h lgc.h lmem.h lref.h lstring.h ltable.h ltm.h
linit.o: linit.c lua.h lualib.h
liolib.o: liolib.c lauxlib.h lua.h luadebug.h lualib.h
llex.o: llex.c lauxlib.h lua.h llex.h lobject.h llimits.h lzio.h \
lmem.h lparser.h lstate.h luadebug.h lstring.h
lmathlib.o: lmathlib.c lauxlib.h lua.h lualib.h
lmem.o: lmem.c lmem.h lua.h lobject.h llimits.h lstate.h luadebug.h
lobject.o: lobject.c lobject.h llimits.h lua.h
lparser.o: lparser.c lcode.h llex.h lobject.h llimits.h lua.h lzio.h \
lopcodes.h lparser.h ldo.h lstate.h luadebug.h lfunc.h lmem.h \
lstring.h
lref.o: lref.c lapi.h lobject.h llimits.h lua.h lmem.h lref.h lstate.h \
luadebug.h
lstate.o: lstate.c lauxlib.h lua.h lbuiltin.h ldo.h lobject.h \
llimits.h lstate.h luadebug.h lgc.h llex.h lzio.h lmem.h lref.h \
lstring.h ltm.h
lstring.o: lstring.c lmem.h lua.h lobject.h llimits.h lstate.h \
luadebug.h lstring.h
lstrlib.o: lstrlib.c lauxlib.h lua.h lualib.h
ltable.o: ltable.c lauxlib.h lua.h lmem.h lobject.h llimits.h lstate.h \
luadebug.h ltable.h
ltests.o: ltests.c lapi.h lobject.h llimits.h lua.h lauxlib.h lmem.h \
lopcodes.h lstate.h luadebug.h lstring.h ltable.h
ltm.o: ltm.c lauxlib.h lua.h lmem.h lobject.h llimits.h lstate.h \
luadebug.h ltm.h
lua.o: lua.c lua.h luadebug.h lualib.h
lundump.o: lundump.c lauxlib.h lua.h lfunc.h lobject.h llimits.h \
lmem.h lopcodes.h lstring.h lstate.h luadebug.h lundump.h lzio.h
lvm.o: lvm.c lauxlib.h lua.h ldebug.h lobject.h llimits.h luadebug.h \
ldo.h lstate.h lfunc.h lgc.h lopcodes.h lstring.h ltable.h ltm.h \
lvm.h
lzio.o: lzio.c lzio.h

3502
manual.tex

File diff suppressed because it is too large Load Diff

234
mathlib.c Normal file
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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"


1639
y_tab.c Normal file

File diff suppressed because it is too large Load Diff

35
y_tab.h Normal file
View 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