Compare commits

..

1 Commits
v1.2 ... v1.0

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
39 changed files with 4736 additions and 2369 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

View File

@@ -1,3 +0,0 @@
1d
x

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

144
hash.c
View File

@@ -2,15 +2,13 @@
** hash.c
** hash manager for lua
** Luiz Henrique de Figueiredo - 17 Aug 90
** Modified by Waldemar Celes Filho
** 12 May 93
*/
char *rcs_hash="$Id: hash.c,v 2.1 1994/04/20 22:07:57 celes Exp celes $";
#include <string.h>
#include <stdlib.h>
#include "mm.h"
#include "opcode.h"
#include "hash.h"
#include "inout.h"
@@ -26,20 +24,10 @@ char *rcs_hash="$Id: hash.c,v 2.1 1994/04/20 22:07:57 celes Exp celes $";
#define nhash(t) ((t)->nhash)
#define nodelist(t) ((t)->list)
#define list(t,i) ((t)->list[i])
#define markarray(t) ((t)->mark)
#define ref_tag(n) (tag(&(n)->ref))
#define ref_nvalue(n) (nvalue(&(n)->ref))
#define ref_svalue(n) (svalue(&(n)->ref))
typedef struct ArrayList
{
Hash *array;
struct ArrayList *next;
} ArrayList;
static ArrayList *listhead = NULL;
static int head (Hash *t, Object *ref) /* hash function */
{
if (tag(ref) == T_NUMBER) return (((int)nvalue(ref))%nhash(t));
@@ -101,7 +89,7 @@ static void freelist (Node *n)
/*
** Create a new hash. Return the hash pointer or NULL on error.
*/
static Hash *hashcreate (unsigned int nhash)
Hash *lua_hashcreate (unsigned int nhash)
{
Hash *t = new (Hash);
if (t == NULL)
@@ -123,7 +111,7 @@ static Hash *hashcreate (unsigned int nhash)
/*
** Delete a hash
*/
static void hashdelete (Hash *h)
void lua_hashdelete (Hash *h)
{
int i;
for (i=0; i<nhash(h); i++)
@@ -132,86 +120,6 @@ static void hashdelete (Hash *h)
free(h);
}
/*
** Mark a hash and check its elements
*/
void lua_hashmark (Hash *h)
{
if (markarray(h) == 0)
{
int i;
markarray(h) = 1;
for (i=0; i<nhash(h); i++)
{
Node *n;
for (n = list(h,i); n != NULL; n = n->next)
{
lua_markobject(&n->ref);
lua_markobject(&n->val);
}
}
}
}
/*
** Garbage collection to arrays
** Delete all unmarked arrays.
*/
void lua_hashcollector (void)
{
ArrayList *curr = listhead, *prev = NULL;
while (curr != NULL)
{
ArrayList *next = curr->next;
if (markarray(curr->array) != 1)
{
if (prev == NULL) listhead = next;
else prev->next = next;
hashdelete(curr->array);
free(curr);
}
else
{
markarray(curr->array) = 0;
prev = curr;
}
curr = next;
}
}
/*
** Create a new array
** This function insert the new array at array list. It also
** execute garbage collection if the number of array created
** exceed a pre-defined range.
*/
Hash *lua_createarray (int nhash)
{
ArrayList *new = new(ArrayList);
if (new == NULL)
{
lua_error ("not enough memory");
return NULL;
}
new->array = hashcreate(nhash);
if (new->array == NULL)
{
lua_error ("not enough memory");
return NULL;
}
if (lua_nentity == lua_block)
lua_pack();
lua_nentity++;
new->next = listhead;
listhead = new;
return new->array;
}
/*
** If the hash node is present, return its pointer, otherwise create a new
** node for the given reference and also return its pointer.
@@ -241,6 +149,26 @@ Object *lua_hashdefine (Hash *t, Object *ref)
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.
@@ -248,6 +176,7 @@ Object *lua_hashdefine (Hash *t, Object *ref)
** 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))
@@ -255,25 +184,11 @@ static void firstnode (Hash *a, int h)
int i;
for (i=h; i<nhash(a); i++)
{
if (list(a,i) != NULL)
if (list(a,i) != NULL && tag(&list(a,i)->val) != T_NIL)
{
if (tag(&list(a,i)->val) != T_NIL)
{
lua_pushobject (&list(a,i)->ref);
lua_pushobject (&list(a,i)->val);
return;
}
else
{
Node *next = list(a,i)->next;
while (next != NULL && tag(&next->val) == T_NIL) next = next->next;
if (next != NULL)
{
lua_pushobject (&next->ref);
lua_pushobject (&next->val);
return;
}
}
lua_pushobject (&list(a,i)->ref);
lua_pushobject (&list(a,i)->val);
return;
}
}
}
@@ -342,4 +257,3 @@ void lua_next (void)
}
}
}

11
hash.h
View File

@@ -2,7 +2,8 @@
** hash.h
** hash manager for lua
** Luiz Henrique de Figueiredo - 17 Aug 90
** $Id: hash.h,v 1.1 1993/12/17 18:41:19 celes Exp celes $
** Modified by Waldemar Celes Filho
** 26 Apr 93
*/
#ifndef hash_h
@@ -22,11 +23,13 @@ typedef struct Hash
Node **list;
} Hash;
#define markarray(t) ((t)->mark)
Hash *lua_createarray (int nhash);
void lua_hashmark (Hash *h);
void lua_hashcollector (void);
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

38
inout.c
View File

@@ -2,10 +2,12 @@
** inout.c
** Provide function to realise the input/output function and debugger
** facilities.
**
** Waldemar Celes Filho
** TeCGraf - PUC-Rio
** 11 May 93
*/
char *rcs_inout="$Id: inout.c,v 1.2 1993/12/22 21:15:16 roberto Exp celes $";
#include <stdio.h>
#include <string.h>
@@ -13,7 +15,6 @@ char *rcs_inout="$Id: inout.c,v 1.2 1993/12/22 21:15:16 roberto Exp celes $";
#include "hash.h"
#include "inout.h"
#include "table.h"
#include "tree.h"
/* Exported variables */
int lua_linenumber;
@@ -48,6 +49,14 @@ static int fileinput (void)
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
*/
@@ -57,6 +66,14 @@ static int stringinput (void)
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.
@@ -65,6 +82,7 @@ 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;
@@ -78,7 +96,6 @@ void lua_closefile (void)
{
if (fp != NULL)
{
lua_delfile();
fclose (fp);
fp = NULL;
}
@@ -91,6 +108,7 @@ int lua_openstring (char *s)
{
lua_linenumber = 1;
lua_setinput (stringinput);
lua_setunput (stringunput);
st = s;
{
char sn[64];
@@ -100,14 +118,6 @@ int lua_openstring (char *s)
return 0;
}
/*
** Function to close an opened string
*/
void lua_closestring (void)
{
lua_delfile();
}
/*
** Call user function to handle error messages, if registred. Or report error
** using standard function (fprintf).
@@ -158,12 +168,12 @@ void lua_reportbug (char *s)
{
sprintf (strchr(msg,0),
"\n\tin statement begining at line %d in function \"%s\" of file \"%s\"",
lua_debugline, lua_varname(funcstack[nfuncstack-1].function),
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",
lua_varname(funcstack[i].function),
s_name(funcstack[i].function),
lua_file[funcstack[i].file]);
}
else

View File

@@ -1,5 +1,9 @@
/*
** $Id: $
** inout.h
**
** Waldemar Celes Filho
** TeCGraf - PUC-Rio
** 11 May 93
*/
@@ -13,7 +17,6 @@ extern int lua_debugline;
int lua_openfile (char *fn);
void lua_closefile (void);
int lua_openstring (char *s);
void lua_closestring (void);
int lua_pushfunction (int file, int function);
void lua_popfunction (void);
void lua_reportbug (char *s);

122
iolib.c
View File

@@ -1,21 +1,20 @@
/*
** iolib.c
** Input/output library to LUA
**
** Waldemar Celes Filho
** TeCGraf - PUC-Rio
** 19 May 93
*/
char *rcs_iolib="$Id: iolib.c,v 1.3 1994/03/28 15:14:02 celes Exp celes $";
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
#include <ctype.h>
#include <sys/stat.h>
#ifdef __GNUC__
#include <floatingpoint.h>
#endif
#include "mm.h"
#include "lua.h"
static FILE *in=stdin, *out=stdout;
@@ -110,58 +109,6 @@ static void io_writeto (void)
}
/*
** Open a file to write appended.
** LUA interface:
** status = appendto (filename)
** where:
** status = 2 -> success (already exist)
** status = 1 -> success (new file)
** status = 0 -> error
*/
static void io_appendto (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 'appendto`");
lua_pushnumber (0);
}
else
{
int r;
FILE *fp;
struct stat st;
if (stat(lua_getstring(o), &st) == -1) r = 1;
else r = 2;
fp = fopen (lua_getstring(o),"a");
if (fp == NULL)
{
lua_pushnumber (0);
}
else
{
if (out != stdout) fclose (out);
out = fp;
lua_pushnumber (r);
}
}
}
}
/*
** Read a variable. On error put nil on stack.
** LUA interface:
@@ -179,7 +126,7 @@ static void io_appendto (void)
static void io_read (void)
{
lua_Object o = lua_getparam (1);
if (o == NULL || !lua_isstring(o)) /* free format */
if (o == NULL) /* free format */
{
int c;
char s[256];
@@ -187,31 +134,19 @@ static void io_read (void)
;
if (c == '\"')
{
int c, n=0;
while((c = fgetc(in)) != '\"')
if (fscanf (in, "%[^\"]\"", s) != 1)
{
if (c == EOF)
{
lua_pushnil ();
return;
}
s[n++] = c;
lua_pushnil ();
return;
}
s[n] = 0;
}
else if (c == '\'')
{
int c, n=0;
while((c = fgetc(in)) != '\'')
if (fscanf (in, "%[^\']\'", s) != 1)
{
if (c == EOF)
{
lua_pushnil ();
return;
}
s[n++] = c;
lua_pushnil ();
return;
}
s[n] = 0;
}
else
{
@@ -248,16 +183,7 @@ static void io_read (void)
char f[80];
char s[256];
sprintf (f, "%%%ds", m);
if (fgets (s, m, in) == NULL)
{
lua_pushnil();
return;
}
else
{
if (s[strlen(s)-1] == '\n')
s[strlen(s)-1] = 0;
}
fscanf (in, f, s);
switch (tolower(t))
{
case 'i':
@@ -286,25 +212,22 @@ static void io_read (void)
case 'i':
{
long int l;
if (fscanf (in, "%ld", &l) == EOF)
lua_pushnil();
else lua_pushnumber(l);
fscanf (in, "%ld", &l);
lua_pushnumber(l);
}
break;
case 'f': case 'g': case 'e':
{
float f;
if (fscanf (in, "%f", &f) == EOF)
lua_pushnil();
else lua_pushnumber(f);
fscanf (in, "%f", &f);
lua_pushnumber(f);
}
break;
default:
{
char s[256];
if (fscanf (in, "%s", s) == EOF)
lua_pushnil();
else lua_pushstring(s);
fscanf (in, "%s", s);
lua_pushstring(s);
}
break;
}
@@ -423,8 +346,8 @@ static void io_write (void)
}
/*
** Execute a executable program using "system".
** Return the result of execution.
** Execute a executable program using "sustem".
** On error put 0 on stack, otherwise put 1.
*/
void io_execute (void)
{
@@ -436,8 +359,8 @@ void io_execute (void)
}
else
{
int res = system(lua_getstring(o));
lua_pushnumber (res);
system(lua_getstring(o));
lua_pushnumber (1);
}
return;
}
@@ -471,7 +394,6 @@ void iolib_open (void)
{
lua_register ("readfrom", io_readfrom);
lua_register ("writeto", io_writeto);
lua_register ("appendto", io_appendto);
lua_register ("read", io_read);
lua_register ("write", io_write);
lua_register ("execute", io_execute);

233
lex.c
View File

@@ -1,233 +0,0 @@
char *rcs_lex = "$Id: lex.c,v 1.3 1993/12/28 16:42:29 roberto Exp celes $";
/*$Log: lex.c,v $
* Revision 1.3 1993/12/28 16:42:29 roberto
* "include"s de string.h e stdlib.h para evitar warnings
*
* Revision 1.2 1993/12/22 21:39:15 celes
* Tratamento do token $debug e $nodebug
*
* Revision 1.1 1993/12/22 21:15:16 roberto
* Initial revision
**/
#include <ctype.h>
#include <math.h>
#include <stdlib.h>
#include <string.h>
#include "opcode.h"
#include "hash.h"
#include "inout.h"
#include "table.h"
#include "y.tab.h"
#define next() { current = input(); }
#define save(x) { *yytextLast++ = (x); }
#define save_and_next() { save(current); next(); }
static int current;
static char yytext[256];
static char *yytextLast;
static Input input;
void lua_setinput (Input fn)
{
current = ' ';
input = fn;
}
char *lua_lasttext (void)
{
*yytextLast = 0;
return yytext;
}
static struct
{
char *name;
int token;
} reserved [] = {
{"and", AND},
{"do", DO},
{"else", ELSE},
{"elseif", ELSEIF},
{"end", END},
{"function", FUNCTION},
{"if", IF},
{"local", LOCAL},
{"nil", NIL},
{"not", NOT},
{"or", OR},
{"repeat", REPEAT},
{"return", RETURN},
{"then", THEN},
{"until", UNTIL},
{"while", WHILE} };
#define RESERVEDSIZE (sizeof(reserved)/sizeof(reserved[0]))
int findReserved (char *name)
{
int l = 0;
int h = RESERVEDSIZE - 1;
while (l <= h)
{
int m = (l+h)/2;
int comp = strcmp(name, reserved[m].name);
if (comp < 0)
h = m-1;
else if (comp == 0)
return reserved[m].token;
else
l = m+1;
}
return 0;
}
int yylex ()
{
while (1)
{
yytextLast = yytext;
switch (current)
{
case '\n': lua_linenumber++;
case ' ':
case '\t':
next();
continue;
case '$':
next();
while (isalnum(current) || current == '_')
save_and_next();
*yytextLast = 0;
if (strcmp(yytext, "debug") == 0)
{
yylval.vInt = 1;
return DEBUG;
}
else if (strcmp(yytext, "nodebug") == 0)
{
yylval.vInt = 0;
return DEBUG;
}
return WRONGTOKEN;
case '-':
save_and_next();
if (current != '-') return '-';
do { next(); } while (current != '\n' && current != 0);
continue;
case '<':
save_and_next();
if (current != '=') return '<';
else { save_and_next(); return LE; }
case '>':
save_and_next();
if (current != '=') return '>';
else { save_and_next(); return GE; }
case '~':
save_and_next();
if (current != '=') return '~';
else { save_and_next(); return NE; }
case '"':
case '\'':
{
int del = current;
next(); /* skip the delimiter */
while (current != del)
{
switch (current)
{
case 0:
case '\n':
return WRONGTOKEN;
case '\\':
next(); /* do not save the '\' */
switch (current)
{
case 'n': save('\n'); next(); break;
case 't': save('\t'); next(); break;
case 'r': save('\r'); next(); break;
default : save('\\'); break;
}
break;
default:
save_and_next();
}
}
next(); /* skip the delimiter */
*yytextLast = 0;
yylval.vWord = lua_findconstant (yytext);
return STRING;
}
case 'a': case 'b': case 'c': case 'd': case 'e':
case 'f': case 'g': case 'h': case 'i': case 'j':
case 'k': case 'l': case 'm': case 'n': case 'o':
case 'p': case 'q': case 'r': case 's': case 't':
case 'u': case 'v': case 'w': case 'x': case 'y':
case 'z':
case 'A': case 'B': case 'C': case 'D': case 'E':
case 'F': case 'G': case 'H': case 'I': case 'J':
case 'K': case 'L': case 'M': case 'N': case 'O':
case 'P': case 'Q': case 'R': case 'S': case 'T':
case 'U': case 'V': case 'W': case 'X': case 'Y':
case 'Z':
case '_':
{
int res;
do { save_and_next(); } while (isalnum(current) || current == '_');
*yytextLast = 0;
res = findReserved(yytext);
if (res) return res;
yylval.pChar = yytext;
return NAME;
}
case '.':
save_and_next();
if (current == '.')
{
save_and_next();
return CONC;
}
else if (!isdigit(current)) return '.';
/* current is a digit: goes through to number */
goto fraction;
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
do { save_and_next(); } while (isdigit(current));
if (current == '.') save_and_next();
fraction: while (isdigit(current)) save_and_next();
if (current == 'e' || current == 'E')
{
save_and_next();
if (current == '+' || current == '-') save_and_next();
if (!isdigit(current)) return WRONGTOKEN;
do { save_and_next(); } while (isdigit(current));
}
*yytextLast = 0;
yylval.vFloat = atof(yytext);
return NUMBER;
default: /* also end of file */
{
save_and_next();
return *yytext;
}
}
}
}

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);
}

