gateway: simplify stopping the cleanup timer
[olsrd.git] / lib / tas / src / lua / lvm.c
1
2 /*
3 ** $Id: lvm.c,v 1.284b 2003/04/03 13:35:34 roberto Exp $
4 ** Lua virtual machine
5 ** See Copyright Notice in lua.h
6 */
7
8
9 #include <stdarg.h>
10 #include <stdlib.h>
11 #include <string.h>
12
13 /* needed only when `lua_number2str' uses `sprintf' */
14 #include <stdio.h>
15
16 #define lvm_c
17
18 #include "lua.h"
19
20 #include "ldebug.h"
21 #include "ldo.h"
22 #include "lfunc.h"
23 #include "lgc.h"
24 #include "lobject.h"
25 #include "lopcodes.h"
26 #include "lstate.h"
27 #include "lstring.h"
28 #include "ltable.h"
29 #include "ltm.h"
30 #include "lvm.h"
31
32
33
34 /* function to convert a lua_Number to a string */
35 #ifndef lua_number2str
36 #define lua_number2str(s,n)     sprintf((s), LUA_NUMBER_FMT, (n))
37 #endif
38
39
40 /* limit for table tag-method chains (to avoid loops) */
41 #define MAXTAGLOOP      100
42
43
44 const TObject *
45 luaV_tonumber(const TObject * obj, TObject * n)
46 {
47   lua_Number num;
48   if (ttisnumber(obj))
49     return obj;
50   if (ttisstring(obj) && luaO_str2d(svalue(obj), &num)) {
51     setnvalue(n, num);
52     return n;
53   } else
54     return NULL;
55 }
56
57
58 int
59 luaV_tostring(lua_State * L, StkId obj)
60 {
61   if (!ttisnumber(obj))
62     return 0;
63   else {
64     char s[32];                        /* 16 digits, sign, point and \0  (+ some extra...) */
65     lua_number2str(s, nvalue(obj));
66     setsvalue2s(obj, luaS_new(L, s));
67     return 1;
68   }
69 }
70
71
72 static void
73 traceexec(lua_State * L)
74 {
75   lu_byte mask = L->hookmask;
76   if (mask & LUA_MASKCOUNT) {   /* instruction-hook set? */
77     if (L->hookcount == 0) {
78       resethookcount(L);
79       luaD_callhook(L, LUA_HOOKCOUNT, -1);
80       return;
81     }
82   }
83   if (mask & LUA_MASKLINE) {
84     CallInfo *ci = L->ci;
85     Proto *p = ci_func(ci)->l.p;
86     int newline = getline(p, pcRel(*ci->u.l.pc, p));
87     if (!L->hookinit) {
88       luaG_inithooks(L);
89       return;
90     }
91     lua_assert(ci->state & CI_HASFRAME);
92     if (pcRel(*ci->u.l.pc, p) == 0)     /* tracing may be starting now? */
93       ci->u.l.savedpc = *ci->u.l.pc;    /* initialize `savedpc' */
94     /* calls linehook when enters a new line or jumps back (loop) */
95     if (*ci->u.l.pc <= ci->u.l.savedpc || newline != getline(p, pcRel(ci->u.l.savedpc, p))) {
96       luaD_callhook(L, LUA_HOOKLINE, newline);
97       ci = L->ci;               /* previous call may reallocate `ci' */
98     }
99     ci->u.l.savedpc = *ci->u.l.pc;
100   }
101 }
102
103
104 static void
105 callTMres(lua_State * L, const TObject * f, const TObject * p1, const TObject * p2)
106 {
107   setobj2s(L->top, f);          /* push function */
108   setobj2s(L->top + 1, p1);     /* 1st argument */
109   setobj2s(L->top + 2, p2);     /* 2nd argument */
110   luaD_checkstack(L, 3);        /* cannot check before (could invalidate p1, p2) */
111   L->top += 3;
112   luaD_call(L, L->top - 3, 1);
113   L->top--;                     /* result will be in L->top */
114 }
115
116
117
118 static void
119 callTM(lua_State * L, const TObject * f, const TObject * p1, const TObject * p2, const TObject * p3)
120 {
121   setobj2s(L->top, f);          /* push function */
122   setobj2s(L->top + 1, p1);     /* 1st argument */
123   setobj2s(L->top + 2, p2);     /* 2nd argument */
124   setobj2s(L->top + 3, p3);     /* 3th argument */
125   luaD_checkstack(L, 4);        /* cannot check before (could invalidate p1...p3) */
126   L->top += 4;
127   luaD_call(L, L->top - 4, 0);
128 }
129
130
131 static const TObject *
132 luaV_index(lua_State * L, const TObject * t, TObject * key, int loop)
133 {
134   const TObject *tm = fasttm(L, hvalue(t)->metatable, TM_INDEX);
135   if (tm == NULL)
136     return &luaO_nilobject;     /* no TM */
137   if (ttisfunction(tm)) {
138     callTMres(L, tm, t, key);
139     return L->top;
140   } else
141     return luaV_gettable(L, tm, key, loop);
142 }
143
144 static const TObject *
145 luaV_getnotable(lua_State * L, const TObject * t, TObject * key, int loop)
146 {
147   const TObject *tm = luaT_gettmbyobj(L, t, TM_INDEX);
148   if (ttisnil(tm))
149     luaG_typeerror(L, t, "index");
150   if (ttisfunction(tm)) {
151     callTMres(L, tm, t, key);
152     return L->top;
153   } else
154     return luaV_gettable(L, tm, key, loop);
155 }
156
157
158 /*
159 ** Function to index a table.
160 ** Receives the table at `t' and the key at `key'.
161 ** leaves the result at `res'.
162 */
163 const TObject *
164 luaV_gettable(lua_State * L, const TObject * t, TObject * key, int loop)
165 {
166   if (loop > MAXTAGLOOP)
167     luaG_runerror(L, "loop in gettable");
168   if (ttistable(t)) {           /* `t' is a table? */
169     Table *h = hvalue(t);
170     const TObject *v = luaH_get(h, key);        /* do a primitive get */
171     if (!ttisnil(v))
172       return v;
173     else
174       return luaV_index(L, t, key, loop + 1);
175   } else
176     return luaV_getnotable(L, t, key, loop + 1);
177 }
178
179
180 /*
181 ** Receives table at `t', key at `key' and value at `val'.
182 */
183 void
184 luaV_settable(lua_State * L, const TObject * t, TObject * key, StkId val)
185 {
186   const TObject *tm;
187   int loop = 0;
188   do {
189     if (ttistable(t)) {         /* `t' is a table? */
190       Table *h = hvalue(t);
191       TObject *oldval = luaH_set(L, h, key);    /* do a primitive set */
192       if (!ttisnil(oldval) ||   /* result is no nil? */
193           (tm = fasttm(L, h->metatable, TM_NEWINDEX)) == NULL) {        /* or no TM? */
194         setobj2t(oldval, val);  /* write barrier */
195         return;
196       }
197       /* else will try the tag method */
198     } else if (ttisnil(tm = luaT_gettmbyobj(L, t, TM_NEWINDEX)))
199       luaG_typeerror(L, t, "index");
200     if (ttisfunction(tm)) {
201       callTM(L, tm, t, key, val);
202       return;
203     }
204     t = tm;                     /* else repeat with `tm' */
205   } while (++loop <= MAXTAGLOOP);
206   luaG_runerror(L, "loop in settable");
207 }
208
209
210 static int
211 call_binTM(lua_State * L, const TObject * p1, const TObject * p2, StkId res, TMS event)
212 {
213   ptrdiff_t result = savestack(L, res);
214   const TObject *tm = luaT_gettmbyobj(L, p1, event);    /* try first operand */
215   if (ttisnil(tm))
216     tm = luaT_gettmbyobj(L, p2, event); /* try second operand */
217   if (!ttisfunction(tm))
218     return 0;
219   callTMres(L, tm, p1, p2);
220   res = restorestack(L, result);        /* previous call may change stack */
221   setobjs2s(res, L->top);
222   return 1;
223 }
224
225
226 static const TObject *
227 get_compTM(lua_State * L, Table * mt1, Table * mt2, TMS event)
228 {
229   const TObject *tm1 = fasttm(L, mt1, event);
230   const TObject *tm2;
231   if (tm1 == NULL)
232     return NULL;                /* no metamethod */
233   if (mt1 == mt2)
234     return tm1;                 /* same metatables => same metamethods */
235   tm2 = fasttm(L, mt2, event);
236   if (tm2 == NULL)
237     return NULL;                /* no metamethod */
238   if (luaO_rawequalObj(tm1, tm2))       /* same metamethods? */
239     return tm1;
240   return NULL;
241 }
242
243
244 static int
245 call_orderTM(lua_State * L, const TObject * p1, const TObject * p2, TMS event)
246 {
247   const TObject *tm1 = luaT_gettmbyobj(L, p1, event);
248   const TObject *tm2;
249   if (ttisnil(tm1))
250     return -1;                  /* no metamethod? */
251   tm2 = luaT_gettmbyobj(L, p2, event);
252   if (!luaO_rawequalObj(tm1, tm2))      /* different metamethods? */
253     return -1;
254   callTMres(L, tm1, p1, p2);
255   return !l_isfalse(L->top);
256 }
257
258
259 static int
260 luaV_strcmp(const TString * ls, const TString * rs)
261 {
262   const char *l = getstr(ls);
263   size_t ll = ls->tsv.len;
264   const char *r = getstr(rs);
265   size_t lr = rs->tsv.len;
266   for (;;) {
267     int temp = strcoll(l, r);
268     if (temp != 0)
269       return temp;
270     else {                      /* strings are equal up to a `\0' */
271       size_t len = strlen(l);          /* index of first `\0' in both strings */
272       if (len == lr)            /* r is finished? */
273         return (len == ll) ? 0 : 1;
274       else if (len == ll)       /* l is finished? */
275         return -1;              /* l is smaller than r (because r is not finished) */
276       /* both strings longer than `len'; go on comparing (after the `\0') */
277       len++;
278       l += len;
279       ll -= len;
280       r += len;
281       lr -= len;
282     }
283   }
284 }
285
286
287 int
288 luaV_lessthan(lua_State * L, const TObject * l, const TObject * r)
289 {
290   int res;
291   if (ttype(l) != ttype(r))
292     return luaG_ordererror(L, l, r);
293   else if (ttisnumber(l))
294     return nvalue(l) < nvalue(r);
295   else if (ttisstring(l))
296     return luaV_strcmp(tsvalue(l), tsvalue(r)) < 0;
297   else if ((res = call_orderTM(L, l, r, TM_LT)) != -1)
298     return res;
299   return luaG_ordererror(L, l, r);
300 }
301
302
303 static int
304 luaV_lessequal(lua_State * L, const TObject * l, const TObject * r)
305 {
306   int res;
307   if (ttype(l) != ttype(r))
308     return luaG_ordererror(L, l, r);
309   else if (ttisnumber(l))
310     return nvalue(l) <= nvalue(r);
311   else if (ttisstring(l))
312     return luaV_strcmp(tsvalue(l), tsvalue(r)) <= 0;
313   else if ((res = call_orderTM(L, l, r, TM_LE)) != -1)  /* first try `le' */
314     return res;
315   else if ((res = call_orderTM(L, r, l, TM_LT)) != -1)  /* else try `lt' */
316     return !res;
317   return luaG_ordererror(L, l, r);
318 }
319
320
321 int
322 luaV_equalval(lua_State * L, const TObject * t1, const TObject * t2)
323 {
324   const TObject *tm;
325   lua_assert(ttype(t1) == ttype(t2));
326   switch (ttype(t1)) {
327   case LUA_TNIL:
328     return 1;
329   case LUA_TNUMBER:
330     return nvalue(t1) == nvalue(t2);
331   case LUA_TBOOLEAN:
332     return bvalue(t1) == bvalue(t2);    /* true must be 1 !! */
333   case LUA_TLIGHTUSERDATA:
334     return pvalue(t1) == pvalue(t2);
335   case LUA_TUSERDATA:{
336       if (uvalue(t1) == uvalue(t2))
337         return 1;
338       tm = get_compTM(L, uvalue(t1)->uv.metatable, uvalue(t2)->uv.metatable, TM_EQ);
339       break;                    /* will try TM */
340     }
341   case LUA_TTABLE:{
342       if (hvalue(t1) == hvalue(t2))
343         return 1;
344       tm = get_compTM(L, hvalue(t1)->metatable, hvalue(t2)->metatable, TM_EQ);
345       break;                    /* will try TM */
346     }
347   default:
348     return gcvalue(t1) == gcvalue(t2);
349   }
350   if (tm == NULL)
351     return 0;                   /* no TM? */
352   callTMres(L, tm, t1, t2);     /* call TM */
353   return !l_isfalse(L->top);
354 }
355
356
357 void
358 luaV_concat(lua_State * L, int total, int last)
359 {
360   do {
361     StkId top = L->base + last + 1;
362     int n = 2;                         /* number of elements handled in this pass (at least 2) */
363     if (!tostring(L, top - 2) || !tostring(L, top - 1)) {
364       if (!call_binTM(L, top - 2, top - 1, top - 2, TM_CONCAT))
365         luaG_concaterror(L, top - 2, top - 1);
366     } else if (tsvalue(top - 1)->tsv.len > 0) { /* if len=0, do nothing */
367       /* at least two string values; get as many as possible */
368       lu_mem tl = cast(lu_mem, tsvalue(top - 1)->tsv.len) + cast(lu_mem, tsvalue(top - 2)->tsv.len);
369       char *buffer;
370       int i;
371       while (n < total && tostring(L, top - n - 1)) {   /* collect total length */
372         tl += tsvalue(top - n - 1)->tsv.len;
373         n++;
374       }
375       if (tl > MAX_SIZET)
376         luaG_runerror(L, "string size overflow");
377       buffer = luaZ_openspace(L, &G(L)->buff, tl);
378       tl = 0;
379       for (i = n; i > 0; i--) { /* concat all strings */
380         size_t l = tsvalue(top - i)->tsv.len;
381         memcpy(buffer + tl, svalue(top - i), l);
382         tl += l;
383       }
384       setsvalue2s(top - n, luaS_newlstr(L, buffer, tl));
385     }
386     total -= n - 1;             /* got `n' strings to create 1 new */
387     last -= n - 1;
388   } while (total > 1);          /* repeat until only 1 result left */
389 }
390
391
392 static void
393 Arith(lua_State * L, StkId ra, const TObject * rb, const TObject * rc, TMS op)
394 {
395   TObject tempb, tempc;
396   const TObject *b, *c;
397   if ((b = luaV_tonumber(rb, &tempb)) != NULL && (c = luaV_tonumber(rc, &tempc)) != NULL) {
398     switch (op) {
399     case TM_ADD:
400       setnvalue(ra, nvalue(b) + nvalue(c));
401       break;
402     case TM_SUB:
403       setnvalue(ra, nvalue(b) - nvalue(c));
404       break;
405     case TM_MUL:
406       setnvalue(ra, nvalue(b) * nvalue(c));
407       break;
408     case TM_DIV:
409       setnvalue(ra, nvalue(b) / nvalue(c));
410       break;
411     case TM_POW:{
412         const TObject *f = luaH_getstr(hvalue(gt(L)), G(L)->tmname[TM_POW]);
413         ptrdiff_t res = savestack(L, ra);
414         if (!ttisfunction(f))
415           luaG_runerror(L, "`__pow' (`^' operator) is not a function");
416         callTMres(L, f, b, c);
417         ra = restorestack(L, res);      /* previous call may change stack */
418         setobjs2s(ra, L->top);
419         break;
420       }
421     default:
422       lua_assert(0);
423       break;
424     }
425   } else if (!call_binTM(L, rb, rc, ra, op))
426     luaG_aritherror(L, rb, rc);
427 }
428
429
430
431 /*
432 ** some macros for common tasks in `luaV_execute'
433 */
434
435 #define runtime_check(L, c)     { if (!(c)) return 0; }
436
437 #define RA(i)   (base+GETARG_A(i))
438
439 /* to be used after possible stack reallocation */
440 #define XRA(i)  (L->base+GETARG_A(i))
441 #define RB(i)   (base+GETARG_B(i))
442 #define RKB(i)  ((GETARG_B(i) < MAXSTACK) ? RB(i) : k+GETARG_B(i)-MAXSTACK)
443 #define RC(i)   (base+GETARG_C(i))
444 #define RKC(i)  ((GETARG_C(i) < MAXSTACK) ? RC(i) : k+GETARG_C(i)-MAXSTACK)
445 #define KBx(i)  (k+GETARG_Bx(i))
446
447
448 #define dojump(pc, i)   ((pc) += (i))
449
450
451 StkId
452 luaV_execute(lua_State * L)
453 {
454   LClosure *cl;
455   TObject *k;
456   const Instruction *pc;
457 callentry:                     /* entry point when calling new functions */
458   if (L->hookmask & LUA_MASKCALL) {
459     L->ci->u.l.pc = &pc;
460     luaD_callhook(L, LUA_HOOKCALL, -1);
461   }
462 retentry:                      /* entry point when returning to old functions */
463   L->ci->u.l.pc = &pc;
464   lua_assert(L->ci->state == CI_SAVEDPC || L->ci->state == (CI_SAVEDPC | CI_CALLING));
465   L->ci->state = CI_HASFRAME;   /* activate frame */
466   pc = L->ci->u.l.savedpc;
467   cl = &clvalue(L->base - 1)->l;
468   k = cl->p->k;
469   /* main loop of interpreter */
470   for (;;) {
471     const Instruction i = *pc++;
472     StkId base, ra;
473     if ((L->hookmask & (LUA_MASKLINE | LUA_MASKCOUNT)) && (--L->hookcount == 0 || L->hookmask & LUA_MASKLINE)) {
474       traceexec(L);
475       if (L->ci->state & CI_YIELD) {    /* did hook yield? */
476         L->ci->u.l.savedpc = pc - 1;
477         L->ci->state = CI_YIELD | CI_SAVEDPC;
478         return NULL;
479       }
480     }
481     /* warning!! several calls may realloc the stack and invalidate `ra' */
482     base = L->base;
483     ra = RA(i);
484     lua_assert(L->ci->state & CI_HASFRAME);
485     lua_assert(base == L->ci->base);
486     lua_assert(L->top <= L->stack + L->stacksize && L->top >= base);
487     lua_assert(L->top == L->ci->top ||
488                GET_OPCODE(i) == OP_CALL || GET_OPCODE(i) == OP_TAILCALL ||
489                GET_OPCODE(i) == OP_RETURN || GET_OPCODE(i) == OP_SETLISTO);
490     switch (GET_OPCODE(i)) {
491     case OP_MOVE:{
492         setobjs2s(ra, RB(i));
493         break;
494       }
495     case OP_LOADK:{
496         setobj2s(ra, KBx(i));
497         break;
498       }
499     case OP_LOADBOOL:{
500         setbvalue(ra, GETARG_B(i));
501         if (GETARG_C(i))
502           pc++;                 /* skip next instruction (if C) */
503         break;
504       }
505     case OP_LOADNIL:{
506         TObject *rb = RB(i);
507         do {
508           setnilvalue(rb--);
509         } while (rb >= ra);
510         break;
511       }
512     case OP_GETUPVAL:{
513         int b = GETARG_B(i);
514         setobj2s(ra, cl->upvals[b]->v);
515         break;
516       }
517     case OP_GETGLOBAL:{
518         TObject *rb = KBx(i);
519         const TObject *v;
520         lua_assert(ttisstring(rb) && ttistable(&cl->g));
521         v = luaH_getstr(hvalue(&cl->g), tsvalue(rb));
522         if (!ttisnil(v)) {
523           setobj2s(ra, v);
524         } else
525           setobj2s(XRA(i), luaV_index(L, &cl->g, rb, 0));
526         break;
527       }
528     case OP_GETTABLE:{
529         StkId rb = RB(i);
530         TObject *rc = RKC(i);
531         if (ttistable(rb)) {
532           const TObject *v = luaH_get(hvalue(rb), rc);
533           if (!ttisnil(v)) {
534             setobj2s(ra, v);
535           } else
536             setobj2s(XRA(i), luaV_index(L, rb, rc, 0));
537         } else
538           setobj2s(XRA(i), luaV_getnotable(L, rb, rc, 0));
539         break;
540       }
541     case OP_SETGLOBAL:{
542         lua_assert(ttisstring(KBx(i)) && ttistable(&cl->g));
543         luaV_settable(L, &cl->g, KBx(i), ra);
544         break;
545       }
546     case OP_SETUPVAL:{
547         int b = GETARG_B(i);
548         setobj(cl->upvals[b]->v, ra);   /* write barrier */
549         break;
550       }
551     case OP_SETTABLE:{
552         luaV_settable(L, ra, RKB(i), RKC(i));
553         break;
554       }
555     case OP_NEWTABLE:{
556         int b = GETARG_B(i);
557         b = fb2int(b);
558         sethvalue(ra, luaH_new(L, b, GETARG_C(i)));
559         luaC_checkGC(L);
560         break;
561       }
562     case OP_SELF:{
563         StkId rb = RB(i);
564         TObject *rc = RKC(i);
565         runtime_check(L, ttisstring(rc));
566         setobjs2s(ra + 1, rb);
567         if (ttistable(rb)) {
568           const TObject *v = luaH_getstr(hvalue(rb), tsvalue(rc));
569           if (!ttisnil(v)) {
570             setobj2s(ra, v);
571           } else
572             setobj2s(XRA(i), luaV_index(L, rb, rc, 0));
573         } else
574           setobj2s(XRA(i), luaV_getnotable(L, rb, rc, 0));
575         break;
576       }
577     case OP_ADD:{
578         TObject *rb = RKB(i);
579         TObject *rc = RKC(i);
580         if (ttisnumber(rb) && ttisnumber(rc)) {
581           setnvalue(ra, nvalue(rb) + nvalue(rc));
582         } else
583           Arith(L, ra, rb, rc, TM_ADD);
584         break;
585       }
586     case OP_SUB:{
587         TObject *rb = RKB(i);
588         TObject *rc = RKC(i);
589         if (ttisnumber(rb) && ttisnumber(rc)) {
590           setnvalue(ra, nvalue(rb) - nvalue(rc));
591         } else
592           Arith(L, ra, rb, rc, TM_SUB);
593         break;
594       }
595     case OP_MUL:{
596         TObject *rb = RKB(i);
597         TObject *rc = RKC(i);
598         if (ttisnumber(rb) && ttisnumber(rc)) {
599           setnvalue(ra, nvalue(rb) * nvalue(rc));
600         } else
601           Arith(L, ra, rb, rc, TM_MUL);
602         break;
603       }
604     case OP_DIV:{
605         TObject *rb = RKB(i);
606         TObject *rc = RKC(i);
607         if (ttisnumber(rb) && ttisnumber(rc)) {
608           setnvalue(ra, nvalue(rb) / nvalue(rc));
609         } else
610           Arith(L, ra, rb, rc, TM_DIV);
611         break;
612       }
613     case OP_POW:{
614         Arith(L, ra, RKB(i), RKC(i), TM_POW);
615         break;
616       }
617     case OP_UNM:{
618         const TObject *rb = RB(i);
619         TObject temp;
620         if (tonumber(rb, &temp)) {
621           setnvalue(ra, -nvalue(rb));
622         } else {
623           setnilvalue(&temp);
624           if (!call_binTM(L, RB(i), &temp, ra, TM_UNM))
625             luaG_aritherror(L, RB(i), &temp);
626         }
627         break;
628       }
629     case OP_NOT:{
630         int res = l_isfalse(RB(i));    /* next assignment may change this value */
631         setbvalue(ra, res);
632         break;
633       }
634     case OP_CONCAT:{
635         int b = GETARG_B(i);
636         int c = GETARG_C(i);
637         luaV_concat(L, c - b + 1, c);   /* may change `base' (and `ra') */
638         base = L->base;
639         setobjs2s(RA(i), base + b);
640         luaC_checkGC(L);
641         break;
642       }
643     case OP_JMP:{
644         dojump(pc, GETARG_sBx(i));
645         break;
646       }
647     case OP_EQ:{
648         if (equalobj(L, RKB(i), RKC(i)) != GETARG_A(i))
649           pc++;
650         else
651           dojump(pc, GETARG_sBx(*pc) + 1);
652         break;
653       }
654     case OP_LT:{
655         if (luaV_lessthan(L, RKB(i), RKC(i)) != GETARG_A(i))
656           pc++;
657         else
658           dojump(pc, GETARG_sBx(*pc) + 1);
659         break;
660       }
661     case OP_LE:{
662         if (luaV_lessequal(L, RKB(i), RKC(i)) != GETARG_A(i))
663           pc++;
664         else
665           dojump(pc, GETARG_sBx(*pc) + 1);
666         break;
667       }
668     case OP_TEST:{
669         TObject *rb = RB(i);
670         if (l_isfalse(rb) == GETARG_C(i))
671           pc++;
672         else {
673           setobjs2s(ra, rb);
674           dojump(pc, GETARG_sBx(*pc) + 1);
675         }
676         break;
677       }
678     case OP_CALL:
679     case OP_TAILCALL:{
680         StkId firstResult;
681         int b = GETARG_B(i);
682         int nresults;
683         if (b != 0)
684           L->top = ra + b;      /* else previous instruction set top */
685         nresults = GETARG_C(i) - 1;
686         firstResult = luaD_precall(L, ra);
687         if (firstResult) {
688           if (firstResult > L->top) {   /* yield? */
689             lua_assert(L->ci->state == (CI_C | CI_YIELD));
690             (L->ci - 1)->u.l.savedpc = pc;
691             (L->ci - 1)->state = CI_SAVEDPC;
692             return NULL;
693           }
694           /* it was a C function (`precall' called it); adjust results */
695           luaD_poscall(L, nresults, firstResult);
696           if (nresults >= 0)
697             L->top = L->ci->top;
698         } else {                /* it is a Lua function */
699           if (GET_OPCODE(i) == OP_CALL) {       /* regular call? */
700             (L->ci - 1)->u.l.savedpc = pc;      /* save `pc' to return later */
701             (L->ci - 1)->state = (CI_SAVEDPC | CI_CALLING);
702           } else {              /* tail call: put new frame in place of previous one */
703             int aux;
704             base = (L->ci - 1)->base;   /* `luaD_precall' may change the stack */
705             ra = RA(i);
706             if (L->openupval)
707               luaF_close(L, base);
708             for (aux = 0; ra + aux < L->top; aux++)     /* move frame down */
709               setobjs2s(base + aux - 1, ra + aux);
710             (L->ci - 1)->top = L->top = base + aux;     /* correct top */
711             lua_assert(L->ci->state & CI_SAVEDPC);
712             (L->ci - 1)->u.l.savedpc = L->ci->u.l.savedpc;
713             (L->ci - 1)->u.l.tailcalls++;       /* one more call lost */
714             (L->ci - 1)->state = CI_SAVEDPC;
715             L->ci--;            /* remove new frame */
716             L->base = L->ci->base;
717           }
718           goto callentry;
719         }
720         break;
721       }
722     case OP_RETURN:{
723         CallInfo *ci = L->ci - 1;      /* previous function frame */
724         int b = GETARG_B(i);
725         if (b != 0)
726           L->top = ra + b - 1;
727         lua_assert(L->ci->state & CI_HASFRAME);
728         if (L->openupval)
729           luaF_close(L, base);
730         L->ci->state = CI_SAVEDPC;      /* deactivate current function */
731         L->ci->u.l.savedpc = pc;
732         /* previous function was running `here'? */
733         if (!(ci->state & CI_CALLING)) {
734           lua_assert((ci->state & CI_C) || ci->u.l.pc != &pc);
735           return ra;            /* no: return */
736         } else {                /* yes: continue its execution */
737           int nresults;
738           lua_assert(ttisfunction(ci->base - 1) && (ci->state & CI_SAVEDPC));
739           lua_assert(GET_OPCODE(*(ci->u.l.savedpc - 1)) == OP_CALL);
740           nresults = GETARG_C(*(ci->u.l.savedpc - 1)) - 1;
741           luaD_poscall(L, nresults, ra);
742           if (nresults >= 0)
743             L->top = L->ci->top;
744           goto retentry;
745         }
746       }
747     case OP_FORLOOP:{
748         lua_Number step, idx, limit;
749         const TObject *plimit = ra + 1;
750         const TObject *pstep = ra + 2;
751         if (!ttisnumber(ra))
752           luaG_runerror(L, "`for' initial value must be a number");
753         if (!tonumber(plimit, ra + 1))
754           luaG_runerror(L, "`for' limit must be a number");
755         if (!tonumber(pstep, ra + 2))
756           luaG_runerror(L, "`for' step must be a number");
757         step = nvalue(pstep);
758         idx = nvalue(ra) + step;        /* increment index */
759         limit = nvalue(plimit);
760         if (step > 0 ? idx <= limit : idx >= limit) {
761           dojump(pc, GETARG_sBx(i));    /* jump back */
762           chgnvalue(ra, idx);   /* update index */
763         }
764         break;
765       }
766     case OP_TFORLOOP:{
767         int nvar = GETARG_C(i) + 1;
768         StkId cb = ra + nvar + 2;      /* call base */
769         setobjs2s(cb, ra);
770         setobjs2s(cb + 1, ra + 1);
771         setobjs2s(cb + 2, ra + 2);
772         L->top = cb + 3;        /* func. + 2 args (state and index) */
773         luaD_call(L, cb, nvar);
774         L->top = L->ci->top;
775         ra = XRA(i) + 2;        /* final position of first result */
776         cb = ra + nvar;
777         do {                    /* move results to proper positions */
778           nvar--;
779           setobjs2s(ra + nvar, cb + nvar);
780         } while (nvar > 0);
781         if (ttisnil(ra))        /* break loop? */
782           pc++;                 /* skip jump (break loop) */
783         else
784           dojump(pc, GETARG_sBx(*pc) + 1);      /* jump back */
785         break;
786       }
787     case OP_TFORPREP:{         /* for compatibility only */
788         if (ttistable(ra)) {
789           setobjs2s(ra + 1, ra);
790           setobj2s(ra, luaH_getstr(hvalue(gt(L)), luaS_new(L, "next")));
791         }
792         dojump(pc, GETARG_sBx(i));
793         break;
794       }
795     case OP_SETLIST:
796     case OP_SETLISTO:{
797         int bc;
798         int n;
799         Table *h;
800         runtime_check(L, ttistable(ra));
801         h = hvalue(ra);
802         bc = GETARG_Bx(i);
803         if (GET_OPCODE(i) == OP_SETLIST)
804           n = (bc & (LFIELDS_PER_FLUSH - 1)) + 1;
805         else {
806           n = L->top - ra - 1;
807           L->top = L->ci->top;
808         }
809         bc &= ~(LFIELDS_PER_FLUSH - 1); /* bc = bc - bc%FPF */
810         for (; n > 0; n--)
811           setobj2t(luaH_setnum(L, h, bc + n), ra + n);  /* write barrier */
812         break;
813       }
814     case OP_CLOSE:{
815         luaF_close(L, ra);
816         break;
817       }
818     case OP_CLOSURE:{
819         Proto *p;
820         Closure *ncl;
821         int nup, j;
822         p = cl->p->p[GETARG_Bx(i)];
823         nup = p->nups;
824         ncl = luaF_newLclosure(L, nup, &cl->g);
825         ncl->l.p = p;
826         for (j = 0; j < nup; j++, pc++) {
827           if (GET_OPCODE(*pc) == OP_GETUPVAL)
828             ncl->l.upvals[j] = cl->upvals[GETARG_B(*pc)];
829           else {
830             lua_assert(GET_OPCODE(*pc) == OP_MOVE);
831             ncl->l.upvals[j] = luaF_findupval(L, base + GETARG_B(*pc));
832           }
833         }
834         setclvalue(ra, ncl);
835         luaC_checkGC(L);
836         break;
837       }
838     }
839   }
840 }