commit cd05d9c5cb69020c069f037ba7f243f705d0a48a Author: The Lua team Date: Wed Jul 28 10:18:00 1993 -0300 oldest known commit diff --git a/hash.c b/hash.c new file mode 100644 index 00000000..8743d52c --- /dev/null +++ b/hash.c @@ -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 +#include + +#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; iref = *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; inext) + { + 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; ival) != 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"); + } + } +} diff --git a/hash.h b/hash.h new file mode 100644 index 00000000..28c50317 --- /dev/null +++ b/hash.h @@ -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 diff --git a/inout.c b/inout.c new file mode 100644 index 00000000..3ba32ba7 --- /dev/null +++ b/inout.c @@ -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 +#include + +#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); +} + diff --git a/inout.h b/inout.h new file mode 100644 index 00000000..5a72261c --- /dev/null +++ b/inout.h @@ -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 diff --git a/iolib.c b/iolib.c new file mode 100644 index 00000000..174dd501 --- /dev/null +++ b/iolib.c @@ -0,0 +1,401 @@ +/* +** iolib.c +** Input/output library to LUA +** +** Waldemar Celes Filho +** TeCGraf - PUC-Rio +** 19 May 93 +*/ + +#include +#include +#include +#include +#ifdef __GNUC__ +#include +#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; iyysbuf?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 +#include + +#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); + } diff --git a/lua.c b/lua.c new file mode 100644 index 00000000..be01b70f --- /dev/null +++ b/lua.c @@ -0,0 +1,54 @@ +/* +** lua.c +** Linguagem para Usuarios de Aplicacao +** TeCGraf - PUC-Rio +** 28 Apr 93 +*/ + +#include + +#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 /* NULL */ +#include + +#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); +} diff --git a/opcode.c b/opcode.c new file mode 100644 index 00000000..97975ba1 --- /dev/null +++ b/opcode.c @@ -0,0 +1,933 @@ +/* +** opcode.c +** TecCGraf - PUC-Rio +** 26 Apr 93 +*/ + +#include +#include +#include +#ifdef __GNUC__ +#include +#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= 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"); + } +} + diff --git a/opcode.h b/opcode.h new file mode 100644 index 00000000..b32969d5 --- /dev/null +++ b/opcode.h @@ -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 diff --git a/strlib.c b/strlib.c new file mode 100644 index 00000000..efd01e9b --- /dev/null +++ b/strlib.c @@ -0,0 +1,131 @@ +/* +** strlib.c +** String library to LUA +** +** Waldemar Celes Filho +** TeCGraf - PUC-Rio +** 19 May 93 +*/ + +#include +#include +#include + + +#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); +} diff --git a/table.c b/table.c new file mode 100644 index 00000000..3bae7ebd --- /dev/null +++ b/table.c @@ -0,0 +1,351 @@ +/* +** table.c +** Module to control static tables +** TeCGraf - PUC-Rio +** 11 May 93 +*/ + +#include +#include + +#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= 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= 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= 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= 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 +#include +#include + +#include "opcode.h" +#include "hash.h" +#include "inout.h" +#include "table.h" +#include "lua.h" + +#ifndef ALIGNMENT +#define ALIGNMENT (sizeof(void *)) +#endif + +#ifndef MAXCODE +#define MAXCODE 1024 +#endif +static long buffer[MAXCODE]; +static Byte *code = (Byte *)buffer; +static long mainbuffer[MAXCODE]; +static Byte *maincode = (Byte *)mainbuffer; +static Byte *basepc; +static Byte *pc; + +#define MAXVAR 32 +static long varbuffer[MAXVAR]; +static Byte nvarbuffer=0; /* number of variables at a list */ + +static Word localvar[STACKGAP]; +static Byte nlocalvar=0; /* number of local variables */ +static int ntemp; /* number of temporary var into stack */ +static int err; /* flag to indicate error */ + +/* Internal functions */ +#define align(n) align_n(sizeof(n)) + +static void code_byte (Byte c) +{ + if (pc-basepc>MAXCODE-1) + { + lua_error ("code buffer overflow"); + err = 1; + } + *pc++ = c; +} + +static void code_word (Word n) +{ + if (pc-basepc>MAXCODE-sizeof(Word)) + { + lua_error ("code buffer overflow"); + err = 1; + } + *((Word *)pc) = n; + pc += sizeof(Word); +} + +static void code_float (float n) +{ + if (pc-basepc>MAXCODE-sizeof(float)) + { + lua_error ("code buffer overflow"); + err = 1; + } + *((float *)pc) = n; + pc += sizeof(float); +} + +static void incr_ntemp (void) +{ + if (ntemp+nlocalvar+MAXVAR+1 < STACKGAP) + ntemp++; + else + { + lua_error ("stack overflow"); + err = 1; + } +} + +static void incr_nlocalvar (void) +{ + if (ntemp+nlocalvar+MAXVAR+1 < STACKGAP) + nlocalvar++; + 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 align_n (unsigned size) +{ + if (size > ALIGNMENT) size = ALIGNMENT; + while (((pc+1-code)%size) != 0) /* +1 to include BYTECODE */ + code_byte (NOP); +} + +static void code_number (float f) +{ int i = f; + if (f == i) /* f has an integer value */ + { + if (i <= 2) code_byte(PUSH0 + i); + else if (i <= 255) + { + code_byte(PUSHBYTE); + code_byte(i); + } + else + { + align(Word); + code_byte(PUSHWORD); + code_word(i); + } + } + else + { + align(float); + code_byte(PUSHFLOAT); + code_float(f); + } + incr_ntemp(); +} + + +# line 140 "lua.stx" +typedef union +{ + int vInt; + long vLong; + float vFloat; + Word vWord; + Byte *pByte; +} YYSTYPE; +# 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 +#define yyclearin yychar = -1 +#define yyerrok yyerrflag = 0 +extern int yychar; +extern int yyerrflag; +#ifndef YYMAXDEPTH +#define YYMAXDEPTH 150 +#endif +YYSTYPE yylval, yyval; +# define YYERRCODE 256 + +# line 530 "lua.stx" + + +/* +** 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 */ + { + align(Word); + 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 */ + { + align(Word); + 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 ", 62, + "<", 60, + "LE", 278, + "GE", 279, + "CONC", 280, + "+", 43, + "-", 45, + "*", 42, + "/", 47, + "%", 37, + "UNARY", 281, + "-unknown-", -1 /* ends search */ +}; + +char * yyreds[] = +{ + "-no such reduction-", + "functionlist : /* empty */", + "functionlist : functionlist", + "functionlist : functionlist stat sc", + "functionlist : functionlist function", + "functionlist : functionlist setdebug", + "function : FUNCTION NAME", + "function : FUNCTION NAME '(' parlist ')'", + "function : FUNCTION NAME '(' parlist ')' block END", + "statlist : /* empty */", + "statlist : statlist stat sc", + "stat : /* empty */", + "stat : stat1", + "sc : /* empty */", + "sc : ';'", + "stat1 : IF expr1 THEN PrepJump block PrepJump elsepart END", + "stat1 : WHILE", + "stat1 : WHILE expr1 DO PrepJump block PrepJump END", + "stat1 : REPEAT", + "stat1 : REPEAT block UNTIL expr1 PrepJump", + "stat1 : varlist1 '=' exprlist1", + "stat1 : functioncall", + "stat1 : LOCAL declist", + "elsepart : /* empty */", + "elsepart : ELSE block", + "elsepart : ELSEIF expr1 THEN PrepJump block PrepJump elsepart", + "block : /* empty */", + "block : statlist", + "block : statlist ret", + "ret : /* empty */", + "ret : /* empty */", + "ret : RETURN exprlist sc", + "PrepJump : /* empty */", + "expr1 : expr", + "expr : '(' expr ')'", + "expr : expr1 '=' expr1", + "expr : expr1 '<' expr1", + "expr : expr1 '>' expr1", + "expr : expr1 NE expr1", + "expr : expr1 LE expr1", + "expr : expr1 GE expr1", + "expr : expr1 '+' expr1", + "expr : expr1 '-' expr1", + "expr : expr1 '*' expr1", + "expr : expr1 '/' expr1", + "expr : expr1 CONC expr1", + "expr : '+' expr1", + "expr : '-' expr1", + "expr : '@'", + "expr : '@' objectname fieldlist", + "expr : '@' '(' dimension ')'", + "expr : var", + "expr : NUMBER", + "expr : STRING", + "expr : NIL", + "expr : functioncall", + "expr : NOT expr1", + "expr : expr1 AND PrepJump", + "expr : expr1 AND PrepJump expr1", + "expr : expr1 OR PrepJump", + "expr : expr1 OR PrepJump expr1", + "dimension : /* empty */", + "dimension : expr1", + "functioncall : functionvalue", + "functioncall : functionvalue '(' exprlist ')'", + "functionvalue : var", + "exprlist : /* empty */", + "exprlist : exprlist1", + "exprlist1 : expr", + "exprlist1 : exprlist1 ','", + "exprlist1 : exprlist1 ',' expr", + "parlist : /* empty */", + "parlist : parlist1", + "parlist1 : NAME", + "parlist1 : parlist1 ',' NAME", + "objectname : /* empty */", + "objectname : NAME", + "fieldlist : '{' ffieldlist '}'", + "fieldlist : '[' lfieldlist ']'", + "ffieldlist : /* empty */", + "ffieldlist : ffieldlist1", + "ffieldlist1 : ffield", + "ffieldlist1 : ffieldlist1 ',' ffield", + "ffield : NAME", + "ffield : NAME '=' expr1", + "lfieldlist : /* empty */", + "lfieldlist : lfieldlist1", + "lfieldlist1 : /* empty */", + "lfieldlist1 : lfield", + "lfieldlist1 : lfieldlist1 ','", + "lfieldlist1 : lfieldlist1 ',' lfield", + "lfield : expr1", + "varlist1 : var", + "varlist1 : varlist1 ',' var", + "var : NAME", + "var : var", + "var : var '[' expr1 ']'", + "var : var", + "var : var '.' NAME", + "declist : NAME init", + "declist : declist ',' NAME init", + "init : /* empty */", + "init : '='", + "init : '=' expr1", + "setdebug : DEBUG", +}; +#endif /* YYDEBUG */ +#line 1 "/usr/lib/yaccpar" +/* @(#)yaccpar 1.10 89/04/04 SMI; from S5R3 1.10 */ + +/* +** Skeleton parser driver for yacc output +*/ + +/* +** yacc user known macros and defines +*/ +#define YYERROR goto yyerrlab +#define YYACCEPT { free(yys); free(yyv); return(0); } +#define YYABORT { free(yys); free(yyv); return(1); } +#define YYBACKUP( newtoken, newvalue )\ +{\ + if ( yychar >= 0 || ( yyr2[ yytmp ] >> 1 ) != 1 )\ + {\ + yyerror( "syntax error - cannot backup" );\ + goto yyerrlab;\ + }\ + yychar = newtoken;\ + yystate = *yyps;\ + yylval = newvalue;\ + goto yynewstate;\ +} +#define YYRECOVERING() (!!yyerrflag) +#ifndef YYDEBUG +# define YYDEBUG 1 /* make debugging available */ +#endif + +/* +** user known globals +*/ +int yydebug; /* set to 1 to get debugging */ + +/* +** driver internal defines +*/ +#define YYFLAG (-1000) + +/* +** static variables used by the parser +*/ +static YYSTYPE *yyv; /* value stack */ +static int *yys; /* state stack */ + +static YYSTYPE *yypv; /* top of value stack */ +static int *yyps; /* top of state stack */ + +static int yystate; /* current state */ +static int yytmp; /* extra var (lasts between blocks) */ + +int yynerrs; /* number of errors */ + +int yyerrflag; /* error recovery flag */ +int yychar; /* current input token number */ + + +/* +** yyparse - return 0 if worked, 1 if syntax error not recovered from +*/ +int +yyparse() +{ + register YYSTYPE *yypvt; /* top of value stack for $vars */ + unsigned yymaxdepth = YYMAXDEPTH; + + /* + ** Initialize externals - yyparse may be called more than once + */ + yyv = (YYSTYPE*)malloc(yymaxdepth*sizeof(YYSTYPE)); + yys = (int*)malloc(yymaxdepth*sizeof(int)); + if (!yyv || !yys) + { + yyerror( "out of memory" ); + return(1); + } + yypv = &yyv[-1]; + yyps = &yys[-1]; + yystate = 0; + yytmp = 0; + yynerrs = 0; + yyerrflag = 0; + yychar = -1; + + goto yystack; + { + register YYSTYPE *yy_pv; /* top of value stack */ + register int *yy_ps; /* top of state stack */ + register int yy_state; /* current state */ + register int yy_n; /* internal state number info */ + + /* + ** get globals into registers. + ** branch to here only if YYBACKUP was called. + */ + yynewstate: + yy_pv = yypv; + yy_ps = yyps; + yy_state = yystate; + goto yy_newstate; + + /* + ** get globals into registers. + ** either we just started, or we just finished a reduction + */ + yystack: + yy_pv = yypv; + yy_ps = yyps; + yy_state = yystate; + + /* + ** top of for (;;) loop while no reductions done + */ + yy_stack: + /* + ** put a state and value onto the stacks + */ +#if YYDEBUG + /* + ** if debugging, look up token value in list of value vs. + ** name pairs. 0 and negative (-1) are special values. + ** Note: linear search is used since time is not a real + ** consideration while debugging. + */ + if ( yydebug ) + { + register int yy_i; + + (void)printf( "State %d, token ", yy_state ); + if ( yychar == 0 ) + (void)printf( "end-of-file\n" ); + else if ( yychar < 0 ) + (void)printf( "-none-\n" ); + else + { + for ( yy_i = 0; yytoks[yy_i].t_val >= 0; + yy_i++ ) + { + if ( yytoks[yy_i].t_val == yychar ) + break; + } + (void)printf( "%s\n", yytoks[yy_i].t_name ); + } + } +#endif /* YYDEBUG */ + if ( ++yy_ps >= &yys[ yymaxdepth ] ) /* room on stack? */ + { + /* + ** reallocate and recover. Note that pointers + ** have to be reset, or bad things will happen + */ + int yyps_index = (yy_ps - yys); + int yypv_index = (yy_pv - yyv); + int yypvt_index = (yypvt - yyv); + yymaxdepth += YYMAXDEPTH; + yyv = (YYSTYPE*)realloc((char*)yyv, + yymaxdepth * sizeof(YYSTYPE)); + yys = (int*)realloc((char*)yys, + yymaxdepth * sizeof(int)); + if (!yyv || !yys) + { + yyerror( "yacc stack overflow" ); + return(1); + } + yy_ps = yys + yyps_index; + yy_pv = yyv + yypv_index; + yypvt = yyv + yypvt_index; + } + *yy_ps = yy_state; + *++yy_pv = yyval; + + /* + ** we have a new state - find out what to do + */ + yy_newstate: + if ( ( yy_n = yypact[ yy_state ] ) <= YYFLAG ) + goto yydefault; /* simple state */ +#if YYDEBUG + /* + ** if debugging, need to mark whether new token grabbed + */ + yytmp = yychar < 0; +#endif + if ( ( yychar < 0 ) && ( ( yychar = yylex() ) < 0 ) ) + yychar = 0; /* reached EOF */ +#if YYDEBUG + if ( yydebug && yytmp ) + { + register int yy_i; + + (void)printf( "Received token " ); + if ( yychar == 0 ) + (void)printf( "end-of-file\n" ); + else if ( yychar < 0 ) + (void)printf( "-none-\n" ); + else + { + for ( yy_i = 0; yytoks[yy_i].t_val >= 0; + yy_i++ ) + { + if ( yytoks[yy_i].t_val == yychar ) + break; + } + (void)printf( "%s\n", yytoks[yy_i].t_name ); + } + } +#endif /* YYDEBUG */ + if ( ( ( yy_n += yychar ) < 0 ) || ( yy_n >= YYLAST ) ) + goto yydefault; + if ( yychk[ yy_n = yyact[ yy_n ] ] == yychar ) /*valid shift*/ + { + yychar = -1; + yyval = yylval; + yy_state = yy_n; + if ( yyerrflag > 0 ) + yyerrflag--; + goto yy_stack; + } + + yydefault: + if ( ( yy_n = yydef[ yy_state ] ) == -2 ) + { +#if YYDEBUG + yytmp = yychar < 0; +#endif + if ( ( yychar < 0 ) && ( ( yychar = yylex() ) < 0 ) ) + yychar = 0; /* reached EOF */ +#if YYDEBUG + if ( yydebug && yytmp ) + { + register int yy_i; + + (void)printf( "Received token " ); + if ( yychar == 0 ) + (void)printf( "end-of-file\n" ); + else if ( yychar < 0 ) + (void)printf( "-none-\n" ); + else + { + for ( yy_i = 0; + yytoks[yy_i].t_val >= 0; + yy_i++ ) + { + if ( yytoks[yy_i].t_val + == yychar ) + { + break; + } + } + (void)printf( "%s\n", yytoks[yy_i].t_name ); + } + } +#endif /* YYDEBUG */ + /* + ** look through exception table + */ + { + register int *yyxi = yyexca; + + while ( ( *yyxi != -1 ) || + ( yyxi[1] != yy_state ) ) + { + yyxi += 2; + } + while ( ( *(yyxi += 2) >= 0 ) && + ( *yyxi != yychar ) ) + ; + if ( ( yy_n = yyxi[1] ) < 0 ) + YYACCEPT; + } + } + + /* + ** check for syntax error + */ + if ( yy_n == 0 ) /* have an error */ + { + /* no worry about speed here! */ + switch ( yyerrflag ) + { + case 0: /* new error */ + yyerror( "syntax error" ); + goto skip_init; + yyerrlab: + /* + ** get globals into registers. + ** we have a user generated syntax type error + */ + yy_pv = yypv; + yy_ps = yyps; + yy_state = yystate; + yynerrs++; + skip_init: + case 1: + case 2: /* incompletely recovered error */ + /* try again... */ + yyerrflag = 3; + /* + ** find state where "error" is a legal + ** shift action + */ + while ( yy_ps >= yys ) + { + yy_n = yypact[ *yy_ps ] + YYERRCODE; + if ( yy_n >= 0 && yy_n < YYLAST && + yychk[yyact[yy_n]] == YYERRCODE) { + /* + ** simulate shift of "error" + */ + yy_state = yyact[ yy_n ]; + goto yy_stack; + } + /* + ** current state has no shift on + ** "error", pop stack + */ +#if YYDEBUG +# define _POP_ "Error recovery pops state %d, uncovers state %d\n" + if ( yydebug ) + (void)printf( _POP_, *yy_ps, + yy_ps[-1] ); +# undef _POP_ +#endif + yy_ps--; + yy_pv--; + } + /* + ** there is no state on stack with "error" as + ** a valid shift. give up. + */ + YYABORT; + case 3: /* no shift yet; eat a token */ +#if YYDEBUG + /* + ** if debugging, look up token in list of + ** pairs. 0 and negative shouldn't occur, + ** but since timing doesn't matter when + ** debugging, it doesn't hurt to leave the + ** tests here. + */ + if ( yydebug ) + { + register int yy_i; + + (void)printf( "Error recovery discards " ); + if ( yychar == 0 ) + (void)printf( "token end-of-file\n" ); + else if ( yychar < 0 ) + (void)printf( "token -none-\n" ); + else + { + for ( yy_i = 0; + yytoks[yy_i].t_val >= 0; + yy_i++ ) + { + if ( yytoks[yy_i].t_val + == yychar ) + { + break; + } + } + (void)printf( "token %s\n", + yytoks[yy_i].t_name ); + } + } +#endif /* YYDEBUG */ + if ( yychar == 0 ) /* reached EOF. quit */ + YYABORT; + yychar = -1; + goto yy_newstate; + } + }/* end if ( yy_n == 0 ) */ + /* + ** reduction by production yy_n + ** put stack tops, etc. so things right after switch + */ +#if YYDEBUG + /* + ** if debugging, print the string that is the user's + ** specification of the reduction which is just about + ** to be done. + */ + if ( yydebug ) + (void)printf( "Reduce by (%d) \"%s\"\n", + yy_n, yyreds[ yy_n ] ); +#endif + yytmp = yy_n; /* value to switch over */ + yypvt = yy_pv; /* $vars top of value stack */ + /* + ** Look in goto table for next state + ** Sorry about using yy_state here as temporary + ** register variable, but why not, if it works... + ** If yyr2[ yy_n ] doesn't have the low order bit + ** set, then there is no action to be done for + ** this reduction. So, no saving & unsaving of + ** registers done. The only difference between the + ** code just after the if and the body of the if is + ** the goto yy_stack in the body. This way the test + ** can be made before the choice of what to do is needed. + */ + { + /* length of production doubled with extra bit */ + register int yy_len = yyr2[ yy_n ]; + + if ( !( yy_len & 01 ) ) + { + yy_len >>= 1; + yyval = ( yy_pv -= yy_len )[1]; /* $$ = $1 */ + yy_state = yypgo[ yy_n = yyr1[ yy_n ] ] + + *( yy_ps -= yy_len ) + 1; + if ( yy_state >= YYLAST || + yychk[ yy_state = + yyact[ yy_state ] ] != -yy_n ) + { + yy_state = yyact[ yypgo[ yy_n ] ]; + } + goto yy_stack; + } + yy_len >>= 1; + yyval = ( yy_pv -= yy_len )[1]; /* $$ = $1 */ + yy_state = yypgo[ yy_n = yyr1[ yy_n ] ] + + *( yy_ps -= yy_len ) + 1; + if ( yy_state >= YYLAST || + yychk[ yy_state = yyact[ yy_state ] ] != -yy_n ) + { + yy_state = yyact[ yypgo[ yy_n ] ]; + } + } + /* save until reenter driver code */ + yystate = yy_state; + yyps = yy_ps; + yypv = yy_pv; + } + /* + ** code supplied by user is placed in this switch + */ + switch( yytmp ) + { + +case 2: +# line 179 "lua.stx" +{pc=basepc=maincode; nlocalvar=0;} break; +case 3: +# line 179 "lua.stx" +{maincode=pc;} break; +case 6: +# line 184 "lua.stx" +{pc=basepc=code; nlocalvar=0;} break; +case 7: +# line 185 "lua.stx" +{ + if (lua_debug) + { + align(Word); + code_byte(SETFUNCTION); + code_word(yypvt[-5].vWord); + code_word(yypvt[-4].vWord); + } + lua_codeadjust (0); + } break; +case 8: +# line 197 "lua.stx" +{ + if (lua_debug) code_byte(RESET); + code_byte(RETCODE); code_byte(nlocalvar); + s_tag(yypvt[-7].vWord) = T_FUNCTION; + s_bvalue(yypvt[-7].vWord) = calloc (pc-code, sizeof(Byte)); + memcpy (s_bvalue(yypvt[-7].vWord), code, (pc-code)*sizeof(Byte)); + } break; +case 11: +# line 210 "lua.stx" +{ + ntemp = 0; + if (lua_debug) + { + align(Word); code_byte(SETLINE); code_word(lua_linenumber); + } + } break; +case 15: +# line 223 "lua.stx" +{ + { + Byte *elseinit = yypvt[-2].pByte + sizeof(Word)+1; + if (pc - elseinit == 0) /* no else */ + { + pc -= sizeof(Word)+1; + /* if (*(pc-1) == NOP) --pc; */ + elseinit = pc; + } + else + { + *(yypvt[-2].pByte) = JMP; + *((Word *)(yypvt[-2].pByte+1)) = pc - elseinit; + } + *(yypvt[-4].pByte) = IFFJMP; + *((Word *)(yypvt[-4].pByte+1)) = elseinit - (yypvt[-4].pByte + sizeof(Word)+1); + } + } break; +case 16: +# line 242 "lua.stx" +{yyval.pByte = pc;} break; +case 17: +# line 244 "lua.stx" +{ + *(yypvt[-3].pByte) = IFFJMP; + *((Word *)(yypvt[-3].pByte+1)) = pc - (yypvt[-3].pByte + sizeof(Word)+1); + + *(yypvt[-1].pByte) = UPJMP; + *((Word *)(yypvt[-1].pByte+1)) = pc - yypvt[-6].pByte; + } break; +case 18: +# line 252 "lua.stx" +{yyval.pByte = pc;} break; +case 19: +# line 254 "lua.stx" +{ + *(yypvt[-0].pByte) = IFFUPJMP; + *((Word *)(yypvt[-0].pByte+1)) = pc - yypvt[-4].pByte; + } break; +case 20: +# line 261 "lua.stx" +{ + { + int i; + if (yypvt[-0].vInt == 0 || nvarbuffer != ntemp - yypvt[-2].vInt * 2) + lua_codeadjust (yypvt[-2].vInt * 2 + nvarbuffer); + for (i=nvarbuffer-1; i>=0; i--) + lua_codestore (i); + if (yypvt[-2].vInt > 1 || (yypvt[-2].vInt == 1 && varbuffer[0] != 0)) + lua_codeadjust (0); + } + } break; +case 21: +# line 272 "lua.stx" +{ lua_codeadjust (0); } break; +case 25: +# line 279 "lua.stx" +{ + { + Byte *elseinit = yypvt[-1].pByte + sizeof(Word)+1; + if (pc - elseinit == 0) /* no else */ + { + pc -= sizeof(Word)+1; + /* if (*(pc-1) == NOP) --pc; */ + elseinit = pc; + } + else + { + *(yypvt[-1].pByte) = JMP; + *((Word *)(yypvt[-1].pByte+1)) = pc - elseinit; + } + *(yypvt[-3].pByte) = IFFJMP; + *((Word *)(yypvt[-3].pByte+1)) = elseinit - (yypvt[-3].pByte + sizeof(Word)+1); + } + } break; +case 26: +# line 299 "lua.stx" +{yyval.vInt = nlocalvar;} break; +case 27: +# line 299 "lua.stx" +{ntemp = 0;} break; +case 28: +# line 300 "lua.stx" +{ + if (nlocalvar != yypvt[-3].vInt) + { + nlocalvar = yypvt[-3].vInt; + lua_codeadjust (0); + } + } break; +case 30: +# line 310 "lua.stx" +{ if (lua_debug){align(Word);code_byte(SETLINE);code_word(lua_linenumber);}} break; +case 31: +# line 312 "lua.stx" +{ + if (lua_debug) code_byte(RESET); + code_byte(RETCODE); code_byte(nlocalvar); + } break; +case 32: +# line 319 "lua.stx" +{ + align(Word); + yyval.pByte = pc; + code_byte(0); /* open space */ + code_word (0); + } break; +case 33: +# line 326 "lua.stx" +{ if (yypvt[-0].vInt == 0) {lua_codeadjust (ntemp+1); incr_ntemp();}} break; +case 34: +# line 329 "lua.stx" +{ yyval.vInt = yypvt[-1].vInt; } break; +case 35: +# line 330 "lua.stx" +{ code_byte(EQOP); yyval.vInt = 1; ntemp--;} break; +case 36: +# line 331 "lua.stx" +{ code_byte(LTOP); yyval.vInt = 1; ntemp--;} break; +case 37: +# line 332 "lua.stx" +{ code_byte(LEOP); code_byte(NOTOP); yyval.vInt = 1; ntemp--;} break; +case 38: +# line 333 "lua.stx" +{ code_byte(EQOP); code_byte(NOTOP); yyval.vInt = 1; ntemp--;} break; +case 39: +# line 334 "lua.stx" +{ code_byte(LEOP); yyval.vInt = 1; ntemp--;} break; +case 40: +# line 335 "lua.stx" +{ code_byte(LTOP); code_byte(NOTOP); yyval.vInt = 1; ntemp--;} break; +case 41: +# line 336 "lua.stx" +{ code_byte(ADDOP); yyval.vInt = 1; ntemp--;} break; +case 42: +# line 337 "lua.stx" +{ code_byte(SUBOP); yyval.vInt = 1; ntemp--;} break; +case 43: +# line 338 "lua.stx" +{ code_byte(MULTOP); yyval.vInt = 1; ntemp--;} break; +case 44: +# line 339 "lua.stx" +{ code_byte(DIVOP); yyval.vInt = 1; ntemp--;} break; +case 45: +# line 340 "lua.stx" +{ code_byte(CONCOP); yyval.vInt = 1; ntemp--;} break; +case 46: +# line 341 "lua.stx" +{ yyval.vInt = 1; } break; +case 47: +# line 342 "lua.stx" +{ code_byte(MINUSOP); yyval.vInt = 1;} break; +case 48: +# line 344 "lua.stx" +{ + code_byte(PUSHBYTE); + yyval.pByte = pc; code_byte(0); + incr_ntemp(); + code_byte(CREATEARRAY); + } break; +case 49: +# line 351 "lua.stx" +{ + *(yypvt[-2].pByte) = yypvt[-0].vInt; + if (yypvt[-1].vLong < 0) /* there is no function to be called */ + { + yyval.vInt = 1; + } + else + { + lua_pushvar (yypvt[-1].vLong+1); + code_byte(PUSHMARK); + incr_ntemp(); + code_byte(PUSHOBJECT); + incr_ntemp(); + code_byte(CALLFUNC); + ntemp -= 4; + yyval.vInt = 0; + if (lua_debug) + { + align(Word); code_byte(SETLINE); code_word(lua_linenumber); + } + } + } break; +case 50: +# line 374 "lua.stx" +{ + code_byte(CREATEARRAY); + yyval.vInt = 1; + } break; +case 51: +# line 378 "lua.stx" +{ lua_pushvar (yypvt[-0].vLong); yyval.vInt = 1;} break; +case 52: +# line 379 "lua.stx" +{ code_number(yypvt[-0].vFloat); yyval.vInt = 1; } break; +case 53: +# line 381 "lua.stx" +{ + align(Word); + code_byte(PUSHSTRING); + code_word(yypvt[-0].vWord); + yyval.vInt = 1; + incr_ntemp(); + } break; +case 54: +# line 388 "lua.stx" +{code_byte(PUSHNIL); yyval.vInt = 1; incr_ntemp();} break; +case 55: +# line 390 "lua.stx" +{ + yyval.vInt = 0; + if (lua_debug) + { + align(Word); code_byte(SETLINE); code_word(lua_linenumber); + } + } break; +case 56: +# line 397 "lua.stx" +{ code_byte(NOTOP); yyval.vInt = 1;} break; +case 57: +# line 398 "lua.stx" +{code_byte(POP); ntemp--;} break; +case 58: +# line 399 "lua.stx" +{ + *(yypvt[-2].pByte) = ONFJMP; + *((Word *)(yypvt[-2].pByte+1)) = pc - (yypvt[-2].pByte + sizeof(Word)+1); + yyval.vInt = 1; + } break; +case 59: +# line 404 "lua.stx" +{code_byte(POP); ntemp--;} break; +case 60: +# line 405 "lua.stx" +{ + *(yypvt[-2].pByte) = ONTJMP; + *((Word *)(yypvt[-2].pByte+1)) = pc - (yypvt[-2].pByte + sizeof(Word)+1); + yyval.vInt = 1; + } break; +case 61: +# line 412 "lua.stx" +{ code_byte(PUSHNIL); incr_ntemp();} break; +case 63: +# line 416 "lua.stx" +{code_byte(PUSHMARK); yyval.vInt = ntemp; incr_ntemp();} break; +case 64: +# line 417 "lua.stx" +{ code_byte(CALLFUNC); ntemp = yypvt[-3].vInt-1;} break; +case 65: +# line 419 "lua.stx" +{lua_pushvar (yypvt[-0].vLong); } break; +case 66: +# line 422 "lua.stx" +{ yyval.vInt = 1; } break; +case 67: +# line 423 "lua.stx" +{ yyval.vInt = yypvt[-0].vInt; } break; +case 68: +# line 426 "lua.stx" +{ yyval.vInt = yypvt[-0].vInt; } break; +case 69: +# line 427 "lua.stx" +{if (!yypvt[-1].vInt){lua_codeadjust (ntemp+1); incr_ntemp();}} break; +case 70: +# line 428 "lua.stx" +{yyval.vInt = yypvt[-0].vInt;} break; +case 73: +# line 435 "lua.stx" +{localvar[nlocalvar]=yypvt[-0].vWord; incr_nlocalvar();} break; +case 74: +# line 436 "lua.stx" +{localvar[nlocalvar]=yypvt[-0].vWord; incr_nlocalvar();} break; +case 75: +# line 439 "lua.stx" +{yyval.vLong=-1;} break; +case 76: +# line 440 "lua.stx" +{yyval.vLong=yypvt[-0].vWord;} break; +case 77: +# line 443 "lua.stx" +{ yyval.vInt = yypvt[-1].vInt; } break; +case 78: +# line 444 "lua.stx" +{ yyval.vInt = yypvt[-1].vInt; } break; +case 79: +# line 447 "lua.stx" +{ yyval.vInt = 0; } break; +case 80: +# line 448 "lua.stx" +{ yyval.vInt = yypvt[-0].vInt; } break; +case 81: +# line 451 "lua.stx" +{yyval.vInt=1;} break; +case 82: +# line 452 "lua.stx" +{yyval.vInt=yypvt[-2].vInt+1;} break; +case 83: +# line 456 "lua.stx" +{ + align(Word); + code_byte(PUSHSTRING); + code_word(lua_findconstant (s_name(yypvt[-0].vWord))); + incr_ntemp(); + } break; +case 84: +# line 463 "lua.stx" +{ + code_byte(STOREFIELD); + ntemp-=2; + } break; +case 85: +# line 469 "lua.stx" +{ yyval.vInt = 0; } break; +case 86: +# line 470 "lua.stx" +{ yyval.vInt = yypvt[-0].vInt; } break; +case 87: +# line 473 "lua.stx" +{ code_number(1); } break; +case 88: +# line 473 "lua.stx" +{yyval.vInt=1;} break; +case 89: +# line 474 "lua.stx" +{ code_number(yypvt[-1].vInt+1); } break; +case 90: +# line 475 "lua.stx" +{yyval.vInt=yypvt[-3].vInt+1;} break; +case 91: +# line 479 "lua.stx" +{ + code_byte(STOREFIELD); + ntemp-=2; + } break; +case 92: +# line 486 "lua.stx" +{ + nvarbuffer = 0; + varbuffer[nvarbuffer] = yypvt[-0].vLong; incr_nvarbuffer(); + yyval.vInt = (yypvt[-0].vLong == 0) ? 1 : 0; + } break; +case 93: +# line 492 "lua.stx" +{ + varbuffer[nvarbuffer] = yypvt[-0].vLong; incr_nvarbuffer(); + yyval.vInt = (yypvt[-0].vLong == 0) ? yypvt[-2].vInt + 1 : yypvt[-2].vInt; + } break; +case 94: +# line 499 "lua.stx" +{ + int local = lua_localname (yypvt[-0].vWord); + if (local == -1) /* global var */ + yyval.vLong = yypvt[-0].vWord + 1; /* return positive value */ + else + yyval.vLong = -(local+1); /* return negative value */ + } break; +case 95: +# line 507 "lua.stx" +{lua_pushvar (yypvt[-0].vLong);} break; +case 96: +# line 508 "lua.stx" +{ + yyval.vLong = 0; /* indexed variable */ + } break; +case 97: +# line 511 "lua.stx" +{lua_pushvar (yypvt[-0].vLong);} break; +case 98: +# line 512 "lua.stx" +{ + align(Word); + code_byte(PUSHSTRING); + code_word(lua_findconstant (s_name(yypvt[-0].vWord))); incr_ntemp(); + yyval.vLong = 0; /* indexed variable */ + } break; +case 99: +# line 520 "lua.stx" +{localvar[nlocalvar]=yypvt[-1].vWord; incr_nlocalvar();} break; +case 100: +# line 521 "lua.stx" +{localvar[nlocalvar]=yypvt[-1].vWord; incr_nlocalvar();} break; +case 101: +# line 524 "lua.stx" +{ code_byte(PUSHNIL); } break; +case 102: +# line 525 "lua.stx" +{ntemp = 0;} break; +case 104: +# line 528 "lua.stx" +{lua_debug = yypvt[-0].vInt;} break; + } + goto yystack; /* reset registers in driver code */ +} diff --git a/y_tab.h b/y_tab.h new file mode 100644 index 00000000..b973d540 --- /dev/null +++ b/y_tab.h @@ -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