55
lua.c
View File

@@ -1,31 +1,54 @@
/*
** lua.c
** Linguagem para Usuarios de Aplicacao
** TeCGraf - PUC-Rio
** 28 Apr 93
*/
char *rcs_lua="$Id: $";
#include <stdio.h>
#include "lua.h"
#include "lualib.h"
void main (int argc, char *argv[])
void test (void)
{
int i;
iolib_open ();
strlib_open ();
mathlib_open ();
if (argc < 2)
{
char buffer[250];
while (gets(buffer) != 0)
lua_dostring(buffer);
}
else
for (i=1; i<argc; i++)
lua_dofile (argv[i]);
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));
}
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);
}
}

2
lua.h
View File

@@ -2,7 +2,7 @@
** LUA - Linguagem para Usuarios de Aplicacao
** Grupo de Tecnologia em Computacao Grafica
** TeCGraf - PUC-Rio
** $Id: $
** 19 May 93
*/

85
lua.lex
View File

@@ -1,85 +0,0 @@
%{
char *rcs_lualex = "$Id: $";
#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;
}
%}
%%
[ \t]* ;
^"$debug" {yylval.vInt = 1; return DEBUG;}
^"$nodebug" {yylval.vInt = 0; return DEBUG;}
\n lua_linenumber++;
"--".* ;
"local" return LOCAL;
"if" return IF;
"then" return THEN;
"else" return ELSE;
"elseif" return ELSEIF;
"while" return WHILE;
"do" return DO;
"repeat" return REPEAT;
"until" return UNTIL;
"function" {
yylval.vWord = lua_nfile-1;
return FUNCTION;
}
"end" return END;
"return" return RETURN;
"local" return LOCAL;
"nil" return NIL;
"and" return AND;
"or" return OR;
"not" return NOT;
"~=" return NE;
"<=" return LE;
">=" return GE;
".." return CONC;
\"[^\"]*\" |
\'[^\']*\' {
yylval.vWord = lua_findenclosedconstant (yytext);
return STRING;
}
[0-9]+("."[0-9]*)? |
([0-9]+)?"."[0-9]+ |
[0-9]+("."[0-9]*)?[dDeEgG][+-]?[0-9]+ |
([0-9]+)?"."[0-9]+[dDeEgG][+-]?[0-9]+ {
yylval.vFloat = atof(yytext);
return NUMBER;
}
[a-zA-Z_][a-zA-Z0-9_]* {
yylval.vWord = lua_findsymbol (yytext);
return NAME;
}
. return *yytext;

954
lua.stx
View File

