mirrors/lua
0
0
Fork 0
mirror of https://github.com/lua/lua.git synced 2024-11-27 12:13:38 +08:00
Code Issues Packages Projects Releases Wiki Activity

oldest known commit

Browse Source
This commit is contained in:
The Lua team 1993-07-28 10:18:00 -03:00
commit cd05d9c5cb
17 changed files with 5459 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

259
hash.c Normal file
View File

@ -0,0 +1,259 @@
/*
** hash.c
** hash manager for lua
** Luiz Henrique de Figueiredo - 17 Aug 90
** Modified by Waldemar Celes Filho
** 12 May 93
*/
#include <string.h>
#include <stdlib.h>
#include "opcode.h"
#include "hash.h"
#include "inout.h"
#include "table.h"
#include "lua.h"
#define streq(s1,s2) (strcmp(s1,s2)==0)
#define strneq(s1,s2) (strcmp(s1,s2)!=0)
#define new(s) ((s *)malloc(sizeof(s)))
#define newvector(n,s) ((s *)calloc(n,sizeof(s)))
#define nhash(t) ((t)->nhash)
#define nodelist(t) ((t)->list)
#define list(t,i) ((t)->list[i])
#define ref_tag(n) (tag(&(n)->ref))
#define ref_nvalue(n) (nvalue(&(n)->ref))
#define ref_svalue(n) (svalue(&(n)->ref))
static int head (Hash *t, Object *ref) /* hash function */
{
if (tag(ref) == T_NUMBER) return (((int)nvalue(ref))%nhash(t));
else if (tag(ref) == T_STRING)
{
int h;
char *name = svalue(ref);
for (h=0; *name!=0; name++) /* interpret name as binary number */
{
h <<= 8;
h += (unsigned char) *name; /* avoid sign extension */
h %= nhash(t); /* make it a valid index */
}
return h;
}
else
{
lua_reportbug ("unexpected type to index table");
return -1;
}
}
static Node *present(Hash *t, Object *ref, int h)
{
Node *n=NULL, *p;
if (tag(ref) == T_NUMBER)
{
for (p=NULL,n=list(t,h); n!=NULL; p=n, n=n->next)
if (ref_tag(n) == T_NUMBER && nvalue(ref) == ref_nvalue(n)) break;
}
else if (tag(ref) == T_STRING)
{
for (p=NULL,n=list(t,h); n!=NULL; p=n, n=n->next)
if (ref_tag(n) == T_STRING && streq(svalue(ref),ref_svalue(n))) break;
}
if (n==NULL) /* name not present */
return NULL;
#if 0
if (p!=NULL) /* name present but not first */
{
p->next=n->next; /* move-to-front self-organization */
n->next=list(t,h);
list(t,h)=n;
}
#endif
return n;
}
static void freelist (Node *n)
{
while (n)
{
Node *next = n->next;
free (n);
n = next;
}
}
/*
** Create a new hash. Return the hash pointer or NULL on error.
*/
Hash *lua_hashcreate (unsigned int nhash)
{
Hash *t = new (Hash);
if (t == NULL)
{
lua_error ("not enough memory");
return NULL;
}
nhash(t) = nhash;
markarray(t) = 0;
nodelist(t) = newvector (nhash, Node*);
if (nodelist(t) == NULL)
{
lua_error ("not enough memory");
return NULL;
}
return t;
}
/*
** Delete a hash
*/
void lua_hashdelete (Hash *h)
{
int i;
for (i=0; i<nhash(h); i++)
freelist (list(h,i));
free (nodelist(h));
free(h);
}
/*
** If the hash node is present, return its pointer, otherwise create a new
** node for the given reference and also return its pointer.
** On error, return NULL.
*/
Object *lua_hashdefine (Hash *t, Object *ref)
{
int h;
Node *n;
h = head (t, ref);
if (h < 0) return NULL;
n = present(t, ref, h);
if (n == NULL)
{
n = new(Node);
if (n == NULL)
{
lua_error ("not enough memory");
return NULL;
}
n->ref = *ref;
tag(&n->val) = T_NIL;
n->next = list(t,h); /* link node to head of list */
list(t,h) = n;
}
return (&n->val);
}
/*
** Mark a hash and check its elements
*/
void lua_hashmark (Hash *h)
{
int i;
markarray(h) = 1;
for (i=0; i<nhash(h); i++)
{
Node *n;
for (n = list(h,i); n != NULL; n = n->next)
{
lua_markobject (&n->ref);
lua_markobject (&n->val);
}
}
}
/*
** Internal function to manipulate arrays.
** Given an array object and a reference value, return the next element
** in the hash.
** This function pushs the element value and its reference to the stack.
*/
#include "lua.h"
static void firstnode (Hash *a, int h)
{
if (h < nhash(a))
{
int i;
for (i=h; i<nhash(a); i++)
{
if (list(a,i) != NULL && tag(&list(a,i)->val) != T_NIL)
{
lua_pushobject (&list(a,i)->ref);
lua_pushobject (&list(a,i)->val);
return;
}
}
}
lua_pushnil();
lua_pushnil();
}
void lua_next (void)
{
Hash *a;
Object *o = lua_getparam (1);
Object *r = lua_getparam (2);
if (o == NULL || r == NULL)
{ lua_error ("too few arguments to function `next'"); return; }
if (lua_getparam (3) != NULL)
{ lua_error ("too many arguments to function `next'"); return; }
if (tag(o) != T_ARRAY)
{ lua_error ("first argument of function `next' is not a table"); return; }
a = avalue(o);
if (tag(r) == T_NIL)
{
firstnode (a, 0);
return;
}
else
{
int h = head (a, r);
if (h >= 0)
{
Node *n = list(a,h);
while (n)
{
if (memcmp(&n->ref,r,sizeof(Object)) == 0)
{
if (n->next == NULL)
{
firstnode (a, h+1);
return;
}
else if (tag(&n->next->val) != T_NIL)
{
lua_pushobject (&n->next->ref);
lua_pushobject (&n->next->val);
return;
}
else
{
Node *next = n->next->next;
while (next != NULL && tag(&next->val) == T_NIL) next = next->next;
if (next == NULL)
{
firstnode (a, h+1);
return;
}
else
{
lua_pushobject (&next->ref);
lua_pushobject (&next->val);
}
return;
}
}
n = n->next;
}
if (n == NULL)
lua_error ("error in function 'next': reference not found");
}
}
}

35
hash.h Normal file
View File

@ -0,0 +1,35 @@
/*
** hash.h
** hash manager for lua
** Luiz Henrique de Figueiredo - 17 Aug 90
** Modified by Waldemar Celes Filho
** 26 Apr 93
*/
#ifndef hash_h
#define hash_h
typedef struct node
{
Object ref;
Object val;
struct node *next;
} Node;
typedef struct Hash
{
char mark;
unsigned int nhash;
Node **list;
} Hash;
#define markarray(t) ((t)->mark)
Hash *lua_hashcreate (unsigned int nhash);
void lua_hashdelete (Hash *h);
Object *lua_hashdefine (Hash *t, Object *ref);
void lua_hashmark (Hash *h);
void lua_next (void);
#endif

188
inout.c Normal file
View File

