aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRoberto Ierusalimschy <roberto@inf.puc-rio.br>1997-09-16 16:25:59 -0300
committerRoberto Ierusalimschy <roberto@inf.puc-rio.br>1997-09-16 16:25:59 -0300
commit43a2ee6ea1b7825c1892de614cb38a3fe487a19f (patch)
treec2db158b379c56fb93c0c66ded2a6c8312102062
parent4b91e9cde630573cb35bb20101eb74cf5cf79a27 (diff)
downloadlua-43a2ee6ea1b7825c1892de614cb38a3fe487a19f.tar.gz
lua-43a2ee6ea1b7825c1892de614cb38a3fe487a19f.tar.bz2
lua-43a2ee6ea1b7825c1892de614cb38a3fe487a19f.zip
Stack and Call structure of Lua
-rw-r--r--ldo.c415
-rw-r--r--ldo.h62
-rw-r--r--opcode.c1484
3 files changed, 477 insertions, 1484 deletions
diff --git a/ldo.c b/ldo.c
new file mode 100644
index 00000000..b272b819
--- /dev/null
+++ b/ldo.c
@@ -0,0 +1,415 @@
1/*
2** $Id: $
3** Stack and Call structure of Lua
4** See Copyright Notice in lua.h
5*/
6
7
8#include <setjmp.h>
9#include <stdio.h>
10#include <string.h>
11
12#include "ldo.h"
13#include "lgc.h"
14#include "lmem.h"
15#include "lobject.h"
16#include "lparser.h"
17#include "ltm.h"
18#include "lua.h"
19#include "luadebug.h"
20#include "lundump.h"
21#include "lvm.h"
22#include "lzio.h"
23
24
25
26#ifndef STACK_LIMIT
27#define STACK_LIMIT 6000
28#endif
29
30
31static TObject initial_stack;
32
33struct Stack luaD_stack = {&initial_stack+1, &initial_stack, &initial_stack};
34
35
36struct C_Lua_Stack luaD_Cstack = {0, 0, 0};
37
38static jmp_buf *errorJmp = NULL; /* current error recover point */
39
40
41
42
43
44#define STACK_EXTRA 32
45
46static void initstack (int n)
47{
48 int maxstack = STACK_EXTRA+n;
49 luaD_stack.stack = luaM_newvector(maxstack, TObject);
50 luaD_stack.last = luaD_stack.stack+(maxstack-1);
51 luaD_stack.top = luaD_stack.stack;
52 *(luaD_stack.top++) = initial_stack;
53}
54
55
56void luaD_checkstack (int n)
57{
58 if (luaD_stack.stack == &initial_stack)
59 initstack(n);
60 else if (luaD_stack.last-luaD_stack.top <= n) {
61 static int limit = STACK_LIMIT;
62 StkId top = luaD_stack.top-luaD_stack.stack;
63 int stacksize = (luaD_stack.last-luaD_stack.stack)+1+STACK_EXTRA+n;
64 luaD_stack.stack = luaM_reallocvector(luaD_stack.stack, stacksize,TObject);
65 luaD_stack.last = luaD_stack.stack+(stacksize-1);
66 luaD_stack.top = luaD_stack.stack + top;
67 if (stacksize >= limit) {
68 limit = stacksize+STACK_EXTRA; /* extra space to run error handler */
69 if (lua_stackedfunction(100) == LUA_NOOBJECT) {
70 /* less than 100 functions on the stack: cannot be recursive loop */
71 lua_error("Lua2C - C2Lua overflow");
72 }
73 else
74 lua_error(stackEM);
75 }
76 }
77}
78
79
80
81/*
82** Adjust stack. Set top to the given value, pushing NILs if needed.
83*/
84void luaD_adjusttop (StkId newtop)
85{
86 int diff = newtop-(luaD_stack.top-luaD_stack.stack);
87 if (diff <= 0)
88 luaD_stack.top += diff;
89 else {
90 luaD_checkstack(diff);
91 while (diff--)
92 ttype(luaD_stack.top++) = LUA_T_NIL;
93 }
94}
95
96
97/*
98** Open a hole below "nelems" from the luaD_stack.top.
99*/
100void luaD_openstack (int nelems)
101{
102 int i;
103 for (i=0; i<nelems; i++)
104 *(luaD_stack.top-i) = *(luaD_stack.top-i-1);
105 incr_top;
106}
107
108
109void luaD_lineHook (int line)
110{
111 struct C_Lua_Stack oldCLS = luaD_Cstack;
112 StkId old_top = luaD_Cstack.lua2C = luaD_Cstack.base = luaD_stack.top-luaD_stack.stack;
113 luaD_Cstack.num = 0;
114 (*lua_linehook)(line);
115 luaD_stack.top = luaD_stack.stack+old_top;
116 luaD_Cstack = oldCLS;
117}
118
119
120void luaD_callHook (StkId base, lua_Type type, int isreturn)
121{
122 struct C_Lua_Stack oldCLS = luaD_Cstack;
123 StkId old_top = luaD_Cstack.lua2C = luaD_Cstack.base = luaD_stack.top-luaD_stack.stack;
124 luaD_Cstack.num = 0;
125 if (isreturn)
126 (*lua_callhook)(LUA_NOOBJECT, "(return)", 0);
127 else {
128 TObject *f = luaD_stack.stack+base-1;
129 if (type == LUA_T_MARK)
130 (*lua_callhook)(Ref(f), f->value.tf->fileName->str,
131 f->value.tf->lineDefined);
132 else
133 (*lua_callhook)(Ref(f), "(C)", -1);
134 }
135 luaD_stack.top = luaD_stack.stack+old_top;
136 luaD_Cstack = oldCLS;
137}
138
139
140/*
141** Call a C function. luaD_Cstack.base will point to the luaD_stack.top of the luaD_stack.stack,
142** and luaD_Cstack.num is the number of parameters. Returns an index
143** to the first result from C.
144*/
145static StkId callC (lua_CFunction func, StkId base)
146{
147 struct C_Lua_Stack oldCLS = luaD_Cstack;
148 StkId firstResult;
149 luaD_Cstack.num = (luaD_stack.top-luaD_stack.stack) - base;
150 /* incorporate parameters on the luaD_stack.stack */
151 luaD_Cstack.lua2C = base;
152 luaD_Cstack.base = base+luaD_Cstack.num; /* == luaD_stack.top-luaD_stack.stack */
153 if (lua_callhook)
154 luaD_callHook(base, LUA_T_CMARK, 0);
155 (*func)();
156 if (lua_callhook) /* func may have changed lua_callhook */
157 luaD_callHook(base, LUA_T_CMARK, 1);
158 firstResult = luaD_Cstack.base;
159 luaD_Cstack = oldCLS;
160 return firstResult;
161}
162
163
164void luaD_callTM (TObject *f, int nParams, int nResults)
165{
166 luaD_openstack(nParams);
167 *(luaD_stack.top-nParams-1) = *f;
168 luaD_call((luaD_stack.top-luaD_stack.stack)-nParams, nResults);
169}
170
171
172/*
173** Call a function (C or Lua). The parameters must be on the luaD_stack.stack,
174** between [luaD_stack.stack+base,luaD_stack.top). The function to be called is at luaD_stack.stack+base-1.
175** When returns, the results are on the luaD_stack.stack, between [luaD_stack.stack+base-1,luaD_stack.top).
176** The number of results is nResults, unless nResults=MULT_RET.
177*/
178void luaD_call (StkId base, int nResults)
179{
180 StkId firstResult;
181 TObject *func = luaD_stack.stack+base-1;
182 int i;
183 if (ttype(func) == LUA_T_CFUNCTION) {
184 ttype(func) = LUA_T_CMARK;
185 firstResult = callC(fvalue(func), base);
186 }
187 else if (ttype(func) == LUA_T_FUNCTION) {
188 ttype(func) = LUA_T_MARK;
189 firstResult = luaV_execute(func->value.cl, base);
190 }
191 else { /* func is not a function */
192 /* Check the tag method for invalid functions */
193 TObject *im = luaT_getimbyObj(func, IM_FUNCTION);
194 if (ttype(im) == LUA_T_NIL)
195 lua_error("call expression not a function");
196 luaD_callTM(im, (luaD_stack.top-luaD_stack.stack)-(base-1), nResults);
197 return;
198 }
199 /* adjust the number of results */
200 if (nResults != MULT_RET)
201 luaD_adjusttop(firstResult+nResults);
202 /* move results to base-1 (to erase parameters and function) */
203 base--;
204 nResults = luaD_stack.top - (luaD_stack.stack+firstResult); /* actual number of results */
205 for (i=0; i<nResults; i++)
206 *(luaD_stack.stack+base+i) = *(luaD_stack.stack+firstResult+i);
207 luaD_stack.top -= firstResult-base;
208}
209
210
211
212/*
213** Traverse all objects on luaD_stack.stack
214*/
215void luaD_travstack (int (*fn)(TObject *))
216{
217 StkId i;
218 for (i = (luaD_stack.top-1)-luaD_stack.stack; i>=0; i--)
219 fn (luaD_stack.stack+i);
220}
221
222
223/*
224** Error messages
225*/
226
227static void auxerrorim (char *form)
228{
229 lua_Object s = lua_getparam(1);
230 if (lua_isstring(s))
231 fprintf(stderr, form, lua_getstring(s));
232}
233
234
235static void emergencyerrorf (void)
236{
237 auxerrorim("THERE WAS AN ERROR INSIDE AN ERROR METHOD:\n%s\n");
238}
239
240
241static void stderrorim (void)
242{
243 auxerrorim("lua: %s\n");
244}
245
246
247TObject luaD_errorim = {LUA_T_CFUNCTION, {stderrorim}};
248
249
250static void message (char *s)
251{
252 TObject im = luaD_errorim;
253 if (ttype(&im) != LUA_T_NIL) {
254 luaD_errorim.ttype = LUA_T_CFUNCTION;
255 luaD_errorim.value.f = emergencyerrorf;
256 lua_pushstring(s);
257 luaD_callTM(&im, 1, 0);
258 luaD_errorim = im;
259 }
260}
261
262/*
263** Reports an error, and jumps up to the available recover label
264*/
265void lua_error (char *s)
266{
267 if (s) message(s);
268 if (errorJmp)
269 longjmp(*errorJmp, 1);
270 else {
271 fprintf (stderr, "lua: exit(1). Unable to recover\n");
272 exit(1);
273 }
274}
275
276/*
277** Call the function at luaD_Cstack.base, and incorporate results on
278** the Lua2C structure.
279*/
280static void do_callinc (int nResults)
281{
282 StkId base = luaD_Cstack.base;
283 luaD_call(base+1, nResults);
284 luaD_Cstack.lua2C = base; /* position of the luaM_new results */
285 luaD_Cstack.num = (luaD_stack.top-luaD_stack.stack) - base; /* number of results */
286 luaD_Cstack.base = base + luaD_Cstack.num; /* incorporate results on luaD_stack.stack */
287}
288
289
290/*
291** Execute a protected call. Assumes that function is at luaD_Cstack.base and
292** parameters are on luaD_stack.top of it. Leave nResults on the luaD_stack.stack.
293*/
294int luaD_protectedrun (int nResults)
295{
296 jmp_buf myErrorJmp;
297 int status;
298 struct C_Lua_Stack oldCLS = luaD_Cstack;
299 jmp_buf *oldErr = errorJmp;
300 errorJmp = &myErrorJmp;
301 if (setjmp(myErrorJmp) == 0) {
302 do_callinc(nResults);
303 status = 0;
304 }
305 else { /* an error occurred: restore luaD_Cstack and luaD_stack.top */
306 luaD_Cstack = oldCLS;
307 luaD_stack.top = luaD_stack.stack+luaD_Cstack.base;
308 status = 1;
309 }
310 errorJmp = oldErr;
311 return status;
312}
313
314
315/*
316** returns 0 = chunk loaded; 1 = error; 2 = no more chunks to load
317*/
318static int protectedparser (ZIO *z, char *chunkname, int bin)
319{
320 int status;
321 TProtoFunc *tf;
322 jmp_buf myErrorJmp;
323 jmp_buf *oldErr = errorJmp;
324 errorJmp = &myErrorJmp;
325 if (setjmp(myErrorJmp) == 0) {
326 tf = bin ? luaU_undump1(z, chunkname) : luaY_parser(z, chunkname);
327 status = 0;
328 }
329 else {
330 tf = NULL;
331 status = 1;
332 }
333 errorJmp = oldErr;
334 if (status) return 1; /* error code */
335 if (tf == NULL) return 2; /* 'natural' end */
336 luaD_adjusttop(luaD_Cstack.base+1); /* one slot for the pseudo-function */
337 luaD_stack.stack[luaD_Cstack.base].ttype = LUA_T_PROTO;
338 luaD_stack.stack[luaD_Cstack.base].value.tf = tf;
339 luaV_closure();
340 return 0;
341}
342
343
344static int do_main (ZIO *z, char *chunkname, int bin)
345{
346 int status;
347 do {
348 long old_entities = (luaC_checkGC(), luaO_nentities);
349 status = protectedparser(z, chunkname, bin);
350 if (status == 1) return 1; /* error */
351 else if (status == 2) return 0; /* 'natural' end */
352 else {
353 long newelems2 = 2*(luaO_nentities-old_entities);
354 luaC_threshold += newelems2;
355 status = luaD_protectedrun(MULT_RET);
356 luaC_threshold -= newelems2;
357 }
358 } while (bin && status == 0);
359 return status;
360}
361
362
363void luaD_gcIM (TObject *o)
364{
365 TObject *im = luaT_getimbyObj(o, IM_GC);
366 if (ttype(im) != LUA_T_NIL) {
367 *luaD_stack.top = *o;
368 incr_top;
369 luaD_callTM(im, 1, 0);
370 }
371}
372
373
374int lua_dofile (char *filename)
375{
376 ZIO z;
377 int status;
378 int c;
379 int bin;
380 FILE *f = (filename == NULL) ? stdin : fopen(filename, "r");
381 if (f == NULL)
382 return 2;
383 if (filename == NULL)
384 filename = "(stdin)";
385 c = fgetc(f);
386 ungetc(c, f);
387 bin = (c == ID_CHUNK);
388 if (bin)
389 f = freopen(filename, "rb", f); /* set binary mode */
390 luaZ_Fopen(&z, f);
391 status = do_main(&z, filename, bin);
392 if (f != stdin)
393 fclose(f);
394 return status;
395}
396
397
398#define SIZE_PREF 20 /* size of string prefix to appear in error messages */
399
400
401int lua_dostring (char *str)
402{
403 int status;
404 char buff[SIZE_PREF+25];
405 char *temp;
406 ZIO z;
407 if (str == NULL) return 1;
408 sprintf(buff, "(dostring) >> %.20s", str);
409 temp = strchr(buff, '\n');
410 if (temp) *temp = 0; /* end string after first line */
411 luaZ_sopen(&z, str);
412 status = do_main(&z, buff, 0);
413 return status;
414}
415
diff --git a/ldo.h b/ldo.h
new file mode 100644
index 00000000..edcd1b93
--- /dev/null
+++ b/ldo.h
@@ -0,0 +1,62 @@
1/*
2** $Id: $
3** Stack and Call structure of Lua
4** See Copyright Notice in lua.h
5*/
6
7#ifndef ldo_h
8#define ldo_h
9
10
11#include "lobject.h"
12
13
14typedef int StkId; /* index to luaD_stack.stack elements */
15
16#define MULT_RET 255
17
18
19extern struct Stack {
20 TObject *last;
21 TObject *stack;
22 TObject *top;
23} luaD_stack;
24
25
26extern struct C_Lua_Stack {
27 StkId base; /* when Lua calls C or C calls Lua, points to */
28 /* the first slot after the last parameter. */
29 StkId lua2C; /* points to first element of "array" lua2C */
30 int num; /* size of "array" lua2C */
31} luaD_Cstack;
32
33
34extern TObject luaD_errorim;
35
36
37/*
38** macro to increment stack top.
39** There must be always an empty slot at the luaD_stack.top
40*/
41#define incr_top { if (luaD_stack.top >= luaD_stack.last) luaD_checkstack(1); \
42 luaD_stack.top++; }
43
44
45/* macros to convert from lua_Object to (TObject *) and back */
46
47#define Address(lo) ((lo)+luaD_stack.stack-1)
48#define Ref(st) ((st)-luaD_stack.stack+1)
49
50void luaD_adjusttop (StkId newtop);
51void luaD_openstack (int nelems);
52void luaD_lineHook (int line);
53void luaD_callHook (StkId base, lua_Type type, int isreturn);
54void luaD_call (StkId base, int nResults);
55void luaD_callTM (TObject *f, int nParams, int nResults);
56int luaD_protectedrun (int nResults);
57void luaD_gcIM (TObject *o);
58void luaD_travstack (int (*fn)(TObject *));
59void luaD_checkstack (int n);
60
61
62#endif
diff --git a/opcode.c b/opcode.c
deleted file mode 100644
index e569d284..00000000
--- a/opcode.c
+++ /dev/null
@@ -1,1484 +0,0 @@
1/*
2** opcode.c
3** TecCGraf - PUC-Rio
4*/
5
6char *rcs_opcode="$Id: opcode.c,v 4.21 1997/07/31 19:37:37 roberto Exp roberto $";
7
8#include <setjmp.h>
9#include <stdio.h>
10#include <string.h>
11#include <stdlib.h>
12
13#include "lualoc.h"
14#include "luadebug.h"
15#include "luamem.h"
16#include "opcode.h"
17#include "hash.h"
18#include "inout.h"
19#include "table.h"
20#include "lua.h"
21#include "fallback.h"
22#include "auxlib.h"
23#include "lex.h"
24
25#define tonumber(o) ((ttype(o) != LUA_T_NUMBER) && (lua_tonumber(o) != 0))
26#define tostring(o) ((ttype(o) != LUA_T_STRING) && (lua_tostring(o) != 0))
27
28
29#define get_word(w,pc) {w=*pc+(*(pc+1)<<8); pc+=2;}
30
31
32#define STACK_SIZE 128
33
34#ifndef STACK_LIMIT
35#define STACK_LIMIT 6000
36#endif
37
38typedef int StkId; /* index to stack elements */
39
40static TObject initial_stack;
41
42static TObject *stackLimit = &initial_stack+1;
43static TObject *stack = &initial_stack;
44static TObject *top = &initial_stack;
45
46
47/* macros to convert from lua_Object to (TObject *) and back */
48
49#define Address(lo) ((lo)+stack-1)
50#define Ref(st) ((st)-stack+1)
51
52
53/* macro to increment stack top. There must be always an empty slot in
54* the stack
55*/
56#define incr_top if (++top >= stackLimit) growstack()
57
58struct C_Lua_Stack {
59 StkId base; /* when Lua calls C or C calls Lua, points to */
60 /* the first slot after the last parameter. */
61 StkId lua2C; /* points to first element of "array" lua2C */
62 int num; /* size of "array" lua2C */
63};
64
65static struct C_Lua_Stack CLS_current = {0, 0, 0};
66
67static jmp_buf *errorJmp = NULL; /* current error recover point */
68
69
70/* Hooks */
71lua_LHFunction lua_linehook = NULL;
72lua_CHFunction lua_callhook = NULL;
73
74
75static StkId lua_execute (TFunc *func, StkId base);
76static void do_call (StkId base, int nResults);
77
78
79
80TObject *luaI_Address (lua_Object o)
81{
82 return Address(o);
83}
84
85
86/*
87** Init stack
88*/
89static void lua_initstack (void)
90{
91 Long maxstack = STACK_SIZE;
92 stack = newvector(maxstack, TObject);
93 stackLimit = stack+maxstack;
94 top = stack;
95 *(top++) = initial_stack;
96}
97
98
99/*
100** Check stack overflow and, if necessary, realloc vector
101*/
102#define lua_checkstack(nt) if ((nt) >= stackLimit) growstack()
103
104static void growstack (void)
105{
106 if (stack == &initial_stack)
107 lua_initstack();
108 else
109 {
110 static int limit = STACK_LIMIT;
111 StkId t = top-stack;
112 Long stacksize = stackLimit - stack;
113 stacksize = growvector(&stack, stacksize, TObject, stackEM, limit+100);
114 stackLimit = stack+stacksize;
115 top = stack + t;
116 if (stacksize >= limit)
117 {
118 limit = stacksize;
119 lua_error(stackEM);
120 }
121 }
122}
123
124
125/*
126** Concatenate two given strings. Return the new string pointer.
127*/
128static char *lua_strconc (char *l, char *r)
129{
130 size_t nl = strlen(l);
131 char *buffer = luaI_buffer(nl+strlen(r)+1);
132 strcpy(buffer, l);
133 strcpy(buffer+nl, r);
134 return buffer;
135}
136
137
138/*
139** Convert, if possible, to a number object.
140** Return 0 if success, not 0 if error.
141*/
142static int lua_tonumber (TObject *obj)
143{
144 double t;
145 char c;
146 if (ttype(obj) != LUA_T_STRING)
147 return 1;
148 else if (sscanf(svalue(obj), "%lf %c",&t, &c) == 1) {
149 nvalue(obj) = (real)t;
150 ttype(obj) = LUA_T_NUMBER;
151 return 0;
152 }
153 else
154 return 2;
155}
156
157
158/*
159** Convert, if possible, to a string ttype
160** Return 0 in success or not 0 on error.
161*/
162static int lua_tostring (TObject *obj)
163{
164 if (ttype(obj) != LUA_T_NUMBER)
165 return 1;
166 else {
167 char s[60];
168 real f = nvalue(obj);
169 int i;
170 if ((real)(-MAX_INT) <= f && f <= (real)MAX_INT && (real)(i=(int)f) == f)
171 sprintf (s, "%d", i);
172 else
173 sprintf (s, "%g", (double)nvalue(obj));
174 tsvalue(obj) = luaI_createstring(s);
175 ttype(obj) = LUA_T_STRING;
176 return 0;
177 }
178}
179
180
181/*
182** Adjust stack. Set top to the given value, pushing NILs if needed.
183*/
184static void adjust_top_aux (StkId newtop)
185{
186 TObject *nt;
187 lua_checkstack(stack+newtop);
188 nt = stack+newtop; /* warning: previous call may change stack */
189 while (top < nt) ttype(top++) = LUA_T_NIL;
190}
191
192
193#define adjust_top(newtop) { if (newtop <= top-stack) \
194 top = stack+newtop; \
195 else adjust_top_aux(newtop); }
196
197#define adjustC(nParams) adjust_top(CLS_current.base+nParams)
198
199
200static void checkCparams (int nParams)
201{
202 if (top-stack < CLS_current.base+nParams)
203 lua_error("API error - wrong number of arguments in C2lua stack");
204}
205
206
207/*
208** Open a hole below "nelems" from the top.
209*/
210static void open_stack (int nelems)
211{
212 int i;
213 for (i=0; i<nelems; i++)
214 *(top-i) = *(top-i-1);
215 incr_top;
216}
217
218
219static lua_Object put_luaObject (TObject *o)
220{
221 open_stack((top-stack)-CLS_current.base);
222 stack[CLS_current.base++] = *o;
223 return CLS_current.base; /* this is +1 real position (see Ref) */
224}
225
226
227static lua_Object put_luaObjectonTop (void)
228{
229 open_stack((top-stack)-CLS_current.base);
230 stack[CLS_current.base++] = *(--top);
231 return CLS_current.base; /* this is +1 real position (see Ref) */
232}
233
234
235lua_Object lua_pop (void)
236{
237 checkCparams(1);
238 return put_luaObjectonTop();
239}
240
241
242
243/*
244** call Line hook
245*/
246static void lineHook (int line)
247{
248 struct C_Lua_Stack oldCLS = CLS_current;
249 StkId old_top = CLS_current.lua2C = CLS_current.base = top-stack;
250 CLS_current.num = 0;
251 (*lua_linehook)(line);
252 top = stack+old_top;
253 CLS_current = oldCLS;
254}
255
256
257/*
258** Call hook
259** The function being called is in [stack+base-1]
260*/
261static void callHook (StkId base, lua_Type type, int isreturn)
262{
263 struct C_Lua_Stack oldCLS = CLS_current;
264 StkId old_top = CLS_current.lua2C = CLS_current.base = top-stack;
265 CLS_current.num = 0;
266 if (isreturn)
267 (*lua_callhook)(LUA_NOOBJECT, "(return)", 0);
268 else
269 {
270 TObject *f = stack+base-1;
271 if (type == LUA_T_MARK)
272 (*lua_callhook)(Ref(f), f->value.tf->fileName->str,
273 f->value.tf->lineDefined);
274 else
275 (*lua_callhook)(Ref(f), "(C)", -1);
276 }
277 top = stack+old_top;
278 CLS_current = oldCLS;
279}
280
281
282/*
283** Call a C function. CLS_current.base will point to the top of the stack,
284** and CLS_current.num is the number of parameters. Returns an index
285** to the first result from C.
286*/
287static StkId callC (lua_CFunction func, StkId base)
288{
289 struct C_Lua_Stack oldCLS = CLS_current;
290 StkId firstResult;
291 CLS_current.num = (top-stack) - base;
292 /* incorporate parameters on the stack */
293 CLS_current.lua2C = base;
294 CLS_current.base = base+CLS_current.num; /* == top-stack */
295 if (lua_callhook)
296 callHook(base, LUA_T_CMARK, 0);
297 (*func)();
298 if (lua_callhook) /* func may have changed lua_callhook */
299 callHook(base, LUA_T_CMARK, 1);
300 firstResult = CLS_current.base;
301 CLS_current = oldCLS;
302 return firstResult;
303}
304
305static void callIM (TObject *f, int nParams, int nResults)
306{
307 open_stack(nParams);
308 *(top-nParams-1) = *f;
309 do_call((top-stack)-nParams, nResults);
310}
311
312
313/*
314** Call a function (C or Lua). The parameters must be on the stack,
315** between [stack+base,top). The function to be called is at stack+base-1.
316** When returns, the results are on the stack, between [stack+base-1,top).
317** The number of results is nResults, unless nResults=MULT_RET.
318*/
319static void do_call (StkId base, int nResults)
320{
321 StkId firstResult;
322 TObject *func = stack+base-1;
323 int i;
324 if (ttype(func) == LUA_T_CFUNCTION) {
325 ttype(func) = LUA_T_CMARK;
326 firstResult = callC(fvalue(func), base);
327 }
328 else if (ttype(func) == LUA_T_FUNCTION) {
329 ttype(func) = LUA_T_MARK;
330 firstResult = lua_execute(func->value.tf, base);
331 }
332 else { /* func is not a function */
333 /* Check the tag method for invalid functions */
334 TObject *im = luaI_getimbyObj(func, IM_FUNCTION);
335 if (ttype(im) == LUA_T_NIL)
336 lua_error("call expression not a function");
337 open_stack((top-stack)-(base-1));
338 stack[base-1] = *im;
339 do_call(base, nResults);
340 return;
341 }
342 /* adjust the number of results */
343 if (nResults != MULT_RET)
344 adjust_top(firstResult+nResults);
345 /* move results to base-1 (to erase parameters and function) */
346 base--;
347 nResults = top - (stack+firstResult); /* actual number of results */
348 for (i=0; i<nResults; i++)
349 *(stack+base+i) = *(stack+firstResult+i);
350 top -= firstResult-base;
351}
352
353
354/*
355** Function to index a table. Receives the table at top-2 and the index
356** at top-1.
357*/
358static void pushsubscript (void)
359{
360 TObject *im;
361 if (ttype(top-2) != LUA_T_ARRAY) /* not a table, get "gettable" method */
362 im = luaI_getimbyObj(top-2, IM_GETTABLE);
363 else { /* object is a table... */
364 int tg = (top-2)->value.a->htag;
365 im = luaI_getim(tg, IM_GETTABLE);
366 if (ttype(im) == LUA_T_NIL) { /* and does not have a "gettable" method */
367 TObject *h = lua_hashget(avalue(top-2), top-1);
368 if (h != NULL && ttype(h) != LUA_T_NIL) {
369 --top;
370 *(top-1) = *h;
371 }
372 else if (ttype(im=luaI_getim(tg, IM_INDEX)) != LUA_T_NIL)
373 callIM(im, 2, 1);
374 else {
375 --top;
376 ttype(top-1) = LUA_T_NIL;
377 }
378 return;
379 }
380 /* else it has a "gettable" method, go through to next command */
381 }
382 /* object is not a table, or it has a "gettable" method */
383 if (ttype(im) != LUA_T_NIL)
384 callIM(im, 2, 1);
385 else
386 lua_error("indexed expression not a table");
387}
388
389
390lua_Object lua_rawgettable (void)
391{
392 checkCparams(2);
393 if (ttype(top-2) != LUA_T_ARRAY)
394 lua_error("indexed expression not a table in raw gettable");
395 else {
396 TObject *h = lua_hashget(avalue(top-2), top-1);
397 --top;
398 if (h != NULL)
399 *(top-1) = *h;
400 else
401 ttype(top-1) = LUA_T_NIL;
402 }
403 return put_luaObjectonTop();
404}
405
406
407/*
408** Function to store indexed based on values at the top
409** mode = 0: raw store (without internal methods)
410** mode = 1: normal store (with internal methods)
411** mode = 2: "deep stack" store (with internal methods)
412*/
413static void storesubscript (TObject *t, int mode)
414{
415 TObject *im = (mode == 0) ? NULL : luaI_getimbyObj(t, IM_SETTABLE);
416 if (ttype(t) == LUA_T_ARRAY && (im == NULL || ttype(im) == LUA_T_NIL)) {
417 TObject *h = lua_hashdefine(avalue(t), t+1);
418 *h = *(top-1);
419 top -= (mode == 2) ? 1 : 3;
420 }
421 else { /* object is not a table, and/or has a specific "settable" method */
422 if (im && ttype(im) != LUA_T_NIL) {
423 if (mode == 2) {
424 lua_checkstack(top+2);
425 *(top+1) = *(top-1);
426 *(top) = *(t+1);
427 *(top-1) = *t;
428 top += 2;
429 }
430 callIM(im, 3, 0);
431 }
432 else
433 lua_error("indexed expression not a table");
434 }
435}
436
437
438static void getglobal (Word n)
439{
440 TObject *value = &lua_table[n].object;
441 TObject *im = luaI_getimbyObj(value, IM_GETGLOBAL);
442 if (ttype(im) == LUA_T_NIL) { /* default behavior */
443 *top = *value;
444 incr_top;
445 }
446 else {
447 ttype(top) = LUA_T_STRING;
448 tsvalue(top) = lua_table[n].varname;
449 incr_top;
450 *top = *value;
451 incr_top;
452 callIM(im, 2, 1);
453 }
454}
455
456/*
457** Traverse all objects on stack
458*/
459void lua_travstack (int (*fn)(TObject *))
460{
461 StkId i;
462 for (i = (top-1)-stack; i>=0; i--)
463 fn (stack+i);
464}
465
466
467/*
468** Error messages and debug functions
469*/
470
471
472static void auxerrorim (char *form)
473{
474 lua_Object s = lua_getparam(1);
475 if (lua_isstring(s))
476 fprintf(stderr, form, lua_getstring(s));
477}
478
479
480static void emergencyerrorf (void)
481{
482 auxerrorim("WARNING - THERE WAS AN ERROR INSIDE AN ERROR METHOD:\n%s\n");
483}
484
485
486static void stderrorim (void)
487{
488 auxerrorim("lua: %s\n");
489}
490
491
492TObject luaI_errorim = {LUA_T_CFUNCTION, {stderrorim}};
493
494
495static void lua_message (char *s)
496{
497 TObject im = luaI_errorim;
498 if (ttype(&im) != LUA_T_NIL) {
499 luaI_errorim.ttype = LUA_T_CFUNCTION;
500 luaI_errorim.value.f = emergencyerrorf;
501 lua_pushstring(s);
502 callIM(&im, 1, 0);
503 luaI_errorim = im;
504 }
505}
506
507/*
508** Reports an error, and jumps up to the available recover label
509*/
510void lua_error (char *s)
511{
512 if (s) lua_message(s);
513 if (errorJmp)
514 longjmp(*errorJmp, 1);
515 else
516 {
517 fprintf (stderr, "lua: exit(1). Unable to recover\n");
518 exit(1);
519 }
520}
521
522
523lua_Function lua_stackedfunction (int level)
524{
525 StkId i;
526 for (i = (top-1)-stack; i>=0; i--)
527 if (stack[i].ttype == LUA_T_MARK || stack[i].ttype == LUA_T_CMARK)
528 if (level-- == 0)
529 return Ref(stack+i);
530 return LUA_NOOBJECT;
531}
532
533
534int lua_currentline (lua_Function func)
535{
536 TObject *f = Address(func);
537 return (f+1 < top && (f+1)->ttype == LUA_T_LINE) ? (f+1)->value.i : -1;
538}
539
540
541lua_Object lua_getlocal (lua_Function func, int local_number, char **name)
542{
543 TObject *f = luaI_Address(func);
544 /* check whether func is a Lua function */
545 if (ttype(f) != LUA_T_MARK && ttype(f) != LUA_T_FUNCTION)
546 return LUA_NOOBJECT;
547 *name = luaI_getlocalname(f->value.tf, local_number, lua_currentline(func));
548 if (*name)
549 {
550 /* if "*name", there must be a LUA_T_LINE */
551 /* therefore, f+2 points to function base */
552 return Ref((f+2)+(local_number-1));
553 }
554 else
555 return LUA_NOOBJECT;
556}
557
558int lua_setlocal (lua_Function func, int local_number)
559{
560 TObject *f = Address(func);
561 char *name = luaI_getlocalname(f->value.tf, local_number, lua_currentline(func));
562 checkCparams(1);
563 --top;
564 if (name)
565 {
566 /* if "name", there must be a LUA_T_LINE */
567 /* therefore, f+2 points to function base */
568 *((f+2)+(local_number-1)) = *top;
569 return 1;
570 }
571 else
572 return 0;
573}
574
575/*
576** Call the function at CLS_current.base, and incorporate results on
577** the Lua2C structure.
578*/
579static void do_callinc (int nResults)
580{
581 StkId base = CLS_current.base;
582 do_call(base+1, nResults);
583 CLS_current.lua2C = base; /* position of the new results */
584 CLS_current.num = (top-stack) - base; /* number of results */
585 CLS_current.base = base + CLS_current.num; /* incorporate results on stack */
586}
587
588
589static void do_unprotectedrun (lua_CFunction f, int nParams, int nResults)
590{
591 StkId base = (top-stack)-nParams;
592 open_stack(nParams);
593 stack[base].ttype = LUA_T_CFUNCTION;
594 stack[base].value.f = f;
595 do_call(base+1, nResults);
596}
597
598
599/*
600** Execute a protected call. Assumes that function is at CLS_current.base and
601** parameters are on top of it. Leave nResults on the stack.
602*/
603static int do_protectedrun (int nResults)
604{
605 jmp_buf myErrorJmp;
606 int status;
607 struct C_Lua_Stack oldCLS = CLS_current;
608 jmp_buf *oldErr = errorJmp;
609 errorJmp = &myErrorJmp;
610 if (setjmp(myErrorJmp) == 0) {
611 do_callinc(nResults);
612 status = 0;
613 }
614 else { /* an error occurred: restore CLS_current and top */
615 CLS_current = oldCLS;
616 top = stack+CLS_current.base;
617 status = 1;
618 }
619 errorJmp = oldErr;
620 return status;
621}
622
623int luaI_dorun (TFunc *tf)
624{
625 int status;
626 adjustC(1); /* one slot for the pseudo-function */
627 stack[CLS_current.base].ttype = LUA_T_FUNCTION;
628 stack[CLS_current.base].value.tf = tf;
629 status = do_protectedrun(MULT_RET);
630 return status;
631}
632
633
634int lua_domain (void)
635{
636 int status;
637 TFunc *tf = new(TFunc);
638 jmp_buf myErrorJmp;
639 jmp_buf *oldErr = errorJmp;
640 errorJmp = &myErrorJmp;
641 luaI_initTFunc(tf);
642 adjustC(1); /* one slot for the pseudo-function */
643 stack[CLS_current.base].ttype = LUA_T_FUNCTION;
644 stack[CLS_current.base].value.tf = tf;
645 if (setjmp(myErrorJmp) == 0) {
646 lua_parse(tf);
647 status = 0;
648 }
649 else {
650 adjustC(0); /* erase extra slot */
651 status = 1;
652 }
653 if (status == 0)
654 status = do_protectedrun(MULT_RET);
655 errorJmp = oldErr;
656 return status;
657}
658
659/*
660** Execute the given lua function. Return 0 on success or 1 on error.
661*/
662int lua_callfunction (lua_Object function)
663{
664 if (function == LUA_NOOBJECT)
665 return 1;
666 else
667 {
668 open_stack((top-stack)-CLS_current.base);
669 stack[CLS_current.base] = *Address(function);
670 return do_protectedrun (MULT_RET);
671 }
672}
673
674
675lua_Object lua_gettagmethod (int tag, char *event)
676{
677 lua_pushnumber(tag);
678 lua_pushstring(event);
679 do_unprotectedrun(luaI_gettagmethod, 2, 1);
680 return put_luaObjectonTop();
681}
682
683lua_Object lua_settagmethod (int tag, char *event)
684{
685 TObject newmethod;
686 checkCparams(1);
687 newmethod = *(--top);
688 lua_pushnumber(tag);
689 lua_pushstring(event);
690 *top = newmethod; incr_top;
691 do_unprotectedrun(luaI_settagmethod, 3, 1);
692 return put_luaObjectonTop();
693}
694
695lua_Object lua_seterrormethod (void)
696{
697 checkCparams(1);
698 do_unprotectedrun(luaI_seterrormethod, 1, 1);
699 return put_luaObjectonTop();
700}
701
702
703/*
704** API: receives on the stack the table and the index.
705** returns the value.
706*/
707lua_Object lua_gettable (void)
708{
709 checkCparams(2);
710 pushsubscript();
711 return put_luaObjectonTop();
712}
713
714
715#define MAX_C_BLOCKS 10
716
717static int numCblocks = 0;
718static struct C_Lua_Stack Cblocks[MAX_C_BLOCKS];
719
720/*
721** API: starts a new block
722*/
723void lua_beginblock (void)
724{
725 if (numCblocks >= MAX_C_BLOCKS)
726 lua_error("`lua_beginblock': too many nested blocks");
727 Cblocks[numCblocks] = CLS_current;
728 numCblocks++;
729}
730
731/*
732** API: ends a block
733*/
734void lua_endblock (void)
735{
736 --numCblocks;
737 CLS_current = Cblocks[numCblocks];
738 adjustC(0);
739}
740
741void lua_settag (int tag)
742{
743 checkCparams(1);
744 luaI_settag(tag, --top);
745}
746
747/*
748** API: receives on the stack the table, the index, and the new value.
749*/
750void lua_settable (void)
751{
752 checkCparams(3);
753 storesubscript(top-3, 1);
754}
755
756void lua_rawsettable (void)
757{
758 checkCparams(3);
759 storesubscript(top-3, 0);
760}
761
762/*
763** API: creates a new table
764*/
765lua_Object lua_createtable (void)
766{
767 TObject o;
768 avalue(&o) = lua_createarray(0);
769 ttype(&o) = LUA_T_ARRAY;
770 return put_luaObject(&o);
771}
772
773/*
774** Get a parameter, returning the object handle or LUA_NOOBJECT on error.
775** 'number' must be 1 to get the first parameter.
776*/
777lua_Object lua_lua2C (int number)
778{
779 if (number <= 0 || number > CLS_current.num) return LUA_NOOBJECT;
780 /* Ref(stack+(CLS_current.lua2C+number-1)) ==
781 stack+(CLS_current.lua2C+number-1)-stack+1 == */
782 return CLS_current.lua2C+number;
783}
784
785int lua_isnil (lua_Object o)
786{
787 return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_NIL);
788}
789
790int lua_istable (lua_Object o)
791{
792 return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_ARRAY);
793}
794
795int lua_isuserdata (lua_Object o)
796{
797 return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_USERDATA);
798}
799
800int lua_iscfunction (lua_Object o)
801{
802 int t = lua_tag(o);
803 return (t == LUA_T_CMARK) || (t == LUA_T_CFUNCTION);
804}
805
806int lua_isnumber (lua_Object o)
807{
808 return (o!= LUA_NOOBJECT) && (tonumber(Address(o)) == 0);
809}
810
811int lua_isstring (lua_Object o)
812{
813 int t = lua_tag(o);
814 return (t == LUA_T_STRING) || (t == LUA_T_NUMBER);
815}
816
817int lua_isfunction (lua_Object o)
818{
819 int t = lua_tag(o);
820 return (t == LUA_T_FUNCTION) || (t == LUA_T_CFUNCTION) ||
821 (t == LUA_T_MARK) || (t == LUA_T_CMARK);
822}
823
824/*
825** Given an object handle, return its number value. On error, return 0.0.
826*/
827real lua_getnumber (lua_Object object)
828{
829 if (object == LUA_NOOBJECT) return 0.0;
830 if (tonumber (Address(object))) return 0.0;
831 else return (nvalue(Address(object)));
832}
833
834/*
835** Given an object handle, return its string pointer. On error, return NULL.
836*/
837char *lua_getstring (lua_Object object)
838{
839 if (object == LUA_NOOBJECT || tostring (Address(object)))
840 return NULL;
841 else return (svalue(Address(object)));
842}
843
844
845void *lua_getuserdata (lua_Object object)
846{
847 if (object == LUA_NOOBJECT || ttype(Address(object)) != LUA_T_USERDATA)
848 return NULL;
849 else return tsvalue(Address(object))->u.v;
850}
851
852
853/*
854** Given an object handle, return its cfuntion pointer. On error, return NULL.
855*/
856lua_CFunction lua_getcfunction (lua_Object object)
857{
858 if (object == LUA_NOOBJECT || ((ttype(Address(object)) != LUA_T_CFUNCTION) &&
859 (ttype(Address(object)) != LUA_T_CMARK)))
860 return NULL;
861 else return (fvalue(Address(object)));
862}
863
864
865lua_Object lua_getref (int ref)
866{
867 TObject *o = luaI_getref(ref);
868 if (o == NULL)
869 return LUA_NOOBJECT;
870 return put_luaObject(o);
871}
872
873
874int lua_ref (int lock)
875{
876 checkCparams(1);
877 return luaI_ref(--top, lock);
878}
879
880
881
882/*
883** Get a global object.
884*/
885lua_Object lua_getglobal (char *name)
886{
887 getglobal(luaI_findsymbolbyname(name));
888 return put_luaObjectonTop();
889}
890
891
892lua_Object lua_rawgetglobal (char *name)
893{
894 return put_luaObject(&lua_table[luaI_findsymbolbyname(name)].object);
895}
896
897
898/*
899** Store top of the stack at a global variable array field.
900*/
901static void setglobal (Word n)
902{
903 TObject *oldvalue = &lua_table[n].object;
904 TObject *im = luaI_getimbyObj(oldvalue, IM_SETGLOBAL);
905 if (ttype(im) == LUA_T_NIL) /* default behavior */
906 s_object(n) = *(--top);
907 else {
908 TObject newvalue = *(top-1);
909 ttype(top-1) = LUA_T_STRING;
910 tsvalue(top-1) = lua_table[n].varname;
911 *top = *oldvalue;
912 incr_top;
913 *top = newvalue;
914 incr_top;
915 callIM(im, 3, 0);
916 }
917}
918
919
920void lua_setglobal (char *name)
921{
922 checkCparams(1);
923 setglobal(luaI_findsymbolbyname(name));
924}
925
926void lua_rawsetglobal (char *name)
927{
928 Word n = luaI_findsymbolbyname(name);
929 checkCparams(1);
930 s_object(n) = *(--top);
931}
932
933/*
934** Push a nil object
935*/
936void lua_pushnil (void)
937{
938 ttype(top) = LUA_T_NIL;
939 incr_top;
940}
941
942/*
943** Push an object (ttype=number) to stack.
944*/
945void lua_pushnumber (real n)
946{
947 ttype(top) = LUA_T_NUMBER; nvalue(top) = n;
948 incr_top;
949}
950
951/*
952** Push an object (ttype=string) to stack.
953*/
954void lua_pushstring (char *s)
955{
956 if (s == NULL)
957 ttype(top) = LUA_T_NIL;
958 else
959 {
960 tsvalue(top) = luaI_createstring(s);
961 ttype(top) = LUA_T_STRING;
962 }
963 incr_top;
964}
965
966
967/*
968** Push an object (ttype=cfunction) to stack.
969*/
970void lua_pushcfunction (lua_CFunction fn)
971{
972 ttype(top) = LUA_T_CFUNCTION; fvalue(top) = fn;
973 incr_top;
974}
975
976
977
978void lua_pushusertag (void *u, int tag)
979{
980 if (tag < 0 && tag != LUA_ANYTAG)
981 luaI_realtag(tag); /* error if tag is not valid */
982 tsvalue(top) = luaI_createudata(u, tag);
983 ttype(top) = LUA_T_USERDATA;
984 incr_top;
985}
986
987/*
988** Push an object on the stack.
989*/
990void luaI_pushobject (TObject *o)
991{
992 *top = *o;
993 incr_top;
994}
995
996/*
997** Push a lua_Object on stack.
998*/
999void lua_pushobject (lua_Object o)
1000{
1001 if (o == LUA_NOOBJECT)
1002 lua_error("API error - attempt to push a NOOBJECT");
1003 *top = *Address(o);
1004 if (ttype(top) == LUA_T_MARK) ttype(top) = LUA_T_FUNCTION;
1005 else if (ttype(top) == LUA_T_CMARK) ttype(top) = LUA_T_CFUNCTION;
1006 incr_top;
1007}
1008
1009int lua_tag (lua_Object lo)
1010{
1011 if (lo == LUA_NOOBJECT) return LUA_T_NIL;
1012 else {
1013 TObject *o = Address(lo);
1014 lua_Type t = ttype(o);
1015 if (t == LUA_T_USERDATA)
1016 return o->value.ts->tag;
1017 else if (t == LUA_T_ARRAY)
1018 return o->value.a->htag;
1019 else return t;
1020 }
1021}
1022
1023
1024void luaI_gcIM (TObject *o)
1025{
1026 TObject *im = luaI_getimbyObj(o, IM_GC);
1027 if (ttype(im) != LUA_T_NIL) {
1028 *top = *o;
1029 incr_top;
1030 callIM(im, 1, 0);
1031 }
1032}
1033
1034
1035static void call_binTM (IMS event, char *msg)
1036{
1037 TObject *im = luaI_getimbyObj(top-2, event); /* try first operand */
1038 if (ttype(im) == LUA_T_NIL) {
1039 im = luaI_getimbyObj(top-1, event); /* try second operand */
1040 if (ttype(im) == LUA_T_NIL) {
1041 im = luaI_getim(0, event); /* try a 'global' i.m. */
1042 if (ttype(im) == LUA_T_NIL)
1043 lua_error(msg);
1044 }
1045 }
1046 lua_pushstring(luaI_eventname[event]);
1047 callIM(im, 3, 1);
1048}
1049
1050
1051static void call_arith (IMS event)
1052{
1053 call_binTM(event, "unexpected type at arithmetic operation");
1054}
1055
1056
1057static void comparison (lua_Type ttype_less, lua_Type ttype_equal,
1058 lua_Type ttype_great, IMS op)
1059{
1060 TObject *l = top-2;
1061 TObject *r = top-1;
1062 int result;
1063 if (ttype(l) == LUA_T_NUMBER && ttype(r) == LUA_T_NUMBER)
1064 result = (nvalue(l) < nvalue(r)) ? -1 : (nvalue(l) == nvalue(r)) ? 0 : 1;
1065 else if (ttype(l) == LUA_T_STRING && ttype(r) == LUA_T_STRING)
1066 result = strcoll(svalue(l), svalue(r));
1067 else {
1068 call_binTM(op, "unexpected type at comparison");
1069 return;
1070 }
1071 top--;
1072 nvalue(top-1) = 1;
1073 ttype(top-1) = (result < 0) ? ttype_less :
1074 (result == 0) ? ttype_equal : ttype_great;
1075}
1076
1077
1078static void adjust_varargs (StkId first_extra_arg)
1079{
1080 TObject arg;
1081 TObject *firstelem = stack+first_extra_arg;
1082 int nvararg = top-firstelem;
1083 int i;
1084 if (nvararg < 0) nvararg = 0;
1085 avalue(&arg) = lua_createarray(nvararg+1); /* +1 for field 'n' */
1086 ttype(&arg) = LUA_T_ARRAY;
1087 for (i=0; i<nvararg; i++) {
1088 TObject index;
1089 ttype(&index) = LUA_T_NUMBER;
1090 nvalue(&index) = i+1;
1091 *(lua_hashdefine(avalue(&arg), &index)) = *(firstelem+i);
1092 }
1093 /* store counter in field "n" */ {
1094 TObject index, extra;
1095 ttype(&index) = LUA_T_STRING;
1096 tsvalue(&index) = luaI_createstring("n");
1097 ttype(&extra) = LUA_T_NUMBER;
1098 nvalue(&extra) = nvararg;
1099 *(lua_hashdefine(avalue(&arg), &index)) = extra;
1100 }
1101 adjust_top(first_extra_arg);
1102 *top = arg; incr_top;
1103}
1104
1105
1106
1107/*
1108** Execute the given opcode, until a RET. Parameters are between
1109** [stack+base,top). Returns n such that the the results are between
1110** [stack+n,top).
1111*/
1112static StkId lua_execute (TFunc *func, StkId base)
1113{
1114 Byte *pc = func->code;
1115 if (lua_callhook)
1116 callHook (base, LUA_T_MARK, 0);
1117 while (1)
1118 {
1119 OpCode opcode;
1120 switch (opcode = (OpCode)*pc++)
1121 {
1122 case PUSHNIL: ttype(top) = LUA_T_NIL; incr_top; break;
1123
1124 case PUSH0: case PUSH1: case PUSH2:
1125 ttype(top) = LUA_T_NUMBER;
1126 nvalue(top) = opcode-PUSH0;
1127 incr_top;
1128 break;
1129
1130 case PUSHBYTE:
1131 ttype(top) = LUA_T_NUMBER; nvalue(top) = *pc++; incr_top; break;
1132
1133 case PUSHWORD:
1134 {
1135 Word w;
1136 get_word(w,pc);
1137 ttype(top) = LUA_T_NUMBER; nvalue(top) = w;
1138 incr_top;
1139 }
1140 break;
1141
1142 case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2:
1143 case PUSHLOCAL3: case PUSHLOCAL4: case PUSHLOCAL5:
1144 case PUSHLOCAL6: case PUSHLOCAL7: case PUSHLOCAL8:
1145 case PUSHLOCAL9:
1146 *top = *((stack+base) + (int)(opcode-PUSHLOCAL0)); incr_top; break;
1147
1148 case PUSHLOCAL: *top = *((stack+base) + (*pc++)); incr_top; break;
1149
1150 case PUSHGLOBAL:
1151 {
1152 Word w;
1153 get_word(w,pc);
1154 getglobal(w);
1155 }
1156 break;
1157
1158 case PUSHINDEXED:
1159 pushsubscript();
1160 break;
1161
1162 case PUSHSELF:
1163 {
1164 TObject receiver = *(top-1);
1165 Word w;
1166 get_word(w,pc);
1167 *top = func->consts[w];
1168 incr_top;
1169 pushsubscript();
1170 *top = receiver;
1171 incr_top;
1172 break;
1173 }
1174
1175 case PUSHCONSTANTB: {
1176 *top = func->consts[*pc++];
1177 incr_top;
1178 break;
1179 }
1180
1181 case PUSHCONSTANT: {
1182 Word w;
1183 get_word(w,pc);
1184 *top = func->consts[w];
1185 incr_top;
1186 break;
1187 }
1188
1189 case STORELOCAL0: case STORELOCAL1: case STORELOCAL2:
1190 case STORELOCAL3: case STORELOCAL4: case STORELOCAL5:
1191 case STORELOCAL6: case STORELOCAL7: case STORELOCAL8:
1192 case STORELOCAL9:
1193 *((stack+base) + (int)(opcode-STORELOCAL0)) = *(--top);
1194 break;
1195
1196 case STORELOCAL: *((stack+base) + (*pc++)) = *(--top); break;
1197
1198 case STOREGLOBAL:
1199 {
1200 Word w;
1201 get_word(w,pc);
1202 setglobal(w);
1203 }
1204 break;
1205
1206 case STOREINDEXED0:
1207 storesubscript(top-3, 1);
1208 break;
1209
1210 case STOREINDEXED: {
1211 int n = *pc++;
1212 storesubscript(top-3-n, 2);
1213 break;
1214 }
1215
1216 case STORELIST0:
1217 case STORELIST:
1218 {
1219 int m, n;
1220 TObject *arr;
1221 if (opcode == STORELIST0) m = 0;
1222 else m = *(pc++) * FIELDS_PER_FLUSH;
1223 n = *(pc++);
1224 arr = top-n-1;
1225 while (n)
1226 {
1227 ttype(top) = LUA_T_NUMBER; nvalue(top) = n+m;
1228 *(lua_hashdefine (avalue(arr), top)) = *(top-1);
1229 top--;
1230 n--;
1231 }
1232 }
1233 break;
1234
1235 case STOREMAP: {
1236 int n = *(pc++);
1237 TObject *arr = top-(2*n)-1;
1238 while (n--) {
1239 *(lua_hashdefine (avalue(arr), top-2)) = *(top-1);
1240 top-=2;
1241 }
1242 }
1243 break;
1244
1245 case ADJUST0:
1246 adjust_top(base);
1247 break;
1248
1249 case ADJUST: {
1250 StkId newtop = base + *(pc++);
1251 adjust_top(newtop);
1252 break;
1253 }
1254
1255 case VARARGS:
1256 adjust_varargs(base + *(pc++));
1257 break;
1258
1259 case CREATEARRAY:
1260 {
1261 Word size;
1262 get_word(size,pc);
1263 avalue(top) = lua_createarray(size);
1264 ttype(top) = LUA_T_ARRAY;
1265 incr_top;
1266 }
1267 break;
1268
1269 case EQOP:
1270 {
1271 int res = lua_equalObj(top-2, top-1);
1272 --top;
1273 ttype(top-1) = res ? LUA_T_NUMBER : LUA_T_NIL;
1274 nvalue(top-1) = 1;
1275 }
1276 break;
1277
1278 case LTOP:
1279 comparison(LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, IM_LT);
1280 break;
1281
1282 case LEOP:
1283 comparison(LUA_T_NUMBER, LUA_T_NUMBER, LUA_T_NIL, IM_LE);
1284 break;
1285
1286 case GTOP:
1287 comparison(LUA_T_NIL, LUA_T_NIL, LUA_T_NUMBER, IM_GT);
1288 break;
1289
1290 case GEOP:
1291 comparison(LUA_T_NIL, LUA_T_NUMBER, LUA_T_NUMBER, IM_GE);
1292 break;
1293
1294 case ADDOP:
1295 {
1296 TObject *l = top-2;
1297 TObject *r = top-1;
1298 if (tonumber(r) || tonumber(l))
1299 call_arith(IM_ADD);
1300 else
1301 {
1302 nvalue(l) += nvalue(r);
1303 --top;
1304 }
1305 }
1306 break;
1307
1308 case SUBOP:
1309 {
1310 TObject *l = top-2;
1311 TObject *r = top-1;
1312 if (tonumber(r) || tonumber(l))
1313 call_arith(IM_SUB);
1314 else
1315 {
1316 nvalue(l) -= nvalue(r);
1317 --top;
1318 }
1319 }
1320 break;
1321
1322 case MULTOP:
1323 {
1324 TObject *l = top-2;
1325 TObject *r = top-1;
1326 if (tonumber(r) || tonumber(l))
1327 call_arith(IM_MUL);
1328 else
1329 {
1330 nvalue(l) *= nvalue(r);
1331 --top;
1332 }
1333 }
1334 break;
1335
1336 case DIVOP:
1337 {
1338 TObject *l = top-2;
1339 TObject *r = top-1;
1340 if (tonumber(r) || tonumber(l))
1341 call_arith(IM_DIV);
1342 else
1343 {
1344 nvalue(l) /= nvalue(r);
1345 --top;
1346 }
1347 }
1348 break;
1349
1350 case POWOP:
1351 call_arith(IM_POW);
1352 break;
1353
1354 case CONCOP: {
1355 TObject *l = top-2;
1356 TObject *r = top-1;
1357 if (tostring(l) || tostring(r))
1358 call_binTM(IM_CONCAT, "unexpected type for concatenation");
1359 else {
1360 tsvalue(l) = luaI_createstring(lua_strconc(svalue(l),svalue(r)));
1361 --top;
1362 }
1363 }
1364 break;
1365
1366 case MINUSOP:
1367 if (tonumber(top-1))
1368 {
1369 ttype(top) = LUA_T_NIL;
1370 incr_top;
1371 call_arith(IM_UNM);
1372 }
1373 else
1374 nvalue(top-1) = - nvalue(top-1);
1375 break;
1376
1377 case NOTOP:
1378 ttype(top-1) = (ttype(top-1) == LUA_T_NIL) ? LUA_T_NUMBER : LUA_T_NIL;
1379 nvalue(top-1) = 1;
1380 break;
1381
1382 case ONTJMP:
1383 {
1384 Word w;
1385 get_word(w,pc);
1386 if (ttype(top-1) != LUA_T_NIL) pc += w;
1387 else top--;
1388 }
1389 break;
1390
1391 case ONFJMP:
1392 {
1393 Word w;
1394 get_word(w,pc);
1395 if (ttype(top-1) == LUA_T_NIL) pc += w;
1396 else top--;
1397 }
1398 break;
1399
1400 case JMP:
1401 {
1402 Word w;
1403 get_word(w,pc);
1404 pc += w;
1405 }
1406 break;
1407
1408 case UPJMP:
1409 {
1410 Word w;
1411 get_word(w,pc);
1412 pc -= w;
1413 }
1414 break;
1415
1416 case IFFJMP:
1417 {
1418 Word w;
1419 get_word(w,pc);
1420 top--;
1421 if (ttype(top) == LUA_T_NIL) pc += w;
1422 }
1423 break;
1424
1425 case IFFUPJMP:
1426 {
1427 Word w;
1428 get_word(w,pc);
1429 top--;
1430 if (ttype(top) == LUA_T_NIL) pc -= w;
1431 }
1432 break;
1433
1434 case CALLFUNC:
1435 {
1436 int nParams = *(pc++);
1437 int nResults = *(pc++);
1438 StkId newBase = (top-stack)-nParams;
1439 do_call(newBase, nResults);
1440 }
1441 break;
1442
1443 case RETCODE0:
1444 case RETCODE:
1445 if (lua_callhook)
1446 callHook (base, LUA_T_MARK, 1);
1447 return (base + ((opcode==RETCODE0) ? 0 : *pc));
1448
1449 case SETLINE:
1450 {
1451 Word line;
1452 get_word(line,pc);
1453 if ((stack+base-1)->ttype != LUA_T_LINE)
1454 {
1455 /* open space for LINE value */
1456 open_stack((top-stack)-base);
1457 base++;
1458 (stack+base-1)->ttype = LUA_T_LINE;
1459 }
1460 (stack+base-1)->value.i = line;
1461 if (lua_linehook)
1462 lineHook (line);
1463 break;
1464 }
1465
1466 default:
1467 lua_error ("internal error - opcode doesn't match");
1468 }
1469 }
1470}
1471
1472
1473#if LUA_COMPAT2_5
1474/*
1475** API: set a function as a fallback
1476*/
1477lua_Object lua_setfallback (char *name, lua_CFunction fallback)
1478{
1479 lua_pushstring(name);
1480 lua_pushcfunction(fallback);
1481 do_unprotectedrun(luaI_setfallback, 2, 1);
1482 return put_luaObjectonTop();
1483}
1484#endif