@@ -1,954 +0,0 @@
%{
char *rcs_luastx = "$Id: lua.stx,v 2.4 1994/04/20 16:22:21 celes Exp celes $";
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "mm.h"
#include "opcode.h"
#include "hash.h"
#include "inout.h"
#include "table.h"
#include "lua.h"
#define LISTING 0
#ifndef CODE_BLOCK
#define CODE_BLOCK 256
#endif
static Long maxcode;
static Long maxmain;
static Long maxcurr ;
static Byte *code = NULL;
static Byte *initcode;
static Byte *basepc;
static Long maincode;
static Long pc;
#define MAXVAR 32
static long varbuffer[MAXVAR]; /* variables in an assignment list;
it's long to store negative Word values */
static int nvarbuffer=0; /* number of variables at a list */
static Word localvar[STACKGAP]; /* store local variable names */
static int nlocalvar=0; /* number of local variables */
#define MAXFIELDS FIELDS_PER_FLUSH*2
static Word fields[MAXFIELDS]; /* fieldnames to be flushed */
static int nfields=0;
static int ntemp; /* number of temporary var into stack */
static int err; /* flag to indicate error */
/* Internal functions */
static void code_byte (Byte c)
{
if (pc>maxcurr-2) /* 1 byte free to code HALT of main code */
{
maxcurr *= 2;
basepc = (Byte *)realloc(basepc, maxcurr*sizeof(Byte));
if (basepc == NULL)
{
lua_error ("not enough memory");
err = 1;
}
}
basepc[pc++] = c;
}
static void code_word (Word n)
{
CodeWord code;
code.w = n;
code_byte(code.m.c1);
code_byte(code.m.c2);
}
static void code_float (float n)
{
CodeFloat code;
code.f = n;
code_byte(code.m.c1);
code_byte(code.m.c2);
code_byte(code.m.c3);
code_byte(code.m.c4);
}
static void code_word_at (Byte *p, Word n)
{
CodeWord code;
code.w = n;
*p++ = code.m.c1;
*p++ = code.m.c2;
}
static void push_field (Word name)
{
if (nfields < STACKGAP-1)
fields[nfields++] = name;
else
{
lua_error ("too many fields in a constructor");
err = 1;
}
}
static void flush_record (int n)
{
int i;
if (n == 0) return;
code_byte(STORERECORD);
code_byte(n);
for (i=0; i<n; i++)
code_word(fields[--nfields]);
ntemp -= n;
}
static void flush_list (int m, int n)
{
if (n == 0) return;
if (m == 0)
code_byte(STORELIST0);
else
{
code_byte(STORELIST);
code_byte(m);
}
code_byte(n);
ntemp-=n;
}
static void incr_ntemp (void)
{
if (ntemp+nlocalvar+MAXVAR+1 < STACKGAP)
ntemp++;
else
{
lua_error ("stack overflow");
err = 1;
}
}
static void add_nlocalvar (int n)
{
if (ntemp+nlocalvar+MAXVAR+n < STACKGAP)
nlocalvar += n;
else
{
lua_error ("too many local variables or expression too complicate");
err = 1;
}
}
static void incr_nvarbuffer (void)
{
if (nvarbuffer < MAXVAR-1)
nvarbuffer++;
else
{
lua_error ("variable buffer overflow");
err = 1;
}
}
static void code_number (float f)
{
Word i = (Word)f;
if (f == (float)i) /* f has an (short) integer value */
{
if (i <= 2) code_byte(PUSH0 + i);
else if (i <= 255)
{
code_byte(PUSHBYTE);
code_byte(i);
}
else
{
code_byte(PUSHWORD);
code_word(i);
}
}
else
{
code_byte(PUSHFLOAT);
code_float(f);
}
incr_ntemp();
}
%}
%union
{
int vInt;
float vFloat;
char *pChar;
Word vWord;
Long vLong;
Byte *pByte;
}
%start functionlist
%token WRONGTOKEN
%token NIL
%token IF THEN ELSE ELSEIF WHILE DO REPEAT UNTIL END
%token RETURN
%token LOCAL
%token <vFloat> NUMBER
%token <vWord> FUNCTION STRING
%token <pChar> NAME
%token <vInt> DEBUG
%type <vLong> PrepJump
%type <vInt> expr, exprlist, exprlist1, varlist1, typeconstructor
%type <vInt> fieldlist, localdeclist
%type <vInt> ffieldlist, ffieldlist1
%type <vInt> lfieldlist, lfieldlist1
%type <vLong> var, objectname
%left AND OR
%left '=' NE '>' '<' LE GE
%left CONC
%left '+' '-'
%left '*' '/'
%left UNARY NOT
%% /* beginning of rules section */
functionlist : /* empty */
| functionlist
{
pc=maincode; basepc=initcode; maxcurr=maxmain;
nlocalvar=0;
}
stat sc
{
maincode=pc; initcode=basepc; maxmain=maxcurr;
}
| functionlist function
| functionlist setdebug
;
function : FUNCTION NAME
{
if (code == NULL) /* first function */
{
code = (Byte *) calloc(CODE_BLOCK, sizeof(Byte));
if (code == NULL)
{
lua_error("not enough memory");
err = 1;
}
maxcode = CODE_BLOCK;
}
pc=0; basepc=code; maxcurr=maxcode;
nlocalvar=0;
$<vWord>$ = lua_findsymbol($2);
}
'(' parlist ')'
{
if (lua_debug)
{
code_byte(SETFUNCTION);
code_word(lua_nfile-1);
code_word($<vWord>3);
}
lua_codeadjust (0);
}
block
END
{
if (lua_debug) code_byte(RESET);
code_byte(RETCODE); code_byte(nlocalvar);
s_tag($<vWord>3) = T_FUNCTION;
s_bvalue($<vWord>3) = calloc (pc, sizeof(Byte));
if (s_bvalue($<vWord>3) == NULL)
{
lua_error("not enough memory");
err = 1;
}
memcpy (s_bvalue($<vWord>3), basepc, pc*sizeof(Byte));
code = basepc; maxcode=maxcurr;
#if LISTING
PrintCode(code,code+pc);
#endif
}
;
statlist : /* empty */
| statlist stat sc
;
stat : {
ntemp = 0;
if (lua_debug)
{
code_byte(SETLINE); code_word(lua_linenumber);
}
}
stat1
sc : /* empty */ | ';' ;
stat1 : IF expr1 THEN PrepJump block PrepJump elsepart END
{
{
Long elseinit = $6+sizeof(Word)+1;
if (pc - elseinit == 0) /* no else */
{
pc -= sizeof(Word)+1;
elseinit = pc;
}
else
{
basepc[$6] = JMP;
code_word_at(basepc+$6+1, pc - elseinit);
}
basepc[$4] = IFFJMP;
code_word_at(basepc+$4+1,elseinit-($4+sizeof(Word)+1));
}
}
| WHILE {$<vLong>$=pc;} expr1 DO PrepJump block PrepJump END
{
basepc[$5] = IFFJMP;
code_word_at(basepc+$5+1, pc - ($5 + sizeof(Word)+1));
basepc[$7] = UPJMP;
code_word_at(basepc+$7+1, pc - ($<vLong>2));
}
| REPEAT {$<vLong>$=pc;} block UNTIL expr1 PrepJump
{
basepc[$6] = IFFUPJMP;
code_word_at(basepc+$6+1, pc - ($<vLong>2));
}
| varlist1 '=' exprlist1
{
{
int i;
if ($3 == 0 || nvarbuffer != ntemp - $1 * 2)
lua_codeadjust ($1 * 2 + nvarbuffer);
for (i=nvarbuffer-1; i>=0; i--)
lua_codestore (i);
if ($1 > 1 || ($1 == 1 && varbuffer[0] != 0))
lua_codeadjust (0);
}
}
| functioncall { lua_codeadjust (0); }
| typeconstructor { lua_codeadjust (0); }
| LOCAL localdeclist decinit { add_nlocalvar($2); lua_codeadjust (0); }
;
elsepart : /* empty */
| ELSE block
| ELSEIF expr1 THEN PrepJump block PrepJump elsepart
{
{
Long elseinit = $6+sizeof(Word)+1;
if (pc - elseinit == 0) /* no else */
{
pc -= sizeof(Word)+1;
elseinit = pc;
}
else
{
basepc[$6] = JMP;
code_word_at(basepc+$6+1, pc - elseinit);
}
basepc[$4] = IFFJMP;
code_word_at(basepc+$4+1, elseinit - ($4 + sizeof(Word)+1));
}
}
;
block : {$<vInt>$ = nlocalvar;} statlist {ntemp = 0;} ret
{
if (nlocalvar != $<vInt>1)
{
nlocalvar = $<vInt>1;
lua_codeadjust (0);
}
}
;
ret : /* empty */
| { if (lua_debug){code_byte(SETLINE);code_word(lua_linenumber);}}
RETURN exprlist sc
{
if (lua_debug) code_byte(RESET);
code_byte(RETCODE); code_byte(nlocalvar);
}
;
PrepJump : /* empty */
{
$$ = pc;
code_byte(0); /* open space */
code_word (0);
}
expr1 : expr { if ($1 == 0) {lua_codeadjust (ntemp+1); incr_ntemp();}}
;
expr : '(' expr ')' { $$ = $2; }
| expr1 '=' expr1 { code_byte(EQOP); $$ = 1; ntemp--;}
| expr1 '<' expr1 { code_byte(LTOP); $$ = 1; ntemp--;}
| expr1 '>' expr1 { code_byte(LEOP); code_byte(NOTOP); $$ = 1; ntemp--;}
| expr1 NE expr1 { code_byte(EQOP); code_byte(NOTOP); $$ = 1; ntemp--;}
| expr1 LE expr1 { code_byte(LEOP); $$ = 1; ntemp--;}
| expr1 GE expr1 { code_byte(LTOP); code_byte(NOTOP); $$ = 1; ntemp--;}
| expr1 '+' expr1 { code_byte(ADDOP); $$ = 1; ntemp--;}
| expr1 '-' expr1 { code_byte(SUBOP); $$ = 1; ntemp--;}
| expr1 '*' expr1 { code_byte(MULTOP); $$ = 1; ntemp--;}
| expr1 '/' expr1 { code_byte(DIVOP); $$ = 1; ntemp--;}
| expr1 CONC expr1 { code_byte(CONCOP); $$ = 1; ntemp--;}
| '+' expr1 %prec UNARY { $$ = 1; }
| '-' expr1 %prec UNARY { code_byte(MINUSOP); $$ = 1;}
| typeconstructor { $$ = $1; }
| '@' '(' dimension ')'
{
code_byte(CREATEARRAY);
$$ = 1;
}
| var { lua_pushvar ($1); $$ = 1;}
| NUMBER { code_number($1); $$ = 1; }
| STRING
{
code_byte(PUSHSTRING);
code_word($1);
$$ = 1;
incr_ntemp();
}
| NIL {code_byte(PUSHNIL); $$ = 1; incr_ntemp();}
| functioncall
{
$$ = 0;
if (lua_debug)
{
code_byte(SETLINE); code_word(lua_linenumber);
}
}
| NOT expr1 { code_byte(NOTOP); $$ = 1;}
| expr1 AND PrepJump {code_byte(POP); ntemp--;} expr1
{
basepc[$3] = ONFJMP;
code_word_at(basepc+$3+1, pc - ($3 + sizeof(Word)+1));
$$ = 1;
}
| expr1 OR PrepJump {code_byte(POP); ntemp--;} expr1
{
basepc[$3] = ONTJMP;
code_word_at(basepc+$3+1, pc - ($3 + sizeof(Word)+1));
$$ = 1;
}
;
typeconstructor: '@'
{
code_byte(PUSHBYTE);
$<vLong>$ = pc; code_byte(0);
incr_ntemp();
code_byte(CREATEARRAY);
}
objectname fieldlist
{
basepc[$<vLong>2] = $4;
if ($3 < 0) /* there is no function to be called */
{
$$ = 1;
}
else
{
lua_pushvar ($3+1);
code_byte(PUSHMARK);
incr_ntemp();
code_byte(PUSHOBJECT);
incr_ntemp();
code_byte(CALLFUNC);
ntemp -= 4;
$$ = 0;
if (lua_debug)
{
code_byte(SETLINE); code_word(lua_linenumber);
}
}
}
;
dimension : /* empty */ { code_byte(PUSHNIL); incr_ntemp();}
| expr1
;
functioncall : functionvalue {code_byte(PUSHMARK); $<vInt>$ = ntemp; incr_ntemp();}
'(' exprlist ')' { code_byte(CALLFUNC); ntemp = $<vInt>2-1;}
functionvalue : var {lua_pushvar ($1); }
;
exprlist : /* empty */ { $$ = 1; }
| exprlist1 { $$ = $1; }
;
exprlist1 : expr { $$ = $1; }
| exprlist1 ',' {if (!$1){lua_codeadjust (ntemp+1); incr_ntemp();}}
expr {$$ = $4;}
;
parlist : /* empty */
| parlist1
;
parlist1 : NAME
{
localvar[nlocalvar]=lua_findsymbol($1);
add_nlocalvar(1);
}
| parlist1 ',' NAME
{
localvar[nlocalvar]=lua_findsymbol($3);
add_nlocalvar(1);
}
;
objectname : /* empty */ {$$=-1;}
| NAME {$$=lua_findsymbol($1);}
;
fieldlist : '{' ffieldlist '}'
{
flush_record($2%FIELDS_PER_FLUSH);
$$ = $2;
}
| '[' lfieldlist ']'
{
flush_list($2/FIELDS_PER_FLUSH, $2%FIELDS_PER_FLUSH);
$$ = $2;
}
;
ffieldlist : /* empty */ { $$ = 0; }
| ffieldlist1 { $$ = $1; }
;
ffieldlist1 : ffield {$$=1;}
| ffieldlist1 ',' ffield
{
$$=$1+1;
if ($$%FIELDS_PER_FLUSH == 0) flush_record(FIELDS_PER_FLUSH);
}
;
ffield : NAME {$<vWord>$ = lua_findconstant($1);} '=' expr1
{
push_field($<vWord>2);
}
;
lfieldlist : /* empty */ { $$ = 0; }
| lfieldlist1 { $$ = $1; }
;
lfieldlist1 : expr1 {$$=1;}
| lfieldlist1 ',' expr1
{
$$=$1+1;
if ($$%FIELDS_PER_FLUSH == 0)
flush_list($$/FIELDS_PER_FLUSH - 1, FIELDS_PER_FLUSH);
}
;
varlist1 : var
{
nvarbuffer = 0;
varbuffer[nvarbuffer] = $1; incr_nvarbuffer();
$$ = ($1 == 0) ? 1 : 0;
}
| varlist1 ',' var
{
varbuffer[nvarbuffer] = $3; incr_nvarbuffer();
$$ = ($3 == 0) ? $1 + 1 : $1;
}
;
var : NAME
{
Word s = lua_findsymbol($1);
int local = lua_localname (s);
if (local == -1) /* global var */
$$ = s + 1; /* return positive value */
else
$$ = -(local+1); /* return negative value */
}
| var {lua_pushvar ($1);} '[' expr1 ']'
{
$$ = 0; /* indexed variable */
}
| var {lua_pushvar ($1);} '.' NAME
{
code_byte(PUSHSTRING);
code_word(lua_findconstant($4)); incr_ntemp();
$$ = 0; /* indexed variable */
}
;
localdeclist : NAME {localvar[nlocalvar]=lua_findsymbol($1); $$ = 1;}
| localdeclist ',' NAME
{
localvar[nlocalvar+$1]=lua_findsymbol($3);
$$ = $1+1;
}
;
decinit : /* empty */
| '=' exprlist1
;
setdebug : DEBUG {lua_debug = $1;}
%%
/*
** Search a local name and if find return its index. If do not find return -1
*/
static int lua_localname (Word n)
{
int i;
for (i=nlocalvar-1; i >= 0; i--)
if (n == localvar[i]) return i; /* local var */
return -1; /* global var */
}
/*
** Push a variable given a number. If number is positive, push global variable
** indexed by (number -1). If negative, push local indexed by ABS(number)-1.
** Otherwise, if zero, push indexed variable (record).
*/
static void lua_pushvar (long number)
{
if (number > 0) /* global var */
{
code_byte(PUSHGLOBAL);
code_word(number-1);
incr_ntemp();
}
else if (number < 0) /* local var */
{
number = (-number) - 1;
if (number < 10) code_byte(PUSHLOCAL0 + number);
else
{
code_byte(PUSHLOCAL);
code_byte(number);
}
incr_ntemp();
}
else
{
code_byte(PUSHINDEXED);
ntemp--;
}
}
static void lua_codeadjust (int n)
{
code_byte(ADJUST);
code_byte(n + nlocalvar);
}
static void lua_codestore (int i)
{
if (varbuffer[i] > 0) /* global var */
{
code_byte(STOREGLOBAL);
code_word(varbuffer[i]-1);
}
else if (varbuffer[i] < 0) /* local var */
{
int number = (-varbuffer[i]) - 1;
if (number < 10) code_byte(STORELOCAL0 + number);
else
{
code_byte(STORELOCAL);
code_byte(number);
}
}
else /* indexed var */
{
int j;
int upper=0; /* number of indexed variables upper */
int param; /* number of itens until indexed expression */
for (j=i+1; j <nvarbuffer; j++)
if (varbuffer[j] == 0) upper++;
param = upper*2 + i;
if (param == 0)
code_byte(STOREINDEXED0);
else
{
code_byte(STOREINDEXED);
code_byte(param);
}
}
}
void yyerror (char *s)
{
static char msg[256];
sprintf (msg,"%s near \"%s\" at line %d in file \"%s\"",
s, lua_lasttext (), lua_linenumber, lua_filename());
lua_error (msg);
err = 1;
}
int yywrap (void)
{
return 1;
}
/*
** Parse LUA code and execute global statement.
** Return 0 on success or 1 on error.
*/
int lua_parse (void)
{
Byte *init = initcode = (Byte *) calloc(CODE_BLOCK, sizeof(Byte));
maincode = 0;
maxmain = CODE_BLOCK;
if (init == NULL)
{
lua_error("not enough memory");
return 1;
}
err = 0;
if (yyparse () || (err==1)) return 1;
initcode[maincode++] = HALT;
init = initcode;
#if LISTING
PrintCode(init,init+maincode);
#endif
if (lua_execute (init)) return 1;
free(init);
return 0;
}
#if LISTING
static void PrintCode (Byte *code, Byte *end)
{
Byte *p = code;
printf ("\n\nCODE\n");
while (p != end)
{
switch ((OpCode)*p)
{
case PUSHNIL: printf ("%d PUSHNIL\n", (p++)-code); break;
case PUSH0: case PUSH1: case PUSH2:
printf ("%d PUSH%c\n", p-code, *p-PUSH0+'0');
p++;
break;
case PUSHBYTE:
printf ("%d PUSHBYTE %d\n", p-code, *(++p));
p++;
break;
case PUSHWORD:
{
CodeWord c;
int n = p-code;
p++;
get_word(c,p);
printf ("%d PUSHWORD %d\n", n, c.w);
}
break;
case PUSHFLOAT:
{
CodeFloat c;
int n = p-code;
p++;
get_float(c,p);
printf ("%d PUSHFLOAT %f\n", n, c.f);
}
break;
case PUSHSTRING:
{
CodeWord c;
int n = p-code;
p++;
get_word(c,p);
printf ("%d PUSHSTRING %d\n", n, c.w);
}
break;
case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2: case PUSHLOCAL3:
case PUSHLOCAL4: case PUSHLOCAL5: case PUSHLOCAL6: case PUSHLOCAL7:
case PUSHLOCAL8: case PUSHLOCAL9:
printf ("%d PUSHLOCAL%c\n", p-code, *p-PUSHLOCAL0+'0');
p++;
break;
case PUSHLOCAL: printf ("%d PUSHLOCAL %d\n", p-code, *(++p));
p++;
break;
case PUSHGLOBAL:
{
CodeWord c;
int n = p-code;
p++;
get_word(c,p);
printf ("%d PUSHGLOBAL %d\n", n, c.w);
}
break;
case PUSHINDEXED: printf ("%d PUSHINDEXED\n", (p++)-code); break;
case PUSHMARK: printf ("%d PUSHMARK\n", (p++)-code); break;
case PUSHOBJECT: printf ("%d PUSHOBJECT\n", (p++)-code); break;
case STORELOCAL0: case STORELOCAL1: case STORELOCAL2: case STORELOCAL3:
case STORELOCAL4: case STORELOCAL5: case STORELOCAL6: case STORELOCAL7:
case STORELOCAL8: case STORELOCAL9:
printf ("%d STORELOCAL%c\n", p-code, *p-STORELOCAL0+'0');
p++;
break;
case STORELOCAL:
printf ("%d STORELOCAL %d\n", p-code, *(++p));
p++;
break;
case STOREGLOBAL:
{
CodeWord c;
int n = p-code;
p++;
get_word(c,p);
printf ("%d STOREGLOBAL %d\n", n, c.w);
}
break;
case STOREINDEXED0: printf ("%d STOREINDEXED0\n", (p++)-code); break;
case STOREINDEXED: printf ("%d STOREINDEXED %d\n", p-code, *(++p));
p++;
break;
case STORELIST0:
printf("%d STORELIST0 %d\n", p-code, *(++p));
p++;
break;
case STORELIST:
printf("%d STORELIST %d %d\n", p-code, *(p+1), *(p+2));
p+=3;
break;
case STORERECORD:
printf("%d STORERECORD %d\n", p-code, *(++p));
p += *p*sizeof(Word) + 1;
break;
case ADJUST:
printf ("%d ADJUST %d\n", p-code, *(++p));
p++;
break;
case CREATEARRAY: printf ("%d CREATEARRAY\n", (p++)-code); break;
case EQOP: printf ("%d EQOP\n", (p++)-code); break;
case LTOP: printf ("%d LTOP\n", (p++)-code); break;
case LEOP: printf ("%d LEOP\n", (p++)-code); break;
case ADDOP: printf ("%d ADDOP\n", (p++)-code); break;
case SUBOP: printf ("%d SUBOP\n", (p++)-code); break;
case MULTOP: printf ("%d MULTOP\n", (p++)-code); break;
case DIVOP: printf ("%d DIVOP\n", (p++)-code); break;
case CONCOP: printf ("%d CONCOP\n", (p++)-code); break;
case MINUSOP: printf ("%d MINUSOP\n", (p++)-code); break;
case NOTOP: printf ("%d NOTOP\n", (p++)-code); break;
case ONTJMP:
{
CodeWord c;
int n = p-code;
p++;
get_word(c,p);
printf ("%d ONTJMP %d\n", n, c.w);
}
break;
case ONFJMP:
{
CodeWord c;
int n = p-code;
p++;
get_word(c,p);
printf ("%d ONFJMP %d\n", n, c.w);
}
break;
case JMP:
{
CodeWord c;
int n = p-code;
p++;
get_word(c,p);
printf ("%d JMP %d\n", n, c.w);
}
break;
case UPJMP:
{
CodeWord c;
int n = p-code;
p++;
get_word(c,p);
printf ("%d UPJMP %d\n", n, c.w);
}
break;
case IFFJMP:
{
CodeWord c;
int n = p-code;
p++;
get_word(c,p);
printf ("%d IFFJMP %d\n", n, c.w);
}
break;
case IFFUPJMP:
{
CodeWord c;
int n = p-code;
p++;
get_word(c,p);
printf ("%d IFFUPJMP %d\n", n, c.w);
}
break;
case POP: printf ("%d POP\n", (p++)-code); break;
case CALLFUNC: printf ("%d CALLFUNC\n", (p++)-code); break;
case RETCODE:
printf ("%d RETCODE %d\n", p-code, *(++p));
p++;
break;
case HALT: printf ("%d HALT\n", (p++)-code); break;
case SETFUNCTION:
{
CodeWord c1, c2;
int n = p-code;
p++;
get_word(c1,p);
get_word(c2,p);
printf ("%d SETFUNCTION %d %d\n", n, c1.w, c2.w);
}
break;
case SETLINE:
{
CodeWord c;
int n = p-code;
p++;
get_word(c,p);
printf ("%d SETLINE %d\n", n, c.w);
}
break;
case RESET: printf ("%d RESET\n", (p++)-code); break;
default: printf ("%d Cannot happen: code %d\n", (p++)-code, *(p-1)); break;
}
}
}
#endif

