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