@ -0,0 +1,188 @@
/*
** inout.c
** Provide function to realise the input/output function and debugger
** facilities.
**
** Waldemar Celes Filho
** TeCGraf - PUC-Rio
** 11 May 93
*/
#include <stdio.h>
#include <string.h>
#include "opcode.h"
#include "hash.h"
#include "inout.h"
#include "table.h"
/* Exported variables */
int lua_linenumber;
int lua_debug;
int lua_debugline;
/* Internal variables */
#ifndef MAXFUNCSTACK
#define MAXFUNCSTACK 32
#endif
static struct { int file; int function; } funcstack[MAXFUNCSTACK];
static int nfuncstack=0;
static FILE *fp;
static char *st;
static void (*usererror) (char *s);
/*
** Function to set user function to handle errors.
*/
void lua_errorfunction (void (*fn) (char *s))
{
usererror = fn;
}
/*
** Function to get the next character from the input file
*/
static int fileinput (void)
{
int c = fgetc (fp);
return (c == EOF ? 0 : c);
}
/*
** Function to unget the next character from to input file
*/
static void fileunput (int c)
{
ungetc (c, fp);
}
/*
** Function to get the next character from the input string
*/
static int stringinput (void)
{
st++;
return (*(st-1));
}
/*
** Function to unget the next character from to input string
*/
static void stringunput (int c)
{
st--;
}
/*
** Function to open a file to be input unit.
** Return 0 on success or 1 on error.
*/
int lua_openfile (char *fn)
{
lua_linenumber = 1;
lua_setinput (fileinput);
lua_setunput (fileunput);
fp = fopen (fn, "r");
if (fp == NULL) return 1;
if (lua_addfile (fn)) return 1;
return 0;
}
/*
** Function to close an opened file
*/
void lua_closefile (void)
{
if (fp != NULL)
{
fclose (fp);
fp = NULL;
}
}
/*
** Function to open a string to be input unit
*/
int lua_openstring (char *s)
{
lua_linenumber = 1;
lua_setinput (stringinput);
lua_setunput (stringunput);
st = s;
{
char sn[64];
sprintf (sn, "String: %10.10s...", s);
if (lua_addfile (sn)) return 1;
}
return 0;
}
/*
** Call user function to handle error messages, if registred. Or report error
** using standard function (fprintf).
*/
void lua_error (char *s)
{
if (usererror != NULL) usererror (s);
else fprintf (stderr, "lua: %s\n", s);
}
/*
** Called to execute SETFUNCTION opcode, this function pushs a function into
** function stack. Return 0 on success or 1 on error.
*/
int lua_pushfunction (int file, int function)
{
if (nfuncstack >= MAXFUNCSTACK-1)
{
lua_error ("function stack overflow");
return 1;
}
funcstack[nfuncstack].file = file;
funcstack[nfuncstack].function = function;
nfuncstack++;
return 0;
}
/*
** Called to execute RESET opcode, this function pops a function from
** function stack.
*/
void lua_popfunction (void)
{
nfuncstack--;
}
/*
** Report bug building a message and sending it to lua_error function.
*/
void lua_reportbug (char *s)
{
char msg[1024];
strcpy (msg, s);
if (lua_debugline != 0)
{
int i;
if (nfuncstack > 0)
{
sprintf (strchr(msg,0),
"\n\tin statement begining at line %d in function \"%s\" of file \"%s\"",
lua_debugline, s_name(funcstack[nfuncstack-1].function),
lua_file[funcstack[nfuncstack-1].file]);
sprintf (strchr(msg,0), "\n\tactive stack\n");
for (i=nfuncstack-1; i>=0; i--)
sprintf (strchr(msg,0), "\t-> function \"%s\" of file \"%s\"\n",
s_name(funcstack[i].function),
lua_file[funcstack[i].file]);
}
else
{
sprintf (strchr(msg,0),
"\n\tin statement begining at line %d of file \"%s\"",
lua_debugline, lua_filename());
}
}
lua_error (msg);
}

24
inout.h Normal file
View File

@ -0,0 +1,24 @@
/*
** inout.h
**
** Waldemar Celes Filho
** TeCGraf - PUC-Rio
** 11 May 93
*/
#ifndef inout_h
#define inout_h
extern int lua_linenumber;
extern int lua_debug;
extern int lua_debugline;
int lua_openfile (char *fn);
void lua_closefile (void);
int lua_openstring (char *s);
int lua_pushfunction (int file, int function);
void lua_popfunction (void);
void lua_reportbug (char *s);
#endif

401
iolib.c Normal file
View File

@ -0,0 +1,401 @@
/*
** iolib.c
** Input/output library to LUA
**
** Waldemar Celes Filho
** TeCGraf - PUC-Rio
** 19 May 93
*/
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
#include <ctype.h>
#ifdef __GNUC__
#include <floatingpoint.h>
#endif
#include "lua.h"
static FILE *in=stdin, *out=stdout;
/*
** Open a file to read.
** LUA interface:
** status = readfrom (filename)
** where:
** status = 1 -> success
** status = 0 -> error
*/
static void io_readfrom (void)
{
lua_Object o = lua_getparam (1);
if (o == NULL) /* restore standart input */
{
if (in != stdin)
{
fclose (in);
in = stdin;
}
lua_pushnumber (1);
}
else
{
if (!lua_isstring (o))
{
lua_error ("incorrect argument to function 'readfrom`");
lua_pushnumber (0);
}
else
{
FILE *fp = fopen (lua_getstring(o),"r");
if (fp == NULL)
{
lua_pushnumber (0);
}
else
{
if (in != stdin) fclose (in);
in = fp;
lua_pushnumber (1);
}
}
}
}
/*
** Open a file to write.
** LUA interface:
** status = writeto (filename)
** where:
** status = 1 -> success
** status = 0 -> error
*/
static void io_writeto (void)
{
lua_Object o = lua_getparam (1);
if (o == NULL) /* restore standart output */
{
if (out != stdout)
{
fclose (out);
out = stdout;
}
lua_pushnumber (1);
}
else
{
if (!lua_isstring (o))
{
lua_error ("incorrect argument to function 'writeto`");
lua_pushnumber (0);
}
else
{
FILE *fp = fopen (lua_getstring(o),"w");
if (fp == NULL)
{
lua_pushnumber (0);
}
else
{
if (out != stdout) fclose (out);
out = fp;
lua_pushnumber (1);
}
}
}
}
/*
** Read a variable. On error put nil on stack.
** LUA interface:
** variable = read ([format])
**
** O formato pode ter um dos seguintes especificadores:
**
** s ou S -> para string
** f ou F, g ou G, e ou E -> para reais
** i ou I -> para inteiros
**
** Estes especificadores podem vir seguidos de numero que representa
** o numero de campos a serem lidos.
*/
static void io_read (void)
{
lua_Object o = lua_getparam (1);
if (o == NULL) /* free format */
{
int c;
char s[256];
while (isspace(c=fgetc(in)))
;
if (c == '\"')
{
if (fscanf (in, "%[^\"]\"", s) != 1)
{
lua_pushnil ();
return;
}
}
else if (c == '\'')
{
if (fscanf (in, "%[^\']\'", s) != 1)
{
lua_pushnil ();
return;
}
}
else
{
char *ptr;
double d;
ungetc (c, in);
if (fscanf (in, "%s", s) != 1)
{
lua_pushnil ();
return;
}
d = strtod (s, &ptr);
if (!(*ptr))
{
lua_pushnumber (d);
return;
}
}
lua_pushstring (s);
return;
}
else /* formatted */
{
char *e = lua_getstring(o);
char t;
int m=0;
while (isspace(*e)) e++;
t = *e++;
while (isdigit(*e))
m = m*10 + (*e++ - '0');
if (m > 0)
{
char f[80];
char s[256];
sprintf (f, "%%%ds", m);
fscanf (in, f, s);
switch (tolower(t))
{
case 'i':
{
long int l;
sscanf (s, "%ld", &l);
lua_pushnumber(l);
}
break;
case 'f': case 'g': case 'e':
{
float f;
sscanf (s, "%f", &f);
lua_pushnumber(f);
}
break;
default:
lua_pushstring(s);
break;
}
}
else
{
switch (tolower(t))
{
case 'i':
{
long int l;
fscanf (in, "%ld", &l);
lua_pushnumber(l);
}
break;
case 'f': case 'g': case 'e':
{
float f;
fscanf (in, "%f", &f);
lua_pushnumber(f);
}
break;
default:
{
char s[256];
fscanf (in, "%s", s);
lua_pushstring(s);
}
break;
}
}
}
}
/*
** Write a variable. On error put 0 on stack, otherwise put 1.
** LUA interface:
** status = write (variable [,format])
**
** O formato pode ter um dos seguintes especificadores:
**
** s ou S -> para string
** f ou F, g ou G, e ou E -> para reais
** i ou I -> para inteiros
**
** Estes especificadores podem vir seguidos de:
**
** [?][m][.n]
**
** onde:
** ? -> indica justificacao
** < = esquerda
** | = centro
** > = direita (default)
** m -> numero maximo de campos (se exceder estoura)
** n -> indica precisao para
** reais -> numero de casas decimais
** inteiros -> numero minimo de digitos
** string -> nao se aplica
*/
static char *buildformat (char *e, lua_Object o)
{
static char buffer[512];
static char f[80];
char *string = &buffer[255];
char t, j='r';
int m=0, n=0, l;
while (isspace(*e)) e++;
t = *e++;
if (*e == '<' || *e == '|' || *e == '>') j = *e++;
while (isdigit(*e))
m = m*10 + (*e++ - '0');
e++; /* skip point */
while (isdigit(*e))
n = n*10 + (*e++ - '0');
sprintf(f,"%%");
if (j == '<' || j == '|') sprintf(strchr(f,0),"-");
if (m != 0) sprintf(strchr(f,0),"%d", m);
if (n != 0) sprintf(strchr(f,0),".%d", n);
sprintf(strchr(f,0), "%c", t);
switch (tolower(t))
{
case 'i': t = 'i';
sprintf (string, f, (long int)lua_getnumber(o));
break;
case 'f': case 'g': case 'e': t = 'f';
sprintf (string, f, (float)lua_getnumber(o));
break;
case 's': t = 's';
sprintf (string, f, lua_getstring(o));
break;
default: return "";
}
l = strlen(string);
if (m!=0 && l>m)
{
int i;
for (i=0; i<m; i++)
string[i] = '*';
string[i] = 0;
}
else if (m!=0 && j=='|')
{
int i=l-1;
while (isspace(string[i])) i--;
string -= (m-i) / 2;
i=0;
while (string[i]==0) string[i++] = ' ';
string[l] = 0;
}
return string;
}
static void io_write (void)
{
lua_Object o1 = lua_getparam (1);
lua_Object o2 = lua_getparam (2);
if (o1 == NULL) /* new line */
{
fprintf (out, "\n");
lua_pushnumber(1);
}
else if (o2 == NULL) /* free format */
{
int status=0;
if (lua_isnumber(o1))
status = fprintf (out, "%g", lua_getnumber(o1));
else if (lua_isstring(o1))
status = fprintf (out, "%s", lua_getstring(o1));
lua_pushnumber(status);
}
else /* formated */
{
if (!lua_isstring(o2))
{
lua_error ("incorrect format to function `write'");
lua_pushnumber(0);
return;
}
lua_pushnumber(fprintf (out, "%s", buildformat(lua_getstring(o2),o1)));
}
}
/*
** Execute a executable program using "sustem".
** On error put 0 on stack, otherwise put 1.
*/
void io_execute (void)
{
lua_Object o = lua_getparam (1);
if (o == NULL || !lua_isstring (o))
{
lua_error ("incorrect argument to function 'execute`");
lua_pushnumber (0);
}
else
{
system(lua_getstring(o));
lua_pushnumber (1);
}
return;
}
/*
** Remove a file.
** On error put 0 on stack, otherwise put 1.
*/
void io_remove (void)
{
lua_Object o = lua_getparam (1);
if (o == NULL || !lua_isstring (o))
{
lua_error ("incorrect argument to function 'execute`");
lua_pushnumber (0);
}
else
{
if (remove(lua_getstring(o)) == 0)
lua_pushnumber (1);
else
lua_pushnumber (0);
}
return;
}
/*
** Open io library
*/
void iolib_open (void)
{
lua_register ("readfrom", io_readfrom);
lua_register ("writeto", io_writeto);
lua_register ("read", io_read);
lua_register ("write", io_write);
lua_register ("execute", io_execute);
lua_register ("remove", io_remove);
}

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