View File

@@ -1,8 +1,8 @@
/*
** Libraries to be used in LUA programs
** Libraries to use in LUA programs
** Grupo de Tecnologia em Computacao Grafica
** TeCGraf - PUC-Rio
** $Id: $
** 19 May 93
*/
#ifndef lualib_h
@@ -13,4 +13,3 @@ void strlib_open (void);
void mathlib_open (void);
#endif

View File

@@ -1,53 +0,0 @@
# $Id: makefile,v 1.5 1994/01/10 19:49:56 roberto Exp celes $
# Compilation parameters
CC = gcc
CFLAGS = -I/usr/5include -Wall -O2
AR = ar
ARFLAGS = rvl
# Aplication modules
LUAMOD = \
y.tab \
lex \
opcode \
hash \
table \
inout \
tree
LIBMOD = \
iolib \
strlib \
mathlib
LUAOBJS = $(LUAMOD:%=%.o)
LIBOBJS = $(LIBMOD:%=%.o)
lua : lua.o lua.a lualib.a
$(CC) $(CFLAGS) -o $@ lua.c lua.a lualib.a -lm
lua.a : y.tab.c $(LUAOBJS)
$(AR) $(ARFLAGS) $@ $?
ranlib lua.a
lualib.a : $(LIBOBJS)
$(AR) $(ARFLAGS) $@ $?
ranlib $@
.KEEP_STATE:
liblua.so.1.0 : lua.o
ld -o liblua.so.1.0 $(LUAOBJS)
%.o : %.c
$(CC) $(CFLAGS) -c -o $@ $<
y.tab.c : lua.stx exscript
yacc -d lua.stx ; ex y.tab.c <exscript
% : RCS/%,v
co $@

