aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--hash.c259
-rw-r--r--hash.h35
-rw-r--r--inout.c188
-rw-r--r--inout.h24
-rw-r--r--iolib.c401
-rw-r--r--lex_yy.c923
-rw-r--r--lua.c54
-rw-r--r--lua.h54
-rw-r--r--lualib.h15
-rw-r--r--mathlib.c234
-rw-r--r--opcode.c933
-rw-r--r--opcode.h144
-rw-r--r--strlib.c131
-rw-r--r--table.c351
-rw-r--r--table.h39
-rw-r--r--y_tab.c1639
-rw-r--r--y_tab.h35
17 files changed, 5459 insertions, 0 deletions
diff --git a/hash.c b/hash.c
new file mode 100644
index 00000000..8743d52c
--- /dev/null
+++ b/hash.c
@@ -0,0 +1,259 @@
1/*
2** hash.c
3** hash manager for lua
4** Luiz Henrique de Figueiredo - 17 Aug 90
5** Modified by Waldemar Celes Filho
6** 12 May 93
7*/
8
9#include <string.h>
10#include <stdlib.h>
11
12#include "opcode.h"
13#include "hash.h"
14#include "inout.h"
15#include "table.h"
16#include "lua.h"
17
18#define streq(s1,s2) (strcmp(s1,s2)==0)
19#define strneq(s1,s2) (strcmp(s1,s2)!=0)
20
21#define new(s) ((s *)malloc(sizeof(s)))
22#define newvector(n,s) ((s *)calloc(n,sizeof(s)))
23
24#define nhash(t) ((t)->nhash)
25#define nodelist(t) ((t)->list)
26#define list(t,i) ((t)->list[i])
27#define ref_tag(n) (tag(&(n)->ref))
28#define ref_nvalue(n) (nvalue(&(n)->ref))
29#define ref_svalue(n) (svalue(&(n)->ref))
30
31static int head (Hash *t, Object *ref) /* hash function */
32{
33 if (tag(ref) == T_NUMBER) return (((int)nvalue(ref))%nhash(t));
34 else if (tag(ref) == T_STRING)
35 {
36 int h;
37 char *name = svalue(ref);
38 for (h=0; *name!=0; name++) /* interpret name as binary number */
39 {
40 h <<= 8;
41 h += (unsigned char) *name; /* avoid sign extension */
42 h %= nhash(t); /* make it a valid index */
43 }
44 return h;
45 }
46 else
47 {
48 lua_reportbug ("unexpected type to index table");
49 return -1;
50 }
51}
52
53static Node *present(Hash *t, Object *ref, int h)
54{
55 Node *n=NULL, *p;
56 if (tag(ref) == T_NUMBER)
57 {
58 for (p=NULL,n=list(t,h); n!=NULL; p=n, n=n->next)
59 if (ref_tag(n) == T_NUMBER && nvalue(ref) == ref_nvalue(n)) break;
60 }
61 else if (tag(ref) == T_STRING)
62 {
63 for (p=NULL,n=list(t,h); n!=NULL; p=n, n=n->next)
64 if (ref_tag(n) == T_STRING && streq(svalue(ref),ref_svalue(n))) break;
65 }
66 if (n==NULL) /* name not present */
67 return NULL;
68#if 0
69 if (p!=NULL) /* name present but not first */
70 {
71 p->next=n->next; /* move-to-front self-organization */
72 n->next=list(t,h);
73 list(t,h)=n;
74 }
75#endif
76 return n;
77}
78
79static void freelist (Node *n)
80{
81 while (n)
82 {
83 Node *next = n->next;
84 free (n);
85 n = next;
86 }
87}
88
89/*
90** Create a new hash. Return the hash pointer or NULL on error.
91*/
92Hash *lua_hashcreate (unsigned int nhash)
93{
94 Hash *t = new (Hash);
95 if (t == NULL)
96 {
97 lua_error ("not enough memory");
98 return NULL;
99 }
100 nhash(t) = nhash;
101 markarray(t) = 0;
102 nodelist(t) = newvector (nhash, Node*);
103 if (nodelist(t) == NULL)
104 {
105 lua_error ("not enough memory");
106 return NULL;
107 }
108 return t;
109}
110
111/*
112** Delete a hash
113*/
114void lua_hashdelete (Hash *h)
115{
116 int i;
117 for (i=0; i<nhash(h); i++)
118 freelist (list(h,i));
119 free (nodelist(h));
120 free(h);
121}
122
123/*
124** If the hash node is present, return its pointer, otherwise create a new
125** node for the given reference and also return its pointer.
126** On error, return NULL.
127*/
128Object *lua_hashdefine (Hash *t, Object *ref)
129{
130 int h;
131 Node *n;
132 h = head (t, ref);
133 if (h < 0) return NULL;
134
135 n = present(t, ref, h);
136 if (n == NULL)
137 {
138 n = new(Node);
139 if (n == NULL)
140 {
141 lua_error ("not enough memory");
142 return NULL;
143 }
144 n->ref = *ref;
145 tag(&n->val) = T_NIL;
146 n->next = list(t,h); /* link node to head of list */
147 list(t,h) = n;
148 }
149 return (&n->val);
150}
151
152/*
153** Mark a hash and check its elements
154*/
155void lua_hashmark (Hash *h)
156{
157 int i;
158
159 markarray(h) = 1;
160
161 for (i=0; i<nhash(h); i++)
162 {
163 Node *n;
164 for (n = list(h,i); n != NULL; n = n->next)
165 {
166 lua_markobject (&n->ref);
167 lua_markobject (&n->val);
168 }
169 }
170}
171
172
173/*
174** Internal function to manipulate arrays.
175** Given an array object and a reference value, return the next element
176** in the hash.
177** This function pushs the element value and its reference to the stack.
178*/
179#include "lua.h"
180static void firstnode (Hash *a, int h)
181{
182 if (h < nhash(a))
183 {
184 int i;
185 for (i=h; i<nhash(a); i++)
186 {
187 if (list(a,i) != NULL && tag(&list(a,i)->val) != T_NIL)
188 {
189 lua_pushobject (&list(a,i)->ref);
190 lua_pushobject (&list(a,i)->val);
191 return;
192 }
193 }
194 }
195 lua_pushnil();
196 lua_pushnil();
197}
198void lua_next (void)
199{
200 Hash *a;
201 Object *o = lua_getparam (1);
202 Object *r = lua_getparam (2);
203 if (o == NULL || r == NULL)
204 { lua_error ("too few arguments to function `next'"); return; }
205 if (lua_getparam (3) != NULL)
206 { lua_error ("too many arguments to function `next'"); return; }
207 if (tag(o) != T_ARRAY)
208 { lua_error ("first argument of function `next' is not a table"); return; }
209 a = avalue(o);
210 if (tag(r) == T_NIL)
211 {
212 firstnode (a, 0);
213 return;
214 }
215 else
216 {
217 int h = head (a, r);
218 if (h >= 0)
219 {
220 Node *n = list(a,h);
221 while (n)
222 {
223 if (memcmp(&n->ref,r,sizeof(Object)) == 0)
224 {
225 if (n->next == NULL)
226 {
227 firstnode (a, h+1);
228 return;
229 }
230 else if (tag(&n->next->val) != T_NIL)
231 {
232 lua_pushobject (&n->next->ref);
233 lua_pushobject (&n->next->val);
234 return;
235 }
236 else
237 {
238 Node *next = n->next->next;
239 while (next != NULL && tag(&next->val) == T_NIL) next = next->next;
240 if (next == NULL)
241 {
242 firstnode (a, h+1);
243 return;
244 }
245 else
246 {
247 lua_pushobject (&next->ref);
248 lua_pushobject (&next->val);
249 }
250 return;
251 }
252 }
253 n = n->next;
254 }
255 if (n == NULL)
256 lua_error ("error in function 'next': reference not found");
257 }
258 }
259}
diff --git a/hash.h b/hash.h
new file mode 100644
index 00000000..28c50317
--- /dev/null
+++ b/hash.h
@@ -0,0 +1,35 @@
1/*
2** hash.h
3** hash manager for lua
4** Luiz Henrique de Figueiredo - 17 Aug 90
5** Modified by Waldemar Celes Filho
6** 26 Apr 93
7*/
8
9#ifndef hash_h
10#define hash_h
11
12typedef struct node
13{
14 Object ref;
15 Object val;
16 struct node *next;
17} Node;
18
19typedef struct Hash
20{
21 char mark;
22 unsigned int nhash;
23 Node **list;
24} Hash;
25
26#define markarray(t) ((t)->mark)
27
28Hash *lua_hashcreate (unsigned int nhash);
29void lua_hashdelete (Hash *h);
30Object *lua_hashdefine (Hash *t, Object *ref);
31void lua_hashmark (Hash *h);
32
33void lua_next (void);
34
35#endif
diff --git a/inout.c b/inout.c
new file mode 100644
index 00000000..3ba32ba7
--- /dev/null
+++ b/inout.c
@@ -0,0 +1,188 @@
1/*
2** inout.c
3** Provide function to realise the input/output function and debugger
4** facilities.
5**
6** Waldemar Celes Filho
7** TeCGraf - PUC-Rio
8** 11 May 93
9*/
10
11#include <stdio.h>
12#include <string.h>
13
14#include "opcode.h"
15#include "hash.h"
16#include "inout.h"
17#include "table.h"
18
19/* Exported variables */
20int lua_linenumber;
21int lua_debug;
22int lua_debugline;
23
24/* Internal variables */
25#ifndef MAXFUNCSTACK
26#define MAXFUNCSTACK 32
27#endif
28static struct { int file; int function; } funcstack[MAXFUNCSTACK];
29static int nfuncstack=0;
30
31static FILE *fp;
32static char *st;
33static void (*usererror) (char *s);
34
35/*
36** Function to set user function to handle errors.
37*/
38void lua_errorfunction (void (*fn) (char *s))
39{
40 usererror = fn;
41}
42
43/*
44** Function to get the next character from the input file
45*/
46static int fileinput (void)
47{
48 int c = fgetc (fp);
49 return (c == EOF ? 0 : c);
50}
51
52/*
53** Function to unget the next character from to input file
54*/
55static void fileunput (int c)
56{
57 ungetc (c, fp);
58}
59
60/*
61** Function to get the next character from the input string
62*/
63static int stringinput (void)
64{
65 st++;
66 return (*(st-1));
67}
68
69/*
70** Function to unget the next character from to input string
71*/
72static void stringunput (int c)
73{
74 st--;
75}
76
77/*
78** Function to open a file to be input unit.
79** Return 0 on success or 1 on error.
80*/
81int lua_openfile (char *fn)
82{
83 lua_linenumber = 1;
84 lua_setinput (fileinput);
85 lua_setunput (fileunput);
86 fp = fopen (fn, "r");
87 if (fp == NULL) return 1;
88 if (lua_addfile (fn)) return 1;
89 return 0;
90}
91
92/*
93** Function to close an opened file
94*/
95void lua_closefile (void)
96{
97 if (fp != NULL)
98 {
99 fclose (fp);
100 fp = NULL;
101 }
102}
103
104/*
105** Function to open a string to be input unit
106*/
107int lua_openstring (char *s)
108{
109 lua_linenumber = 1;
110 lua_setinput (stringinput);
111 lua_setunput (stringunput);
112 st = s;
113 {
114 char sn[64];
115 sprintf (sn, "String: %10.10s...", s);
116 if (lua_addfile (sn)) return 1;
117 }
118 return 0;
119}
120
121/*
122** Call user function to handle error messages, if registred. Or report error
123** using standard function (fprintf).
124*/
125void lua_error (char *s)
126{
127 if (usererror != NULL) usererror (s);
128 else fprintf (stderr, "lua: %s\n", s);
129}
130
131/*
132** Called to execute SETFUNCTION opcode, this function pushs a function into
133** function stack. Return 0 on success or 1 on error.
134*/
135int lua_pushfunction (int file, int function)
136{
137 if (nfuncstack >= MAXFUNCSTACK-1)
138 {
139 lua_error ("function stack overflow");
140 return 1;
141 }
142 funcstack[nfuncstack].file = file;
143 funcstack[nfuncstack].function = function;
144 nfuncstack++;
145 return 0;
146}
147
148/*
149** Called to execute RESET opcode, this function pops a function from
150** function stack.
151*/
152void lua_popfunction (void)
153{
154 nfuncstack--;
155}
156
157/*
158** Report bug building a message and sending it to lua_error function.
159*/
160void lua_reportbug (char *s)
161{
162 char msg[1024];
163 strcpy (msg, s);
164 if (lua_debugline != 0)
165 {
166 int i;
167 if (nfuncstack > 0)
168 {
169 sprintf (strchr(msg,0),
170 "\n\tin statement begining at line %d in function \"%s\" of file \"%s\"",
171 lua_debugline, s_name(funcstack[nfuncstack-1].function),
172 lua_file[funcstack[nfuncstack-1].file]);
173 sprintf (strchr(msg,0), "\n\tactive stack\n");
174 for (i=nfuncstack-1; i>=0; i--)
175 sprintf (strchr(msg,0), "\t-> function \"%s\" of file \"%s\"\n",
176 s_name(funcstack[i].function),
177 lua_file[funcstack[i].file]);
178 }
179 else
180 {
181 sprintf (strchr(msg,0),
182 "\n\tin statement begining at line %d of file \"%s\"",
183 lua_debugline, lua_filename());
184 }
185 }
186 lua_error (msg);
187}
188
diff --git a/inout.h b/inout.h
new file mode 100644
index 00000000..5a72261c
--- /dev/null
+++ b/inout.h
@@ -0,0 +1,24 @@
1/*
2** inout.h
3**
4** Waldemar Celes Filho
5** TeCGraf - PUC-Rio
6** 11 May 93
7*/
8
9
10#ifndef inout_h
11#define inout_h
12
13extern int lua_linenumber;
14extern int lua_debug;
15extern int lua_debugline;
16
17int lua_openfile (char *fn);
18void lua_closefile (void);
19int lua_openstring (char *s);
20int lua_pushfunction (int file, int function);
21void lua_popfunction (void);
22void lua_reportbug (char *s);
23
24#endif
diff --git a/iolib.c b/iolib.c
new file mode 100644
index 00000000..174dd501
--- /dev/null
+++ b/iolib.c
@@ -0,0 +1,401 @@
1/*
2** iolib.c
3** Input/output library to LUA
4**
5** Waldemar Celes Filho
6** TeCGraf - PUC-Rio
7** 19 May 93
8*/
9
10#include <stdlib.h>
11#include <string.h>
12#include <stdio.h>
13#include <ctype.h>
14#ifdef __GNUC__
15#include <floatingpoint.h>
16#endif
17
18#include "lua.h"
19
20static FILE *in=stdin, *out=stdout;
21
22/*
23** Open a file to read.
24** LUA interface:
25** status = readfrom (filename)
26** where:
27** status = 1 -> success
28** status = 0 -> error
29*/
30static void io_readfrom (void)
31{
32 lua_Object o = lua_getparam (1);
33 if (o == NULL) /* restore standart input */
34 {
35 if (in != stdin)
36 {
37 fclose (in);
38 in = stdin;
39 }
40 lua_pushnumber (1);
41 }
42 else
43 {
44 if (!lua_isstring (o))
45 {
46 lua_error ("incorrect argument to function 'readfrom`");
47 lua_pushnumber (0);
48 }
49 else
50 {
51 FILE *fp = fopen (lua_getstring(o),"r");
52 if (fp == NULL)
53 {
54 lua_pushnumber (0);
55 }
56 else
57 {
58 if (in != stdin) fclose (in);
59 in = fp;
60 lua_pushnumber (1);
61 }
62 }
63 }
64}
65
66
67/*
68** Open a file to write.
69** LUA interface:
70** status = writeto (filename)
71** where:
72** status = 1 -> success
73** status = 0 -> error
74*/
75static void io_writeto (void)
76{
77 lua_Object o = lua_getparam (1);
78 if (o == NULL) /* restore standart output */
79 {
80 if (out != stdout)
81 {
82 fclose (out);
83 out = stdout;
84 }
85 lua_pushnumber (1);
86 }
87 else
88 {
89 if (!lua_isstring (o))
90 {
91 lua_error ("incorrect argument to function 'writeto`");
92 lua_pushnumber (0);
93 }
94 else
95 {
96 FILE *fp = fopen (lua_getstring(o),"w");
97 if (fp == NULL)
98 {
99 lua_pushnumber (0);
100 }
101 else
102 {
103 if (out != stdout) fclose (out);
104 out = fp;
105 lua_pushnumber (1);
106 }
107 }
108 }
109}
110
111
112/*
113** Read a variable. On error put nil on stack.
114** LUA interface:
115** variable = read ([format])
116**
117** O formato pode ter um dos seguintes especificadores:
118**
119** s ou S -> para string
120** f ou F, g ou G, e ou E -> para reais
121** i ou I -> para inteiros
122**
123** Estes especificadores podem vir seguidos de numero que representa
124** o numero de campos a serem lidos.
125*/
126static void io_read (void)
127{
128 lua_Object o = lua_getparam (1);
129 if (o == NULL) /* free format */
130 {
131 int c;
132 char s[256];
133 while (isspace(c=fgetc(in)))
134 ;
135 if (c == '\"')
136 {
137 if (fscanf (in, "%[^\"]\"", s) != 1)
138 {
139 lua_pushnil ();
140 return;
141 }
142 }
143 else if (c == '\'')
144 {
145 if (fscanf (in, "%[^\']\'", s) != 1)
146 {
147 lua_pushnil ();
148 return;
149 }
150 }
151 else
152 {
153 char *ptr;
154 double d;
155 ungetc (c, in);
156 if (fscanf (in, "%s", s) != 1)
157 {
158 lua_pushnil ();
159 return;
160 }
161 d = strtod (s, &ptr);
162 if (!(*ptr))
163 {
164 lua_pushnumber (d);
165 return;
166 }
167 }
168 lua_pushstring (s);
169 return;
170 }
171 else /* formatted */
172 {
173 char *e = lua_getstring(o);
174 char t;
175 int m=0;
176 while (isspace(*e)) e++;
177 t = *e++;
178 while (isdigit(*e))
179 m = m*10 + (*e++ - '0');
180
181 if (m > 0)
182 {
183 char f[80];
184 char s[256];
185 sprintf (f, "%%%ds", m);
186 fscanf (in, f, s);
187 switch (tolower(t))
188 {
189 case 'i':
190 {
191 long int l;
192 sscanf (s, "%ld", &l);
193 lua_pushnumber(l);
194 }
195 break;
196 case 'f': case 'g': case 'e':
197 {
198 float f;
199 sscanf (s, "%f", &f);
200 lua_pushnumber(f);
201 }
202 break;
203 default:
204 lua_pushstring(s);
205 break;
206 }
207 }
208 else
209 {
210 switch (tolower(t))
211 {
212 case 'i':
213 {
214 long int l;
215 fscanf (in, "%ld", &l);
216 lua_pushnumber(l);
217 }
218 break;
219 case 'f': case 'g': case 'e':
220 {
221 float f;
222 fscanf (in, "%f", &f);
223 lua_pushnumber(f);
224 }
225 break;
226 default:
227 {
228 char s[256];
229 fscanf (in, "%s", s);
230 lua_pushstring(s);
231 }
232 break;
233 }
234 }
235 }
236}
237
238
239/*
240** Write a variable. On error put 0 on stack, otherwise put 1.
241** LUA interface:
242** status = write (variable [,format])
243**
244** O formato pode ter um dos seguintes especificadores:
245**
246** s ou S -> para string
247** f ou F, g ou G, e ou E -> para reais
248** i ou I -> para inteiros
249**
250** Estes especificadores podem vir seguidos de:
251**
252** [?][m][.n]
253**
254** onde:
255** ? -> indica justificacao
256** < = esquerda
257** | = centro
258** > = direita (default)
259** m -> numero maximo de campos (se exceder estoura)
260** n -> indica precisao para
261** reais -> numero de casas decimais
262** inteiros -> numero minimo de digitos
263** string -> nao se aplica
264*/
265static char *buildformat (char *e, lua_Object o)
266{
267 static char buffer[512];
268 static char f[80];
269 char *string = &buffer[255];
270 char t, j='r';
271 int m=0, n=0, l;
272 while (isspace(*e)) e++;
273 t = *e++;
274 if (*e == '<' || *e == '|' || *e == '>') j = *e++;
275 while (isdigit(*e))
276 m = m*10 + (*e++ - '0');
277 e++; /* skip point */
278 while (isdigit(*e))
279 n = n*10 + (*e++ - '0');
280
281 sprintf(f,"%%");
282 if (j == '<' || j == '|') sprintf(strchr(f,0),"-");
283 if (m != 0) sprintf(strchr(f,0),"%d", m);
284 if (n != 0) sprintf(strchr(f,0),".%d", n);
285 sprintf(strchr(f,0), "%c", t);
286 switch (tolower(t))
287 {
288 case 'i': t = 'i';
289 sprintf (string, f, (long int)lua_getnumber(o));
290 break;
291 case 'f': case 'g': case 'e': t = 'f';
292 sprintf (string, f, (float)lua_getnumber(o));
293 break;
294 case 's': t = 's';
295 sprintf (string, f, lua_getstring(o));
296 break;
297 default: return "";
298 }
299 l = strlen(string);
300 if (m!=0 && l>m)
301 {
302 int i;
303 for (i=0; i<m; i++)
304 string[i] = '*';
305 string[i] = 0;
306 }
307 else if (m!=0 && j=='|')
308 {
309 int i=l-1;
310 while (isspace(string[i])) i--;
311 string -= (m-i) / 2;
312 i=0;
313 while (string[i]==0) string[i++] = ' ';
314 string[l] = 0;
315 }
316 return string;
317}
318static void io_write (void)
319{
320 lua_Object o1 = lua_getparam (1);
321 lua_Object o2 = lua_getparam (2);
322 if (o1 == NULL) /* new line */
323 {
324 fprintf (out, "\n");
325 lua_pushnumber(1);
326 }
327 else if (o2 == NULL) /* free format */
328 {
329 int status=0;
330 if (lua_isnumber(o1))
331 status = fprintf (out, "%g", lua_getnumber(o1));
332 else if (lua_isstring(o1))
333 status = fprintf (out, "%s", lua_getstring(o1));
334 lua_pushnumber(status);
335 }
336 else /* formated */
337 {
338 if (!lua_isstring(o2))
339 {
340 lua_error ("incorrect format to function `write'");
341 lua_pushnumber(0);
342 return;
343 }
344 lua_pushnumber(fprintf (out, "%s", buildformat(lua_getstring(o2),o1)));
345 }
346}
347
348/*
349** Execute a executable program using "sustem".
350** On error put 0 on stack, otherwise put 1.
351*/
352void io_execute (void)
353{
354 lua_Object o = lua_getparam (1);
355 if (o == NULL || !lua_isstring (o))
356 {
357 lua_error ("incorrect argument to function 'execute`");
358 lua_pushnumber (0);
359 }
360 else
361 {
362 system(lua_getstring(o));
363 lua_pushnumber (1);
364 }
365 return;
366}
367
368/*
369** Remove a file.
370** On error put 0 on stack, otherwise put 1.
371*/
372void io_remove (void)
373{
374 lua_Object o = lua_getparam (1);
375 if (o == NULL || !lua_isstring (o))
376 {
377 lua_error ("incorrect argument to function 'execute`");
378 lua_pushnumber (0);
379 }
380 else
381 {
382 if (remove(lua_getstring(o)) == 0)
383 lua_pushnumber (1);
384 else
385 lua_pushnumber (0);
386 }
387 return;
388}
389
390/*
391** Open io library
392*/
393void iolib_open (void)
394{
395 lua_register ("readfrom", io_readfrom);
396 lua_register ("writeto", io_writeto);
397 lua_register ("read", io_read);
398 lua_register ("write", io_write);
399 lua_register ("execute", io_execute);
400 lua_register ("remove", io_remove);
401}
diff --git a/lex_yy.c b/lex_yy.c
new file mode 100644
index 00000000..cc129d9b
--- /dev/null
+++ b/lex_yy.c
@@ -0,0 +1,923 @@
1# include "stdio.h"
2# define U(x) x
3# define NLSTATE yyprevious=YYNEWLINE
4# define BEGIN yybgin = yysvec + 1 +
5# define INITIAL 0
6# define YYLERR yysvec
7# define YYSTATE (yyestate-yysvec-1)
8# define YYOPTIM 1
9# define YYLMAX BUFSIZ
10# define output(c) putc(c,yyout)
11# define input() (((yytchar=yysptr>yysbuf?U(*--yysptr):getc(yyin))==10?(yylineno++,yytchar):yytchar)==EOF?0:yytchar)
12# define unput(c) {yytchar= (c);if(yytchar=='\n')yylineno--;*yysptr++=yytchar;}
13# define yymore() (yymorfg=1)
14# define ECHO fprintf(yyout, "%s",yytext)
15# define REJECT { nstr = yyreject(); goto yyfussy;}
16int yyleng; extern char yytext[];
17int yymorfg;
18extern char *yysptr, yysbuf[];
19int yytchar;
20FILE *yyin = {stdin}, *yyout = {stdout};
21extern int yylineno;
22struct yysvf {
23 struct yywork *yystoff;
24 struct yysvf *yyother;
25 int *yystops;};
26struct yysvf *yyestate;
27extern struct yysvf yysvec[], *yybgin;
28#include <stdlib.h>
29#include <string.h>
30
31#include "opcode.h"
32#include "hash.h"
33#include "inout.h"
34#include "table.h"
35#include "y_tab.h"
36
37#undef input
38#undef unput
39
40static Input input;
41static Unput unput;
42
43void lua_setinput (Input fn)
44{
45 input = fn;
46}
47
48void lua_setunput (Unput fn)
49{
50 unput = fn;
51}
52
53char *lua_lasttext (void)
54{
55 return yytext;
56}
57
58# define YYNEWLINE 10
59yylex(){
60int nstr; extern int yyprevious;
61while((nstr = yylook()) >= 0)
62yyfussy: switch(nstr){
63case 0:
64if(yywrap()) return(0); break;
65case 1:
66 ;
67break;
68case 2:
69 {yylval.vInt = 1; return DEBUG;}
70break;
71case 3:
72 {yylval.vInt = 0; return DEBUG;}
73break;
74case 4:
75 lua_linenumber++;
76break;
77case 5:
78 ;
79break;
80case 6:
81 return LOCAL;
82break;
83case 7:
84 return IF;
85break;
86case 8:
87 return THEN;
88break;
89case 9:
90 return ELSE;
91break;
92case 10:
93 return ELSEIF;
94break;
95case 11:
96 return WHILE;
97break;
98case 12:
99 return DO;
100break;
101case 13:
102 return REPEAT;
103break;
104case 14:
105 return UNTIL;
106break;
107case 15:
108 {
109 yylval.vWord = lua_nfile-1;
110 return FUNCTION;
111 }
112break;
113case 16:
114 return END;
115break;
116case 17:
117 return RETURN;
118break;
119case 18:
120 return LOCAL;
121break;
122case 19:
123 return NIL;
124break;
125case 20:
126 return AND;
127break;
128case 21:
129 return OR;
130break;
131case 22:
132 return NOT;
133break;
134case 23:
135 return NE;
136break;
137case 24:
138 return LE;
139break;
140case 25:
141 return GE;
142break;
143case 26:
144 return CONC;
145break;
146case 27:
147 case 28:
148 {
149 yylval.vWord = lua_findenclosedconstant (yytext);
150 return STRING;
151 }
152break;
153case 29:
154case 30:
155case 31:
156case 32:
157{
158 yylval.vFloat = atof(yytext);
159 return NUMBER;
160 }
161break;
162case 33:
163 {
164 yylval.vWord = lua_findsymbol (yytext);
165 return NAME;
166 }
167break;
168case 34:
169 return *yytext;
170break;
171case -1:
172break;
173default:
174fprintf(yyout,"bad switch yylook %d",nstr);
175} return(0); }
176/* end of yylex */
177int yyvstop[] = {
1780,
179
1801,
1810,
182
1831,
1840,
185
18634,
1870,
188
1891,
19034,
1910,
192
1934,
1940,
195
19634,
1970,
198
19934,
2000,
201
20234,
2030,
204
20534,
2060,
207
20829,
20934,
2100,
211
21234,
2130,
214
21534,
2160,
217
21833,
21934,
2200,
221
22233,
22334,
2240,
225
22633,
22734,
2280,
229
23033,
23134,
2320,
233
23433,
23534,
2360,
237
23833,
23934,
2400,
241
24233,
24334,
2440,
245
24633,
24734,
2480,
249
25033,
25134,
2520,
253
25433,
25534,
2560,
257
25833,
25934,
2600,
261
26233,
26334,
2640,
265
26633,
26734,
2680,
269
27034,
2710,
272
27334,
2740,
275
2761,
2770,
278
27927,
2800,
281
28228,
2830,
284
2855,
2860,
287
28826,
2890,
290
29130,
2920,
293
29429,
2950,
296
29729,
2980,
299
30024,
3010,
302
30325,
3040,
305
30633,
3070,
308
30933,
3100,
311
31212,
31333,
3140,
315
31633,
3170,
318
31933,
3200,
321
32233,
3230,
324
3257,
32633,
3270,
328
32933,
3300,
331
33233,
3330,
334
33533,
3360,
337
33821,
33933,
3400,
341
34233,
3430,
344
34533,
3460,
347
34833,
3490,
350
35133,
3520,
353
35423,
3550,
356
35729,
35830,
3590,
360
36131,
3620,
363
36420,
36533,
3660,
367
36833,
3690,
370
37116,
37233,
3730,
374
37533,
3760,
377
37833,
3790,
380
38119,
38233,
3830,
384
38522,
38633,
3870,
388
38933,
3900,
391
39233,
3930,
394
39533,
3960,
397
39833,
3990,
400
40133,
4020,
403
40432,
4050,
406
4079,
40833,
4090,
410
41133,
4120,
413
41433,
4150,
416
41733,
4180,
419
42033,
4210,
422
4238,
42433,
4250,
426
42733,
4280,
429
43033,
4310,
432
43331,
43432,
4350,
436
43733,
4380,
439
44033,
4410,
442
4436,
44418,
44533,
4460,
447
44833,
4490,
450
45133,
4520,
453
45414,
45533,
4560,
457
45811,
45933,
4600,
461
46210,
46333,
4640,
465
46633,
4670,
468
46913,
47033,
4710,
472
47317,
47433,
4750,
476
4772,
4780,
479
48033,
4810,
482
48315,
48433,
4850,
486
4873,
4880,
4890};
490# define YYTYPE char
491struct yywork { YYTYPE verify, advance; } yycrank[] = {
4920,0, 0,0, 1,3, 0,0,
4930,0, 0,0, 0,0, 0,0,
4940,0, 0,0, 1,4, 1,5,
4956,29, 4,28, 0,0, 0,0,
4960,0, 0,0, 7,31, 0,0,
4976,29, 6,29, 0,0, 0,0,
4980,0, 0,0, 7,31, 7,31,
4990,0, 0,0, 0,0, 0,0,
5000,0, 0,0, 0,0, 1,6,
5014,28, 0,0, 0,0, 0,0,
5021,7, 0,0, 0,0, 0,0,
5031,3, 6,30, 1,8, 1,9,
5040,0, 1,10, 6,29, 7,31,
5058,33, 0,0, 6,29, 0,0,
5067,32, 0,0, 0,0, 6,29,
5077,31, 1,11, 0,0, 1,12,
5082,27, 7,31, 1,13, 11,39,
50912,40, 1,13, 26,56, 0,0,
5100,0, 2,8, 2,9, 0,0,
5116,29, 0,0, 0,0, 6,29,
5120,0, 0,0, 7,31, 0,0,
5130,0, 7,31, 0,0, 0,0,
5142,11, 0,0, 2,12, 0,0,
5150,0, 0,0, 0,0, 0,0,
5160,0, 0,0, 1,14, 0,0,
5170,0, 1,15, 1,16, 1,17,
5180,0, 22,52, 1,18, 18,47,
51923,53, 1,19, 42,63, 1,20,
5201,21, 25,55, 14,42, 1,22,
52115,43, 1,23, 1,24, 16,44,
5221,25, 16,45, 17,46, 19,48,
52321,51, 2,14, 20,49, 1,26,
5242,15, 2,16, 2,17, 24,54,
52520,50, 2,18, 44,64, 45,65,
5262,19, 46,66, 2,20, 2,21,
52727,57, 48,67, 2,22, 49,68,
5282,23, 2,24, 50,69, 2,25,
52952,70, 53,72, 27,58, 54,73,
53052,71, 9,34, 2,26, 9,35,
5319,35, 9,35, 9,35, 9,35,
5329,35, 9,35, 9,35, 9,35,
5339,35, 10,36, 55,74, 10,37,
53410,37, 10,37, 10,37, 10,37,
53510,37, 10,37, 10,37, 10,37,
53610,37, 57,75, 58,76, 64,80,
53766,81, 67,82, 70,83, 71,84,
53872,85, 73,86, 74,87, 10,38,
53910,38, 38,61, 10,38, 38,61,
54075,88, 76,89, 38,62, 38,62,
54138,62, 38,62, 38,62, 38,62,
54238,62, 38,62, 38,62, 38,62,
54380,92, 81,93, 13,41, 13,41,
54413,41, 13,41, 13,41, 13,41,
54513,41, 13,41, 13,41, 13,41,
54682,94, 83,95, 84,96, 10,38,
54710,38, 86,97, 10,38, 13,41,
54813,41, 13,41, 13,41, 13,41,
54913,41, 13,41, 13,41, 13,41,
55013,41, 13,41, 13,41, 13,41,
55113,41, 13,41, 13,41, 13,41,
55213,41, 13,41, 13,41, 13,41,
55313,41, 13,41, 13,41, 13,41,
55413,41, 87,98, 88,99, 60,79,
55560,79, 13,41, 60,79, 13,41,
55613,41, 13,41, 13,41, 13,41,
55713,41, 13,41, 13,41, 13,41,
55813,41, 13,41, 13,41, 13,41,
55913,41, 13,41, 13,41, 13,41,
56013,41, 13,41, 13,41, 13,41,
56113,41, 13,41, 13,41, 13,41,
56213,41, 33,33, 89,100, 60,79,
56360,79, 92,101, 60,79, 93,102,
56495,103, 33,33, 33,0, 96,104,
56599,105, 100,106, 102,107, 106,108,
566107,109, 35,35, 35,35, 35,35,
56735,35, 35,35, 35,35, 35,35,
56835,35, 35,35, 35,35, 108,110,
5690,0, 0,0, 0,0, 0,0,
5700,0, 0,0, 33,33, 0,0,
5710,0, 35,59, 35,59, 33,33,
57235,59, 0,0, 0,0, 33,33,
5730,0, 0,0, 0,0, 0,0,
57433,33, 0,0, 0,0, 0,0,
5750,0, 36,60, 36,60, 36,60,
57636,60, 36,60, 36,60, 36,60,
57736,60, 36,60, 36,60, 0,0,
5780,0, 33,33, 0,0, 0,0,
57933,33, 35,59, 35,59, 0,0,
58035,59, 36,38, 36,38, 59,77,
58136,38, 59,77, 0,0, 0,0,
58259,78, 59,78, 59,78, 59,78,
58359,78, 59,78, 59,78, 59,78,
58459,78, 59,78, 61,62, 61,62,
58561,62, 61,62, 61,62, 61,62,
58661,62, 61,62, 61,62, 61,62,
5870,0, 0,0, 0,0, 0,0,
5880,0, 36,38, 36,38, 0,0,
58936,38, 77,78, 77,78, 77,78,
59077,78, 77,78, 77,78, 77,78,
59177,78, 77,78, 77,78, 79,90,
5920,0, 79,90, 0,0, 0,0,
59379,91, 79,91, 79,91, 79,91,
59479,91, 79,91, 79,91, 79,91,
59579,91, 79,91, 90,91, 90,91,
59690,91, 90,91, 90,91, 90,91,
59790,91, 90,91, 90,91, 90,91,
5980,0};
599struct yysvf yysvec[] = {
6000, 0, 0,
601yycrank+-1, 0, yyvstop+1,
602yycrank+-28, yysvec+1, yyvstop+3,
603yycrank+0, 0, yyvstop+5,
604yycrank+4, 0, yyvstop+7,
605yycrank+0, 0, yyvstop+10,
606yycrank+-11, 0, yyvstop+12,
607yycrank+-17, 0, yyvstop+14,
608yycrank+7, 0, yyvstop+16,
609yycrank+107, 0, yyvstop+18,
610yycrank+119, 0, yyvstop+20,
611yycrank+6, 0, yyvstop+23,
612yycrank+7, 0, yyvstop+25,
613yycrank+158, 0, yyvstop+27,
614yycrank+4, yysvec+13, yyvstop+30,
615yycrank+5, yysvec+13, yyvstop+33,
616yycrank+11, yysvec+13, yyvstop+36,
617yycrank+5, yysvec+13, yyvstop+39,
618yycrank+5, yysvec+13, yyvstop+42,
619yycrank+12, yysvec+13, yyvstop+45,
620yycrank+21, yysvec+13, yyvstop+48,
621yycrank+10, yysvec+13, yyvstop+51,
622yycrank+4, yysvec+13, yyvstop+54,
623yycrank+4, yysvec+13, yyvstop+57,
624yycrank+21, yysvec+13, yyvstop+60,
625yycrank+9, yysvec+13, yyvstop+63,
626yycrank+9, 0, yyvstop+66,
627yycrank+40, 0, yyvstop+68,
628yycrank+0, yysvec+4, yyvstop+70,
629yycrank+0, yysvec+6, 0,
630yycrank+0, 0, yyvstop+72,
631yycrank+0, yysvec+7, 0,
632yycrank+0, 0, yyvstop+74,
633yycrank+-280, 0, yyvstop+76,
634yycrank+0, 0, yyvstop+78,
635yycrank+249, 0, yyvstop+80,
636yycrank+285, 0, yyvstop+82,
637yycrank+0, yysvec+10, yyvstop+84,
638yycrank+146, 0, 0,
639yycrank+0, 0, yyvstop+86,
640yycrank+0, 0, yyvstop+88,
641yycrank+0, yysvec+13, yyvstop+90,
642yycrank+10, yysvec+13, yyvstop+92,
643yycrank+0, yysvec+13, yyvstop+94,
644yycrank+19, yysvec+13, yyvstop+97,
645yycrank+35, yysvec+13, yyvstop+99,
646yycrank+27, yysvec+13, yyvstop+101,
647yycrank+0, yysvec+13, yyvstop+103,
648yycrank+42, yysvec+13, yyvstop+106,
649yycrank+35, yysvec+13, yyvstop+108,
650yycrank+30, yysvec+13, yyvstop+110,
651yycrank+0, yysvec+13, yyvstop+112,
652yycrank+36, yysvec+13, yyvstop+115,
653yycrank+48, yysvec+13, yyvstop+117,
654yycrank+35, yysvec+13, yyvstop+119,
655yycrank+61, yysvec+13, yyvstop+121,
656yycrank+0, 0, yyvstop+123,
657yycrank+76, 0, 0,
658yycrank+67, 0, 0,
659yycrank+312, 0, 0,
660yycrank+183, yysvec+36, yyvstop+125,
661yycrank+322, 0, 0,
662yycrank+0, yysvec+61, yyvstop+128,
663yycrank+0, yysvec+13, yyvstop+130,
664yycrank+78, yysvec+13, yyvstop+133,
665yycrank+0, yysvec+13, yyvstop+135,
666yycrank+81, yysvec+13, yyvstop+138,
667yycrank+84, yysvec+13, yyvstop+140,
668yycrank+0, yysvec+13, yyvstop+142,
669yycrank+0, yysvec+13, yyvstop+145,
670yycrank+81, yysvec+13, yyvstop+148,
671yycrank+66, yysvec+13, yyvstop+150,
672yycrank+74, yysvec+13, yyvstop+152,
673yycrank+80, yysvec+13, yyvstop+154,
674yycrank+78, yysvec+13, yyvstop+156,
675yycrank+94, 0, 0,
676yycrank+93, 0, 0,
677yycrank+341, 0, 0,
678yycrank+0, yysvec+77, yyvstop+158,
679yycrank+356, 0, 0,
680yycrank+99, yysvec+13, yyvstop+160,
681yycrank+89, yysvec+13, yyvstop+163,
682yycrank+108, yysvec+13, yyvstop+165,
683yycrank+120, yysvec+13, yyvstop+167,
684yycrank+104, yysvec+13, yyvstop+169,
685yycrank+0, yysvec+13, yyvstop+171,
686yycrank+113, yysvec+13, yyvstop+174,
687yycrank+148, yysvec+13, yyvstop+176,
688yycrank+133, 0, 0,
689yycrank+181, 0, 0,
690yycrank+366, 0, 0,
691yycrank+0, yysvec+90, yyvstop+178,
692yycrank+183, yysvec+13, yyvstop+181,
693yycrank+182, yysvec+13, yyvstop+183,
694yycrank+0, yysvec+13, yyvstop+185,
695yycrank+172, yysvec+13, yyvstop+189,
696yycrank+181, yysvec+13, yyvstop+191,
697yycrank+0, yysvec+13, yyvstop+193,
698yycrank+0, yysvec+13, yyvstop+196,
699yycrank+189, 0, 0,
700yycrank+195, 0, 0,
701yycrank+0, yysvec+13, yyvstop+199,
702yycrank+183, yysvec+13, yyvstop+202,
703yycrank+0, yysvec+13, yyvstop+204,
704yycrank+0, yysvec+13, yyvstop+207,
705yycrank+0, 0, yyvstop+210,
706yycrank+178, 0, 0,
707yycrank+186, yysvec+13, yyvstop+212,
708yycrank+204, 0, 0,
709yycrank+0, yysvec+13, yyvstop+214,
710yycrank+0, 0, yyvstop+217,
7110, 0, 0};
712struct yywork *yytop = yycrank+423;
713struct yysvf *yybgin = yysvec+1;
714char yymatch[] = {
71500 ,01 ,01 ,01 ,01 ,01 ,01 ,01 ,
71601 ,011 ,012 ,01 ,01 ,01 ,01 ,01 ,
71701 ,01 ,01 ,01 ,01 ,01 ,01 ,01 ,
71801 ,01 ,01 ,01 ,01 ,01 ,01 ,01 ,
719011 ,01 ,'"' ,01 ,01 ,01 ,01 ,047 ,
72001 ,01 ,01 ,'+' ,01 ,'+' ,01 ,01 ,
721'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,
722'0' ,'0' ,01 ,01 ,01 ,01 ,01 ,01 ,
72301 ,'A' ,'A' ,'A' ,'D' ,'D' ,'A' ,'D' ,
724'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
725'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
726'A' ,'A' ,'A' ,01 ,01 ,01 ,01 ,'A' ,
72701 ,'A' ,'A' ,'A' ,'D' ,'D' ,'A' ,'D' ,
728'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
729'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
730'A' ,'A' ,'A' ,01 ,01 ,01 ,01 ,01 ,
7310};
732char yyextra[] = {
7330,0,0,0,0,0,0,0,
7340,0,0,0,0,0,0,0,
7350,0,0,0,0,0,0,0,
7360,0,0,0,0,0,0,0,
7370,0,0,0,0,0,0,0,
7380};
739#ifndef lint
740static char ncform_sccsid[] = "@(#)ncform 1.6 88/02/08 SMI"; /* from S5R2 1.2 */
741#endif
742
743int yylineno =1;
744# define YYU(x) x
745# define NLSTATE yyprevious=YYNEWLINE
746char yytext[YYLMAX];
747struct yysvf *yylstate [YYLMAX], **yylsp, **yyolsp;
748char yysbuf[YYLMAX];
749char *yysptr = yysbuf;
750int *yyfnd;
751extern struct yysvf *yyestate;
752int yyprevious = YYNEWLINE;
753yylook(){
754 register struct yysvf *yystate, **lsp;
755 register struct yywork *yyt;
756 struct yysvf *yyz;
757 int yych, yyfirst;
758 struct yywork *yyr;
759# ifdef LEXDEBUG
760 int debug;
761# endif
762 char *yylastch;
763 /* start off machines */
764# ifdef LEXDEBUG
765 debug = 0;
766# endif
767 yyfirst=1;
768 if (!yymorfg)
769 yylastch = yytext;
770 else {
771 yymorfg=0;
772 yylastch = yytext+yyleng;
773 }
774 for(;;){
775 lsp = yylstate;
776 yyestate = yystate = yybgin;
777 if (yyprevious==YYNEWLINE) yystate++;
778 for (;;){
779# ifdef LEXDEBUG
780 if(debug)fprintf(yyout,"state %d\n",yystate-yysvec-1);
781# endif
782 yyt = yystate->yystoff;
783 if(yyt == yycrank && !yyfirst){ /* may not be any transitions */
784 yyz = yystate->yyother;
785 if(yyz == 0)break;
786 if(yyz->yystoff == yycrank)break;
787 }
788 *yylastch++ = yych = input();
789 yyfirst=0;
790 tryagain:
791# ifdef LEXDEBUG
792 if(debug){
793 fprintf(yyout,"char ");
794 allprint(yych);
795 putchar('\n');
796 }
797# endif
798 yyr = yyt;
799 if ( (int)yyt > (int)yycrank){
800 yyt = yyr + yych;
801 if (yyt <= yytop && yyt->verify+yysvec == yystate){
802 if(yyt->advance+yysvec == YYLERR) /* error transitions */
803 {unput(*--yylastch);break;}
804 *lsp++ = yystate = yyt->advance+yysvec;
805 goto contin;
806 }
807 }
808# ifdef YYOPTIM
809 else if((int)yyt < (int)yycrank) { /* r < yycrank */
810 yyt = yyr = yycrank+(yycrank-yyt);
811# ifdef LEXDEBUG
812 if(debug)fprintf(yyout,"compressed state\n");
813# endif
814 yyt = yyt + yych;
815 if(yyt <= yytop && yyt->verify+yysvec == yystate){
816 if(yyt->advance+yysvec == YYLERR) /* error transitions */
817 {unput(*--yylastch);break;}
818 *lsp++ = yystate = yyt->advance+yysvec;
819 goto contin;
820 }
821 yyt = yyr + YYU(yymatch[yych]);
822# ifdef LEXDEBUG
823 if(debug){
824 fprintf(yyout,"try fall back character ");
825 allprint(YYU(yymatch[yych]));
826 putchar('\n');
827 }
828# endif
829 if(yyt <= yytop && yyt->verify+yysvec == yystate){
830 if(yyt->advance+yysvec == YYLERR) /* error transition */
831 {unput(*--yylastch);break;}
832 *lsp++ = yystate = yyt->advance+yysvec;
833 goto contin;
834 }
835 }
836 if ((yystate = yystate->yyother) && (yyt= yystate->yystoff) != yycrank){
837# ifdef LEXDEBUG
838 if(debug)fprintf(yyout,"fall back to state %d\n",yystate-yysvec-1);
839# endif
840 goto tryagain;
841 }
842# endif
843 else
844 {unput(*--yylastch);break;}
845 contin:
846# ifdef LEXDEBUG
847 if(debug){
848 fprintf(yyout,"state %d char ",yystate-yysvec-1);
849 allprint(yych);
850 putchar('\n');
851 }
852# endif
853 ;
854 }
855# ifdef LEXDEBUG
856 if(debug){
857 fprintf(yyout,"stopped at %d with ",*(lsp-1)-yysvec-1);
858 allprint(yych);
859 putchar('\n');
860 }
861# endif
862 while (lsp-- > yylstate){
863 *yylastch-- = 0;
864 if (*lsp != 0 && (yyfnd= (*lsp)->yystops) && *yyfnd > 0){
865 yyolsp = lsp;
866 if(yyextra[*yyfnd]){ /* must backup */
867 while(yyback((*lsp)->yystops,-*yyfnd) != 1 && lsp > yylstate){
868 lsp--;
869 unput(*yylastch--);
870 }
871 }
872 yyprevious = YYU(*yylastch);
873 yylsp = lsp;
874 yyleng = yylastch-yytext+1;
875 yytext[yyleng] = 0;
876# ifdef LEXDEBUG
877 if(debug){
878 fprintf(yyout,"\nmatch ");
879 sprint(yytext);
880 fprintf(yyout," action %d\n",*yyfnd);
881 }
882# endif
883 return(*yyfnd++);
884 }
885 unput(*yylastch);
886 }
887 if (yytext[0] == 0 /* && feof(yyin) */)
888 {
889 yysptr=yysbuf;
890 return(0);
891 }
892 yyprevious = yytext[0] = input();
893 if (yyprevious>0)
894 output(yyprevious);
895 yylastch=yytext;
896# ifdef LEXDEBUG
897 if(debug)putchar('\n');
898# endif
899 }
900 }
901yyback(p, m)
902 int *p;
903{
904if (p==0) return(0);
905while (*p)
906 {
907 if (*p++ == m)
908 return(1);
909 }
910return(0);
911}
912 /* the following are only used in the lex library */
913yyinput(){
914 return(input());
915 }
916yyoutput(c)
917 int c; {
918 output(c);
919 }
920yyunput(c)
921 int c; {
922 unput(c);
923 }
diff --git a/lua.c b/lua.c
new file mode 100644
index 00000000..be01b70f
--- /dev/null
+++ b/lua.c
@@ -0,0 +1,54 @@
1/*
2** lua.c
3** Linguagem para Usuarios de Aplicacao
4** TeCGraf - PUC-Rio
5** 28 Apr 93
6*/
7
8#include <stdio.h>
9
10#include "lua.h"
11#include "lualib.h"
12
13
14void test (void)
15{
16 lua_pushobject(lua_getparam(1));
17 lua_call ("c", 1);
18}
19
20
21static void callfunc (void)
22{
23 lua_Object obj = lua_getparam (1);
24 if (lua_isstring(obj)) lua_call(lua_getstring(obj),0);
25}
26
27static void execstr (void)
28{
29 lua_Object obj = lua_getparam (1);
30 if (lua_isstring(obj)) lua_dostring(lua_getstring(obj));
31}
32
33void main (int argc, char *argv[])
34{
35 int i;
36 if (argc < 2)
37 {
38 puts ("usage: lua filename [functionnames]");
39 return;
40 }
41 lua_register ("callfunc", callfunc);
42 lua_register ("execstr", execstr);
43 lua_register ("test", test);
44 iolib_open ();
45 strlib_open ();
46 mathlib_open ();
47 lua_dofile (argv[1]);
48 for (i=2; i<argc; i++)
49 {
50 lua_call (argv[i],0);
51 }
52}
53
54
diff --git a/lua.h b/lua.h
new file mode 100644
index 00000000..2558075a
--- /dev/null
+++ b/lua.h
@@ -0,0 +1,54 @@
1/*
2** LUA - Linguagem para Usuarios de Aplicacao
3** Grupo de Tecnologia em Computacao Grafica
4** TeCGraf - PUC-Rio
5** 19 May 93
6*/
7
8
9#ifndef lua_h
10#define lua_h
11
12typedef void (*lua_CFunction) (void);
13typedef struct Object *lua_Object;
14
15#define lua_register(n,f) (lua_pushcfunction(f), lua_storeglobal(n))
16
17
18void lua_errorfunction (void (*fn) (char *s));
19void lua_error (char *s);
20int lua_dofile (char *filename);
21int lua_dostring (char *string);
22int lua_call (char *functionname, int nparam);
23
24lua_Object lua_getparam (int number);
25float lua_getnumber (lua_Object object);
26char *lua_getstring (lua_Object object);
27char *lua_copystring (lua_Object object);
28lua_CFunction lua_getcfunction (lua_Object object);
29void *lua_getuserdata (lua_Object object);
30lua_Object lua_getfield (lua_Object object, char *field);
31lua_Object lua_getindexed (lua_Object object, float index);
32lua_Object lua_getglobal (char *name);
33
34lua_Object lua_pop (void);
35
36int lua_pushnil (void);
37int lua_pushnumber (float n);
38int lua_pushstring (char *s);
39int lua_pushcfunction (lua_CFunction fn);
40int lua_pushuserdata (void *u);
41int lua_pushobject (lua_Object object);
42
43int lua_storeglobal (char *name);
44int lua_storefield (lua_Object object, char *field);
45int lua_storeindexed (lua_Object object, float index);
46
47int lua_isnil (lua_Object object);
48int lua_isnumber (lua_Object object);
49int lua_isstring (lua_Object object);
50int lua_istable (lua_Object object);
51int lua_iscfunction (lua_Object object);
52int lua_isuserdata (lua_Object object);
53
54#endif
diff --git a/lualib.h b/lualib.h
new file mode 100644
index 00000000..fb4be040
--- /dev/null
+++ b/lualib.h
@@ -0,0 +1,15 @@
1/*
2** Libraries to use in LUA programs
3** Grupo de Tecnologia em Computacao Grafica
4** TeCGraf - PUC-Rio
5** 19 May 93
6*/
7
8#ifndef lualib_h
9#define lualib_h
10
11void iolib_open (void);
12void strlib_open (void);
13void mathlib_open (void);
14
15#endif
diff --git a/mathlib.c b/mathlib.c
new file mode 100644
index 00000000..b07c8c47
--- /dev/null
+++ b/mathlib.c
@@ -0,0 +1,234 @@
1/*
2** mathlib.c
3** Mathematica library to LUA
4**
5** Waldemar Celes Filho
6** TeCGraf - PUC-Rio
7** 19 May 93
8*/
9
10#include <stdio.h> /* NULL */
11#include <math.h>
12
13#include "lua.h"
14
15static void math_abs (void)
16{
17 double d;
18 lua_Object o = lua_getparam (1);
19 if (o == NULL)
20 { lua_error ("too few arguments to function `abs'"); return; }
21 if (!lua_isnumber(o))
22 { lua_error ("incorrect arguments to function `abs'"); return; }
23 d = lua_getnumber(o);
24 if (d < 0) d = -d;
25 lua_pushnumber (d);
26}
27
28
29static void math_sin (void)
30{
31 double d;
32 lua_Object o = lua_getparam (1);
33 if (o == NULL)
34 { lua_error ("too few arguments to function `sin'"); return; }
35 if (!lua_isnumber(o))
36 { lua_error ("incorrect arguments to function `sin'"); return; }
37 d = lua_getnumber(o);
38 lua_pushnumber (sin(d));
39}
40
41
42
43static void math_cos (void)
44{
45 double d;
46 lua_Object o = lua_getparam (1);
47 if (o == NULL)
48 { lua_error ("too few arguments to function `cos'"); return; }
49 if (!lua_isnumber(o))
50 { lua_error ("incorrect arguments to function `cos'"); return; }
51 d = lua_getnumber(o);
52 lua_pushnumber (cos(d));
53}
54
55
56
57static void math_tan (void)
58{
59 double d;
60 lua_Object o = lua_getparam (1);
61 if (o == NULL)
62 { lua_error ("too few arguments to function `tan'"); return; }
63 if (!lua_isnumber(o))
64 { lua_error ("incorrect arguments to function `tan'"); return; }
65 d = lua_getnumber(o);
66 lua_pushnumber (tan(d));
67}
68
69
70static void math_asin (void)
71{
72 double d;
73 lua_Object o = lua_getparam (1);
74 if (o == NULL)
75 { lua_error ("too few arguments to function `asin'"); return; }
76 if (!lua_isnumber(o))
77 { lua_error ("incorrect arguments to function `asin'"); return; }
78 d = lua_getnumber(o);
79 lua_pushnumber (asin(d));
80}
81
82
83static void math_acos (void)
84{
85 double d;
86 lua_Object o = lua_getparam (1);
87 if (o == NULL)
88 { lua_error ("too few arguments to function `acos'"); return; }
89 if (!lua_isnumber(o))
90 { lua_error ("incorrect arguments to function `acos'"); return; }
91 d = lua_getnumber(o);
92 lua_pushnumber (acos(d));
93}
94
95
96
97static void math_atan (void)
98{
99 double d;
100 lua_Object o = lua_getparam (1);
101 if (o == NULL)
102 { lua_error ("too few arguments to function `atan'"); return; }
103 if (!lua_isnumber(o))
104 { lua_error ("incorrect arguments to function `atan'"); return; }
105 d = lua_getnumber(o);
106 lua_pushnumber (atan(d));
107}
108
109
110static void math_ceil (void)
111{
112 double d;
113 lua_Object o = lua_getparam (1);
114 if (o == NULL)
115 { lua_error ("too few arguments to function `ceil'"); return; }
116 if (!lua_isnumber(o))
117 { lua_error ("incorrect arguments to function `ceil'"); return; }
118 d = lua_getnumber(o);
119 lua_pushnumber (ceil(d));
120}
121
122
123static void math_floor (void)
124{
125 double d;
126 lua_Object o = lua_getparam (1);
127 if (o == NULL)
128 { lua_error ("too few arguments to function `floor'"); return; }
129 if (!lua_isnumber(o))
130 { lua_error ("incorrect arguments to function `floor'"); return; }
131 d = lua_getnumber(o);
132 lua_pushnumber (floor(d));
133}
134
135static void math_mod (void)
136{
137 int d1, d2;
138 lua_Object o1 = lua_getparam (1);
139 lua_Object o2 = lua_getparam (2);
140 if (!lua_isnumber(o1) || !lua_isnumber(o2))
141 { lua_error ("incorrect arguments to function `mod'"); return; }
142 d1 = (int) lua_getnumber(o1);
143 d2 = (int) lua_getnumber(o2);
144 lua_pushnumber (d1%d2);
145}
146
147
148static void math_sqrt (void)
149{
150 double d;
151 lua_Object o = lua_getparam (1);
152 if (o == NULL)
153 { lua_error ("too few arguments to function `sqrt'"); return; }
154 if (!lua_isnumber(o))
155 { lua_error ("incorrect arguments to function `sqrt'"); return; }
156 d = lua_getnumber(o);
157 lua_pushnumber (sqrt(d));
158}
159
160static void math_pow (void)
161{
162 double d1, d2;
163 lua_Object o1 = lua_getparam (1);
164 lua_Object o2 = lua_getparam (2);
165 if (!lua_isnumber(o1) || !lua_isnumber(o2))
166 { lua_error ("incorrect arguments to function `pow'"); return; }
167 d1 = lua_getnumber(o1);
168 d2 = lua_getnumber(o2);
169 lua_pushnumber (pow(d1,d2));
170}
171
172static void math_min (void)
173{
174 int i=1;
175 double d, dmin;
176 lua_Object o;
177 if ((o = lua_getparam(i++)) == NULL)
178 { lua_error ("too few arguments to function `min'"); return; }
179 if (!lua_isnumber(o))
180 { lua_error ("incorrect arguments to function `min'"); return; }
181 dmin = lua_getnumber (o);
182 while ((o = lua_getparam(i++)) != NULL)
183 {
184 if (!lua_isnumber(o))
185 { lua_error ("incorrect arguments to function `min'"); return; }
186 d = lua_getnumber (o);
187 if (d < dmin) dmin = d;
188 }
189 lua_pushnumber (dmin);
190}
191
192
193static void math_max (void)
194{
195 int i=1;
196 double d, dmax;
197 lua_Object o;
198 if ((o = lua_getparam(i++)) == NULL)
199 { lua_error ("too few arguments to function `max'"); return; }
200 if (!lua_isnumber(o))
201 { lua_error ("incorrect arguments to function `max'"); return; }
202 dmax = lua_getnumber (o);
203 while ((o = lua_getparam(i++)) != NULL)
204 {
205 if (!lua_isnumber(o))
206 { lua_error ("incorrect arguments to function `max'"); return; }
207 d = lua_getnumber (o);
208 if (d > dmax) dmax = d;
209 }
210 lua_pushnumber (dmax);
211}
212
213
214
215/*
216** Open math library
217*/
218void mathlib_open (void)
219{
220 lua_register ("abs", math_abs);
221 lua_register ("sin", math_sin);
222 lua_register ("cos", math_cos);
223 lua_register ("tan", math_tan);
224 lua_register ("asin", math_asin);
225 lua_register ("acos", math_acos);
226 lua_register ("atan", math_atan);
227 lua_register ("ceil", math_ceil);
228 lua_register ("floor", math_floor);
229 lua_register ("mod", math_mod);
230 lua_register ("sqrt", math_sqrt);
231 lua_register ("pow", math_pow);
232 lua_register ("min", math_min);
233 lua_register ("max", math_max);
234}
diff --git a/opcode.c b/opcode.c
new file mode 100644
index 00000000..97975ba1
--- /dev/null
+++ b/opcode.c
@@ -0,0 +1,933 @@
1/*
2** opcode.c
3** TecCGraf - PUC-Rio
4** 26 Apr 93
5*/
6
7#include <stdio.h>
8#include <stdlib.h>
9#include <string.h>
10#ifdef __GNUC__
11#include <floatingpoint.h>
12#endif
13
14#include "opcode.h"
15#include "hash.h"
16#include "inout.h"
17#include "table.h"
18#include "lua.h"
19
20#define tonumber(o) ((tag(o) != T_NUMBER) && (lua_tonumber(o) != 0))
21#define tostring(o) ((tag(o) != T_STRING) && (lua_tostring(o) != 0))
22
23#ifndef MAXSTACK
24#define MAXSTACK 256
25#endif
26static Object stack[MAXSTACK] = {{T_MARK, {NULL}}};
27static Object *top=stack+1, *base=stack+1;
28
29
30/*
31** Concatenate two given string, creating a mark space at the beginning.
32** Return the new string pointer.
33*/
34static char *lua_strconc (char *l, char *r)
35{
36 char *s = calloc (strlen(l)+strlen(r)+2, sizeof(char));
37 if (s == NULL)
38 {
39 lua_error ("not enough memory");
40 return NULL;
41 }
42 *s++ = 0; /* create mark space */
43 return strcat(strcpy(s,l),r);
44}
45
46/*
47** Duplicate a string, creating a mark space at the beginning.
48** Return the new string pointer.
49*/
50char *lua_strdup (char *l)
51{
52 char *s = calloc (strlen(l)+2, sizeof(char));
53 if (s == NULL)
54 {
55 lua_error ("not enough memory");
56 return NULL;
57 }
58 *s++ = 0; /* create mark space */
59 return strcpy(s,l);
60}
61
62/*
63** Convert, if possible, to a number tag.
64** Return 0 in success or not 0 on error.
65*/
66static int lua_tonumber (Object *obj)
67{
68 char *ptr;
69 if (tag(obj) != T_STRING)
70 {
71 lua_reportbug ("unexpected type at conversion to number");
72 return 1;
73 }
74 nvalue(obj) = strtod(svalue(obj), &ptr);
75 if (*ptr)
76 {
77 lua_reportbug ("string to number convertion failed");
78 return 2;
79 }
80 tag(obj) = T_NUMBER;
81 return 0;
82}
83
84/*
85** Test if is possible to convert an object to a number one.
86** If possible, return the converted object, otherwise return nil object.
87*/
88static Object *lua_convtonumber (Object *obj)
89{
90 static Object cvt;
91
92 if (tag(obj) == T_NUMBER)
93 {
94 cvt = *obj;
95 return &cvt;
96 }
97
98 tag(&cvt) = T_NIL;
99 if (tag(obj) == T_STRING)
100 {
101 char *ptr;
102 nvalue(&cvt) = strtod(svalue(obj), &ptr);
103 if (*ptr == 0)
104 tag(&cvt) = T_NUMBER;
105 }
106 return &cvt;
107}
108
109
110
111/*
112** Convert, if possible, to a string tag
113** Return 0 in success or not 0 on error.
114*/
115static int lua_tostring (Object *obj)
116{
117 static char s[256];
118 if (tag(obj) != T_NUMBER)
119 {
120 lua_reportbug ("unexpected type at conversion to string");
121 return 1;
122 }
123 if ((int) nvalue(obj) == nvalue(obj))
124 sprintf (s, "%d", (int) nvalue(obj));
125 else
126 sprintf (s, "%g", nvalue(obj));
127 svalue(obj) = lua_createstring(lua_strdup(s));
128 if (svalue(obj) == NULL)
129 return 1;
130 tag(obj) = T_STRING;
131 return 0;
132}
133
134
135/*
136** Execute the given opcode. Return 0 in success or 1 on error.
137*/
138int lua_execute (Byte *pc)
139{
140 while (1)
141 {
142 switch ((OpCode)*pc++)
143 {
144 case NOP: break;
145
146 case PUSHNIL: tag(top++) = T_NIL; break;
147
148 case PUSH0: tag(top) = T_NUMBER; nvalue(top++) = 0; break;
149 case PUSH1: tag(top) = T_NUMBER; nvalue(top++) = 1; break;
150 case PUSH2: tag(top) = T_NUMBER; nvalue(top++) = 2; break;
151
152 case PUSHBYTE: tag(top) = T_NUMBER; nvalue(top++) = *pc++; break;
153
154 case PUSHWORD:
155 tag(top) = T_NUMBER; nvalue(top++) = *((Word *)(pc)); pc += sizeof(Word);
156 break;
157
158 case PUSHFLOAT:
159 tag(top) = T_NUMBER; nvalue(top++) = *((float *)(pc)); pc += sizeof(float);
160 break;
161 case PUSHSTRING:
162 {
163 int w = *((Word *)(pc));
164 pc += sizeof(Word);
165 tag(top) = T_STRING; svalue(top++) = lua_constant[w];
166 }
167 break;
168
169 case PUSHLOCAL0: *top++ = *(base + 0); break;
170 case PUSHLOCAL1: *top++ = *(base + 1); break;
171 case PUSHLOCAL2: *top++ = *(base + 2); break;
172 case PUSHLOCAL3: *top++ = *(base + 3); break;
173 case PUSHLOCAL4: *top++ = *(base + 4); break;
174 case PUSHLOCAL5: *top++ = *(base + 5); break;
175 case PUSHLOCAL6: *top++ = *(base + 6); break;
176 case PUSHLOCAL7: *top++ = *(base + 7); break;
177 case PUSHLOCAL8: *top++ = *(base + 8); break;
178 case PUSHLOCAL9: *top++ = *(base + 9); break;
179
180 case PUSHLOCAL: *top++ = *(base + (*pc++)); break;
181
182 case PUSHGLOBAL:
183 *top++ = s_object(*((Word *)(pc))); pc += sizeof(Word);
184 break;
185
186 case PUSHINDEXED:
187 --top;
188 if (tag(top-1) != T_ARRAY)
189 {
190 lua_reportbug ("indexed expression not a table");
191 return 1;
192 }
193 {
194 Object *h = lua_hashdefine (avalue(top-1), top);
195 if (h == NULL) return 1;
196 *(top-1) = *h;
197 }
198 break;
199
200 case PUSHMARK: tag(top++) = T_MARK; break;
201
202 case PUSHOBJECT: *top = *(top-3); top++; break;
203
204 case STORELOCAL0: *(base + 0) = *(--top); break;
205 case STORELOCAL1: *(base + 1) = *(--top); break;
206 case STORELOCAL2: *(base + 2) = *(--top); break;
207 case STORELOCAL3: *(base + 3) = *(--top); break;
208 case STORELOCAL4: *(base + 4) = *(--top); break;
209 case STORELOCAL5: *(base + 5) = *(--top); break;
210 case STORELOCAL6: *(base + 6) = *(--top); break;
211 case STORELOCAL7: *(base + 7) = *(--top); break;
212 case STORELOCAL8: *(base + 8) = *(--top); break;
213 case STORELOCAL9: *(base + 9) = *(--top); break;
214
215 case STORELOCAL: *(base + (*pc++)) = *(--top); break;
216
217 case STOREGLOBAL:
218 s_object(*((Word *)(pc))) = *(--top); pc += sizeof(Word);
219 break;
220
221 case STOREINDEXED0:
222 if (tag(top-3) != T_ARRAY)
223 {
224 lua_reportbug ("indexed expression not a table");
225 return 1;
226 }
227 {
228 Object *h = lua_hashdefine (avalue(top-3), top-2);
229 if (h == NULL) return 1;
230 *h = *(top-1);
231 }
232 top -= 3;
233 break;
234
235 case STOREINDEXED:
236 {
237 int n = *pc++;
238 if (tag(top-3-n) != T_ARRAY)
239 {
240 lua_reportbug ("indexed expression not a table");
241 return 1;
242 }
243 {
244 Object *h = lua_hashdefine (avalue(top-3-n), top-2-n);
245 if (h == NULL) return 1;
246 *h = *(top-1);
247 }
248 --top;
249 }
250 break;
251
252 case STOREFIELD:
253 if (tag(top-3) != T_ARRAY)
254 {
255 lua_error ("internal error - table expected");
256 return 1;
257 }
258 *(lua_hashdefine (avalue(top-3), top-2)) = *(top-1);
259 top -= 2;
260 break;
261
262 case ADJUST:
263 {
264 Object *newtop = base + *(pc++);
265 if (top != newtop)
266 {
267 while (top < newtop) tag(top++) = T_NIL;
268 top = newtop;
269 }
270 }
271 break;
272
273 case CREATEARRAY:
274 if (tag(top-1) == T_NIL)
275 nvalue(top-1) = 101;
276 else
277 {
278 if (tonumber(top-1)) return 1;
279 if (nvalue(top-1) <= 0) nvalue(top-1) = 101;
280 }
281 avalue(top-1) = lua_createarray(lua_hashcreate(nvalue(top-1)));
282 if (avalue(top-1) == NULL)
283 return 1;
284 tag(top-1) = T_ARRAY;
285 break;
286
287 case EQOP:
288 {
289 Object *l = top-2;
290 Object *r = top-1;
291 --top;
292 if (tag(l) != tag(r))
293 tag(top-1) = T_NIL;
294 else
295 {
296 switch (tag(l))
297 {
298 case T_NIL: tag(top-1) = T_NUMBER; break;
299 case T_NUMBER: tag(top-1) = (nvalue(l) == nvalue(r)) ? T_NUMBER : T_NIL; break;
300 case T_ARRAY: tag(top-1) = (avalue(l) == avalue(r)) ? T_NUMBER : T_NIL; break;
301 case T_FUNCTION: tag(top-1) = (bvalue(l) == bvalue(r)) ? T_NUMBER : T_NIL; break;
302 case T_CFUNCTION: tag(top-1) = (fvalue(l) == fvalue(r)) ? T_NUMBER : T_NIL; break;
303 case T_USERDATA: tag(top-1) = (uvalue(l) == uvalue(r)) ? T_NUMBER : T_NIL; break;
304 case T_STRING: tag(top-1) = (strcmp (svalue(l), svalue(r)) == 0) ? T_NUMBER : T_NIL; break;
305 case T_MARK: return 1;
306 }
307 }
308 nvalue(top-1) = 1;
309 }
310 break;
311
312 case LTOP:
313 {
314 Object *l = top-2;
315 Object *r = top-1;
316 --top;
317 if (tag(l) == T_NUMBER && tag(r) == T_NUMBER)
318 tag(top-1) = (nvalue(l) < nvalue(r)) ? T_NUMBER : T_NIL;
319 else
320 {
321 if (tostring(l) || tostring(r))
322 return 1;
323 tag(top-1) = (strcmp (svalue(l), svalue(r)) < 0) ? T_NUMBER : T_NIL;
324 }
325 nvalue(top-1) = 1;
326 }
327 break;
328
329 case LEOP:
330 {
331 Object *l = top-2;
332 Object *r = top-1;
333 --top;
334 if (tag(l) == T_NUMBER && tag(r) == T_NUMBER)
335 tag(top-1) = (nvalue(l) <= nvalue(r)) ? T_NUMBER : T_NIL;
336 else
337 {
338 if (tostring(l) || tostring(r))
339 return 1;
340 tag(top-1) = (strcmp (svalue(l), svalue(r)) <= 0) ? T_NUMBER : T_NIL;
341 }
342 nvalue(top-1) = 1;
343 }
344 break;
345
346 case ADDOP:
347 {
348 Object *l = top-2;
349 Object *r = top-1;
350 if (tonumber(r) || tonumber(l))
351 return 1;
352 nvalue(l) += nvalue(r);
353 --top;
354 }
355 break;
356
357 case SUBOP:
358 {
359 Object *l = top-2;
360 Object *r = top-1;
361 if (tonumber(r) || tonumber(l))
362 return 1;
363 nvalue(l) -= nvalue(r);
364 --top;
365 }
366 break;
367
368 case MULTOP:
369 {
370 Object *l = top-2;
371 Object *r = top-1;
372 if (tonumber(r) || tonumber(l))
373 return 1;
374 nvalue(l) *= nvalue(r);
375 --top;
376 }
377 break;
378
379 case DIVOP:
380 {
381 Object *l = top-2;
382 Object *r = top-1;
383 if (tonumber(r) || tonumber(l))
384 return 1;
385 nvalue(l) /= nvalue(r);
386 --top;
387 }
388 break;
389
390 case CONCOP:
391 {
392 Object *l = top-2;
393 Object *r = top-1;
394 if (tostring(r) || tostring(l))
395 return 1;
396 svalue(l) = lua_createstring (lua_strconc(svalue(l),svalue(r)));
397 if (svalue(l) == NULL)
398 return 1;
399 --top;
400 }
401 break;
402
403 case MINUSOP:
404 if (tonumber(top-1))
405 return 1;
406 nvalue(top-1) = - nvalue(top-1);
407 break;
408
409 case NOTOP:
410 tag(top-1) = tag(top-1) == T_NIL ? T_NUMBER : T_NIL;
411 break;
412
413 case ONTJMP:
414 {
415 int n = *((Word *)(pc));
416 pc += sizeof(Word);
417 if (tag(top-1) != T_NIL) pc += n;
418 }
419 break;
420
421 case ONFJMP:
422 {
423 int n = *((Word *)(pc));
424 pc += sizeof(Word);
425 if (tag(top-1) == T_NIL) pc += n;
426 }
427 break;
428
429 case JMP: pc += *((Word *)(pc)) + sizeof(Word); break;
430
431 case UPJMP: pc -= *((Word *)(pc)) - sizeof(Word); break;
432
433 case IFFJMP:
434 {
435 int n = *((Word *)(pc));
436 pc += sizeof(Word);
437 top--;
438 if (tag(top) == T_NIL) pc += n;
439 }
440 break;
441
442 case IFFUPJMP:
443 {
444 int n = *((Word *)(pc));
445 pc += sizeof(Word);
446 top--;
447 if (tag(top) == T_NIL) pc -= n;
448 }
449 break;
450
451 case POP: --top; break;
452
453 case CALLFUNC:
454 {
455 Byte *newpc;
456 Object *b = top-1;
457 while (tag(b) != T_MARK) b--;
458 if (tag(b-1) == T_FUNCTION)
459 {
460 lua_debugline = 0; /* always reset debug flag */
461 newpc = bvalue(b-1);
462 bvalue(b-1) = pc; /* store return code */
463 nvalue(b) = (base-stack); /* store base value */
464 base = b+1;
465 pc = newpc;
466 if (MAXSTACK-(base-stack) < STACKGAP)
467 {
468 lua_error ("stack overflow");
469 return 1;
470 }
471 }
472 else if (tag(b-1) == T_CFUNCTION)
473 {
474 int nparam;
475 lua_debugline = 0; /* always reset debug flag */
476 nvalue(b) = (base-stack); /* store base value */
477 base = b+1;
478 nparam = top-base; /* number of parameters */
479 (fvalue(b-1))(); /* call C function */
480
481 /* shift returned values */
482 {
483 int i;
484 int nretval = top - base - nparam;
485 top = base - 2;
486 base = stack + (int) nvalue(base-1);
487 for (i=0; i<nretval; i++)
488 {
489 *top = *(top+nparam+2);
490 ++top;
491 }
492 }
493 }
494 else
495 {
496 lua_reportbug ("call expression not a function");
497 return 1;
498 }
499 }
500 break;
501
502 case RETCODE:
503 {
504 int i;
505 int shift = *pc++;
506 int nretval = top - base - shift;
507 top = base - 2;
508 pc = bvalue(base-2);
509 base = stack + (int) nvalue(base-1);
510 for (i=0; i<nretval; i++)
511 {
512 *top = *(top+shift+2);
513 ++top;
514 }
515 }
516 break;
517
518 case HALT:
519 return 0; /* success */
520
521 case SETFUNCTION:
522 {
523 int file, func;
524 file = *((Word *)(pc));
525 pc += sizeof(Word);
526 func = *((Word *)(pc));
527 pc += sizeof(Word);
528 if (lua_pushfunction (file, func))
529 return 1;
530 }
531 break;
532
533 case SETLINE:
534 lua_debugline = *((Word *)(pc));
535 pc += sizeof(Word);
536 break;
537
538 case RESET:
539 lua_popfunction ();
540 break;
541
542 default:
543 lua_error ("internal error - opcode didn't match");
544 return 1;
545 }
546 }
547}
548
549
550/*
551** Mark all strings and arrays used by any object stored at stack.
552*/
553void lua_markstack (void)
554{
555 Object *o;
556 for (o = top-1; o >= stack; o--)
557 lua_markobject (o);
558}
559
560/*
561** Open file, generate opcode and execute global statement. Return 0 on
562** success or 1 on error.
563*/
564int lua_dofile (char *filename)
565{
566 if (lua_openfile (filename)) return 1;
567 if (lua_parse ()) { lua_closefile (); return 1; }
568 lua_closefile ();
569 return 0;
570}
571
572/*
573** Generate opcode stored on string and execute global statement. Return 0 on
574** success or 1 on error.
575*/
576int lua_dostring (char *string)
577{
578 if (lua_openstring (string)) return 1;
579 if (lua_parse ()) return 1;
580 return 0;
581}
582
583/*
584** Execute the given function. Return 0 on success or 1 on error.
585*/
586int lua_call (char *functionname, int nparam)
587{
588 static Byte startcode[] = {CALLFUNC, HALT};
589 int i;
590 Object func = s_object(lua_findsymbol(functionname));
591 if (tag(&func) != T_FUNCTION) return 1;
592 for (i=1; i<=nparam; i++)
593 *(top-i+2) = *(top-i);
594 top += 2;
595 tag(top-nparam-1) = T_MARK;
596 *(top-nparam-2) = func;
597 return (lua_execute (startcode));
598}
599
600/*
601** Get a parameter, returning the object handle or NULL on error.
602** 'number' must be 1 to get the first parameter.
603*/
604Object *lua_getparam (int number)
605{
606 if (number <= 0 || number > top-base) return NULL;
607 return (base+number-1);
608}
609
610/*
611** Given an object handle, return its number value. On error, return 0.0.
612*/
613real lua_getnumber (Object *object)
614{
615 if (tonumber (object)) return 0.0;
616 else return (nvalue(object));
617}
618
619/*
620** Given an object handle, return its string pointer. On error, return NULL.
621*/
622char *lua_getstring (Object *object)
623{
624 if (tostring (object)) return NULL;
625 else return (svalue(object));
626}
627
628/*
629** Given an object handle, return a copy of its string. On error, return NULL.
630*/
631char *lua_copystring (Object *object)
632{
633 if (tostring (object)) return NULL;
634 else return (strdup(svalue(object)));
635}
636
637/*
638** Given an object handle, return its cfuntion pointer. On error, return NULL.
639*/
640lua_CFunction lua_getcfunction (Object *object)
641{
642 if (tag(object) != T_CFUNCTION) return NULL;
643 else return (fvalue(object));
644}
645
646/*
647** Given an object handle, return its user data. On error, return NULL.
648*/
649void *lua_getuserdata (Object *object)
650{
651 if (tag(object) != T_USERDATA) return NULL;
652 else return (uvalue(object));
653}
654
655/*
656** Given an object handle and a field name, return its field object.
657** On error, return NULL.
658*/
659Object *lua_getfield (Object *object, char *field)
660{
661 if (tag(object) != T_ARRAY)
662 return NULL;
663 else
664 {
665 Object ref;
666 tag(&ref) = T_STRING;
667 svalue(&ref) = lua_createstring(lua_strdup(field));
668 return (lua_hashdefine(avalue(object), &ref));
669 }
670}
671
672/*
673** Given an object handle and an index, return its indexed object.
674** On error, return NULL.
675*/
676Object *lua_getindexed (Object *object, float index)
677{
678 if (tag(object) != T_ARRAY)
679 return NULL;
680 else
681 {
682 Object ref;
683 tag(&ref) = T_NUMBER;
684 nvalue(&ref) = index;
685 return (lua_hashdefine(avalue(object), &ref));
686 }
687}
688
689/*
690** Get a global object. Return the object handle or NULL on error.
691*/
692Object *lua_getglobal (char *name)
693{
694 int n = lua_findsymbol(name);
695 if (n < 0) return NULL;
696 return &s_object(n);
697}
698
699/*
700** Pop and return an object
701*/
702Object *lua_pop (void)
703{
704 if (top <= base) return NULL;
705 top--;
706 return top;
707}
708
709/*
710** Push a nil object
711*/
712int lua_pushnil (void)
713{
714 if ((top-stack) >= MAXSTACK-1)
715 {
716 lua_error ("stack overflow");
717 return 1;
718 }
719 tag(top) = T_NIL;
720 return 0;
721}
722
723/*
724** Push an object (tag=number) to stack. Return 0 on success or 1 on error.
725*/
726int lua_pushnumber (real n)
727{
728 if ((top-stack) >= MAXSTACK-1)
729 {
730 lua_error ("stack overflow");
731 return 1;
732 }
733 tag(top) = T_NUMBER; nvalue(top++) = n;
734 return 0;
735}
736
737/*
738** Push an object (tag=string) to stack. Return 0 on success or 1 on error.
739*/
740int lua_pushstring (char *s)
741{
742 if ((top-stack) >= MAXSTACK-1)
743 {
744 lua_error ("stack overflow");
745 return 1;
746 }
747 tag(top) = T_STRING;
748 svalue(top++) = lua_createstring(lua_strdup(s));
749 return 0;
750}
751
752/*
753** Push an object (tag=cfunction) to stack. Return 0 on success or 1 on error.
754*/
755int lua_pushcfunction (lua_CFunction fn)
756{
757 if ((top-stack) >= MAXSTACK-1)
758 {
759 lua_error ("stack overflow");
760 return 1;
761 }
762 tag(top) = T_CFUNCTION; fvalue(top++) = fn;
763 return 0;
764}
765
766/*
767** Push an object (tag=userdata) to stack. Return 0 on success or 1 on error.
768*/
769int lua_pushuserdata (void *u)
770{
771 if ((top-stack) >= MAXSTACK-1)
772 {
773 lua_error ("stack overflow");
774 return 1;
775 }
776 tag(top) = T_USERDATA; uvalue(top++) = u;
777 return 0;
778}
779
780/*
781** Push an object to stack.
782*/
783int lua_pushobject (Object *o)
784{
785 if ((top-stack) >= MAXSTACK-1)
786 {
787 lua_error ("stack overflow");
788 return 1;
789 }
790 *top++ = *o;
791 return 0;
792}
793
794/*
795** Store top of the stack at a global variable array field.
796** Return 1 on error, 0 on success.
797*/
798int lua_storeglobal (char *name)
799{
800 int n = lua_findsymbol (name);
801 if (n < 0) return 1;
802 if (tag(top-1) == T_MARK) return 1;
803 s_object(n) = *(--top);
804 return 0;
805}
806
807/*
808** Store top of the stack at an array field. Return 1 on error, 0 on success.
809*/
810int lua_storefield (lua_Object object, char *field)
811{
812 if (tag(object) != T_ARRAY)
813 return 1;
814 else
815 {
816 Object ref, *h;
817 tag(&ref) = T_STRING;
818 svalue(&ref) = lua_createstring(lua_strdup(field));
819 h = lua_hashdefine(avalue(object), &ref);
820 if (h == NULL) return 1;
821 if (tag(top-1) == T_MARK) return 1;
822 *h = *(--top);
823 }
824 return 0;
825}
826
827
828/*
829** Store top of the stack at an array index. Return 1 on error, 0 on success.
830*/
831int lua_storeindexed (lua_Object object, float index)
832{
833 if (tag(object) != T_ARRAY)
834 return 1;
835 else
836 {
837 Object ref, *h;
838 tag(&ref) = T_NUMBER;
839 nvalue(&ref) = index;
840 h = lua_hashdefine(avalue(object), &ref);
841 if (h == NULL) return 1;
842 if (tag(top-1) == T_MARK) return 1;
843 *h = *(--top);
844 }
845 return 0;
846}
847
848
849/*
850** Given an object handle, return if it is nil.
851*/
852int lua_isnil (Object *object)
853{
854 return (object != NULL && tag(object) == T_NIL);
855}
856
857/*
858** Given an object handle, return if it is a number one.
859*/
860int lua_isnumber (Object *object)
861{
862 return (object != NULL && tag(object) == T_NUMBER);
863}
864
865/*
866** Given an object handle, return if it is a string one.
867*/
868int lua_isstring (Object *object)
869{
870 return (object != NULL && tag(object) == T_STRING);
871}
872
873/*
874** Given an object handle, return if it is an array one.
875*/
876int lua_istable (Object *object)
877{
878 return (object != NULL && tag(object) == T_ARRAY);
879}
880
881/*
882** Given an object handle, return if it is a cfunction one.
883*/
884int lua_iscfunction (Object *object)
885{
886 return (object != NULL && tag(object) == T_CFUNCTION);
887}
888
889/*
890** Given an object handle, return if it is an user data one.
891*/
892int lua_isuserdata (Object *object)
893{
894 return (object != NULL && tag(object) == T_USERDATA);
895}
896
897/*
898** Internal function: return an object type.
899*/
900void lua_type (void)
901{
902 Object *o = lua_getparam(1);
903 lua_pushstring (lua_constant[tag(o)]);
904}
905
906/*
907** Internal function: convert an object to a number
908*/
909void lua_obj2number (void)
910{
911 Object *o = lua_getparam(1);
912 lua_pushobject (lua_convtonumber(o));
913}
914
915/*
916** Internal function: print object values
917*/
918void lua_print (void)
919{
920 int i=1;
921 void *obj;
922 while ((obj=lua_getparam (i++)) != NULL)
923 {
924 if (lua_isnumber(obj)) printf("%g\n",lua_getnumber (obj));
925 else if (lua_isstring(obj)) printf("%s\n",lua_getstring (obj));
926 else if (lua_iscfunction(obj)) printf("cfunction: %p\n",lua_getcfunction (obj));
927 else if (lua_isuserdata(obj)) printf("userdata: %p\n",lua_getuserdata (obj));
928 else if (lua_istable(obj)) printf("table: %p\n",obj);
929 else if (lua_isnil(obj)) printf("nil\n");
930 else printf("invalid value to print\n");
931 }
932}
933
diff --git a/opcode.h b/opcode.h
new file mode 100644
index 00000000..b32969d5
--- /dev/null
+++ b/opcode.h
@@ -0,0 +1,144 @@
1/*
2** opcode.h
3** TeCGraf - PUC-Rio
4** 16 Apr 92
5*/
6
7#ifndef opcode_h
8#define opcode_h
9
10#ifndef STACKGAP
11#define STACKGAP 128
12#endif
13
14#ifndef real
15#define real float
16#endif
17
18typedef unsigned char Byte;
19
20typedef unsigned short Word;
21
22typedef enum
23{
24 NOP,
25 PUSHNIL,
26 PUSH0, PUSH1, PUSH2,
27 PUSHBYTE,
28 PUSHWORD,
29 PUSHFLOAT,
30 PUSHSTRING,
31 PUSHLOCAL0, PUSHLOCAL1, PUSHLOCAL2, PUSHLOCAL3, PUSHLOCAL4,
32 PUSHLOCAL5, PUSHLOCAL6, PUSHLOCAL7, PUSHLOCAL8, PUSHLOCAL9,
33 PUSHLOCAL,
34 PUSHGLOBAL,
35 PUSHINDEXED,
36 PUSHMARK,
37 PUSHOBJECT,
38 STORELOCAL0, STORELOCAL1, STORELOCAL2, STORELOCAL3, STORELOCAL4,
39 STORELOCAL5, STORELOCAL6, STORELOCAL7, STORELOCAL8, STORELOCAL9,
40 STORELOCAL,
41 STOREGLOBAL,
42 STOREINDEXED0,
43 STOREINDEXED,
44 STOREFIELD,
45 ADJUST,
46 CREATEARRAY,
47 EQOP,
48 LTOP,
49 LEOP,
50 ADDOP,
51 SUBOP,
52 MULTOP,
53 DIVOP,
54 CONCOP,
55 MINUSOP,
56 NOTOP,
57 ONTJMP,
58 ONFJMP,
59 JMP,
60 UPJMP,
61 IFFJMP,
62 IFFUPJMP,
63 POP,
64 CALLFUNC,
65 RETCODE,
66 HALT,
67 SETFUNCTION,
68 SETLINE,
69 RESET
70} OpCode;
71
72typedef enum
73{
74 T_MARK,
75 T_NIL,
76 T_NUMBER,
77 T_STRING,
78 T_ARRAY,
79 T_FUNCTION,
80 T_CFUNCTION,
81 T_USERDATA
82} Type;
83
84typedef void (*Cfunction) (void);
85typedef int (*Input) (void);
86typedef void (*Unput) (int );
87
88typedef union
89{
90 Cfunction f;
91 real n;
92 char *s;
93 Byte *b;
94 struct Hash *a;
95 void *u;
96} Value;
97
98typedef struct Object
99{
100 Type tag;
101 Value value;
102} Object;
103
104typedef struct
105{
106 char *name;
107 Object object;
108} Symbol;
109
110/* Macros to access structure members */
111#define tag(o) ((o)->tag)
112#define nvalue(o) ((o)->value.n)
113#define svalue(o) ((o)->value.s)
114#define bvalue(o) ((o)->value.b)
115#define avalue(o) ((o)->value.a)
116#define fvalue(o) ((o)->value.f)
117#define uvalue(o) ((o)->value.u)
118
119/* Macros to access symbol table */
120#define s_name(i) (lua_table[i].name)
121#define s_object(i) (lua_table[i].object)
122#define s_tag(i) (tag(&s_object(i)))
123#define s_nvalue(i) (nvalue(&s_object(i)))
124#define s_svalue(i) (svalue(&s_object(i)))
125#define s_bvalue(i) (bvalue(&s_object(i)))
126#define s_avalue(i) (avalue(&s_object(i)))
127#define s_fvalue(i) (fvalue(&s_object(i)))
128#define s_uvalue(i) (uvalue(&s_object(i)))
129
130
131/* Exported functions */
132int lua_execute (Byte *pc);
133void lua_markstack (void);
134char *lua_strdup (char *l);
135
136void lua_setinput (Input fn); /* from "lua.lex" module */
137void lua_setunput (Unput fn); /* from "lua.lex" module */
138char *lua_lasttext (void); /* from "lua.lex" module */
139int lua_parse (void); /* from "lua.stx" module */
140void lua_type (void);
141void lua_obj2number (void);
142void lua_print (void);
143
144#endif
diff --git a/strlib.c b/strlib.c
new file mode 100644
index 00000000..efd01e9b
--- /dev/null
+++ b/strlib.c
@@ -0,0 +1,131 @@
1/*
2** strlib.c
3** String library to LUA
4**
5** Waldemar Celes Filho
6** TeCGraf - PUC-Rio
7** 19 May 93
8*/
9
10#include <stdlib.h>
11#include <string.h>
12#include <ctype.h>
13
14
15#include "lua.h"
16
17/*
18** Return the position of the first caracter of a substring into a string
19** LUA interface:
20** n = strfind (string, substring)
21*/
22static void str_find (void)
23{
24 int n;
25 char *s1, *s2;
26 lua_Object o1 = lua_getparam (1);
27 lua_Object o2 = lua_getparam (2);
28 if (!lua_isstring(o1) || !lua_isstring(o2))
29 { lua_error ("incorrect arguments to function `strfind'"); return; }
30 s1 = lua_getstring(o1);
31 s2 = lua_getstring(o2);
32 n = strstr(s1,s2) - s1 + 1;
33 lua_pushnumber (n);
34}
35
36/*
37** Return the string length
38** LUA interface:
39** n = strlen (string)
40*/
41static void str_len (void)
42{
43 lua_Object o = lua_getparam (1);
44 if (!lua_isstring(o))
45 { lua_error ("incorrect arguments to function `strlen'"); return; }
46 lua_pushnumber(strlen(lua_getstring(o)));
47}
48
49
50/*
51** Return the substring of a string, from start to end
52** LUA interface:
53** substring = strsub (string, start, end)
54*/
55static void str_sub (void)
56{
57 int start, end;
58 char *s;
59 lua_Object o1 = lua_getparam (1);
60 lua_Object o2 = lua_getparam (2);
61 lua_Object o3 = lua_getparam (3);
62 if (!lua_isstring(o1) || !lua_isnumber(o2) || !lua_isnumber(o3))
63 { lua_error ("incorrect arguments to function `strsub'"); return; }
64 s = strdup (lua_getstring(o1));
65 start = lua_getnumber (o2);
66 end = lua_getnumber (o3);
67 if (end < start || start < 1 || end > strlen(s))
68 lua_pushstring ("");
69 else
70 {
71 s[end] = 0;
72 lua_pushstring (&s[start-1]);
73 }
74 free (s);
75}
76
77/*
78** Convert a string to lower case.
79** LUA interface:
80** lowercase = strlower (string)
81*/
82static void str_lower (void)
83{
84 char *s, *c;
85 lua_Object o = lua_getparam (1);
86 if (!lua_isstring(o))
87 { lua_error ("incorrect arguments to function `strlower'"); return; }
88 c = s = strdup(lua_getstring(o));
89 while (*c != 0)
90 {
91 *c = tolower(*c);
92 c++;
93 }
94 lua_pushstring(s);
95 free(s);
96}
97
98
99/*
100** Convert a string to upper case.
101** LUA interface:
102** uppercase = strupper (string)
103*/
104static void str_upper (void)
105{
106 char *s, *c;
107 lua_Object o = lua_getparam (1);
108 if (!lua_isstring(o))
109 { lua_error ("incorrect arguments to function `strlower'"); return; }
110 c = s = strdup(lua_getstring(o));
111 while (*c != 0)
112 {
113 *c = toupper(*c);
114 c++;
115 }
116 lua_pushstring(s);
117 free(s);
118}
119
120
121/*
122** Open string library
123*/
124void strlib_open (void)
125{
126 lua_register ("strfind", str_find);
127 lua_register ("strlen", str_len);
128 lua_register ("strsub", str_sub);
129 lua_register ("strlower", str_lower);
130 lua_register ("strupper", str_upper);
131}
diff --git a/table.c b/table.c
new file mode 100644
index 00000000..3bae7ebd
--- /dev/null
+++ b/table.c
@@ -0,0 +1,351 @@
1/*
2** table.c
3** Module to control static tables
4** TeCGraf - PUC-Rio
5** 11 May 93
6*/
7
8#include <stdlib.h>
9#include <string.h>
10
11#include "opcode.h"
12#include "hash.h"
13#include "inout.h"
14#include "table.h"
15#include "lua.h"
16
17#define streq(s1,s2) (strcmp(s1,s2)==0)
18
19#ifndef MAXSYMBOL
20#define MAXSYMBOL 512
21#endif
22static Symbol tablebuffer[MAXSYMBOL] = {
23 {"type",{T_CFUNCTION,{lua_type}}},
24 {"tonumber",{T_CFUNCTION,{lua_obj2number}}},
25 {"next",{T_CFUNCTION,{lua_next}}},
26 {"nextvar",{T_CFUNCTION,{lua_nextvar}}},
27 {"print",{T_CFUNCTION,{lua_print}}}
28 };
29Symbol *lua_table=tablebuffer;
30Word lua_ntable=5;
31
32#ifndef MAXCONSTANT
33#define MAXCONSTANT 256
34#endif
35static char *constantbuffer[MAXCONSTANT] = {"mark","nil","number",
36 "string","table",
37 "function","cfunction"
38 };
39char **lua_constant = constantbuffer;
40Word lua_nconstant=T_CFUNCTION+1;
41
42#ifndef MAXSTRING
43#define MAXSTRING 512
44#endif
45static char *stringbuffer[MAXSTRING];
46char **lua_string = stringbuffer;
47Word lua_nstring=0;
48
49#ifndef MAXARRAY
50#define MAXARRAY 512
51#endif
52static Hash *arraybuffer[MAXARRAY];
53Hash **lua_array = arraybuffer;
54Word lua_narray=0;
55
56#define MAXFILE 20
57char *lua_file[MAXFILE];
58int lua_nfile;
59
60
61/*
62** Given a name, search it at symbol table and return its index. If not
63** found, allocate at end of table, checking oveflow and return its index.
64** On error, return -1.
65*/
66int lua_findsymbol (char *s)
67{
68 int i;
69 for (i=0; i<lua_ntable; i++)
70 if (streq(s,s_name(i)))
71 return i;
72 if (lua_ntable >= MAXSYMBOL-1)
73 {
74 lua_error ("symbol table overflow");
75 return -1;
76 }
77 s_name(lua_ntable) = strdup(s);
78 if (s_name(lua_ntable) == NULL)
79 {
80 lua_error ("not enough memory");
81 return -1;
82 }
83 s_tag(lua_ntable++) = T_NIL;
84
85 return (lua_ntable-1);
86}
87
88/*
89** Given a constant string, eliminate its delimeters (" or '), search it at
90** constant table and return its index. If not found, allocate at end of
91** the table, checking oveflow and return its index.
92**
93** For each allocation, the function allocate a extra char to be used to
94** mark used string (it's necessary to deal with constant and string
95** uniformily). The function store at the table the second position allocated,
96** that represents the beginning of the real string. On error, return -1.
97**
98*/
99int lua_findenclosedconstant (char *s)
100{
101 int i, j, l=strlen(s);
102 char *c = calloc (l, sizeof(char)); /* make a copy */
103
104 c++; /* create mark space */
105
106 /* introduce scape characters */
107 for (i=1,j=0; i<l-1; i++)
108 {
109 if (s[i] == '\\')
110 {
111 switch (s[++i])
112 {
113 case 'n': c[j++] = '\n'; break;
114 case 't': c[j++] = '\t'; break;
115 case 'r': c[j++] = '\r'; break;
116 default : c[j++] = '\\'; c[j++] = c[i]; break;
117 }
118 }
119 else
120 c[j++] = s[i];
121 }
122 c[j++] = 0;
123
124 for (i=0; i<lua_nconstant; i++)
125 if (streq(c,lua_constant[i]))
126 {
127 free (c-1);
128 return i;
129 }
130 if (lua_nconstant >= MAXCONSTANT-1)
131 {
132 lua_error ("lua: constant string table overflow");
133 return -1;
134 }
135 lua_constant[lua_nconstant++] = c;
136 return (lua_nconstant-1);
137}
138
139/*
140** Given a constant string, search it at constant table and return its index.
141** If not found, allocate at end of the table, checking oveflow and return
142** its index.
143**
144** For each allocation, the function allocate a extra char to be used to
145** mark used string (it's necessary to deal with constant and string
146** uniformily). The function store at the table the second position allocated,
147** that represents the beginning of the real string. On error, return -1.
148**
149*/
150int lua_findconstant (char *s)
151{
152 int i;
153 for (i=0; i<lua_nconstant; i++)
154 if (streq(s,lua_constant[i]))
155 return i;
156 if (lua_nconstant >= MAXCONSTANT-1)
157 {
158 lua_error ("lua: constant string table overflow");
159 return -1;
160 }
161 {
162 char *c = calloc(strlen(s)+2,sizeof(char));
163 c++; /* create mark space */
164 lua_constant[lua_nconstant++] = strcpy(c,s);
165 }
166 return (lua_nconstant-1);
167}
168
169
170/*
171** Mark an object if it is a string or a unmarked array.
172*/
173void lua_markobject (Object *o)
174{
175 if (tag(o) == T_STRING)
176 lua_markstring (svalue(o)) = 1;
177 else if (tag(o) == T_ARRAY && markarray(avalue(o)) == 0)
178 lua_hashmark (avalue(o));
179}
180
181/*
182** Mark all strings and arrays used by any object stored at symbol table.
183*/
184static void lua_marktable (void)
185{
186 int i;
187 for (i=0; i<lua_ntable; i++)
188 lua_markobject (&s_object(i));
189}
190
191/*
192** Simulate a garbage colection. When string table or array table overflows,
193** this function check if all allocated strings and arrays are in use. If
194** there are unused ones, pack (compress) the tables.
195*/
196static void lua_pack (void)
197{
198 lua_markstack ();
199 lua_marktable ();
200
201 { /* pack string */
202 int i, j;
203 for (i=j=0; i<lua_nstring; i++)
204 if (lua_markstring(lua_string[i]) == 1)
205 {
206 lua_string[j++] = lua_string[i];
207 lua_markstring(lua_string[i]) = 0;
208 }
209 else
210 {
211 free (lua_string[i]-1);
212 }
213 lua_nstring = j;
214 }
215
216 { /* pack array */
217 int i, j;
218 for (i=j=0; i<lua_narray; i++)
219 if (markarray(lua_array[i]) == 1)
220 {
221 lua_array[j++] = lua_array[i];
222 markarray(lua_array[i]) = 0;
223 }
224 else
225 {
226 lua_hashdelete (lua_array[i]);
227 }
228 lua_narray = j;
229 }
230}
231
232/*
233** Allocate a new string at string table. The given string is already
234** allocated with mark space and the function puts it at the end of the
235** table, checking overflow, and returns its own pointer, or NULL on error.
236*/
237char *lua_createstring (char *s)
238{
239 if (s == NULL) return NULL;
240
241 if (lua_nstring >= MAXSTRING-1)
242 {
243 lua_pack ();
244 if (lua_nstring >= MAXSTRING-1)
245 {
246 lua_error ("string table overflow");
247 return NULL;
248 }
249 }
250 lua_string[lua_nstring++] = s;
251 return s;
252}
253
254/*
255** Allocate a new array, already created, at array table. The function puts
256** it at the end of the table, checking overflow, and returns its own pointer,
257** or NULL on error.
258*/
259void *lua_createarray (void *a)
260{
261 if (a == NULL) return NULL;
262
263 if (lua_narray >= MAXARRAY-1)
264 {
265 lua_pack ();
266 if (lua_narray >= MAXARRAY-1)
267 {
268 lua_error ("indexed table overflow");
269 return NULL;
270 }
271 }
272 lua_array[lua_narray++] = a;
273 return a;
274}
275
276
277/*
278** Add a file name at file table, checking overflow. This function also set
279** the external variable "lua_filename" with the function filename set.
280** Return 0 on success or 1 on error.
281*/
282int lua_addfile (char *fn)
283{
284 if (lua_nfile >= MAXFILE-1)
285 {
286 lua_error ("too many files");
287 return 1;
288 }
289 if ((lua_file[lua_nfile++] = strdup (fn)) == NULL)
290 {
291 lua_error ("not enough memory");
292 return 1;
293 }
294 return 0;
295}
296
297/*
298** Return the last file name set.
299*/
300char *lua_filename (void)
301{
302 return lua_file[lua_nfile-1];
303}
304
305/*
306** Internal function: return next global variable
307*/
308void lua_nextvar (void)
309{
310 int index;
311 Object *o = lua_getparam (1);
312 if (o == NULL)
313 { lua_error ("too few arguments to function `nextvar'"); return; }
314 if (lua_getparam (2) != NULL)
315 { lua_error ("too many arguments to function `nextvar'"); return; }
316 if (tag(o) == T_NIL)
317 {
318 index = 0;
319 }
320 else if (tag(o) != T_STRING)
321 {
322 lua_error ("incorrect argument to function `nextvar'");
323 return;
324 }
325 else
326 {
327 for (index=0; index<lua_ntable; index++)
328 if (streq(s_name(index),svalue(o))) break;
329 if (index == lua_ntable)
330 {
331 lua_error ("name not found in function `nextvar'");
332 return;
333 }
334 index++;
335 while (index < lua_ntable-1 && tag(&s_object(index)) == T_NIL) index++;
336
337 if (index == lua_ntable-1)
338 {
339 lua_pushnil();
340 lua_pushnil();
341 return;
342 }
343 }
344 {
345 Object name;
346 tag(&name) = T_STRING;
347 svalue(&name) = lua_createstring(lua_strdup(s_name(index)));
348 if (lua_pushobject (&name)) return;
349 if (lua_pushobject (&s_object(index))) return;
350 }
351}
diff --git a/table.h b/table.h
new file mode 100644
index 00000000..8406ee22
--- /dev/null
+++ b/table.h
@@ -0,0 +1,39 @@
1/*
2** table.c
3** Module to control static tables
4** TeCGraf - PUC-Rio
5** 11 May 93
6*/
7
8#ifndef table_h
9#define table_h
10
11extern Symbol *lua_table;
12extern Word lua_ntable;
13
14extern char **lua_constant;
15extern Word lua_nconstant;
16
17extern char **lua_string;
18extern Word lua_nstring;
19
20extern Hash **lua_array;
21extern Word lua_narray;
22
23extern char *lua_file[];
24extern int lua_nfile;
25
26#define lua_markstring(s) (*((s)-1))
27
28
29int lua_findsymbol (char *s);
30int lua_findenclosedconstant (char *s);
31int lua_findconstant (char *s);
32void lua_markobject (Object *o);
33char *lua_createstring (char *s);
34void *lua_createarray (void *a);
35int lua_addfile (char *fn);
36char *lua_filename (void);
37void lua_nextvar (void);
38
39#endif
diff --git a/y_tab.c b/y_tab.c
new file mode 100644
index 00000000..d34d2147
--- /dev/null
+++ b/y_tab.c
@@ -0,0 +1,1639 @@
1# line 2 "lua.stx"
2
3#include <stdio.h>
4#include <stdlib.h>
5#include <string.h>
6
7#include "opcode.h"
8#include "hash.h"
9#include "inout.h"
10#include "table.h"
11#include "lua.h"
12
13#ifndef ALIGNMENT
14#define ALIGNMENT (sizeof(void *))
15#endif
16
17#ifndef MAXCODE
18#define MAXCODE 1024
19#endif
20static long buffer[MAXCODE];
21static Byte *code = (Byte *)buffer;
22static long mainbuffer[MAXCODE];
23static Byte *maincode = (Byte *)mainbuffer;
24static Byte *basepc;
25static Byte *pc;
26
27#define MAXVAR 32
28static long varbuffer[MAXVAR];
29static Byte nvarbuffer=0; /* number of variables at a list */
30
31static Word localvar[STACKGAP];
32static Byte nlocalvar=0; /* number of local variables */
33static int ntemp; /* number of temporary var into stack */
34static int err; /* flag to indicate error */
35
36/* Internal functions */
37#define align(n) align_n(sizeof(n))
38
39static void code_byte (Byte c)
40{
41 if (pc-basepc>MAXCODE-1)
42 {
43 lua_error ("code buffer overflow");
44 err = 1;
45 }
46 *pc++ = c;
47}
48
49static void code_word (Word n)
50{
51 if (pc-basepc>MAXCODE-sizeof(Word))
52 {
53 lua_error ("code buffer overflow");
54 err = 1;
55 }
56 *((Word *)pc) = n;
57 pc += sizeof(Word);
58}
59
60static void code_float (float n)
61{
62 if (pc-basepc>MAXCODE-sizeof(float))
63 {
64 lua_error ("code buffer overflow");
65 err = 1;
66 }
67 *((float *)pc) = n;
68 pc += sizeof(float);
69}
70
71static void incr_ntemp (void)
72{
73 if (ntemp+nlocalvar+MAXVAR+1 < STACKGAP)
74 ntemp++;
75 else
76 {
77 lua_error ("stack overflow");
78 err = 1;
79 }
80}
81
82static void incr_nlocalvar (void)
83{
84 if (ntemp+nlocalvar+MAXVAR+1 < STACKGAP)
85 nlocalvar++;
86 else
87 {
88 lua_error ("too many local variables or expression too complicate");
89 err = 1;
90 }
91}
92
93static void incr_nvarbuffer (void)
94{
95 if (nvarbuffer < MAXVAR-1)
96 nvarbuffer++;
97 else
98 {
99 lua_error ("variable buffer overflow");
100 err = 1;
101 }
102}
103
104static void align_n (unsigned size)
105{
106 if (size > ALIGNMENT) size = ALIGNMENT;
107 while (((pc+1-code)%size) != 0) /* +1 to include BYTECODE */
108 code_byte (NOP);
109}
110
111static void code_number (float f)
112{ int i = f;
113 if (f == i) /* f has an integer value */
114 {
115 if (i <= 2) code_byte(PUSH0 + i);
116 else if (i <= 255)
117 {
118 code_byte(PUSHBYTE);
119 code_byte(i);
120 }
121 else
122 {
123 align(Word);
124 code_byte(PUSHWORD);
125 code_word(i);
126 }
127 }
128 else
129 {
130 align(float);
131 code_byte(PUSHFLOAT);
132 code_float(f);
133 }
134 incr_ntemp();
135}
136
137
138# line 140 "lua.stx"
139typedef union
140{
141 int vInt;
142 long vLong;
143 float vFloat;
144 Word vWord;
145 Byte *pByte;
146} YYSTYPE;
147# define NIL 257
148# define IF 258
149# define THEN 259
150# define ELSE 260
151# define ELSEIF 261
152# define WHILE 262
153# define DO 263
154# define REPEAT 264
155# define UNTIL 265
156# define END 266
157# define RETURN 267
158# define LOCAL 268
159# define NUMBER 269
160# define FUNCTION 270
161# define NAME 271
162# define STRING 272
163# define DEBUG 273
164# define NOT 274
165# define AND 275
166# define OR 276
167# define NE 277
168# define LE 278
169# define GE 279
170# define CONC 280
171# define UNARY 281
172#define yyclearin yychar = -1
173#define yyerrok yyerrflag = 0
174extern int yychar;
175extern int yyerrflag;
176#ifndef YYMAXDEPTH
177#define YYMAXDEPTH 150
178#endif
179YYSTYPE yylval, yyval;
180# define YYERRCODE 256
181
182# line 530 "lua.stx"
183
184
185/*
186** Search a local name and if find return its index. If do not find return -1
187*/
188static int lua_localname (Word n)
189{
190 int i;
191 for (i=nlocalvar-1; i >= 0; i--)
192 if (n == localvar[i]) return i; /* local var */
193 return -1; /* global var */
194}
195
196/*
197** Push a variable given a number. If number is positive, push global variable
198** indexed by (number -1). If negative, push local indexed by ABS(number)-1.
199** Otherwise, if zero, push indexed variable (record).
200*/
201static void lua_pushvar (long number)
202{
203 if (number > 0) /* global var */
204 {
205 align(Word);
206 code_byte(PUSHGLOBAL);
207 code_word(number-1);
208 incr_ntemp();
209 }
210 else if (number < 0) /* local var */
211 {
212 number = (-number) - 1;
213 if (number < 10) code_byte(PUSHLOCAL0 + number);
214 else
215 {
216 code_byte(PUSHLOCAL);
217 code_byte(number);
218 }
219 incr_ntemp();
220 }
221 else
222 {
223 code_byte(PUSHINDEXED);
224 ntemp--;
225 }
226}
227
228static void lua_codeadjust (int n)
229{
230 code_byte(ADJUST);
231 code_byte(n + nlocalvar);
232}
233
234static void lua_codestore (int i)
235{
236 if (varbuffer[i] > 0) /* global var */
237 {
238 align(Word);
239 code_byte(STOREGLOBAL);
240 code_word(varbuffer[i]-1);
241 }
242 else if (varbuffer[i] < 0) /* local var */
243 {
244 int number = (-varbuffer[i]) - 1;
245 if (number < 10) code_byte(STORELOCAL0 + number);
246 else
247 {
248 code_byte(STORELOCAL);
249 code_byte(number);
250 }
251 }
252 else /* indexed var */
253 {
254 int j;
255 int upper=0; /* number of indexed variables upper */
256 int param; /* number of itens until indexed expression */
257 for (j=i+1; j <nvarbuffer; j++)
258 if (varbuffer[j] == 0) upper++;
259 param = upper*2 + i;
260 if (param == 0)
261 code_byte(STOREINDEXED0);
262 else
263 {
264 code_byte(STOREINDEXED);
265 code_byte(param);
266 }
267 }
268}
269
270void yyerror (char *s)
271{
272 static char msg[256];
273 sprintf (msg,"%s near \"%s\" at line %d in file \"%s\"",
274 s, lua_lasttext (), lua_linenumber, lua_filename());
275 lua_error (msg);
276 err = 1;
277}
278
279int yywrap (void)
280{
281 return 1;
282}
283
284
285/*
286** Parse LUA code and execute global statement.
287** Return 0 on success or 1 on error.
288*/
289int lua_parse (void)
290{
291 Byte *initcode = maincode;
292 err = 0;
293 if (yyparse () || (err==1)) return 1;
294 *maincode++ = HALT;
295 if (lua_execute (initcode)) return 1;
296 maincode = initcode;
297 return 0;
298}
299
300
301#if 0
302
303static void PrintCode (void)
304{
305 Byte *p = code;
306 printf ("\n\nCODE\n");
307 while (p != pc)
308 {
309 switch ((OpCode)*p)
310 {
311 case NOP: printf ("%d NOP\n", (p++)-code); break;
312 case PUSHNIL: printf ("%d PUSHNIL\n", (p++)-code); break;
313 case PUSH0: case PUSH1: case PUSH2:
314 printf ("%d PUSH%c\n", p-code, *p-PUSH0+'0');
315 p++;
316 break;
317 case PUSHBYTE:
318 printf ("%d PUSHBYTE %d\n", p-code, *(++p));
319 p++;
320 break;
321 case PUSHWORD:
322 printf ("%d PUSHWORD %d\n", p-code, *((Word *)(p+1)));
323 p += 1 + sizeof(Word);
324 break;
325 case PUSHFLOAT:
326 printf ("%d PUSHFLOAT %f\n", p-code, *((float *)(p+1)));
327 p += 1 + sizeof(float);
328 break;
329 case PUSHSTRING:
330 printf ("%d PUSHSTRING %d\n", p-code, *((Word *)(p+1)));
331 p += 1 + sizeof(Word);
332 break;
333 case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2: case PUSHLOCAL3:
334 case PUSHLOCAL4: case PUSHLOCAL5: case PUSHLOCAL6: case PUSHLOCAL7:
335 case PUSHLOCAL8: case PUSHLOCAL9:
336 printf ("%d PUSHLOCAL%c\n", p-code, *p-PUSHLOCAL0+'0');
337 p++;
338 break;
339 case PUSHLOCAL: printf ("%d PUSHLOCAL %d\n", p-code, *(++p));
340 p++;
341 break;
342 case PUSHGLOBAL:
343 printf ("%d PUSHGLOBAL %d\n", p-code, *((Word *)(p+1)));
344 p += 1 + sizeof(Word);
345 break;
346 case PUSHINDEXED: printf ("%d PUSHINDEXED\n", (p++)-code); break;
347 case PUSHMARK: printf ("%d PUSHMARK\n", (p++)-code); break;
348 case PUSHOBJECT: printf ("%d PUSHOBJECT\n", (p++)-code); break;
349 case STORELOCAL0: case STORELOCAL1: case STORELOCAL2: case STORELOCAL3:
350 case STORELOCAL4: case STORELOCAL5: case STORELOCAL6: case STORELOCAL7:
351 case STORELOCAL8: case STORELOCAL9:
352 printf ("%d STORELOCAL%c\n", p-code, *p-STORELOCAL0+'0');
353 p++;
354 break;
355 case STORELOCAL:
356 printf ("%d STORELOCAK %d\n", p-code, *(++p));
357 p++;
358 break;
359 case STOREGLOBAL:
360 printf ("%d STOREGLOBAL %d\n", p-code, *((Word *)(p+1)));
361 p += 1 + sizeof(Word);
362 break;
363 case STOREINDEXED0: printf ("%d STOREINDEXED0\n", (p++)-code); break;
364 case STOREINDEXED: printf ("%d STOREINDEXED %d\n", p-code, *(++p));
365 p++;
366 break;
367 case STOREFIELD: printf ("%d STOREFIELD\n", (p++)-code); break;
368 case ADJUST:
369 printf ("%d ADJUST %d\n", p-code, *(++p));
370 p++;
371 break;
372 case CREATEARRAY: printf ("%d CREATEARRAY\n", (p++)-code); break;
373 case EQOP: printf ("%d EQOP\n", (p++)-code); break;
374 case LTOP: printf ("%d LTOP\n", (p++)-code); break;
375 case LEOP: printf ("%d LEOP\n", (p++)-code); break;
376 case ADDOP: printf ("%d ADDOP\n", (p++)-code); break;
377 case SUBOP: printf ("%d SUBOP\n", (p++)-code); break;
378 case MULTOP: printf ("%d MULTOP\n", (p++)-code); break;
379 case DIVOP: printf ("%d DIVOP\n", (p++)-code); break;
380 case CONCOP: printf ("%d CONCOP\n", (p++)-code); break;
381 case MINUSOP: printf ("%d MINUSOP\n", (p++)-code); break;
382 case NOTOP: printf ("%d NOTOP\n", (p++)-code); break;
383 case ONTJMP:
384 printf ("%d ONTJMP %d\n", p-code, *((Word *)(p+1)));
385 p += sizeof(Word) + 1;
386 break;
387 case ONFJMP:
388 printf ("%d ONFJMP %d\n", p-code, *((Word *)(p+1)));
389 p += sizeof(Word) + 1;
390 break;
391 case JMP:
392 printf ("%d JMP %d\n", p-code, *((Word *)(p+1)));
393 p += sizeof(Word) + 1;
394 break;
395 case UPJMP:
396 printf ("%d UPJMP %d\n", p-code, *((Word *)(p+1)));
397 p += sizeof(Word) + 1;
398 break;
399 case IFFJMP:
400 printf ("%d IFFJMP %d\n", p-code, *((Word *)(p+1)));
401 p += sizeof(Word) + 1;
402 break;
403 case IFFUPJMP:
404 printf ("%d IFFUPJMP %d\n", p-code, *((Word *)(p+1)));
405 p += sizeof(Word) + 1;
406 break;
407 case POP: printf ("%d POP\n", (p++)-code); break;
408 case CALLFUNC: printf ("%d CALLFUNC\n", (p++)-code); break;
409 case RETCODE:
410 printf ("%d RETCODE %d\n", p-code, *(++p));
411 p++;
412 break;
413 default: printf ("%d Cannot happen\n", (p++)-code); break;
414 }
415 }
416}
417#endif
418
419int yyexca[] ={
420-1, 1,
421 0, -1,
422 -2, 2,
423-1, 19,
424 40, 65,
425 91, 95,
426 46, 97,
427 -2, 92,
428-1, 29,
429 40, 65,
430 91, 95,
431 46, 97,
432 -2, 51,
433-1, 70,
434 275, 33,
435 276, 33,
436 61, 33,
437 277, 33,
438 62, 33,
439 60, 33,
440 278, 33,
441 279, 33,
442 280, 33,
443 43, 33,
444 45, 33,
445 42, 33,
446 47, 33,
447 -2, 68,
448-1, 71,
449 91, 95,
450 46, 97,
451 -2, 93,
452-1, 102,
453 260, 27,
454 261, 27,
455 265, 27,
456 266, 27,
457 267, 27,
458 -2, 11,
459-1, 117,
460 93, 85,
461 -2, 87,
462-1, 122,
463 267, 30,
464 -2, 29,
465-1, 145,
466 275, 33,
467 276, 33,
468 61, 33,
469 277, 33,
470 62, 33,
471 60, 33,
472 278, 33,
473 279, 33,
474 280, 33,
475 43, 33,
476 45, 33,
477 42, 33,
478 47, 33,
479 -2, 70,
480 };
481# define YYNPROD 105
482# define YYLAST 318
483int yyact[]={
484
485 54, 52, 136, 53, 13, 55, 54, 52, 14, 53,
486 15, 55, 5, 166, 18, 6, 129, 21, 47, 46,
487 48, 107, 104, 97, 47, 46, 48, 54, 52, 80,
488 53, 21, 55, 54, 52, 40, 53, 9, 55, 54,
489 52, 158, 53, 160, 55, 47, 46, 48, 159, 101,
490 81, 47, 46, 48, 10, 54, 52, 126, 53, 67,
491 55, 54, 52, 60, 53, 155, 55, 148, 149, 135,
492 147, 108, 150, 47, 46, 48, 73, 23, 75, 47,
493 46, 48, 7, 25, 38, 153, 26, 164, 27, 117,
494 61, 62, 74, 11, 76, 54, 24, 127, 65, 66,
495 55, 37, 154, 151, 103, 111, 72, 28, 93, 94,
496 82, 83, 84, 85, 86, 87, 88, 89, 90, 91,
497 92, 116, 59, 77, 54, 52, 118, 53, 99, 55,
498 110, 95, 64, 44, 70, 109, 29, 33, 105, 106,
499 42, 112, 41, 165, 139, 19, 17, 152, 79, 123,
500 43, 119, 20, 114, 113, 98, 63, 144, 143, 122,
501 68, 39, 36, 130, 35, 120, 12, 8, 102, 125,
502 128, 141, 78, 69, 70, 71, 142, 131, 132, 140,
503 22, 124, 4, 3, 2, 121, 96, 138, 146, 137,
504 134, 157, 133, 115, 16, 1, 0, 0, 0, 0,
505 0, 0, 0, 156, 0, 0, 0, 0, 161, 0,
506 0, 0, 0, 162, 0, 0, 0, 168, 0, 172,
507 145, 163, 171, 0, 174, 0, 0, 0, 169, 156,
508 167, 170, 173, 57, 58, 49, 50, 51, 56, 57,
509 58, 49, 50, 51, 56, 175, 0, 0, 100, 0,
510 45, 0, 0, 0, 0, 70, 0, 0, 0, 0,
511 57, 58, 49, 50, 51, 56, 57, 58, 49, 50,
512 51, 56, 0, 0, 0, 0, 0, 56, 0, 0,
513 0, 0, 0, 0, 0, 0, 0, 0, 57, 58,
514 49, 50, 51, 56, 0, 0, 49, 50, 51, 56,
515 32, 0, 0, 0, 0, 0, 0, 0, 0, 0,
516 0, 0, 30, 0, 21, 31, 0, 34 };
517int yypact[]={
518
519 -1000, -258, -1000, -1000, -1000, -234, -1000, 34, -254, -1000,
520 -1000, -1000, -1000, 43, -1000, -1000, 40, -1000, -236, -1000,
521 -1000, -1000, 93, -9, -1000, 43, 43, 43, 92, -1000,
522 -1000, -1000, -1000, -1000, 43, 43, -1000, 43, -240, 62,
523 31, -13, 48, 83, -242, -1000, 43, 43, 43, 43,
524 43, 43, 43, 43, 43, 43, 43, -1000, -1000, 90,
525 13, -1000, -1000, -248, 43, 19, -15, -216, -1000, 60,
526 -1000, -1000, -249, -1000, -1000, 43, -250, 43, 89, 61,
527 -1000, -1000, -3, -3, -3, -3, -3, -3, 53, 53,
528 -1000, -1000, 82, -1000, -1000, -1000, -2, -1000, 85, 13,
529 -1000, 43, -1000, -1000, 31, 43, -36, -1000, 56, 60,
530 -1000, -255, -1000, 43, 43, -1000, -269, -1000, -1000, -1000,
531 13, 34, -1000, 43, -1000, 13, -1000, -1000, -1000, -1000,
532 -193, 19, 19, -53, 59, -1000, -1000, -8, 58, 43,
533 -1000, -1000, -1000, -1000, -226, -1000, -218, -223, -1000, 43,
534 -1000, -269, 26, -1000, -1000, -1000, 13, -253, 43, -1000,
535 -1000, -1000, -42, -1000, 43, 43, -1000, 34, -1000, 13,
536 -1000, -1000, -1000, -1000, -193, -1000 };
537int yypgo[]={
538
539 0, 195, 50, 96, 71, 135, 194, 193, 192, 190,
540 189, 187, 136, 186, 184, 82, 54, 183, 182, 180,
541 172, 170, 59, 168, 167, 166, 63, 70, 164, 162,
542 137, 161, 160, 159, 158, 157, 156, 155, 154, 153,
543 152, 150, 149, 148, 69, 147, 144, 65, 143, 142,
544 140, 76, 138 };
545int yyr1[]={
546
547 0, 1, 14, 1, 1, 1, 19, 21, 17, 23,
548 23, 24, 15, 16, 16, 25, 28, 25, 29, 25,
549 25, 25, 25, 27, 27, 27, 32, 33, 22, 34,
550 35, 34, 2, 26, 3, 3, 3, 3, 3, 3,
551 3, 3, 3, 3, 3, 3, 3, 3, 36, 3,
552 3, 3, 3, 3, 3, 3, 3, 38, 3, 39,
553 3, 37, 37, 41, 30, 40, 4, 4, 5, 42,
554 5, 20, 20, 43, 43, 13, 13, 7, 7, 8,
555 8, 9, 9, 45, 44, 10, 10, 46, 11, 48,
556 11, 47, 6, 6, 12, 49, 12, 50, 12, 31,
557 31, 51, 52, 51, 18 };
558int yyr2[]={
559
560 0, 0, 1, 9, 4, 4, 1, 1, 19, 0,
561 6, 1, 4, 0, 2, 17, 1, 17, 1, 13,
562 7, 3, 4, 0, 4, 15, 1, 1, 9, 0,
563 1, 9, 1, 3, 7, 7, 7, 7, 7, 7,
564 7, 7, 7, 7, 7, 7, 5, 5, 1, 9,
565 9, 3, 3, 3, 3, 3, 5, 1, 11, 1,
566 11, 1, 2, 1, 11, 3, 1, 3, 3, 1,
567 9, 0, 2, 3, 7, 1, 3, 7, 7, 1,
568 3, 3, 7, 1, 9, 1, 3, 1, 5, 1,
569 9, 3, 3, 7, 3, 1, 11, 1, 9, 5,
570 9, 1, 1, 6, 3 };
571int yychk[]={
572
573 -1000, -1, -14, -17, -18, 270, 273, -15, -24, 271,
574 -16, 59, -25, 258, 262, 264, -6, -30, 268, -12,
575 -40, 271, -19, -26, -3, 40, 43, 45, 64, -12,
576 269, 272, 257, -30, 274, -28, -29, 61, 44, -31,
577 271, -49, -50, -41, 40, 259, 61, 60, 62, 277,
578 278, 279, 43, 45, 42, 47, 280, 275, 276, -3,
579 -26, -26, -26, -36, 40, -26, -26, -22, -32, -5,
580 -3, -12, 44, -51, 61, 91, 46, 40, -20, -43,
581 271, -2, -26, -26, -26, -26, -26, -26, -26, -26,
582 -26, -26, -26, -2, -2, 41, -13, 271, -37, -26,
583 263, 265, -23, 44, 271, -52, -26, 271, -4, -5,
584 41, 44, -22, -38, -39, -7, 123, 91, 41, -2,
585 -26, -15, -33, -42, -51, -26, 93, 41, -21, 271,
586 -2, -26, -26, -8, -9, -44, 271, -10, -11, -46,
587 -22, -2, -16, -34, -35, -3, -22, -27, 260, 261,
588 125, 44, -45, 93, 44, -47, -26, -2, 267, 266,
589 266, -22, -26, -44, 61, -48, 266, -4, 259, -26,
590 -47, -16, -2, -22, -2, -27 };
591int yydef[]={
592
593 1, -2, 11, 4, 5, 0, 104, 13, 0, 6,
594 3, 14, 12, 0, 16, 18, 0, 21, 0, -2,
595 63, 94, 0, 0, 33, 0, 0, 0, 48, -2,
596 52, 53, 54, 55, 0, 0, 26, 0, 0, 22,
597 101, 0, 0, 0, 71, 32, 0, 0, 0, 0,
598 0, 0, 0, 0, 0, 0, 0, 32, 32, 33,
599 0, 46, 47, 75, 61, 56, 0, 0, 9, 20,
600 -2, -2, 0, 99, 102, 0, 0, 66, 0, 72,
601 73, 26, 35, 36, 37, 38, 39, 40, 41, 42,
602 43, 44, 45, 57, 59, 34, 0, 76, 0, 62,
603 32, 0, -2, 69, 101, 0, 0, 98, 0, 67,
604 7, 0, 32, 0, 0, 49, 79, -2, 50, 26,
605 32, 13, -2, 0, 100, 103, 96, 64, 26, 74,
606 23, 58, 60, 0, 80, 81, 83, 0, 86, 0,
607 32, 19, 10, 28, 0, -2, 0, 0, 26, 0,
608 77, 0, 0, 78, 89, 88, 91, 0, 66, 8,
609 15, 24, 0, 82, 0, 0, 17, 13, 32, 84,
610 90, 31, 26, 32, 23, 25 };
611typedef struct { char *t_name; int t_val; } yytoktype;
612#ifndef YYDEBUG
613# define YYDEBUG 0 /* don't allow debugging */
614#endif
615
616#if YYDEBUG
617
618yytoktype yytoks[] =
619{
620 "NIL", 257,
621 "IF", 258,
622 "THEN", 259,
623 "ELSE", 260,
624 "ELSEIF", 261,
625 "WHILE", 262,
626 "DO", 263,
627 "REPEAT", 264,
628 "UNTIL", 265,
629 "END", 266,
630 "RETURN", 267,
631 "LOCAL", 268,
632 "NUMBER", 269,
633 "FUNCTION", 270,
634 "NAME", 271,
635 "STRING", 272,
636 "DEBUG", 273,
637 "NOT", 274,
638 "AND", 275,
639 "OR", 276,
640 "=", 61,
641 "NE", 277,
642 ">", 62,
643 "<", 60,
644 "LE", 278,
645 "GE", 279,
646 "CONC", 280,
647 "+", 43,
648 "-", 45,
649 "*", 42,
650 "/", 47,
651 "%", 37,
652 "UNARY", 281,
653 "-unknown-", -1 /* ends search */
654};
655
656char * yyreds[] =
657{
658 "-no such reduction-",
659 "functionlist : /* empty */",
660 "functionlist : functionlist",
661 "functionlist : functionlist stat sc",
662 "functionlist : functionlist function",
663 "functionlist : functionlist setdebug",
664 "function : FUNCTION NAME",
665 "function : FUNCTION NAME '(' parlist ')'",
666 "function : FUNCTION NAME '(' parlist ')' block END",
667 "statlist : /* empty */",
668 "statlist : statlist stat sc",
669 "stat : /* empty */",
670 "stat : stat1",
671 "sc : /* empty */",
672 "sc : ';'",
673 "stat1 : IF expr1 THEN PrepJump block PrepJump elsepart END",
674 "stat1 : WHILE",
675 "stat1 : WHILE expr1 DO PrepJump block PrepJump END",
676 "stat1 : REPEAT",
677 "stat1 : REPEAT block UNTIL expr1 PrepJump",
678 "stat1 : varlist1 '=' exprlist1",
679 "stat1 : functioncall",
680 "stat1 : LOCAL declist",
681 "elsepart : /* empty */",
682 "elsepart : ELSE block",
683 "elsepart : ELSEIF expr1 THEN PrepJump block PrepJump elsepart",
684 "block : /* empty */",
685 "block : statlist",
686 "block : statlist ret",
687 "ret : /* empty */",
688 "ret : /* empty */",
689 "ret : RETURN exprlist sc",
690 "PrepJump : /* empty */",
691 "expr1 : expr",
692 "expr : '(' expr ')'",
693 "expr : expr1 '=' expr1",
694 "expr : expr1 '<' expr1",
695 "expr : expr1 '>' expr1",
696 "expr : expr1 NE expr1",
697 "expr : expr1 LE expr1",
698 "expr : expr1 GE expr1",
699 "expr : expr1 '+' expr1",
700 "expr : expr1 '-' expr1",
701 "expr : expr1 '*' expr1",
702 "expr : expr1 '/' expr1",
703 "expr : expr1 CONC expr1",
704 "expr : '+' expr1",
705 "expr : '-' expr1",
706 "expr : '@'",
707 "expr : '@' objectname fieldlist",
708 "expr : '@' '(' dimension ')'",
709 "expr : var",
710 "expr : NUMBER",
711 "expr : STRING",
712 "expr : NIL",
713 "expr : functioncall",
714 "expr : NOT expr1",
715 "expr : expr1 AND PrepJump",
716 "expr : expr1 AND PrepJump expr1",
717 "expr : expr1 OR PrepJump",
718 "expr : expr1 OR PrepJump expr1",
719 "dimension : /* empty */",
720 "dimension : expr1",
721 "functioncall : functionvalue",
722 "functioncall : functionvalue '(' exprlist ')'",
723 "functionvalue : var",
724 "exprlist : /* empty */",
725 "exprlist : exprlist1",
726 "exprlist1 : expr",
727 "exprlist1 : exprlist1 ','",
728 "exprlist1 : exprlist1 ',' expr",
729 "parlist : /* empty */",
730 "parlist : parlist1",
731 "parlist1 : NAME",
732 "parlist1 : parlist1 ',' NAME",
733 "objectname : /* empty */",
734 "objectname : NAME",
735 "fieldlist : '{' ffieldlist '}'",
736 "fieldlist : '[' lfieldlist ']'",
737 "ffieldlist : /* empty */",
738 "ffieldlist : ffieldlist1",
739 "ffieldlist1 : ffield",
740 "ffieldlist1 : ffieldlist1 ',' ffield",
741 "ffield : NAME",
742 "ffield : NAME '=' expr1",
743 "lfieldlist : /* empty */",
744 "lfieldlist : lfieldlist1",
745 "lfieldlist1 : /* empty */",
746 "lfieldlist1 : lfield",
747 "lfieldlist1 : lfieldlist1 ','",
748 "lfieldlist1 : lfieldlist1 ',' lfield",
749 "lfield : expr1",
750 "varlist1 : var",
751 "varlist1 : varlist1 ',' var",
752 "var : NAME",
753 "var : var",
754 "var : var '[' expr1 ']'",
755 "var : var",
756 "var : var '.' NAME",
757 "declist : NAME init",
758 "declist : declist ',' NAME init",
759 "init : /* empty */",
760 "init : '='",
761 "init : '=' expr1",
762 "setdebug : DEBUG",
763};
764#endif /* YYDEBUG */
765#line 1 "/usr/lib/yaccpar"
766/* @(#)yaccpar 1.10 89/04/04 SMI; from S5R3 1.10 */
767
768/*
769** Skeleton parser driver for yacc output
770*/
771
772/*
773** yacc user known macros and defines
774*/
775#define YYERROR goto yyerrlab
776#define YYACCEPT { free(yys); free(yyv); return(0); }
777#define YYABORT { free(yys); free(yyv); return(1); }
778#define YYBACKUP( newtoken, newvalue )\
779{\
780 if ( yychar >= 0 || ( yyr2[ yytmp ] >> 1 ) != 1 )\
781 {\
782 yyerror( "syntax error - cannot backup" );\
783 goto yyerrlab;\
784 }\
785 yychar = newtoken;\
786 yystate = *yyps;\
787 yylval = newvalue;\
788 goto yynewstate;\
789}
790#define YYRECOVERING() (!!yyerrflag)
791#ifndef YYDEBUG
792# define YYDEBUG 1 /* make debugging available */
793#endif
794
795/*
796** user known globals
797*/
798int yydebug; /* set to 1 to get debugging */
799
800/*
801** driver internal defines
802*/
803#define YYFLAG (-1000)
804
805/*
806** static variables used by the parser
807*/
808static YYSTYPE *yyv; /* value stack */
809static int *yys; /* state stack */
810
811static YYSTYPE *yypv; /* top of value stack */
812static int *yyps; /* top of state stack */
813
814static int yystate; /* current state */
815static int yytmp; /* extra var (lasts between blocks) */
816
817int yynerrs; /* number of errors */
818
819int yyerrflag; /* error recovery flag */
820int yychar; /* current input token number */
821
822
823/*
824** yyparse - return 0 if worked, 1 if syntax error not recovered from
825*/
826int
827yyparse()
828{
829 register YYSTYPE *yypvt; /* top of value stack for $vars */
830 unsigned yymaxdepth = YYMAXDEPTH;
831
832 /*
833 ** Initialize externals - yyparse may be called more than once
834 */
835 yyv = (YYSTYPE*)malloc(yymaxdepth*sizeof(YYSTYPE));
836 yys = (int*)malloc(yymaxdepth*sizeof(int));
837 if (!yyv || !yys)
838 {
839 yyerror( "out of memory" );
840 return(1);
841 }
842 yypv = &yyv[-1];
843 yyps = &yys[-1];
844 yystate = 0;
845 yytmp = 0;
846 yynerrs = 0;
847 yyerrflag = 0;
848 yychar = -1;
849
850 goto yystack;
851 {
852 register YYSTYPE *yy_pv; /* top of value stack */
853 register int *yy_ps; /* top of state stack */
854 register int yy_state; /* current state */
855 register int yy_n; /* internal state number info */
856
857 /*
858 ** get globals into registers.
859 ** branch to here only if YYBACKUP was called.
860 */
861 yynewstate:
862 yy_pv = yypv;
863 yy_ps = yyps;
864 yy_state = yystate;
865 goto yy_newstate;
866
867 /*
868 ** get globals into registers.
869 ** either we just started, or we just finished a reduction
870 */
871 yystack:
872 yy_pv = yypv;
873 yy_ps = yyps;
874 yy_state = yystate;
875
876 /*
877 ** top of for (;;) loop while no reductions done
878 */
879 yy_stack:
880 /*
881 ** put a state and value onto the stacks
882 */
883#if YYDEBUG
884 /*
885 ** if debugging, look up token value in list of value vs.
886 ** name pairs. 0 and negative (-1) are special values.
887 ** Note: linear search is used since time is not a real
888 ** consideration while debugging.
889 */
890 if ( yydebug )
891 {
892 register int yy_i;
893
894 (void)printf( "State %d, token ", yy_state );
895 if ( yychar == 0 )
896 (void)printf( "end-of-file\n" );
897 else if ( yychar < 0 )
898 (void)printf( "-none-\n" );
899 else
900 {
901 for ( yy_i = 0; yytoks[yy_i].t_val >= 0;
902 yy_i++ )
903 {
904 if ( yytoks[yy_i].t_val == yychar )
905 break;
906 }
907 (void)printf( "%s\n", yytoks[yy_i].t_name );
908 }
909 }
910#endif /* YYDEBUG */
911 if ( ++yy_ps >= &yys[ yymaxdepth ] ) /* room on stack? */
912 {
913 /*
914 ** reallocate and recover. Note that pointers
915 ** have to be reset, or bad things will happen
916 */
917 int yyps_index = (yy_ps - yys);
918 int yypv_index = (yy_pv - yyv);
919 int yypvt_index = (yypvt - yyv);
920 yymaxdepth += YYMAXDEPTH;
921 yyv = (YYSTYPE*)realloc((char*)yyv,
922 yymaxdepth * sizeof(YYSTYPE));
923 yys = (int*)realloc((char*)yys,
924 yymaxdepth * sizeof(int));
925 if (!yyv || !yys)
926 {
927 yyerror( "yacc stack overflow" );
928 return(1);
929 }
930 yy_ps = yys + yyps_index;
931 yy_pv = yyv + yypv_index;
932 yypvt = yyv + yypvt_index;
933 }
934 *yy_ps = yy_state;
935 *++yy_pv = yyval;
936
937 /*
938 ** we have a new state - find out what to do
939 */
940 yy_newstate:
941 if ( ( yy_n = yypact[ yy_state ] ) <= YYFLAG )
942 goto yydefault; /* simple state */
943#if YYDEBUG
944 /*
945 ** if debugging, need to mark whether new token grabbed
946 */
947 yytmp = yychar < 0;
948#endif
949 if ( ( yychar < 0 ) && ( ( yychar = yylex() ) < 0 ) )
950 yychar = 0; /* reached EOF */
951#if YYDEBUG
952 if ( yydebug && yytmp )
953 {
954 register int yy_i;
955
956 (void)printf( "Received token " );
957 if ( yychar == 0 )
958 (void)printf( "end-of-file\n" );
959 else if ( yychar < 0 )
960 (void)printf( "-none-\n" );
961 else
962 {
963 for ( yy_i = 0; yytoks[yy_i].t_val >= 0;
964 yy_i++ )
965 {
966 if ( yytoks[yy_i].t_val == yychar )
967 break;
968 }
969 (void)printf( "%s\n", yytoks[yy_i].t_name );
970 }
971 }
972#endif /* YYDEBUG */
973 if ( ( ( yy_n += yychar ) < 0 ) || ( yy_n >= YYLAST ) )
974 goto yydefault;
975 if ( yychk[ yy_n = yyact[ yy_n ] ] == yychar ) /*valid shift*/
976 {
977 yychar = -1;
978 yyval = yylval;
979 yy_state = yy_n;
980 if ( yyerrflag > 0 )
981 yyerrflag--;
982 goto yy_stack;
983 }
984
985 yydefault:
986 if ( ( yy_n = yydef[ yy_state ] ) == -2 )
987 {
988#if YYDEBUG
989 yytmp = yychar < 0;
990#endif
991 if ( ( yychar < 0 ) && ( ( yychar = yylex() ) < 0 ) )
992 yychar = 0; /* reached EOF */
993#if YYDEBUG
994 if ( yydebug && yytmp )
995 {
996 register int yy_i;
997
998 (void)printf( "Received token " );
999 if ( yychar == 0 )
1000 (void)printf( "end-of-file\n" );
1001 else if ( yychar < 0 )
1002 (void)printf( "-none-\n" );
1003 else
1004 {
1005 for ( yy_i = 0;
1006 yytoks[yy_i].t_val >= 0;
1007 yy_i++ )
1008 {
1009 if ( yytoks[yy_i].t_val
1010 == yychar )
1011 {
1012 break;
1013 }
1014 }
1015 (void)printf( "%s\n", yytoks[yy_i].t_name );
1016 }
1017 }
1018#endif /* YYDEBUG */
1019 /*
1020 ** look through exception table
1021 */
1022 {
1023 register int *yyxi = yyexca;
1024
1025 while ( ( *yyxi != -1 ) ||
1026 ( yyxi[1] != yy_state ) )
1027 {
1028 yyxi += 2;
1029 }
1030 while ( ( *(yyxi += 2) >= 0 ) &&
1031 ( *yyxi != yychar ) )
1032 ;
1033 if ( ( yy_n = yyxi[1] ) < 0 )
1034 YYACCEPT;
1035 }
1036 }
1037
1038 /*
1039 ** check for syntax error
1040 */
1041 if ( yy_n == 0 ) /* have an error */
1042 {
1043 /* no worry about speed here! */
1044 switch ( yyerrflag )
1045 {
1046 case 0: /* new error */
1047 yyerror( "syntax error" );
1048 goto skip_init;
1049 yyerrlab:
1050 /*
1051 ** get globals into registers.
1052 ** we have a user generated syntax type error
1053 */
1054 yy_pv = yypv;
1055 yy_ps = yyps;
1056 yy_state = yystate;
1057 yynerrs++;
1058 skip_init:
1059 case 1:
1060 case 2: /* incompletely recovered error */
1061 /* try again... */
1062 yyerrflag = 3;
1063 /*
1064 ** find state where "error" is a legal
1065 ** shift action
1066 */
1067 while ( yy_ps >= yys )
1068 {
1069 yy_n = yypact[ *yy_ps ] + YYERRCODE;
1070 if ( yy_n >= 0 && yy_n < YYLAST &&
1071 yychk[yyact[yy_n]] == YYERRCODE) {
1072 /*
1073 ** simulate shift of "error"
1074 */
1075 yy_state = yyact[ yy_n ];
1076 goto yy_stack;
1077 }
1078 /*
1079 ** current state has no shift on
1080 ** "error", pop stack
1081 */
1082#if YYDEBUG
1083# define _POP_ "Error recovery pops state %d, uncovers state %d\n"
1084 if ( yydebug )
1085 (void)printf( _POP_, *yy_ps,
1086 yy_ps[-1] );
1087# undef _POP_
1088#endif
1089 yy_ps--;
1090 yy_pv--;
1091 }
1092 /*
1093 ** there is no state on stack with "error" as
1094 ** a valid shift. give up.
1095 */
1096 YYABORT;
1097 case 3: /* no shift yet; eat a token */
1098#if YYDEBUG
1099 /*
1100 ** if debugging, look up token in list of
1101 ** pairs. 0 and negative shouldn't occur,
1102 ** but since timing doesn't matter when
1103 ** debugging, it doesn't hurt to leave the
1104 ** tests here.
1105 */
1106 if ( yydebug )
1107 {
1108 register int yy_i;
1109
1110 (void)printf( "Error recovery discards " );
1111 if ( yychar == 0 )
1112 (void)printf( "token end-of-file\n" );
1113 else if ( yychar < 0 )
1114 (void)printf( "token -none-\n" );
1115 else
1116 {
1117 for ( yy_i = 0;
1118 yytoks[yy_i].t_val >= 0;
1119 yy_i++ )
1120 {
1121 if ( yytoks[yy_i].t_val
1122 == yychar )
1123 {
1124 break;
1125 }
1126 }
1127 (void)printf( "token %s\n",
1128 yytoks[yy_i].t_name );
1129 }
1130 }
1131#endif /* YYDEBUG */
1132 if ( yychar == 0 ) /* reached EOF. quit */
1133 YYABORT;
1134 yychar = -1;
1135 goto yy_newstate;
1136 }
1137 }/* end if ( yy_n == 0 ) */
1138 /*
1139 ** reduction by production yy_n
1140 ** put stack tops, etc. so things right after switch
1141 */
1142#if YYDEBUG
1143 /*
1144 ** if debugging, print the string that is the user's
1145 ** specification of the reduction which is just about
1146 ** to be done.
1147 */
1148 if ( yydebug )
1149 (void)printf( "Reduce by (%d) \"%s\"\n",
1150 yy_n, yyreds[ yy_n ] );
1151#endif
1152 yytmp = yy_n; /* value to switch over */
1153 yypvt = yy_pv; /* $vars top of value stack */
1154 /*
1155 ** Look in goto table for next state
1156 ** Sorry about using yy_state here as temporary
1157 ** register variable, but why not, if it works...
1158 ** If yyr2[ yy_n ] doesn't have the low order bit
1159 ** set, then there is no action to be done for
1160 ** this reduction. So, no saving & unsaving of
1161 ** registers done. The only difference between the
1162 ** code just after the if and the body of the if is
1163 ** the goto yy_stack in the body. This way the test
1164 ** can be made before the choice of what to do is needed.
1165 */
1166 {
1167 /* length of production doubled with extra bit */
1168 register int yy_len = yyr2[ yy_n ];
1169
1170 if ( !( yy_len & 01 ) )
1171 {
1172 yy_len >>= 1;
1173 yyval = ( yy_pv -= yy_len )[1]; /* $$ = $1 */
1174 yy_state = yypgo[ yy_n = yyr1[ yy_n ] ] +
1175 *( yy_ps -= yy_len ) + 1;
1176 if ( yy_state >= YYLAST ||
1177 yychk[ yy_state =
1178 yyact[ yy_state ] ] != -yy_n )
1179 {
1180 yy_state = yyact[ yypgo[ yy_n ] ];
1181 }
1182 goto yy_stack;
1183 }
1184 yy_len >>= 1;
1185 yyval = ( yy_pv -= yy_len )[1]; /* $$ = $1 */
1186 yy_state = yypgo[ yy_n = yyr1[ yy_n ] ] +
1187 *( yy_ps -= yy_len ) + 1;
1188 if ( yy_state >= YYLAST ||
1189 yychk[ yy_state = yyact[ yy_state ] ] != -yy_n )
1190 {
1191 yy_state = yyact[ yypgo[ yy_n ] ];
1192 }
1193 }
1194 /* save until reenter driver code */
1195 yystate = yy_state;
1196 yyps = yy_ps;
1197 yypv = yy_pv;
1198 }
1199 /*
1200 ** code supplied by user is placed in this switch
1201 */
1202 switch( yytmp )
1203 {
1204
1205case 2:
1206# line 179 "lua.stx"
1207{pc=basepc=maincode; nlocalvar=0;} break;
1208case 3:
1209# line 179 "lua.stx"
1210{maincode=pc;} break;
1211case 6:
1212# line 184 "lua.stx"
1213{pc=basepc=code; nlocalvar=0;} break;
1214case 7:
1215# line 185 "lua.stx"
1216{
1217 if (lua_debug)
1218 {
1219 align(Word);
1220 code_byte(SETFUNCTION);
1221 code_word(yypvt[-5].vWord);
1222 code_word(yypvt[-4].vWord);
1223 }
1224 lua_codeadjust (0);
1225 } break;
1226case 8:
1227# line 197 "lua.stx"
1228{
1229 if (lua_debug) code_byte(RESET);
1230 code_byte(RETCODE); code_byte(nlocalvar);
1231 s_tag(yypvt[-7].vWord) = T_FUNCTION;
1232 s_bvalue(yypvt[-7].vWord) = calloc (pc-code, sizeof(Byte));
1233 memcpy (s_bvalue(yypvt[-7].vWord), code, (pc-code)*sizeof(Byte));
1234 } break;
1235case 11:
1236# line 210 "lua.stx"
1237{
1238 ntemp = 0;
1239 if (lua_debug)
1240 {
1241 align(Word); code_byte(SETLINE); code_word(lua_linenumber);
1242 }
1243 } break;
1244case 15:
1245# line 223 "lua.stx"
1246{
1247 {
1248 Byte *elseinit = yypvt[-2].pByte + sizeof(Word)+1;
1249 if (pc - elseinit == 0) /* no else */
1250 {
1251 pc -= sizeof(Word)+1;
1252 /* if (*(pc-1) == NOP) --pc; */
1253 elseinit = pc;
1254 }
1255 else
1256 {
1257 *(yypvt[-2].pByte) = JMP;
1258 *((Word *)(yypvt[-2].pByte+1)) = pc - elseinit;
1259 }
1260 *(yypvt[-4].pByte) = IFFJMP;
1261 *((Word *)(yypvt[-4].pByte+1)) = elseinit - (yypvt[-4].pByte + sizeof(Word)+1);
1262 }
1263 } break;
1264case 16:
1265# line 242 "lua.stx"
1266{yyval.pByte = pc;} break;
1267case 17:
1268# line 244 "lua.stx"
1269{
1270 *(yypvt[-3].pByte) = IFFJMP;
1271 *((Word *)(yypvt[-3].pByte+1)) = pc - (yypvt[-3].pByte + sizeof(Word)+1);
1272
1273 *(yypvt[-1].pByte) = UPJMP;
1274 *((Word *)(yypvt[-1].pByte+1)) = pc - yypvt[-6].pByte;
1275 } break;
1276case 18:
1277# line 252 "lua.stx"
1278{yyval.pByte = pc;} break;
1279case 19:
1280# line 254 "lua.stx"
1281{
1282 *(yypvt[-0].pByte) = IFFUPJMP;
1283 *((Word *)(yypvt[-0].pByte+1)) = pc - yypvt[-4].pByte;
1284 } break;
1285case 20:
1286# line 261 "lua.stx"
1287{
1288 {
1289 int i;
1290 if (yypvt[-0].vInt == 0 || nvarbuffer != ntemp - yypvt[-2].vInt * 2)
1291 lua_codeadjust (yypvt[-2].vInt * 2 + nvarbuffer);
1292 for (i=nvarbuffer-1; i>=0; i--)
1293 lua_codestore (i);
1294 if (yypvt[-2].vInt > 1 || (yypvt[-2].vInt == 1 && varbuffer[0] != 0))
1295 lua_codeadjust (0);
1296 }
1297 } break;
1298case 21:
1299# line 272 "lua.stx"
1300{ lua_codeadjust (0); } break;
1301case 25:
1302# line 279 "lua.stx"
1303{
1304 {
1305 Byte *elseinit = yypvt[-1].pByte + sizeof(Word)+1;
1306 if (pc - elseinit == 0) /* no else */
1307 {
1308 pc -= sizeof(Word)+1;
1309 /* if (*(pc-1) == NOP) --pc; */
1310 elseinit = pc;
1311 }
1312 else
1313 {
1314 *(yypvt[-1].pByte) = JMP;
1315 *((Word *)(yypvt[-1].pByte+1)) = pc - elseinit;
1316 }
1317 *(yypvt[-3].pByte) = IFFJMP;
1318 *((Word *)(yypvt[-3].pByte+1)) = elseinit - (yypvt[-3].pByte + sizeof(Word)+1);
1319 }
1320 } break;
1321case 26:
1322# line 299 "lua.stx"
1323{yyval.vInt = nlocalvar;} break;
1324case 27:
1325# line 299 "lua.stx"
1326{ntemp = 0;} break;
1327case 28:
1328# line 300 "lua.stx"
1329{
1330 if (nlocalvar != yypvt[-3].vInt)
1331 {
1332 nlocalvar = yypvt[-3].vInt;
1333 lua_codeadjust (0);
1334 }
1335 } break;
1336case 30:
1337# line 310 "lua.stx"
1338{ if (lua_debug){align(Word);code_byte(SETLINE);code_word(lua_linenumber);}} break;
1339case 31:
1340# line 312 "lua.stx"
1341{
1342 if (lua_debug) code_byte(RESET);
1343 code_byte(RETCODE); code_byte(nlocalvar);
1344 } break;
1345case 32:
1346# line 319 "lua.stx"
1347{
1348 align(Word);
1349 yyval.pByte = pc;
1350 code_byte(0); /* open space */
1351 code_word (0);
1352 } break;
1353case 33:
1354# line 326 "lua.stx"
1355{ if (yypvt[-0].vInt == 0) {lua_codeadjust (ntemp+1); incr_ntemp();}} break;
1356case 34:
1357# line 329 "lua.stx"
1358{ yyval.vInt = yypvt[-1].vInt; } break;
1359case 35:
1360# line 330 "lua.stx"
1361{ code_byte(EQOP); yyval.vInt = 1; ntemp--;} break;
1362case 36:
1363# line 331 "lua.stx"
1364{ code_byte(LTOP); yyval.vInt = 1; ntemp--;} break;
1365case 37:
1366# line 332 "lua.stx"
1367{ code_byte(LEOP); code_byte(NOTOP); yyval.vInt = 1; ntemp--;} break;
1368case 38:
1369# line 333 "lua.stx"
1370{ code_byte(EQOP); code_byte(NOTOP); yyval.vInt = 1; ntemp--;} break;
1371case 39:
1372# line 334 "lua.stx"
1373{ code_byte(LEOP); yyval.vInt = 1; ntemp--;} break;
1374case 40:
1375# line 335 "lua.stx"
1376{ code_byte(LTOP); code_byte(NOTOP); yyval.vInt = 1; ntemp--;} break;
1377case 41:
1378# line 336 "lua.stx"
1379{ code_byte(ADDOP); yyval.vInt = 1; ntemp--;} break;
1380case 42:
1381# line 337 "lua.stx"
1382{ code_byte(SUBOP); yyval.vInt = 1; ntemp--;} break;
1383case 43:
1384# line 338 "lua.stx"
1385{ code_byte(MULTOP); yyval.vInt = 1; ntemp--;} break;
1386case 44:
1387# line 339 "lua.stx"
1388{ code_byte(DIVOP); yyval.vInt = 1; ntemp--;} break;
1389case 45:
1390# line 340 "lua.stx"
1391{ code_byte(CONCOP); yyval.vInt = 1; ntemp--;} break;
1392case 46:
1393# line 341 "lua.stx"
1394{ yyval.vInt = 1; } break;
1395case 47:
1396# line 342 "lua.stx"
1397{ code_byte(MINUSOP); yyval.vInt = 1;} break;
1398case 48:
1399# line 344 "lua.stx"
1400{
1401 code_byte(PUSHBYTE);
1402 yyval.pByte = pc; code_byte(0);
1403 incr_ntemp();
1404 code_byte(CREATEARRAY);
1405 } break;
1406case 49:
1407# line 351 "lua.stx"
1408{
1409 *(yypvt[-2].pByte) = yypvt[-0].vInt;
1410 if (yypvt[-1].vLong < 0) /* there is no function to be called */
1411 {
1412 yyval.vInt = 1;
1413 }
1414 else
1415 {
1416 lua_pushvar (yypvt[-1].vLong+1);
1417 code_byte(PUSHMARK);
1418 incr_ntemp();
1419 code_byte(PUSHOBJECT);
1420 incr_ntemp();
1421 code_byte(CALLFUNC);
1422 ntemp -= 4;
1423 yyval.vInt = 0;
1424 if (lua_debug)
1425 {
1426 align(Word); code_byte(SETLINE); code_word(lua_linenumber);
1427 }
1428 }
1429 } break;
1430case 50:
1431# line 374 "lua.stx"
1432{
1433 code_byte(CREATEARRAY);
1434 yyval.vInt = 1;
1435 } break;
1436case 51:
1437# line 378 "lua.stx"
1438{ lua_pushvar (yypvt[-0].vLong); yyval.vInt = 1;} break;
1439case 52:
1440# line 379 "lua.stx"
1441{ code_number(yypvt[-0].vFloat); yyval.vInt = 1; } break;
1442case 53:
1443# line 381 "lua.stx"
1444{
1445 align(Word);
1446 code_byte(PUSHSTRING);
1447 code_word(yypvt[-0].vWord);
1448 yyval.vInt = 1;
1449 incr_ntemp();
1450 } break;
1451case 54:
1452# line 388 "lua.stx"
1453{code_byte(PUSHNIL); yyval.vInt = 1; incr_ntemp();} break;
1454case 55:
1455# line 390 "lua.stx"
1456{
1457 yyval.vInt = 0;
1458 if (lua_debug)
1459 {
1460 align(Word); code_byte(SETLINE); code_word(lua_linenumber);
1461 }
1462 } break;
1463case 56:
1464# line 397 "lua.stx"
1465{ code_byte(NOTOP); yyval.vInt = 1;} break;
1466case 57:
1467# line 398 "lua.stx"
1468{code_byte(POP); ntemp--;} break;
1469case 58:
1470# line 399 "lua.stx"
1471{
1472 *(yypvt[-2].pByte) = ONFJMP;
1473 *((Word *)(yypvt[-2].pByte+1)) = pc - (yypvt[-2].pByte + sizeof(Word)+1);
1474 yyval.vInt = 1;
1475 } break;
1476case 59:
1477# line 404 "lua.stx"
1478{code_byte(POP); ntemp--;} break;
1479case 60:
1480# line 405 "lua.stx"
1481{
1482 *(yypvt[-2].pByte) = ONTJMP;
1483 *((Word *)(yypvt[-2].pByte+1)) = pc - (yypvt[-2].pByte + sizeof(Word)+1);
1484 yyval.vInt = 1;
1485 } break;
1486case 61:
1487# line 412 "lua.stx"
1488{ code_byte(PUSHNIL); incr_ntemp();} break;
1489case 63:
1490# line 416 "lua.stx"
1491{code_byte(PUSHMARK); yyval.vInt = ntemp; incr_ntemp();} break;
1492case 64:
1493# line 417 "lua.stx"
1494{ code_byte(CALLFUNC); ntemp = yypvt[-3].vInt-1;} break;
1495case 65:
1496# line 419 "lua.stx"
1497{lua_pushvar (yypvt[-0].vLong); } break;
1498case 66:
1499# line 422 "lua.stx"
1500{ yyval.vInt = 1; } break;
1501case 67:
1502# line 423 "lua.stx"
1503{ yyval.vInt = yypvt[-0].vInt; } break;
1504case 68:
1505# line 426 "lua.stx"
1506{ yyval.vInt = yypvt[-0].vInt; } break;
1507case 69:
1508# line 427 "lua.stx"
1509{if (!yypvt[-1].vInt){lua_codeadjust (ntemp+1); incr_ntemp();}} break;
1510case 70:
1511# line 428 "lua.stx"
1512{yyval.vInt = yypvt[-0].vInt;} break;
1513case 73:
1514# line 435 "lua.stx"
1515{localvar[nlocalvar]=yypvt[-0].vWord; incr_nlocalvar();} break;
1516case 74:
1517# line 436 "lua.stx"
1518{localvar[nlocalvar]=yypvt[-0].vWord; incr_nlocalvar();} break;
1519case 75:
1520# line 439 "lua.stx"
1521{yyval.vLong=-1;} break;
1522case 76:
1523# line 440 "lua.stx"
1524{yyval.vLong=yypvt[-0].vWord;} break;
1525case 77:
1526# line 443 "lua.stx"
1527{ yyval.vInt = yypvt[-1].vInt; } break;
1528case 78:
1529# line 444 "lua.stx"
1530{ yyval.vInt = yypvt[-1].vInt; } break;
1531case 79:
1532# line 447 "lua.stx"
1533{ yyval.vInt = 0; } break;
1534case 80:
1535# line 448 "lua.stx"
1536{ yyval.vInt = yypvt[-0].vInt; } break;
1537case 81:
1538# line 451 "lua.stx"
1539{yyval.vInt=1;} break;
1540case 82:
1541# line 452 "lua.stx"
1542{yyval.vInt=yypvt[-2].vInt+1;} break;
1543case 83:
1544# line 456 "lua.stx"
1545{
1546 align(Word);
1547 code_byte(PUSHSTRING);
1548 code_word(lua_findconstant (s_name(yypvt[-0].vWord)));
1549 incr_ntemp();
1550 } break;
1551case 84:
1552# line 463 "lua.stx"
1553{
1554 code_byte(STOREFIELD);
1555 ntemp-=2;
1556 } break;
1557case 85:
1558# line 469 "lua.stx"
1559{ yyval.vInt = 0; } break;
1560case 86:
1561# line 470 "lua.stx"
1562{ yyval.vInt = yypvt[-0].vInt; } break;
1563case 87:
1564# line 473 "lua.stx"
1565{ code_number(1); } break;
1566case 88:
1567# line 473 "lua.stx"
1568{yyval.vInt=1;} break;
1569case 89:
1570# line 474 "lua.stx"
1571{ code_number(yypvt[-1].vInt+1); } break;
1572case 90:
1573# line 475 "lua.stx"
1574{yyval.vInt=yypvt[-3].vInt+1;} break;
1575case 91:
1576# line 479 "lua.stx"
1577{
1578 code_byte(STOREFIELD);
1579 ntemp-=2;
1580 } break;
1581case 92:
1582# line 486 "lua.stx"
1583{
1584 nvarbuffer = 0;
1585 varbuffer[nvarbuffer] = yypvt[-0].vLong; incr_nvarbuffer();
1586 yyval.vInt = (yypvt[-0].vLong == 0) ? 1 : 0;
1587 } break;
1588case 93:
1589# line 492 "lua.stx"
1590{
1591 varbuffer[nvarbuffer] = yypvt[-0].vLong; incr_nvarbuffer();
1592 yyval.vInt = (yypvt[-0].vLong == 0) ? yypvt[-2].vInt + 1 : yypvt[-2].vInt;
1593 } break;
1594case 94:
1595# line 499 "lua.stx"
1596{
1597 int local = lua_localname (yypvt[-0].vWord);
1598 if (local == -1) /* global var */
1599 yyval.vLong = yypvt[-0].vWord + 1; /* return positive value */
1600 else
1601 yyval.vLong = -(local+1); /* return negative value */
1602 } break;
1603case 95:
1604# line 507 "lua.stx"
1605{lua_pushvar (yypvt[-0].vLong);} break;
1606case 96:
1607# line 508 "lua.stx"
1608{
1609 yyval.vLong = 0; /* indexed variable */
1610 } break;
1611case 97:
1612# line 511 "lua.stx"
1613{lua_pushvar (yypvt[-0].vLong);} break;
1614case 98:
1615# line 512 "lua.stx"
1616{
1617 align(Word);
1618 code_byte(PUSHSTRING);
1619 code_word(lua_findconstant (s_name(yypvt[-0].vWord))); incr_ntemp();
1620 yyval.vLong = 0; /* indexed variable */
1621 } break;
1622case 99:
1623# line 520 "lua.stx"
1624{localvar[nlocalvar]=yypvt[-1].vWord; incr_nlocalvar();} break;
1625case 100:
1626# line 521 "lua.stx"
1627{localvar[nlocalvar]=yypvt[-1].vWord; incr_nlocalvar();} break;
1628case 101:
1629# line 524 "lua.stx"
1630{ code_byte(PUSHNIL); } break;
1631case 102:
1632# line 525 "lua.stx"
1633{ntemp = 0;} break;
1634case 104:
1635# line 528 "lua.stx"
1636{lua_debug = yypvt[-0].vInt;} break;
1637 }
1638 goto yystack; /* reset registers in driver code */
1639}
diff --git a/y_tab.h b/y_tab.h
new file mode 100644
index 00000000..b973d540
--- /dev/null
+++ b/y_tab.h
@@ -0,0 +1,35 @@
1
2typedef union
3{
4 int vInt;
5 long vLong;
6 float vFloat;
7 Word vWord;
8 Byte *pByte;
9} YYSTYPE;
10extern YYSTYPE yylval;
11# define NIL 257
12# define IF 258
13# define THEN 259
14# define ELSE 260
15# define ELSEIF 261
16# define WHILE 262
17# define DO 263
18# define REPEAT 264
19# define UNTIL 265
20# define END 266
21# define RETURN 267
22# define LOCAL 268
23# define NUMBER 269
24# define FUNCTION 270
25# define NAME 271
26# define STRING 272
27# define DEBUG 273
28# define NOT 274
29# define AND 275
30# define OR 276
31# define NE 277
32# define LE 278
33# define GE 279
34# define CONC 280
35# define UNARY 281
generated by cgit v1.2.3-55-g6feb (git 2.39.1) at 2025-12-27 22:34:15 +0000