54
lua.c Normal file
View File

@ -0,0 +1,54 @@
/*
** 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));
}
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);
}
}

54
lua.h Normal file
View File

@ -0,0 +1,54 @@
/*
** LUA - Linguagem para Usuarios de Aplicacao
** Grupo de Tecnologia em Computacao Grafica
** TeCGraf - PUC-Rio
** 19 May 93
*/
#ifndef lua_h
#define lua_h
typedef void (*lua_CFunction) (void);
typedef struct Object *lua_Object;
#define lua_register(n,f) (lua_pushcfunction(f), lua_storeglobal(n))
void lua_errorfunction (void (*fn) (char *s));
void lua_error (char *s);
int lua_dofile (char *filename);
int lua_dostring (char *string);
int lua_call (char *functionname, int nparam);
lua_Object lua_getparam (int number);
float lua_getnumber (lua_Object object);
char *lua_getstring (lua_Object object);
char *lua_copystring (lua_Object object);
lua_CFunction lua_getcfunction (lua_Object object);
void *lua_getuserdata (lua_Object object);
lua_Object lua_getfield (lua_Object object, char *field);
lua_Object lua_getindexed (lua_Object object, float index);
lua_Object lua_getglobal (char *name);
lua_Object lua_pop (void);
int lua_pushnil (void);
int lua_pushnumber (float n);
int lua_pushstring (char *s);
int lua_pushcfunction (lua_CFunction fn);
int lua_pushuserdata (void *u);
int lua_pushobject (lua_Object object);
int lua_storeglobal (char *name);
int lua_storefield (lua_Object object, char *field);
int lua_storeindexed (lua_Object object, float index);
int lua_isnil (lua_Object object);
int lua_isnumber (lua_Object object);
int lua_isstring (lua_Object object);
int lua_istable (lua_Object object);
int lua_iscfunction (lua_Object object);
int lua_isuserdata (lua_Object object);
#endif

15
lualib.h Normal file
View File

@ -0,0 +1,15 @@
/*
** Libraries to use in LUA programs
** Grupo de Tecnologia em Computacao Grafica
** TeCGraf - PUC-Rio
** 19 May 93
*/
#ifndef lualib_h
#define lualib_h
void iolib_open (void);
void strlib_open (void);
void mathlib_open (void);
#endif

234
mathlib.c Normal file
View File

@ -0,0 +1,234 @@
/*
** mathlib.c
** Mathematica library to LUA
**
** Waldemar Celes Filho
** TeCGraf - PUC-Rio
** 19 May 93
*/
#include <stdio.h> /* NULL */
#include <math.h>
#include "lua.h"
static void math_abs (void)
{
double d;
lua_Object o = lua_getparam (1);
if (o == NULL)
{ lua_error ("too few arguments to function `abs'"); return; }
if (!lua_isnumber(o))
{ lua_error ("incorrect arguments to function `abs'"); return; }
d = lua_getnumber(o);
if (d < 0) d = -d;
lua_pushnumber (d);
}
static void math_sin (void)
{
double d;
lua_Object o = lua_getparam (1);
if (o == NULL)
{ lua_error ("too few arguments to function `sin'"); return; }
if (!lua_isnumber(o))
{ lua_error ("incorrect arguments to function `sin'"); return; }
d = lua_getnumber(o);
lua_pushnumber (sin(d));
}
static void math_cos (void)
{
double d;
lua_Object o = lua_getparam (1);
if (o == NULL)
{ lua_error ("too few arguments to function `cos'"); return; }
if (!lua_isnumber(o))
{ lua_error ("incorrect arguments to function `cos'"); return; }
d = lua_getnumber(o);
lua_pushnumber (cos(d));
}
static void math_tan (void)
{
double d;
lua_Object o = lua_getparam (1);
if (o == NULL)
{ lua_error ("too few arguments to function `tan'"); return; }
if (!lua_isnumber(o))
{ lua_error ("incorrect arguments to function `tan'"); return; }
d = lua_getnumber(o);
lua_pushnumber (tan(d));
}
static void math_asin (void)
{
double d;
lua_Object o = lua_getparam (1);
if (o == NULL)
{ lua_error ("too few arguments to function `asin'"); return; }
if (!lua_isnumber(o))
{ lua_error ("incorrect arguments to function `asin'"); return; }
d = lua_getnumber(o);
lua_pushnumber (asin(d));
}
static void math_acos (void)
{
double d;
lua_Object o = lua_getparam (1);
if (o == NULL)
{ lua_error ("too few arguments to function `acos'"); return; }
if (!lua_isnumber(o))
{ lua_error ("incorrect arguments to function `acos'"); return; }
d = lua_getnumber(o);
lua_pushnumber (acos(d));
}
static void math_atan (void)
{
double d;
lua_Object o = lua_getparam (1);
if (o == NULL)
{ lua_error ("too few arguments to function `atan'"); return; }
if (!lua_isnumber(o))
{ lua_error ("incorrect arguments to function `atan'"); return; }
d = lua_getnumber(o);
lua_pushnumber (atan(d));
}
static void math_ceil (void)
{
double d;
lua_Object o = lua_getparam (1);
if (o == NULL)
{ lua_error ("too few arguments to function `ceil'"); return; }
if (!lua_isnumber(o))
{ lua_error ("incorrect arguments to function `ceil'"); return; }
d = lua_getnumber(o);
lua_pushnumber (ceil(d));
}
static void math_floor (void)
{
double d;
lua_Object o = lua_getparam (1);
if (o == NULL)
{ lua_error ("too few arguments to function `floor'"); return; }
if (!lua_isnumber(o))
{ lua_error ("incorrect arguments to function `floor'"); return; }
d = lua_getnumber(o);
lua_pushnumber (floor(d));
}
static void math_mod (void)
{
int d1, d2;
lua_Object o1 = lua_getparam (1);
lua_Object o2 = lua_getparam (2);
if (!lua_isnumber(o1) || !lua_isnumber(o2))
{ lua_error ("incorrect arguments to function `mod'"); return; }
d1 = (int) lua_getnumber(o1);
d2 = (int) lua_getnumber(o2);
lua_pushnumber (d1%d2);
}
static void math_sqrt (void)
{
double d;
lua_Object o = lua_getparam (1);
if (o == NULL)
{ lua_error ("too few arguments to function `sqrt'"); return; }
if (!lua_isnumber(o))
{ lua_error ("incorrect arguments to function `sqrt'"); return; }
d = lua_getnumber(o);
lua_pushnumber (sqrt(d));
}
static void math_pow (void)
{
double d1, d2;
lua_Object o1 = lua_getparam (1);
lua_Object o2 = lua_getparam (2);
if (!lua_isnumber(o1) || !lua_isnumber(o2))
{ lua_error ("incorrect arguments to function `pow'"); return; }
d1 = lua_getnumber(o1);
d2 = lua_getnumber(o2);
lua_pushnumber (pow(d1,d2));
}
static void math_min (void)
{
int i=1;
double d, dmin;
lua_Object o;
if ((o = lua_getparam(i++)) == NULL)
{ lua_error ("too few arguments to function `min'"); return; }
if (!lua_isnumber(o))
{ lua_error ("incorrect arguments to function `min'"); return; }
dmin = lua_getnumber (o);
while ((o = lua_getparam(i++)) != NULL)
{
if (!lua_isnumber(o))
{ lua_error ("incorrect arguments to function `min'"); return; }
d = lua_getnumber (o);
if (d < dmin) dmin = d;
}
lua_pushnumber (dmin);
}
static void math_max (void)
{
int i=1;
double d, dmax;
lua_Object o;
if ((o = lua_getparam(i++)) == NULL)
{ lua_error ("too few arguments to function `max'"); return; }
if (!lua_isnumber(o))
{ lua_error ("incorrect arguments to function `max'"); return; }
dmax = lua_getnumber (o);
while ((o = lua_getparam(i++)) != NULL)
{
if (!lua_isnumber(o))
{ lua_error ("incorrect arguments to function `max'"); return; }
d = lua_getnumber (o);
if (d > dmax) dmax = d;
}
lua_pushnumber (dmax);
}
/*
** Open math library
*/
void mathlib_open (void)
{
lua_register ("abs", math_abs);
lua_register ("sin", math_sin);
lua_register ("cos", math_cos);
lua_register ("tan", math_tan);
lua_register ("asin", math_asin);
lua_register ("acos", math_acos);
lua_register ("atan", math_atan);
lua_register ("ceil", math_ceil);
lua_register ("floor", math_floor);
lua_register ("mod", math_mod);
lua_register ("sqrt", math_sqrt);
lua_register ("pow", math_pow);
lua_register ("min", math_min);
lua_register ("max", math_max);
}

