diff options
author | Roberto Ierusalimschy <roberto@inf.puc-rio.br> | 1997-09-16 16:25:59 -0300 |
---|---|---|
committer | Roberto Ierusalimschy <roberto@inf.puc-rio.br> | 1997-09-16 16:25:59 -0300 |
commit | 43a2ee6ea1b7825c1892de614cb38a3fe487a19f (patch) | |
tree | c2db158b379c56fb93c0c66ded2a6c8312102062 | |
parent | 4b91e9cde630573cb35bb20101eb74cf5cf79a27 (diff) | |
download | lua-43a2ee6ea1b7825c1892de614cb38a3fe487a19f.tar.gz lua-43a2ee6ea1b7825c1892de614cb38a3fe487a19f.tar.bz2 lua-43a2ee6ea1b7825c1892de614cb38a3fe487a19f.zip |
Stack and Call structure of Lua
-rw-r--r-- | ldo.c | 415 | ||||
-rw-r--r-- | ldo.h | 62 | ||||
-rw-r--r-- | opcode.c | 1484 |
3 files changed, 477 insertions, 1484 deletions
@@ -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 | |||
31 | static TObject initial_stack; | ||
32 | |||
33 | struct Stack luaD_stack = {&initial_stack+1, &initial_stack, &initial_stack}; | ||
34 | |||
35 | |||
36 | struct C_Lua_Stack luaD_Cstack = {0, 0, 0}; | ||
37 | |||
38 | static jmp_buf *errorJmp = NULL; /* current error recover point */ | ||
39 | |||
40 | |||
41 | |||
42 | |||
43 | |||
44 | #define STACK_EXTRA 32 | ||
45 | |||
46 | static 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 | |||
56 | void 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 | */ | ||
84 | void 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 | */ | ||
100 | void 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 | |||
109 | void 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 | |||
120 | void 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 | */ | ||
145 | static 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 | |||
164 | void 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 | */ | ||
178 | void 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 | */ | ||
215 | void 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 | |||
227 | static 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 | |||
235 | static void emergencyerrorf (void) | ||
236 | { | ||
237 | auxerrorim("THERE WAS AN ERROR INSIDE AN ERROR METHOD:\n%s\n"); | ||
238 | } | ||
239 | |||
240 | |||
241 | static void stderrorim (void) | ||
242 | { | ||
243 | auxerrorim("lua: %s\n"); | ||
244 | } | ||
245 | |||
246 | |||
247 | TObject luaD_errorim = {LUA_T_CFUNCTION, {stderrorim}}; | ||
248 | |||
249 | |||
250 | static 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 | */ | ||
265 | void 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 | */ | ||
280 | static 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 | */ | ||
294 | int 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 | */ | ||
318 | static 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 | |||
344 | static 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 | |||
363 | void 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 | |||
374 | int 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 | |||
401 | int 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 | |||
@@ -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 | |||
14 | typedef int StkId; /* index to luaD_stack.stack elements */ | ||
15 | |||
16 | #define MULT_RET 255 | ||
17 | |||
18 | |||
19 | extern struct Stack { | ||
20 | TObject *last; | ||
21 | TObject *stack; | ||
22 | TObject *top; | ||
23 | } luaD_stack; | ||
24 | |||
25 | |||
26 | extern 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 | |||
34 | extern 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 | |||
50 | void luaD_adjusttop (StkId newtop); | ||
51 | void luaD_openstack (int nelems); | ||
52 | void luaD_lineHook (int line); | ||
53 | void luaD_callHook (StkId base, lua_Type type, int isreturn); | ||
54 | void luaD_call (StkId base, int nResults); | ||
55 | void luaD_callTM (TObject *f, int nParams, int nResults); | ||
56 | int luaD_protectedrun (int nResults); | ||
57 | void luaD_gcIM (TObject *o); | ||
58 | void luaD_travstack (int (*fn)(TObject *)); | ||
59 | void 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 | |||
6 | char *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 | |||
38 | typedef int StkId; /* index to stack elements */ | ||
39 | |||
40 | static TObject initial_stack; | ||
41 | |||
42 | static TObject *stackLimit = &initial_stack+1; | ||
43 | static TObject *stack = &initial_stack; | ||
44 | static 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 | |||
58 | struct 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 | |||
65 | static struct C_Lua_Stack CLS_current = {0, 0, 0}; | ||
66 | |||
67 | static jmp_buf *errorJmp = NULL; /* current error recover point */ | ||
68 | |||
69 | |||
70 | /* Hooks */ | ||
71 | lua_LHFunction lua_linehook = NULL; | ||
72 | lua_CHFunction lua_callhook = NULL; | ||
73 | |||
74 | |||
75 | static StkId lua_execute (TFunc *func, StkId base); | ||
76 | static void do_call (StkId base, int nResults); | ||
77 | |||
78 | |||
79 | |||
80 | TObject *luaI_Address (lua_Object o) | ||
81 | { | ||
82 | return Address(o); | ||
83 | } | ||
84 | |||
85 | |||
86 | /* | ||
87 | ** Init stack | ||
88 | */ | ||
89 | static 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 | |||
104 | static 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 | */ | ||
128 | static 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 | */ | ||
142 | static 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 | */ | ||
162 | static 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 | */ | ||
184 | static 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 | |||
200 | static 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 | */ | ||
210 | static 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 | |||
219 | static 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 | |||
227 | static 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 | |||
235 | lua_Object lua_pop (void) | ||
236 | { | ||
237 | checkCparams(1); | ||
238 | return put_luaObjectonTop(); | ||
239 | } | ||
240 | |||
241 | |||
242 | |||
243 | /* | ||
244 | ** call Line hook | ||
245 | */ | ||
246 | static 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 | */ | ||
261 | static 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 | */ | ||
287 | static 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 | |||
305 | static 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 | */ | ||
319 | static 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 | */ | ||
358 | static 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 | |||
390 | lua_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 | */ | ||
413 | static 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 | |||
438 | static 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 | */ | ||
459 | void 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 | |||
472 | static 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 | |||
480 | static void emergencyerrorf (void) | ||
481 | { | ||
482 | auxerrorim("WARNING - THERE WAS AN ERROR INSIDE AN ERROR METHOD:\n%s\n"); | ||
483 | } | ||
484 | |||
485 | |||
486 | static void stderrorim (void) | ||
487 | { | ||
488 | auxerrorim("lua: %s\n"); | ||
489 | } | ||
490 | |||
491 | |||
492 | TObject luaI_errorim = {LUA_T_CFUNCTION, {stderrorim}}; | ||
493 | |||
494 | |||
495 | static 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 | */ | ||
510 | void 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 | |||
523 | lua_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 | |||
534 | int 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 | |||
541 | lua_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 | |||
558 | int 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 | */ | ||
579 | static 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 | |||
589 | static 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 | */ | ||
603 | static 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 | |||
623 | int 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 | |||
634 | int 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 | */ | ||
662 | int 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 | |||
675 | lua_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 | |||
683 | lua_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 | |||
695 | lua_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 | */ | ||
707 | lua_Object lua_gettable (void) | ||
708 | { | ||
709 | checkCparams(2); | ||
710 | pushsubscript(); | ||
711 | return put_luaObjectonTop(); | ||
712 | } | ||
713 | |||
714 | |||
715 | #define MAX_C_BLOCKS 10 | ||
716 | |||
717 | static int numCblocks = 0; | ||
718 | static struct C_Lua_Stack Cblocks[MAX_C_BLOCKS]; | ||
719 | |||
720 | /* | ||
721 | ** API: starts a new block | ||
722 | */ | ||
723 | void 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 | */ | ||
734 | void lua_endblock (void) | ||
735 | { | ||
736 | --numCblocks; | ||
737 | CLS_current = Cblocks[numCblocks]; | ||
738 | adjustC(0); | ||
739 | } | ||
740 | |||
741 | void 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 | */ | ||
750 | void lua_settable (void) | ||
751 | { | ||
752 | checkCparams(3); | ||
753 | storesubscript(top-3, 1); | ||
754 | } | ||
755 | |||
756 | void lua_rawsettable (void) | ||
757 | { | ||
758 | checkCparams(3); | ||
759 | storesubscript(top-3, 0); | ||
760 | } | ||
761 | |||
762 | /* | ||
763 | ** API: creates a new table | ||
764 | */ | ||
765 | lua_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 | */ | ||
777 | lua_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 | |||
785 | int lua_isnil (lua_Object o) | ||
786 | { | ||
787 | return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_NIL); | ||
788 | } | ||
789 | |||
790 | int lua_istable (lua_Object o) | ||
791 | { | ||
792 | return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_ARRAY); | ||
793 | } | ||
794 | |||
795 | int lua_isuserdata (lua_Object o) | ||
796 | { | ||
797 | return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_USERDATA); | ||
798 | } | ||
799 | |||
800 | int lua_iscfunction (lua_Object o) | ||
801 | { | ||
802 | int t = lua_tag(o); | ||
803 | return (t == LUA_T_CMARK) || (t == LUA_T_CFUNCTION); | ||
804 | } | ||
805 | |||
806 | int lua_isnumber (lua_Object o) | ||
807 | { | ||
808 | return (o!= LUA_NOOBJECT) && (tonumber(Address(o)) == 0); | ||
809 | } | ||
810 | |||
811 | int lua_isstring (lua_Object o) | ||
812 | { | ||
813 | int t = lua_tag(o); | ||
814 | return (t == LUA_T_STRING) || (t == LUA_T_NUMBER); | ||
815 | } | ||
816 | |||
817 | int 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 | */ | ||
827 | real 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 | */ | ||
837 | char *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 | |||
845 | void *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 | */ | ||
856 | lua_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 | |||
865 | lua_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 | |||
874 | int 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 | */ | ||
885 | lua_Object lua_getglobal (char *name) | ||
886 | { | ||
887 | getglobal(luaI_findsymbolbyname(name)); | ||
888 | return put_luaObjectonTop(); | ||
889 | } | ||
890 | |||
891 | |||
892 | lua_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 | */ | ||
901 | static 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 | |||
920 | void lua_setglobal (char *name) | ||
921 | { | ||
922 | checkCparams(1); | ||
923 | setglobal(luaI_findsymbolbyname(name)); | ||
924 | } | ||
925 | |||
926 | void 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 | */ | ||
936 | void 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 | */ | ||
945 | void 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 | */ | ||
954 | void 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 | */ | ||
970 | void lua_pushcfunction (lua_CFunction fn) | ||
971 | { | ||
972 | ttype(top) = LUA_T_CFUNCTION; fvalue(top) = fn; | ||
973 | incr_top; | ||
974 | } | ||
975 | |||
976 | |||
977 | |||
978 | void 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 | */ | ||
990 | void luaI_pushobject (TObject *o) | ||
991 | { | ||
992 | *top = *o; | ||
993 | incr_top; | ||
994 | } | ||
995 | |||
996 | /* | ||
997 | ** Push a lua_Object on stack. | ||
998 | */ | ||
999 | void 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 | |||
1009 | int 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 | |||
1024 | void 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 | |||
1035 | static 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 | |||
1051 | static void call_arith (IMS event) | ||
1052 | { | ||
1053 | call_binTM(event, "unexpected type at arithmetic operation"); | ||
1054 | } | ||
1055 | |||
1056 | |||
1057 | static 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 | |||
1078 | static 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 | */ | ||
1112 | static 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 | */ | ||
1477 | lua_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 | ||