View File

@@ -1,18 +1,17 @@
/*
** mathlib.c
** Mathematics library to LUA
** Mathematica library to LUA
**
** Waldemar Celes Filho
** TeCGraf - PUC-Rio
** 19 May 93
*/
char *rcs_mathlib="$Id: $";
#include <stdio.h> /* NULL */
#include <math.h>
#include "lua.h"
#define TODEGREE(a) ((a)*180.0/3.14159)
#define TORAD(a) ((a)*3.14159/180.0)
static void math_abs (void)
{
double d;
@@ -36,7 +35,7 @@ static void math_sin (void)
if (!lua_isnumber(o))
{ lua_error ("incorrect arguments to function `sin'"); return; }
d = lua_getnumber(o);
lua_pushnumber (sin(TORAD(d)));
lua_pushnumber (sin(d));
}
@@ -50,7 +49,7 @@ static void math_cos (void)
if (!lua_isnumber(o))
{ lua_error ("incorrect arguments to function `cos'"); return; }
d = lua_getnumber(o);
lua_pushnumber (cos(TORAD(d)));
lua_pushnumber (cos(d));
}
@@ -64,7 +63,7 @@ static void math_tan (void)
if (!lua_isnumber(o))
{ lua_error ("incorrect arguments to function `tan'"); return; }
d = lua_getnumber(o);
lua_pushnumber (tan(TORAD(d)));
lua_pushnumber (tan(d));
}
@@ -77,7 +76,7 @@ static void math_asin (void)
if (!lua_isnumber(o))
{ lua_error ("incorrect arguments to function `asin'"); return; }
d = lua_getnumber(o);
lua_pushnumber (TODEGREE(asin(d)));
lua_pushnumber (asin(d));
}
@@ -90,7 +89,7 @@ static void math_acos (void)
if (!lua_isnumber(o))
{ lua_error ("incorrect arguments to function `acos'"); return; }
d = lua_getnumber(o);
lua_pushnumber (TODEGREE(acos(d)));
lua_pushnumber (acos(d));
}
@@ -104,7 +103,7 @@ static void math_atan (void)
if (!lua_isnumber(o))
{ lua_error ("incorrect arguments to function `atan'"); return; }
d = lua_getnumber(o);
lua_pushnumber (TODEGREE(atan(d)));
lua_pushnumber (atan(d));
}

View File

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

39
mm.h
View File

@@ -1,39 +0,0 @@
/*
** mm.h
** Waldemar Celes Filho
** Sep 16, 1992
*/
#ifndef mm_h
#define mm_h
#include <stdlib.h>
#ifdef _MM_
/* switch off the debugger functions */
#define malloc(s) MmMalloc(s,__FILE__,__LINE__)
#define calloc(n,s) MmCalloc(n,s,__FILE__,__LINE__)
#define realloc(a,s) MmRealloc(a,s,__FILE__,__LINE__,#a)
#define free(a) MmFree(a,__FILE__,__LINE__,#a)
#define strdup(s) MmStrdup(s,__FILE__,__LINE__)
#endif
typedef void (*Ferror) (char *);
/* Exported functions */
void MmInit (Ferror f, Ferror w);
void *MmMalloc (unsigned size, char *file, int line);
void *MmCalloc (unsigned n, unsigned size, char *file, int line);
void MmFree (void *a, char *file, int line, char *var);
void *MmRealloc (void *old, unsigned size, char *file, int line, char *var);
char *MmStrdup (char *s, char *file, int line);
unsigned MmGetBytes (void);
void MmListAllocated (void);
void MmCheck (void);
void MmStatistics (void);
#endif

359
opcode.c
View File