933
opcode.c Normal file
View File

@ -0,0 +1,933 @@
/*
** opcode.c
** TecCGraf - PUC-Rio
** 26 Apr 93
*/
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#ifdef __GNUC__
#include <floatingpoint.h>
#endif
#include "opcode.h"
#include "hash.h"
#include "inout.h"
#include "table.h"
#include "lua.h"
#define tonumber(o) ((tag(o) != T_NUMBER) && (lua_tonumber(o) != 0))
#define tostring(o) ((tag(o) != T_STRING) && (lua_tostring(o) != 0))
#ifndef MAXSTACK
#define MAXSTACK 256
#endif
static Object stack[MAXSTACK] = {{T_MARK, {NULL}}};
static Object *top=stack+1, *base=stack+1;
/*
** Concatenate two given string, creating a mark space at the beginning.
** Return the new string pointer.
*/
static char *lua_strconc (char *l, char *r)
{
char *s = calloc (strlen(l)+strlen(r)+2, sizeof(char));
if (s == NULL)
{
lua_error ("not enough memory");
return NULL;
}
*s++ = 0; /* create mark space */
return strcat(strcpy(s,l),r);
}
/*
** Duplicate a string, creating a mark space at the beginning.
** Return the new string pointer.
*/
char *lua_strdup (char *l)
{
char *s = calloc (strlen(l)+2, sizeof(char));
if (s == NULL)
{
lua_error ("not enough memory");
return NULL;
}
*s++ = 0; /* create mark space */
return strcpy(s,l);
}
/*
** Convert, if possible, to a number tag.
** Return 0 in success or not 0 on error.
*/
static int lua_tonumber (Object *obj)
{
char *ptr;
if (tag(obj) != T_STRING)
{
lua_reportbug ("unexpected type at conversion to number");
return 1;
}
nvalue(obj) = strtod(svalue(obj), &ptr);
if (*ptr)
{
lua_reportbug ("string to number convertion failed");
return 2;
}
tag(obj) = T_NUMBER;
return 0;
}
/*
** Test if is possible to convert an object to a number one.
** If possible, return the converted object, otherwise return nil object.
*/
static Object *lua_convtonumber (Object *obj)
{
static Object cvt;
if (tag(obj) == T_NUMBER)
{
cvt = *obj;
return &cvt;
}
tag(&cvt) = T_NIL;
if (tag(obj) == T_STRING)
{
char *ptr;
nvalue(&cvt) = strtod(svalue(obj), &ptr);
if (*ptr == 0)
tag(&cvt) = T_NUMBER;
}
return &cvt;
}
/*
** Convert, if possible, to a string tag
** Return 0 in success or not 0 on error.
*/
static int lua_tostring (Object *obj)
{
static char s[256];
if (tag(obj) != T_NUMBER)
{
lua_reportbug ("unexpected type at conversion to string");
return 1;
}
if ((int) nvalue(obj) == nvalue(obj))
sprintf (s, "%d", (int) nvalue(obj));
else
sprintf (s, "%g", nvalue(obj));
svalue(obj) = lua_createstring(lua_strdup(s));
if (svalue(obj) == NULL)
return 1;
tag(obj) = T_STRING;
return 0;
}
/*
** Execute the given opcode. Return 0 in success or 1 on error.
*/
int lua_execute (Byte *pc)
{
while (1)
{
switch ((OpCode)*pc++)
{
case NOP: break;
case PUSHNIL: tag(top++) = T_NIL; break;
case PUSH0: tag(top) = T_NUMBER; nvalue(top++) = 0; break;
case PUSH1: tag(top) = T_NUMBER; nvalue(top++) = 1; break;
case PUSH2: tag(top) = T_NUMBER; nvalue(top++) = 2; break;
case PUSHBYTE: tag(top) = T_NUMBER; nvalue(top++) = *pc++; break;
case PUSHWORD:
tag(top) = T_NUMBER; nvalue(top++) = *((Word *)(pc)); pc += sizeof(Word);
break;
case PUSHFLOAT:
tag(top) = T_NUMBER; nvalue(top++) = *((float *)(pc)); pc += sizeof(float);
break;
case PUSHSTRING:
{
int w = *((Word *)(pc));
pc += sizeof(Word);
tag(top) = T_STRING; svalue(top++) = lua_constant[w];
}
break;
case PUSHLOCAL0: *top++ = *(base + 0); break;
case PUSHLOCAL1: *top++ = *(base + 1); break;
case PUSHLOCAL2: *top++ = *(base + 2); break;
case PUSHLOCAL3: *top++ = *(base + 3); break;
case PUSHLOCAL4: *top++ = *(base + 4); break;
case PUSHLOCAL5: *top++ = *(base + 5); break;
case PUSHLOCAL6: *top++ = *(base + 6); break;
case PUSHLOCAL7: *top++ = *(base + 7); break;
case PUSHLOCAL8: *top++ = *(base + 8); break;
case PUSHLOCAL9: *top++ = *(base + 9); break;
case PUSHLOCAL: *top++ = *(base + (*pc++)); break;
case PUSHGLOBAL:
*top++ = s_object(*((Word *)(pc))); pc += sizeof(Word);
break;
case PUSHINDEXED:
--top;
if (tag(top-1) != T_ARRAY)
{
lua_reportbug ("indexed expression not a table");
return 1;
}
{
Object *h = lua_hashdefine (avalue(top-1), top);
if (h == NULL) return 1;
*(top-1) = *h;
}
break;
case PUSHMARK: tag(top++) = T_MARK; break;
case PUSHOBJECT: *top = *(top-3); top++; break;
case STORELOCAL0: *(base + 0) = *(--top); break;
case STORELOCAL1: *(base + 1) = *(--top); break;
case STORELOCAL2: *(base + 2) = *(--top); break;
case STORELOCAL3: *(base + 3) = *(--top); break;
case STORELOCAL4: *(base + 4) = *(--top); break;
case STORELOCAL5: *(base + 5) = *(--top); break;
case STORELOCAL6: *(base + 6) = *(--top); break;
case STORELOCAL7: *(base + 7) = *(--top); break;
case STORELOCAL8: *(base + 8) = *(--top); break;
case STORELOCAL9: *(base + 9) = *(--top); break;
case STORELOCAL: *(base + (*pc++)) = *(--top); break;
case STOREGLOBAL:
s_object(*((Word *)(pc))) = *(--top); pc += sizeof(Word);
break;
case STOREINDEXED0:
if (tag(top-3) != T_ARRAY)
{
lua_reportbug ("indexed expression not a table");
return 1;
}
{
Object *h = lua_hashdefine (avalue(top-3), top-2);
if (h == NULL) return 1;
*h = *(top-1);
}
top -= 3;
break;
case STOREINDEXED:
{
int n = *pc++;
if (tag(top-3-n) != T_ARRAY)
{
lua_reportbug ("indexed expression not a table");
return 1;
}
{
Object *h = lua_hashdefine (avalue(top-3-n), top-2-n);
if (h == NULL) return 1;
*h = *(top-1);
}
--top;
}
break;
case STOREFIELD:
if (tag(top-3) != T_ARRAY)
{
lua_error ("internal error - table expected");
return 1;
}
*(lua_hashdefine (avalue(top-3), top-2)) = *(top-1);
top -= 2;
break;
case ADJUST:
{
Object *newtop = base + *(pc++);
if (top != newtop)
{
while (top < newtop) tag(top++) = T_NIL;
top = newtop;
}
}
break;
case CREATEARRAY:
if (tag(top-1) == T_NIL)
nvalue(top-1) = 101;
else
{
if (tonumber(top-1)) return 1;
if (nvalue(top-1) <= 0) nvalue(top-1) = 101;
}
avalue(top-1) = lua_createarray(lua_hashcreate(nvalue(top-1)));
if (avalue(top-1) == NULL)
return 1;
tag(top-1) = T_ARRAY;
break;
case EQOP:
{
Object *l = top-2;
Object *r = top-1;
--top;
if (tag(l) != tag(r))
tag(top-1) = T_NIL;
else
{
switch (tag(l))
{
case T_NIL: tag(top-1) = T_NUMBER; break;
case T_NUMBER: tag(top-1) = (nvalue(l) == nvalue(r)) ? T_NUMBER : T_NIL; break;
case T_ARRAY: tag(top-1) = (avalue(l) == avalue(r)) ? T_NUMBER : T_NIL; break;
case T_FUNCTION: tag(top-1) = (bvalue(l) == bvalue(r)) ? T_NUMBER : T_NIL; break;
case T_CFUNCTION: tag(top-1) = (fvalue(l) == fvalue(r)) ? T_NUMBER : T_NIL; break;
case T_USERDATA: tag(top-1) = (uvalue(l) == uvalue(r)) ? T_NUMBER : T_NIL; break;
case T_STRING: tag(top-1) = (strcmp (svalue(l), svalue(r)) == 0) ? T_NUMBER : T_NIL; break;
case T_MARK: return 1;
}
}
nvalue(top-1) = 1;
}
break;
case LTOP:
{
Object *l = top-2;
Object *r = top-1;
--top;
if (tag(l) == T_NUMBER && tag(r) == T_NUMBER)
tag(top-1) = (nvalue(l) < nvalue(r)) ? T_NUMBER : T_NIL;
else
{
if (tostring(l) || tostring(r))
return 1;
tag(top-1) = (strcmp (svalue(l), svalue(r)) < 0) ? T_NUMBER : T_NIL;
}
nvalue(top-1) = 1;
}
break;
case LEOP:
{
Object *l = top-2;
Object *r = top-1;
--top;
if (tag(l) == T_NUMBER && tag(r) == T_NUMBER)
tag(top-1) = (nvalue(l) <= nvalue(r)) ? T_NUMBER : T_NIL;
else
{
if (tostring(l) || tostring(r))
return 1;
tag(top-1) = (strcmp (svalue(l), svalue(r)) <= 0) ? T_NUMBER : T_NIL;
}
nvalue(top-1) = 1;
}
break;
case ADDOP:
{
Object *l = top-2;
Object *r = top-1;
if (tonumber(r) || tonumber(l))
return 1;
nvalue(l) += nvalue(r);
--top;
}
break;
case SUBOP:
{
Object *l = top-2;
Object *r = top-1;
if (tonumber(r) || tonumber(l))
return 1;
nvalue(l) -= nvalue(r);
--top;
}
break;
case MULTOP:
{
Object *l = top-2;
Object *r = top-1;
if (tonumber(r) || tonumber(l))
return 1;
nvalue(l) *= nvalue(r);
--top;
}
break;
case DIVOP:
{
Object *l = top-2;
Object *r = top-1;
if (tonumber(r) || tonumber(l))
return 1;
nvalue(l) /= nvalue(r);
--top;
}
break;
case CONCOP:
{
Object *l = top-2;
Object *r = top-1;
if (tostring(r) || tostring(l))
return 1;
svalue(l) = lua_createstring (lua_strconc(svalue(l),svalue(r)));
if (svalue(l) == NULL)
return 1;
--top;
}
break;
case MINUSOP:
if (tonumber(top-1))
return 1;
nvalue(top-1) = - nvalue(top-1);
break;
case NOTOP:
tag(top-1) = tag(top-1) == T_NIL ? T_NUMBER : T_NIL;
break;
case ONTJMP:
{
int n = *((Word *)(pc));
pc += sizeof(Word);
if (tag(top-1) != T_NIL) pc += n;
}
break;
case ONFJMP:
{
int n = *((Word *)(pc));
pc += sizeof(Word);
if (tag(top-1) == T_NIL) pc += n;
}
break;
case JMP: pc += *((Word *)(pc)) + sizeof(Word); break;
case UPJMP: pc -= *((Word *)(pc)) - sizeof(Word); break;
case IFFJMP:
{
int n = *((Word *)(pc));
pc += sizeof(Word);
top--;
if (tag(top) == T_NIL) pc += n;
}
break;
case IFFUPJMP:
{
int n = *((Word *)(pc));
pc += sizeof(Word);
top--;
if (tag(top) == T_NIL) pc -= n;
}
break;
case POP: --top; break;
case CALLFUNC:
{
Byte *newpc;
Object *b = top-1;
while (tag(b) != T_MARK) b--;
if (tag(b-1) == T_FUNCTION)
{
lua_debugline = 0; /* always reset debug flag */
newpc = bvalue(b-1);
bvalue(b-1) = pc; /* store return code */
nvalue(b) = (base-stack); /* store base value */
base = b+1;
pc = newpc;
if (MAXSTACK-(base-stack) < STACKGAP)
{
lua_error ("stack overflow");
return 1;
}
}
else if (tag(b-1) == T_CFUNCTION)
{
int nparam;
lua_debugline = 0; /* always reset debug flag */
nvalue(b) = (base-stack); /* store base value */
base = b+1;
nparam = top-base; /* number of parameters */
(fvalue(b-1))(); /* call C function */
/* shift returned values */
{
int i;
int nretval = top - base - nparam;
top = base - 2;
base = stack + (int) nvalue(base-1);
for (i=0; i<nretval; i++)
{
*top = *(top+nparam+2);
++top;
}
}
}
else
{
lua_reportbug ("call expression not a function");
return 1;
}
}
break;
case RETCODE:
{
int i;
int shift = *pc++;
int nretval = top - base - shift;
top = base - 2;
pc = bvalue(base-2);
base = stack + (int) nvalue(base-1);
for (i=0; i<nretval; i++)
{
*top = *(top+shift+2);
++top;
}
}
break;
case HALT:
return 0; /* success */
case SETFUNCTION:
{
int file, func;
file = *((Word *)(pc));
pc += sizeof(Word);
func = *((Word *)(pc));
pc += sizeof(Word);
if (lua_pushfunction (file, func))
return 1;
}
break;
case SETLINE:
lua_debugline = *((Word *)(pc));
pc += sizeof(Word);
break;
case RESET:
lua_popfunction ();
break;
default:
lua_error ("internal error - opcode didn't match");
return 1;
}
}
}
/*
** Mark all strings and arrays used by any object stored at stack.
*/
void lua_markstack (void)
{
Object *o;
for (o = top-1; o >= stack; o--)
lua_markobject (o);
}
/*
** Open file, generate opcode and execute global statement. Return 0 on
** success or 1 on error.
*/
int lua_dofile (char *filename)
{
if (lua_openfile (filename)) return 1;
if (lua_parse ()) { lua_closefile (); return 1; }
lua_closefile ();
return 0;
}
/*
** Generate opcode stored on string and execute global statement. Return 0 on
** success or 1 on error.
*/
int lua_dostring (char *string)
{
if (lua_openstring (string)) return 1;
if (lua_parse ()) return 1;
return 0;
}
/*
** Execute the given function. Return 0 on success or 1 on error.
*/
int lua_call (char *functionname, int nparam)
{
static Byte startcode[] = {CALLFUNC, HALT};
int i;
Object func = s_object(lua_findsymbol(functionname));
if (tag(&func) != T_FUNCTION) return 1;
for (i=1; i<=nparam; i++)
*(top-i+2) = *(top-i);
top += 2;
tag(top-nparam-1) = T_MARK;
*(top-nparam-2) = func;
return (lua_execute (startcode));
}
/*
** Get a parameter, returning the object handle or NULL on error.
** 'number' must be 1 to get the first parameter.
*/
Object *lua_getparam (int number)
{
if (number <= 0 || number > top-base) return NULL;
return (base+number-1);
}
/*
** Given an object handle, return its number value. On error, return 0.0.
*/
real lua_getnumber (Object *object)
{
if (tonumber (object)) return 0.0;
else return (nvalue(object));
}
/*
** Given an object handle, return its string pointer. On error, return NULL.
*/
char *lua_getstring (Object *object)
{
if (tostring (object)) return NULL;
else return (svalue(object));
}
/*
** Given an object handle, return a copy of its string. On error, return NULL.
*/
char *lua_copystring (Object *object)
{
if (tostring (object)) return NULL;
else return (strdup(svalue(object)));
}
/*
** Given an object handle, return its cfuntion pointer. On error, return NULL.
*/
lua_CFunction lua_getcfunction (Object *object)
{
if (tag(object) != T_CFUNCTION) return NULL;
else return (fvalue(object));
}
/*
** Given an object handle, return its user data. On error, return NULL.
*/
void *lua_getuserdata (Object *object)
{
if (tag(object) != T_USERDATA) return NULL;
else return (uvalue(object));
}
/*
** Given an object handle and a field name, return its field object.
** On error, return NULL.
*/
Object *lua_getfield (Object *object, char *field)
{
if (tag(object) != T_ARRAY)
return NULL;
else
{
Object ref;
tag(&ref) = T_STRING;
svalue(&ref) = lua_createstring(lua_strdup(field));
return (lua_hashdefine(avalue(object), &ref));
}
}
/*
** Given an object handle and an index, return its indexed object.
** On error, return NULL.
*/
Object *lua_getindexed (Object *object, float index)
{
if (tag(object) != T_ARRAY)
return NULL;
else
{
Object ref;
tag(&ref) = T_NUMBER;
nvalue(&ref) = index;
return (lua_hashdefine(avalue(object), &ref));
}
}
/*
** Get a global object. Return the object handle or NULL on error.
*/
Object *lua_getglobal (char *name)
{
int n = lua_findsymbol(name);
if (n < 0) return NULL;
return &s_object(n);
}
/*
** Pop and return an object
*/
Object *lua_pop (void)
{
if (top <= base) return NULL;
top--;
return top;
}
/*
** Push a nil object
*/
int lua_pushnil (void)
{
if ((top-stack) >= MAXSTACK-1)
{
lua_error ("stack overflow");
return 1;
}
tag(top) = T_NIL;
return 0;
}
/*
** Push an object (tag=number) to stack. Return 0 on success or 1 on error.
*/
int lua_pushnumber (real n)
{
if ((top-stack) >= MAXSTACK-1)
{
lua_error ("stack overflow");
return 1;
}
tag(top) = T_NUMBER; nvalue(top++) = n;
return 0;
}
/*
** Push an object (tag=string) to stack. Return 0 on success or 1 on error.
*/
int lua_pushstring (char *s)
{
if ((top-stack) >= MAXSTACK-1)
{
lua_error ("stack overflow");
return 1;
}
tag(top) = T_STRING;
svalue(top++) = lua_createstring(lua_strdup(s));
return 0;
}
/*
** Push an object (tag=cfunction) to stack. Return 0 on success or 1 on error.
*/
int lua_pushcfunction (lua_CFunction fn)
{
if ((top-stack) >= MAXSTACK-1)
{
lua_error ("stack overflow");
return 1;
}
tag(top) = T_CFUNCTION; fvalue(top++) = fn;
return 0;
}
/*
** Push an object (tag=userdata) to stack. Return 0 on success or 1 on error.
*/
int lua_pushuserdata (void *u)
{
if ((top-stack) >= MAXSTACK-1)
{
lua_error ("stack overflow");
return 1;
}
tag(top) = T_USERDATA; uvalue(top++) = u;
return 0;
}
/*
** Push an object to stack.
*/
int lua_pushobject (Object *o)
{
if ((top-stack) >= MAXSTACK-1)
{
lua_error ("stack overflow");
return 1;
}
*top++ = *o;
return 0;
}
/*
** Store top of the stack at a global variable array field.
** Return 1 on error, 0 on success.
*/
int lua_storeglobal (char *name)
{
int n = lua_findsymbol (name);
if (n < 0) return 1;
if (tag(top-1) == T_MARK) return 1;
s_object(n) = *(--top);
return 0;
}
/*
** Store top of the stack at an array field. Return 1 on error, 0 on success.
*/
int lua_storefield (lua_Object object, char *field)
{
if (tag(object) != T_ARRAY)
return 1;
else
{
Object ref, *h;
tag(&ref) = T_STRING;
svalue(&ref) = lua_createstring(lua_strdup(field));
h = lua_hashdefine(avalue(object), &ref);
if (h == NULL) return 1;
if (tag(top-1) == T_MARK) return 1;
*h = *(--top);
}
return 0;
}
/*
** Store top of the stack at an array index. Return 1 on error, 0 on success.
*/
int lua_storeindexed (lua_Object object, float index)
{
if (tag(object) != T_ARRAY)
return 1;
else
{
Object ref, *h;
tag(&ref) = T_NUMBER;
nvalue(&ref) = index;
h = lua_hashdefine(avalue(object), &ref);
if (h == NULL) return 1;
if (tag(top-1) == T_MARK) return 1;
*h = *(--top);
}
return 0;
}
/*
** Given an object handle, return if it is nil.
*/
int lua_isnil (Object *object)
{
return (object != NULL && tag(object) == T_NIL);
}
/*
** Given an object handle, return if it is a number one.
*/
int lua_isnumber (Object *object)
{
return (object != NULL && tag(object) == T_NUMBER);
}
/*
** Given an object handle, return if it is a string one.
*/
int lua_isstring (Object *object)
{
return (object != NULL && tag(object) == T_STRING);
}
/*
** Given an object handle, return if it is an array one.
*/
int lua_istable (Object *object)
{
return (object != NULL && tag(object) == T_ARRAY);
}
/*
** Given an object handle, return if it is a cfunction one.
*/
int lua_iscfunction (Object *object)
{
return (object != NULL && tag(object) == T_CFUNCTION);
}
/*
** Given an object handle, return if it is an user data one.
*/
int lua_isuserdata (Object *object)
{
return (object != NULL && tag(object) == T_USERDATA);
}
/*
** Internal function: return an object type.
*/
void lua_type (void)
{
Object *o = lua_getparam(1);
lua_pushstring (lua_constant[tag(o)]);
}
/*
** Internal function: convert an object to a number
*/
void lua_obj2number (void)
{
Object *o = lua_getparam(1);
lua_pushobject (lua_convtonumber(o));
}
/*
** Internal function: print object values
*/
void lua_print (void)
{
int i=1;
void *obj;
while ((obj=lua_getparam (i++)) != NULL)
{
if (lua_isnumber(obj)) printf("%g\n",lua_getnumber (obj));
else if (lua_isstring(obj)) printf("%s\n",lua_getstring (obj));
else if (lua_iscfunction(obj)) printf("cfunction: %p\n",lua_getcfunction (obj));
else if (lua_isuserdata(obj)) printf("userdata: %p\n",lua_getuserdata (obj));
else if (lua_istable(obj)) printf("table: %p\n",obj);
else if (lua_isnil(obj)) printf("nil\n");
else printf("invalid value to print\n");
}
}

