aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorWaldemar Celes <celes@tecgraf.puc-rio.br>1994-07-19 18:27:18 -0300
committerWaldemar Celes <celes@tecgraf.puc-rio.br>1994-07-19 18:27:18 -0300
commit493d718b7fe0f1075072a44d7946e38ca7d773d3 (patch)
tree3239639a562d742002342166cce005f7d70cc503
parent1c749a3059051c52c3bc24540e27b0ccbcfff273 (diff)
downloadlua-493d718b7fe0f1075072a44d7946e38ca7d773d3.tar.gz
lua-493d718b7fe0f1075072a44d7946e38ca7d773d3.tar.bz2
lua-493d718b7fe0f1075072a44d7946e38ca7d773d3.zip
Uso de arvores binarias para armazenar nomes e realocacao dinamica
de tabelas (pilhas, hashtable, globais, codigo, etc.)
-rw-r--r--hash.c5
-rw-r--r--inout.c7
-rw-r--r--lua.stx49
-rw-r--r--opcode.c131
-rw-r--r--opcode.h6
-rw-r--r--table.c314
-rw-r--r--table.h14
7 files changed, 251 insertions, 275 deletions
diff --git a/hash.c b/hash.c
index 549338a1..0b823092 100644
--- a/hash.c
+++ b/hash.c
@@ -4,7 +4,7 @@
4** Luiz Henrique de Figueiredo - 17 Aug 90 4** Luiz Henrique de Figueiredo - 17 Aug 90
5*/ 5*/
6 6
7char *rcs_hash="$Id: hash.c,v 1.2 1994/03/28 15:14:02 celes Exp celes $"; 7char *rcs_hash="$Id: hash.c,v 2.1 1994/04/20 22:07:57 celes Exp celes $";
8 8
9#include <string.h> 9#include <string.h>
10#include <stdlib.h> 10#include <stdlib.h>
@@ -31,9 +31,6 @@ char *rcs_hash="$Id: hash.c,v 1.2 1994/03/28 15:14:02 celes Exp celes $";
31#define ref_nvalue(n) (nvalue(&(n)->ref)) 31#define ref_nvalue(n) (nvalue(&(n)->ref))
32#define ref_svalue(n) (svalue(&(n)->ref)) 32#define ref_svalue(n) (svalue(&(n)->ref))
33 33
34#ifndef ARRAYBLOCK
35#define ARRAYBLOCK 50
36#endif
37 34
38typedef struct ArrayList 35typedef struct ArrayList
39{ 36{
diff --git a/inout.c b/inout.c
index 7587da56..7548e05e 100644
--- a/inout.c
+++ b/inout.c
@@ -4,7 +4,7 @@
4** facilities. 4** facilities.
5*/ 5*/
6 6
7char *rcs_inout="$Id: inout.c,v 1.1 1993/12/17 18:41:19 celes Exp roberto $"; 7char *rcs_inout="$Id: inout.c,v 1.2 1993/12/22 21:15:16 roberto Exp celes $";
8 8
9#include <stdio.h> 9#include <stdio.h>
10#include <string.h> 10#include <string.h>
@@ -13,6 +13,7 @@ char *rcs_inout="$Id: inout.c,v 1.1 1993/12/17 18:41:19 celes Exp roberto $";
13#include "hash.h" 13#include "hash.h"
14#include "inout.h" 14#include "inout.h"
15#include "table.h" 15#include "table.h"
16#include "tree.h"
16 17
17/* Exported variables */ 18/* Exported variables */
18int lua_linenumber; 19int lua_linenumber;
@@ -157,12 +158,12 @@ void lua_reportbug (char *s)
157 { 158 {
158 sprintf (strchr(msg,0), 159 sprintf (strchr(msg,0),
159 "\n\tin statement begining at line %d in function \"%s\" of file \"%s\"", 160 "\n\tin statement begining at line %d in function \"%s\" of file \"%s\"",
160 lua_debugline, s_name(funcstack[nfuncstack-1].function), 161 lua_debugline, lua_varname(funcstack[nfuncstack-1].function),
161 lua_file[funcstack[nfuncstack-1].file]); 162 lua_file[funcstack[nfuncstack-1].file]);
162 sprintf (strchr(msg,0), "\n\tactive stack\n"); 163 sprintf (strchr(msg,0), "\n\tactive stack\n");
163 for (i=nfuncstack-1; i>=0; i--) 164 for (i=nfuncstack-1; i>=0; i--)
164 sprintf (strchr(msg,0), "\t-> function \"%s\" of file \"%s\"\n", 165 sprintf (strchr(msg,0), "\t-> function \"%s\" of file \"%s\"\n",
165 s_name(funcstack[i].function), 166 lua_varname(funcstack[i].function),
166 lua_file[funcstack[i].file]); 167 lua_file[funcstack[i].file]);
167 } 168 }
168 else 169 else
diff --git a/lua.stx b/lua.stx
index 1e4b3107..6c7c9791 100644
--- a/lua.stx
+++ b/lua.stx
@@ -1,6 +1,6 @@
1%{ 1%{
2 2
3char *rcs_luastx = "$Id: lua.stx,v 2.3 1994/04/19 19:06:15 celes Exp celes $"; 3char *rcs_luastx = "$Id: lua.stx,v 2.4 1994/04/20 16:22:21 celes Exp celes $";
4 4
5#include <stdio.h> 5#include <stdio.h>
6#include <stdlib.h> 6#include <stdlib.h>
@@ -16,17 +16,17 @@ char *rcs_luastx = "$Id: lua.stx,v 2.3 1994/04/19 19:06:15 celes Exp celes $";
16 16
17#define LISTING 0 17#define LISTING 0
18 18
19#ifndef GAPCODE 19#ifndef CODE_BLOCK
20#define GAPCODE 50 20#define CODE_BLOCK 256
21#endif 21#endif
22static Word maxcode; 22static Long maxcode;
23static Word maxmain; 23static Long maxmain;
24static Word maxcurr ; 24static Long maxcurr ;
25static Byte *code = NULL; 25static Byte *code = NULL;
26static Byte *initcode; 26static Byte *initcode;
27static Byte *basepc; 27static Byte *basepc;
28static Word maincode; 28static Long maincode;
29static Word pc; 29static Long pc;
30 30
31#define MAXVAR 32 31#define MAXVAR 32
32static long varbuffer[MAXVAR]; /* variables in an assignment list; 32static long varbuffer[MAXVAR]; /* variables in an assignment list;
@@ -48,7 +48,7 @@ static void code_byte (Byte c)
48{ 48{
49 if (pc>maxcurr-2) /* 1 byte free to code HALT of main code */ 49 if (pc>maxcurr-2) /* 1 byte free to code HALT of main code */
50 { 50 {
51 maxcurr += GAPCODE; 51 maxcurr *= 2;
52 basepc = (Byte *)realloc(basepc, maxcurr*sizeof(Byte)); 52 basepc = (Byte *)realloc(basepc, maxcurr*sizeof(Byte));
53 if (basepc == NULL) 53 if (basepc == NULL)
54 { 54 {
@@ -155,7 +155,8 @@ static void incr_nvarbuffer (void)
155} 155}
156 156
157static void code_number (float f) 157static void code_number (float f)
158{ Word i = (Word)f; 158{
159 Word i = (Word)f;
159 if (f == (float)i) /* f has an (short) integer value */ 160 if (f == (float)i) /* f has an (short) integer value */
160 { 161 {
161 if (i <= 2) code_byte(PUSH0 + i); 162 if (i <= 2) code_byte(PUSH0 + i);
@@ -184,10 +185,10 @@ static void code_number (float f)
184%union 185%union
185{ 186{
186 int vInt; 187 int vInt;
187 long vLong;
188 float vFloat; 188 float vFloat;
189 char *pChar; 189 char *pChar;
190 Word vWord; 190 Word vWord;
191 Long vLong;
191 Byte *pByte; 192 Byte *pByte;
192} 193}
193 194
@@ -203,7 +204,7 @@ static void code_number (float f)
203%token <pChar> NAME 204%token <pChar> NAME
204%token <vInt> DEBUG 205%token <vInt> DEBUG
205 206
206%type <vWord> PrepJump 207%type <vLong> PrepJump
207%type <vInt> expr, exprlist, exprlist1, varlist1, typeconstructor 208%type <vInt> expr, exprlist, exprlist1, varlist1, typeconstructor
208%type <vInt> fieldlist, localdeclist 209%type <vInt> fieldlist, localdeclist
209%type <vInt> ffieldlist, ffieldlist1 210%type <vInt> ffieldlist, ffieldlist1
@@ -240,13 +241,13 @@ function : FUNCTION NAME
240 { 241 {
241 if (code == NULL) /* first function */ 242 if (code == NULL) /* first function */
242 { 243 {
243 code = (Byte *) calloc(GAPCODE, sizeof(Byte)); 244 code = (Byte *) calloc(CODE_BLOCK, sizeof(Byte));
244 if (code == NULL) 245 if (code == NULL)
245 { 246 {
246 lua_error("not enough memory"); 247 lua_error("not enough memory");
247 err = 1; 248 err = 1;
248 } 249 }
249 maxcode = GAPCODE; 250 maxcode = CODE_BLOCK;
250 } 251 }
251 pc=0; basepc=code; maxcurr=maxcode; 252 pc=0; basepc=code; maxcurr=maxcode;
252 nlocalvar=0; 253 nlocalvar=0;
@@ -301,7 +302,7 @@ sc : /* empty */ | ';' ;
301stat1 : IF expr1 THEN PrepJump block PrepJump elsepart END 302stat1 : IF expr1 THEN PrepJump block PrepJump elsepart END
302 { 303 {
303 { 304 {
304 Word elseinit = $6+sizeof(Word)+1; 305 Long elseinit = $6+sizeof(Word)+1;
305 if (pc - elseinit == 0) /* no else */ 306 if (pc - elseinit == 0) /* no else */
306 { 307 {
307 pc -= sizeof(Word)+1; 308 pc -= sizeof(Word)+1;
@@ -317,21 +318,21 @@ stat1 : IF expr1 THEN PrepJump block PrepJump elsepart END
317 } 318 }
318 } 319 }
319 320
320 | WHILE {$<vWord>$=pc;} expr1 DO PrepJump block PrepJump END 321 | WHILE {$<vLong>$=pc;} expr1 DO PrepJump block PrepJump END
321 322
322 { 323 {
323 basepc[$5] = IFFJMP; 324 basepc[$5] = IFFJMP;
324 code_word_at(basepc+$5+1, pc - ($5 + sizeof(Word)+1)); 325 code_word_at(basepc+$5+1, pc - ($5 + sizeof(Word)+1));
325 326
326 basepc[$7] = UPJMP; 327 basepc[$7] = UPJMP;
327 code_word_at(basepc+$7+1, pc - ($<vWord>2)); 328 code_word_at(basepc+$7+1, pc - ($<vLong>2));
328 } 329 }
329 330
330 | REPEAT {$<vWord>$=pc;} block UNTIL expr1 PrepJump 331 | REPEAT {$<vLong>$=pc;} block UNTIL expr1 PrepJump
331 332
332 { 333 {
333 basepc[$6] = IFFUPJMP; 334 basepc[$6] = IFFUPJMP;
334 code_word_at(basepc+$6+1, pc - ($<vWord>2)); 335 code_word_at(basepc+$6+1, pc - ($<vLong>2));
335 } 336 }
336 337
337 338
@@ -357,7 +358,7 @@ elsepart : /* empty */
357 | ELSEIF expr1 THEN PrepJump block PrepJump elsepart 358 | ELSEIF expr1 THEN PrepJump block PrepJump elsepart
358 { 359 {
359 { 360 {
360 Word elseinit = $6+sizeof(Word)+1; 361 Long elseinit = $6+sizeof(Word)+1;
361 if (pc - elseinit == 0) /* no else */ 362 if (pc - elseinit == 0) /* no else */
362 { 363 {
363 pc -= sizeof(Word)+1; 364 pc -= sizeof(Word)+1;
@@ -459,13 +460,13 @@ expr : '(' expr ')' { $$ = $2; }
459typeconstructor: '@' 460typeconstructor: '@'
460 { 461 {
461 code_byte(PUSHBYTE); 462 code_byte(PUSHBYTE);
462 $<vWord>$ = pc; code_byte(0); 463 $<vLong>$ = pc; code_byte(0);
463 incr_ntemp(); 464 incr_ntemp();
464 code_byte(CREATEARRAY); 465 code_byte(CREATEARRAY);
465 } 466 }
466 objectname fieldlist 467 objectname fieldlist
467 { 468 {
468 basepc[$<vWord>2] = $4; 469 basepc[$<vLong>2] = $4;
469 if ($3 < 0) /* there is no function to be called */ 470 if ($3 < 0) /* there is no function to be called */
470 { 471 {
471 $$ = 1; 472 $$ = 1;
@@ -725,9 +726,9 @@ int yywrap (void)
725*/ 726*/
726int lua_parse (void) 727int lua_parse (void)
727{ 728{
728 Byte *init = initcode = (Byte *) calloc(GAPCODE, sizeof(Byte)); 729 Byte *init = initcode = (Byte *) calloc(CODE_BLOCK, sizeof(Byte));
729 maincode = 0; 730 maincode = 0;
730 maxmain = GAPCODE; 731 maxmain = CODE_BLOCK;
731 if (init == NULL) 732 if (init == NULL)
732 { 733 {
733 lua_error("not enough memory"); 734 lua_error("not enough memory");
diff --git a/opcode.c b/opcode.c
index 261baa5d..2309bed1 100644
--- a/opcode.c
+++ b/opcode.c
@@ -3,7 +3,7 @@
3** TecCGraf - PUC-Rio 3** TecCGraf - PUC-Rio
4*/ 4*/
5 5
6char *rcs_opcode="$Id: opcode.c,v 1.4 1994/04/13 21:37:20 celes Exp celes $"; 6char *rcs_opcode="$Id: opcode.c,v 2.1 1994/04/20 22:07:57 celes Exp celes $";
7 7
8#include <stdio.h> 8#include <stdio.h>
9#include <stdlib.h> 9#include <stdlib.h>
@@ -23,43 +23,71 @@ char *rcs_opcode="$Id: opcode.c,v 1.4 1994/04/13 21:37:20 celes Exp celes $";
23#define tonumber(o) ((tag(o) != T_NUMBER) && (lua_tonumber(o) != 0)) 23#define tonumber(o) ((tag(o) != T_NUMBER) && (lua_tonumber(o) != 0))
24#define tostring(o) ((tag(o) != T_STRING) && (lua_tostring(o) != 0)) 24#define tostring(o) ((tag(o) != T_STRING) && (lua_tostring(o) != 0))
25 25
26#ifndef MAXSTACK 26
27#define MAXSTACK 256 27#define STACK_BUFFER (STACKGAP+128)
28#endif 28
29static Object stack[MAXSTACK] = {{T_MARK, {NULL}}}; 29static Word maxstack;
30static Object *top=stack+1, *base=stack+1; 30static Object *stack=NULL;
31static Object *top, *base;
31 32
32 33
33/* 34/*
34** Concatenate two given string, creating a mark space at the beginning. 35** Init stack
35** Return the new string pointer.
36*/ 36*/
37static char *lua_strconc (char *l, char *r) 37static int lua_initstack (void)
38{ 38{
39 char *s = calloc (strlen(l)+strlen(r)+2, sizeof(char)); 39 maxstack = STACK_BUFFER;
40 if (s == NULL) 40 stack = (Object *)calloc(maxstack, sizeof(Object));
41 if (stack == NULL)
41 { 42 {
42 lua_error ("not enough memory"); 43 lua_error("stack - not enough memory");
43 return NULL; 44 return 1;
44 } 45 }
45 *s++ = 0; /* create mark space */ 46 tag(stack) = T_MARK;
46 return strcat(strcpy(s,l),r); 47 top = base = stack+1;
48 return 0;
47} 49}
48 50
51
49/* 52/*
50** Duplicate a string, creating a mark space at the beginning. 53** Check stack overflow and, if necessary, realloc vector
54*/
55static int lua_checkstack (Word n)
56{
57 if (stack == NULL)
58 return lua_initstack();
59 if (n > maxstack)
60 {
61 Word t = top-stack;
62 Word b = base-stack;
63 maxstack *= 2;
64 stack = (Object *)realloc(stack, maxstack*sizeof(Object));
65 if (stack == NULL)
66 {
67 lua_error("stack - not enough memory");
68 return 1;
69 }
70 top = stack + t;
71 base = stack + b;
72 }
73 return 0;
74}
75
76
77/*
78** Concatenate two given string, creating a mark space at the beginning.
51** Return the new string pointer. 79** Return the new string pointer.
52*/ 80*/
53char *lua_strdup (char *l) 81static char *lua_strconc (char *l, char *r)
54{ 82{
55 char *s = calloc (strlen(l)+2, sizeof(char)); 83 static char buffer[1024];
56 if (s == NULL) 84 int n = strlen(l)+strlen(r)+1;
85 if (n > 1024)
57 { 86 {
58 lua_error ("not enough memory"); 87 lua_error ("string too large");
59 return NULL; 88 return NULL;
60 } 89 }
61 *s++ = 0; /* create mark space */ 90 return strcat(strcpy(buffer,l),r);
62 return strcpy(s,l);
63} 91}
64 92
65/* 93/*
@@ -127,7 +155,7 @@ static int lua_tostring (Object *obj)
127 sprintf (s, "%d", (int) nvalue(obj)); 155 sprintf (s, "%d", (int) nvalue(obj));
128 else 156 else
129 sprintf (s, "%g", nvalue(obj)); 157 sprintf (s, "%g", nvalue(obj));
130 svalue(obj) = lua_createstring(lua_strdup(s)); 158 svalue(obj) = lua_createstring(s);
131 if (svalue(obj) == NULL) 159 if (svalue(obj) == NULL)
132 return 1; 160 return 1;
133 tag(obj) = T_STRING; 161 tag(obj) = T_STRING;
@@ -140,7 +168,12 @@ static int lua_tostring (Object *obj)
140*/ 168*/
141int lua_execute (Byte *pc) 169int lua_execute (Byte *pc)
142{ 170{
143 Object *oldbase = base; 171 Word oldbase;
172
173 if (stack == NULL)
174 lua_initstack();
175
176 oldbase = base-stack;
144 base = top; 177 base = top;
145 while (1) 178 while (1)
146 { 179 {
@@ -516,11 +549,8 @@ int lua_execute (Byte *pc)
516 nvalue(b) = (base-stack); /* store base value */ 549 nvalue(b) = (base-stack); /* store base value */
517 base = b+1; 550 base = b+1;
518 pc = newpc; 551 pc = newpc;
519 if (MAXSTACK-(base-stack) < STACKGAP) 552 if (lua_checkstack(STACKGAP+(base-stack)))
520 {
521 lua_error ("stack overflow");
522 return 1; 553 return 1;
523 }
524 } 554 }
525 else if (tag(b-1) == T_CFUNCTION) 555 else if (tag(b-1) == T_CFUNCTION)
526 { 556 {
@@ -569,7 +599,7 @@ int lua_execute (Byte *pc)
569 break; 599 break;
570 600
571 case HALT: 601 case HALT:
572 base = oldbase; 602 base = stack+oldbase;
573 return 0; /* success */ 603 return 0; /* success */
574 604
575 case SETFUNCTION: 605 case SETFUNCTION:
@@ -726,7 +756,7 @@ Object *lua_getfield (Object *object, char *field)
726 { 756 {
727 Object ref; 757 Object ref;
728 tag(&ref) = T_STRING; 758 tag(&ref) = T_STRING;
729 svalue(&ref) = lua_createstring(lua_strdup(field)); 759 svalue(&ref) = lua_createstring(field);
730 return (lua_hashdefine(avalue(object), &ref)); 760 return (lua_hashdefine(avalue(object), &ref));
731 } 761 }
732} 762}
@@ -774,12 +804,9 @@ Object *lua_pop (void)
774*/ 804*/
775int lua_pushnil (void) 805int lua_pushnil (void)
776{ 806{
777 if ((top-stack) >= MAXSTACK-1) 807 if (lua_checkstack(top-stack+1) == 1)
778 {
779 lua_error ("stack overflow");
780 return 1; 808 return 1;
781 } 809 tag(top++) = T_NIL;
782 tag(top) = T_NIL;
783 return 0; 810 return 0;
784} 811}
785 812
@@ -788,11 +815,8 @@ int lua_pushnil (void)
788*/ 815*/
789int lua_pushnumber (real n) 816int lua_pushnumber (real n)
790{ 817{
791 if ((top-stack) >= MAXSTACK-1) 818 if (lua_checkstack(top-stack+1) == 1)
792 {
793 lua_error ("stack overflow");
794 return 1; 819 return 1;
795 }
796 tag(top) = T_NUMBER; nvalue(top++) = n; 820 tag(top) = T_NUMBER; nvalue(top++) = n;
797 return 0; 821 return 0;
798} 822}
@@ -802,13 +826,10 @@ int lua_pushnumber (real n)
802*/ 826*/
803int lua_pushstring (char *s) 827int lua_pushstring (char *s)
804{ 828{
805 if ((top-stack) >= MAXSTACK-1) 829 if (lua_checkstack(top-stack+1) == 1)
806 {
807 lua_error ("stack overflow");
808 return 1; 830 return 1;
809 }
810 tag(top) = T_STRING; 831 tag(top) = T_STRING;
811 svalue(top++) = lua_createstring(lua_strdup(s)); 832 svalue(top++) = lua_createstring(s);
812 return 0; 833 return 0;
813} 834}
814 835
@@ -817,11 +838,8 @@ int lua_pushstring (char *s)
817*/ 838*/
818int lua_pushcfunction (lua_CFunction fn) 839int lua_pushcfunction (lua_CFunction fn)
819{ 840{
820 if ((top-stack) >= MAXSTACK-1) 841 if (lua_checkstack(top-stack+1) == 1)
821 {
822 lua_error ("stack overflow");
823 return 1; 842 return 1;
824 }
825 tag(top) = T_CFUNCTION; fvalue(top++) = fn; 843 tag(top) = T_CFUNCTION; fvalue(top++) = fn;
826 return 0; 844 return 0;
827} 845}
@@ -831,11 +849,8 @@ int lua_pushcfunction (lua_CFunction fn)
831*/ 849*/
832int lua_pushuserdata (void *u) 850int lua_pushuserdata (void *u)
833{ 851{
834 if ((top-stack) >= MAXSTACK-1) 852 if (lua_checkstack(top-stack+1) == 1)
835 {
836 lua_error ("stack overflow");
837 return 1; 853 return 1;
838 }
839 tag(top) = T_USERDATA; uvalue(top++) = u; 854 tag(top) = T_USERDATA; uvalue(top++) = u;
840 return 0; 855 return 0;
841} 856}
@@ -845,11 +860,8 @@ int lua_pushuserdata (void *u)
845*/ 860*/
846int lua_pushobject (Object *o) 861int lua_pushobject (Object *o)
847{ 862{
848 if ((top-stack) >= MAXSTACK-1) 863 if (lua_checkstack(top-stack+1) == 1)
849 {
850 lua_error ("stack overflow");
851 return 1; 864 return 1;
852 }
853 *top++ = *o; 865 *top++ = *o;
854 return 0; 866 return 0;
855} 867}
@@ -878,7 +890,7 @@ int lua_storefield (lua_Object object, char *field)
878 { 890 {
879 Object ref, *h; 891 Object ref, *h;
880 tag(&ref) = T_STRING; 892 tag(&ref) = T_STRING;
881 svalue(&ref) = lua_createstring(lua_strdup(field)); 893 svalue(&ref) = lua_createstring(field);
882 h = lua_hashdefine(avalue(object), &ref); 894 h = lua_hashdefine(avalue(object), &ref);
883 if (h == NULL) return 1; 895 if (h == NULL) return 1;
884 if (tag(top-1) == T_MARK) return 1; 896 if (tag(top-1) == T_MARK) return 1;
@@ -963,6 +975,9 @@ int lua_isuserdata (Object *object)
963void lua_type (void) 975void lua_type (void)
964{ 976{
965 Object *o = lua_getparam(1); 977 Object *o = lua_getparam(1);
978
979 if (lua_constant == NULL)
980 lua_initconstant();
966 lua_pushstring (lua_constant[tag(o)]); 981 lua_pushstring (lua_constant[tag(o)]);
967} 982}
968 983
@@ -981,7 +996,7 @@ void lua_obj2number (void)
981void lua_print (void) 996void lua_print (void)
982{ 997{
983 int i=1; 998 int i=1;
984 void *obj; 999 Object *obj;
985 while ((obj=lua_getparam (i++)) != NULL) 1000 while ((obj=lua_getparam (i++)) != NULL)
986 { 1001 {
987 if (lua_isnumber(obj)) printf("%g\n",lua_getnumber (obj)); 1002 if (lua_isnumber(obj)) printf("%g\n",lua_getnumber (obj));
diff --git a/opcode.h b/opcode.h
index 38202f6e..853efd13 100644
--- a/opcode.h
+++ b/opcode.h
@@ -1,6 +1,6 @@
1/* 1/*
2** TeCGraf - PUC-Rio 2** TeCGraf - PUC-Rio
3** $Id: opcode.h,v 1.4 1994/04/13 21:37:20 celes Exp celes $ 3** $Id: opcode.h,v 2.1 1994/04/20 22:07:57 celes Exp celes $
4*/ 4*/
5 5
6#ifndef opcode_h 6#ifndef opcode_h
@@ -20,6 +20,8 @@ typedef unsigned char Byte;
20 20
21typedef unsigned short Word; 21typedef unsigned short Word;
22 22
23typedef signed long Long;
24
23typedef union 25typedef union
24{ 26{
25 struct {char c1; char c2;} m; 27 struct {char c1; char c2;} m;
@@ -116,7 +118,6 @@ typedef struct Object
116 118
117typedef struct 119typedef struct
118{ 120{
119 char *name;
120 Object object; 121 Object object;
121} Symbol; 122} Symbol;
122 123
@@ -130,7 +131,6 @@ typedef struct
130#define uvalue(o) ((o)->value.u) 131#define uvalue(o) ((o)->value.u)
131 132
132/* Macros to access symbol table */ 133/* Macros to access symbol table */
133#define s_name(i) (lua_table[i].name)
134#define s_object(i) (lua_table[i].object) 134#define s_object(i) (lua_table[i].object)
135#define s_tag(i) (tag(&s_object(i))) 135#define s_tag(i) (tag(&s_object(i)))
136#define s_nvalue(i) (nvalue(&s_object(i))) 136#define s_nvalue(i) (nvalue(&s_object(i)))
diff --git a/table.c b/table.c
index 5d2f1b28..2fbcdc07 100644
--- a/table.c
+++ b/table.c
@@ -3,7 +3,7 @@
3** Module to control static tables 3** Module to control static tables
4*/ 4*/
5 5
6char *rcs_table="$Id: table.c,v 1.5 1994/04/13 22:10:21 celes Exp celes $"; 6char *rcs_table="$Id: table.c,v 2.1 1994/04/20 22:07:57 celes Exp celes $";
7 7
8#include <stdlib.h> 8#include <stdlib.h>
9#include <string.h> 9#include <string.h>
@@ -11,6 +11,7 @@ char *rcs_table="$Id: table.c,v 1.5 1994/04/13 22:10:21 celes Exp celes $";
11#include "mm.h" 11#include "mm.h"
12 12
13#include "opcode.h" 13#include "opcode.h"
14#include "tree.h"
14#include "hash.h" 15#include "hash.h"
15#include "inout.h" 16#include "inout.h"
16#include "table.h" 17#include "table.h"
@@ -18,144 +19,159 @@ char *rcs_table="$Id: table.c,v 1.5 1994/04/13 22:10:21 celes Exp celes $";
18 19
19#define streq(s1,s2) (s1[0]==s2[0]&&strcmp(s1+1,s2+1)==0) 20#define streq(s1,s2) (s1[0]==s2[0]&&strcmp(s1+1,s2+1)==0)
20 21
21#ifndef MAXSYMBOL 22#define BUFFER_BLOCK 256
22#define MAXSYMBOL 512 23
23#endif 24Symbol *lua_table;
24static Symbol tablebuffer[MAXSYMBOL] = { 25static Word lua_ntable = 0;
25 {"type",{T_CFUNCTION,{lua_type}}}, 26static Word lua_maxsymbol = 0;
26 {"tonumber",{T_CFUNCTION,{lua_obj2number}}}, 27
27 {"next",{T_CFUNCTION,{lua_next}}}, 28char **lua_constant;
28 {"nextvar",{T_CFUNCTION,{lua_nextvar}}}, 29static Word lua_nconstant = 0;
29 {"print",{T_CFUNCTION,{lua_print}}}, 30static Word lua_maxconstant = 0;
30 {"dofile",{T_CFUNCTION,{lua_internaldofile}}}, 31
31 {"dostring",{T_CFUNCTION,{lua_internaldostring}}} 32
32 };
33Symbol *lua_table=tablebuffer;
34Word lua_ntable=7;
35
36struct List
37{
38 Symbol *s;
39 struct List *next;
40};
41
42static struct List o6={ tablebuffer+6, 0};
43static struct List o5={ tablebuffer+5, &o6 };
44static struct List o4={ tablebuffer+4, &o5 };
45static struct List o3={ tablebuffer+3, &o4 };
46static struct List o2={ tablebuffer+2, &o3 };
47static struct List o1={ tablebuffer+1, &o2 };
48static struct List o0={ tablebuffer+0, &o1 };
49static struct List *searchlist=&o0;
50
51#ifndef MAXCONSTANT
52#define MAXCONSTANT 256
53#endif
54/* pre-defined constants need garbage collection extra byte */
55static char tm[] = " mark";
56static char ti[] = " nil";
57static char tn[] = " number";
58static char ts[] = " string";
59static char tt[] = " table";
60static char tf[] = " function";
61static char tc[] = " cfunction";
62static char tu[] = " userdata";
63static char *constantbuffer[MAXCONSTANT] = {tm+1, ti+1,
64 tn+1, ts+1,
65 tt+1, tf+1,
66 tc+1, tu+1
67 };
68char **lua_constant = constantbuffer;
69Word lua_nconstant=T_USERDATA+1;
70
71#ifndef MAXSTRING
72#define MAXSTRING 512
73#endif
74static char *stringbuffer[MAXSTRING];
75char **lua_string = stringbuffer;
76Word lua_nstring=0;
77 33
78#define MAXFILE 20 34#define MAXFILE 20
79char *lua_file[MAXFILE]; 35char *lua_file[MAXFILE];
80int lua_nfile; 36int lua_nfile;
81 37
38/* Variables to controll garbage collection */
39#define GARBAGE_BLOCK 256
40Word lua_block=GARBAGE_BLOCK; /* when garbage collector will be called */
41Word lua_nentity; /* counter of new entities (strings and arrays) */
82 42
83#define markstring(s) (*((s)-1))
84 43
44/*
45** Initialise symbol table with internal functions
46*/
47static void lua_initsymbol (void)
48{
49 int n;
50 lua_maxsymbol = BUFFER_BLOCK;
51 lua_table = (Symbol *) calloc(lua_maxsymbol, sizeof(Symbol));
52 if (lua_table == NULL)
53 {
54 lua_error ("symbol table: not enough memory");
55 return;
56 }
57 n = lua_findsymbol("type");
58 s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_type;
59 n = lua_findsymbol("tonumber");
60 s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_obj2number;
61 n = lua_findsymbol("next");
62 s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_next;
63 n = lua_findsymbol("nextvar");
64 s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_nextvar;
65 n = lua_findsymbol("print");
66 s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_print;
67 n = lua_findsymbol("dofile");
68 s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_internaldofile;
69 n = lua_findsymbol("dostring");
70 s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_internaldostring;
71}
85 72
86/* Variables to controll garbage collection */
87Word lua_block=10; /* to check when garbage collector will be called */
88Word lua_nentity; /* counter of new entities (strings and arrays) */
89 73
74/*
75** Initialise constant table with pre-defined constants
76*/
77void lua_initconstant (void)
78{
79 lua_maxconstant = BUFFER_BLOCK;
80 lua_constant = (char **) calloc(lua_maxconstant, sizeof(char *));
81 if (lua_constant == NULL)
82 {
83 lua_error ("constant table: not enough memory");
84 return;
85 }
86 lua_findconstant("mark");
87 lua_findconstant("nil");
88 lua_findconstant("number");
89 lua_findconstant("string");
90 lua_findconstant("table");
91 lua_findconstant("function");
92 lua_findconstant("cfunction");
93 lua_findconstant("userdata");
94}
90 95
91/* 96/*
92** Given a name, search it at symbol table and return its index. If not 97** Given a name, search it at symbol table and return its index. If not
93** found, allocate at end of table, checking oveflow and return its index. 98** found, allocate it.
94** On error, return -1. 99** On error, return -1.
95*/ 100*/
96int lua_findsymbol (char *s) 101int lua_findsymbol (char *s)
97{ 102{
98 struct List *l, *p; 103 char *n;
99 for (p=NULL, l=searchlist; l!=NULL; p=l, l=l->next) 104 if (lua_table == NULL)
100 if (streq(s,l->s->name)) 105 lua_initsymbol();
101 { 106 n = lua_varcreate(s);
102 if (p!=NULL) 107 if (n == NULL)
103 {
104 p->next = l->next;
105 l->next = searchlist;
106 searchlist = l;
107 }
108 return (l->s-lua_table);
109 }
110
111 if (lua_ntable >= MAXSYMBOL-1)
112 { 108 {
113 lua_error ("symbol table overflow"); 109 lua_error ("create symbol: not enough memory");
114 return -1; 110 return -1;
115 } 111 }
116 s_name(lua_ntable) = strdup(s); 112 if (indexstring(n) == UNMARKED_STRING)
117 if (s_name(lua_ntable) == NULL)
118 { 113 {
119 lua_error ("not enough memory"); 114 if (lua_ntable == lua_maxsymbol)
120 return -1; 115 {
116 lua_maxsymbol *= 2;
117 if (lua_maxsymbol > MAX_WORD)
118 {
119 lua_error("symbol table overflow");
120 return -1;
121 }
122 lua_table = (Symbol *)realloc(lua_table, lua_maxsymbol*sizeof(Symbol));
123 if (lua_table == NULL)
124 {
125 lua_error ("symbol table: not enough memory");
126 return -1;
127 }
128 }
129 indexstring(n) = lua_ntable;
130 s_tag(lua_ntable) = T_NIL;
131 lua_ntable++;
121 } 132 }
122 s_tag(lua_ntable) = T_NIL; 133 return indexstring(n);
123 p = malloc(sizeof(*p));
124 p->s = lua_table+lua_ntable;
125 p->next = searchlist;
126 searchlist = p;
127
128 return lua_ntable++;
129} 134}
130 135
136
131/* 137/*
132** Given a constant string, search it at constant table and return its index. 138** Given a name, search it at constant table and return its index. If not
133** If not found, allocate at end of the table, checking oveflow and return 139** found, allocate it.
134** its index. 140** On error, return -1.
135**
136** For each allocation, the function allocate a extra char to be used to
137** mark used string (it's necessary to deal with constant and string
138** uniformily). The function store at the table the second position allocated,
139** that represents the beginning of the real string. On error, return -1.
140**
141*/ 141*/
142int lua_findconstant (char *s) 142int lua_findconstant (char *s)
143{ 143{
144 int i; 144 char *n;
145 for (i=0; i<lua_nconstant; i++) 145 if (lua_constant == NULL)
146 if (streq(s,lua_constant[i])) 146 lua_initconstant();
147 return i; 147 n = lua_constcreate(s);
148 if (lua_nconstant >= MAXCONSTANT-1) 148 if (n == NULL)
149 { 149 {
150 lua_error ("lua: constant string table overflow"); 150 lua_error ("create constant: not enough memory");
151 return -1; 151 return -1;
152 } 152 }
153 if (indexstring(n) == UNMARKED_STRING)
153 { 154 {
154 char *c = calloc(strlen(s)+2,sizeof(char)); 155 if (lua_nconstant == lua_maxconstant)
155 c++; /* create mark space */ 156 {
156 lua_constant[lua_nconstant++] = strcpy(c,s); 157 lua_maxconstant *= 2;
158 if (lua_maxconstant > MAX_WORD)
159 {
160 lua_error("constant table overflow");
161 return -1;
162 }
163 lua_constant = (char**)realloc(lua_constant,lua_maxconstant*sizeof(char*));
164 if (lua_constant == NULL)
165 {
166 lua_error ("constant table: not enough memory");
167 return -1;
168 }
169 }
170 indexstring(n) = lua_nconstant;
171 lua_constant[lua_nconstant] = n;
172 lua_nconstant++;
157 } 173 }
158 return (lua_nconstant-1); 174 return indexstring(n);
159} 175}
160 176
161 177
@@ -175,10 +191,10 @@ void lua_travsymbol (void (*fn)(Object *))
175*/ 191*/
176void lua_markobject (Object *o) 192void lua_markobject (Object *o)
177{ 193{
178 if (tag(o) == T_STRING) 194 if (tag(o) == T_STRING && indexstring(svalue(o)) == UNMARKED_STRING)
179 markstring (svalue(o)) = 1; 195 indexstring(svalue(o)) = MARKED_STRING;
180 else if (tag(o) == T_ARRAY) 196 else if (tag(o) == T_ARRAY)
181 lua_hashmark (avalue(o)); 197 lua_hashmark (avalue(o));
182} 198}
183 199
184 200
@@ -194,63 +210,27 @@ void lua_pack (void)
194 /* mark symbol table strings */ 210 /* mark symbol table strings */
195 lua_travsymbol(lua_markobject); 211 lua_travsymbol(lua_markobject);
196 212
197 lua_stringcollector(); 213 lua_strcollector();
198 lua_hashcollector(); 214 lua_hashcollector();
199 215
200 lua_nentity = 0; /* reset counter */ 216 lua_nentity = 0; /* reset counter */
201} 217}
202 218
203/*
204** Garbage collection to atrings.
205** Delete all unmarked strings
206*/
207void lua_stringcollector (void)
208{
209 int i, j;
210 for (i=j=0; i<lua_nstring; i++)
211 if (markstring(lua_string[i]) == 1)
212 {
213 lua_string[j++] = lua_string[i];
214 markstring(lua_string[i]) = 0;
215 }
216 else
217 {
218 free (lua_string[i]-1);
219 }
220 lua_nstring = j;
221}
222 219
223/* 220/*
224** Allocate a new string at string table. The given string is already 221** If the string isn't allocated, allocate a new string at string tree.
225** allocated with mark space and the function puts it at the end of the
226** table, checking overflow, and returns its own pointer, or NULL on error.
227*/ 222*/
228char *lua_createstring (char *s) 223char *lua_createstring (char *s)
229{ 224{
230 int i;
231 if (s == NULL) return NULL; 225 if (s == NULL) return NULL;
232 226
233 for (i=0; i<lua_nstring; i++) 227 if (lua_nentity == lua_block)
234 if (streq(s,lua_string[i]))
235 {
236 free(s-1);
237 return lua_string[i];
238 }
239
240 if (lua_nentity == lua_block || lua_nstring >= MAXSTRING-1)
241 {
242 lua_pack (); 228 lua_pack ();
243 if (lua_nstring >= MAXSTRING-1)
244 {
245 lua_error ("string table overflow");
246 return NULL;
247 }
248 }
249 lua_string[lua_nstring++] = s;
250 lua_nentity++; 229 lua_nentity++;
251 return s; 230 return lua_strcreate(s);
252} 231}
253 232
233
254/* 234/*
255** Add a file name at file table, checking overflow. This function also set 235** Add a file name at file table, checking overflow. This function also set
256** the external variable "lua_filename" with the function filename set. 236** the external variable "lua_filename" with the function filename set.
@@ -293,7 +273,7 @@ char *lua_filename (void)
293*/ 273*/
294void lua_nextvar (void) 274void lua_nextvar (void)
295{ 275{
296 int index; 276 char *varname, *next;
297 Object *o = lua_getparam (1); 277 Object *o = lua_getparam (1);
298 if (o == NULL) 278 if (o == NULL)
299 { lua_error ("too few arguments to function `nextvar'"); return; } 279 { lua_error ("too few arguments to function `nextvar'"); return; }
@@ -301,7 +281,7 @@ void lua_nextvar (void)
301 { lua_error ("too many arguments to function `nextvar'"); return; } 281 { lua_error ("too many arguments to function `nextvar'"); return; }
302 if (tag(o) == T_NIL) 282 if (tag(o) == T_NIL)
303 { 283 {
304 index = 0; 284 varname = 0;
305 } 285 }
306 else if (tag(o) != T_STRING) 286 else if (tag(o) != T_STRING)
307 { 287 {
@@ -310,28 +290,20 @@ void lua_nextvar (void)
310 } 290 }
311 else 291 else
312 { 292 {
313 for (index=0; index<lua_ntable; index++) 293 varname = svalue(o);
314 if (streq(s_name(index),svalue(o))) break; 294 }
315 if (index == lua_ntable) 295 next = lua_varnext(varname);
316 { 296 if (next == NULL)
317 lua_error ("name not found in function `nextvar'"); 297 {
318 return; 298 lua_pushnil();
319 } 299 lua_pushnil();
320 index++;
321 while (index < lua_ntable && tag(&s_object(index)) == T_NIL) index++;
322
323 if (index == lua_ntable)
324 {
325 lua_pushnil();
326 lua_pushnil();
327 return;
328 }
329 } 300 }
301 else
330 { 302 {
331 Object name; 303 Object name;
332 tag(&name) = T_STRING; 304 tag(&name) = T_STRING;
333 svalue(&name) = lua_createstring(lua_strdup(s_name(index))); 305 svalue(&name) = next;
334 if (lua_pushobject (&name)) return; 306 if (lua_pushobject (&name)) return;
335 if (lua_pushobject (&s_object(index))) return; 307 if (lua_pushobject (&s_object(indexstring(next)))) return;
336 } 308 }
337} 309}
diff --git a/table.h b/table.h
index 17be39e4..47be08c4 100644
--- a/table.h
+++ b/table.h
@@ -1,23 +1,14 @@
1/* 1/*
2** Module to control static tables 2** Module to control static tables
3** TeCGraf - PUC-Rio 3** TeCGraf - PUC-Rio
4** $Id: table.h,v 1.2 1993/12/22 21:15:16 roberto Exp celes $ 4** $Id: table.h,v 2.1 1994/04/20 22:07:57 celes Exp celes $
5*/ 5*/
6 6
7#ifndef table_h 7#ifndef table_h
8#define table_h 8#define table_h
9 9
10extern Symbol *lua_table; 10extern Symbol *lua_table;
11extern Word lua_ntable;
12
13extern char **lua_constant; 11extern char **lua_constant;
14extern Word lua_nconstant;
15
16extern char **lua_string;
17extern Word lua_nstring;
18
19extern Hash **lua_array;
20extern Word lua_narray;
21 12
22extern char *lua_file[]; 13extern char *lua_file[];
23extern int lua_nfile; 14extern int lua_nfile;
@@ -26,13 +17,12 @@ extern Word lua_block;
26extern Word lua_nentity; 17extern Word lua_nentity;
27 18
28 19
29 20void lua_initconstant (void);
30int lua_findsymbol (char *s); 21int lua_findsymbol (char *s);
31int lua_findconstant (char *s); 22int lua_findconstant (char *s);
32void lua_travsymbol (void (*fn)(Object *)); 23void lua_travsymbol (void (*fn)(Object *));
33void lua_markobject (Object *o); 24void lua_markobject (Object *o);
34void lua_pack (void); 25void lua_pack (void);
35void lua_stringcollector (void);
36char *lua_createstring (char *s); 26char *lua_createstring (char *s);
37int lua_addfile (char *fn); 27int lua_addfile (char *fn);
38int lua_delfile (void); 28int lua_delfile (void);