@@ -1,10 +1,9 @@
/*
** opcode.c
** TecCGraf - PUC-Rio
** 26 Apr 93
*/
char *rcs_opcode="$Id: opcode.c,v 2.1 1994/04/20 22:07:57 celes Exp celes $";
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
@@ -12,8 +11,6 @@ char *rcs_opcode="$Id: opcode.c,v 2.1 1994/04/20 22:07:57 celes Exp celes $";
#include <floatingpoint.h>
#endif
#include "mm.h"
#include "opcode.h"
#include "hash.h"
#include "inout.h"
@@ -23,55 +20,11 @@ char *rcs_opcode="$Id: opcode.c,v 2.1 1994/04/20 22:07:57 celes Exp celes $";
#define tonumber(o) ((tag(o) != T_NUMBER) && (lua_tonumber(o) != 0))
#define tostring(o) ((tag(o) != T_STRING) && (lua_tostring(o) != 0))
#define STACK_BUFFER (STACKGAP+128)
static Word maxstack;
static Object *stack=NULL;
static Object *top, *base;
/*
** Init stack
*/
static int lua_initstack (void)
{
maxstack = STACK_BUFFER;
stack = (Object *)calloc(maxstack, sizeof(Object));
if (stack == NULL)
{
lua_error("stack - not enough memory");
return 1;
}
tag(stack) = T_MARK;
top = base = stack+1;
return 0;
}
/*
** Check stack overflow and, if necessary, realloc vector
*/
static int lua_checkstack (Word n)
{
if (stack == NULL)
return lua_initstack();
if (n > maxstack)
{
Word t = top-stack;
Word b = base-stack;
maxstack *= 2;
stack = (Object *)realloc(stack, maxstack*sizeof(Object));
if (stack == NULL)
{
lua_error("stack - not enough memory");
return 1;
}
top = stack + t;
base = stack + b;
}
return 0;
}
#ifndef MAXSTACK
#define MAXSTACK 256
#endif
static Object stack[MAXSTACK] = {{T_MARK, {NULL}}};
static Object *top=stack+1, *base=stack+1;
/*
@@ -80,14 +33,30 @@ static int lua_checkstack (Word n)
*/
static char *lua_strconc (char *l, char *r)
{
static char buffer[1024];
int n = strlen(l)+strlen(r)+1;
if (n > 1024)
char *s = calloc (strlen(l)+strlen(r)+2, sizeof(char));
if (s == NULL)
{
lua_error ("string too large");
lua_error ("not enough memory");
return NULL;
}
return strcat(strcpy(buffer,l),r);
*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);
}
/*
@@ -155,7 +124,7 @@ static int lua_tostring (Object *obj)
sprintf (s, "%d", (int) nvalue(obj));
else
sprintf (s, "%g", nvalue(obj));
svalue(obj) = lua_createstring(s);
svalue(obj) = lua_createstring(lua_strdup(s));
if (svalue(obj) == NULL)
return 1;
tag(obj) = T_STRING;
@@ -168,18 +137,12 @@ static int lua_tostring (Object *obj)
*/
int lua_execute (Byte *pc)
{
Word oldbase;
if (stack == NULL)
lua_initstack();
oldbase = base-stack;
base = top;
while (1)
{
OpCode opcode;
switch (opcode = (OpCode)*pc++)
switch ((OpCode)*pc++)
{
case NOP: break;
case PUSHNIL: tag(top++) = T_NIL; break;
case PUSH0: tag(top) = T_NUMBER; nvalue(top++) = 0; break;
@@ -189,42 +152,35 @@ int lua_execute (Byte *pc)
case PUSHBYTE: tag(top) = T_NUMBER; nvalue(top++) = *pc++; break;
case PUSHWORD:
{
CodeWord code;
get_word(code,pc);
tag(top) = T_NUMBER; nvalue(top++) = code.w;
}
tag(top) = T_NUMBER; nvalue(top++) = *((Word *)(pc)); pc += sizeof(Word);
break;
case PUSHFLOAT:
{
CodeFloat code;
get_float(code,pc);
tag(top) = T_NUMBER; nvalue(top++) = code.f;
}
tag(top) = T_NUMBER; nvalue(top++) = *((float *)(pc)); pc += sizeof(float);
break;
case PUSHSTRING:
{
CodeWord code;
get_word(code,pc);
tag(top) = T_STRING; svalue(top++) = lua_constant[code.w];
int w = *((Word *)(pc));
pc += sizeof(Word);
tag(top) = T_STRING; svalue(top++) = lua_constant[w];
}
break;
case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2:
case PUSHLOCAL3: case PUSHLOCAL4: case PUSHLOCAL5:
case PUSHLOCAL6: case PUSHLOCAL7: case PUSHLOCAL8:
case PUSHLOCAL9: *top++ = *(base + (int)(opcode-PUSHLOCAL0)); 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:
{
CodeWord code;
get_word(code,pc);
*top++ = s_object(code.w);
}
*top++ = s_object(*((Word *)(pc))); pc += sizeof(Word);
break;
case PUSHINDEXED:
@@ -245,19 +201,21 @@ int lua_execute (Byte *pc)
case PUSHOBJECT: *top = *(top-3); top++; break;
case STORELOCAL0: case STORELOCAL1: case STORELOCAL2:
case STORELOCAL3: case STORELOCAL4: case STORELOCAL5:
case STORELOCAL6: case STORELOCAL7: case STORELOCAL8:
case STORELOCAL9: *(base + (int)(opcode-STORELOCAL0)) = *(--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:
{
CodeWord code;
get_word(code,pc);
s_object(code.w) = *(--top);
}
s_object(*((Word *)(pc))) = *(--top); pc += sizeof(Word);
break;
case STOREINDEXED0:
@@ -287,60 +245,28 @@ int lua_execute (Byte *pc)
if (h == NULL) return 1;
*h = *(top-1);
}
top--;
--top;
}
break;
case STORELIST0:
case STORELIST:
{
int m, n;
Object *arr;
if (opcode == STORELIST0) m = 0;
else m = *(pc++) * FIELDS_PER_FLUSH;
n = *(pc++);
arr = top-n-1;
if (tag(arr) != T_ARRAY)
case STOREFIELD:
if (tag(top-3) != T_ARRAY)
{
lua_reportbug ("internal error - table expected");
lua_error ("internal error - table expected");
return 1;
}
while (n)
{
tag(top) = T_NUMBER; nvalue(top) = n+m;
*(lua_hashdefine (avalue(arr), top)) = *(top-1);
top--;
n--;
}
}
break;
case STORERECORD:
{
int n = *(pc++);
Object *arr = top-n-1;
if (tag(arr) != T_ARRAY)
{
lua_reportbug ("internal error - table expected");
return 1;
}
while (n)
{
CodeWord code;
get_word(code,pc);
tag(top) = T_STRING; svalue(top) = lua_constant[code.w];
*(lua_hashdefine (avalue(arr), top)) = *(top-1);
top--;
n--;
}
}
*(lua_hashdefine (avalue(top-3), top-2)) = *(top-1);
top -= 2;
break;
case ADJUST:
{
Object *newtop = base + *(pc++);
while (top < newtop) tag(top++) = T_NIL;
top = newtop; /* top could be bigger than newtop */
if (top != newtop)
{
while (top < newtop) tag(top++) = T_NIL;
top = newtop;
}
}
break;
@@ -352,7 +278,7 @@ int lua_execute (Byte *pc)
if (tonumber(top-1)) return 1;
if (nvalue(top-1) <= 0) nvalue(top-1) = 101;
}
avalue(top-1) = lua_createarray(nvalue(top-1));
avalue(top-1) = lua_createarray(lua_hashcreate(nvalue(top-1)));
if (avalue(top-1) == NULL)
return 1;
tag(top-1) = T_ARRAY;
@@ -486,51 +412,39 @@ int lua_execute (Byte *pc)
case ONTJMP:
{
CodeWord code;
get_word(code,pc);
if (tag(top-1) != T_NIL) pc += code.w;
int n = *((Word *)(pc));
pc += sizeof(Word);
if (tag(top-1) != T_NIL) pc += n;
}
break;
case ONFJMP:
{
CodeWord code;
get_word(code,pc);
if (tag(top-1) == T_NIL) pc += code.w;
int n = *((Word *)(pc));
pc += sizeof(Word);
if (tag(top-1) == T_NIL) pc += n;
}
break;
case JMP:
{
CodeWord code;
get_word(code,pc);
pc += code.w;
}
break;
case JMP: pc += *((Word *)(pc)) + sizeof(Word); break;
case UPJMP:
{
CodeWord code;
get_word(code,pc);
pc -= code.w;
}
break;
case UPJMP: pc -= *((Word *)(pc)) - sizeof(Word); break;
case IFFJMP:
{
CodeWord code;
get_word(code,pc);
int n = *((Word *)(pc));
pc += sizeof(Word);
top--;
if (tag(top) == T_NIL) pc += code.w;
if (tag(top) == T_NIL) pc += n;
}
break;
case IFFUPJMP:
{
CodeWord code;
get_word(code,pc);
int n = *((Word *)(pc));
pc += sizeof(Word);
top--;
if (tag(top) == T_NIL) pc -= code.w;
if (tag(top) == T_NIL) pc -= n;
}
break;
@@ -549,8 +463,11 @@ int lua_execute (Byte *pc)
nvalue(b) = (base-stack); /* store base value */
base = b+1;
pc = newpc;
if (lua_checkstack(STACKGAP+(base-stack)))
if (MAXSTACK-(base-stack) < STACKGAP)
{
lua_error ("stack overflow");
return 1;
}
}
else if (tag(b-1) == T_CFUNCTION)
{
@@ -599,25 +516,23 @@ int lua_execute (Byte *pc)
break;
case HALT:
base = stack+oldbase;
return 0; /* success */
case SETFUNCTION:
{
CodeWord file, func;
get_word(file,pc);
get_word(func,pc);
if (lua_pushfunction (file.w, func.w))
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:
{
CodeWord code;
get_word(code,pc);
lua_debugline = code.w;
}
lua_debugline = *((Word *)(pc));
pc += sizeof(Word);
break;
case RESET:
@@ -633,13 +548,13 @@ int lua_execute (Byte *pc)
/*
** Traverse all objects on stack
** Mark all strings and arrays used by any object stored at stack.
*/
void lua_travstack (void (*fn)(Object *))
void lua_markstack (void)
{
Object *o;
for (o = top-1; o >= stack; o--)
fn (o);
lua_markobject (o);
}
/*
@@ -662,7 +577,6 @@ int lua_dostring (char *string)
{
if (lua_openstring (string)) return 1;
if (lua_parse ()) return 1;
lua_closestring();
return 0;
}
@@ -698,7 +612,6 @@ Object *lua_getparam (int number)
*/
real lua_getnumber (Object *object)
{
if (object == NULL || tag(object) == T_NIL) return 0.0;
if (tonumber (object)) return 0.0;
else return (nvalue(object));
}
@@ -708,7 +621,6 @@ real lua_getnumber (Object *object)
*/
char *lua_getstring (Object *object)
{
if (object == NULL || tag(object) == T_NIL) return NULL;
if (tostring (object)) return NULL;
else return (svalue(object));
}
@@ -718,7 +630,6 @@ char *lua_getstring (Object *object)
*/
char *lua_copystring (Object *object)
{
if (object == NULL || tag(object) == T_NIL) return NULL;
if (tostring (object)) return NULL;
else return (strdup(svalue(object)));
}
@@ -728,7 +639,6 @@ char *lua_copystring (Object *object)
*/
lua_CFunction lua_getcfunction (Object *object)
{
if (object == NULL) return NULL;
if (tag(object) != T_CFUNCTION) return NULL;
else return (fvalue(object));
}
@@ -738,7 +648,6 @@ lua_CFunction lua_getcfunction (Object *object)
*/
void *lua_getuserdata (Object *object)
{
if (object == NULL) return NULL;
if (tag(object) != T_USERDATA) return NULL;
else return (uvalue(object));
}
@@ -749,14 +658,13 @@ void *lua_getuserdata (Object *object)
*/
Object *lua_getfield (Object *object, char *field)
{
if (object == NULL) return NULL;
if (tag(object) != T_ARRAY)
return NULL;
else
{
Object ref;
tag(&ref) = T_STRING;
svalue(&ref) = lua_createstring(field);
svalue(&ref) = lua_createstring(lua_strdup(field));
return (lua_hashdefine(avalue(object), &ref));
}
}
@@ -767,7 +675,6 @@ Object *lua_getfield (Object *object, char *field)
*/
Object *lua_getindexed (Object *object, float index)
{
if (object == NULL) return NULL;
if (tag(object) != T_ARRAY)
return NULL;
else
@@ -804,9 +711,12 @@ Object *lua_pop (void)
*/
int lua_pushnil (void)
{
if (lua_checkstack(top-stack+1) == 1)
if ((top-stack) >= MAXSTACK-1)
{
lua_error ("stack overflow");
return 1;
tag(top++) = T_NIL;
}
tag(top) = T_NIL;
return 0;
}
@@ -815,8 +725,11 @@ int lua_pushnil (void)
*/
int lua_pushnumber (real n)
{
if (lua_checkstack(top-stack+1) == 1)
if ((top-stack) >= MAXSTACK-1)
{
lua_error ("stack overflow");
return 1;
}
tag(top) = T_NUMBER; nvalue(top++) = n;
return 0;
}
@@ -826,10 +739,13 @@ int lua_pushnumber (real n)
*/
int lua_pushstring (char *s)
{
if (lua_checkstack(top-stack+1) == 1)
if ((top-stack) >= MAXSTACK-1)
{
lua_error ("stack overflow");
return 1;
}
tag(top) = T_STRING;
svalue(top++) = lua_createstring(s);
svalue(top++) = lua_createstring(lua_strdup(s));
return 0;
}
@@ -838,8 +754,11 @@ int lua_pushstring (char *s)
*/
int lua_pushcfunction (lua_CFunction fn)
{
if (lua_checkstack(top-stack+1) == 1)
if ((top-stack) >= MAXSTACK-1)
{
lua_error ("stack overflow");
return 1;
}
tag(top) = T_CFUNCTION; fvalue(top++) = fn;
return 0;
}
@@ -849,8 +768,11 @@ int lua_pushcfunction (lua_CFunction fn)
*/
int lua_pushuserdata (void *u)
{
if (lua_checkstack(top-stack+1) == 1)
if ((top-stack) >= MAXSTACK-1)
{
lua_error ("stack overflow");
return 1;
}
tag(top) = T_USERDATA; uvalue(top++) = u;
return 0;
}
@@ -860,8 +782,11 @@ int lua_pushuserdata (void *u)
*/
int lua_pushobject (Object *o)
{
if (lua_checkstack(top-stack+1) == 1)
if ((top-stack) >= MAXSTACK-1)
{
lua_error ("stack overflow");
return 1;
}
*top++ = *o;
return 0;
}
@@ -890,7 +815,7 @@ int lua_storefield (lua_Object object, char *field)
{
Object ref, *h;
tag(&ref) = T_STRING;
svalue(&ref) = lua_createstring(field);
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;
@@ -975,9 +900,6 @@ int lua_isuserdata (Object *object)
void lua_type (void)
{
Object *o = lua_getparam(1);
if (lua_constant == NULL)
lua_initconstant();
lua_pushstring (lua_constant[tag(o)]);
}
@@ -996,7 +918,7 @@ void lua_obj2number (void)
void lua_print (void)
{
int i=1;
Object *obj;
void *obj;
while ((obj=lua_getparam (i++)) != NULL)
{
if (lua_isnumber(obj)) printf("%g\n",lua_getnumber (obj));
@@ -1009,28 +931,3 @@ void lua_print (void)
}
}
/*
** Internal function: do a file
*/
void lua_internaldofile (void)
{
lua_Object obj = lua_getparam (1);
if (lua_isstring(obj) && !lua_dofile(lua_getstring(obj)))
lua_pushnumber(1);
else
lua_pushnil();
}
/*
** Internal function: do a string
*/
void lua_internaldostring (void)
{
lua_Object obj = lua_getparam (1);
if (lua_isstring(obj) && !lua_dostring(lua_getstring(obj)))
lua_pushnumber(1);
else
lua_pushnil();
}

View File

@@ -1,6 +1,7 @@
/*
** opcode.h
** TeCGraf - PUC-Rio
** $Id: opcode.h,v 2.1 1994/04/20 22:07:57 celes Exp celes $
** 16 Apr 92
*/
#ifndef opcode_h
@@ -14,28 +15,13 @@
#define real float
#endif
#define FIELDS_PER_FLUSH 40
typedef unsigned char Byte;
typedef unsigned short Word;
typedef signed long Long;
typedef union
{
struct {char c1; char c2;} m;
Word w;
} CodeWord;
typedef union
{
struct {char c1; char c2; char c3; char c4;} m;
float f;
} CodeFloat;
typedef enum
{
NOP,
PUSHNIL,
PUSH0, PUSH1, PUSH2,
PUSHBYTE,
@@ -55,9 +41,7 @@ typedef enum
STOREGLOBAL,
STOREINDEXED0,
STOREINDEXED,
STORELIST0,
STORELIST,
STORERECORD,
STOREFIELD,
ADJUST,
CREATEARRAY,
EQOP,
@@ -99,6 +83,7 @@ typedef enum
typedef void (*Cfunction) (void);
typedef int (*Input) (void);
typedef void (*Unput) (int );
typedef union
{
@@ -118,6 +103,7 @@ typedef struct Object
typedef struct
{
char *name;
Object object;
} Symbol;
@@ -131,6 +117,7 @@ typedef struct
#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)))
@@ -140,25 +127,18 @@ typedef struct
#define s_fvalue(i) (fvalue(&s_object(i)))
#define s_uvalue(i) (uvalue(&s_object(i)))
#define get_word(code,pc) {code.m.c1 = *pc++; code.m.c2 = *pc++;}
#define get_float(code,pc) {code.m.c1 = *pc++; code.m.c2 = *pc++;\
code.m.c3 = *pc++; code.m.c4 = *pc++;}
/* Exported functions */
int lua_execute (Byte *pc);
void lua_markstack (void);
char *lua_strdup (char *l);
void lua_setinput (Input fn); /* from "lex.c" module */
char *lua_lasttext (void); /* from "lex.c" module */
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);
void lua_internaldofile (void);
void lua_internaldostring (void);
void lua_travstack (void (*fn)(Object *));
#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

View File

@@ -1,16 +1,16 @@
/*
** strlib.c
** String library to LUA
**
** Waldemar Celes Filho
** TeCGraf - PUC-Rio
** 19 May 93
*/
char *rcs_strlib="$Id: strlib.c,v 1.1 1993/12/17 18:41:19 celes Exp celes $";
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include "mm.h"
#include "lua.h"
@@ -21,18 +21,16 @@ char *rcs_strlib="$Id: strlib.c,v 1.1 1993/12/17 18:41:19 celes Exp celes $";
*/
static void str_find (void)
{
char *s1, *s2, *f;
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);
f = strstr(s1,s2);
if (f != NULL)
lua_pushnumber (f-s1+1);
else
lua_pushnil();
n = strstr(s1,s2) - s1 + 1;
lua_pushnumber (n);
}
/*
@@ -61,15 +59,13 @@ static void str_sub (void)
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))
if (!lua_isstring(o1) || !lua_isnumber(o2) || !lua_isnumber(o3))
{ lua_error ("incorrect arguments to function `strsub'"); return; }
if (o3 != NULL && !lua_isnumber(o3))
{ lua_error ("incorrect third argument to function `strsub'"); return; }
s = lua_copystring(o1);
s = strdup (lua_getstring(o1));
start = lua_getnumber (o2);
end = o3 == NULL ? strlen(s) : lua_getnumber (o3);
end = lua_getnumber (o3);
if (end < start || start < 1 || end > strlen(s))
lua_pushstring("");
lua_pushstring ("");
else
{
s[end] = 0;

View File

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

404
table.c
View File

@@ -1,188 +1,169 @@
/*
** table.c
** Module to control static tables
** TeCGraf - PUC-Rio
** 11 May 93
*/
char *rcs_table="$Id: table.c,v 2.1 1994/04/20 22:07:57 celes Exp celes $";
#include <stdlib.h>
#include <string.h>
#include "mm.h"
#include "opcode.h"
#include "tree.h"
#include "hash.h"
#include "inout.h"
#include "table.h"
#include "lua.h"
#define streq(s1,s2) (s1[0]==s2[0]&&strcmp(s1+1,s2+1)==0)
#define streq(s1,s2) (strcmp(s1,s2)==0)
#define BUFFER_BLOCK 256
#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;
Symbol *lua_table;
static Word lua_ntable = 0;
static Word lua_maxsymbol = 0;
char **lua_constant;
static Word lua_nconstant = 0;
static Word lua_maxconstant = 0;
#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;
/* Variables to controll garbage collection */
#define GARBAGE_BLOCK 256
Word lua_block=GARBAGE_BLOCK; /* when garbage collector will be called */
Word lua_nentity; /* counter of new entities (strings and arrays) */
/*
** Initialise symbol table with internal functions
*/
static void lua_initsymbol (void)
{
int n;
lua_maxsymbol = BUFFER_BLOCK;
lua_table = (Symbol *) calloc(lua_maxsymbol, sizeof(Symbol));
if (lua_table == NULL)
{
lua_error ("symbol table: not enough memory");
return;
}
n = lua_findsymbol("type");
s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_type;
n = lua_findsymbol("tonumber");
s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_obj2number;
n = lua_findsymbol("next");
s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_next;
n = lua_findsymbol("nextvar");
s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_nextvar;
n = lua_findsymbol("print");
s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_print;
n = lua_findsymbol("dofile");
s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_internaldofile;
n = lua_findsymbol("dostring");
s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_internaldostring;
}
/*
** Initialise constant table with pre-defined constants
*/
void lua_initconstant (void)
{
lua_maxconstant = BUFFER_BLOCK;
lua_constant = (char **) calloc(lua_maxconstant, sizeof(char *));
if (lua_constant == NULL)
{
lua_error ("constant table: not enough memory");
return;
}
lua_findconstant("mark");
lua_findconstant("nil");
lua_findconstant("number");
lua_findconstant("string");
lua_findconstant("table");
lua_findconstant("function");
lua_findconstant("cfunction");
lua_findconstant("userdata");
}
/*
** Given a name, search it at symbol table and return its index. If not
** found, allocate it.
** found, allocate at end of table, checking oveflow and return its index.
** On error, return -1.
*/
int lua_findsymbol (char *s)
{
char *n;
if (lua_table == NULL)
lua_initsymbol();
n = lua_varcreate(s);
if (n == NULL)
int i;
for (i=0; i<lua_ntable; i++)
if (streq(s,s_name(i)))
return i;
if (lua_ntable >= MAXSYMBOL-1)
{
lua_error ("create symbol: not enough memory");
lua_error ("symbol table overflow");
return -1;
}
if (indexstring(n) == UNMARKED_STRING)
s_name(lua_ntable) = strdup(s);
if (s_name(lua_ntable) == NULL)
{
if (lua_ntable == lua_maxsymbol)
{
lua_maxsymbol *= 2;
if (lua_maxsymbol > MAX_WORD)
{
lua_error("symbol table overflow");
return -1;
}
lua_table = (Symbol *)realloc(lua_table, lua_maxsymbol*sizeof(Symbol));
if (lua_table == NULL)
{
lua_error ("symbol table: not enough memory");
return -1;
}
}
indexstring(n) = lua_ntable;
s_tag(lua_ntable) = T_NIL;
lua_ntable++;
lua_error ("not enough memory");
return -1;
}
return indexstring(n);
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 name, search it at constant table and return its index. If not
** found, allocate it.
** On error, return -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)
{
char *n;
if (lua_constant == NULL)
lua_initconstant();
n = lua_constcreate(s);
if (n == NULL)
int i;
for (i=0; i<lua_nconstant; i++)
if (streq(s,lua_constant[i]))
return i;
if (lua_nconstant >= MAXCONSTANT-1)
{
lua_error ("create constant: not enough memory");
lua_error ("lua: constant string table overflow");
return -1;
}
if (indexstring(n) == UNMARKED_STRING)
{
if (lua_nconstant == lua_maxconstant)
{
lua_maxconstant *= 2;
if (lua_maxconstant > MAX_WORD)
{
lua_error("constant table overflow");
return -1;
}
lua_constant = (char**)realloc(lua_constant,lua_maxconstant*sizeof(char*));
if (lua_constant == NULL)
{
lua_error ("constant table: not enough memory");
return -1;
}
}
indexstring(n) = lua_nconstant;
lua_constant[lua_nconstant] = n;
lua_nconstant++;
char *c = calloc(strlen(s)+2,sizeof(char));
c++; /* create mark space */
lua_constant[lua_nconstant++] = strcpy(c,s);
}
return indexstring(n);
}
/*
** Traverse symbol table objects
*/
void lua_travsymbol (void (*fn)(Object *))
{
int i;
for (i=0; i<lua_ntable; i++)
fn(&s_object(i));
return (lua_nconstant-1);
}
@@ -191,43 +172,105 @@ void lua_travsymbol (void (*fn)(Object *))
*/
void lua_markobject (Object *o)
{
if (tag(o) == T_STRING && indexstring(svalue(o)) == UNMARKED_STRING)
indexstring(svalue(o)) = MARKED_STRING;
else if (tag(o) == T_ARRAY)
lua_hashmark (avalue(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));
}
/*
** Garbage collection.
** Delete all unused strings and arrays.
** Mark all strings and arrays used by any object stored at symbol table.
*/
void lua_pack (void)
static void lua_marktable (void)
{
/* mark stack strings */
lua_travstack(lua_markobject);
/* mark symbol table strings */
lua_travsymbol(lua_markobject);
lua_strcollector();
lua_hashcollector();
lua_nentity = 0; /* reset counter */
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;
}
}
/*
** If the string isn't allocated, allocate a new string at string tree.
** 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_nentity == lua_block)
if (lua_nstring >= MAXSTRING-1)
{
lua_pack ();
lua_nentity++;
return lua_strcreate(s);
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;
}
@@ -251,15 +294,6 @@ int lua_addfile (char *fn)
return 0;
}
/*
** Delete a file from file stack
*/
int lua_delfile (void)
{
lua_nfile--;
return 1;
}
/*
** Return the last file name set.
*/
@@ -273,7 +307,7 @@ char *lua_filename (void)
*/
void lua_nextvar (void)
{
char *varname, *next;
int index;
Object *o = lua_getparam (1);
if (o == NULL)
{ lua_error ("too few arguments to function `nextvar'"); return; }
@@ -281,7 +315,7 @@ void lua_nextvar (void)
{ lua_error ("too many arguments to function `nextvar'"); return; }
if (tag(o) == T_NIL)
{
varname = 0;
index = 0;
}
else if (tag(o) != T_STRING)
{
@@ -290,20 +324,28 @@ void lua_nextvar (void)
}
else
{
varname = svalue(o);
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;
}
}
next = lua_varnext(varname);
if (next == NULL)
{
lua_pushnil();
lua_pushnil();
}
else
{
Object name;
tag(&name) = T_STRING;
svalue(&name) = next;
svalue(&name) = lua_createstring(lua_strdup(s_name(index)));
if (lua_pushobject (&name)) return;
if (lua_pushobject (&s_object(indexstring(next)))) return;
if (lua_pushobject (&s_object(index))) return;
}
}

35
table.h
View File

@@ -1,32 +1,39 @@
/*
** table.c
** Module to control static tables
** TeCGraf - PUC-Rio
** $Id: table.h,v 2.1 1994/04/20 22:07:57 celes Exp celes $
** 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;
extern Word lua_block;
extern Word lua_nentity;
#define lua_markstring(s) (*((s)-1))
void lua_initconstant (void);
int lua_findsymbol (char *s);
int lua_findconstant (char *s);
void lua_travsymbol (void (*fn)(Object *));
void lua_markobject (Object *o);
void lua_pack (void);
char *lua_createstring (char *s);
int lua_addfile (char *fn);
int lua_delfile (void);
char *lua_filename (void);
void lua_nextvar (void);
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

210
tree.c
View File

@@ -1,210 +0,0 @@
/*
** tree.c
** TecCGraf - PUC-Rio
*/
char *rcs_tree="$Id: $";
#include <stdlib.h>
#include <string.h>
#include "lua.h"
#include "tree.h"
#define lua_strcmp(a,b) (a[0]<b[0]?(-1):(a[0]>b[0]?(1):strcmp(a,b)))
typedef struct TreeNode
{
struct TreeNode *right;
struct TreeNode *left;
Word index;
char str[1]; /* \0 byte already reserved */
} TreeNode;
static TreeNode *string_root = NULL;
static TreeNode *constant_root = NULL;
static TreeNode *variable_root = NULL;
/*
** Insert a new string/constant/variable at the tree.
*/
static char *tree_create (TreeNode **node, char *str)
{
if (*node == NULL)
{
*node = (TreeNode *) malloc (sizeof(TreeNode)+strlen(str));
if (*node == NULL)
lua_error ("memoria insuficiente\n");
(*node)->left = (*node)->right = NULL;
strcpy((*node)->str, str);
(*node)->index = UNMARKED_STRING;
return (*node)->str;
}
else
{
int c = lua_strcmp(str, (*node)->str);
if (c < 0)
return tree_create(&(*node)->left, str);
else if (c > 0)
return tree_create(&(*node)->right, str);
else
return (*node)->str;
}
}
char *lua_strcreate (char *str)
{
return tree_create(&string_root, str);
}
char *lua_constcreate (char *str)
{
return tree_create(&constant_root, str);
}
char *lua_varcreate (char *str)
{
return tree_create(&variable_root, str);
}
/*
** Free a node of the tree
*/
static TreeNode *lua_strfree (TreeNode *parent)
{
if (parent->left == NULL && parent->right == NULL) /* no child */
{
free (parent);
return NULL;
}
else if (parent->left == NULL) /* only right child */
{
TreeNode *p = parent->right;
free (parent);
return p;
}
else if (parent->right == NULL) /* only left child */
{
TreeNode *p = parent->left;
free (parent);
return p;
}
else /* two children */
{
TreeNode *p = parent, *r = parent->right;
while (r->left != NULL)
{
p = r;
r = r->left;
}
if (p == parent)
{
r->left = parent->left;
parent->left = NULL;
parent->right = r->right;
r->right = lua_strfree(parent);
}
else
{
TreeNode *t = r->right;
r->left = parent->left;
r->right = parent->right;
parent->left = NULL;
parent->right = t;
p->left = lua_strfree(parent);
}
return r;
}
}
/*
** Traverse tree for garbage collection
*/
static TreeNode *lua_travcollector (TreeNode *r)
{
if (r == NULL) return NULL;
r->right = lua_travcollector(r->right);
r->left = lua_travcollector(r->left);
if (r->index == UNMARKED_STRING)
return lua_strfree(r);
else
{
r->index = UNMARKED_STRING;
return r;
}
}
/*
** Garbage collection function.
** This function traverse the tree freening unindexed strings
*/
void lua_strcollector (void)
{
string_root = lua_travcollector(string_root);
}
/*
** Return next variable.
*/
static TreeNode *tree_next (TreeNode *node, char *str)
{
#if 0
if (node == NULL) return NULL;
if (str == NULL || lua_strcmp(str, node->str) < 0)
{
TreeNode *result = tree_next(node->left, str);
return result == NULL ? node : result;
}
else
{
return tree_next(node->right, str);
}
#else
if (node == NULL) return NULL;
else if (str == NULL) return node;
else
{
int c = lua_strcmp(str, node->str);
if (c == 0)
return node->left != NULL ? node->left : node->right;
else if (c < 0)
{
TreeNode *result = tree_next(node->left, str);
return result != NULL ? result : node->right;
}
else
return tree_next(node->right, str);
}
#endif
}
char *lua_varnext (char *n)
{
TreeNode *result = tree_next(variable_root, n);
return result != NULL ? result->str : NULL;
}
/*
** Given an id, find the string with exaustive search
*/
static char *tree_name (TreeNode *node, Word index)
{
if (node == NULL) return NULL;
if (node->index == index) return node->str;
else
{
char *result = tree_name(node->left, index);
return result != NULL ? result : tree_name(node->right, index);
}
}
char *lua_varname (Word index)
{
return tree_name(variable_root, index);
}

27
tree.h
View File

@@ -1,27 +0,0 @@
/*
** tree.h
** TecCGraf - PUC-Rio
** $Id: $
*/
#ifndef tree_h
#define tree_h
#include "opcode.h"
#define UNMARKED_STRING 0xFFFF
#define MARKED_STRING 0xFFFE
#define MAX_WORD 0xFFFD
#define indexstring(s) (*(((Word *)s)-1))
char *lua_strcreate (char *str);
char *lua_constcreate (char *str);
char *lua_varcreate (char *str);
void lua_strcollector (void);
char *lua_varnext (char *n);
char *lua_varname (Word index);
#endif

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