144
opcode.h Normal file
View File

@ -0,0 +1,144 @@
/*
** opcode.h
** TeCGraf - PUC-Rio
** 16 Apr 92
*/
#ifndef opcode_h
#define opcode_h
#ifndef STACKGAP
#define STACKGAP 128
#endif
#ifndef real
#define real float
#endif
typedef unsigned char Byte;
typedef unsigned short Word;
typedef enum
{
NOP,
PUSHNIL,
PUSH0, PUSH1, PUSH2,
PUSHBYTE,
PUSHWORD,
PUSHFLOAT,
PUSHSTRING,
PUSHLOCAL0, PUSHLOCAL1, PUSHLOCAL2, PUSHLOCAL3, PUSHLOCAL4,
PUSHLOCAL5, PUSHLOCAL6, PUSHLOCAL7, PUSHLOCAL8, PUSHLOCAL9,
PUSHLOCAL,
PUSHGLOBAL,
PUSHINDEXED,
PUSHMARK,
PUSHOBJECT,
STORELOCAL0, STORELOCAL1, STORELOCAL2, STORELOCAL3, STORELOCAL4,
STORELOCAL5, STORELOCAL6, STORELOCAL7, STORELOCAL8, STORELOCAL9,
STORELOCAL,
STOREGLOBAL,
STOREINDEXED0,
STOREINDEXED,
STOREFIELD,
ADJUST,
CREATEARRAY,
EQOP,
LTOP,
LEOP,
ADDOP,
SUBOP,
MULTOP,
DIVOP,
CONCOP,
MINUSOP,
NOTOP,
ONTJMP,
ONFJMP,
JMP,
UPJMP,
IFFJMP,
IFFUPJMP,
POP,
CALLFUNC,
RETCODE,
HALT,
SETFUNCTION,
SETLINE,
RESET
} OpCode;
typedef enum
{
T_MARK,
T_NIL,
T_NUMBER,
T_STRING,
T_ARRAY,
T_FUNCTION,
T_CFUNCTION,
T_USERDATA
} Type;
typedef void (*Cfunction) (void);
typedef int (*Input) (void);
typedef void (*Unput) (int );
typedef union
{
Cfunction f;
real n;
char *s;
Byte *b;
struct Hash *a;
void *u;
} Value;
typedef struct Object
{
Type tag;
Value value;
} Object;
typedef struct
{
char *name;
Object object;
} Symbol;
/* Macros to access structure members */
#define tag(o) ((o)->tag)
#define nvalue(o) ((o)->value.n)
#define svalue(o) ((o)->value.s)
#define bvalue(o) ((o)->value.b)
#define avalue(o) ((o)->value.a)
#define fvalue(o) ((o)->value.f)
#define uvalue(o) ((o)->value.u)
/* Macros to access symbol table */
#define s_name(i) (lua_table[i].name)
#define s_object(i) (lua_table[i].object)
#define s_tag(i) (tag(&s_object(i)))
#define s_nvalue(i) (nvalue(&s_object(i)))
#define s_svalue(i) (svalue(&s_object(i)))
#define s_bvalue(i) (bvalue(&s_object(i)))
#define s_avalue(i) (avalue(&s_object(i)))
#define s_fvalue(i) (fvalue(&s_object(i)))
#define s_uvalue(i) (uvalue(&s_object(i)))
/* Exported functions */
int lua_execute (Byte *pc);
void lua_markstack (void);
char *lua_strdup (char *l);
void lua_setinput (Input fn); /* from "lua.lex" module */
void lua_setunput (Unput fn); /* from "lua.lex" module */
char *lua_lasttext (void); /* from "lua.lex" module */
int lua_parse (void); /* from "lua.stx" module */
void lua_type (void);
void lua_obj2number (void);
void lua_print (void);
#endif

