summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Makefile29
-rw-r--r--src/fallback.c171
-rw-r--r--src/fallback.h31
-rw-r--r--src/hash.c421
-rw-r--r--src/hash.h17
-rw-r--r--src/inout.c239
-rw-r--r--src/inout.h23
-rw-r--r--src/lex.c143
-rw-r--r--src/mem.c44
-rw-r--r--src/mem.h25
-rw-r--r--src/opcode.c1623
-rw-r--r--src/opcode.h92
-rw-r--r--src/parser.c (renamed from src/y.tab.c)1492
-rw-r--r--src/parser.h (renamed from src/y.tab.h)20
-rw-r--r--src/table.c402
-rw-r--r--src/table.h31
-rw-r--r--src/tree.c141
-rw-r--r--src/tree.h37
-rw-r--r--src/types.h31
-rw-r--r--src/ugly.h36
-rw-r--r--src/yacc/Makefile30
-rw-r--r--src/yacc/exscript3
-rw-r--r--src/yacc/lua.lex85
-rw-r--r--src/yacc/lua.stx847
24 files changed, 3359 insertions, 2654 deletions
diff --git a/src/Makefile b/src/Makefile
index 7e833d4f..6d1f1bb1 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -1,24 +1,35 @@
-# makefile for lua
+# makefile for lua distribution
-LIB= $(LUA)/lib
INC= $(LUA)/include
+LIB= $(LUA)/lib
+
+# in SunOs /usr/5include contains prototypes for standard lib
+INCS= -I/usr/5include -I$(INC)
+WARN= -Wall -Wmissing-prototypes -Wshadow -ansi
CC= gcc
-CFLAGS= -g -Wall -O2 -I$(INC) $(DEFS)
-DEFS= -DMAXCODE=64000 -DMAXCONSTANT=1024 -DMAXSYMBOL=1024 -DMAXARRAY=1024
+CFLAGS= $(INCS) $(DEFS) $(WARN) -O2
+
+OBJS= fallback.o hash.o inout.o lex.o mem.o opcode.o parser.o table.o tree.o
-OBJS= hash.o inout.o lex.o opcode.o table.o y.tab.o
SLIB= $(LIB)/liblua.a
-DLIB= $(LIB)/liblua.so.1.1
-libs: $(SLIB) $(DLIB)
+# dynamic libraries only work for SunOs
+DLIB= $(LIB)/liblua.so.2.1
+
+all: $(SLIB)
+
+dynamic: $(DLIB)
$(SLIB): $(OBJS)
- ar ruvl $@ $(OBJS)
- ranlib $(SLIB)
+ ar rcuv $@ $(OBJS)
+ ranlib $@
$(DLIB): $(OBJS)
ld -o $@ $(OBJS)
clean:
rm -f $(OBJS) $(SLIB) $(DLIB)
+
+co:
+ co -M fallback.c hash.c inout.c lex.c mem.c opcode.c table.c tree.c fallback.h hash.h inout.h mem.h opcode.h table.h tree.h types.h ugly.h
diff --git a/src/fallback.c b/src/fallback.c
new file mode 100644
index 00000000..d5bbbba1
--- /dev/null
+++ b/src/fallback.c
@@ -0,0 +1,171 @@
+/*
+** fallback.c
+** TecCGraf - PUC-Rio
+*/
+
+char *rcs_fallback="$Id: fallback.c,v 1.11 1995/02/06 19:34:03 roberto Exp $";
+
+#include <stdio.h>
+#include <string.h>
+
+#include "mem.h"
+#include "fallback.h"
+#include "opcode.h"
+#include "inout.h"
+#include "lua.h"
+
+
+static void errorFB (void);
+static void indexFB (void);
+static void gettableFB (void);
+static void arithFB (void);
+static void concatFB (void);
+static void orderFB (void);
+static void GDFB (void);
+static void funcFB (void);
+
+
+/*
+** Warning: This list must be in the same order as the #define's
+*/
+struct FB luaI_fallBacks[] = {
+{"error", {LUA_T_CFUNCTION, errorFB}},
+{"index", {LUA_T_CFUNCTION, indexFB}},
+{"gettable", {LUA_T_CFUNCTION, gettableFB}},
+{"arith", {LUA_T_CFUNCTION, arithFB}},
+{"order", {LUA_T_CFUNCTION, orderFB}},
+{"concat", {LUA_T_CFUNCTION, concatFB}},
+{"settable", {LUA_T_CFUNCTION, gettableFB}},
+{"gc", {LUA_T_CFUNCTION, GDFB}},
+{"function", {LUA_T_CFUNCTION, funcFB}}
+};
+
+#define N_FB (sizeof(luaI_fallBacks)/sizeof(struct FB))
+
+void luaI_setfallback (void)
+{
+ int i;
+ char *name = lua_getstring(lua_getparam(1));
+ lua_Object func = lua_getparam(2);
+ if (name == NULL || !(lua_isfunction(func) || lua_iscfunction(func)))
+ {
+ lua_pushnil();
+ return;
+ }
+ for (i=0; i<N_FB; i++)
+ {
+ if (strcmp(luaI_fallBacks[i].kind, name) == 0)
+ {
+ luaI_pushobject(&luaI_fallBacks[i].function);
+ luaI_fallBacks[i].function = *luaI_Address(func);
+ return;
+ }
+ }
+ /* name not found */
+ lua_pushnil();
+}
+
+
+static void errorFB (void)
+{
+ lua_Object o = lua_getparam(1);
+ if (lua_isstring(o))
+ fprintf (stderr, "lua: %s\n", lua_getstring(o));
+ else
+ fprintf(stderr, "lua: unknown error\n");
+}
+
+
+static void indexFB (void)
+{
+ lua_pushnil();
+}
+
+
+static void gettableFB (void)
+{
+ lua_reportbug("indexed expression not a table");
+}
+
+
+static void arithFB (void)
+{
+ lua_reportbug("unexpected type at conversion to number");
+}
+
+static void concatFB (void)
+{
+ lua_reportbug("unexpected type at conversion to string");
+}
+
+
+static void orderFB (void)
+{
+ lua_reportbug("unexpected type at comparison");
+}
+
+static void GDFB (void) { }
+
+static void funcFB (void)
+{
+ lua_reportbug("call expression not a function");
+}
+
+
+/*
+** Lock routines
+*/
+
+static Object *lockArray = NULL;
+static Word lockSize = 0;
+
+int luaI_lock (Object *object)
+{
+ Word i;
+ Word oldSize;
+ if (tag(object) == LUA_T_NIL)
+ return -1;
+ for (i=0; i<lockSize; i++)
+ if (tag(&lockArray[i]) == LUA_T_NIL)
+ {
+ lockArray[i] = *object;
+ return i;
+ }
+ /* no more empty spaces */
+ oldSize = lockSize;
+ if (lockArray == NULL)
+ {
+ lockSize = 10;
+ lockArray = newvector(lockSize, Object);
+ }
+ else
+ {
+ lockSize = 3*oldSize/2 + 5;
+ lockArray = growvector(lockArray, lockSize, Object);
+ }
+ for (i=oldSize; i<lockSize; i++)
+ tag(&lockArray[i]) = LUA_T_NIL;
+ lockArray[oldSize] = *object;
+ return oldSize;
+}
+
+
+void lua_unlock (int ref)
+{
+ tag(&lockArray[ref]) = LUA_T_NIL;
+}
+
+
+Object *luaI_getlocked (int ref)
+{
+ return &lockArray[ref];
+}
+
+
+void luaI_travlock (void (*fn)(Object *))
+{
+ Word i;
+ for (i=0; i<lockSize; i++)
+ fn(&lockArray[i]);
+}
+
diff --git a/src/fallback.h b/src/fallback.h
new file mode 100644
index 00000000..225a9063
--- /dev/null
+++ b/src/fallback.h
@@ -0,0 +1,31 @@
+/*
+** $Id: fallback.h,v 1.7 1994/11/21 18:22:58 roberto Stab $
+*/
+
+#ifndef fallback_h
+#define fallback_h
+
+#include "opcode.h"
+
+extern struct FB {
+ char *kind;
+ Object function;
+} luaI_fallBacks[];
+
+#define FB_ERROR 0
+#define FB_INDEX 1
+#define FB_GETTABLE 2
+#define FB_ARITH 3
+#define FB_ORDER 4
+#define FB_CONCAT 5
+#define FB_SETTABLE 6
+#define FB_GC 7
+#define FB_FUNCTION 8
+
+void luaI_setfallback (void);
+int luaI_lock (Object *object);
+Object *luaI_getlocked (int ref);
+void luaI_travlock (void (*fn)(Object *));
+
+#endif
+
diff --git a/src/hash.c b/src/hash.c
index 287c1316..2f227d25 100644
--- a/src/hash.c
+++ b/src/hash.c
@@ -1,138 +1,147 @@
/*
** hash.c
** hash manager for lua
-** Luiz Henrique de Figueiredo - 17 Aug 90
*/
-char *rcs_hash="$Id: hash.c,v 2.1 1994/04/20 22:07:57 celes Exp $";
+char *rcs_hash="$Id: hash.c,v 2.24 1995/02/06 19:34:03 roberto Exp $";
#include <string.h>
-#include <stdlib.h>
-
-#include "mm.h"
+#include "mem.h"
#include "opcode.h"
#include "hash.h"
#include "inout.h"
#include "table.h"
#include "lua.h"
-#define streq(s1,s2) (strcmp(s1,s2)==0)
-#define strneq(s1,s2) (strcmp(s1,s2)!=0)
-
-#define new(s) ((s *)malloc(sizeof(s)))
-#define newvector(n,s) ((s *)calloc(n,sizeof(s)))
+#define streq(s1,s2) (s1 == s2 || (*(s1) == *(s2) && strcmp(s1,s2)==0))
#define nhash(t) ((t)->nhash)
-#define nodelist(t) ((t)->list)
-#define list(t,i) ((t)->list[i])
+#define nuse(t) ((t)->nuse)
#define markarray(t) ((t)->mark)
-#define ref_tag(n) (tag(&(n)->ref))
-#define ref_nvalue(n) (nvalue(&(n)->ref))
-#define ref_svalue(n) (svalue(&(n)->ref))
+#define nodevector(t) ((t)->node)
+#define node(t,i) (&(t)->node[i])
+#define ref(n) (&(n)->ref)
+#define val(n) (&(n)->val)
-#ifndef ARRAYBLOCK
-#define ARRAYBLOCK 50
-#endif
-typedef struct ArrayList
-{
- Hash *array;
- struct ArrayList *next;
-} ArrayList;
+#define REHASH_LIMIT 0.70 /* avoid more than this % full */
+
-static ArrayList *listhead = NULL;
+static Hash *listhead = NULL;
-static int head (Hash *t, Object *ref) /* hash function */
+
+
+/* hash dimensions values */
+static Word dimensions[] =
+ {3, 5, 7, 11, 23, 47, 97, 197, 397, 797, 1597, 3203, 6421,
+ 12853, 25717, 51437, 65521, 0}; /* 65521 == last prime < MAX_WORD */
+
+static Word redimension (Word nhash)
{
- if (tag(ref) == T_NUMBER) return (((int)nvalue(ref))%nhash(t));
- else if (tag(ref) == T_STRING)
+ Word i;
+ for (i=0; dimensions[i]!=0; i++)
{
- 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;
+ if (dimensions[i] > nhash)
+ return dimensions[i];
}
+ lua_error("table overflow");
+ return 0; /* to avoid warnings */
}
-static Node *present(Hash *t, Object *ref, int h)
+static Word hashindex (Hash *t, Object *ref) /* hash function */
{
- 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 */
+ switch (tag(ref))
{
- p->next=n->next; /* move-to-front self-organization */
- n->next=list(t,h);
- list(t,h)=n;
+ case LUA_T_NIL:
+ lua_reportbug ("unexpected type to index table");
+ return -1; /* UNREACHEABLE */
+ case LUA_T_NUMBER:
+ return (((Word)nvalue(ref))%nhash(t));
+ case LUA_T_STRING:
+ {
+ unsigned long h = tsvalue(ref)->hash;
+ if (h == 0)
+ {
+ char *name = svalue(ref);
+ while (*name)
+ h = ((h<<5)-h)^(unsigned char)*(name++);
+ tsvalue(ref)->hash = h;
+ }
+ return (Word)h%nhash(t); /* make it a valid index */
+ }
+ case LUA_T_FUNCTION:
+ return (((IntPoint)bvalue(ref))%nhash(t));
+ case LUA_T_CFUNCTION:
+ return (((IntPoint)fvalue(ref))%nhash(t));
+ case LUA_T_ARRAY:
+ return (((IntPoint)avalue(ref))%nhash(t));
+ default: /* user data */
+ return (((IntPoint)uvalue(ref))%nhash(t));
}
-#endif
- return n;
}
-static void freelist (Node *n)
+Bool lua_equalObj (Object *t1, Object *t2)
{
- while (n)
+ if (tag(t1) != tag(t2)) return 0;
+ switch (tag(t1))
+ {
+ case LUA_T_NIL: return 1;
+ case LUA_T_NUMBER: return nvalue(t1) == nvalue(t2);
+ case LUA_T_STRING: return streq(svalue(t1), svalue(t2));
+ case LUA_T_ARRAY: return avalue(t1) == avalue(t2);
+ case LUA_T_FUNCTION: return bvalue(t1) == bvalue(t2);
+ case LUA_T_CFUNCTION: return fvalue(t1) == fvalue(t2);
+ default: return uvalue(t1) == uvalue(t2);
+ }
+}
+
+static Word present (Hash *t, Object *ref)
+{
+ Word h = hashindex(t, ref);
+ while (tag(ref(node(t, h))) != LUA_T_NIL)
{
- Node *next = n->next;
- free (n);
- n = next;
+ if (lua_equalObj(ref, ref(node(t, h))))
+ return h;
+ h = (h+1) % nhash(t);
}
+ return h;
+}
+
+
+/*
+** Alloc a vector node
+*/
+static Node *hashnodecreate (Word nhash)
+{
+ Word i;
+ Node *v = newvector (nhash, Node);
+ for (i=0; i<nhash; i++)
+ tag(ref(&v[i])) = LUA_T_NIL;
+ return v;
}
/*
** Create a new hash. Return the hash pointer or NULL on error.
*/
-static Hash *hashcreate (unsigned int nhash)
+static Hash *hashcreate (Word nhash)
{
- Hash *t = new (Hash);
- if (t == NULL)
- {
- lua_error ("not enough memory");
- return NULL;
- }
+ Hash *t = new(Hash);
+ nhash = redimension((Word)((float)nhash/REHASH_LIMIT));
+ nodevector(t) = hashnodecreate(nhash);
nhash(t) = nhash;
+ nuse(t) = 0;
markarray(t) = 0;
- nodelist(t) = newvector (nhash, Node*);
- if (nodelist(t) == NULL)
- {
- lua_error ("not enough memory");
- return NULL;
- }
return t;
}
/*
** Delete a hash
*/
-static void hashdelete (Hash *h)
+static void hashdelete (Hash *t)
{
- int i;
- for (i=0; i<nhash(h); i++)
- freelist (list(h,i));
- free (nodelist(h));
- free(h);
+ luaI_free (nodevector(t));
+ luaI_free(t);
}
@@ -143,12 +152,12 @@ void lua_hashmark (Hash *h)
{
if (markarray(h) == 0)
{
- int i;
+ Word i;
markarray(h) = 1;
for (i=0; i<nhash(h); i++)
{
- Node *n;
- for (n = list(h,i); n != NULL; n = n->next)
+ Node *n = node(h,i);
+ if (tag(ref(n)) != LUA_T_NIL)
{
lua_markobject(&n->ref);
lua_markobject(&n->val);
@@ -156,92 +165,125 @@ void lua_hashmark (Hash *h)
}
}
}
+
+
+static void call_fallbacks (void)
+{
+ Hash *curr_array;
+ Object t;
+ tag(&t) = LUA_T_ARRAY;
+ for (curr_array = listhead; curr_array; curr_array = curr_array->next)
+ if (markarray(curr_array) != 1)
+ {
+ avalue(&t) = curr_array;
+ luaI_gcFB(&t);
+ }
+ tag(&t) = LUA_T_NIL;
+ luaI_gcFB(&t); /* end of list */
+}
+
/*
** Garbage collection to arrays
** Delete all unmarked arrays.
*/
-void lua_hashcollector (void)
+Long lua_hashcollector (void)
{
- ArrayList *curr = listhead, *prev = NULL;
- while (curr != NULL)
+ Hash *curr_array = listhead, *prev = NULL;
+ Long counter = 0;
+ call_fallbacks();
+ while (curr_array != NULL)
{
- ArrayList *next = curr->next;
- if (markarray(curr->array) != 1)
+ Hash *next = curr_array->next;
+ if (markarray(curr_array) != 1)
{
if (prev == NULL) listhead = next;
else prev->next = next;
- hashdelete(curr->array);
- free(curr);
+ hashdelete(curr_array);
+ ++counter;
}
else
{
- markarray(curr->array) = 0;
- prev = curr;
+ markarray(curr_array) = 0;
+ prev = curr_array;
}
- curr = next;
+ curr_array = next;
}
+ return counter;
}
/*
** Create a new array
-** This function insert the new array at array list. It also
-** execute garbage collection if the number of array created
+** This function inserts the new array in the array list. It also
+** executes garbage collection if the number of arrays created
** exceed a pre-defined range.
*/
-Hash *lua_createarray (int nhash)
+Hash *lua_createarray (Word nhash)
{
- ArrayList *new = new(ArrayList);
- if (new == NULL)
- {
- lua_error ("not enough memory");
- return NULL;
- }
- new->array = hashcreate(nhash);
- if (new->array == NULL)
+ Hash *array;
+ lua_pack();
+ array = hashcreate(nhash);
+ array->next = listhead;
+ listhead = array;
+ return array;
+}
+
+
+/*
+** Re-hash
+*/
+static void rehash (Hash *t)
+{
+ Word i;
+ Word nold = nhash(t);
+ Node *vold = nodevector(t);
+ nhash(t) = redimension(nhash(t));
+ nodevector(t) = hashnodecreate(nhash(t));
+ for (i=0; i<nold; i++)
{
- lua_error ("not enough memory");
- return NULL;
+ Node *n = vold+i;
+ if (tag(ref(n)) != LUA_T_NIL && tag(val(n)) != LUA_T_NIL)
+ *node(t, present(t, ref(n))) = *n; /* copy old node to new hahs */
}
+ luaI_free(vold);
+}
- if (lua_nentity == lua_block)
- lua_pack();
-
- lua_nentity++;
- new->next = listhead;
- listhead = new;
- return new->array;
+/*
+** If the hash node is present, return its pointer, otherwise return
+** null.
+*/
+Object *lua_hashget (Hash *t, Object *ref)
+{
+ Word h = present(t, ref);
+ if (tag(ref(node(t, h))) != LUA_T_NIL) return val(node(t, h));
+ else return NULL;
}
/*
** If the hash node is present, return its pointer, otherwise create a new
** node for the given reference and also return its pointer.
-** On error, return NULL.
*/
Object *lua_hashdefine (Hash *t, Object *ref)
{
- int h;
+ Word h;
Node *n;
- h = head (t, ref);
- if (h < 0) return NULL;
-
- n = present(t, ref, h);
- if (n == NULL)
+ h = present(t, ref);
+ n = node(t, h);
+ if (tag(ref(n)) == LUA_T_NIL)
{
- n = new(Node);
- if (n == NULL)
+ nuse(t)++;
+ if ((float)nuse(t) > (float)nhash(t)*REHASH_LIMIT)
{
- lua_error ("not enough memory");
- return NULL;
+ rehash(t);
+ h = present(t, ref);
+ n = node(t, h);
}
- n->ref = *ref;
- tag(&n->val) = T_NIL;
- n->next = list(t,h); /* link node to head of list */
- list(t,h) = n;
+ *ref(n) = *ref;
+ tag(val(n)) = LUA_T_NIL;
}
- return (&n->val);
+ return (val(n));
}
@@ -251,97 +293,44 @@ Object *lua_hashdefine (Hash *t, Object *ref)
** in the hash.
** This function pushs the element value and its reference to the stack.
*/
-static void firstnode (Hash *a, int h)
+static void hashnext (Hash *t, Word i)
{
- if (h < nhash(a))
- {
- int i;
- for (i=h; i<nhash(a); i++)
+ if (i >= nhash(t))
+ {
+ lua_pushnil(); lua_pushnil();
+ return;
+ }
+ while (tag(ref(node(t,i))) == LUA_T_NIL || tag(val(node(t,i))) == LUA_T_NIL)
+ {
+ if (++i >= nhash(t))
{
- if (list(a,i) != NULL)
- {
- if (tag(&list(a,i)->val) != T_NIL)
- {
- lua_pushobject (&list(a,i)->ref);
- lua_pushobject (&list(a,i)->val);
- return;
- }
- else
- {
- Node *next = list(a,i)->next;
- while (next != NULL && tag(&next->val) == T_NIL) next = next->next;
- if (next != NULL)
- {
- lua_pushobject (&next->ref);
- lua_pushobject (&next->val);
- return;
- }
- }
- }
+ lua_pushnil(); lua_pushnil();
+ return;
}
}
- lua_pushnil();
- lua_pushnil();
+ luaI_pushobject(ref(node(t,i)));
+ luaI_pushobject(val(node(t,i)));
}
+
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)
+ Hash *t;
+ lua_Object o = lua_getparam(1);
+ lua_Object r = lua_getparam(2);
+ if (o == LUA_NOOBJECT || r == LUA_NOOBJECT)
+ lua_error ("too few arguments to function `next'");
+ if (lua_getparam(3) != LUA_NOOBJECT)
+ lua_error ("too many arguments to function `next'");
+ if (!lua_istable(o))
+ lua_error ("first argument of function `next' is not a table");
+ t = avalue(luaI_Address(o));
+ if (lua_isnil(r))
{
- firstnode (a, 0);
- return;
+ hashnext(t, 0);
}
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");
- }
+ Word h = present (t, luaI_Address(r));
+ hashnext(t, h+1);
}
}
diff --git a/src/hash.h b/src/hash.h
index 060031a5..2af6ce16 100644
--- a/src/hash.h
+++ b/src/hash.h
@@ -2,30 +2,35 @@
** hash.h
** hash manager for lua
** Luiz Henrique de Figueiredo - 17 Aug 90
-** $Id: hash.h,v 2.1 1994/04/20 22:07:57 celes Exp $
+** $Id: hash.h,v 2.8 1995/01/12 14:19:04 roberto Exp $
*/
#ifndef hash_h
#define hash_h
+#include "types.h"
+
typedef struct node
{
Object ref;
Object val;
- struct node *next;
} Node;
typedef struct Hash
{
+ struct Hash *next;
char mark;
- unsigned int nhash;
- Node **list;
+ Word nhash;
+ Word nuse;
+ Node *node;
} Hash;
-Hash *lua_createarray (int nhash);
+Bool lua_equalObj (Object *t1, Object *t2);
+Hash *lua_createarray (Word nhash);
void lua_hashmark (Hash *h);
-void lua_hashcollector (void);
+Long lua_hashcollector (void);
+Object *lua_hashget (Hash *t, Object *ref);
Object *lua_hashdefine (Hash *t, Object *ref);
void lua_next (void);
diff --git a/src/inout.c b/src/inout.c
index d985c1b7..7bd7c235 100644
--- a/src/inout.c
+++ b/src/inout.c
@@ -2,49 +2,54 @@
** inout.c
** Provide function to realise the input/output function and debugger
** facilities.
+** Also provides some predefined lua functions.
*/
-char *rcs_inout="$Id: inout.c,v 1.2 1993/12/22 21:15:16 roberto Exp $";
+char *rcs_inout="$Id: inout.c,v 2.16 1994/12/20 21:20:36 roberto Exp $";
#include <stdio.h>
+#include <stdlib.h>
#include <string.h>
+#include "mem.h"
#include "opcode.h"
#include "hash.h"
#include "inout.h"
#include "table.h"
+#include "tree.h"
+#include "lua.h"
/* Exported variables */
-int lua_linenumber;
-int lua_debug;
-int lua_debugline;
+Word lua_linenumber;
+Bool lua_debug;
+Word lua_debugline = 0;
+
/* Internal variables */
+
#ifndef MAXFUNCSTACK
-#define MAXFUNCSTACK 32
+#define MAXFUNCSTACK 100
#endif
-static struct { int file; int function; } funcstack[MAXFUNCSTACK];
-static int nfuncstack=0;
+
+typedef struct FuncStackNode {
+ struct FuncStackNode *next;
+ char *file;
+ Word function;
+ Word line;
+} FuncStackNode;
+
+static FuncStackNode *funcStack = NULL;
+static Word 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);
+ return fgetc (fp);
}
/*
@@ -52,22 +57,25 @@ static int fileinput (void)
*/
static int stringinput (void)
{
- st++;
- return (*(st-1));
+ return *st++;
}
/*
** Function to open a file to be input unit.
-** Return 0 on success or 1 on error.
+** Return 0 on success or error message on error.
*/
-int lua_openfile (char *fn)
+char *lua_openfile (char *fn)
{
lua_linenumber = 1;
lua_setinput (fileinput);
fp = fopen (fn, "r");
- if (fp == NULL) return 1;
- if (lua_addfile (fn)) return 1;
- return 0;
+ if (fp == NULL)
+ {
+ static char buff[32];
+ sprintf(buff, "unable to open file %.10s", fn);
+ return buff;
+ }
+ return lua_addfile (fn);
}
/*
@@ -86,7 +94,7 @@ void lua_closefile (void)
/*
** Function to open a string to be input unit
*/
-int lua_openstring (char *s)
+char *lua_openstring (char *s)
{
lua_linenumber = 1;
lua_setinput (stringinput);
@@ -94,9 +102,8 @@ int lua_openstring (char *s)
{
char sn[64];
sprintf (sn, "String: %10.10s...", s);
- if (lua_addfile (sn)) return 1;
+ return lua_addfile (sn);
}
- return 0;
}
/*
@@ -107,40 +114,38 @@ void lua_closestring (void)
lua_delfile();
}
-/*
-** 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.
+** function stack.
*/
-int lua_pushfunction (int file, int function)
+void lua_pushfunction (char *file, Word function)
{
- if (nfuncstack >= MAXFUNCSTACK-1)
+ FuncStackNode *newNode;
+ if (nfuncstack++ >= MAXFUNCSTACK)
{
- lua_error ("function stack overflow");
- return 1;
+ lua_reportbug("function stack overflow");
}
- funcstack[nfuncstack].file = file;
- funcstack[nfuncstack].function = function;
- nfuncstack++;
- return 0;
+ newNode = new(FuncStackNode);
+ newNode->function = function;
+ newNode->file = file;
+ newNode->line= lua_debugline;
+ newNode->next = funcStack;
+ funcStack = newNode;
}
/*
-** Called to execute RESET opcode, this function pops a function from
+** Called to execute RESET opcode, this function pops a function from
** function stack.
*/
void lua_popfunction (void)
{
- nfuncstack--;
+ FuncStackNode *temp = funcStack;
+ if (temp == NULL) return;
+ --nfuncstack;
+ lua_debugline = temp->line;
+ funcStack = temp->next;
+ luaI_free(temp);
}
/*
@@ -148,30 +153,142 @@ void lua_popfunction (void)
*/
void lua_reportbug (char *s)
{
- char msg[1024];
+ char msg[MAXFUNCSTACK*80];
strcpy (msg, s);
if (lua_debugline != 0)
{
- int i;
- if (nfuncstack > 0)
+ if (funcStack)
{
- 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]);
+ FuncStackNode *func = funcStack;
+ int line = lua_debugline;
+ sprintf (strchr(msg,0), "\n\tactive stack:\n");
+ do
+ {
+ sprintf (strchr(msg,0),
+ "\t-> function \"%s\" at file \"%s\":%u\n",
+ lua_constant[func->function]->str, func->file, line);
+ line = func->line;
+ func = func->next;
+ lua_popfunction();
+ } while (func);
}
else
{
sprintf (strchr(msg,0),
- "\n\tin statement begining at line %d of file \"%s\"",
+ "\n\tin statement begining at line %u of file \"%s\"",
lua_debugline, lua_filename());
}
}
lua_error (msg);
}
+
+/*
+** Internal function: do a string
+*/
+void lua_internaldostring (void)
+{
+ lua_Object obj = lua_getparam (1);
+ if (lua_isstring(obj) && !lua_dostring(lua_getstring(obj)))
+ lua_pushnumber(1);
+ else
+ lua_pushnil();
+}
+
+/*
+** Internal function: do a file
+*/
+void lua_internaldofile (void)
+{
+ lua_Object obj = lua_getparam (1);
+ if (lua_isstring(obj) && !lua_dofile(lua_getstring(obj)))
+ lua_pushnumber(1);
+ else
+ lua_pushnil();
+}
+
+/*
+** Internal function: print object values
+*/
+void lua_print (void)
+{
+ int i=1;
+ lua_Object obj;
+ while ((obj=lua_getparam (i++)) != LUA_NOOBJECT)
+ {
+ if (lua_isnumber(obj)) printf("%g\n",lua_getnumber(obj));
+ else if (lua_isstring(obj)) printf("%s\n",lua_getstring(obj));
+ else if (lua_isfunction(obj)) printf("function: %p\n",bvalue(luaI_Address(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",avalue(luaI_Address(obj)));
+ else if (lua_isnil(obj)) printf("nil\n");
+ else printf("invalid value to print\n");
+ }
+}
+
+
+/*
+** Internal function: return an object type.
+*/
+void luaI_type (void)
+{
+ lua_Object o = lua_getparam(1);
+ if (o == LUA_NOOBJECT)
+ lua_error("no parameter to function 'type'");
+ switch (lua_type(o))
+ {
+ case LUA_T_NIL :
+ lua_pushliteral("nil");
+ break;
+ case LUA_T_NUMBER :
+ lua_pushliteral("number");
+ break;
+ case LUA_T_STRING :
+ lua_pushliteral("string");
+ break;
+ case LUA_T_ARRAY :
+ lua_pushliteral("table");
+ break;
+ case LUA_T_FUNCTION :
+ lua_pushliteral("function");
+ break;
+ case LUA_T_CFUNCTION :
+ lua_pushliteral("cfunction");
+ break;
+ default :
+ lua_pushliteral("userdata");
+ break;
+ }
+}
+
+/*
+** Internal function: convert an object to a number
+*/
+void lua_obj2number (void)
+{
+ lua_Object o = lua_getparam(1);
+ if (lua_isnumber(o))
+ lua_pushobject(o);
+ else if (lua_isstring(o))
+ {
+ char c;
+ float f;
+ if (sscanf(lua_getstring(o),"%f %c",&f,&c) == 1)
+ lua_pushnumber(f);
+ else
+ lua_pushnil();
+ }
+ else
+ lua_pushnil();
+}
+
+
+void luaI_error (void)
+{
+ char *s = lua_getstring(lua_getparam(1));
+ if (s == NULL) s = "(no message)";
+ lua_reportbug(s);
+}
+
diff --git a/src/inout.h b/src/inout.h
index ca5920ca..22093020 100644
--- a/src/inout.h
+++ b/src/inout.h
@@ -1,21 +1,30 @@
/*
-** $Id: inout.h,v 1.1 1993/12/17 18:41:19 celes Exp $
+** $Id: inout.h,v 1.7 1994/12/20 21:20:36 roberto Exp $
*/
#ifndef inout_h
#define inout_h
-extern int lua_linenumber;
-extern int lua_debug;
-extern int lua_debugline;
+#include "types.h"
-int lua_openfile (char *fn);
+extern Word lua_linenumber;
+extern Bool lua_debug;
+extern Word lua_debugline;
+
+char *lua_openfile (char *fn);
void lua_closefile (void);
-int lua_openstring (char *s);
+char *lua_openstring (char *s);
void lua_closestring (void);
-int lua_pushfunction (int file, int function);
+void lua_pushfunction (char *file, Word function);
void lua_popfunction (void);
void lua_reportbug (char *s);
+void lua_internaldofile (void);
+void lua_internaldostring (void);
+void lua_print (void);
+void luaI_type (void);
+void lua_obj2number (void);
+void luaI_error (void);
+
#endif
diff --git a/src/lex.c b/src/lex.c
index 14f41434..2916084f 100644
--- a/src/lex.c
+++ b/src/lex.c
@@ -1,30 +1,20 @@
-char *rcs_lex = "$Id: lex.c,v 2.1 1994/04/15 19:00:28 celes Exp $";
-/*$Log: lex.c,v $
- * Revision 2.1 1994/04/15 19:00:28 celes
- * Retirar chamada da funcao lua_findsymbol associada a cada
- * token NAME. A decisao de chamar lua_findsymbol ou lua_findconstant
- * fica a cargo do modulo "lua.stx".
- *
- * Revision 1.3 1993/12/28 16:42:29 roberto
- * "include"s de string.h e stdlib.h para evitar warnings
- *
- * Revision 1.2 1993/12/22 21:39:15 celes
- * Tratamento do token $debug e $nodebug
- *
- * Revision 1.1 1993/12/22 21:15:16 roberto
- * Initial revision
- **/
+char *rcs_lex = "$Id: lex.c,v 2.14 1994/12/27 20:50:38 celes Exp $";
+
#include <ctype.h>
#include <math.h>
+#include <stdio.h>
#include <stdlib.h>
#include <string.h>
+#include "tree.h"
+#include "table.h"
#include "opcode.h"
-#include "hash.h"
#include "inout.h"
-#include "table.h"
-#include "y.tab.h"
+#include "parser.h"
+#include "ugly.h"
+
+#define lua_strcmp(a,b) (a[0]<b[0]?(-1):(a[0]>b[0]?(1):strcmp(a,b)))
#define next() { current = input(); }
#define save(x) { *yytextLast++ = (x); }
@@ -49,7 +39,8 @@ char *lua_lasttext (void)
}
-static struct
+/* The reserved words must be listed in lexicographic order */
+static struct
{
char *name;
int token;
@@ -71,17 +62,18 @@ static struct
{"until", UNTIL},
{"while", WHILE} };
+
#define RESERVEDSIZE (sizeof(reserved)/sizeof(reserved[0]))
-int findReserved (char *name)
+static int findReserved (char *name)
{
int l = 0;
int h = RESERVEDSIZE - 1;
while (l <= h)
{
int m = (l+h)/2;
- int comp = strcmp(name, reserved[m].name);
+ int comp = lua_strcmp(name, reserved[m].name);
if (comp < 0)
h = m-1;
else if (comp == 0)
@@ -93,13 +85,20 @@ int findReserved (char *name)
}
-int yylex ()
+int yylex (void)
{
+ float a;
while (1)
{
yytextLast = yytext;
+#if 0
+ fprintf(stderr,"'%c' %d\n",current,current);
+#endif
switch (current)
{
+ case EOF:
+ case 0:
+ return 0;
case '\n': lua_linenumber++;
case ' ':
case '\t':
@@ -111,34 +110,39 @@ int yylex ()
while (isalnum(current) || current == '_')
save_and_next();
*yytextLast = 0;
- if (strcmp(yytext, "debug") == 0)
+ if (lua_strcmp(yytext, "debug") == 0)
{
yylval.vInt = 1;
return DEBUG;
}
- else if (strcmp(yytext, "nodebug") == 0)
+ else if (lua_strcmp(yytext, "nodebug") == 0)
{
yylval.vInt = 0;
return DEBUG;
}
return WRONGTOKEN;
-
+
case '-':
save_and_next();
if (current != '-') return '-';
do { next(); } while (current != '\n' && current != 0);
continue;
-
+
+ case '=':
+ save_and_next();
+ if (current != '=') return '=';
+ else { save_and_next(); return EQ; }
+
case '<':
save_and_next();
if (current != '=') return '<';
else { save_and_next(); return LE; }
-
+
case '>':
save_and_next();
if (current != '=') return '>';
else { save_and_next(); return GE; }
-
+
case '~':
save_and_next();
if (current != '=') return '~';
@@ -149,12 +153,13 @@ int yylex ()
{
int del = current;
next(); /* skip the delimiter */
- while (current != del)
+ while (current != del)
{
switch (current)
{
- case 0:
- case '\n':
+ case EOF:
+ case 0:
+ case '\n':
return WRONGTOKEN;
case '\\':
next(); /* do not save the '\' */
@@ -163,16 +168,16 @@ int yylex ()
case 'n': save('\n'); next(); break;
case 't': save('\t'); next(); break;
case 'r': save('\r'); next(); break;
- default : save('\\'); break;
+ default : save(current); next(); break;
}
break;
- default:
+ default:
save_and_next();
}
}
next(); /* skip the delimiter */
*yytextLast = 0;
- yylval.vWord = lua_findconstant (yytext);
+ yylval.vWord = luaI_findconstant(lua_constcreate(yytext));
return STRING;
}
@@ -190,49 +195,77 @@ int yylex ()
case 'Z':
case '_':
{
- int res;
+ Word res;
do { save_and_next(); } while (isalnum(current) || current == '_');
*yytextLast = 0;
res = findReserved(yytext);
if (res) return res;
- yylval.pChar = yytext;
+ yylval.pNode = lua_constcreate(yytext);
return NAME;
}
-
+
case '.':
save_and_next();
- if (current == '.')
- {
- save_and_next();
+ if (current == '.')
+ {
+ save_and_next();
return CONC;
}
else if (!isdigit(current)) return '.';
/* current is a digit: goes through to number */
+ a=0.0;
goto fraction;
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
-
- do { save_and_next(); } while (isdigit(current));
+ a=0.0;
+ do { a=10*a+current-'0'; save_and_next(); } while (isdigit(current));
if (current == '.') save_and_next();
-fraction: while (isdigit(current)) save_and_next();
- if (current == 'e' || current == 'E')
- {
- save_and_next();
- if (current == '+' || current == '-') save_and_next();
- if (!isdigit(current)) return WRONGTOKEN;
- do { save_and_next(); } while (isdigit(current));
+fraction:
+ { float da=0.1;
+ while (isdigit(current))
+ {a+=(current-'0')*da; da/=10.0; save_and_next()};
+ if (current == 'e' || current == 'E')
+ {
+ int e=0;
+ int neg;
+ float ea;
+ save_and_next();
+ neg=(current=='-');
+ if (current == '+' || current == '-') save_and_next();
+ if (!isdigit(current)) return WRONGTOKEN;
+ do { e=10*e+current-'0'; save_and_next(); } while (isdigit(current));
+ for (ea=neg?0.1:10.0; e>0; e>>=1)
+ {
+ if (e & 1) a*=ea;
+ ea*=ea;
+ }
+ }
+ yylval.vFloat = a;
+ return NUMBER;
}
- *yytextLast = 0;
- yylval.vFloat = atof(yytext);
- return NUMBER;
+
+ case U_and: case U_do: case U_else: case U_elseif: case U_end:
+ case U_function: case U_if: case U_local: case U_nil: case U_not:
+ case U_or: case U_repeat: case U_return: case U_then:
+ case U_until: case U_while:
+ {
+ int old = current;
+ next();
+ return reserved[old-U_and].token;
+ }
+
+ case U_eq: next(); return EQ;
+ case U_le: next(); return LE;
+ case U_ge: next(); return GE;
+ case U_ne: next(); return NE;
+ case U_sc: next(); return CONC;
default: /* also end of file */
{
save_and_next();
- return *yytext;
+ return yytext[0];
}
}
}
}
-
diff --git a/src/mem.c b/src/mem.c
new file mode 100644
index 00000000..90369720
--- /dev/null
+++ b/src/mem.c
@@ -0,0 +1,44 @@
+/*
+** mem.c
+** TecCGraf - PUC-Rio
+*/
+
+char *rcs_mem = "$Id: mem.c,v 1.5 1995/02/06 19:34:03 roberto Exp $";
+
+#include <stdlib.h>
+#include <string.h>
+
+#include "mem.h"
+#include "lua.h"
+
+void luaI_free (void *block)
+{
+ *((int *)block) = -1; /* to catch errors */
+ free(block);
+}
+
+
+void *luaI_malloc (unsigned long size)
+{
+ void *block = malloc((size_t)size);
+ if (block == NULL)
+ lua_error("not enough memory");
+ return block;
+}
+
+
+void *luaI_realloc (void *oldblock, unsigned long size)
+{
+ void *block = realloc(oldblock, (size_t)size);
+ if (block == NULL)
+ lua_error("not enough memory");
+ return block;
+}
+
+
+char *luaI_strdup (char *str)
+{
+ char *newstr = luaI_malloc(strlen(str)+1);
+ strcpy(newstr, str);
+ return newstr;
+}
diff --git a/src/mem.h b/src/mem.h
new file mode 100644
index 00000000..bae5b4d3
--- /dev/null
+++ b/src/mem.h
@@ -0,0 +1,25 @@
+/*
+** mem.c
+** memory manager for lua
+** $Id: mem.h,v 1.2 1995/01/13 22:11:12 roberto Exp $
+*/
+
+#ifndef mem_h
+#define mem_h
+
+#ifndef NULL
+#define NULL 0
+#endif
+
+void luaI_free (void *block);
+void *luaI_malloc (unsigned long size);
+void *luaI_realloc (void *oldblock, unsigned long size);
+
+char *luaI_strdup (char *str);
+
+#define new(s) ((s *)luaI_malloc(sizeof(s)))
+#define newvector(n,s) ((s *)luaI_malloc((n)*sizeof(s)))
+#define growvector(old,n,s) ((s *)luaI_realloc(old,(n)*sizeof(s)))
+
+#endif
+
diff --git a/src/opcode.c b/src/opcode.c
index 6006f7ac..7ce5b2a6 100644
--- a/src/opcode.c
+++ b/src/opcode.c
@@ -3,171 +3,763 @@
** TecCGraf - PUC-Rio
*/
-char *rcs_opcode="$Id: opcode.c,v 2.1 1994/04/20 22:07:57 celes Exp $";
+char *rcs_opcode="$Id: opcode.c,v 3.34 1995/02/06 19:35:09 roberto Exp $";
-#include <stdio.h>
+#include <setjmp.h>
#include <stdlib.h>
+#include <stdio.h>
#include <string.h>
+#include <math.h>
-/* stdlib.h does not have this in SunOS */
-extern double strtod(const char *, char **);
-
-#include "mm.h"
-
+#include "mem.h"
#include "opcode.h"
#include "hash.h"
#include "inout.h"
#include "table.h"
#include "lua.h"
+#include "fallback.h"
+
+#define tonumber(o) ((tag(o) != LUA_T_NUMBER) && (lua_tonumber(o) != 0))
+#define tostring(o) ((tag(o) != LUA_T_STRING) && (lua_tostring(o) != 0))
+
+
+#define STACK_BUFFER (STACKGAP+128)
+
+typedef int StkId; /* index to stack elements */
+
+static Long maxstack = 0L;
+static Object *stack = NULL;
+static Object *top = NULL;
+
+
+/* macros to convert from lua_Object to (Object *) and back */
+
+#define Address(lo) ((lo)+stack-1)
+#define Ref(st) ((st)-stack+1)
+
+
+static StkId CBase = 0; /* when Lua calls C or C calls Lua, points to */
+ /* the first slot after the last parameter. */
+static int CnResults = 0; /* when Lua calls C, has the number of parameters; */
+ /* when C calls Lua, has the number of results. */
-#define tonumber(o) ((tag(o) != T_NUMBER) && (lua_tonumber(o) != 0))
-#define tostring(o) ((tag(o) != T_STRING) && (lua_tostring(o) != 0))
+static jmp_buf *errorJmp = NULL; /* current error recover point */
-#ifndef MAXSTACK
-#define MAXSTACK 256
-#endif
-static Object stack[MAXSTACK] = {{T_MARK, {NULL}}};
-static Object *top=stack+1, *base=stack+1;
+
+static StkId lua_execute (Byte *pc, StkId base);
+static void do_call (Object *func, StkId base, int nResults, StkId whereRes);
+
+
+
+Object *luaI_Address (lua_Object o)
+{
+ return Address(o);
+}
/*
-** Concatenate two given string, creating a mark space at the beginning.
-** Return the new string pointer.
+** Error messages
*/
-static char *lua_strconc (char *l, char *r)
+
+static void lua_message (char *s)
{
- 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);
+ lua_pushstring(s);
+ do_call(&luaI_fallBacks[FB_ERROR].function, (top-stack)-1, 0, (top-stack)-1);
}
/*
-** Duplicate a string, creating a mark space at the beginning.
-** Return the new string pointer.
+** Reports an error, and jumps up to the available recover label
*/
-char *lua_strdup (char *l)
+void lua_error (char *s)
{
- 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);
+ if (s) lua_message(s);
+ if (errorJmp)
+ longjmp(*errorJmp, 1);
+ else
+ {
+ fprintf (stderr, "lua: exit(1). Unable to recover\n");
+ exit(1);
+ }
}
+
/*
-** Convert, if possible, to a number tag.
-** Return 0 in success or not 0 on error.
-*/
-static int lua_tonumber (Object *obj)
+** Init stack
+*/
+static void lua_initstack (void)
{
- 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;
+ maxstack = STACK_BUFFER;
+ stack = newvector(maxstack, Object);
+ top = stack;
}
+
/*
-** 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)
+** Check stack overflow and, if necessary, realloc vector
+*/
+#define lua_checkstack(n) if ((Long)(n) > maxstack) checkstack(n)
+
+static void checkstack (StkId n)
{
- static Object cvt;
-
- if (tag(obj) == T_NUMBER)
- {
- cvt = *obj;
- return &cvt;
- }
-
- tag(&cvt) = T_NIL;
- if (tag(obj) == T_STRING)
+ StkId t;
+ if (stack == NULL)
+ lua_initstack();
+ if (maxstack >= MAX_INT)
+ lua_error("stack size overflow");
+ t = top-stack;
+ maxstack *= 2;
+ if (maxstack >= MAX_INT)
+ maxstack = MAX_INT;
+ stack = growvector(stack, maxstack, Object);
+ top = stack + t;
+}
+
+
+/*
+** Concatenate two given strings. Return the new string pointer.
+*/
+static char *lua_strconc (char *l, char *r)
+{
+ static char *buffer = NULL;
+ static int buffer_size = 0;
+ int nl = strlen(l);
+ int n = nl+strlen(r)+1;
+ if (n > buffer_size)
+ {
+ buffer_size = n;
+ if (buffer != NULL)
+ luaI_free(buffer);
+ buffer = newvector(buffer_size, char);
+ }
+ strcpy(buffer,l);
+ strcpy(buffer+nl, r);
+ return buffer;
+}
+
+
+/*
+** Convert, if possible, to a number object.
+** Return 0 if success, not 0 if error.
+*/
+static int lua_tonumber (Object *obj)
+{
+ float t;
+ char c;
+ if (tag(obj) != LUA_T_STRING)
+ return 1;
+ else if (sscanf(svalue(obj), "%f %c",&t, &c) == 1)
{
- char *ptr;
- nvalue(&cvt) = strtod(svalue(obj), &ptr);
- if (*ptr == 0)
- tag(&cvt) = T_NUMBER;
+ nvalue(obj) = t;
+ tag(obj) = LUA_T_NUMBER;
+ return 0;
}
- return &cvt;
+ else
+ return 2;
}
-
/*
** 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 (tag(obj) != LUA_T_NUMBER)
+ return 1;
if ((int) nvalue(obj) == nvalue(obj))
- sprintf (s, "%d", (int) 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)
+ sprintf (s, "%g", nvalue(obj));
+ tsvalue(obj) = lua_createstring(s);
+ if (tsvalue(obj) == NULL)
return 1;
- tag(obj) = T_STRING;
+ tag(obj) = LUA_T_STRING;
return 0;
}
/*
-** Execute the given opcode. Return 0 in success or 1 on error.
+** Adjust stack. Set top to the given value, pushing NILs if needed.
+*/
+static void adjust_top (StkId newtop)
+{
+ Object *nt = stack+newtop;
+ while (top < nt) tag(top++) = LUA_T_NIL;
+ top = nt; /* top could be bigger than newtop */
+}
+
+
+static void adjustC (int nParams)
+{
+ adjust_top(CBase+nParams);
+}
+
+
+/*
+** Call a C function. CBase will point to the top of the stack,
+** and CnResults is the number of parameters. Returns an index
+** to the first result from C.
+*/
+static StkId callC (lua_CFunction func, StkId base)
+{
+ StkId oldBase = CBase;
+ int oldCnResults = CnResults;
+ StkId firstResult;
+ CnResults = (top-stack) - base;
+ /* incorporate parameters on the stack */
+ CBase = base+CnResults;
+ (*func)();
+ firstResult = CBase;
+ CBase = oldBase;
+ CnResults = oldCnResults;
+ return firstResult;
+}
+
+/*
+** Call the fallback for invalid functions (see do_call)
+*/
+static void call_funcFB (Object *func, StkId base, int nResults, StkId whereRes)
+{
+ StkId i;
+ /* open space for first parameter (func) */
+ for (i=top-stack; i>base; i--)
+ stack[i] = stack[i-1];
+ top++;
+ stack[base] = *func;
+ do_call(&luaI_fallBacks[FB_FUNCTION].function, base, nResults, whereRes);
+}
+
+
+/*
+** Call a function (C or Lua). The parameters must be on the stack,
+** between [stack+base,top). When returns, the results are on the stack,
+** between [stack+whereRes,top). The number of results is nResults, unless
+** nResults=MULT_RET.
+*/
+static void do_call (Object *func, StkId base, int nResults, StkId whereRes)
+{
+ StkId firstResult;
+ if (tag(func) == LUA_T_CFUNCTION)
+ firstResult = callC(fvalue(func), base);
+ else if (tag(func) == LUA_T_FUNCTION)
+ firstResult = lua_execute(bvalue(func), base);
+ else
+ { /* func is not a function */
+ call_funcFB(func, base, nResults, whereRes);
+ return;
+ }
+ /* adjust the number of results */
+ if (nResults != MULT_RET && top - (stack+firstResult) != nResults)
+ adjust_top(firstResult+nResults);
+ /* move results to the given position */
+ if (firstResult != whereRes)
+ {
+ int i;
+ nResults = top - (stack+firstResult); /* actual number of results */
+ for (i=0; i<nResults; i++)
+ *(stack+whereRes+i) = *(stack+firstResult+i);
+ top -= firstResult-whereRes;
+ }
+}
+
+
+/*
+** Function to index a table. Receives the table at top-2 and the index
+** at top-1.
+*/
+static void pushsubscript (void)
+{
+ if (tag(top-2) != LUA_T_ARRAY)
+ do_call(&luaI_fallBacks[FB_GETTABLE].function, (top-stack)-2, 1, (top-stack)-2);
+ else
+ {
+ Object *h = lua_hashget(avalue(top-2), top-1);
+ if (h == NULL || tag(h) == LUA_T_NIL)
+ do_call(&luaI_fallBacks[FB_INDEX].function, (top-stack)-2, 1, (top-stack)-2);
+ else
+ {
+ --top;
+ *(top-1) = *h;
+ }
+ }
+}
+
+
+/*
+** Function to store indexed based on values at the top
+*/
+static void storesubscript (void)
+{
+ if (tag(top-3) != LUA_T_ARRAY)
+ do_call(&luaI_fallBacks[FB_SETTABLE].function, (top-stack)-3, 0, (top-stack)-3);
+ else
+ {
+ Object *h = lua_hashdefine (avalue(top-3), top-2);
+ *h = *(top-1);
+ top -= 3;
+ }
+}
+
+
+/*
+** Traverse all objects on stack
+*/
+void lua_travstack (void (*fn)(Object *))
+{
+ Object *o;
+ for (o = top-1; o >= stack; o--)
+ fn (o);
+}
+
+
+/*
+** Execute a protected call. If function is null compiles the pre-set input.
+** Leave nResults on the stack.
+*/
+static int do_protectedrun (Object *function, int nResults)
+{
+ jmp_buf myErrorJmp;
+ int status;
+ StkId oldCBase = CBase;
+ jmp_buf *oldErr = errorJmp;
+ errorJmp = &myErrorJmp;
+ if (setjmp(myErrorJmp) == 0)
+ {
+ do_call(function, CBase, nResults, CBase);
+ CnResults = (top-stack) - CBase; /* number of results */
+ CBase += CnResults; /* incorporate results on the stack */
+ status = 0;
+ }
+ else
+ {
+ CBase = oldCBase;
+ top = stack+CBase;
+ status = 1;
+ }
+ errorJmp = oldErr;
+ return status;
+}
+
+
+static int do_protectedmain (void)
+{
+ Byte *code = NULL;
+ int status;
+ StkId oldCBase = CBase;
+ jmp_buf myErrorJmp;
+ jmp_buf *oldErr = errorJmp;
+ errorJmp = &myErrorJmp;
+ if (setjmp(myErrorJmp) == 0)
+ {
+ Object f;
+ lua_parse(&code);
+ tag(&f) = LUA_T_FUNCTION; bvalue(&f) = code;
+ do_call(&f, CBase, 0, CBase);
+ status = 0;
+ }
+ else
+ status = 1;
+ if (code)
+ luaI_free(code);
+ errorJmp = oldErr;
+ CBase = oldCBase;
+ top = stack+CBase;
+ return status;
+}
+
+
+/*
+** Execute the given lua function. Return 0 on success or 1 on error.
+*/
+int lua_callfunction (lua_Object function)
+{
+ if (function == LUA_NOOBJECT)
+ return 1;
+ else
+ return do_protectedrun (Address(function), MULT_RET);
+}
+
+
+int lua_call (char *funcname)
+{
+ Word n = luaI_findsymbolbyname(funcname);
+ return do_protectedrun(&s_object(n), MULT_RET);
+}
+
+
+/*
+** Open file, generate opcode and execute global statement. Return 0 on
+** success or 1 on error.
+*/
+int lua_dofile (char *filename)
+{
+ int status;
+ char *message = lua_openfile (filename);
+ if (message)
+ {
+ lua_message(message);
+ return 1;
+ }
+ status = do_protectedmain();
+ lua_closefile();
+ return status;
+}
+
+/*
+** Generate opcode stored on string and execute global statement. Return 0 on
+** success or 1 on error.
+*/
+int lua_dostring (char *string)
+{
+ int status;
+ char *message = lua_openstring(string);
+ if (message)
+ {
+ lua_message(message);
+ return 1;
+ }
+ status = do_protectedmain();
+ lua_closestring();
+ return status;
+}
+
+
+/*
+** API: set a function as a fallback
+*/
+lua_Object lua_setfallback (char *name, lua_CFunction fallback)
+{
+ static Object func = {LUA_T_CFUNCTION, luaI_setfallback};
+ adjustC(0);
+ lua_pushstring(name);
+ lua_pushcfunction(fallback);
+ do_protectedrun(&func, 1);
+ return (Ref(top-1));
+}
+
+
+/*
+** API: receives on the stack the table and the index.
+** returns the value.
+*/
+lua_Object lua_getsubscript (void)
+{
+ adjustC(2);
+ pushsubscript();
+ CBase++; /* incorporate object in the stack */
+ return (Ref(top-1));
+}
+
+
+#define MAX_C_BLOCKS 10
+
+static int numCblocks = 0;
+static StkId Cblocks[MAX_C_BLOCKS];
+
+/*
+** API: starts a new block
+*/
+void lua_beginblock (void)
+{
+ if (numCblocks < MAX_C_BLOCKS)
+ Cblocks[numCblocks] = CBase;
+ numCblocks++;
+}
+
+/*
+** API: ends a block
+*/
+void lua_endblock (void)
+{
+ --numCblocks;
+ if (numCblocks < MAX_C_BLOCKS)
+ {
+ CBase = Cblocks[numCblocks];
+ adjustC(0);
+ }
+}
+
+/*
+** API: receives on the stack the table, the index, and the new value.
+*/
+void lua_storesubscript (void)
+{
+ adjustC(3);
+ storesubscript();
+}
+
+/*
+** API: creates a new table
+*/
+lua_Object lua_createtable (void)
+{
+ adjustC(0);
+ avalue(top) = lua_createarray(0);
+ tag(top) = LUA_T_ARRAY;
+ top++;
+ CBase++; /* incorporate object in the stack */
+ return Ref(top-1);
+}
+
+/*
+** Get a parameter, returning the object handle or LUA_NOOBJECT on error.
+** 'number' must be 1 to get the first parameter.
+*/
+lua_Object lua_getparam (int number)
+{
+ if (number <= 0 || number > CnResults) return LUA_NOOBJECT;
+ /* Ref(stack+(CBase-CnResults+number-1)) ==
+ stack+(CBase-CnResults+number-1)-stack+1 == */
+ return CBase-CnResults+number;
+}
+
+/*
+** Given an object handle, return its number value. On error, return 0.0.
+*/
+real lua_getnumber (lua_Object object)
+{
+ if (object == LUA_NOOBJECT || tag(Address(object)) == LUA_T_NIL) return 0.0;
+ if (tonumber (Address(object))) return 0.0;
+ else return (nvalue(Address(object)));
+}
+
+/*
+** Given an object handle, return its string pointer. On error, return NULL.
+*/
+char *lua_getstring (lua_Object object)
+{
+ if (object == LUA_NOOBJECT || tag(Address(object)) == LUA_T_NIL) return NULL;
+ if (tostring (Address(object))) return NULL;
+ else return (svalue(Address(object)));
+}
+
+/*
+** Given an object handle, return its cfuntion pointer. On error, return NULL.
+*/
+lua_CFunction lua_getcfunction (lua_Object object)
+{
+ if (object == LUA_NOOBJECT || tag(Address(object)) != LUA_T_CFUNCTION)
+ return NULL;
+ else return (fvalue(Address(object)));
+}
+
+/*
+** Given an object handle, return its user data. On error, return NULL.
+*/
+void *lua_getuserdata (lua_Object object)
+{
+ if (object == LUA_NOOBJECT || tag(Address(object)) < LUA_T_USERDATA)
+ return NULL;
+ else return (uvalue(Address(object)));
+}
+
+
+lua_Object lua_getlocked (int ref)
+{
+ adjustC(0);
+ *top = *luaI_getlocked(ref);
+ top++;
+ CBase++; /* incorporate object in the stack */
+ return Ref(top-1);
+}
+
+
+void lua_pushlocked (int ref)
+{
+ lua_checkstack(top-stack+1);
+ *top = *luaI_getlocked(ref);
+ top++;
+}
+
+
+int lua_lock (void)
+{
+ adjustC(1);
+ return luaI_lock(--top);
+}
+
+
+/*
+** Get a global object. Return the object handle or NULL on error.
+*/
+lua_Object lua_getglobal (char *name)
+{
+ Word n = luaI_findsymbolbyname(name);
+ adjustC(0);
+ *top = s_object(n);
+ top++;
+ CBase++; /* incorporate object in the stack */
+ return Ref(top-1);
+}
+
+/*
+** Store top of the stack at a global variable array field.
+*/
+void lua_storeglobal (char *name)
+{
+ Word n = luaI_findsymbolbyname(name);
+ adjustC(1);
+ s_object(n) = *(--top);
+}
+
+/*
+** Push a nil object
+*/
+void lua_pushnil (void)
+{
+ lua_checkstack(top-stack+1);
+ tag(top++) = LUA_T_NIL;
+}
+
+/*
+** Push an object (tag=number) to stack.
+*/
+void lua_pushnumber (real n)
+{
+ lua_checkstack(top-stack+1);
+ tag(top) = LUA_T_NUMBER; nvalue(top++) = n;
+}
+
+/*
+** Push an object (tag=string) to stack.
+*/
+void lua_pushstring (char *s)
+{
+ lua_checkstack(top-stack+1);
+ tsvalue(top) = lua_createstring(s);
+ tag(top) = LUA_T_STRING;
+ top++;
+}
+
+/*
+** Push an object (tag=string) on stack and register it on the constant table.
+*/
+void lua_pushliteral (char *s)
+{
+ lua_checkstack(top-stack+1);
+ tsvalue(top) = lua_constant[luaI_findconstant(lua_constcreate(s))];
+ tag(top) = LUA_T_STRING;
+ top++;
+}
+
+/*
+** Push an object (tag=cfunction) to stack.
+*/
+void lua_pushcfunction (lua_CFunction fn)
+{
+ lua_checkstack(top-stack+1);
+ tag(top) = LUA_T_CFUNCTION; fvalue(top++) = fn;
+}
+
+/*
+** Push an object (tag=userdata) to stack.
+*/
+void lua_pushusertag (void *u, int tag)
+{
+ if (tag < LUA_T_USERDATA) return;
+ lua_checkstack(top-stack+1);
+ tag(top) = tag; uvalue(top++) = u;
+}
+
+/*
+** Push a lua_Object to stack.
+*/
+void lua_pushobject (lua_Object o)
+{
+ lua_checkstack(top-stack+1);
+ *top++ = *Address(o);
+}
+
+/*
+** Push an object on the stack.
+*/
+void luaI_pushobject (Object *o)
+{
+ lua_checkstack(top-stack+1);
+ *top++ = *o;
+}
+
+int lua_type (lua_Object o)
+{
+ if (o == LUA_NOOBJECT)
+ return LUA_T_NIL;
+ else
+ return tag(Address(o));
+}
+
+
+void luaI_gcFB (Object *o)
+{
+ *(top++) = *o;
+ do_call(&luaI_fallBacks[FB_GC].function, (top-stack)-1, 0, (top-stack)-1);
+}
+
+
+static void call_arith (char *op)
+{
+ lua_pushstring(op);
+ do_call(&luaI_fallBacks[FB_ARITH].function, (top-stack)-3, 1, (top-stack)-3);
+}
+
+static void comparison (lua_Type tag_less, lua_Type tag_equal,
+ lua_Type tag_great, char *op)
+{
+ Object *l = top-2;
+ Object *r = top-1;
+ int result;
+ if (tag(l) == LUA_T_NUMBER && tag(r) == LUA_T_NUMBER)
+ result = (nvalue(l) < nvalue(r)) ? -1 : (nvalue(l) == nvalue(r)) ? 0 : 1;
+ else if (tostring(l) || tostring(r))
+ {
+ lua_pushstring(op);
+ do_call(&luaI_fallBacks[FB_ORDER].function, (top-stack)-3, 1, (top-stack)-3);
+ return;
+ }
+ else
+ result = strcmp(svalue(l), svalue(r));
+ top--;
+ nvalue(top-1) = 1;
+ tag(top-1) = (result < 0) ? tag_less : (result == 0) ? tag_equal : tag_great;
+}
+
+
+
+/*
+** Execute the given opcode, until a RET. Parameters are between
+** [stack+base,top). Returns n such that the the results are between
+** [stack+n,top).
*/
-int lua_execute (Byte *pc)
+static StkId lua_execute (Byte *pc, StkId base)
{
- Object *oldbase = base;
- base = top;
+ lua_checkstack(STACKGAP+MAX_TEMPS+base);
while (1)
{
OpCode opcode;
switch (opcode = (OpCode)*pc++)
{
- 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:
+ case PUSHNIL: tag(top++) = LUA_T_NIL; break;
+
+ case PUSH0: case PUSH1: case PUSH2:
+ tag(top) = LUA_T_NUMBER;
+ nvalue(top++) = opcode-PUSH0;
+ break;
+
+ case PUSHBYTE: tag(top) = LUA_T_NUMBER; nvalue(top++) = *pc++; break;
+
+ case PUSHWORD:
{
CodeWord code;
get_word(code,pc);
- tag(top) = T_NUMBER; nvalue(top++) = code.w;
+ tag(top) = LUA_T_NUMBER; nvalue(top++) = code.w;
}
break;
-
+
case PUSHFLOAT:
{
CodeFloat code;
get_float(code,pc);
- tag(top) = T_NUMBER; nvalue(top++) = code.f;
+ tag(top) = LUA_T_NUMBER; nvalue(top++) = code.f;
}
break;
@@ -175,50 +767,57 @@ int lua_execute (Byte *pc)
{
CodeWord code;
get_word(code,pc);
- tag(top) = T_STRING; svalue(top++) = lua_constant[code.w];
+ tag(top) = LUA_T_STRING; tsvalue(top++) = lua_constant[code.w];
}
break;
-
+
+ case PUSHFUNCTION:
+ {
+ CodeCode code;
+ get_code(code,pc);
+ tag(top) = LUA_T_FUNCTION; bvalue(top++) = code.b;
+ }
+ break;
+
case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2:
case PUSHLOCAL3: case PUSHLOCAL4: case PUSHLOCAL5:
case PUSHLOCAL6: case PUSHLOCAL7: case PUSHLOCAL8:
- case PUSHLOCAL9: *top++ = *(base + (int)(opcode-PUSHLOCAL0)); break;
-
- case PUSHLOCAL: *top++ = *(base + (*pc++)); break;
-
- case PUSHGLOBAL:
+ case PUSHLOCAL9: *top++ = *((stack+base) + (int)(opcode-PUSHLOCAL0)); break;
+
+ case PUSHLOCAL: *top++ = *((stack+base) + (*pc++)); break;
+
+ case PUSHGLOBAL:
{
CodeWord code;
get_word(code,pc);
*top++ = s_object(code.w);
}
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;
-
+ pushsubscript();
+ break;
+
+ case PUSHSELF:
+ {
+ Object receiver = *(top-1);
+ CodeWord code;
+ get_word(code,pc);
+ tag(top) = LUA_T_STRING; tsvalue(top++) = lua_constant[code.w];
+ pushsubscript();
+ *(top++) = receiver;
+ break;
+ }
+
case STORELOCAL0: case STORELOCAL1: case STORELOCAL2:
case STORELOCAL3: case STORELOCAL4: case STORELOCAL5:
case STORELOCAL6: case STORELOCAL7: case STORELOCAL8:
- case STORELOCAL9: *(base + (int)(opcode-STORELOCAL0)) = *(--top); break;
-
- case STORELOCAL: *(base + (*pc++)) = *(--top); break;
-
+ case STORELOCAL9:
+ *((stack+base) + (int)(opcode-STORELOCAL0)) = *(--top);
+ break;
+
+ case STORELOCAL: *((stack+base) + (*pc++)) = *(--top); break;
+
case STOREGLOBAL:
{
CodeWord code;
@@ -228,36 +827,29 @@ int lua_execute (Byte *pc)
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;
-
+ storesubscript();
+ break;
+
case STOREINDEXED:
{
int n = *pc++;
- if (tag(top-3-n) != T_ARRAY)
+ if (tag(top-3-n) != LUA_T_ARRAY)
{
- lua_reportbug ("indexed expression not a table");
- return 1;
+ *(top+1) = *(top-1);
+ *(top) = *(top-2-n);
+ *(top-1) = *(top-3-n);
+ top += 2;
+ do_call(&luaI_fallBacks[FB_SETTABLE].function, (top-stack)-3, 0, (top-stack)-3);
}
+ else
{
Object *h = lua_hashdefine (avalue(top-3-n), top-2-n);
- if (h == NULL) return 1;
*h = *(top-1);
+ top--;
}
- top--;
}
break;
-
+
case STORELIST0:
case STORELIST:
{
@@ -267,206 +859,180 @@ int lua_execute (Byte *pc)
else m = *(pc++) * FIELDS_PER_FLUSH;
n = *(pc++);
arr = top-n-1;
- if (tag(arr) != T_ARRAY)
- {
- lua_reportbug ("internal error - table expected");
- return 1;
- }
while (n)
{
- tag(top) = T_NUMBER; nvalue(top) = n+m;
+ tag(top) = LUA_T_NUMBER; nvalue(top) = n+m;
*(lua_hashdefine (avalue(arr), top)) = *(top-1);
top--;
n--;
}
}
break;
-
+
case STORERECORD:
{
int n = *(pc++);
Object *arr = top-n-1;
- if (tag(arr) != T_ARRAY)
- {
- lua_reportbug ("internal error - table expected");
- return 1;
- }
while (n)
{
CodeWord code;
get_word(code,pc);
- tag(top) = T_STRING; svalue(top) = lua_constant[code.w];
+ tag(top) = LUA_T_STRING; tsvalue(top) = lua_constant[code.w];
*(lua_hashdefine (avalue(arr), top)) = *(top-1);
top--;
n--;
}
}
break;
-
+
+ case ADJUST0:
+ adjust_top(base);
+ break;
+
case ADJUST:
+ adjust_top(base + *(pc++));
+ break;
+
+ case CREATEARRAY:
{
- Object *newtop = base + *(pc++);
- while (top < newtop) tag(top++) = T_NIL;
- top = newtop; /* top could be bigger than newtop */
+ CodeWord size;
+ get_word(size,pc);
+ avalue(top) = lua_createarray(size.w);
+ tag(top) = LUA_T_ARRAY;
+ top++;
}
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(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;
+ int res = lua_equalObj(top-2, 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;
- }
- }
+ tag(top-1) = res ? LUA_T_NUMBER : LUA_T_NIL;
nvalue(top-1) = 1;
}
break;
-
- case LTOP:
+
+ case LTOP:
+ comparison(LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, "lt");
+ break;
+
+ case LEOP:
+ comparison(LUA_T_NUMBER, LUA_T_NUMBER, LUA_T_NIL, "le");
+ break;
+
+ case GTOP:
+ comparison(LUA_T_NIL, LUA_T_NIL, LUA_T_NUMBER, "gt");
+ break;
+
+ case GEOP:
+ comparison(LUA_T_NIL, LUA_T_NUMBER, LUA_T_NUMBER, "ge");
+ break;
+
+ case ADDOP:
{
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;
+ if (tonumber(r) || tonumber(l))
+ call_arith("add");
else
{
- if (tostring(l) || tostring(r))
- return 1;
- tag(top-1) = (strcmp (svalue(l), svalue(r)) < 0) ? T_NUMBER : T_NIL;
+ nvalue(l) += nvalue(r);
+ --top;
}
- nvalue(top-1) = 1;
}
break;
-
- case LEOP:
+
+ case SUBOP:
{
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;
+ if (tonumber(r) || tonumber(l))
+ call_arith("sub");
else
{
- if (tostring(l) || tostring(r))
- return 1;
- tag(top-1) = (strcmp (svalue(l), svalue(r)) <= 0) ? T_NUMBER : T_NIL;
+ nvalue(l) -= nvalue(r);
+ --top;
}
- 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;
+ call_arith("mul");
+ else
+ {
+ nvalue(l) *= nvalue(r);
+ --top;
+ }
}
- break;
-
+ break;
+
case DIVOP:
{
Object *l = top-2;
Object *r = top-1;
if (tonumber(r) || tonumber(l))
- return 1;
- nvalue(l) /= nvalue(r);
- --top;
+ call_arith("div");
+ else
+ {
+ nvalue(l) /= nvalue(r);
+ --top;
+ }
}
- break;
-
+ break;
+
+ case POWOP:
+ call_arith("pow");
+ 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;
+ do_call(&luaI_fallBacks[FB_CONCAT].function, (top-stack)-2, 1, (top-stack)-2);
+ else
+ {
+ tsvalue(l) = lua_createstring (lua_strconc(svalue(l),svalue(r)));
+ --top;
+ }
}
- break;
-
+ break;
+
case MINUSOP:
if (tonumber(top-1))
- return 1;
- nvalue(top-1) = - nvalue(top-1);
- break;
-
+ {
+ tag(top++) = LUA_T_NIL;
+ call_arith("unm");
+ }
+ else
+ nvalue(top-1) = - nvalue(top-1);
+ break;
+
case NOTOP:
- tag(top-1) = tag(top-1) == T_NIL ? T_NUMBER : T_NIL;
- break;
-
+ tag(top-1) = (tag(top-1) == LUA_T_NIL) ? LUA_T_NUMBER : LUA_T_NIL;
+ nvalue(top-1) = 1;
+ break;
+
case ONTJMP:
{
CodeWord code;
get_word(code,pc);
- if (tag(top-1) != T_NIL) pc += code.w;
+ if (tag(top-1) != LUA_T_NIL) pc += code.w;
}
break;
-
- case ONFJMP:
+
+ case ONFJMP:
{
CodeWord code;
get_word(code,pc);
- if (tag(top-1) == T_NIL) pc += code.w;
+ if (tag(top-1) == LUA_T_NIL) pc += code.w;
}
break;
-
+
case JMP:
{
CodeWord code;
@@ -474,7 +1040,7 @@ int lua_execute (Byte *pc)
pc += code.w;
}
break;
-
+
case UPJMP:
{
CodeWord code;
@@ -482,13 +1048,13 @@ int lua_execute (Byte *pc)
pc -= code.w;
}
break;
-
+
case IFFJMP:
{
CodeWord code;
get_word(code,pc);
top--;
- if (tag(top) == T_NIL) pc += code.w;
+ if (tag(top) == LUA_T_NIL) pc += code.w;
}
break;
@@ -497,91 +1063,38 @@ int lua_execute (Byte *pc)
CodeWord code;
get_word(code,pc);
top--;
- if (tag(top) == T_NIL) pc -= code.w;
+ if (tag(top) == LUA_T_NIL) pc -= code.w;
}
break;
case POP: --top; break;
-
+
case CALLFUNC:
{
- Byte *newpc;
- Object *b = top-1;
- while (tag(b) != T_MARK) b--;
- if (tag(b-1) == T_FUNCTION)
- {
- lua_debugline = 0; /* always reset debug flag */
- newpc = bvalue(b-1);
- bvalue(b-1) = pc; /* store return code */
- nvalue(b) = (base-stack); /* store base value */
- base = b+1;
- pc = newpc;
- if (MAXSTACK-(base-stack) < STACKGAP)
- {
- lua_error ("stack overflow");
- return 1;
- }
- }
- else if (tag(b-1) == T_CFUNCTION)
- {
- int nparam;
- lua_debugline = 0; /* always reset debug flag */
- nvalue(b) = (base-stack); /* store base value */
- base = b+1;
- nparam = top-base; /* number of parameters */
- (fvalue(b-1))(); /* call C function */
-
- /* shift returned values */
- {
- int i;
- int nretval = top - base - nparam;
- top = base - 2;
- base = stack + (int) nvalue(base-1);
- for (i=0; i<nretval; i++)
- {
- *top = *(top+nparam+2);
- ++top;
- }
- }
- }
- else
- {
- lua_reportbug ("call expression not a function");
- return 1;
- }
+ int nParams = *(pc++);
+ int nResults = *(pc++);
+ Object *func = top-1-nParams; /* function is below parameters */
+ StkId newBase = (top-stack)-nParams;
+ do_call(func, newBase, nResults, newBase-1);
}
break;
-
+
+ case RETCODE0:
+ return base;
+
case RETCODE:
- {
- int i;
- int shift = *pc++;
- int nretval = top - base - shift;
- top = base - 2;
- pc = bvalue(base-2);
- base = stack + (int) nvalue(base-1);
- for (i=0; i<nretval; i++)
- {
- *top = *(top+shift+2);
- ++top;
- }
- }
- break;
-
- case HALT:
- base = oldbase;
- return 0; /* success */
-
+ return base+*pc;
+
case SETFUNCTION:
{
- CodeWord file, func;
- get_word(file,pc);
+ CodeCode file;
+ CodeWord func;
+ get_code(file,pc);
get_word(func,pc);
- if (lua_pushfunction (file.w, func.w))
- return 1;
+ lua_pushfunction ((char *)file.b, func.w);
}
break;
-
+
case SETLINE:
{
CodeWord code;
@@ -589,433 +1102,15 @@ int lua_execute (Byte *pc)
lua_debugline = code.w;
}
break;
-
+
case RESET:
lua_popfunction ();
break;
-
+
default:
- lua_error ("internal error - opcode didn't match");
- return 1;
+ lua_error ("internal error - opcode doesn't match");
}
}
}
-/*
-** Traverse all objects on stack
-*/
-void lua_travstack (void (*fn)(Object *))
-{
- Object *o;
- for (o = top-1; o >= stack; o--)
- fn (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;
- lua_closestring();
- 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 (object == NULL || tag(object) == T_NIL) return 0.0;
- 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 (object == NULL || tag(object) == T_NIL) return NULL;
- 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 (object == NULL || tag(object) == T_NIL) return NULL;
- 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 (object == NULL) return NULL;
- 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 (object == NULL) return NULL;
- 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 (object == NULL) return NULL;
- 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 (object == NULL) return NULL;
- 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");
- }
-}
-
-/*
-** Internal function: do a file
-*/
-void lua_internaldofile (void)
-{
- lua_Object obj = lua_getparam (1);
- if (lua_isstring(obj) && !lua_dofile(lua_getstring(obj)))
- lua_pushnumber(1);
- else
- lua_pushnil();
-}
-
-/*
-** Internal function: do a string
-*/
-void lua_internaldostring (void)
-{
- lua_Object obj = lua_getparam (1);
- if (lua_isstring(obj) && !lua_dostring(lua_getstring(obj)))
- lua_pushnumber(1);
- else
- lua_pushnil();
-}
-
-
diff --git a/src/opcode.h b/src/opcode.h
index abf284c4..e3a6d37c 100644
--- a/src/opcode.h
+++ b/src/opcode.h
@@ -1,11 +1,15 @@
/*
** TeCGraf - PUC-Rio
-** $Id: opcode.h,v 2.1 1994/04/20 22:07:57 celes Exp $
+** $Id: opcode.h,v 3.10 1994/12/20 21:20:36 roberto Exp $
*/
#ifndef opcode_h
#define opcode_h
+#include "lua.h"
+#include "types.h"
+#include "tree.h"
+
#ifndef STACKGAP
#define STACKGAP 128
#endif
@@ -16,21 +20,8 @@
#define FIELDS_PER_FLUSH 40
-typedef unsigned char Byte;
-
-typedef unsigned short Word;
-
-typedef union
-{
- struct {char c1; char c2;} m;
- Word w;
-} CodeWord;
+#define MAX_TEMPS 20
-typedef union
-{
- struct {char c1; char c2; char c3; char c4;} m;
- float f;
-} CodeFloat;
typedef enum
{
@@ -40,13 +31,13 @@ typedef enum
PUSHWORD,
PUSHFLOAT,
PUSHSTRING,
+ PUSHFUNCTION,
PUSHLOCAL0, PUSHLOCAL1, PUSHLOCAL2, PUSHLOCAL3, PUSHLOCAL4,
PUSHLOCAL5, PUSHLOCAL6, PUSHLOCAL7, PUSHLOCAL8, PUSHLOCAL9,
PUSHLOCAL,
PUSHGLOBAL,
PUSHINDEXED,
- PUSHMARK,
- PUSHOBJECT,
+ PUSHSELF,
STORELOCAL0, STORELOCAL1, STORELOCAL2, STORELOCAL3, STORELOCAL4,
STORELOCAL5, STORELOCAL6, STORELOCAL7, STORELOCAL8, STORELOCAL9,
STORELOCAL,
@@ -56,15 +47,19 @@ typedef enum
STORELIST0,
STORELIST,
STORERECORD,
+ ADJUST0,
ADJUST,
CREATEARRAY,
EQOP,
LTOP,
LEOP,
+ GTOP,
+ GEOP,
ADDOP,
SUBOP,
MULTOP,
DIVOP,
+ POWOP,
CONCOP,
MINUSOP,
NOTOP,
@@ -76,61 +71,51 @@ typedef enum
IFFUPJMP,
POP,
CALLFUNC,
+ RETCODE0,
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;
+#define MULT_RET 255
+
typedef void (*Cfunction) (void);
typedef int (*Input) (void);
typedef union
{
- Cfunction f;
- real n;
- char *s;
- Byte *b;
+ Cfunction f;
+ real n;
+ TaggedString *ts;
+ Byte *b;
struct Hash *a;
void *u;
} Value;
typedef struct Object
{
- Type tag;
+ lua_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 svalue(o) ((o)->value.ts->str)
+#define tsvalue(o) ((o)->value.ts)
#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)))
@@ -140,25 +125,40 @@ typedef struct
#define s_fvalue(i) (fvalue(&s_object(i)))
#define s_uvalue(i) (uvalue(&s_object(i)))
+typedef union
+{
+ struct {char c1; char c2;} m;
+ Word w;
+} CodeWord;
#define get_word(code,pc) {code.m.c1 = *pc++; code.m.c2 = *pc++;}
+
+typedef union
+{
+ struct {char c1; char c2; char c3; char c4;} m;
+ float f;
+} CodeFloat;
#define get_float(code,pc) {code.m.c1 = *pc++; code.m.c2 = *pc++;\
code.m.c3 = *pc++; code.m.c4 = *pc++;}
-
+
+typedef union
+{
+ struct {char c1; char c2; char c3; char c4;} m;
+ Byte *b;
+} CodeCode;
+#define get_code(code,pc) {code.m.c1 = *pc++; code.m.c2 = *pc++;\
+ code.m.c3 = *pc++; code.m.c4 = *pc++;}
/* Exported functions */
-int lua_execute (Byte *pc);
-void lua_markstack (void);
char *lua_strdup (char *l);
void lua_setinput (Input fn); /* from "lex.c" module */
char *lua_lasttext (void); /* from "lex.c" module */
-int lua_parse (void); /* from "lua.stx" module */
-void lua_type (void);
-void lua_obj2number (void);
-void lua_print (void);
-void lua_internaldofile (void);
-void lua_internaldostring (void);
+int yylex (void); /* from "lex.c" module */
+void lua_parse (Byte **code); /* from "lua.stx" module */
void lua_travstack (void (*fn)(Object *));
+Object *luaI_Address (lua_Object o);
+void luaI_pushobject (Object *o);
+void luaI_gcFB (Object *o);
#endif
diff --git a/src/y.tab.c b/src/parser.c
index 70dbd3cd..47b77fb0 100644
--- a/src/y.tab.c
+++ b/src/parser.c
@@ -1,36 +1,56 @@
+#if defined (__cplusplus) || defined (c_plusplus)
+#include <c_varieties.h>
+#ifdef __EXTERN_C__
+ EXTERN_FUNCTION ( extern int yylex, ());
+#else
+ extern int yylex();
+#endif
+ extern void yyerror(char *);
+ extern int yyparse();
+#endif
+
+#include <malloc.h>
# line 2 "lua.stx"
-char *rcs_luastx = "$Id: lua.stx,v 2.4 1994/04/20 16:22:21 celes Exp $";
+char *rcs_luastx = "$Id: lua.stx,v 3.17 1995/01/13 22:11:12 roberto Exp $";
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
-#include "mm.h"
-
+#include "mem.h"
#include "opcode.h"
#include "hash.h"
#include "inout.h"
+#include "tree.h"
#include "table.h"
#include "lua.h"
+/* to avoid warnings generated by yacc */
+int yyparse (void);
+#define malloc luaI_malloc
+#define realloc luaI_realloc
+#define free luaI_free
+
+#ifndef LISTING
#define LISTING 0
+#endif
-#ifndef GAPCODE
-#define GAPCODE 50
+#ifndef CODE_BLOCK
+#define CODE_BLOCK 256
#endif
-static Word maxcode;
-static Word maxmain;
-static Word maxcurr ;
-static Byte *code = NULL;
-static Byte *initcode;
+static int maxcode;
+static int maxmain;
+static Long maxcurr; /* to allow maxcurr *= 2 without overflow */
+static Byte *funcCode = NULL;
+static Byte **initcode;
static Byte *basepc;
-static Word maincode;
-static Word pc;
+static int maincode;
+static int pc;
#define MAXVAR 32
-static long varbuffer[MAXVAR]; /* variables in an assignment list;
+static Long varbuffer[MAXVAR]; /* variables in an assignment list;
it's long to store negative Word values */
static int nvarbuffer=0; /* number of variables at a list */
@@ -40,8 +60,7 @@ static int nlocalvar=0; /* number of local variables */
#define MAXFIELDS FIELDS_PER_FLUSH*2
static Word fields[MAXFIELDS]; /* fieldnames to be flushed */
static int nfields=0;
-static int ntemp; /* number of temporary var into stack */
-static int err; /* flag to indicate error */
+
/* Internal functions */
@@ -49,13 +68,12 @@ static void code_byte (Byte c)
{
if (pc>maxcurr-2) /* 1 byte free to code HALT of main code */
{
- maxcurr += GAPCODE;
- basepc = (Byte *)realloc(basepc, maxcurr*sizeof(Byte));
- if (basepc == NULL)
- {
- lua_error ("not enough memory");
- err = 1;
- }
+ if (maxcurr >= MAX_INT)
+ lua_error("code size overflow");
+ maxcurr *= 2;
+ if (maxcurr >= MAX_INT)
+ maxcurr = MAX_INT;
+ basepc = growvector(basepc, maxcurr, Byte);
}
basepc[pc++] = c;
}
@@ -78,6 +96,16 @@ static void code_float (float n)
code_byte(code.m.c4);
}
+static void code_code (Byte *b)
+{
+ CodeCode code;
+ code.b = b;
+ code_byte(code.m.c1);
+ code_byte(code.m.c2);
+ code_byte(code.m.c3);
+ code_byte(code.m.c4);
+}
+
static void code_word_at (Byte *p, Word n)
{
CodeWord code;
@@ -91,10 +119,7 @@ static void push_field (Word name)
if (nfields < STACKGAP-1)
fields[nfields++] = name;
else
- {
lua_error ("too many fields in a constructor");
- err = 1;
- }
}
static void flush_record (int n)
@@ -105,7 +130,6 @@ static void flush_record (int n)
code_byte(n);
for (i=0; i<n; i++)
code_word(fields[--nfields]);
- ntemp -= n;
}
static void flush_list (int m, int n)
@@ -114,34 +138,22 @@ static void flush_list (int m, int n)
if (m == 0)
code_byte(STORELIST0);
else
+ if (m < 255)
{
code_byte(STORELIST);
code_byte(m);
}
+ else
+ lua_error ("list constructor too long");
code_byte(n);
- ntemp-=n;
-}
-
-static void incr_ntemp (void)
-{
- if (ntemp+nlocalvar+MAXVAR+1 < STACKGAP)
- ntemp++;
- else
- {
- lua_error ("stack overflow");
- err = 1;
- }
}
static void add_nlocalvar (int n)
{
- if (ntemp+nlocalvar+MAXVAR+n < STACKGAP)
+ if (MAX_TEMPS+nlocalvar+MAXVAR+n < STACKGAP)
nlocalvar += n;
else
- {
- lua_error ("too many local variables or expression too complicate");
- err = 1;
- }
+ lua_error ("too many local variables");
}
static void incr_nvarbuffer (void)
@@ -149,14 +161,12 @@ static void incr_nvarbuffer (void)
if (nvarbuffer < MAXVAR-1)
nvarbuffer++;
else
- {
lua_error ("variable buffer overflow");
- err = 1;
- }
}
static void code_number (float f)
-{ Word i = (Word)f;
+{
+ Word i = (Word)f;
if (f == (float)i) /* f has an (short) integer value */
{
if (i <= 2) code_byte(PUSH0 + i);
@@ -176,59 +186,8 @@ static void code_number (float f)
code_byte(PUSHFLOAT);
code_float(f);
}
- incr_ntemp();
}
-
-# line 184 "lua.stx"
-typedef union
-{
- int vInt;
- long vLong;
- float vFloat;
- char *pChar;
- Word vWord;
- Byte *pByte;
-} YYSTYPE;
-# define WRONGTOKEN 257
-# define NIL 258
-# define IF 259
-# define THEN 260
-# define ELSE 261
-# define ELSEIF 262
-# define WHILE 263
-# define DO 264
-# define REPEAT 265
-# define UNTIL 266
-# define END 267
-# define RETURN 268
-# define LOCAL 269
-# define NUMBER 270
-# define FUNCTION 271
-# define STRING 272
-# define NAME 273
-# define DEBUG 274
-# define AND 275
-# define OR 276
-# define NE 277
-# define LE 278
-# define GE 279
-# define CONC 280
-# define UNARY 281
-# define NOT 282
-#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 622 "lua.stx"
-
-
/*
** Search a local name and if find return its index. If do not find return -1
*/
@@ -245,13 +204,12 @@ static int lua_localname (Word n)
** 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)
+static void lua_pushvar (Long number)
{
if (number > 0) /* global var */
{
code_byte(PUSHGLOBAL);
code_word(number-1);
- incr_ntemp();
}
else if (number < 0) /* local var */
{
@@ -262,19 +220,77 @@ static void lua_pushvar (long number)
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);
+ if (n+nlocalvar == 0)
+ code_byte(ADJUST0);
+ else
+ {
+ code_byte(ADJUST);
+ code_byte(n+nlocalvar);
+ }
+}
+
+static void init_function (TreeNode *func)
+{
+ if (funcCode == NULL) /* first function */
+ {
+ funcCode = newvector(CODE_BLOCK, Byte);
+ maxcode = CODE_BLOCK;
+ }
+ pc=0; basepc=funcCode; maxcurr=maxcode;
+ nlocalvar=0;
+ if (lua_debug)
+ {
+ code_byte(SETFUNCTION);
+ code_code((Byte *)luaI_strdup(lua_file[lua_nfile-1]));
+ code_word(luaI_findconstant(func));
+ }
+}
+
+static void codereturn (void)
+{
+ if (lua_debug) code_byte(RESET);
+ if (nlocalvar == 0)
+ code_byte(RETCODE0);
+ else
+ {
+ code_byte(RETCODE);
+ code_byte(nlocalvar);
+ }
+}
+
+static void codedebugline (void)
+{
+ if (lua_debug)
+ {
+ code_byte(SETLINE);
+ code_word(lua_linenumber);
+ }
+}
+
+static void adjust_mult_assign (int vars, int exps, int temps)
+{
+ if (exps < 0)
+ {
+ int r = vars - (-exps-1);
+ if (r >= 0)
+ code_byte(r);
+ else
+ {
+ code_byte(0);
+ lua_codeadjust(temps);
+ }
+ }
+ else if (vars != exps)
+ lua_codeadjust(temps);
}
static void lua_codestore (int i)
@@ -312,48 +328,102 @@ static void lua_codestore (int i)
}
}
-void yyerror (char *s)
+static void codeIf (Long thenAdd, Long elseAdd)
+{
+ Long elseinit = elseAdd+sizeof(Word)+1;
+ if (pc == elseinit) /* no else */
+ {
+ pc -= sizeof(Word)+1;
+ elseinit = pc;
+ }
+ else
+ {
+ basepc[elseAdd] = JMP;
+ code_word_at(basepc+elseAdd+1, pc-elseinit);
+ }
+ basepc[thenAdd] = IFFJMP;
+ code_word_at(basepc+thenAdd+1,elseinit-(thenAdd+sizeof(Word)+1));
+}
+
+static void yyerror (char *s)
{
static char msg[256];
sprintf (msg,"%s near \"%s\" at line %d in file \"%s\"",
s, lua_lasttext (), lua_linenumber, lua_filename());
lua_error (msg);
- err = 1;
-}
-
-int yywrap (void)
-{
- return 1;
}
/*
-** Parse LUA code and execute global statement.
-** Return 0 on success or 1 on error.
+** Parse LUA code.
*/
-int lua_parse (void)
+void lua_parse (Byte **code)
{
- Byte *init = initcode = (Byte *) calloc(GAPCODE, sizeof(Byte));
+ initcode = code;
+ *initcode = newvector(CODE_BLOCK, Byte);
maincode = 0;
- maxmain = GAPCODE;
- if (init == NULL)
- {
- lua_error("not enough memory");
- return 1;
- }
- err = 0;
- if (yyparse () || (err==1)) return 1;
- initcode[maincode++] = HALT;
- init = initcode;
+ maxmain = CODE_BLOCK;
+ if (yyparse ()) lua_error("parse error");
+ (*initcode)[maincode++] = RETCODE0;
#if LISTING
- PrintCode(init,init+maincode);
+{ static void PrintCode (Byte *c, Byte *end);
+ PrintCode(*initcode,*initcode+maincode); }
#endif
- if (lua_execute (init)) return 1;
- free(init);
- return 0;
}
+
+# line 365 "lua.stx"
+typedef union
+{
+ int vInt;
+ float vFloat;
+ char *pChar;
+ Word vWord;
+ Long vLong;
+ Byte *pByte;
+ TreeNode *pNode;
+} YYSTYPE;
+# define WRONGTOKEN 257
+# define NIL 258
+# define IF 259
+# define THEN 260
+# define ELSE 261
+# define ELSEIF 262
+# define WHILE 263
+# define DO 264
+# define REPEAT 265
+# define UNTIL 266
+# define END 267
+# define RETURN 268
+# define LOCAL 269
+# define FUNCTION 270
+# define NUMBER 271
+# define STRING 272
+# define NAME 273
+# define DEBUG 274
+# define AND 275
+# define OR 276
+# define EQ 277
+# define NE 278
+# define LE 279
+# define GE 280
+# define CONC 281
+# define UNARY 282
+# define NOT 283
+#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 737 "lua.stx"
+
+
#if LISTING
static void PrintCode (Byte *code, Byte *end)
@@ -400,6 +470,16 @@ static void PrintCode (Byte *code, Byte *end)
printf ("%d PUSHSTRING %d\n", n, c.w);
}
break;
+ case PUSHFUNCTION:
+ {
+ CodeCode c;
+ int n = p-code;
+ p++;
+ get_code(c,p);
+ printf ("%d PUSHFUNCTION %p\n", n, c.b);
+ }
+ break;
+
case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2: case PUSHLOCAL3:
case PUSHLOCAL4: case PUSHLOCAL5: case PUSHLOCAL6: case PUSHLOCAL7:
case PUSHLOCAL8: case PUSHLOCAL9:
@@ -419,8 +499,6 @@ static void PrintCode (Byte *code, Byte *end)
}
break;
case PUSHINDEXED: printf ("%d PUSHINDEXED\n", (p++)-code); break;
- case PUSHMARK: printf ("%d PUSHMARK\n", (p++)-code); break;
- case PUSHOBJECT: printf ("%d PUSHOBJECT\n", (p++)-code); break;
case STORELOCAL0: case STORELOCAL1: case STORELOCAL2: case STORELOCAL3:
case STORELOCAL4: case STORELOCAL5: case STORELOCAL6: case STORELOCAL7:
case STORELOCAL8: case STORELOCAL9:
@@ -440,6 +518,15 @@ static void PrintCode (Byte *code, Byte *end)
printf ("%d STOREGLOBAL %d\n", n, c.w);
}
break;
+ case PUSHSELF:
+ {
+ CodeWord c;
+ int n = p-code;
+ p++;
+ get_word(c,p);
+ printf ("%d PUSHSELF %d\n", n, c.w);
+ }
+ break;
case STOREINDEXED0: printf ("%d STOREINDEXED0\n", (p++)-code); break;
case STOREINDEXED: printf ("%d STOREINDEXED %d\n", p-code, *(++p));
p++;
@@ -456,11 +543,20 @@ static void PrintCode (Byte *code, Byte *end)
printf("%d STORERECORD %d\n", p-code, *(++p));
p += *p*sizeof(Word) + 1;
break;
+ case ADJUST0: printf ("%d ADJUST0\n", (p++)-code); break;
case ADJUST:
printf ("%d ADJUST %d\n", p-code, *(++p));
p++;
break;
- case CREATEARRAY: printf ("%d CREATEARRAY\n", (p++)-code); break;
+ case CREATEARRAY:
+ {
+ CodeWord c;
+ int n = p-code;
+ p++;
+ get_word(c,p);
+ printf ("%d CREATEARRAY %d\n", n, c.w);
+ break;
+ }
case EQOP: printf ("%d EQOP\n", (p++)-code); break;
case LTOP: printf ("%d LTOP\n", (p++)-code); break;
case LEOP: printf ("%d LEOP\n", (p++)-code); break;
@@ -468,6 +564,7 @@ static void PrintCode (Byte *code, Byte *end)
case SUBOP: printf ("%d SUBOP\n", (p++)-code); break;
case MULTOP: printf ("%d MULTOP\n", (p++)-code); break;
case DIVOP: printf ("%d DIVOP\n", (p++)-code); break;
+ case POWOP: printf ("%d POWOP\n", (p++)-code); break;
case CONCOP: printf ("%d CONCOP\n", (p++)-code); break;
case MINUSOP: printf ("%d MINUSOP\n", (p++)-code); break;
case NOTOP: printf ("%d NOTOP\n", (p++)-code); break;
@@ -526,20 +623,24 @@ static void PrintCode (Byte *code, Byte *end)
}
break;
case POP: printf ("%d POP\n", (p++)-code); break;
- case CALLFUNC: printf ("%d CALLFUNC\n", (p++)-code); break;
+ case CALLFUNC:
+ printf ("%d CALLFUNC %d %d\n", p-code, *(p+1), *(p+2));
+ p+=3;
+ break;
+ case RETCODE0: printf ("%d RETCODE0\n", (p++)-code); break;
case RETCODE:
printf ("%d RETCODE %d\n", p-code, *(++p));
p++;
break;
- case HALT: printf ("%d HALT\n", (p++)-code); break;
case SETFUNCTION:
{
- CodeWord c1, c2;
+ CodeCode c1;
+ CodeWord c2;
int n = p-code;
p++;
- get_word(c1,p);
+ get_code(c1,p);
get_word(c2,p);
- printf ("%d SETFUNCTION %d %d\n", n, c1.w, c2.w);
+ printf ("%d SETFUNCTION %s %d\n", n, (char *)c1.b, c2.w);
}
break;
case SETLINE:
@@ -564,194 +665,201 @@ int yyexca[] ={
0, -1,
-2, 2,
-1, 20,
- 40, 67,
- 91, 94,
- 46, 96,
- -2, 91,
+ 61, 91,
+ 44, 91,
+ -2, 97,
-1, 32,
- 40, 67,
- 91, 94,
- 46, 96,
- -2, 51,
--1, 73,
- 275, 34,
- 276, 34,
- 61, 34,
- 277, 34,
- 62, 34,
- 60, 34,
- 278, 34,
- 279, 34,
- 280, 34,
- 43, 34,
- 45, 34,
- 42, 34,
- 47, 34,
+ 40, 66,
+ 123, 66,
+ -2, 53,
+-1, 47,
+ 123, 63,
-2, 70,
-1, 74,
- 91, 94,
- 46, 96,
- -2, 92,
--1, 105,
- 261, 28,
- 262, 28,
- 266, 28,
- 267, 28,
- 268, 28,
- -2, 11,
--1, 125,
- 268, 31,
- -2, 30,
--1, 146,
- 275, 34,
- 276, 34,
- 61, 34,
- 277, 34,
- 62, 34,
- 60, 34,
- 278, 34,
- 279, 34,
- 280, 34,
- 43, 34,
- 45, 34,
- 42, 34,
- 47, 34,
+ 125, 79,
+ -2, 63,
+-1, 79,
+ 275, 37,
+ 276, 37,
+ 277, 37,
+ 278, 37,
+ 62, 37,
+ 60, 37,
+ 279, 37,
+ 280, 37,
+ 281, 37,
+ 43, 37,
+ 45, 37,
+ 42, 37,
+ 47, 37,
+ 94, 37,
-2, 72,
+-1, 80,
+ 91, 97,
+ 46, 97,
+ -2, 92,
+-1, 118,
+ 261, 33,
+ 262, 33,
+ 266, 33,
+ 267, 33,
+ -2, 16,
+-1, 133,
+ 125, 85,
+ -2, 63,
+-1, 158,
+ 123, 63,
+ -2, 70,
+-1, 159,
+ 275, 37,
+ 276, 37,
+ 277, 37,
+ 278, 37,
+ 62, 37,
+ 60, 37,
+ 279, 37,
+ 280, 37,
+ 281, 37,
+ 43, 37,
+ 45, 37,
+ 42, 37,
+ 47, 37,
+ 94, 37,
+ -2, 74,
};
# define YYNPROD 103
-# define YYLAST 364
+# define YYLAST 351
int yyact[]={
- 58, 56, 22, 57, 132, 59, 58, 56, 137, 57,
- 110, 59, 58, 56, 107, 57, 85, 59, 51, 50,
- 52, 82, 23, 43, 51, 50, 52, 58, 56, 9,
- 57, 157, 59, 58, 56, 165, 57, 5, 59, 162,
- 6, 161, 104, 154, 155, 51, 50, 52, 64, 153,
- 70, 51, 50, 52, 26, 58, 56, 127, 57, 10,
- 59, 111, 25, 78, 27, 58, 56, 28, 57, 29,
- 59, 131, 147, 51, 50, 52, 7, 65, 66, 115,
- 150, 112, 63, 51, 50, 52, 68, 69, 31, 159,
- 11, 79, 58, 76, 128, 73, 41, 59, 151, 87,
- 88, 89, 90, 91, 92, 93, 94, 95, 96, 97,
- 77, 114, 148, 40, 58, 56, 102, 57, 106, 59,
- 117, 32, 72, 121, 116, 100, 80, 109, 67, 48,
- 20, 36, 73, 30, 45, 73, 44, 118, 149, 84,
- 17, 126, 18, 46, 21, 47, 120, 119, 101, 145,
- 144, 125, 71, 123, 75, 39, 38, 12, 8, 108,
- 105, 136, 83, 74, 135, 24, 4, 3, 139, 140,
- 2, 81, 134, 141, 133, 130, 129, 42, 113, 16,
- 1, 146, 124, 0, 143, 0, 0, 152, 0, 0,
- 0, 86, 0, 0, 0, 0, 0, 13, 0, 0,
- 160, 14, 0, 15, 164, 163, 0, 19, 167, 0,
- 0, 23, 73, 0, 0, 0, 0, 0, 168, 166,
- 158, 171, 173, 0, 0, 0, 169, 0, 0, 0,
- 0, 0, 0, 61, 62, 53, 54, 55, 60, 61,
- 62, 53, 54, 55, 60, 0, 0, 0, 0, 103,
- 60, 49, 0, 98, 99, 0, 0, 0, 0, 0,
- 61, 62, 53, 54, 55, 60, 61, 62, 53, 54,
- 55, 60, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 35, 0, 0, 0, 0, 0, 61, 62,
- 53, 54, 55, 60, 33, 122, 34, 23, 0, 0,
- 53, 54, 55, 60, 0, 0, 37, 0, 0, 0,
- 138, 0, 0, 0, 0, 142, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 156, 0, 0, 0, 0, 0, 0,
+ 64, 62, 6, 63, 152, 65, 7, 64, 62, 145,
+ 63, 120, 65, 92, 64, 62, 89, 63, 57, 65,
+ 58, 64, 62, 87, 63, 57, 65, 58, 64, 62,
+ 24, 63, 57, 65, 58, 64, 62, 54, 63, 57,
+ 65, 58, 45, 10, 29, 142, 57, 171, 58, 30,
+ 29, 123, 66, 167, 14, 30, 160, 117, 15, 66,
+ 16, 162, 163, 173, 19, 131, 66, 138, 24, 28,
+ 112, 114, 130, 66, 74, 71, 8, 64, 66, 52,
+ 66, 86, 65, 51, 161, 83, 51, 66, 43, 136,
+ 27, 12, 64, 62, 26, 63, 133, 65, 49, 70,
+ 135, 119, 84, 125, 124, 42, 72, 122, 109, 32,
+ 53, 132, 79, 73, 85, 39, 75, 79, 47, 23,
+ 149, 91, 143, 31, 78, 20, 88, 38, 50, 66,
+ 11, 50, 95, 96, 97, 98, 99, 100, 101, 102,
+ 103, 104, 105, 106, 66, 48, 36, 129, 128, 158,
+ 113, 141, 94, 81, 79, 77, 18, 41, 40, 80,
+ 139, 13, 9, 118, 90, 93, 121, 25, 5, 4,
+ 3, 2, 22, 126, 111, 76, 82, 44, 134, 110,
+ 21, 46, 17, 1, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 140, 0, 0, 0, 0,
+ 0, 0, 0, 0, 147, 148, 0, 151, 0, 150,
+ 0, 0, 153, 159, 0, 156, 0, 0, 0, 0,
+ 164, 107, 108, 0, 0, 0, 0, 0, 79, 116,
+ 170, 169, 55, 68, 69, 56, 59, 60, 61, 67,
+ 68, 69, 56, 59, 60, 61, 67, 68, 69, 56,
+ 59, 60, 61, 67, 68, 69, 56, 59, 60, 61,
+ 67, 177, 35, 56, 59, 60, 61, 67, 35, 137,
+ 127, 157, 0, 166, 67, 33, 34, 24, 0, 0,
+ 146, 33, 34, 115, 0, 0, 0, 37, 0, 0,
+ 0, 155, 0, 37, 0, 0, 0, 172, 0, 0,
+ 144, 0, 0, 0, 0, 0, 0, 165, 0, 0,
+ 0, 0, 0, 154, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 174, 0, 176, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 168, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 170, 0, 0, 172 };
+ 175 };
int yypact[]={
- -1000, -234, -1000, -1000, -1000, -244, -1000, 31, -62, -1000,
- -1000, -1000, -1000, 24, -1000, -1000, 52, -1000, -1000, -250,
- -1000, -1000, -1000, -1000, 89, -9, -1000, 24, 24, 24,
- -1000, 88, -1000, -1000, -1000, -1000, -1000, 24, 24, -1000,
- 24, -251, 49, -1000, -28, 45, 86, -252, -257, -1000,
- 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
- 24, -1000, -1000, 84, 13, -1000, -1000, 24, -1000, -15,
- -224, -1000, 74, -1000, -1000, -1000, -259, 24, 24, -263,
- 24, -12, -1000, 83, 76, -1000, -1000, -30, -30, -30,
- -30, -30, -30, 50, 50, -1000, -1000, 72, -1000, -1000,
- -1000, 82, 13, -1000, 24, -1000, -1000, -1000, 74, -36,
- -1000, 53, 74, -1000, -269, 24, -1000, -265, -1000, 24,
- 24, -1000, -1000, 13, 31, -1000, 24, -1000, -1000, -53,
- 68, -1000, -1000, -13, 54, 13, -1000, -1000, -218, 23,
- 23, -1000, -1000, -1000, -1000, -237, -1000, -1000, -269, 28,
- -1000, 24, -226, -228, -1000, 24, -232, 24, -1000, 24,
- 13, -1000, -1000, -1000, -42, -1000, 31, 13, -1000, -1000,
- -1000, -1000, -218, -1000 };
+ -1000, -268, -1000, -1000, -1000, -1000, -230, -1000, 32, -205,
+ 36, -1000, -1000, -1000, 4, -1000, -1000, 44, -1000, -231,
+ -1000, 78, -1000, 40, -1000, 70, -236, -28, -1000, 4,
+ 4, -1000, 40, -1000, -1000, -1000, -1000, 4, -49, -1000,
+ 4, -1000, 4, -243, 41, -1000, -1000, 4, -1000, -250,
+ 4, -257, -1000, -260, -1000, -1000, 4, 4, 4, 4,
+ 4, 4, 4, 4, 4, 4, 4, 4, -1000, -1000,
+ 67, -21, -16, -16, 10, -35, -209, -1000, 57, -1000,
+ -1000, 37, -1000, -262, 4, 66, 57, -1000, -42, -1000,
+ 63, 59, -1000, 70, -1000, -7, -7, -7, -7, -7,
+ -7, 35, 35, -16, -16, -16, 50, -1000, -1000, -1000,
+ -53, 52, 56, -21, -1000, 28, -1000, -1000, -223, -1000,
+ -1000, 57, -1000, -1000, -1000, -264, -1000, -1000, 4, 4,
+ -1000, -1000, -1000, 4, -1000, -269, 4, -1000, -1000, 4,
+ 32, -1000, -1000, 4, -211, -1000, -200, -14, -14, -269,
+ -21, -1000, 28, -21, -1000, -1000, -21, -1000, 4, -1000,
+ -1000, -214, -1000, -1000, 56, -220, 32, -1000, -1000, -197,
+ -1000, -1000, -1000, -1000, -1000, -1000, -200, -1000 };
int yypgo[]={
- 0, 180, 191, 54, 61, 81, 179, 133, 178, 177,
- 176, 175, 174, 172, 121, 171, 170, 76, 59, 167,
- 166, 165, 162, 161, 50, 160, 158, 157, 48, 49,
- 156, 155, 131, 154, 152, 151, 150, 149, 148, 147,
- 146, 145, 144, 143, 141, 139, 71, 138, 136, 134 };
+ 0, 183, 152, 69, 114, 81, 182, 181, 180, 179,
+ 177, 176, 70, 174, 115, 172, 79, 171, 76, 130,
+ 170, 169, 168, 167, 165, 164, 175, 163, 162, 161,
+ 67, 160, 75, 84, 158, 157, 146, 155, 151, 149,
+ 123, 109, 148, 147, 127, 122, 121, 65, 120, 71 };
int yyr1[]={
- 0, 1, 16, 1, 1, 1, 21, 23, 19, 25,
- 25, 26, 17, 18, 18, 27, 30, 27, 31, 27,
- 27, 27, 27, 27, 29, 29, 29, 34, 35, 24,
- 36, 37, 36, 2, 28, 3, 3, 3, 3, 3,
+ 0, 1, 17, 1, 1, 1, 1, 23, 20, 24,
+ 21, 16, 27, 27, 19, 19, 28, 18, 31, 30,
+ 29, 34, 29, 35, 29, 29, 29, 29, 33, 33,
+ 33, 37, 26, 38, 39, 38, 2, 32, 3, 3,
3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
- 3, 3, 3, 3, 3, 3, 3, 39, 3, 40,
- 3, 41, 7, 38, 38, 43, 32, 42, 4, 4,
- 5, 44, 5, 22, 22, 45, 45, 15, 15, 8,
- 8, 10, 10, 11, 11, 47, 46, 12, 12, 13,
- 13, 6, 6, 14, 48, 14, 49, 14, 9, 9,
- 33, 33, 20 };
+ 3, 3, 3, 3, 3, 3, 3, 3, 3, 42,
+ 3, 43, 3, 44, 40, 36, 8, 8, 7, 7,
+ 4, 4, 5, 45, 5, 25, 25, 46, 46, 9,
+ 9, 9, 48, 9, 47, 47, 12, 12, 49, 13,
+ 13, 6, 6, 14, 14, 14, 15, 41, 10, 10,
+ 11, 11, 22 };
int yyr2[]={
- 0, 0, 1, 9, 4, 4, 1, 1, 19, 0,
- 6, 1, 4, 0, 2, 17, 1, 17, 1, 13,
- 7, 3, 3, 7, 0, 4, 15, 1, 1, 9,
- 0, 1, 9, 1, 3, 7, 7, 7, 7, 7,
- 7, 7, 7, 7, 7, 7, 7, 5, 5, 3,
- 9, 3, 3, 3, 3, 3, 5, 1, 11, 1,
- 11, 1, 9, 1, 2, 1, 11, 3, 1, 3,
- 3, 1, 9, 0, 2, 3, 7, 1, 3, 7,
- 7, 1, 3, 3, 7, 1, 9, 1, 3, 3,
- 7, 3, 7, 3, 1, 11, 1, 9, 3, 7,
- 0, 4, 3 };
+ 0, 0, 1, 9, 4, 4, 4, 1, 9, 1,
+ 13, 11, 0, 6, 0, 2, 1, 4, 1, 4,
+ 17, 1, 17, 1, 13, 7, 3, 7, 0, 4,
+ 15, 1, 7, 0, 1, 9, 1, 3, 7, 7,
+ 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
+ 7, 5, 3, 3, 3, 3, 3, 3, 5, 1,
+ 11, 1, 11, 1, 9, 5, 3, 7, 7, 3,
+ 1, 3, 3, 1, 9, 1, 3, 3, 7, 1,
+ 5, 5, 1, 11, 0, 2, 3, 7, 7, 3,
+ 7, 3, 7, 3, 9, 7, 3, 3, 3, 7,
+ 1, 5, 3 };
int yychk[]={
- -1000, -1, -16, -19, -20, 271, 274, -17, -26, 273,
- -18, 59, -27, 259, 263, 265, -6, -32, -7, 269,
- -14, -42, 64, 273, -21, -28, -3, 40, 43, 45,
- -7, 64, -14, 270, 272, 258, -32, 282, -30, -31,
- 61, 44, -9, 273, -48, -49, -43, -41, 40, 260,
- 61, 60, 62, 277, 278, 279, 43, 45, 42, 47,
- 280, 275, 276, -3, -28, -28, -28, 40, -28, -28,
- -24, -34, -5, -3, -14, -33, 44, 61, 91, 46,
- 40, -15, 273, -22, -45, 273, -2, -28, -28, -28,
- -28, -28, -28, -28, -28, -28, -28, -28, -2, -2,
- 41, -38, -28, 264, 266, -25, 44, 273, -5, -28,
- 273, -4, -5, -8, 123, 91, 41, 44, -24, -39,
- -40, 41, -2, -28, -17, -35, -44, 93, 41, -10,
- -11, -46, 273, -12, -13, -28, -23, 273, -2, -28,
- -28, -24, -2, -18, -36, -37, -3, 125, 44, -47,
- 93, 44, -24, -29, 261, 262, -2, 268, -46, 61,
- -28, 267, 267, -24, -28, 267, -4, -28, 260, -18,
- -2, -24, -2, -29 };
+ -1000, -1, -17, -20, -21, -22, 270, 274, -18, -28,
+ 273, -19, 59, -29, 259, 263, 265, -6, -36, 269,
+ -14, -8, -15, -41, 273, -23, 58, -32, -3, 40,
+ 45, -40, -41, 271, 272, 258, -36, 283, -44, -14,
+ -34, -35, 61, 44, -10, 273, -7, 40, -40, 58,
+ 91, 46, -16, 40, 273, 260, 277, 60, 62, 278,
+ 279, 280, 43, 45, 42, 47, 94, 281, 275, 276,
+ -3, -32, -32, -32, 123, -32, -26, -37, -5, -3,
+ -14, -41, -11, 44, 61, -4, -5, 273, -32, 273,
+ -25, -46, 273, -24, -2, -32, -32, -32, -32, -32,
+ -32, -32, -32, -32, -32, -32, -32, -2, -2, 41,
+ -9, -13, -12, -32, -49, 273, 264, 266, -27, 44,
+ 273, -5, 41, 93, 41, 44, -16, -26, -42, -43,
+ 125, -47, 59, 44, -47, 44, 61, -2, -30, -31,
+ -18, -38, 268, -45, -26, 273, -2, -32, -32, -48,
+ -32, -49, 273, -32, -26, -2, -32, -19, -39, -3,
+ 267, -33, 261, 262, -12, -2, -4, 267, -26, -30,
+ -47, 267, -19, 260, -2, -26, -2, -33 };
int yydef[]={
- 1, -2, 11, 4, 5, 0, 102, 13, 0, 6,
- 3, 14, 12, 0, 16, 18, 0, 21, 22, 0,
- -2, 65, 61, 93, 0, 0, 34, 0, 0, 0,
- 49, 61, -2, 52, 53, 54, 55, 0, 0, 27,
- 0, 0, 100, 98, 0, 0, 0, 77, 73, 33,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 33, 33, 34, 0, 47, 48, 63, 56, 0,
- 0, 9, 20, -2, -2, 23, 0, 0, 0, 0,
- 68, 0, 78, 0, 74, 75, 27, 36, 37, 38,
- 39, 40, 41, 42, 43, 44, 45, 46, 57, 59,
- 35, 0, 64, 33, 0, -2, 71, 99, 101, 0,
- 97, 0, 69, 62, 81, 87, 7, 0, 33, 0,
- 0, 50, 27, 33, 13, -2, 0, 95, 66, 0,
- 82, 83, 85, 0, 88, 89, 27, 76, 24, 58,
- 60, 33, 19, 10, 29, 0, -2, 79, 0, 0,
- 80, 0, 0, 0, 27, 0, 0, 68, 84, 0,
- 90, 8, 15, 25, 0, 17, 13, 86, 33, 32,
- 27, 33, 24, 26 };
+ 1, -2, 16, 4, 5, 6, 0, 102, 14, 0,
+ 7, 3, 15, 17, 63, 21, 23, 0, 26, 0,
+ -2, 63, 93, 66, 96, 0, 0, 0, 37, 63,
+ 63, 52, -2, 54, 55, 56, 57, 63, 0, 97,
+ 63, 31, 63, 0, 100, 98, 65, -2, 69, 0,
+ 63, 0, 8, 75, 9, 36, 63, 63, 63, 63,
+ 63, 63, 63, 63, 63, 63, 63, 63, 36, 36,
+ 37, 0, 51, 58, -2, 0, 0, 12, 25, -2,
+ -2, 0, 27, 0, 63, 0, 71, 67, 0, 95,
+ 0, 76, 77, 0, 31, 39, 40, 41, 42, 43,
+ 44, 45, 46, 47, 48, 49, 50, 59, 61, 38,
+ 0, 84, 84, 89, 86, 96, 36, 18, -2, 73,
+ 99, 101, 68, 94, 31, 0, 10, 36, 63, 63,
+ 64, 80, 82, -2, 81, 85, 63, 31, 36, 63,
+ 14, 32, 34, 63, 0, 78, 28, 60, 62, 0,
+ 90, 87, 0, 88, 36, 24, 19, 13, -2, -2,
+ 11, 0, 31, 18, 84, 0, 14, 20, 29, 0,
+ 83, 22, 35, 36, 31, 36, 28, 30 };
typedef struct { char *t_name; int t_val; } yytoktype;
#ifndef YYDEBUG
# define YYDEBUG 0 /* don't allow debugging */
@@ -774,26 +882,27 @@ yytoktype yytoks[] =
"END", 267,
"RETURN", 268,
"LOCAL", 269,
- "NUMBER", 270,
- "FUNCTION", 271,
+ "FUNCTION", 270,
+ "NUMBER", 271,
"STRING", 272,
"NAME", 273,
"DEBUG", 274,
"AND", 275,
"OR", 276,
- "=", 61,
- "NE", 277,
+ "EQ", 277,
+ "NE", 278,
">", 62,
"<", 60,
- "LE", 278,
- "GE", 279,
- "CONC", 280,
+ "LE", 279,
+ "GE", 280,
+ "CONC", 281,
"+", 43,
"-", 45,
"*", 42,
"/", 47,
- "UNARY", 281,
- "NOT", 282,
+ "UNARY", 282,
+ "NOT", 283,
+ "^", 94,
"-unknown-", -1 /* ends search */
};
@@ -804,38 +913,41 @@ char * yyreds[] =
"functionlist : functionlist",
"functionlist : functionlist stat sc",
"functionlist : functionlist function",
+ "functionlist : functionlist method",
"functionlist : functionlist setdebug",
"function : FUNCTION NAME",
- "function : FUNCTION NAME '(' parlist ')'",
- "function : FUNCTION NAME '(' parlist ')' block END",
+ "function : FUNCTION NAME body",
+ "method : FUNCTION NAME ':' NAME",
+ "method : FUNCTION NAME ':' NAME body",
+ "body : '(' parlist ')' block END",
"statlist : /* empty */",
"statlist : statlist stat sc",
- "stat : /* empty */",
- "stat : stat1",
"sc : /* empty */",
"sc : ';'",
+ "stat : /* empty */",
+ "stat : stat1",
+ "cond : /* empty */",
+ "cond : expr1",
"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 : REPEAT block UNTIL cond PrepJump",
"stat1 : varlist1 '=' exprlist1",
"stat1 : functioncall",
- "stat1 : typeconstructor",
"stat1 : LOCAL localdeclist decinit",
"elsepart : /* empty */",
"elsepart : ELSE block",
- "elsepart : ELSEIF expr1 THEN PrepJump block PrepJump elsepart",
+ "elsepart : ELSEIF cond THEN PrepJump block PrepJump elsepart",
"block : /* empty */",
- "block : statlist",
"block : statlist ret",
"ret : /* empty */",
- "ret : /* empty */",
+ "ret : RETURN",
"ret : RETURN exprlist sc",
"PrepJump : /* empty */",
"expr1 : expr",
"expr : '(' expr ')'",
- "expr : expr1 '=' expr1",
+ "expr : expr1 EQ expr1",
"expr : expr1 '<' expr1",
"expr : expr1 '>' expr1",
"expr : expr1 NE expr1",
@@ -845,12 +957,11 @@ char * yyreds[] =
"expr : expr1 '-' expr1",
"expr : expr1 '*' expr1",
"expr : expr1 '/' expr1",
+ "expr : expr1 '^' expr1",
"expr : expr1 CONC expr1",
- "expr : '+' expr1",
"expr : '-' expr1",
- "expr : typeconstructor",
- "expr : '@' '(' dimension ')'",
- "expr : var",
+ "expr : table",
+ "expr : varexp",
"expr : NUMBER",
"expr : STRING",
"expr : NIL",
@@ -860,13 +971,13 @@ char * yyreds[] =
"expr : expr1 AND PrepJump expr1",
"expr : expr1 OR PrepJump",
"expr : expr1 OR PrepJump expr1",
- "typeconstructor : '@'",
- "typeconstructor : '@' objectname fieldlist",
- "dimension : /* empty */",
- "dimension : expr1",
- "functioncall : functionvalue",
- "functioncall : functionvalue '(' exprlist ')'",
- "functionvalue : var",
+ "table : /* empty */",
+ "table : '{' fieldlist '}'",
+ "functioncall : funcvalue funcParams",
+ "funcvalue : varexp",
+ "funcvalue : varexp ':' NAME",
+ "funcParams : '(' exprlist ')'",
+ "funcParams : table",
"exprlist : /* empty */",
"exprlist : exprlist1",
"exprlist1 : expr",
@@ -876,27 +987,25 @@ char * yyreds[] =
"parlist : parlist1",
"parlist1 : NAME",
"parlist1 : parlist1 ',' NAME",
- "objectname : /* empty */",
- "objectname : NAME",
- "fieldlist : '{' ffieldlist '}'",
- "fieldlist : '[' lfieldlist ']'",
- "ffieldlist : /* empty */",
- "ffieldlist : ffieldlist1",
+ "fieldlist : /* empty */",
+ "fieldlist : lfieldlist1 lastcomma",
+ "fieldlist : ffieldlist1 lastcomma",
+ "fieldlist : lfieldlist1 ';'",
+ "fieldlist : lfieldlist1 ';' ffieldlist1 lastcomma",
+ "lastcomma : /* empty */",
+ "lastcomma : ','",
"ffieldlist1 : ffield",
"ffieldlist1 : ffieldlist1 ',' ffield",
- "ffield : NAME",
"ffield : NAME '=' expr1",
- "lfieldlist : /* empty */",
- "lfieldlist : lfieldlist1",
"lfieldlist1 : expr1",
"lfieldlist1 : lfieldlist1 ',' expr1",
"varlist1 : var",
"varlist1 : varlist1 ',' var",
- "var : NAME",
- "var : var",
- "var : var '[' expr1 ']'",
- "var : var",
- "var : var '.' NAME",
+ "var : singlevar",
+ "var : varexp '[' expr1 ']'",
+ "var : varexp '.' NAME",
+ "singlevar : NAME",
+ "varexp : var",
"localdeclist : NAME",
"localdeclist : localdeclist ',' NAME",
"decinit : /* empty */",
@@ -904,19 +1013,22 @@ char * yyreds[] =
"setdebug : DEBUG",
};
#endif /* YYDEBUG */
-#line 1 "/usr/lib/yaccpar"
+#line 1 "/usr/lang/SC1.0/yaccpar"
/* @(#)yaccpar 1.10 89/04/04 SMI; from S5R3 1.10 */
/*
** Skeleton parser driver for yacc output
*/
+/*
+ @(#)RELEASE SC1.0 C++ 2.1 1Mar1991
+*/
/*
** 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 YYACCEPT return(0)
+#define YYABORT return(1)
#define YYBACKUP( newtoken, newvalue )\
{\
if ( yychar >= 0 || ( yyr2[ yytmp ] >> 1 ) != 1 )\
@@ -930,10 +1042,24 @@ char * yyreds[] =
goto yynewstate;\
}
#define YYRECOVERING() (!!yyerrflag)
+#define YYCOPY(to, from, type) \
+ (type *) memcpy(to, (char *) from, yynewmax * sizeof(type))
#ifndef YYDEBUG
# define YYDEBUG 1 /* make debugging available */
#endif
+
+/*
+** extern declarations for C++ - check your own code for correctness
+** if you have function redefined error messages here.
+*/
+
+#ifdef __cplusplus
+EXTERN_FUNCTION ( extern int printf, (const char*, DOTDOTDOT) );
+EXTERN_FUNCTION ( extern void *memcpy, (void *, const void *, int) );
+#endif
+
+
/*
** user known globals
*/
@@ -947,8 +1073,8 @@ int yydebug; /* set to 1 to get debugging */
/*
** static variables used by the parser
*/
-static YYSTYPE *yyv; /* value stack */
-static int *yys; /* state stack */
+static YYSTYPE yy_yyv[YYMAXDEPTH], *yyv = yy_yyv; /* value stack */
+static int yy_yys[YYMAXDEPTH], *yys = yy_yys; /* state stack */
static YYSTYPE *yypv; /* top of value stack */
static int *yyps; /* top of state stack */
@@ -956,10 +1082,20 @@ static int *yyps; /* top of state stack */
static int yystate; /* current state */
static int yytmp; /* extra var (lasts between blocks) */
+#if defined(__cplusplus) || defined(__STDC__) || defined(lint)
+static int __yaccpar_lint_hack__ = 0;
+ /* if you change the value from 0 to
+ something else, make sure you know
+ what to do with yyerrlab reference.
+ This is a hack - to make sure C++ and
+ lint are happy with the 4.1 yacc code. */
+#endif
+
int yynerrs; /* number of errors */
int yyerrflag; /* error recovery flag */
int yychar; /* current input token number */
+static unsigned yymaxdepth = YYMAXDEPTH;
/*
@@ -968,19 +1104,12 @@ int yychar; /* current input token number */
int
yyparse()
{
- register YYSTYPE *yypvt; /* top of value stack for $vars */
- unsigned yymaxdepth = YYMAXDEPTH;
+ register YYSTYPE *yypvt = (YYSTYPE*)0 ; /* top of value stack for
+$vars */
/*
** 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;
@@ -989,13 +1118,26 @@ yyparse()
yyerrflag = 0;
yychar = -1;
- goto yystack;
+#if defined(__cplusplus) || defined(__STDC__) || defined(lint)
+/*
+ Note that the following can never be executed but simply to please
+ lint and C++
+ */
+ switch (__yaccpar_lint_hack__)
+ {
+ case 1: goto yyerrlab;
+ case 2: goto yynewstate;
+ }
+#endif
+
{
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 */
+ goto yystack;
+
/*
** get globals into registers.
** branch to here only if YYBACKUP was called.
@@ -1052,26 +1194,47 @@ yyparse()
#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)
+ /*
+ ** 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);
+ int yynewmax;
+
+ yynewmax = yymaxdepth + YYMAXDEPTH;
+ if (yymaxdepth == YYMAXDEPTH) /* first time growth */
+ {
+ YYSTYPE *newyyv = (YYSTYPE*)malloc(yynewmax*sizeof(YYSTYPE));
+ int *newyys = (int*)malloc(yynewmax*sizeof(int));
+ if (newyys != 0 && newyyv != 0)
+ {
+ yys = YYCOPY(newyys, yys, int);
+ yyv = YYCOPY(newyyv, yyv, YYSTYPE);
+ }
+ else
+ yynewmax = 0; /* failed */
+ }
+ else /* not first time */
+ {
+ yyv = (YYSTYPE*)realloc((char*)yyv,
+ yynewmax * sizeof(YYSTYPE));
+ yys = (int*)realloc((char*)yys,
+ yynewmax * sizeof(int));
+ if (yys == 0 || yyv == 0)
+ yynewmax = 0; /* failed */
+ }
+ if (yynewmax <= yymaxdepth) /* tables not expanded */
{
yyerror( "yacc stack overflow" );
- return(1);
+ YYABORT;
}
- yy_ps = yys + yyps_index;
- yy_pv = yyv + yypv_index;
- yypvt = yyv + yypvt_index;
+ yymaxdepth = yynewmax;
+
+ yy_ps = yys + yyps_index;
+ yy_pv = yyv + yypv_index;
+ yypvt = yyv + yypvt_index;
}
*yy_ps = yy_state;
*++yy_pv = yyval;
@@ -1292,7 +1455,7 @@ yyparse()
yy_n, yyreds[ yy_n ] );
#endif
yytmp = yy_n; /* value to switch over */
- yypvt = yy_pv; /* $vars top of value stack */
+ yypvt = yy_pv; /* $vars top of value stack */
/*
** Look in goto table for next state
** Sorry about using yy_state here as temporary
@@ -1345,466 +1508,393 @@ yyparse()
{
case 2:
-# line 227 "lua.stx"
+# line 411 "lua.stx"
{
- pc=maincode; basepc=initcode; maxcurr=maxmain;
+ pc=maincode; basepc=*initcode; maxcurr=maxmain;
nlocalvar=0;
} break;
case 3:
-# line 232 "lua.stx"
+# line 416 "lua.stx"
{
- maincode=pc; initcode=basepc; maxmain=maxcurr;
+ maincode=pc; *initcode=basepc; maxmain=maxcurr;
} break;
-case 6:
-# line 240 "lua.stx"
-{
- if (code == NULL) /* first function */
- {
- code = (Byte *) calloc(GAPCODE, sizeof(Byte));
- if (code == NULL)
- {
- lua_error("not enough memory");
- err = 1;
- }
- maxcode = GAPCODE;
- }
- pc=0; basepc=code; maxcurr=maxcode;
- nlocalvar=0;
- yyval.vWord = lua_findsymbol(yypvt[-0].pChar);
- } break;
case 7:
-# line 256 "lua.stx"
+# line 425 "lua.stx"
{
- if (lua_debug)
- {
- code_byte(SETFUNCTION);
- code_word(lua_nfile-1);
- code_word(yypvt[-3].vWord);
- }
- lua_codeadjust (0);
+ init_function(yypvt[-0].pNode);
} break;
case 8:
-# line 267 "lua.stx"
+# line 429 "lua.stx"
{
- if (lua_debug) code_byte(RESET);
- code_byte(RETCODE); code_byte(nlocalvar);
- s_tag(yypvt[-6].vWord) = T_FUNCTION;
- s_bvalue(yypvt[-6].vWord) = calloc (pc, sizeof(Byte));
- if (s_bvalue(yypvt[-6].vWord) == NULL)
- {
- lua_error("not enough memory");
- err = 1;
- }
- memcpy (s_bvalue(yypvt[-6].vWord), basepc, pc*sizeof(Byte));
- code = basepc; maxcode=maxcurr;
-#if LISTING
-PrintCode(code,code+pc);
-#endif
+ Word func = luaI_findsymbol(yypvt[-2].pNode);
+ s_tag(func) = LUA_T_FUNCTION;
+ s_bvalue(func) = yypvt[-0].pByte;
} break;
-case 11:
-# line 289 "lua.stx"
+case 9:
+# line 437 "lua.stx"
{
- ntemp = 0;
- if (lua_debug)
- {
- code_byte(SETLINE); code_word(lua_linenumber);
- }
- } break;
-case 15:
-# line 302 "lua.stx"
+ init_function(yypvt[-0].pNode);
+ localvar[nlocalvar]=luaI_findsymbolbyname("self");
+ add_nlocalvar(1);
+ } break;
+case 10:
+# line 443 "lua.stx"
{
- {
- Word elseinit = yypvt[-2].vWord+sizeof(Word)+1;
- if (pc - elseinit == 0) /* no else */
- {
- pc -= sizeof(Word)+1;
- elseinit = pc;
- }
- else
- {
- basepc[yypvt[-2].vWord] = JMP;
- code_word_at(basepc+yypvt[-2].vWord+1, pc - elseinit);
- }
- basepc[yypvt[-4].vWord] = IFFJMP;
- code_word_at(basepc+yypvt[-4].vWord+1,elseinit-(yypvt[-4].vWord+sizeof(Word)+1));
- }
- } break;
+ /* assign function to table field */
+ pc=maincode; basepc=*initcode; maxcurr=maxmain;
+ nlocalvar=0;
+ lua_pushvar(luaI_findsymbol(yypvt[-4].pNode)+1);
+ code_byte(PUSHSTRING);
+ code_word(luaI_findconstant(yypvt[-2].pNode));
+ code_byte(PUSHFUNCTION);
+ code_code(yypvt[-0].pByte);
+ code_byte(STOREINDEXED0);
+ maincode=pc; *initcode=basepc; maxmain=maxcurr;
+ } break;
+case 11:
+# line 458 "lua.stx"
+{
+ codereturn();
+ yyval.pByte = newvector(pc, Byte);
+ memcpy(yyval.pByte, basepc, pc*sizeof(Byte));
+ funcCode = basepc; maxcode=maxcurr;
+#if LISTING
+ PrintCode(funcCode,funcCode+pc);
+#endif
+ } break;
case 16:
-# line 320 "lua.stx"
-{yyval.vWord=pc;} break;
-case 17:
-# line 322 "lua.stx"
+# line 475 "lua.stx"
+{ codedebugline(); } break;
+case 18:
+# line 477 "lua.stx"
+{ codedebugline(); } break;
+case 20:
+# line 480 "lua.stx"
+{ codeIf(yypvt[-4].vLong, yypvt[-2].vLong); } break;
+case 21:
+# line 482 "lua.stx"
+{yyval.vLong=pc;} break;
+case 22:
+# line 483 "lua.stx"
{
- basepc[yypvt[-3].vWord] = IFFJMP;
- code_word_at(basepc+yypvt[-3].vWord+1, pc - (yypvt[-3].vWord + sizeof(Word)+1));
-
- basepc[yypvt[-1].vWord] = UPJMP;
- code_word_at(basepc+yypvt[-1].vWord+1, pc - (yypvt[-6].vWord));
+ basepc[yypvt[-3].vLong] = IFFJMP;
+ code_word_at(basepc+yypvt[-3].vLong+1, pc - (yypvt[-3].vLong + sizeof(Word)+1));
+ basepc[yypvt[-1].vLong] = UPJMP;
+ code_word_at(basepc+yypvt[-1].vLong+1, pc - (yypvt[-6].vLong));
} break;
-case 18:
-# line 330 "lua.stx"
-{yyval.vWord=pc;} break;
-case 19:
-# line 332 "lua.stx"
+case 23:
+# line 490 "lua.stx"
+{yyval.vLong=pc;} break;
+case 24:
+# line 491 "lua.stx"
{
- basepc[yypvt[-0].vWord] = IFFUPJMP;
- code_word_at(basepc+yypvt[-0].vWord+1, pc - (yypvt[-4].vWord));
+ basepc[yypvt[-0].vLong] = IFFUPJMP;
+ code_word_at(basepc+yypvt[-0].vLong+1, pc - (yypvt[-4].vLong));
} break;
-case 20:
-# line 339 "lua.stx"
+case 25:
+# line 497 "lua.stx"
{
{
int i;
- if (yypvt[-0].vInt == 0 || nvarbuffer != ntemp - yypvt[-2].vInt * 2)
- lua_codeadjust (yypvt[-2].vInt * 2 + nvarbuffer);
+ adjust_mult_assign(nvarbuffer, yypvt[-0].vInt, 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 350 "lua.stx"
-{ lua_codeadjust (0); } break;
-case 22:
-# line 351 "lua.stx"
-{ lua_codeadjust (0); } break;
-case 23:
-# line 352 "lua.stx"
-{ add_nlocalvar(yypvt[-1].vInt); lua_codeadjust (0); } break;
case 26:
-# line 358 "lua.stx"
-{
- {
- Word elseinit = yypvt[-1].vWord+sizeof(Word)+1;
- if (pc - elseinit == 0) /* no else */
- {
- pc -= sizeof(Word)+1;
- elseinit = pc;
- }
- else
- {
- basepc[yypvt[-1].vWord] = JMP;
- code_word_at(basepc+yypvt[-1].vWord+1, pc - elseinit);
- }
- basepc[yypvt[-3].vWord] = IFFJMP;
- code_word_at(basepc+yypvt[-3].vWord+1, elseinit - (yypvt[-3].vWord + sizeof(Word)+1));
- }
- } break;
+# line 507 "lua.stx"
+{ code_byte(0); } break;
case 27:
-# line 377 "lua.stx"
+# line 509 "lua.stx"
+{ add_nlocalvar(yypvt[-1].vInt);
+ adjust_mult_assign(yypvt[-1].vInt, yypvt[-0].vInt, 0);
+ } break;
+case 30:
+# line 517 "lua.stx"
+{ codeIf(yypvt[-3].vLong, yypvt[-1].vLong); } break;
+case 31:
+# line 520 "lua.stx"
{yyval.vInt = nlocalvar;} break;
-case 28:
-# line 377 "lua.stx"
-{ntemp = 0;} break;
-case 29:
-# line 378 "lua.stx"
+case 32:
+# line 521 "lua.stx"
{
- if (nlocalvar != yypvt[-3].vInt)
+ if (nlocalvar != yypvt[-2].vInt)
{
- nlocalvar = yypvt[-3].vInt;
+ nlocalvar = yypvt[-2].vInt;
lua_codeadjust (0);
}
} break;
-case 31:
-# line 388 "lua.stx"
-{ if (lua_debug){code_byte(SETLINE);code_word(lua_linenumber);}} break;
-case 32:
-# line 390 "lua.stx"
-{
- if (lua_debug) code_byte(RESET);
- code_byte(RETCODE); code_byte(nlocalvar);
+case 34:
+# line 531 "lua.stx"
+{ codedebugline(); } break;
+case 35:
+# line 532 "lua.stx"
+{
+ if (yypvt[-1].vInt < 0) code_byte(MULT_RET);
+ codereturn();
} break;
-case 33:
-# line 397 "lua.stx"
+case 36:
+# line 539 "lua.stx"
{
- yyval.vWord = pc;
+ yyval.vLong = pc;
code_byte(0); /* open space */
code_word (0);
} break;
-case 34:
-# line 403 "lua.stx"
-{ if (yypvt[-0].vInt == 0) {lua_codeadjust (ntemp+1); incr_ntemp();}} break;
-case 35:
-# line 406 "lua.stx"
-{ yyval.vInt = yypvt[-1].vInt; } break;
-case 36:
-# line 407 "lua.stx"
-{ code_byte(EQOP); yyval.vInt = 1; ntemp--;} break;
case 37:
-# line 408 "lua.stx"
-{ code_byte(LTOP); yyval.vInt = 1; ntemp--;} break;
+# line 545 "lua.stx"
+{ if (yypvt[-0].vInt == 0) code_byte(1); } break;
case 38:
-# line 409 "lua.stx"
-{ code_byte(LEOP); code_byte(NOTOP); yyval.vInt = 1; ntemp--;} break;
+# line 548 "lua.stx"
+{ yyval.vInt = yypvt[-1].vInt; } break;
case 39:
-# line 410 "lua.stx"
-{ code_byte(EQOP); code_byte(NOTOP); yyval.vInt = 1; ntemp--;} break;
+# line 549 "lua.stx"
+{ code_byte(EQOP); yyval.vInt = 1; } break;
case 40:
-# line 411 "lua.stx"
-{ code_byte(LEOP); yyval.vInt = 1; ntemp--;} break;
+# line 550 "lua.stx"
+{ code_byte(LTOP); yyval.vInt = 1; } break;
case 41:
-# line 412 "lua.stx"
-{ code_byte(LTOP); code_byte(NOTOP); yyval.vInt = 1; ntemp--;} break;
+# line 551 "lua.stx"
+{ code_byte(GTOP); yyval.vInt = 1; } break;
case 42:
-# line 413 "lua.stx"
-{ code_byte(ADDOP); yyval.vInt = 1; ntemp--;} break;
+# line 552 "lua.stx"
+{ code_byte(EQOP); code_byte(NOTOP); yyval.vInt = 1; } break;
case 43:
-# line 414 "lua.stx"
-{ code_byte(SUBOP); yyval.vInt = 1; ntemp--;} break;
+# line 553 "lua.stx"
+{ code_byte(LEOP); yyval.vInt = 1; } break;
case 44:
-# line 415 "lua.stx"
-{ code_byte(MULTOP); yyval.vInt = 1; ntemp--;} break;
+# line 554 "lua.stx"
+{ code_byte(GEOP); yyval.vInt = 1; } break;
case 45:
-# line 416 "lua.stx"
-{ code_byte(DIVOP); yyval.vInt = 1; ntemp--;} break;
+# line 555 "lua.stx"
+{ code_byte(ADDOP); yyval.vInt = 1; } break;
case 46:
-# line 417 "lua.stx"
-{ code_byte(CONCOP); yyval.vInt = 1; ntemp--;} break;
+# line 556 "lua.stx"
+{ code_byte(SUBOP); yyval.vInt = 1; } break;
case 47:
-# line 418 "lua.stx"
-{ yyval.vInt = 1; } break;
+# line 557 "lua.stx"
+{ code_byte(MULTOP); yyval.vInt = 1; } break;
case 48:
-# line 419 "lua.stx"
-{ code_byte(MINUSOP); yyval.vInt = 1;} break;
+# line 558 "lua.stx"
+{ code_byte(DIVOP); yyval.vInt = 1; } break;
case 49:
-# line 420 "lua.stx"
-{ yyval.vInt = yypvt[-0].vInt; } break;
+# line 559 "lua.stx"
+{ code_byte(POWOP); yyval.vInt = 1; } break;
case 50:
-# line 422 "lua.stx"
-{
- code_byte(CREATEARRAY);
- yyval.vInt = 1;
- } break;
+# line 560 "lua.stx"
+{ code_byte(CONCOP); yyval.vInt = 1; } break;
case 51:
-# line 426 "lua.stx"
-{ lua_pushvar (yypvt[-0].vLong); yyval.vInt = 1;} break;
+# line 561 "lua.stx"
+{ code_byte(MINUSOP); yyval.vInt = 1;} break;
case 52:
-# line 427 "lua.stx"
-{ code_number(yypvt[-0].vFloat); yyval.vInt = 1; } break;
+# line 562 "lua.stx"
+{ yyval.vInt = 1; } break;
case 53:
-# line 429 "lua.stx"
+# line 563 "lua.stx"
+{ yyval.vInt = 1;} break;
+case 54:
+# line 564 "lua.stx"
+{ code_number(yypvt[-0].vFloat); yyval.vInt = 1; } break;
+case 55:
+# line 566 "lua.stx"
{
code_byte(PUSHSTRING);
code_word(yypvt[-0].vWord);
yyval.vInt = 1;
- incr_ntemp();
- } break;
-case 54:
-# line 435 "lua.stx"
-{code_byte(PUSHNIL); yyval.vInt = 1; incr_ntemp();} break;
-case 55:
-# line 437 "lua.stx"
-{
- yyval.vInt = 0;
- if (lua_debug)
- {
- code_byte(SETLINE); code_word(lua_linenumber);
- }
} break;
case 56:
-# line 444 "lua.stx"
-{ code_byte(NOTOP); yyval.vInt = 1;} break;
+# line 571 "lua.stx"
+{code_byte(PUSHNIL); yyval.vInt = 1; } break;
case 57:
-# line 445 "lua.stx"
-{code_byte(POP); ntemp--;} break;
+# line 572 "lua.stx"
+{ yyval.vInt = 0; } break;
case 58:
-# line 446 "lua.stx"
-{
- basepc[yypvt[-2].vWord] = ONFJMP;
- code_word_at(basepc+yypvt[-2].vWord+1, pc - (yypvt[-2].vWord + sizeof(Word)+1));
- yyval.vInt = 1;
- } break;
+# line 573 "lua.stx"
+{ code_byte(NOTOP); yyval.vInt = 1;} break;
case 59:
-# line 451 "lua.stx"
-{code_byte(POP); ntemp--;} break;
+# line 574 "lua.stx"
+{code_byte(POP); } break;
case 60:
-# line 452 "lua.stx"
+# line 575 "lua.stx"
{
- basepc[yypvt[-2].vWord] = ONTJMP;
- code_word_at(basepc+yypvt[-2].vWord+1, pc - (yypvt[-2].vWord + sizeof(Word)+1));
+ basepc[yypvt[-2].vLong] = ONFJMP;
+ code_word_at(basepc+yypvt[-2].vLong+1, pc - (yypvt[-2].vLong + sizeof(Word)+1));
yyval.vInt = 1;
} break;
case 61:
-# line 460 "lua.stx"
+# line 580 "lua.stx"
+{code_byte(POP); } break;
+case 62:
+# line 581 "lua.stx"
+{
+ basepc[yypvt[-2].vLong] = ONTJMP;
+ code_word_at(basepc+yypvt[-2].vLong+1, pc - (yypvt[-2].vLong + sizeof(Word)+1));
+ yyval.vInt = 1;
+ } break;
+case 63:
+# line 589 "lua.stx"
{
- code_byte(PUSHBYTE);
- yyval.vWord = pc; code_byte(0);
- incr_ntemp();
code_byte(CREATEARRAY);
+ yyval.vLong = pc; code_word(0);
} break;
-case 62:
-# line 467 "lua.stx"
+case 64:
+# line 594 "lua.stx"
{
- basepc[yypvt[-2].vWord] = 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)
- {
- code_byte(SETLINE); code_word(lua_linenumber);
- }
- }
+ code_word_at(basepc+yypvt[-3].vLong, yypvt[-1].vInt);
} break;
-case 63:
-# line 491 "lua.stx"
-{ code_byte(PUSHNIL); incr_ntemp();} break;
case 65:
-# line 495 "lua.stx"
-{code_byte(PUSHMARK); yyval.vInt = ntemp; incr_ntemp();} break;
+# line 600 "lua.stx"
+{ code_byte(CALLFUNC); code_byte(yypvt[-1].vInt+yypvt[-0].vInt); } break;
case 66:
-# line 496 "lua.stx"
-{ code_byte(CALLFUNC); ntemp = yypvt[-3].vInt-1;} break;
+# line 603 "lua.stx"
+{ yyval.vInt = 0; } break;
case 67:
-# line 498 "lua.stx"
-{lua_pushvar (yypvt[-0].vLong); } break;
+# line 605 "lua.stx"
+{
+ code_byte(PUSHSELF);
+ code_word(luaI_findconstant(yypvt[-0].pNode));
+ yyval.vInt = 1;
+ } break;
case 68:
-# line 501 "lua.stx"
-{ yyval.vInt = 1; } break;
+# line 613 "lua.stx"
+{ if (yypvt[-1].vInt<0) { code_byte(1); yyval.vInt = -yypvt[-1].vInt; } else yyval.vInt = yypvt[-1].vInt; } break;
case 69:
-# line 502 "lua.stx"
-{ yyval.vInt = yypvt[-0].vInt; } break;
+# line 614 "lua.stx"
+{ yyval.vInt = 1; } break;
case 70:
-# line 505 "lua.stx"
-{ yyval.vInt = yypvt[-0].vInt; } break;
+# line 617 "lua.stx"
+{ yyval.vInt = 0; } break;
case 71:
-# line 506 "lua.stx"
-{if (!yypvt[-1].vInt){lua_codeadjust (ntemp+1); incr_ntemp();}} break;
+# line 618 "lua.stx"
+{ yyval.vInt = yypvt[-0].vInt; } break;
case 72:
-# line 507 "lua.stx"
-{yyval.vInt = yypvt[-0].vInt;} break;
+# line 621 "lua.stx"
+{ if (yypvt[-0].vInt == 0) yyval.vInt = -1; else yyval.vInt = 1; } break;
+case 73:
+# line 622 "lua.stx"
+{ if (yypvt[-1].vInt < 0) code_byte(1); } break;
+case 74:
+# line 623 "lua.stx"
+{
+ int r = yypvt[-3].vInt < 0 ? -yypvt[-3].vInt : yypvt[-3].vInt;
+ yyval.vInt = (yypvt[-0].vInt == 0) ? -(r+1) : r+1;
+ } break;
case 75:
-# line 515 "lua.stx"
+# line 629 "lua.stx"
+{ lua_codeadjust(0); } break;
+case 76:
+# line 630 "lua.stx"
+{ lua_codeadjust(0); } break;
+case 77:
+# line 634 "lua.stx"
{
- localvar[nlocalvar]=lua_findsymbol(yypvt[-0].pChar);
+ localvar[nlocalvar]=luaI_findsymbol(yypvt[-0].pNode);
add_nlocalvar(1);
} break;
-case 76:
-# line 520 "lua.stx"
+case 78:
+# line 639 "lua.stx"
{
- localvar[nlocalvar]=lua_findsymbol(yypvt[-0].pChar);
+ localvar[nlocalvar]=luaI_findsymbol(yypvt[-0].pNode);
add_nlocalvar(1);
} break;
-case 77:
-# line 526 "lua.stx"
-{yyval.vLong=-1;} break;
-case 78:
-# line 527 "lua.stx"
-{yyval.vLong=lua_findsymbol(yypvt[-0].pChar);} break;
case 79:
-# line 531 "lua.stx"
-{
- flush_record(yypvt[-1].vInt%FIELDS_PER_FLUSH);
- yyval.vInt = yypvt[-1].vInt;
- } break;
+# line 645 "lua.stx"
+{ yyval.vInt = 0; } break;
case 80:
-# line 536 "lua.stx"
-{
- flush_list(yypvt[-1].vInt/FIELDS_PER_FLUSH, yypvt[-1].vInt%FIELDS_PER_FLUSH);
- yyval.vInt = yypvt[-1].vInt;
- } break;
+# line 647 "lua.stx"
+{ yyval.vInt = yypvt[-1].vInt; flush_list(yypvt[-1].vInt/FIELDS_PER_FLUSH, yypvt[-1].vInt%FIELDS_PER_FLUSH); } break;
case 81:
-# line 542 "lua.stx"
-{ yyval.vInt = 0; } break;
+# line 649 "lua.stx"
+{ yyval.vInt = yypvt[-1].vInt; flush_record(yypvt[-1].vInt%FIELDS_PER_FLUSH); } break;
case 82:
-# line 543 "lua.stx"
-{ yyval.vInt = yypvt[-0].vInt; } break;
+# line 651 "lua.stx"
+{ flush_list(yypvt[-1].vInt/FIELDS_PER_FLUSH, yypvt[-1].vInt%FIELDS_PER_FLUSH); } break;
case 83:
-# line 546 "lua.stx"
+# line 653 "lua.stx"
+{ yyval.vInt = yypvt[-4].vInt+yypvt[-1].vInt; flush_record(yypvt[-1].vInt%FIELDS_PER_FLUSH); } break;
+case 86:
+# line 660 "lua.stx"
{yyval.vInt=1;} break;
-case 84:
-# line 548 "lua.stx"
+case 87:
+# line 662 "lua.stx"
{
yyval.vInt=yypvt[-2].vInt+1;
if (yyval.vInt%FIELDS_PER_FLUSH == 0) flush_record(FIELDS_PER_FLUSH);
} break;
-case 85:
-# line 554 "lua.stx"
-{yyval.vWord = lua_findconstant(yypvt[-0].pChar);} break;
-case 86:
-# line 555 "lua.stx"
+case 88:
+# line 669 "lua.stx"
{
- push_field(yypvt[-2].vWord);
+ push_field(luaI_findconstant(yypvt[-2].pNode));
} break;
-case 87:
-# line 560 "lua.stx"
-{ yyval.vInt = 0; } break;
-case 88:
-# line 561 "lua.stx"
-{ yyval.vInt = yypvt[-0].vInt; } break;
case 89:
-# line 564 "lua.stx"
+# line 674 "lua.stx"
{yyval.vInt=1;} break;
case 90:
-# line 566 "lua.stx"
+# line 676 "lua.stx"
{
yyval.vInt=yypvt[-2].vInt+1;
if (yyval.vInt%FIELDS_PER_FLUSH == 0)
flush_list(yyval.vInt/FIELDS_PER_FLUSH - 1, FIELDS_PER_FLUSH);
} break;
case 91:
-# line 574 "lua.stx"
+# line 684 "lua.stx"
{
nvarbuffer = 0;
varbuffer[nvarbuffer] = yypvt[-0].vLong; incr_nvarbuffer();
yyval.vInt = (yypvt[-0].vLong == 0) ? 1 : 0;
} break;
case 92:
-# line 580 "lua.stx"
+# line 690 "lua.stx"
{
varbuffer[nvarbuffer] = yypvt[-0].vLong; incr_nvarbuffer();
yyval.vInt = (yypvt[-0].vLong == 0) ? yypvt[-2].vInt + 1 : yypvt[-2].vInt;
} break;
case 93:
-# line 587 "lua.stx"
+# line 696 "lua.stx"
+{ yyval.vLong = yypvt[-0].vLong; } break;
+case 94:
+# line 698 "lua.stx"
{
- Word s = lua_findsymbol(yypvt[-0].pChar);
- int local = lua_localname (s);
- if (local == -1) /* global var */
- yyval.vLong = s + 1; /* return positive value */
- else
- yyval.vLong = -(local+1); /* return negative value */
+ yyval.vLong = 0; /* indexed variable */
} break;
-case 94:
-# line 596 "lua.stx"
-{lua_pushvar (yypvt[-0].vLong);} break;
case 95:
-# line 597 "lua.stx"
+# line 702 "lua.stx"
{
+ code_byte(PUSHSTRING);
+ code_word(luaI_findconstant(yypvt[-0].pNode));
yyval.vLong = 0; /* indexed variable */
} break;
case 96:
-# line 600 "lua.stx"
-{lua_pushvar (yypvt[-0].vLong);} break;
-case 97:
-# line 601 "lua.stx"
+# line 710 "lua.stx"
{
- code_byte(PUSHSTRING);
- code_word(lua_findconstant(yypvt[-0].pChar)); incr_ntemp();
- yyval.vLong = 0; /* indexed variable */
+ Word s = luaI_findsymbol(yypvt[-0].pNode);
+ int local = lua_localname (s);
+ if (local == -1) /* global var */
+ yyval.vLong = s + 1; /* return positive value */
+ else
+ yyval.vLong = -(local+1); /* return negative value */
} break;
+case 97:
+# line 720 "lua.stx"
+{ lua_pushvar(yypvt[-0].vLong); } break;
case 98:
-# line 608 "lua.stx"
-{localvar[nlocalvar]=lua_findsymbol(yypvt[-0].pChar); yyval.vInt = 1;} break;
+# line 723 "lua.stx"
+{localvar[nlocalvar]=luaI_findsymbol(yypvt[-0].pNode); yyval.vInt = 1;} break;
case 99:
-# line 610 "lua.stx"
+# line 725 "lua.stx"
{
- localvar[nlocalvar+yypvt[-2].vInt]=lua_findsymbol(yypvt[-0].pChar);
+ localvar[nlocalvar+yypvt[-2].vInt]=luaI_findsymbol(yypvt[-0].pNode);
yyval.vInt = yypvt[-2].vInt+1;
} break;
+case 100:
+# line 731 "lua.stx"
+{ yyval.vInt = 0; } break;
+case 101:
+# line 732 "lua.stx"
+{ yyval.vInt = yypvt[-0].vInt; } break;
case 102:
-# line 620 "lua.stx"
+# line 735 "lua.stx"
{lua_debug = yypvt[-0].vInt;} break;
}
goto yystack; /* reset registers in driver code */
diff --git a/src/y.tab.h b/src/parser.h
index 5bee29f9..4c125dad 100644
--- a/src/y.tab.h
+++ b/src/parser.h
@@ -2,11 +2,12 @@
typedef union
{
int vInt;
- long vLong;
float vFloat;
char *pChar;
Word vWord;
+ Long vLong;
Byte *pByte;
+ TreeNode *pNode;
} YYSTYPE;
extern YYSTYPE yylval;
# define WRONGTOKEN 257
@@ -22,16 +23,17 @@ extern YYSTYPE yylval;
# define END 267
# define RETURN 268
# define LOCAL 269
-# define NUMBER 270
-# define FUNCTION 271
+# define FUNCTION 270
+# define NUMBER 271
# define STRING 272
# define NAME 273
# define DEBUG 274
# define AND 275
# define OR 276
-# define NE 277
-# define LE 278
-# define GE 279
-# define CONC 280
-# define UNARY 281
-# define NOT 282
+# define EQ 277
+# define NE 278
+# define LE 279
+# define GE 280
+# define CONC 281
+# define UNARY 282
+# define NOT 283
diff --git a/src/table.c b/src/table.c
index 7b93df76..cedbf31c 100644
--- a/src/table.c
+++ b/src/table.c
@@ -3,159 +3,144 @@
** Module to control static tables
*/
-char *rcs_table="$Id: table.c,v 2.1 1994/04/20 22:07:57 celes Exp $";
+char *rcs_table="$Id: table.c,v 2.28 1995/01/18 20:15:54 celes Exp $";
-#include <stdlib.h>
#include <string.h>
-#include "mm.h"
-
+#include "mem.h"
#include "opcode.h"
+#include "tree.h"
#include "hash.h"
#include "inout.h"
#include "table.h"
#include "lua.h"
+#include "fallback.h"
+
+
+#define BUFFER_BLOCK 256
+
+Symbol *lua_table;
+static Word lua_ntable = 0;
+static Long lua_maxsymbol = 0;
+
+TaggedString **lua_constant;
+static Word lua_nconstant = 0;
+static Long lua_maxconstant = 0;
+
-#define streq(s1,s2) (s1[0]==s2[0]&&strcmp(s1+1,s2+1)==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}}},
- {"dofile",{T_CFUNCTION,{lua_internaldofile}}},
- {"dostring",{T_CFUNCTION,{lua_internaldostring}}}
- };
-Symbol *lua_table=tablebuffer;
-Word lua_ntable=7;
-
-struct List
-{
- Symbol *s;
- struct List *next;
-};
-
-static struct List o6={ tablebuffer+6, 0};
-static struct List o5={ tablebuffer+5, &o6 };
-static struct List o4={ tablebuffer+4, &o5 };
-static struct List o3={ tablebuffer+3, &o4 };
-static struct List o2={ tablebuffer+2, &o3 };
-static struct List o1={ tablebuffer+1, &o2 };
-static struct List o0={ tablebuffer+0, &o1 };
-static struct List *searchlist=&o0;
-
-#ifndef MAXCONSTANT
-#define MAXCONSTANT 256
-#endif
-/* pre-defined constants need garbage collection extra byte */
-static char tm[] = " mark";
-static char ti[] = " nil";
-static char tn[] = " number";
-static char ts[] = " string";
-static char tt[] = " table";
-static char tf[] = " function";
-static char tc[] = " cfunction";
-static char tu[] = " userdata";
-static char *constantbuffer[MAXCONSTANT] = {tm+1, ti+1,
- tn+1, ts+1,
- tt+1, tf+1,
- tc+1, tu+1
- };
-char **lua_constant = constantbuffer;
-Word lua_nconstant=T_USERDATA+1;
-
-#ifndef MAXSTRING
-#define MAXSTRING 512
-#endif
-static char *stringbuffer[MAXSTRING];
-char **lua_string = stringbuffer;
-Word lua_nstring=0;
#define MAXFILE 20
char *lua_file[MAXFILE];
int lua_nfile;
+#define GARBAGE_BLOCK 256
+#define MIN_GARBAGE_BLOCK 10
-#define markstring(s) (*((s)-1))
+static void lua_nextvar (void);
+static void setglobal (void);
+static void getglobal (void);
+
+/*
+** Initialise symbol table with internal functions
+*/
+static void lua_initsymbol (void)
+{
+ Word n;
+ lua_maxsymbol = BUFFER_BLOCK;
+ lua_table = newvector(lua_maxsymbol, Symbol);
+ n = luaI_findsymbolbyname("next");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_next;
+ n = luaI_findsymbolbyname("dofile");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_internaldofile;
+ n = luaI_findsymbolbyname("setglobal");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = setglobal;
+ n = luaI_findsymbolbyname("getglobal");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = getglobal;
+ n = luaI_findsymbolbyname("nextvar");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_nextvar;
+ n = luaI_findsymbolbyname("type");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = luaI_type;
+ n = luaI_findsymbolbyname("tonumber");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_obj2number;
+ n = luaI_findsymbolbyname("print");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_print;
+ n = luaI_findsymbolbyname("dostring");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_internaldostring;
+ n = luaI_findsymbolbyname("setfallback");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = luaI_setfallback;
+ n = luaI_findsymbolbyname("error");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = luaI_error;
+}
-/* Variables to controll garbage collection */
-Word lua_block=10; /* to check when garbage collector will be called */
-Word lua_nentity; /* counter of new entities (strings and arrays) */
+/*
+** Initialise constant table with pre-defined constants
+*/
+void lua_initconstant (void)
+{
+ lua_maxconstant = BUFFER_BLOCK;
+ lua_constant = newvector(lua_maxconstant, TaggedString *);
+}
/*
** 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.
+** found, allocate it.
*/
-int lua_findsymbol (char *s)
+Word luaI_findsymbol (TreeNode *t)
{
- struct List *l, *p;
- for (p=NULL, l=searchlist; l!=NULL; p=l, l=l->next)
- if (streq(s,l->s->name))
+ if (lua_table == NULL)
+ lua_initsymbol();
+ if (t->varindex == NOT_USED)
+ {
+ if (lua_ntable == lua_maxsymbol)
{
- if (p!=NULL)
- {
- p->next = l->next;
- l->next = searchlist;
- searchlist = l;
- }
- return (l->s-lua_table);
+ if (lua_maxsymbol >= MAX_WORD)
+ lua_error("symbol table overflow");
+ lua_maxsymbol *= 2;
+ if (lua_maxsymbol >= MAX_WORD)
+ lua_maxsymbol = MAX_WORD;
+ lua_table = growvector(lua_table, lua_maxsymbol, Symbol);
}
-
- if (lua_ntable >= MAXSYMBOL-1)
- {
- lua_error ("symbol table overflow");
- return -1;
+ t->varindex = lua_ntable;
+ s_tag(lua_ntable) = LUA_T_NIL;
+ lua_ntable++;
}
- 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;
- p = malloc(sizeof(*p));
- p->s = lua_table+lua_ntable;
- p->next = searchlist;
- searchlist = p;
+ return t->varindex;
+}
- return lua_ntable++;
+
+Word luaI_findsymbolbyname (char *name)
+{
+ return luaI_findsymbol(lua_constcreate(name));
}
+
/*
-** 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.
-**
+** Given a name, search it at constant table and return its index. If not
+** found, allocate it.
+** On error, return -1.
*/
-int lua_findconstant (char *s)
+Word luaI_findconstant (TreeNode *t)
{
- int i;
- for (i=0; i<lua_nconstant; i++)
- if (streq(s,lua_constant[i]))
- return i;
- if (lua_nconstant >= MAXCONSTANT-1)
+ if (lua_constant == NULL)
+ lua_initconstant();
+ if (t->constindex == NOT_USED)
{
- 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);
+ if (lua_nconstant == lua_maxconstant)
+ {
+ if (lua_maxconstant >= MAX_WORD)
+ lua_error("constant table overflow");
+ lua_maxconstant *= 2;
+ if (lua_maxconstant >= MAX_WORD)
+ lua_maxconstant = MAX_WORD;
+ lua_constant = growvector(lua_constant, lua_maxconstant, TaggedString *);
+ }
+ t->constindex = lua_nconstant;
+ lua_constant[lua_nconstant] = &(t->ts);
+ lua_nconstant++;
}
- return (lua_nconstant-1);
+ return t->constindex;
}
@@ -164,7 +149,7 @@ int lua_findconstant (char *s)
*/
void lua_travsymbol (void (*fn)(Object *))
{
- int i;
+ Word i;
for (i=0; i<lua_ntable; i++)
fn(&s_object(i));
}
@@ -175,9 +160,9 @@ void lua_travsymbol (void (*fn)(Object *))
*/
void lua_markobject (Object *o)
{
- if (tag(o) == T_STRING)
- markstring (svalue(o)) = 1;
- else if (tag(o) == T_ARRAY)
+ if (tag(o) == LUA_T_STRING && !tsvalue(o)->marked)
+ tsvalue(o)->marked = 1;
+ else if (tag(o) == LUA_T_ARRAY)
lua_hashmark (avalue(o));
}
@@ -188,87 +173,33 @@ void lua_markobject (Object *o)
*/
void lua_pack (void)
{
- /* mark stack strings */
- lua_travstack(lua_markobject);
-
- /* mark symbol table strings */
- lua_travsymbol(lua_markobject);
-
- lua_stringcollector();
- lua_hashcollector();
-
- lua_nentity = 0; /* reset counter */
+ static Long block = GARBAGE_BLOCK; /* when garbage collector will be called */
+ static Long nentity = 0; /* counter of new entities (strings and arrays) */
+ Long recovered = 0;
+ if (nentity++ < block) return;
+ lua_travstack(lua_markobject); /* mark stack objects */
+ lua_travsymbol(lua_markobject); /* mark symbol table objects */
+ luaI_travlock(lua_markobject); /* mark locked objects */
+ recovered += lua_strcollector();
+ recovered += lua_hashcollector();
+ nentity = 0; /* reset counter */
+ block=(16*block-7*recovered)/12; /* adapt block size */
+ if (block < MIN_GARBAGE_BLOCK) block = MIN_GARBAGE_BLOCK;
}
-/*
-** Garbage collection to atrings.
-** Delete all unmarked strings
-*/
-void lua_stringcollector (void)
-{
- int i, j;
- for (i=j=0; i<lua_nstring; i++)
- if (markstring(lua_string[i]) == 1)
- {
- lua_string[j++] = lua_string[i];
- markstring(lua_string[i]) = 0;
- }
- else
- {
- free (lua_string[i]-1);
- }
- lua_nstring = j;
-}
-
-/*
-** Allocate a new string at string table. The given string is already
-** allocated with mark space and the function puts it at the end of the
-** table, checking overflow, and returns its own pointer, or NULL on error.
-*/
-char *lua_createstring (char *s)
-{
- int i;
- if (s == NULL) return NULL;
-
- for (i=0; i<lua_nstring; i++)
- if (streq(s,lua_string[i]))
- {
- free(s-1);
- return lua_string[i];
- }
-
- if (lua_nentity == lua_block || lua_nstring >= MAXSTRING-1)
- {
- lua_pack ();
- if (lua_nstring >= MAXSTRING-1)
- {
- lua_error ("string table overflow");
- return NULL;
- }
- }
- lua_string[lua_nstring++] = s;
- lua_nentity++;
- return s;
-}
/*
** 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.
+** Return 0 on success or error message on error.
*/
-int lua_addfile (char *fn)
+char *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;
+ if (lua_nfile >= MAXFILE)
+ return "too many files";
+ if ((lua_file[lua_nfile++] = luaI_strdup (fn)) == NULL)
+ return "not enough memory";
+ return NULL;
}
/*
@@ -276,7 +207,7 @@ int lua_addfile (char *fn)
*/
int lua_delfile (void)
{
- lua_nfile--;
+ luaI_free(lua_file[--lua_nfile]);
return 1;
}
@@ -291,47 +222,56 @@ char *lua_filename (void)
/*
** Internal function: return next global variable
*/
-void lua_nextvar (void)
+static 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)
+ char *varname;
+ TreeNode *next;
+ lua_Object o = lua_getparam(1);
+ if (o == LUA_NOOBJECT)
+ lua_reportbug("too few arguments to function `nextvar'");
+ if (lua_getparam(2) != LUA_NOOBJECT)
+ lua_reportbug("too many arguments to function `nextvar'");
+ if (lua_isnil(o))
+ varname = NULL;
+ else if (!lua_isstring(o))
{
- index = 0;
- }
- else if (tag(o) != T_STRING)
- {
- lua_error ("incorrect argument to function `nextvar'");
- return;
+ lua_reportbug("incorrect argument to function `nextvar'");
+ return; /* to avoid warnings */
}
else
+ varname = lua_getstring(o);
+ next = lua_varnext(varname);
+ if (next == NULL)
{
- for (index=0; index<lua_ntable; index++)
- if (streq(s_name(index),svalue(o))) break;
- if (index == lua_ntable)
- {
- lua_error ("name not found in function `nextvar'");
- return;
- }
- index++;
- while (index < lua_ntable && tag(&s_object(index)) == T_NIL) index++;
-
- if (index == lua_ntable)
- {
- lua_pushnil();
- lua_pushnil();
- return;
- }
+ lua_pushnil();
+ lua_pushnil();
}
+ else
{
Object name;
- tag(&name) = T_STRING;
- svalue(&name) = lua_createstring(lua_strdup(s_name(index)));
- if (lua_pushobject (&name)) return;
- if (lua_pushobject (&s_object(index))) return;
+ tag(&name) = LUA_T_STRING;
+ tsvalue(&name) = &(next->ts);
+ luaI_pushobject(&name);
+ luaI_pushobject(&s_object(next->varindex));
}
}
+
+
+static void setglobal (void)
+{
+ lua_Object name = lua_getparam(1);
+ lua_Object value = lua_getparam(2);
+ if (!lua_isstring(name))
+ lua_reportbug("incorrect argument to function `setglobal'");
+ lua_pushobject(value);
+ lua_storeglobal(lua_getstring(name));
+}
+
+
+static void getglobal (void)
+{
+ lua_Object name = lua_getparam(1);
+ if (!lua_isstring(name))
+ lua_reportbug("incorrect argument to function `getglobal'");
+ lua_pushobject(lua_getglobal(lua_getstring(name)));
+}
diff --git a/src/table.h b/src/table.h
index a1da6639..c25075c0 100644
--- a/src/table.h
+++ b/src/table.h
@@ -1,42 +1,31 @@
/*
** Module to control static tables
** TeCGraf - PUC-Rio
-** $Id: table.h,v 2.1 1994/04/20 22:07:57 celes Exp $
+** $Id: table.h,v 2.10 1994/12/20 21:20:36 roberto Exp $
*/
#ifndef table_h
#define table_h
-extern Symbol *lua_table;
-extern Word lua_ntable;
-
-extern char **lua_constant;
-extern Word lua_nconstant;
-
-extern char **lua_string;
-extern Word lua_nstring;
+#include "tree.h"
+#include "opcode.h"
-extern Hash **lua_array;
-extern Word lua_narray;
+extern Symbol *lua_table;
+extern TaggedString **lua_constant;
extern char *lua_file[];
extern int lua_nfile;
-extern Word lua_block;
-extern Word lua_nentity;
-
-
-int lua_findsymbol (char *s);
-int lua_findconstant (char *s);
+void lua_initconstant (void);
+Word luaI_findsymbolbyname (char *name);
+Word luaI_findsymbol (TreeNode *t);
+Word luaI_findconstant (TreeNode *t);
void lua_travsymbol (void (*fn)(Object *));
void lua_markobject (Object *o);
void lua_pack (void);
-void lua_stringcollector (void);
-char *lua_createstring (char *s);
-int lua_addfile (char *fn);
+char *lua_addfile (char *fn);
int lua_delfile (void);
char *lua_filename (void);
-void lua_nextvar (void);
#endif
diff --git a/src/tree.c b/src/tree.c
new file mode 100644
index 00000000..5dd9d78e
--- /dev/null
+++ b/src/tree.c
@@ -0,0 +1,141 @@
+/*
+** tree.c
+** TecCGraf - PUC-Rio
+*/
+
+char *rcs_tree="$Id: tree.c,v 1.13 1995/01/12 14:19:04 roberto Exp $";
+
+
+#include <string.h>
+
+#include "mem.h"
+#include "lua.h"
+#include "tree.h"
+#include "table.h"
+
+
+#define lua_strcmp(a,b) (a[0]<b[0]?(-1):(a[0]>b[0]?(1):strcmp(a,b)))
+
+
+typedef struct StringNode {
+ struct StringNode *next;
+ TaggedString ts;
+} StringNode;
+
+static StringNode *string_root = NULL;
+
+static TreeNode *constant_root = NULL;
+
+/*
+** Insert a new constant/variable at the tree.
+*/
+static TreeNode *tree_create (TreeNode **node, char *str)
+{
+ if (*node == NULL)
+ {
+ *node = (TreeNode *) luaI_malloc(sizeof(TreeNode)+strlen(str));
+ (*node)->left = (*node)->right = NULL;
+ strcpy((*node)->ts.str, str);
+ (*node)->ts.marked = 0;
+ (*node)->ts.hash = 0;
+ (*node)->varindex = (*node)->constindex = NOT_USED;
+ return *node;
+ }
+ else
+ {
+ int c = lua_strcmp(str, (*node)->ts.str);
+ if (c < 0)
+ return tree_create(&(*node)->left, str);
+ else if (c > 0)
+ return tree_create(&(*node)->right, str);
+ else
+ return *node;
+ }
+}
+
+TaggedString *lua_createstring (char *str)
+{
+ StringNode *newString;
+ if (str == NULL) return NULL;
+ lua_pack();
+ newString = (StringNode *)luaI_malloc(sizeof(StringNode)+strlen(str));
+ newString->ts.marked = 0;
+ newString->ts.hash = 0;
+ strcpy(newString->ts.str, str);
+ newString->next = string_root;
+ string_root = newString;
+ return &(newString->ts);
+}
+
+
+TreeNode *lua_constcreate (char *str)
+{
+ return tree_create(&constant_root, str);
+}
+
+
+/*
+** Garbage collection function.
+** This function traverse the string list freeing unindexed strings
+*/
+Long lua_strcollector (void)
+{
+ StringNode *curr = string_root, *prev = NULL;
+ Long counter = 0;
+ while (curr)
+ {
+ StringNode *next = curr->next;
+ if (!curr->ts.marked)
+ {
+ if (prev == NULL) string_root = next;
+ else prev->next = next;
+ luaI_free(curr);
+ ++counter;
+ }
+ else
+ {
+ curr->ts.marked = 0;
+ prev = curr;
+ }
+ curr = next;
+ }
+ return counter;
+}
+
+/*
+** Return next variable.
+*/
+static TreeNode *tree_next (TreeNode *node, char *str)
+{
+ if (node == NULL) return NULL;
+ else if (str == NULL) return node;
+ else
+ {
+ int c = lua_strcmp(str, node->ts.str);
+ if (c == 0)
+ return node->left != NULL ? node->left : node->right;
+ else if (c < 0)
+ {
+ TreeNode *result = tree_next(node->left, str);
+ return result != NULL ? result : node->right;
+ }
+ else
+ return tree_next(node->right, str);
+ }
+}
+
+TreeNode *lua_varnext (char *n)
+{
+ TreeNode *result;
+ char *name = n;
+ while (1)
+ { /* repeat until a valid (non nil) variable */
+ result = tree_next(constant_root, name);
+ if (result == NULL) return NULL;
+ if (result->varindex != NOT_USED &&
+ s_tag(result->varindex) != LUA_T_NIL)
+ return result;
+ name = result->ts.str;
+ }
+}
+
diff --git a/src/tree.h b/src/tree.h
new file mode 100644
index 00000000..849cd5a9
--- /dev/null
+++ b/src/tree.h
@@ -0,0 +1,37 @@
+/*
+** tree.h
+** TecCGraf - PUC-Rio
+** $Id: tree.h,v 1.9 1995/01/12 14:19:04 roberto Exp $
+*/
+
+#ifndef tree_h
+#define tree_h
+
+#include "types.h"
+
+#define NOT_USED 0xFFFE
+
+
+typedef struct TaggedString
+{
+ unsigned long hash; /* 0 if not initialized */
+ char marked; /* for garbage collection */
+ char str[1]; /* \0 byte already reserved */
+} TaggedString;
+
+typedef struct TreeNode
+{
+ struct TreeNode *right;
+ struct TreeNode *left;
+ unsigned short varindex; /* != NOT_USED if this is a symbol */
+ unsigned short constindex; /* != NOT_USED if this is a constant */
+ TaggedString ts;
+} TreeNode;
+
+
+TaggedString *lua_createstring (char *str);
+TreeNode *lua_constcreate (char *str);
+Long lua_strcollector (void);
+TreeNode *lua_varnext (char *n);
+
+#endif
diff --git a/src/types.h b/src/types.h
new file mode 100644
index 00000000..43684228
--- /dev/null
+++ b/src/types.h
@@ -0,0 +1,31 @@
+/*
+** TeCGraf - PUC-Rio
+** $Id: types.h,v 1.3 1995/02/06 19:32:43 roberto Exp $
+*/
+
+#ifndef types_h
+#define types_h
+
+#include <limits.h>
+
+#ifndef real
+#define real float
+#endif
+
+typedef int Bool; /* boolean values */
+
+#define Byte lua_Byte /* some systems have Byte as a predefined type */
+typedef unsigned char Byte; /* unsigned 8 bits */
+
+#define Word lua_Word /* some systems have Word as a predefined type */
+typedef unsigned short Word; /* unsigned 16 bits */
+
+#define MAX_WORD (USHRT_MAX-2) /* maximum value of a word (-2 for safety) */
+#define MAX_INT (INT_MAX-2) /* maximum value of a int (-2 for safety) */
+
+#define Long lua_Long /* some systems have Long as a predefined type */
+typedef signed long Long; /* 32 bits */
+
+typedef unsigned int IntPoint; /* unsigned with same size as a pointer (for hashing) */
+
+#endif
diff --git a/src/ugly.h b/src/ugly.h
new file mode 100644
index 00000000..c7512255
--- /dev/null
+++ b/src/ugly.h
@@ -0,0 +1,36 @@
+/*
+** ugly.h
+** TecCGraf - PUC-Rio
+** $Id: ugly.h,v 1.2 1994/11/13 14:39:04 roberto Stab $
+*/
+
+#ifndef ugly_h
+#define ugly_h
+
+/* This enum must have the same order of the array 'reserved' in lex.c */
+
+enum {
+ U_and=128,
+ U_do,
+ U_else,
+ U_elseif,
+ U_end,
+ U_function,
+ U_if,
+ U_local,
+ U_nil,
+ U_not,
+ U_or,
+ U_repeat,
+ U_return,
+ U_then,
+ U_until,
+ U_while,
+ U_eq = '='+128,
+ U_le = '<'+128,
+ U_ge = '>'+128,
+ U_ne = '~'+128,
+ U_sc = '.'+128
+};
+
+#endif
diff --git a/src/yacc/Makefile b/src/yacc/Makefile
index 1d887e10..284d4ab5 100644
--- a/src/yacc/Makefile
+++ b/src/yacc/Makefile
@@ -1,27 +1,3 @@
-# makefile for lua
-
-LIB= $(LUA)/lib
-INC= $(LUA)/inc
-
-CC= gcc
-CFLAGS= -g -Wall -O2 -I$(INC) $(DEFS)
-DEFS= -DMAXCODE=64000 -DMAXCONSTANT=1024 -DMAXSYMBOL=1024 -DMAXARRAY=1024
-
-OBJS= hash.o inout.o lex.o opcode.o table.o y.tab.o
-SLIB= $(LIB)/lua.a
-DLIB= $(LIB)/liblua.so.1.1
-
-libs: $(SLIB) $(DLIB)
-
-$(SLIB): y.tab.c $(OBJS)
- ar ruvl $@ $(OBJS)
- ranlib $(SLIB)
-
-$(DLIB): $(OBJS)
- ld -o $@ $(OBJS)
-
-y.tab.c: lua.stx exscript
- yacc -d lua.stx ; ex y.tab.c <exscript
-
-clean:
- rm -f $(OBJS) $(SLIB) $(DLIB)
+parser.c:
+ co -M lua.stx
+ yacc -d lua.stx ; mv -f y.tab.c ../parser.c ; mv -f y.tab.h ../parser.h
diff --git a/src/yacc/exscript b/src/yacc/exscript
deleted file mode 100644
index 0a0f2a9f..00000000
--- a/src/yacc/exscript
+++ /dev/null
@@ -1,3 +0,0 @@
-1d
-x
-
diff --git a/src/yacc/lua.lex b/src/yacc/lua.lex
deleted file mode 100644
index cbb0232a..00000000
--- a/src/yacc/lua.lex
+++ /dev/null
@@ -1,85 +0,0 @@
-%{
-
-char *rcs_lualex = "$Id: lua.lex,v 1.1 1993/12/17 18:53:41 celes Exp $";
-
-#include <stdlib.h>
-#include <string.h>
-
-#include "opcode.h"
-#include "hash.h"
-#include "inout.h"
-#include "table.h"
-#include "y.tab.h"
-
-#undef input
-#undef unput
-
-static Input input;
-static Unput unput;
-
-void lua_setinput (Input fn)
-{
- input = fn;
-}
-
-void lua_setunput (Unput fn)
-{
- unput = fn;
-}
-
-char *lua_lasttext (void)
-{
- return yytext;
-}
-
-%}
-
-
-%%
-[ \t]* ;
-^"$debug" {yylval.vInt = 1; return DEBUG;}
-^"$nodebug" {yylval.vInt = 0; return DEBUG;}
-\n lua_linenumber++;
-"--".* ;
-"local" return LOCAL;
-"if" return IF;
-"then" return THEN;
-"else" return ELSE;
-"elseif" return ELSEIF;
-"while" return WHILE;
-"do" return DO;
-"repeat" return REPEAT;
-"until" return UNTIL;
-"function" {
- yylval.vWord = lua_nfile-1;
- return FUNCTION;
- }
-"end" return END;
-"return" return RETURN;
-"local" return LOCAL;
-"nil" return NIL;
-"and" return AND;
-"or" return OR;
-"not" return NOT;
-"~=" return NE;
-"<=" return LE;
-">=" return GE;
-".." return CONC;
-\"[^\"]*\" |
-\'[^\']*\' {
- yylval.vWord = lua_findenclosedconstant (yytext);
- return STRING;
- }
-[0-9]+("."[0-9]*)? |
-([0-9]+)?"."[0-9]+ |
-[0-9]+("."[0-9]*)?[dDeEgG][+-]?[0-9]+ |
-([0-9]+)?"."[0-9]+[dDeEgG][+-]?[0-9]+ {
- yylval.vFloat = atof(yytext);
- return NUMBER;
- }
-[a-zA-Z_][a-zA-Z0-9_]* {
- yylval.vWord = lua_findsymbol (yytext);
- return NAME;
- }
-. return *yytext;
-
diff --git a/src/yacc/lua.stx b/src/yacc/lua.stx
index 118a240c..9c818708 100644
--- a/src/yacc/lua.stx
+++ b/src/yacc/lua.stx
@@ -1,35 +1,43 @@
%{
-char *rcs_luastx = "$Id: lua.stx,v 2.4 1994/04/20 16:22:21 celes Exp $";
+char *rcs_luastx = "$Id: lua.stx,v 3.17 1995/01/13 22:11:12 roberto Exp $";
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
-#include "mm.h"
-
+#include "mem.h"
#include "opcode.h"
#include "hash.h"
#include "inout.h"
+#include "tree.h"
#include "table.h"
#include "lua.h"
+/* to avoid warnings generated by yacc */
+int yyparse (void);
+#define malloc luaI_malloc
+#define realloc luaI_realloc
+#define free luaI_free
+
+#ifndef LISTING
#define LISTING 0
+#endif
-#ifndef GAPCODE
-#define GAPCODE 50
+#ifndef CODE_BLOCK
+#define CODE_BLOCK 256
#endif
-static Word maxcode;
-static Word maxmain;
-static Word maxcurr ;
-static Byte *code = NULL;
-static Byte *initcode;
+static int maxcode;
+static int maxmain;
+static Long maxcurr; /* to allow maxcurr *= 2 without overflow */
+static Byte *funcCode = NULL;
+static Byte **initcode;
static Byte *basepc;
-static Word maincode;
-static Word pc;
+static int maincode;
+static int pc;
#define MAXVAR 32
-static long varbuffer[MAXVAR]; /* variables in an assignment list;
+static Long varbuffer[MAXVAR]; /* variables in an assignment list;
it's long to store negative Word values */
static int nvarbuffer=0; /* number of variables at a list */
@@ -39,8 +47,7 @@ static int nlocalvar=0; /* number of local variables */
#define MAXFIELDS FIELDS_PER_FLUSH*2
static Word fields[MAXFIELDS]; /* fieldnames to be flushed */
static int nfields=0;
-static int ntemp; /* number of temporary var into stack */
-static int err; /* flag to indicate error */
+
/* Internal functions */
@@ -48,13 +55,12 @@ static void code_byte (Byte c)
{
if (pc>maxcurr-2) /* 1 byte free to code HALT of main code */
{
- maxcurr += GAPCODE;
- basepc = (Byte *)realloc(basepc, maxcurr*sizeof(Byte));
- if (basepc == NULL)
- {
- lua_error ("not enough memory");
- err = 1;
- }
+ if (maxcurr >= MAX_INT)
+ lua_error("code size overflow");
+ maxcurr *= 2;
+ if (maxcurr >= MAX_INT)
+ maxcurr = MAX_INT;
+ basepc = growvector(basepc, maxcurr, Byte);
}
basepc[pc++] = c;
}
@@ -77,6 +83,16 @@ static void code_float (float n)
code_byte(code.m.c4);
}
+static void code_code (Byte *b)
+{
+ CodeCode code;
+ code.b = b;
+ code_byte(code.m.c1);
+ code_byte(code.m.c2);
+ code_byte(code.m.c3);
+ code_byte(code.m.c4);
+}
+
static void code_word_at (Byte *p, Word n)
{
CodeWord code;
@@ -90,10 +106,7 @@ static void push_field (Word name)
if (nfields < STACKGAP-1)
fields[nfields++] = name;
else
- {
lua_error ("too many fields in a constructor");
- err = 1;
- }
}
static void flush_record (int n)
@@ -104,7 +117,6 @@ static void flush_record (int n)
code_byte(n);
for (i=0; i<n; i++)
code_word(fields[--nfields]);
- ntemp -= n;
}
static void flush_list (int m, int n)
@@ -113,34 +125,22 @@ static void flush_list (int m, int n)
if (m == 0)
code_byte(STORELIST0);
else
+ if (m < 255)
{
code_byte(STORELIST);
code_byte(m);
}
+ else
+ lua_error ("list constructor too long");
code_byte(n);
- ntemp-=n;
-}
-
-static void incr_ntemp (void)
-{
- if (ntemp+nlocalvar+MAXVAR+1 < STACKGAP)
- ntemp++;
- else
- {
- lua_error ("stack overflow");
- err = 1;
- }
}
static void add_nlocalvar (int n)
{
- if (ntemp+nlocalvar+MAXVAR+n < STACKGAP)
+ if (MAX_TEMPS+nlocalvar+MAXVAR+n < STACKGAP)
nlocalvar += n;
else
- {
- lua_error ("too many local variables or expression too complicate");
- err = 1;
- }
+ lua_error ("too many local variables");
}
static void incr_nvarbuffer (void)
@@ -148,14 +148,12 @@ static void incr_nvarbuffer (void)
if (nvarbuffer < MAXVAR-1)
nvarbuffer++;
else
- {
lua_error ("variable buffer overflow");
- err = 1;
- }
}
static void code_number (float f)
-{ Word i = (Word)f;
+{
+ Word i = (Word)f;
if (f == (float)i) /* f has an (short) integer value */
{
if (i <= 2) code_byte(PUSH0 + i);
@@ -175,20 +173,204 @@ static void code_number (float f)
code_byte(PUSHFLOAT);
code_float(f);
}
- incr_ntemp();
}
+/*
+** Search a local name and if find return its index. If do not find return -1
+*/
+static int lua_localname (Word n)
+{
+ int i;
+ for (i=nlocalvar-1; i >= 0; i--)
+ if (n == localvar[i]) return i; /* local var */
+ return -1; /* global var */
+}
+
+/*
+** Push a variable given a number. If number is positive, push global variable
+** indexed by (number -1). If negative, push local indexed by ABS(number)-1.
+** Otherwise, if zero, push indexed variable (record).
+*/
+static void lua_pushvar (Long number)
+{
+ if (number > 0) /* global var */
+ {
+ code_byte(PUSHGLOBAL);
+ code_word(number-1);
+ }
+ else if (number < 0) /* local var */
+ {
+ number = (-number) - 1;
+ if (number < 10) code_byte(PUSHLOCAL0 + number);
+ else
+ {
+ code_byte(PUSHLOCAL);
+ code_byte(number);
+ }
+ }
+ else
+ {
+ code_byte(PUSHINDEXED);
+ }
+}
+
+static void lua_codeadjust (int n)
+{
+ if (n+nlocalvar == 0)
+ code_byte(ADJUST0);
+ else
+ {
+ code_byte(ADJUST);
+ code_byte(n+nlocalvar);
+ }
+}
+
+static void init_function (TreeNode *func)
+{
+ if (funcCode == NULL) /* first function */
+ {
+ funcCode = newvector(CODE_BLOCK, Byte);
+ maxcode = CODE_BLOCK;
+ }
+ pc=0; basepc=funcCode; maxcurr=maxcode;
+ nlocalvar=0;
+ if (lua_debug)
+ {
+ code_byte(SETFUNCTION);
+ code_code((Byte *)luaI_strdup(lua_file[lua_nfile-1]));
+ code_word(luaI_findconstant(func));
+ }
+}
+
+static void codereturn (void)
+{
+ if (lua_debug) code_byte(RESET);
+ if (nlocalvar == 0)
+ code_byte(RETCODE0);
+ else
+ {
+ code_byte(RETCODE);
+ code_byte(nlocalvar);
+ }
+}
+
+static void codedebugline (void)
+{
+ if (lua_debug)
+ {
+ code_byte(SETLINE);
+ code_word(lua_linenumber);
+ }
+}
+
+static void adjust_mult_assign (int vars, int exps, int temps)
+{
+ if (exps < 0)
+ {
+ int r = vars - (-exps-1);
+ if (r >= 0)
+ code_byte(r);
+ else
+ {
+ code_byte(0);
+ lua_codeadjust(temps);
+ }
+ }
+ else if (vars != exps)
+ lua_codeadjust(temps);
+}
+
+static void lua_codestore (int i)
+{
+ if (varbuffer[i] > 0) /* global var */
+ {
+ code_byte(STOREGLOBAL);
+ code_word(varbuffer[i]-1);
+ }
+ else if (varbuffer[i] < 0) /* local var */
+ {
+ int number = (-varbuffer[i]) - 1;
+ if (number < 10) code_byte(STORELOCAL0 + number);
+ else
+ {
+ code_byte(STORELOCAL);
+ code_byte(number);
+ }
+ }
+ else /* indexed var */
+ {
+ int j;
+ int upper=0; /* number of indexed variables upper */
+ int param; /* number of itens until indexed expression */
+ for (j=i+1; j <nvarbuffer; j++)
+ if (varbuffer[j] == 0) upper++;
+ param = upper*2 + i;
+ if (param == 0)
+ code_byte(STOREINDEXED0);
+ else
+ {
+ code_byte(STOREINDEXED);
+ code_byte(param);
+ }
+ }
+}
+
+static void codeIf (Long thenAdd, Long elseAdd)
+{
+ Long elseinit = elseAdd+sizeof(Word)+1;
+ if (pc == elseinit) /* no else */
+ {
+ pc -= sizeof(Word)+1;
+ elseinit = pc;
+ }
+ else
+ {
+ basepc[elseAdd] = JMP;
+ code_word_at(basepc+elseAdd+1, pc-elseinit);
+ }
+ basepc[thenAdd] = IFFJMP;
+ code_word_at(basepc+thenAdd+1,elseinit-(thenAdd+sizeof(Word)+1));
+}
+
+static void yyerror (char *s)
+{
+ static char msg[256];
+ sprintf (msg,"%s near \"%s\" at line %d in file \"%s\"",
+ s, lua_lasttext (), lua_linenumber, lua_filename());
+ lua_error (msg);
+}
+
+
+/*
+** Parse LUA code.
+*/
+void lua_parse (Byte **code)
+{
+ initcode = code;
+ *initcode = newvector(CODE_BLOCK, Byte);
+ maincode = 0;
+ maxmain = CODE_BLOCK;
+ if (yyparse ()) lua_error("parse error");
+ (*initcode)[maincode++] = RETCODE0;
+#if LISTING
+{ static void PrintCode (Byte *c, Byte *end);
+ PrintCode(*initcode,*initcode+maincode); }
+#endif
+}
+
+
%}
%union
{
int vInt;
- long vLong;
float vFloat;
char *pChar;
Word vWord;
+ Long vLong;
Byte *pByte;
+ TreeNode *pNode;
}
%start functionlist
@@ -198,25 +380,27 @@ static void code_number (float f)
%token IF THEN ELSE ELSEIF WHILE DO REPEAT UNTIL END
%token RETURN
%token LOCAL
+%token FUNCTION
%token <vFloat> NUMBER
-%token <vWord> FUNCTION STRING
-%token <pChar> NAME
+%token <vWord> STRING
+%token <pNode> NAME
%token <vInt> DEBUG
-%type <vWord> PrepJump
-%type <vInt> expr, exprlist, exprlist1, varlist1, typeconstructor
-%type <vInt> fieldlist, localdeclist
-%type <vInt> ffieldlist, ffieldlist1
-%type <vInt> lfieldlist, lfieldlist1
-%type <vLong> var, objectname
-
+%type <vLong> PrepJump
+%type <vInt> expr, exprlist, exprlist1, varlist1, funcParams, funcvalue
+%type <vInt> fieldlist, localdeclist, decinit
+%type <vInt> ffieldlist1
+%type <vInt> lfieldlist1
+%type <vLong> var, singlevar
+%type <pByte> body
%left AND OR
-%left '=' NE '>' '<' LE GE
+%left EQ NE '>' '<' LE GE
%left CONC
%left '+' '-'
%left '*' '/'
%left UNARY NOT
+%right '^'
%% /* beginning of rules section */
@@ -225,156 +409,115 @@ static void code_number (float f)
functionlist : /* empty */
| functionlist
{
- pc=maincode; basepc=initcode; maxcurr=maxmain;
+ pc=maincode; basepc=*initcode; maxcurr=maxmain;
nlocalvar=0;
}
stat sc
{
- maincode=pc; initcode=basepc; maxmain=maxcurr;
+ maincode=pc; *initcode=basepc; maxmain=maxcurr;
}
| functionlist function
+ | functionlist method
| functionlist setdebug
;
-
+
function : FUNCTION NAME
+ {
+ init_function($2);
+ }
+ body
+ {
+ Word func = luaI_findsymbol($2);
+ s_tag(func) = LUA_T_FUNCTION;
+ s_bvalue(func) = $4;
+ }
+ ;
+
+method : FUNCTION NAME ':' NAME
{
- if (code == NULL) /* first function */
- {
- code = (Byte *) calloc(GAPCODE, sizeof(Byte));
- if (code == NULL)
- {
- lua_error("not enough memory");
- err = 1;
- }
- maxcode = GAPCODE;
- }
- pc=0; basepc=code; maxcurr=maxcode;
- nlocalvar=0;
- $<vWord>$ = lua_findsymbol($2);
+ init_function($4);
+ localvar[nlocalvar]=luaI_findsymbolbyname("self");
+ add_nlocalvar(1);
}
- '(' parlist ')'
+ body
{
- if (lua_debug)
- {
- code_byte(SETFUNCTION);
- code_word(lua_nfile-1);
- code_word($<vWord>3);
- }
- lua_codeadjust (0);
+ /* assign function to table field */
+ pc=maincode; basepc=*initcode; maxcurr=maxmain;
+ nlocalvar=0;
+ lua_pushvar(luaI_findsymbol($2)+1);
+ code_byte(PUSHSTRING);
+ code_word(luaI_findconstant($4));
+ code_byte(PUSHFUNCTION);
+ code_code($6);
+ code_byte(STOREINDEXED0);
+ maincode=pc; *initcode=basepc; maxmain=maxcurr;
}
- block
- END
- {
- if (lua_debug) code_byte(RESET);
- code_byte(RETCODE); code_byte(nlocalvar);
- s_tag($<vWord>3) = T_FUNCTION;
- s_bvalue($<vWord>3) = calloc (pc, sizeof(Byte));
- if (s_bvalue($<vWord>3) == NULL)
- {
- lua_error("not enough memory");
- err = 1;
- }
- memcpy (s_bvalue($<vWord>3), basepc, pc*sizeof(Byte));
- code = basepc; maxcode=maxcurr;
+ ;
+
+body : '(' parlist ')' block END
+ {
+ codereturn();
+ $$ = newvector(pc, Byte);
+ memcpy($$, basepc, pc*sizeof(Byte));
+ funcCode = basepc; maxcode=maxcurr;
#if LISTING
-PrintCode(code,code+pc);
+ PrintCode(funcCode,funcCode+pc);
#endif
- }
- ;
+ }
+ ;
statlist : /* empty */
| statlist stat sc
;
-stat : {
- ntemp = 0;
- if (lua_debug)
- {
- code_byte(SETLINE); code_word(lua_linenumber);
- }
- }
- stat1
-
sc : /* empty */ | ';' ;
+stat : { codedebugline(); } stat1 ;
+
+cond : { codedebugline(); } expr1 ;
stat1 : IF expr1 THEN PrepJump block PrepJump elsepart END
- {
- {
- Word elseinit = $6+sizeof(Word)+1;
- if (pc - elseinit == 0) /* no else */
- {
- pc -= sizeof(Word)+1;
- elseinit = pc;
- }
- else
- {
- basepc[$6] = JMP;
- code_word_at(basepc+$6+1, pc - elseinit);
- }
- basepc[$4] = IFFJMP;
- code_word_at(basepc+$4+1,elseinit-($4+sizeof(Word)+1));
- }
- }
-
- | WHILE {$<vWord>$=pc;} expr1 DO PrepJump block PrepJump END
-
+ { codeIf($4, $6); }
+
+ | WHILE {$<vLong>$=pc;} expr1 DO PrepJump block PrepJump END
{
basepc[$5] = IFFJMP;
code_word_at(basepc+$5+1, pc - ($5 + sizeof(Word)+1));
-
basepc[$7] = UPJMP;
- code_word_at(basepc+$7+1, pc - ($<vWord>2));
+ code_word_at(basepc+$7+1, pc - ($<vLong>2));
}
- | REPEAT {$<vWord>$=pc;} block UNTIL expr1 PrepJump
-
+ | REPEAT {$<vLong>$=pc;} block UNTIL cond PrepJump
{
basepc[$6] = IFFUPJMP;
- code_word_at(basepc+$6+1, pc - ($<vWord>2));
+ code_word_at(basepc+$6+1, pc - ($<vLong>2));
}
-
| varlist1 '=' exprlist1
{
{
int i;
- if ($3 == 0 || nvarbuffer != ntemp - $1 * 2)
- lua_codeadjust ($1 * 2 + nvarbuffer);
+ adjust_mult_assign(nvarbuffer, $3, $1 * 2 + nvarbuffer);
for (i=nvarbuffer-1; i>=0; i--)
lua_codestore (i);
if ($1 > 1 || ($1 == 1 && varbuffer[0] != 0))
lua_codeadjust (0);
}
}
- | functioncall { lua_codeadjust (0); }
- | typeconstructor { lua_codeadjust (0); }
- | LOCAL localdeclist decinit { add_nlocalvar($2); lua_codeadjust (0); }
+ | functioncall { code_byte(0); }
+ | LOCAL localdeclist decinit
+ { add_nlocalvar($2);
+ adjust_mult_assign($2, $3, 0);
+ }
;
elsepart : /* empty */
| ELSE block
- | ELSEIF expr1 THEN PrepJump block PrepJump elsepart
- {
- {
- Word elseinit = $6+sizeof(Word)+1;
- if (pc - elseinit == 0) /* no else */
- {
- pc -= sizeof(Word)+1;
- elseinit = pc;
- }
- else
- {
- basepc[$6] = JMP;
- code_word_at(basepc+$6+1, pc - elseinit);
- }
- basepc[$4] = IFFJMP;
- code_word_at(basepc+$4+1, elseinit - ($4 + sizeof(Word)+1));
- }
- }
+ | ELSEIF cond THEN PrepJump block PrepJump elsepart
+ { codeIf($4, $6); }
;
-block : {$<vInt>$ = nlocalvar;} statlist {ntemp = 0;} ret
+block : {$<vInt>$ = nlocalvar;} statlist ret
{
if (nlocalvar != $<vInt>1)
{
@@ -385,11 +528,10 @@ block : {$<vInt>$ = nlocalvar;} statlist {ntemp = 0;} ret
;
ret : /* empty */
- | { if (lua_debug){code_byte(SETLINE);code_word(lua_linenumber);}}
- RETURN exprlist sc
- {
- if (lua_debug) code_byte(RESET);
- code_byte(RETCODE); code_byte(nlocalvar);
+ | RETURN { codedebugline(); } exprlist sc
+ {
+ if ($3 < 0) code_byte(MULT_RET);
+ codereturn();
}
;
@@ -400,55 +542,42 @@ PrepJump : /* empty */
code_word (0);
}
-expr1 : expr { if ($1 == 0) {lua_codeadjust (ntemp+1); incr_ntemp();}}
+expr1 : expr { if ($1 == 0) code_byte(1); }
;
-expr : '(' expr ')' { $$ = $2; }
- | expr1 '=' expr1 { code_byte(EQOP); $$ = 1; ntemp--;}
- | expr1 '<' expr1 { code_byte(LTOP); $$ = 1; ntemp--;}
- | expr1 '>' expr1 { code_byte(LEOP); code_byte(NOTOP); $$ = 1; ntemp--;}
- | expr1 NE expr1 { code_byte(EQOP); code_byte(NOTOP); $$ = 1; ntemp--;}
- | expr1 LE expr1 { code_byte(LEOP); $$ = 1; ntemp--;}
- | expr1 GE expr1 { code_byte(LTOP); code_byte(NOTOP); $$ = 1; ntemp--;}
- | expr1 '+' expr1 { code_byte(ADDOP); $$ = 1; ntemp--;}
- | expr1 '-' expr1 { code_byte(SUBOP); $$ = 1; ntemp--;}
- | expr1 '*' expr1 { code_byte(MULTOP); $$ = 1; ntemp--;}
- | expr1 '/' expr1 { code_byte(DIVOP); $$ = 1; ntemp--;}
- | expr1 CONC expr1 { code_byte(CONCOP); $$ = 1; ntemp--;}
- | '+' expr1 %prec UNARY { $$ = 1; }
+expr : '(' expr ')' { $$ = $2; }
+ | expr1 EQ expr1 { code_byte(EQOP); $$ = 1; }
+ | expr1 '<' expr1 { code_byte(LTOP); $$ = 1; }
+ | expr1 '>' expr1 { code_byte(GTOP); $$ = 1; }
+ | expr1 NE expr1 { code_byte(EQOP); code_byte(NOTOP); $$ = 1; }
+ | expr1 LE expr1 { code_byte(LEOP); $$ = 1; }
+ | expr1 GE expr1 { code_byte(GEOP); $$ = 1; }
+ | expr1 '+' expr1 { code_byte(ADDOP); $$ = 1; }
+ | expr1 '-' expr1 { code_byte(SUBOP); $$ = 1; }
+ | expr1 '*' expr1 { code_byte(MULTOP); $$ = 1; }
+ | expr1 '/' expr1 { code_byte(DIVOP); $$ = 1; }
+ | expr1 '^' expr1 { code_byte(POWOP); $$ = 1; }
+ | expr1 CONC expr1 { code_byte(CONCOP); $$ = 1; }
| '-' expr1 %prec UNARY { code_byte(MINUSOP); $$ = 1;}
- | typeconstructor { $$ = $1; }
- | '@' '(' dimension ')'
- {
- code_byte(CREATEARRAY);
- $$ = 1;
- }
- | var { lua_pushvar ($1); $$ = 1;}
- | NUMBER { code_number($1); $$ = 1; }
- | STRING
+ | table { $$ = 1; }
+ | varexp { $$ = 1;}
+ | NUMBER { code_number($1); $$ = 1; }
+ | STRING
{
code_byte(PUSHSTRING);
code_word($1);
$$ = 1;
- incr_ntemp();
- }
- | NIL {code_byte(PUSHNIL); $$ = 1; incr_ntemp();}
- | functioncall
- {
- $$ = 0;
- if (lua_debug)
- {
- code_byte(SETLINE); code_word(lua_linenumber);
- }
}
+ | NIL {code_byte(PUSHNIL); $$ = 1; }
+ | functioncall { $$ = 0; }
| NOT expr1 { code_byte(NOTOP); $$ = 1;}
- | expr1 AND PrepJump {code_byte(POP); ntemp--;} expr1
+ | expr1 AND PrepJump {code_byte(POP); } expr1
{
basepc[$3] = ONFJMP;
code_word_at(basepc+$3+1, pc - ($3 + sizeof(Word)+1));
$$ = 1;
}
- | expr1 OR PrepJump {code_byte(POP); ntemp--;} expr1
+ | expr1 OR PrepJump {code_byte(POP); } expr1
{
basepc[$3] = ONTJMP;
code_word_at(basepc+$3+1, pc - ($3 + sizeof(Word)+1));
@@ -456,92 +585,77 @@ expr : '(' expr ')' { $$ = $2; }
}
;
-typeconstructor: '@'
+table :
{
- code_byte(PUSHBYTE);
- $<vWord>$ = pc; code_byte(0);
- incr_ntemp();
code_byte(CREATEARRAY);
+ $<vLong>$ = pc; code_word(0);
}
- objectname fieldlist
+ '{' fieldlist '}'
{
- basepc[$<vWord>2] = $4;
- if ($3 < 0) /* there is no function to be called */
- {
- $$ = 1;
- }
- else
- {
- lua_pushvar ($3+1);
- code_byte(PUSHMARK);
- incr_ntemp();
- code_byte(PUSHOBJECT);
- incr_ntemp();
- code_byte(CALLFUNC);
- ntemp -= 4;
- $$ = 0;
- if (lua_debug)
- {
- code_byte(SETLINE); code_word(lua_linenumber);
- }
- }
+ code_word_at(basepc+$<vLong>1, $3);
}
;
-dimension : /* empty */ { code_byte(PUSHNIL); incr_ntemp();}
- | expr1
+functioncall : funcvalue funcParams
+ { code_byte(CALLFUNC); code_byte($1+$2); }
;
-
-functioncall : functionvalue {code_byte(PUSHMARK); $<vInt>$ = ntemp; incr_ntemp();}
- '(' exprlist ')' { code_byte(CALLFUNC); ntemp = $<vInt>2-1;}
-functionvalue : var {lua_pushvar ($1); }
- ;
-
-exprlist : /* empty */ { $$ = 1; }
+funcvalue : varexp { $$ = 0; }
+ | varexp ':' NAME
+ {
+ code_byte(PUSHSELF);
+ code_word(luaI_findconstant($3));
+ $$ = 1;
+ }
+ ;
+
+funcParams : '(' exprlist ')'
+ { if ($2<0) { code_byte(1); $$ = -$2; } else $$ = $2; }
+ | table { $$ = 1; }
+ ;
+
+exprlist : /* empty */ { $$ = 0; }
| exprlist1 { $$ = $1; }
;
-exprlist1 : expr { $$ = $1; }
- | exprlist1 ',' {if (!$1){lua_codeadjust (ntemp+1); incr_ntemp();}}
- expr {$$ = $4;}
+exprlist1 : expr { if ($1 == 0) $$ = -1; else $$ = 1; }
+ | exprlist1 ',' { if ($1 < 0) code_byte(1); } expr
+ {
+ int r = $1 < 0 ? -$1 : $1;
+ $$ = ($4 == 0) ? -(r+1) : r+1;
+ }
;
-parlist : /* empty */
- | parlist1
+parlist : /* empty */ { lua_codeadjust(0); }
+ | parlist1 { lua_codeadjust(0); }
;
parlist1 : NAME
{
- localvar[nlocalvar]=lua_findsymbol($1);
+ localvar[nlocalvar]=luaI_findsymbol($1);
add_nlocalvar(1);
}
| parlist1 ',' NAME
{
- localvar[nlocalvar]=lua_findsymbol($3);
+ localvar[nlocalvar]=luaI_findsymbol($3);
add_nlocalvar(1);
}
;
-objectname : /* empty */ {$$=-1;}
- | NAME {$$=lua_findsymbol($1);}
- ;
-
-fieldlist : '{' ffieldlist '}'
- {
- flush_record($2%FIELDS_PER_FLUSH);
- $$ = $2;
- }
- | '[' lfieldlist ']'
- {
- flush_list($2/FIELDS_PER_FLUSH, $2%FIELDS_PER_FLUSH);
- $$ = $2;
- }
+fieldlist : /* empty */ { $$ = 0; }
+ | lfieldlist1 lastcomma
+ { $$ = $1; flush_list($1/FIELDS_PER_FLUSH, $1%FIELDS_PER_FLUSH); }
+ | ffieldlist1 lastcomma
+ { $$ = $1; flush_record($1%FIELDS_PER_FLUSH); }
+ | lfieldlist1 ';'
+ { flush_list($1/FIELDS_PER_FLUSH, $1%FIELDS_PER_FLUSH); }
+ ffieldlist1 lastcomma
+ { $$ = $1+$4; flush_record($4%FIELDS_PER_FLUSH); }
;
-ffieldlist : /* empty */ { $$ = 0; }
- | ffieldlist1 { $$ = $1; }
- ;
+lastcomma : /* empty */
+ | ','
+ ;
ffieldlist1 : ffield {$$=1;}
| ffieldlist1 ',' ffield
@@ -551,16 +665,12 @@ ffieldlist1 : ffield {$$=1;}
}
;
-ffield : NAME {$<vWord>$ = lua_findconstant($1);} '=' expr1
+ffield : NAME '=' expr1
{
- push_field($<vWord>2);
+ push_field(luaI_findconstant($1));
}
;
-lfieldlist : /* empty */ { $$ = 0; }
- | lfieldlist1 { $$ = $1; }
- ;
-
lfieldlist1 : expr1 {$$=1;}
| lfieldlist1 ',' expr1
{
@@ -583,169 +693,49 @@ varlist1 : var
}
;
-var : NAME
- {
- Word s = lua_findsymbol($1);
- int local = lua_localname (s);
- if (local == -1) /* global var */
- $$ = s + 1; /* return positive value */
- else
- $$ = -(local+1); /* return negative value */
- }
-
- | var {lua_pushvar ($1);} '[' expr1 ']'
+var : singlevar { $$ = $1; }
+ | varexp '[' expr1 ']'
{
$$ = 0; /* indexed variable */
}
- | var {lua_pushvar ($1);} '.' NAME
+ | varexp '.' NAME
{
code_byte(PUSHSTRING);
- code_word(lua_findconstant($4)); incr_ntemp();
+ code_word(luaI_findconstant($3));
$$ = 0; /* indexed variable */
}
;
-localdeclist : NAME {localvar[nlocalvar]=lua_findsymbol($1); $$ = 1;}
+singlevar : NAME
+ {
+ Word s = luaI_findsymbol($1);
+ int local = lua_localname (s);
+ if (local == -1) /* global var */
+ $$ = s + 1; /* return positive value */
+ else
+ $$ = -(local+1); /* return negative value */
+ }
+ ;
+
+varexp : var { lua_pushvar($1); }
+ ;
+
+localdeclist : NAME {localvar[nlocalvar]=luaI_findsymbol($1); $$ = 1;}
| localdeclist ',' NAME
{
- localvar[nlocalvar+$1]=lua_findsymbol($3);
+ localvar[nlocalvar+$1]=luaI_findsymbol($3);
$$ = $1+1;
}
;
-decinit : /* empty */
- | '=' exprlist1
+decinit : /* empty */ { $$ = 0; }
+ | '=' exprlist1 { $$ = $2; }
;
setdebug : DEBUG {lua_debug = $1;}
%%
-/*
-** Search a local name and if find return its index. If do not find return -1
-*/
-static int lua_localname (Word n)
-{
- int i;
- for (i=nlocalvar-1; i >= 0; i--)
- if (n == localvar[i]) return i; /* local var */
- return -1; /* global var */
-}
-
-/*
-** Push a variable given a number. If number is positive, push global variable
-** indexed by (number -1). If negative, push local indexed by ABS(number)-1.
-** Otherwise, if zero, push indexed variable (record).
-*/
-static void lua_pushvar (long number)
-{
- if (number > 0) /* global var */
- {
- code_byte(PUSHGLOBAL);
- code_word(number-1);
- incr_ntemp();
- }
- else if (number < 0) /* local var */
- {
- number = (-number) - 1;
- if (number < 10) code_byte(PUSHLOCAL0 + number);
- else
- {
- code_byte(PUSHLOCAL);
- code_byte(number);
- }
- incr_ntemp();
- }
- else
- {
- code_byte(PUSHINDEXED);
- ntemp--;
- }
-}
-
-static void lua_codeadjust (int n)
-{
- code_byte(ADJUST);
- code_byte(n + nlocalvar);
-}
-
-static void lua_codestore (int i)
-{
- if (varbuffer[i] > 0) /* global var */
- {
- code_byte(STOREGLOBAL);
- code_word(varbuffer[i]-1);
- }
- else if (varbuffer[i] < 0) /* local var */
- {
- int number = (-varbuffer[i]) - 1;
- if (number < 10) code_byte(STORELOCAL0 + number);
- else
- {
- code_byte(STORELOCAL);
- code_byte(number);
- }
- }
- else /* indexed var */
- {
- int j;
- int upper=0; /* number of indexed variables upper */
- int param; /* number of itens until indexed expression */
- for (j=i+1; j <nvarbuffer; j++)
- if (varbuffer[j] == 0) upper++;
- param = upper*2 + i;
- if (param == 0)
- code_byte(STOREINDEXED0);
- else
- {
- code_byte(STOREINDEXED);
- code_byte(param);
- }
- }
-}
-
-void yyerror (char *s)
-{
- static char msg[256];
- sprintf (msg,"%s near \"%s\" at line %d in file \"%s\"",
- s, lua_lasttext (), lua_linenumber, lua_filename());
- lua_error (msg);
- err = 1;
-}
-
-int yywrap (void)
-{
- return 1;
-}
-
-
-/*
-** Parse LUA code and execute global statement.
-** Return 0 on success or 1 on error.
-*/
-int lua_parse (void)
-{
- Byte *init = initcode = (Byte *) calloc(GAPCODE, sizeof(Byte));
- maincode = 0;
- maxmain = GAPCODE;
- if (init == NULL)
- {
- lua_error("not enough memory");
- return 1;
- }
- err = 0;
- if (yyparse () || (err==1)) return 1;
- initcode[maincode++] = HALT;
- init = initcode;
-#if LISTING
- PrintCode(init,init+maincode);
-#endif
- if (lua_execute (init)) return 1;
- free(init);
- return 0;
-}
-
-
#if LISTING
static void PrintCode (Byte *code, Byte *end)
@@ -792,6 +782,16 @@ static void PrintCode (Byte *code, Byte *end)
printf ("%d PUSHSTRING %d\n", n, c.w);
}
break;
+ case PUSHFUNCTION:
+ {
+ CodeCode c;
+ int n = p-code;
+ p++;
+ get_code(c,p);
+ printf ("%d PUSHFUNCTION %p\n", n, c.b);
+ }
+ break;
+
case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2: case PUSHLOCAL3:
case PUSHLOCAL4: case PUSHLOCAL5: case PUSHLOCAL6: case PUSHLOCAL7:
case PUSHLOCAL8: case PUSHLOCAL9:
@@ -811,8 +811,6 @@ static void PrintCode (Byte *code, Byte *end)
}
break;
case PUSHINDEXED: printf ("%d PUSHINDEXED\n", (p++)-code); break;
- case PUSHMARK: printf ("%d PUSHMARK\n", (p++)-code); break;
- case PUSHOBJECT: printf ("%d PUSHOBJECT\n", (p++)-code); break;
case STORELOCAL0: case STORELOCAL1: case STORELOCAL2: case STORELOCAL3:
case STORELOCAL4: case STORELOCAL5: case STORELOCAL6: case STORELOCAL7:
case STORELOCAL8: case STORELOCAL9:
@@ -832,6 +830,15 @@ static void PrintCode (Byte *code, Byte *end)
printf ("%d STOREGLOBAL %d\n", n, c.w);
}
break;
+ case PUSHSELF:
+ {
+ CodeWord c;
+ int n = p-code;
+ p++;
+ get_word(c,p);
+ printf ("%d PUSHSELF %d\n", n, c.w);
+ }
+ break;
case STOREINDEXED0: printf ("%d STOREINDEXED0\n", (p++)-code); break;
case STOREINDEXED: printf ("%d STOREINDEXED %d\n", p-code, *(++p));
p++;
@@ -848,11 +855,20 @@ static void PrintCode (Byte *code, Byte *end)
printf("%d STORERECORD %d\n", p-code, *(++p));
p += *p*sizeof(Word) + 1;
break;
+ case ADJUST0: printf ("%d ADJUST0\n", (p++)-code); break;
case ADJUST:
printf ("%d ADJUST %d\n", p-code, *(++p));
p++;
break;
- case CREATEARRAY: printf ("%d CREATEARRAY\n", (p++)-code); break;
+ case CREATEARRAY:
+ {
+ CodeWord c;
+ int n = p-code;
+ p++;
+ get_word(c,p);
+ printf ("%d CREATEARRAY %d\n", n, c.w);
+ break;
+ }
case EQOP: printf ("%d EQOP\n", (p++)-code); break;
case LTOP: printf ("%d LTOP\n", (p++)-code); break;
case LEOP: printf ("%d LEOP\n", (p++)-code); break;
@@ -860,6 +876,7 @@ static void PrintCode (Byte *code, Byte *end)
case SUBOP: printf ("%d SUBOP\n", (p++)-code); break;
case MULTOP: printf ("%d MULTOP\n", (p++)-code); break;
case DIVOP: printf ("%d DIVOP\n", (p++)-code); break;
+ case POWOP: printf ("%d POWOP\n", (p++)-code); break;
case CONCOP: printf ("%d CONCOP\n", (p++)-code); break;
case MINUSOP: printf ("%d MINUSOP\n", (p++)-code); break;
case NOTOP: printf ("%d NOTOP\n", (p++)-code); break;
@@ -918,20 +935,24 @@ static void PrintCode (Byte *code, Byte *end)
}
break;
case POP: printf ("%d POP\n", (p++)-code); break;
- case CALLFUNC: printf ("%d CALLFUNC\n", (p++)-code); break;
+ case CALLFUNC:
+ printf ("%d CALLFUNC %d %d\n", p-code, *(p+1), *(p+2));
+ p+=3;
+ break;
+ case RETCODE0: printf ("%d RETCODE0\n", (p++)-code); break;
case RETCODE:
printf ("%d RETCODE %d\n", p-code, *(++p));
p++;
break;
- case HALT: printf ("%d HALT\n", (p++)-code); break;
case SETFUNCTION:
{
- CodeWord c1, c2;
+ CodeCode c1;
+ CodeWord c2;
int n = p-code;
p++;
- get_word(c1,p);
+ get_code(c1,p);
get_word(c2,p);
- printf ("%d SETFUNCTION %d %d\n", n, c1.w, c2.w);
+ printf ("%d SETFUNCTION %s %d\n", n, (char *)c1.b, c2.w);
}
break;
case SETLINE:
View Lorry Controller Status