- initial import of revision 374 from cnc
[apt.git] / lua / ldo.c
1 /*
2 ** $Id: ldo.c,v 1.217a 2003/04/03 13:35:34 roberto Exp $
3 ** Stack and Call structure of Lua
4 ** See Copyright Notice in lua.h
5 */
6
7
8 #include <setjmp.h>
9 #include <stdlib.h>
10 #include <string.h>
11
12 #define ldo_c
13
14 #include "lua.h"
15
16 #include "ldebug.h"
17 #include "ldo.h"
18 #include "lfunc.h"
19 #include "lgc.h"
20 #include "lmem.h"
21 #include "lobject.h"
22 #include "lopcodes.h"
23 #include "lparser.h"
24 #include "lstate.h"
25 #include "lstring.h"
26 #include "ltable.h"
27 #include "ltm.h"
28 #include "lundump.h"
29 #include "lvm.h"
30 #include "lzio.h"
31
32
33
34
35 /*
36 ** {======================================================
37 ** Error-recovery functions (based on long jumps)
38 ** =======================================================
39 */
40
41
42 /* chain list of long jump buffers */
43 struct lua_longjmp {
44   struct lua_longjmp *previous;
45   jmp_buf b;
46   volatile int status;  /* error code */
47 };
48
49
50 static void seterrorobj (lua_State *L, int errcode, StkId oldtop) {
51   switch (errcode) {
52     case LUA_ERRMEM: {
53       setsvalue2s(oldtop, luaS_new(L, MEMERRMSG));
54       break;
55     }
56     case LUA_ERRERR: {
57       setsvalue2s(oldtop, luaS_new(L, "error in error handling"));
58       break;
59     }
60     case LUA_ERRSYNTAX:
61     case LUA_ERRRUN: {
62       setobjs2s(oldtop, L->top - 1);  /* error message on current top */
63       break;
64     }
65   }
66   L->top = oldtop + 1;
67 }
68
69
70 void luaD_throw (lua_State *L, int errcode) {
71   if (L->errorJmp) {
72     L->errorJmp->status = errcode;
73     longjmp(L->errorJmp->b, 1);
74   }
75   else {
76     G(L)->panic(L);
77     exit(EXIT_FAILURE);
78   }
79 }
80
81
82 int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud) {
83   struct lua_longjmp lj;
84   lj.status = 0;
85   lj.previous = L->errorJmp;  /* chain new error handler */
86   L->errorJmp = &lj;
87   if (setjmp(lj.b) == 0)
88     (*f)(L, ud);
89   L->errorJmp = lj.previous;  /* restore old error handler */
90   return lj.status;
91 }
92
93
94 static void restore_stack_limit (lua_State *L) {
95   L->stack_last = L->stack+L->stacksize-1;
96   if (L->size_ci > LUA_MAXCALLS) {  /* there was an overflow? */
97     int inuse = (L->ci - L->base_ci);
98     if (inuse + 1 < LUA_MAXCALLS)  /* can `undo' overflow? */
99       luaD_reallocCI(L, LUA_MAXCALLS);
100   }
101 }
102
103 /* }====================================================== */
104
105
106 static void correctstack (lua_State *L, TObject *oldstack) {
107   CallInfo *ci;
108   GCObject *up;
109   L->top = (L->top - oldstack) + L->stack;
110   for (up = L->openupval; up != NULL; up = up->gch.next)
111     gcotouv(up)->v = (gcotouv(up)->v - oldstack) + L->stack;
112   for (ci = L->base_ci; ci <= L->ci; ci++) {
113     ci->top = (ci->top - oldstack) + L->stack;
114     ci->base = (ci->base - oldstack) + L->stack;
115   }
116   L->base = L->ci->base;
117 }
118
119
120 void luaD_reallocstack (lua_State *L, int newsize) {
121   TObject *oldstack = L->stack;
122   luaM_reallocvector(L, L->stack, L->stacksize, newsize, TObject);
123   L->stacksize = newsize;
124   L->stack_last = L->stack+newsize-1-EXTRA_STACK;
125   correctstack(L, oldstack);
126 }
127
128
129 void luaD_reallocCI (lua_State *L, int newsize) {
130   CallInfo *oldci = L->base_ci;
131   luaM_reallocvector(L, L->base_ci, L->size_ci, newsize, CallInfo);
132   L->size_ci = cast(unsigned short, newsize);
133   L->ci = (L->ci - oldci) + L->base_ci;
134   L->end_ci = L->base_ci + L->size_ci;
135 }
136
137
138 void luaD_growstack (lua_State *L, int n) {
139   if (n <= L->stacksize)  /* double size is enough? */
140     luaD_reallocstack(L, 2*L->stacksize);
141   else
142     luaD_reallocstack(L, L->stacksize + n + EXTRA_STACK);
143 }
144
145
146 static void luaD_growCI (lua_State *L) {
147   if (L->size_ci > LUA_MAXCALLS)  /* overflow while handling overflow? */
148     luaD_throw(L, LUA_ERRERR);
149   else {
150     luaD_reallocCI(L, 2*L->size_ci);
151     if (L->size_ci > LUA_MAXCALLS)
152       luaG_runerror(L, "stack overflow");
153   }
154 }
155
156
157 void luaD_callhook (lua_State *L, int event, int line) {
158   lua_Hook hook = L->hook;
159   if (hook && L->allowhook) {
160     ptrdiff_t top = savestack(L, L->top);
161     ptrdiff_t ci_top = savestack(L, L->ci->top);
162     lua_Debug ar;
163     ar.event = event;
164     ar.currentline = line;
165     if (event == LUA_HOOKTAILRET)
166       ar.i_ci = 0;  /* tail call; no debug information about it */
167     else
168       ar.i_ci = L->ci - L->base_ci;
169     luaD_checkstack(L, LUA_MINSTACK);  /* ensure minimum stack size */
170     L->ci->top = L->top + LUA_MINSTACK;
171     L->allowhook = 0;  /* cannot call hooks inside a hook */
172     lua_unlock(L);
173     (*hook)(L, &ar);
174     lua_lock(L);
175     lua_assert(!L->allowhook);
176     L->allowhook = 1;
177     L->ci->top = restorestack(L, ci_top);
178     L->top = restorestack(L, top);
179   }
180 }
181
182
183 static void adjust_varargs (lua_State *L, int nfixargs, StkId base) {
184   int i;
185   Table *htab;
186   TObject nname;
187   int actual = L->top - base;  /* actual number of arguments */
188   if (actual < nfixargs) {
189     luaD_checkstack(L, nfixargs - actual);
190     for (; actual < nfixargs; ++actual)
191       setnilvalue(L->top++);
192   }
193   actual -= nfixargs;  /* number of extra arguments */
194   htab = luaH_new(L, actual, 1);  /* create `arg' table */
195   for (i=0; i<actual; i++)  /* put extra arguments into `arg' table */
196     setobj2n(luaH_setnum(L, htab, i+1), L->top - actual + i);
197   /* store counter in field `n' */
198   setsvalue(&nname, luaS_newliteral(L, "n"));
199   setnvalue(luaH_set(L, htab, &nname), cast(lua_Number, actual));
200   L->top -= actual;  /* remove extra elements from the stack */
201   sethvalue(L->top, htab);
202   incr_top(L);
203 }
204
205
206 static StkId tryfuncTM (lua_State *L, StkId func) {
207   const TObject *tm = luaT_gettmbyobj(L, func, TM_CALL);
208   StkId p;
209   ptrdiff_t funcr = savestack(L, func);
210   if (!ttisfunction(tm))
211     luaG_typeerror(L, func, "call");
212   /* Open a hole inside the stack at `func' */
213   for (p = L->top; p > func; p--) setobjs2s(p, p-1);
214   incr_top(L);
215   func = restorestack(L, funcr);  /* previous call may change stack */
216   setobj2s(func, tm);  /* tag method is the new function to be called */
217   return func;
218 }
219
220
221 StkId luaD_precall (lua_State *L, StkId func) {
222   LClosure *cl;
223   ptrdiff_t funcr = savestack(L, func);
224   if (!ttisfunction(func)) /* `func' is not a function? */
225     func = tryfuncTM(L, func);  /* check the `function' tag method */
226   if (L->ci + 1 == L->end_ci) luaD_growCI(L);
227   else condhardstacktests(luaD_reallocCI(L, L->size_ci));
228   cl = &clvalue(func)->l;
229   if (!cl->isC) {  /* Lua function? prepare its call */
230     CallInfo *ci;
231     Proto *p = cl->p;
232     if (p->is_vararg)  /* varargs? */
233       adjust_varargs(L, p->numparams, func+1);
234     luaD_checkstack(L, p->maxstacksize);
235     ci = ++L->ci;  /* now `enter' new function */
236     L->base = L->ci->base = restorestack(L, funcr) + 1;
237     ci->top = L->base + p->maxstacksize;
238     ci->u.l.savedpc = p->code;  /* starting point */
239     ci->u.l.tailcalls = 0;
240     ci->state = CI_SAVEDPC;
241     while (L->top < ci->top)
242       setnilvalue(L->top++);
243     L->top = ci->top;
244     return NULL;
245   }
246   else {  /* if is a C function, call it */
247     CallInfo *ci;
248     int n;
249     luaD_checkstack(L, LUA_MINSTACK);  /* ensure minimum stack size */
250     ci = ++L->ci;  /* now `enter' new function */
251     L->base = L->ci->base = restorestack(L, funcr) + 1;
252     ci->top = L->top + LUA_MINSTACK;
253     ci->state = CI_C;  /* a C function */
254     if (L->hookmask & LUA_MASKCALL)
255       luaD_callhook(L, LUA_HOOKCALL, -1);
256     lua_unlock(L);
257 #ifdef LUA_COMPATUPVALUES
258     lua_pushupvalues(L);
259 #endif
260     n = (*clvalue(L->base - 1)->c.f)(L);  /* do the actual call */
261     lua_lock(L);
262     return L->top - n;
263   }
264 }
265
266
267 static StkId callrethooks (lua_State *L, StkId firstResult) {
268   ptrdiff_t fr = savestack(L, firstResult);  /* next call may change stack */
269   luaD_callhook(L, LUA_HOOKRET, -1);
270   if (!(L->ci->state & CI_C)) {  /* Lua function? */
271     while (L->ci->u.l.tailcalls--)  /* call hook for eventual tail calls */
272       luaD_callhook(L, LUA_HOOKTAILRET, -1);
273   }
274   return restorestack(L, fr);
275 }
276
277
278 void luaD_poscall (lua_State *L, int wanted, StkId firstResult) { 
279   StkId res;
280   if (L->hookmask & LUA_MASKRET)
281     firstResult = callrethooks(L, firstResult);
282   res = L->base - 1;  /* res == final position of 1st result */
283   L->ci--;
284   L->base = L->ci->base;  /* restore base */
285   /* move results to correct place */
286   while (wanted != 0 && firstResult < L->top) {
287     setobjs2s(res++, firstResult++);
288     wanted--;
289   }
290   while (wanted-- > 0)
291     setnilvalue(res++);
292   L->top = res;
293 }
294
295
296 /*
297 ** Call a function (C or Lua). The function to be called is at *func.
298 ** The arguments are on the stack, right after the function.
299 ** When returns, all the results are on the stack, starting at the original
300 ** function position.
301 */ 
302 void luaD_call (lua_State *L, StkId func, int nResults) {
303   StkId firstResult;
304   lua_assert(!(L->ci->state & CI_CALLING));
305   if (++L->nCcalls >= LUA_MAXCCALLS) {
306     if (L->nCcalls == LUA_MAXCCALLS)
307       luaG_runerror(L, "C stack overflow");
308     else if (L->nCcalls >= (LUA_MAXCCALLS + (LUA_MAXCCALLS>>3)))
309       luaD_throw(L, LUA_ERRERR);  /* error while handing stack error */
310   }
311   firstResult = luaD_precall(L, func);
312   if (firstResult == NULL)  /* is a Lua function? */
313     firstResult = luaV_execute(L);  /* call it */
314   luaD_poscall(L, nResults, firstResult);
315   L->nCcalls--;
316   luaC_checkGC(L);
317 }
318
319
320 static void resume (lua_State *L, void *ud) {
321   StkId firstResult;
322   int nargs = *cast(int *, ud);
323   CallInfo *ci = L->ci;
324   if (ci == L->base_ci) {  /* no activation record? */
325     lua_assert(nargs < L->top - L->base);
326     luaD_precall(L, L->top - (nargs + 1));  /* start coroutine */
327   }
328   else {  /* inside a yield */
329     lua_assert(ci->state & CI_YIELD);
330     if (ci->state & CI_C) {  /* `common' yield? */
331       /* finish interrupted execution of `OP_CALL' */
332       int nresults;
333       lua_assert((ci-1)->state & CI_SAVEDPC);
334       lua_assert(GET_OPCODE(*((ci-1)->u.l.savedpc - 1)) == OP_CALL ||
335                  GET_OPCODE(*((ci-1)->u.l.savedpc - 1)) == OP_TAILCALL);
336       nresults = GETARG_C(*((ci-1)->u.l.savedpc - 1)) - 1;
337       luaD_poscall(L, nresults, L->top - nargs);  /* complete it */
338       if (nresults >= 0) L->top = L->ci->top;
339     }
340     else {  /* yielded inside a hook: just continue its execution */
341       ci->state &= ~CI_YIELD;
342     }
343   }
344   firstResult = luaV_execute(L);
345   if (firstResult != NULL)   /* return? */
346     luaD_poscall(L, LUA_MULTRET, firstResult);  /* finalize this coroutine */
347 }
348
349
350 static int resume_error (lua_State *L, const char *msg) {
351   L->top = L->ci->base;
352   setsvalue2s(L->top, luaS_new(L, msg));
353   incr_top(L);
354   lua_unlock(L);
355   return LUA_ERRRUN;
356 }
357
358
359 LUA_API int lua_resume (lua_State *L, int nargs) {
360   int status;
361   lu_byte old_allowhooks;
362   lua_lock(L);
363   if (L->ci == L->base_ci) {
364     if (nargs >= L->top - L->base)
365       return resume_error(L, "cannot resume dead coroutine");
366   }
367   else if (!(L->ci->state & CI_YIELD))  /* not inside a yield? */
368     return resume_error(L, "cannot resume non-suspended coroutine");
369   old_allowhooks = L->allowhook;
370   lua_assert(L->errfunc == 0 && L->nCcalls == 0);
371   status = luaD_rawrunprotected(L, resume, &nargs);
372   if (status != 0) {  /* error? */
373     L->ci = L->base_ci;  /* go back to initial level */
374     L->base = L->ci->base;
375     L->nCcalls = 0;
376     luaF_close(L, L->base);  /* close eventual pending closures */
377     seterrorobj(L, status, L->base);
378     L->allowhook = old_allowhooks;
379     restore_stack_limit(L);
380   }
381   lua_unlock(L);
382   return status;
383 }
384
385
386 LUA_API int lua_yield (lua_State *L, int nresults) {
387   CallInfo *ci;
388   lua_lock(L);
389   ci = L->ci;
390   if (L->nCcalls > 0)
391     luaG_runerror(L, "attempt to yield across metamethod/C-call boundary");
392   if (ci->state & CI_C) {  /* usual yield */
393     if ((ci-1)->state & CI_C)
394       luaG_runerror(L, "cannot yield a C function");
395     if (L->top - nresults > L->base) {  /* is there garbage in the stack? */
396       int i;
397       for (i=0; i<nresults; i++)  /* move down results */
398         setobjs2s(L->base + i, L->top - nresults + i);
399       L->top = L->base + nresults;
400     }
401   } /* else it's an yield inside a hook: nothing to do */
402   ci->state |= CI_YIELD;
403   lua_unlock(L);
404   return -1;
405 }
406
407
408 int luaD_pcall (lua_State *L, Pfunc func, void *u,
409                 ptrdiff_t old_top, ptrdiff_t ef) {
410   int status;
411   unsigned short oldnCcalls = L->nCcalls;
412   ptrdiff_t old_ci = saveci(L, L->ci);
413   lu_byte old_allowhooks = L->allowhook;
414   ptrdiff_t old_errfunc = L->errfunc;
415   L->errfunc = ef;
416   status = luaD_rawrunprotected(L, func, u);
417   if (status != 0) {  /* an error occurred? */
418     StkId oldtop = restorestack(L, old_top);
419     luaF_close(L, oldtop);  /* close eventual pending closures */
420     seterrorobj(L, status, oldtop);
421     L->nCcalls = oldnCcalls;
422     L->ci = restoreci(L, old_ci);
423     L->base = L->ci->base;
424     L->allowhook = old_allowhooks;
425     restore_stack_limit(L);
426   }
427   L->errfunc = old_errfunc;
428   return status;
429 }
430
431
432
433 /*
434 ** Execute a protected parser.
435 */
436 struct SParser {  /* data to `f_parser' */
437   ZIO *z;
438   Mbuffer buff;  /* buffer to be used by the scanner */
439   int bin;
440 };
441
442 static void f_parser (lua_State *L, void *ud) {
443   struct SParser *p;
444   Proto *tf;
445   Closure *cl;
446   luaC_checkGC(L);
447   p = cast(struct SParser *, ud);
448   tf = p->bin ? luaU_undump(L, p->z, &p->buff) : luaY_parser(L, p->z, &p->buff);
449   cl = luaF_newLclosure(L, 0, gt(L));
450   cl->l.p = tf;
451   setclvalue(L->top, cl);
452   incr_top(L);
453 }
454
455
456 int luaD_protectedparser (lua_State *L, ZIO *z, int bin) {
457   struct SParser p;
458   int status;
459   ptrdiff_t oldtopr = savestack(L, L->top);  /* save current top */
460   p.z = z; p.bin = bin;
461   luaZ_initbuffer(L, &p.buff);
462   status = luaD_rawrunprotected(L, f_parser, &p);
463   luaZ_freebuffer(L, &p.buff);
464   if (status != 0) {  /* error? */
465     StkId oldtop = restorestack(L, oldtopr);
466     seterrorobj(L, status, oldtop);
467   }
468   return status;
469 }
470
471