131
strlib.c Normal file
View File

@ -0,0 +1,131 @@
/*
** strlib.c
** String library to LUA
**
** Waldemar Celes Filho
** TeCGraf - PUC-Rio
** 19 May 93
*/
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include "lua.h"
/*
** Return the position of the first caracter of a substring into a string
** LUA interface:
** n = strfind (string, substring)
*/
static void str_find (void)
{
int n;
char *s1, *s2;
lua_Object o1 = lua_getparam (1);
lua_Object o2 = lua_getparam (2);
if (!lua_isstring(o1) || !lua_isstring(o2))
{ lua_error ("incorrect arguments to function `strfind'"); return; }
s1 = lua_getstring(o1);
s2 = lua_getstring(o2);
n = strstr(s1,s2) - s1 + 1;
lua_pushnumber (n);
}
/*
** Return the string length
** LUA interface:
** n = strlen (string)
*/
static void str_len (void)
{
lua_Object o = lua_getparam (1);
if (!lua_isstring(o))
{ lua_error ("incorrect arguments to function `strlen'"); return; }
lua_pushnumber(strlen(lua_getstring(o)));
}
/*
** Return the substring of a string, from start to end
** LUA interface:
** substring = strsub (string, start, end)
*/
static void str_sub (void)
{
int start, end;
char *s;
lua_Object o1 = lua_getparam (1);
lua_Object o2 = lua_getparam (2);
lua_Object o3 = lua_getparam (3);
if (!lua_isstring(o1) || !lua_isnumber(o2) || !lua_isnumber(o3))
{ lua_error ("incorrect arguments to function `strsub'"); return; }
s = strdup (lua_getstring(o1));
start = lua_getnumber (o2);
end = lua_getnumber (o3);
if (end < start || start < 1 || end > strlen(s))
lua_pushstring ("");
else
{
s[end] = 0;
lua_pushstring (&s[start-1]);
}
free (s);
}
/*
** Convert a string to lower case.
** LUA interface:
** lowercase = strlower (string)
*/
static void str_lower (void)
{
char *s, *c;
lua_Object o = lua_getparam (1);
if (!lua_isstring(o))
{ lua_error ("incorrect arguments to function `strlower'"); return; }
c = s = strdup(lua_getstring(o));
while (*c != 0)
{
*c = tolower(*c);
c++;
}
lua_pushstring(s);
free(s);
}
/*
** Convert a string to upper case.
** LUA interface:
** uppercase = strupper (string)
*/
static void str_upper (void)
{
char *s, *c;
lua_Object o = lua_getparam (1);
if (!lua_isstring(o))
{ lua_error ("incorrect arguments to function `strlower'"); return; }
c = s = strdup(lua_getstring(o));
while (*c != 0)
{
*c = toupper(*c);
c++;
}
lua_pushstring(s);
free(s);
}
/*
** Open string library
*/
void strlib_open (void)
{
lua_register ("strfind", str_find);
lua_register ("strlen", str_len);
lua_register ("strsub", str_sub);
lua_register ("strlower", str_lower);
lua_register ("strupper", str_upper);
}

