1 /*
2 ** $Id: ldo.cpp 905 2008-07-20 21:08:22Z aquadran $
3 ** Stack and Call structure of Lua
4 ** See Copyright Notice in lua.h
5 */
6
7
8 #include "ldo.h"
9 #include "lfunc.h"
10 #include "lgc.h"
11 #include "lmem.h"
12 #include "lobject.h"
13 #include "lopcodes.h"
14 #include "lparser.h"
15 #include "lstate.h"
16 #include "ltask.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
32 /* Extra stack size to run a function: LUA_T_LINE(1), TM calls(2), ... */
33 #define EXTRA_STACK 5
34
35
36 /*
37 ** Error messages
38 */
39
stderrorim(void)40 void stderrorim (void)
41 {
42 fprintf(stderr, "lua error: %s\n", lua_getstring(lua_getparam(1)));
43 }
44
45
46
47 #define STACK_UNIT 128
48
49 /* Initial size for CallInfo array */
50 #define BASIC_CI_SIZE 8
51
luaD_init(void)52 void luaD_init (void)
53 {
54 ttype(&L->errorim) = LUA_T_CPROTO;
55 fvalue(&L->errorim) = stderrorim;
56 }
57
luaD_initthr(void)58 void luaD_initthr (void)
59 {
60 L->stack.stack = luaM_newvector(STACK_UNIT, TObject);
61 L->stack.top = L->stack.stack;
62 L->stack.last = L->stack.stack+(STACK_UNIT-1);
63 L->base_ci = luaM_newvector(BASIC_CI_SIZE, struct CallInfo);
64 memset(L->base_ci, 0, sizeof(CallInfo) * BASIC_CI_SIZE);
65 L->base_ci_size = sizeof(CallInfo) * BASIC_CI_SIZE;
66 L->ci = L->base_ci;
67 L->ci->tf = NULL;
68 L->end_ci = L->base_ci + BASIC_CI_SIZE;
69 }
70
71
luaD_checkstack(int32 n)72 void luaD_checkstack (int32 n)
73 {
74 struct Stack *S = &L->stack;
75 if (S->last-S->top <= n) {
76 StkId top = S->top-S->stack;
77 int32 stacksize = (S->last-S->stack)+1+STACK_UNIT+n;
78 S->stack = luaM_reallocvector(S->stack, stacksize, TObject);
79 S->last = S->stack+(stacksize-1);
80 S->top = S->stack + top;
81 if (stacksize >= STACK_LIMIT) { /* stack overflow? */
82 if (lua_stackedfunction(100) == LUA_NOOBJECT) /* 100 funcs on stack? */
83 lua_error("Lua2C - C2Lua overflow"); /* doesn't look like a rec. loop */
84 else
85 lua_error("stack size overflow");
86 }
87 }
88 }
89
90
91 /*
92 ** Adjust stack. Set top to the given value, pushing NILs if needed.
93 */
luaD_adjusttop(StkId newtop)94 void luaD_adjusttop (StkId newtop)
95 {
96 int32 diff = newtop-(L->stack.top-L->stack.stack);
97 if (diff <= 0)
98 L->stack.top += diff;
99 else {
100 luaD_checkstack(diff);
101 while (diff--)
102 ttype(L->stack.top++) = LUA_T_NIL;
103 }
104 }
105
106
107 /*
108 ** Open a hole below "nelems" from the L->stack.top.
109 */
luaD_openstack(int32 nelems)110 void luaD_openstack (int32 nelems)
111 {
112 luaO_memup(L->stack.top-nelems+1, L->stack.top-nelems,
113 nelems*sizeof(TObject));
114 incr_top;
115 }
116
117
luaD_lineHook(int32 line)118 void luaD_lineHook (int32 line)
119 {
120 struct C_Lua_Stack oldCLS = L->Cstack;
121 StkId old_top = L->Cstack.lua2C = L->Cstack.base = L->stack.top-L->stack.stack;
122 L->Cstack.num = 0;
123 (*lua_linehook)(line);
124 L->stack.top = L->stack.stack+old_top;
125 L->Cstack = oldCLS;
126 }
127
128
luaD_callHook(StkId base,TProtoFunc * tf,int32 isreturn)129 void luaD_callHook (StkId base, TProtoFunc *tf, int32 isreturn)
130 {
131 struct C_Lua_Stack oldCLS = L->Cstack;
132 StkId old_top = L->Cstack.lua2C = L->Cstack.base = L->stack.top-L->stack.stack;
133 L->Cstack.num = 0;
134 if (isreturn)
135 (*lua_callhook)(LUA_NOOBJECT, "(return)", 0);
136 else {
137 TObject *f = L->stack.stack+base-1;
138 if (tf)
139 (*lua_callhook)(Ref(f), tf->fileName->str, tf->lineDefined);
140 else
141 (*lua_callhook)(Ref(f), "(C)", -1);
142 }
143 L->stack.top = L->stack.stack+old_top;
144 L->Cstack = oldCLS;
145 }
146
147
148 /*
149 ** Call a C function.
150 ** Cstack.num is the number of arguments; Cstack.lua2C points to the
151 ** first argument. Returns an index to the first result from C.
152 */
callC(lua_CFunction f,StkId base)153 static StkId callC (lua_CFunction f, StkId base)
154 {
155 struct C_Lua_Stack *CS = &L->Cstack;
156 struct C_Lua_Stack oldCLS = *CS;
157 StkId firstResult;
158 int32 numarg = (L->stack.top-L->stack.stack) - base;
159 CS->num = numarg;
160 CS->lua2C = base;
161 CS->base = base+numarg; /* == top-stack */
162 if (lua_callhook)
163 luaD_callHook(base, NULL, 0);
164 (*f)(); /* do the actual call */
165 if (lua_callhook) /* func may have changed lua_callhook */
166 luaD_callHook(base, NULL, 1);
167 firstResult = CS->base;
168 *CS = oldCLS;
169 return firstResult;
170 }
171
172
callCclosure(struct Closure * cl,lua_CFunction f,StkId base)173 static StkId callCclosure (struct Closure *cl, lua_CFunction f, StkId base)
174 {
175 TObject *pbase;
176 int32 nup = cl->nelems; /* number of upvalues */
177 luaD_checkstack(nup);
178 pbase = L->stack.stack+base; /* care: previous call may change this */
179 /* open space for upvalues as extra arguments */
180 luaO_memup(pbase+nup, pbase, (L->stack.top-pbase)*sizeof(TObject));
181 /* copy upvalues into stack */
182 memcpy(pbase, cl->consts+1, nup*sizeof(TObject));
183 L->stack.top += nup;
184 return callC(f, base);
185 }
186
187
luaD_callTM(TObject * f,int32 nParams,int32 nResults)188 void luaD_callTM (TObject *f, int32 nParams, int32 nResults)
189 {
190 luaD_openstack(nParams);
191 *(L->stack.top-nParams-1) = *f;
192 luaD_call((L->stack.top-L->stack.stack)-nParams, nResults);
193 }
194
adjust_varargs(StkId first_extra_arg)195 static void adjust_varargs (StkId first_extra_arg)
196 {
197 TObject arg;
198 luaV_pack(first_extra_arg,
199 (L->stack.top-L->stack.stack)-first_extra_arg, &arg);
200 luaD_adjusttop(first_extra_arg);
201 *L->stack.top++ = arg;
202 }
203
204
205
206 /*
207 ** Prepare the stack for calling a Lua function.
208 */
luaD_precall(TObject * f,StkId base,int32 nResults)209 void luaD_precall (TObject *f, StkId base, int32 nResults)
210 {
211 /* Create a new CallInfo record */
212 if (L->ci+1 == L->end_ci) {
213 int32 size_ci = L->end_ci - L->base_ci;
214 int32 index_ci = L->ci - L->base_ci;
215 int32 new_ci_size = size_ci * 2 * sizeof(CallInfo);
216 CallInfo *new_ci = (CallInfo *)luaM_malloc(new_ci_size);
217 memcpy(new_ci, L->base_ci, L->base_ci_size);
218 memset(new_ci + (L->base_ci_size / sizeof(CallInfo)), 0, (new_ci_size) - L->base_ci_size);
219 luaM_free(L->base_ci);
220 L->base_ci = new_ci;
221 L->base_ci_size = new_ci_size;
222 L->ci = L->base_ci + index_ci;
223 L->end_ci = L->base_ci + size_ci * 2;
224 }
225 L->ci++;
226 if (ttype(f) == LUA_T_CLOSURE) {
227 L->ci->c = clvalue(f);
228 f = &L->ci->c->consts[0]; /* Get the actual function */
229 }
230 else
231 L->ci->c = NULL;
232 L->ci->base = base;
233 L->ci->nResults = nResults;
234 if (ttype(f)==LUA_T_CPROTO) {
235 L->ci->tf = NULL;
236 L->ci->pc = NULL;
237 }
238 else {
239 Byte *pc = tfvalue(f)->code;
240 if (lua_callhook)
241 luaD_callHook(base, tfvalue(f), 0);
242 luaD_checkstack((*pc++)+EXTRA_STACK);
243 if (*pc < ZEROVARARG)
244 luaD_adjusttop(base+*(pc++));
245 else { /* varargs */
246 luaC_checkGC();
247 adjust_varargs(base+(*pc++)-ZEROVARARG);
248 }
249 L->ci->tf = tfvalue(f);
250 L->ci->pc = pc;
251 }
252 }
253
254 /*
255 ** Adjust the stack to the desired number of results
256 */
luaD_postret(StkId firstResult)257 void luaD_postret (StkId firstResult) {
258 int32 i;
259 StkId base = L->ci->base;
260 int32 nResults = L->ci->nResults;
261 if (L->ci == L->base_ci)
262 lua_error("call stack underflow");
263 /* adjust the number of results */
264 if (nResults != MULT_RET)
265 luaD_adjusttop(firstResult+nResults);
266 /* move results to base-1 (to erase parameters and function) */
267 base--;
268 nResults = L->stack.top - (L->stack.stack+firstResult); /* actual number of results */
269 for (i=0; i<nResults; i++)
270 *(L->stack.stack+base+i) = *(L->stack.stack+firstResult+i);
271 L->stack.top -= firstResult-base;
272 /* pop off the current CallInfo */
273 L->ci--;
274 }
275
276 /*
277 ** Call a function (C or Lua). The parameters must be on the L->stack.stack,
278 ** between [L->stack.stack+base,L->stack.top). The function to be called is at L->stack.stack+base-1.
279 ** When returns, the results are on the L->stack.stack, between [L->stack.stack+base-1,L->stack.top).
280 ** The number of results is nResults, unless nResults=MULT_RET.
281 */
luaD_call(StkId base,int32 nResults)282 void luaD_call (StkId base, int32 nResults)
283 {
284 StkId firstResult;
285 TObject *func = L->stack.stack+base-1;
286 switch (ttype(func)) {
287 case LUA_T_CPROTO:
288 luaD_precall(func, base, nResults);
289 ttype(func) = LUA_T_CMARK;
290 firstResult = callC(fvalue(func), base);
291 break;
292 case LUA_T_PROTO:
293 luaD_precall(func, base, nResults);
294 ttype(func) = LUA_T_PMARK;
295 firstResult = luaV_execute(L->ci);
296 break;
297 case LUA_T_CLOSURE: {
298 Closure *c = clvalue(func);
299 TObject *proto = &(c->consts[0]);
300 luaD_precall(func, base, nResults);
301 ttype(func) = LUA_T_CLMARK;
302 firstResult = (ttype(proto) == LUA_T_CPROTO) ?
303 callCclosure(c, fvalue(proto), base) :
304 luaV_execute(L->ci);
305 break;
306 }
307 default: { /* func is not a function */
308 /* Check the tag method for invalid functions */
309 TObject *im = luaT_getimbyObj(func, IM_FUNCTION);
310 if (ttype(im) == LUA_T_NIL)
311 lua_error("call expression not a function");
312 luaD_callTM(im, (L->stack.top-L->stack.stack)-(base-1), nResults);
313 return;
314 }
315 }
316 luaD_postret(firstResult);
317 }
318
319
travstack(struct Stack * S,int32 (* fn)(TObject *))320 static void travstack (struct Stack *S, int32 (*fn)(TObject *)) {
321 StkId i;
322 for (i = (S->top-1)-S->stack; i>=0; i--)
323 fn(S->stack+i);
324 }
325
326 /*
327 ** Traverse all objects on L->stack.stack, and all other active stacks
328 */
luaD_travstack(int32 (* fn)(TObject *))329 void luaD_travstack (int32 (*fn)(TObject *))
330 {
331 struct lua_Task *t;
332 travstack(&L->stack, fn);
333 for (t = L->root_task; t != NULL; t = t->next)
334 if (t != L->curr_task && t->Tstate != DONE)
335 travstack(&t->stack, fn);
336 }
337
338
339
message(const char * s)340 static void message (const char *s)
341 {
342 TObject im = L->errorim;
343 if (ttype(&im) != LUA_T_NIL) {
344 lua_pushstring(s);
345 luaD_callTM(&im, 1, 0);
346 }
347 }
348
349 /*
350 ** Reports an error, and jumps up to the available recover label
351 */
lua_error(const char * s)352 void lua_error (const char *s)
353 {
354 if (s) message(s);
355 if (L->errorJmp)
356 longjmp(*((jmp_buf *)L->errorJmp), 1);
357 else {
358 fprintf (stderr, "lua: exit(1). Unable to recover\n");
359 exit(1);
360 }
361 }
362
363 /*
364 ** Call the function at L->Cstack.base, and incorporate results on
365 ** the Lua2C structure.
366 */
do_callinc(int32 nResults)367 static void do_callinc (int32 nResults)
368 {
369 StkId base = L->Cstack.base;
370 luaD_call(base+1, nResults);
371 L->Cstack.lua2C = base; /* position of the luaM_new results */
372 L->Cstack.num = (L->stack.top-L->stack.stack) - base; /* number of results */
373 L->Cstack.base = base + L->Cstack.num; /* incorporate results on L->stack.stack */
374 }
375
376
377 /*
378 ** Execute a protected call. Assumes that function is at L->Cstack.base and
379 ** parameters are on top of it. Leave nResults on the stack.
380 */
luaD_protectedrun(int32 nResults)381 int32 luaD_protectedrun (int32 nResults)
382 {
383 jmp_buf myErrorJmp;
384 int32 status;
385 struct C_Lua_Stack oldCLS = L->Cstack;
386 jmp_buf *oldErr = L->errorJmp;
387 int32 ci_len = L->ci - L->base_ci;
388 L->errorJmp = &myErrorJmp;
389 if (setjmp(myErrorJmp) == 0) {
390 do_callinc(nResults);
391 status = 0;
392 }
393 else { /* an error occurred: restore L->Cstack and L->stack.top */
394 L->Cstack = oldCLS;
395 L->stack.top = L->stack.stack+L->Cstack.base;
396 L->ci = L->base_ci + ci_len;
397 status = 1;
398 }
399 L->errorJmp = oldErr;
400 return status;
401 }
402
403
404 /*
405 ** returns 0 = chunk loaded; 1 = error; 2 = no more chunks to load
406 */
protectedparser(ZIO * z,int32 bin)407 static int32 protectedparser (ZIO *z, int32 bin)
408 {
409 volatile int32 status;
410 TProtoFunc *volatile tf;
411 jmp_buf myErrorJmp;
412 jmp_buf *volatile oldErr = L->errorJmp;
413 L->errorJmp = &myErrorJmp;
414 if (setjmp(myErrorJmp) == 0) {
415 tf = bin ? luaU_undump1(z) : luaY_parser(z);
416 status = 0;
417 }
418 else {
419 tf = NULL;
420 status = 1;
421 }
422 L->errorJmp = oldErr;
423 if (status) return 1; /* error code */
424 if (tf == NULL) return 2; /* 'natural' end */
425 luaD_adjusttop(L->Cstack.base+1); /* one slot for the pseudo-function */
426 L->stack.stack[L->Cstack.base].ttype = LUA_T_PROTO;
427 L->stack.stack[L->Cstack.base].value.tf = tf;
428 luaV_closure(0);
429 return 0;
430 }
431
432
do_main(ZIO * z,int32 bin)433 static int32 do_main (ZIO *z, int32 bin)
434 {
435 int32 status;
436 do {
437 int32 old_blocks = (luaC_checkGC(), L->nblocks);
438 status = protectedparser(z, bin);
439 if (status == 1) return 1; /* error */
440 else if (status == 2) return 0; /* 'natural' end */
441 else {
442 int32 newelems2 = 2*(L->nblocks-old_blocks);
443 L->GCthreshold += newelems2;
444 status = luaD_protectedrun(MULT_RET);
445 L->GCthreshold -= newelems2;
446 }
447 } while (bin && status == 0);
448 return status;
449 }
450
451
luaD_gcIM(TObject * o)452 void luaD_gcIM (TObject *o)
453 {
454 TObject *im = luaT_getimbyObj(o, IM_GC);
455 if (ttype(im) != LUA_T_NIL) {
456 *L->stack.top = *o;
457 incr_top;
458 luaD_callTM(im, 1, 0);
459 }
460 }
461
462
lua_dofile(const char * filename)463 int32 lua_dofile (const char *filename)
464 {
465 ZIO z;
466 int32 status;
467 int32 c;
468 int32 bin;
469 FILE *f = (filename == NULL) ? stdin : fopen(filename, "r");
470 if (f == NULL)
471 return 2;
472 if (filename == NULL)
473 filename = "(stdin)";
474 c = fgetc(f);
475 ungetc(c, f);
476 bin = (c == ID_CHUNK);
477 if (bin)
478 f = freopen(filename, "rb", f); /* set binary mode */
479 luaZ_Fopen(&z, f, filename);
480 status = do_main(&z, bin);
481 if (f != stdin)
482 fclose(f);
483 return status;
484 }
485
486
487 #define SIZE_PREF 20 /* size of string prefix to appear in error messages */
488 #define SSIZE_PREF "20"
489
490
build_name(const char * str,char * name)491 static void build_name (const char *str, char *name) {
492 if (str == NULL || *str == ID_CHUNK)
493 strcpy(name, "(buffer)");
494 else {
495 char *temp;
496 sprintf(name, "(dostring) >> \"%." SSIZE_PREF "s\"", str);
497 temp = strchr(name, '\n');
498 if (temp) { /* end string after first line */
499 *temp = '"';
500 *(temp+1) = 0;
501 }
502 }
503 }
504
505
lua_dostring(const char * str)506 int32 lua_dostring (const char *str) {
507 return lua_dobuffer(str, strlen(str), NULL);
508 }
509
510
lua_dobuffer(const char * buff,int32 size,const char * name)511 int32 lua_dobuffer (const char *buff, int32 size, const char *name) {
512 char newname[SIZE_PREF+25];
513 ZIO z;
514 int32 status;
515 if (name==NULL) {
516 build_name(buff, newname);
517 name = newname;
518 }
519 luaZ_mopen(&z, buff, size, name);
520 status = do_main(&z, buff[0]==ID_CHUNK);
521 return status;
522 }
523
524