351
table.c Normal file
View File

@ -0,0 +1,351 @@
/*
** table.c
** Module to control static tables
** TeCGraf - PUC-Rio
** 11 May 93
*/
#include <stdlib.h>
#include <string.h>
#include "opcode.h"
#include "hash.h"
#include "inout.h"
#include "table.h"
#include "lua.h"
#define streq(s1,s2) (strcmp(s1,s2)==0)
#ifndef MAXSYMBOL
#define MAXSYMBOL 512
#endif
static Symbol tablebuffer[MAXSYMBOL] = {
{"type",{T_CFUNCTION,{lua_type}}},
{"tonumber",{T_CFUNCTION,{lua_obj2number}}},
{"next",{T_CFUNCTION,{lua_next}}},
{"nextvar",{T_CFUNCTION,{lua_nextvar}}},
{"print",{T_CFUNCTION,{lua_print}}}
};
Symbol *lua_table=tablebuffer;
Word lua_ntable=5;
#ifndef MAXCONSTANT
#define MAXCONSTANT 256
#endif
static char *constantbuffer[MAXCONSTANT] = {"mark","nil","number",
"string","table",
"function","cfunction"
};
char **lua_constant = constantbuffer;
Word lua_nconstant=T_CFUNCTION+1;
#ifndef MAXSTRING
#define MAXSTRING 512
#endif
static char *stringbuffer[MAXSTRING];
char **lua_string = stringbuffer;
Word lua_nstring=0;
#ifndef MAXARRAY
#define MAXARRAY 512
#endif
static Hash *arraybuffer[MAXARRAY];
Hash **lua_array = arraybuffer;
Word lua_narray=0;
#define MAXFILE 20
char *lua_file[MAXFILE];
int lua_nfile;
/*
** Given a name, search it at symbol table and return its index. If not
** found, allocate at end of table, checking oveflow and return its index.
** On error, return -1.
*/
int lua_findsymbol (char *s)
{
int i;
for (i=0; i<lua_ntable; i++)
if (streq(s,s_name(i)))
return i;
if (lua_ntable >= MAXSYMBOL-1)
{
lua_error ("symbol table overflow");
return -1;
}
s_name(lua_ntable) = strdup(s);
if (s_name(lua_ntable) == NULL)
{
lua_error ("not enough memory");
return -1;
}
s_tag(lua_ntable++) = T_NIL;
return (lua_ntable-1);
}
/*
** Given a constant string, eliminate its delimeters (" or '), search it at
** constant table and return its index. If not found, allocate at end of
** the table, checking oveflow and return its index.
**
** For each allocation, the function allocate a extra char to be used to
** mark used string (it's necessary to deal with constant and string
** uniformily). The function store at the table the second position allocated,
** that represents the beginning of the real string. On error, return -1.
**
*/
int lua_findenclosedconstant (char *s)
{
int i, j, l=strlen(s);
char *c = calloc (l, sizeof(char)); /* make a copy */
c++; /* create mark space */
/* introduce scape characters */
for (i=1,j=0; i<l-1; i++)
{
if (s[i] == '\\')
{
switch (s[++i])
{
case 'n': c[j++] = '\n'; break;
case 't': c[j++] = '\t'; break;
case 'r': c[j++] = '\r'; break;
default : c[j++] = '\\'; c[j++] = c[i]; break;
}
}
else
c[j++] = s[i];
}
c[j++] = 0;
for (i=0; i<lua_nconstant; i++)
if (streq(c,lua_constant[i]))
{
free (c-1);
return i;
}
if (lua_nconstant >= MAXCONSTANT-1)
{
lua_error ("lua: constant string table overflow");
return -1;
}
lua_constant[lua_nconstant++] = c;
return (lua_nconstant-1);
}
/*
** Given a constant string, search it at constant table and return its index.
** If not found, allocate at end of the table, checking oveflow and return
** its index.
**
** For each allocation, the function allocate a extra char to be used to
** mark used string (it's necessary to deal with constant and string
** uniformily). The function store at the table the second position allocated,
** that represents the beginning of the real string. On error, return -1.
**
*/
int lua_findconstant (char *s)
{
int i;
for (i=0; i<lua_nconstant; i++)
if (streq(s,lua_constant[i]))
return i;
if (lua_nconstant >= MAXCONSTANT-1)
{
lua_error ("lua: constant string table overflow");
return -1;
}
{
char *c = calloc(strlen(s)+2,sizeof(char));
c++; /* create mark space */
lua_constant[lua_nconstant++] = strcpy(c,s);
}
return (lua_nconstant-1);
}
/*
** Mark an object if it is a string or a unmarked array.
*/
void lua_markobject (Object *o)
{
if (tag(o) == T_STRING)
lua_markstring (svalue(o)) = 1;
else if (tag(o) == T_ARRAY && markarray(avalue(o)) == 0)
lua_hashmark (avalue(o));
}
/*
** Mark all strings and arrays used by any object stored at symbol table.
*/
static void lua_marktable (void)
{
int i;
for (i=0; i<lua_ntable; i++)
lua_markobject (&s_object(i));
}
/*
** Simulate a garbage colection. When string table or array table overflows,
** this function check if all allocated strings and arrays are in use. If
** there are unused ones, pack (compress) the tables.
*/
static void lua_pack (void)
{
lua_markstack ();
lua_marktable ();
{ /* pack string */
int i, j;
for (i=j=0; i<lua_nstring; i++)
if (lua_markstring(lua_string[i]) == 1)
{
lua_string[j++] = lua_string[i];
lua_markstring(lua_string[i]) = 0;
}
else
{
free (lua_string[i]-1);
}
lua_nstring = j;
}
{ /* pack array */
int i, j;
for (i=j=0; i<lua_narray; i++)
if (markarray(lua_array[i]) == 1)
{
lua_array[j++] = lua_array[i];
markarray(lua_array[i]) = 0;
}
else
{
lua_hashdelete (lua_array[i]);
}
lua_narray = j;
}
}
/*
** Allocate a new string at string table. The given string is already
** allocated with mark space and the function puts it at the end of the
** table, checking overflow, and returns its own pointer, or NULL on error.
*/
char *lua_createstring (char *s)
{
if (s == NULL) return NULL;
if (lua_nstring >= MAXSTRING-1)
{
lua_pack ();
if (lua_nstring >= MAXSTRING-1)
{
lua_error ("string table overflow");
return NULL;
}
}
lua_string[lua_nstring++] = s;
return s;
}
/*
** Allocate a new array, already created, at array table. The function puts
** it at the end of the table, checking overflow, and returns its own pointer,
** or NULL on error.
*/
void *lua_createarray (void *a)
{
if (a == NULL) return NULL;
if (lua_narray >= MAXARRAY-1)
{
lua_pack ();
if (lua_narray >= MAXARRAY-1)
{
lua_error ("indexed table overflow");
return NULL;
}
}
lua_array[lua_narray++] = a;
return a;
}
/*
** Add a file name at file table, checking overflow. This function also set
** the external variable "lua_filename" with the function filename set.
** Return 0 on success or 1 on error.
*/
int lua_addfile (char *fn)
{
if (lua_nfile >= MAXFILE-1)
{
lua_error ("too many files");
return 1;
}
if ((lua_file[lua_nfile++] = strdup (fn)) == NULL)
{
lua_error ("not enough memory");
return 1;
}
return 0;
}
/*
** Return the last file name set.
*/
char *lua_filename (void)
{
return lua_file[lua_nfile-1];
}
/*
** Internal function: return next global variable
*/
void lua_nextvar (void)
{
int index;
Object *o = lua_getparam (1);
if (o == NULL)
{ lua_error ("too few arguments to function `nextvar'"); return; }
if (lua_getparam (2) != NULL)
{ lua_error ("too many arguments to function `nextvar'"); return; }
if (tag(o) == T_NIL)
{
index = 0;
}
else if (tag(o) != T_STRING)
{
lua_error ("incorrect argument to function `nextvar'");
return;
}
else
{
for (index=0; index<lua_ntable; index++)
if (streq(s_name(index),svalue(o))) break;
if (index == lua_ntable)
{
lua_error ("name not found in function `nextvar'");
return;
}
index++;
while (index < lua_ntable-1 && tag(&s_object(index)) == T_NIL) index++;
if (index == lua_ntable-1)
{
lua_pushnil();
lua_pushnil();
return;
}
}
{
Object name;
tag(&name) = T_STRING;
svalue(&name) = lua_createstring(lua_strdup(s_name(index)));
if (lua_pushobject (&name)) return;
if (lua_pushobject (&s_object(index))) return;
}
}

39
table.h Normal file
View File

@ -0,0 +1,39 @@
/*
** table.c
** Module to control static tables
** TeCGraf - PUC-Rio
** 11 May 93
*/
#ifndef table_h
#define table_h
extern Symbol *lua_table;
extern Word lua_ntable;
extern char **lua_constant;
extern Word lua_nconstant;
extern char **lua_string;
extern Word lua_nstring;
extern Hash **lua_array;
extern Word lua_narray;
extern char *lua_file[];
extern int lua_nfile;
#define lua_markstring(s) (*((s)-1))
int lua_findsymbol (char *s);
int lua_findenclosedconstant (char *s);
int lua_findconstant (char *s);
void lua_markobject (Object *o);
char *lua_createstring (char *s);
void *lua_createarray (void *a);
int lua_addfile (char *fn);
char *lua_filename (void);
void lua_nextvar (void);
#endif

1639
y_tab.c Normal file
View 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