1 /*

     2 ** $Id: lvm.c,v 2.63.1.3 2007/12/28 15:32:23 roberto Exp $

     3 ** Lua virtual machine

     4 ** See Copyright Notice in lua.h

     5 */

     6 

     7 

     8 #include <stdio.h>

     9 #include <stdlib.h>

    10 #include <string.h>

    11 

    12 #define lvm_c

    13 #define LUA_CORE

    14 

    15 #include "lua.h"

    16 

    17 #include "ldebug.h"

    18 #include "ldo.h"

    19 #include "lfunc.h"

    20 #include "lgc.h"

    21 #include "lobject.h"

    22 #include "lopcodes.h"

    23 #include "lstate.h"

    24 #include "lstring.h"

    25 #include "ltable.h"

    26 #include "ltm.h"

    27 #include "lvm.h"

    28 

    29 

    30 

    31 /* limit for table tag-method chains (to avoid loops) */

    32 #define MAXTAGLOOP	100

    33 

    34 

    35 const TValue *luaV_tonumber (const TValue *obj, TValue *n) {

    36   lua_Number num;

    37   if (ttisnumber(obj)) return obj;

    38   if (ttisstring(obj) && luaO_str2d(svalue(obj), &num)) {

    39     setnvalue(n, num);

    40     return n;

    41   }

    42   else

    43     return NULL;

    44 }

    45 

    46 

    47 int luaV_tostring (lua_State *L, StkId obj) {

    48   if (!ttisnumber(obj))

    49     return 0;

    50   else {

    51     char s[LUAI_MAXNUMBER2STR];

    52     lua_Number n = nvalue(obj);

    53     lua_number2str(s, n);

    54     setsvalue2s(L, obj, luaS_new(L, s));

    55     return 1;

    56   }

    57 }

    58 

    59 

    60 static void traceexec (lua_State *L, const Instruction *pc) {

    61   lu_byte mask = L->hookmask;

    62   const Instruction *oldpc = L->savedpc;

    63   L->savedpc = pc;

    64   if ((mask & LUA_MASKCOUNT) && L->hookcount == 0) {

    65     resethookcount(L);

    66     luaD_callhook(L, LUA_HOOKCOUNT, -1);

    67   }

    68   if (mask & LUA_MASKLINE) {

    69     Proto *p = ci_func(L->ci)->l.p;

    70     int npc = pcRel(pc, p);

    71     int newline = getline(p, npc);

    72     /* call linehook when enter a new function, when jump back (loop),

    73        or when enter a new line */

    74     if (npc == 0 || pc <= oldpc || newline != getline(p, pcRel(oldpc, p)))

    75       luaD_callhook(L, LUA_HOOKLINE, newline);

    76   }

    77 }

    78 

    79 

    80 static void callTMres (lua_State *L, StkId res, const TValue *f,

    81                         const TValue *p1, const TValue *p2) {

    82   ptrdiff_t result = savestack(L, res);

    83   setobj2s(L, L->top, f);  /* push function */

    84   setobj2s(L, L->top+1, p1);  /* 1st argument */

    85   setobj2s(L, L->top+2, p2);  /* 2nd argument */

    86   luaD_checkstack(L, 3);

    87   L->top += 3;

    88   luaD_call(L, L->top - 3, 1);

    89   res = restorestack(L, result);

    90   L->top--;

    91   setobjs2s(L, res, L->top);

    92 }

    93 

    94 

    95 

    96 static void callTM (lua_State *L, const TValue *f, const TValue *p1,

    97                     const TValue *p2, const TValue *p3) {

    98   setobj2s(L, L->top, f);  /* push function */

    99   setobj2s(L, L->top+1, p1);  /* 1st argument */

   100   setobj2s(L, L->top+2, p2);  /* 2nd argument */

   101   setobj2s(L, L->top+3, p3);  /* 3th argument */

   102   luaD_checkstack(L, 4);

   103   L->top += 4;

   104   luaD_call(L, L->top - 4, 0);

   105 }

   106 

   107 

   108 void luaV_gettable (lua_State *L, const TValue *t, TValue *key, StkId val) {

   109   int loop;

   110   for (loop = 0; loop < MAXTAGLOOP; loop++) {

   111     const TValue *tm;

   112     if (ttistable(t)) {  /* `t' is a table? */

   113       Table *h = hvalue(t);

   114       const TValue *res = luaH_get(h, key); /* do a primitive get */

   115       if (!ttisnil(res) ||  /* result is no nil? */

   116           (tm = fasttm(L, h->metatable, TM_INDEX)) == NULL) { /* or no TM? */

   117         setobj2s(L, val, res);

   118         return;

   119       }

   120       /* else will try the tag method */

   121     }

   122     else if (ttisnil(tm = luaT_gettmbyobj(L, t, TM_INDEX)))

   123       luaG_typeerror(L, t, "index");

   124     if (ttisfunction(tm)) {

   125       callTMres(L, val, tm, t, key);

   126       return;

   127     }

   128     t = tm;  /* else repeat with `tm' */ 

   129   }

   130   luaG_runerror(L, "loop in gettable");

   131 }

   132 

   133 

   134 void luaV_settable (lua_State *L, const TValue *t, TValue *key, StkId val) {

   135   int loop;

   136   for (loop = 0; loop < MAXTAGLOOP; loop++) {

   137     const TValue *tm;

   138     if (ttistable(t)) {  /* `t' is a table? */

   139       Table *h = hvalue(t);

   140       TValue *oldval = luaH_set(L, h, key); /* do a primitive set */

   141       if (!ttisnil(oldval) ||  /* result is no nil? */

   142           (tm = fasttm(L, h->metatable, TM_NEWINDEX)) == NULL) { /* or no TM? */

   143         setobj2t(L, oldval, val);

   144         luaC_barriert(L, h, val);

   145         return;

   146       }

   147       /* else will try the tag method */

   148     }

   149     else if (ttisnil(tm = luaT_gettmbyobj(L, t, TM_NEWINDEX)))

   150       luaG_typeerror(L, t, "index");

   151     if (ttisfunction(tm)) {

   152       callTM(L, tm, t, key, val);

   153       return;

   154     }

   155     t = tm;  /* else repeat with `tm' */ 

   156   }

   157   luaG_runerror(L, "loop in settable");

   158 }

   159 

   160 

   161 static int call_binTM (lua_State *L, const TValue *p1, const TValue *p2,

   162                        StkId res, TMS event) {

   163   const TValue *tm = luaT_gettmbyobj(L, p1, event);  /* try first operand */

   164   if (ttisnil(tm))

   165     tm = luaT_gettmbyobj(L, p2, event);  /* try second operand */

   166   if (ttisnil(tm)) return 0;

   167   callTMres(L, res, tm, p1, p2);

   168   return 1;

   169 }

   170 

   171 

   172 static const TValue *get_compTM (lua_State *L, Table *mt1, Table *mt2,

   173                                   TMS event) {

   174   const TValue *tm1 = fasttm(L, mt1, event);

   175   const TValue *tm2;

   176   if (tm1 == NULL) return NULL;  /* no metamethod */

   177   if (mt1 == mt2) return tm1;  /* same metatables => same metamethods */

   178   tm2 = fasttm(L, mt2, event);

   179   if (tm2 == NULL) return NULL;  /* no metamethod */

   180   if (luaO_rawequalObj(tm1, tm2))  /* same metamethods? */

   181     return tm1;

   182   return NULL;

   183 }

   184 

   185 

   186 static int call_orderTM (lua_State *L, const TValue *p1, const TValue *p2,

   187                          TMS event) {

   188   const TValue *tm1 = luaT_gettmbyobj(L, p1, event);

   189   const TValue *tm2;

   190   if (ttisnil(tm1)) return -1;  /* no metamethod? */

   191   tm2 = luaT_gettmbyobj(L, p2, event);

   192   if (!luaO_rawequalObj(tm1, tm2))  /* different metamethods? */

   193     return -1;

   194   callTMres(L, L->top, tm1, p1, p2);

   195   return !l_isfalse(L->top);

   196 }

   197 

   198 

   199 static int l_strcmp (const TString *ls, const TString *rs) {

   200   const char *l = getstr(ls);

   201   size_t ll = ls->tsv.len;

   202   const char *r = getstr(rs);

   203   size_t lr = rs->tsv.len;

   204   for (;;) {

   205     int temp = strcoll(l, r);

   206     if (temp != 0) return temp;

   207     else {  /* strings are equal up to a `\0' */

   208       size_t len = strlen(l);  /* index of first `\0' in both strings */

   209       if (len == lr)  /* r is finished? */

   210         return (len == ll) ? 0 : 1;

   211       else if (len == ll)  /* l is finished? */

   212         return -1;  /* l is smaller than r (because r is not finished) */

   213       /* both strings longer than `len'; go on comparing (after the `\0') */

   214       len++;

   215       l += len; ll -= len; r += len; lr -= len;

   216     }

   217   }

   218 }

   219 

   220 

   221 int luaV_lessthan (lua_State *L, const TValue *l, const TValue *r) {

   222   int res;

   223   if (ttype(l) != ttype(r))

   224     return luaG_ordererror(L, l, r);

   225   else if (ttisnumber(l))

   226     return luai_numlt(nvalue(l), nvalue(r));

   227   else if (ttisstring(l))

   228     return l_strcmp(rawtsvalue(l), rawtsvalue(r)) < 0;

   229   else if ((res = call_orderTM(L, l, r, TM_LT)) != -1)

   230     return res;

   231   return luaG_ordererror(L, l, r);

   232 }

   233 

   234 

   235 static int lessequal (lua_State *L, const TValue *l, const TValue *r) {

   236   int res;

   237   if (ttype(l) != ttype(r))

   238     return luaG_ordererror(L, l, r);

   239   else if (ttisnumber(l))

   240     return luai_numle(nvalue(l), nvalue(r));

   241   else if (ttisstring(l))

   242     return l_strcmp(rawtsvalue(l), rawtsvalue(r)) <= 0;

   243   else if ((res = call_orderTM(L, l, r, TM_LE)) != -1)  /* first try `le' */

   244     return res;

   245   else if ((res = call_orderTM(L, r, l, TM_LT)) != -1)  /* else try `lt' */

   246     return !res;

   247   return luaG_ordererror(L, l, r);

   248 }

   249 

   250 

   251 int luaV_equalval (lua_State *L, const TValue *t1, const TValue *t2) {

   252   const TValue *tm;

   253   lua_assert(ttype(t1) == ttype(t2));

   254   switch (ttype(t1)) {

   255     case LUA_TNIL: return 1;

   256     case LUA_TNUMBER: return luai_numeq(nvalue(t1), nvalue(t2));

   257     case LUA_TBOOLEAN: return bvalue(t1) == bvalue(t2);  /* true must be 1 !! */

   258     case LUA_TLIGHTUSERDATA: return pvalue(t1) == pvalue(t2);

   259     case LUA_TUSERDATA: {

   260       if (uvalue(t1) == uvalue(t2)) return 1;

   261       tm = get_compTM(L, uvalue(t1)->metatable, uvalue(t2)->metatable,

   262                          TM_EQ);

   263       break;  /* will try TM */

   264     }

   265     case LUA_TTABLE: {

   266       if (hvalue(t1) == hvalue(t2)) return 1;

   267       tm = get_compTM(L, hvalue(t1)->metatable, hvalue(t2)->metatable, TM_EQ);

   268       break;  /* will try TM */

   269     }

   270     default: return gcvalue(t1) == gcvalue(t2);

   271   }

   272   if (tm == NULL) return 0;  /* no TM? */

   273   callTMres(L, L->top, tm, t1, t2);  /* call TM */

   274   return !l_isfalse(L->top);

   275 }

   276 

   277 

   278 void luaV_concat (lua_State *L, int total, int last) {

   279   do {

   280     StkId top = L->base + last + 1;

   281     int n = 2;  /* number of elements handled in this pass (at least 2) */

   282     if (!(ttisstring(top-2) || ttisnumber(top-2)) || !tostring(L, top-1)) {

   283       if (!call_binTM(L, top-2, top-1, top-2, TM_CONCAT))

   284         luaG_concaterror(L, top-2, top-1);

   285     } else if (tsvalue(top-1)->len == 0)  /* second op is empty? */

   286       (void)tostring(L, top - 2);  /* result is first op (as string) */

   287     else {

   288       /* at least two string values; get as many as possible */

   289       size_t tl = tsvalue(top-1)->len;

   290       char *buffer;

   291       int i;

   292       /* collect total length */

   293       for (n = 1; n < total && tostring(L, top-n-1); n++) {

   294         size_t l = tsvalue(top-n-1)->len;

   295         if (l >= MAX_SIZET - tl) luaG_runerror(L, "string length overflow");

   296         tl += l;

   297       }

   298       buffer = luaZ_openspace(L, &G(L)->buff, tl);

   299       tl = 0;

   300       for (i=n; i>0; i--) {  /* concat all strings */

   301         size_t l = tsvalue(top-i)->len;

   302         memcpy(buffer+tl, svalue(top-i), l);

   303         tl += l;

   304       }

   305       setsvalue2s(L, top-n, luaS_newlstr(L, buffer, tl));

   306     }

   307     total -= n-1;  /* got `n' strings to create 1 new */

   308     last -= n-1;

   309   } while (total > 1);  /* repeat until only 1 result left */

   310 }

   311 

   312 

   313 static void Arith (lua_State *L, StkId ra, const TValue *rb,

   314                    const TValue *rc, TMS op) {

   315   TValue tempb, tempc;

   316   const TValue *b, *c;

   317   if ((b = luaV_tonumber(rb, &tempb)) != NULL &&

   318       (c = luaV_tonumber(rc, &tempc)) != NULL) {

   319     lua_Number nb = nvalue(b), nc = nvalue(c);

   320     switch (op) {

   321       case TM_ADD: setnvalue(ra, luai_numadd(nb, nc)); break;

   322       case TM_SUB: setnvalue(ra, luai_numsub(nb, nc)); break;

   323       case TM_MUL: setnvalue(ra, luai_nummul(nb, nc)); break;

   324       case TM_DIV: setnvalue(ra, luai_numdiv(nb, nc)); break;

   325       case TM_MOD: setnvalue(ra, luai_nummod(nb, nc)); break;

   326       case TM_POW: setnvalue(ra, luai_numpow(nb, nc)); break;

   327       case TM_UNM: setnvalue(ra, luai_numunm(nb)); break;

   328       default: lua_assert(0); break;

   329     }

   330   }

   331   else if (!call_binTM(L, rb, rc, ra, op))

   332     luaG_aritherror(L, rb, rc);

   333 }

   334 

   335 

   336 

   337 /*

   338 ** some macros for common tasks in `luaV_execute'

   339 */

   340 

   341 #define runtime_check(L, c)	{ if (!(c)) break; }

   342 

   343 #define RA(i)	(base+GETARG_A(i))

   344 /* to be used after possible stack reallocation */

   345 #define RB(i)	check_exp(getBMode(GET_OPCODE(i)) == OpArgR, base+GETARG_B(i))

   346 #define RC(i)	check_exp(getCMode(GET_OPCODE(i)) == OpArgR, base+GETARG_C(i))

   347 #define RKB(i)	check_exp(getBMode(GET_OPCODE(i)) == OpArgK, \

   348 	ISK(GETARG_B(i)) ? k+INDEXK(GETARG_B(i)) : base+GETARG_B(i))

   349 #define RKC(i)	check_exp(getCMode(GET_OPCODE(i)) == OpArgK, \

   350 	ISK(GETARG_C(i)) ? k+INDEXK(GETARG_C(i)) : base+GETARG_C(i))

   351 #define KBx(i)	check_exp(getBMode(GET_OPCODE(i)) == OpArgK, k+GETARG_Bx(i))

   352 

   353 

   354 #define dojump(L,pc,i)	{(pc) += (i); luai_threadyield(L);}

   355 

   356 

   357 #define Protect(x)	{ L->savedpc = pc; {x;}; base = L->base; }

   358 

   359 

   360 #define arith_op(op,tm) { \

   361         TValue *rb = RKB(i); \

   362         TValue *rc = RKC(i); \

   363         if (ttisnumber(rb) && ttisnumber(rc)) { \

   364           lua_Number nb = nvalue(rb), nc = nvalue(rc); \

   365           setnvalue(ra, op(nb, nc)); \

   366         } \

   367         else \

   368           Protect(Arith(L, ra, rb, rc, tm)); \

   369       }

   370 

   371 

   372 

   373 void luaV_execute (lua_State *L, int nexeccalls) {

   374   LClosure *cl;

   375   StkId base;

   376   TValue *k;

   377   const Instruction *pc;

   378  reentry:  /* entry point */

   379   lua_assert(isLua(L->ci));

   380   pc = L->savedpc;

   381   cl = &clvalue(L->ci->func)->l;

   382   base = L->base;

   383   k = cl->p->k;

   384   /* main loop of interpreter */

   385   for (;;) {

   386     const Instruction i = *pc++;

   387     StkId ra;

   388     if ((L->hookmask & (LUA_MASKLINE | LUA_MASKCOUNT)) &&

   389         (--L->hookcount == 0 || L->hookmask & LUA_MASKLINE)) {

   390       traceexec(L, pc);

   391       if (L->status == LUA_YIELD) {  /* did hook yield? */

   392         L->savedpc = pc - 1;

   393         return;

   394       }

   395       base = L->base;

   396     }

   397     /* warning!! several calls may realloc the stack and invalidate `ra' */

   398     ra = RA(i);

   399     lua_assert(base == L->base && L->base == L->ci->base);

   400     lua_assert(base <= L->top && L->top <= L->stack + L->stacksize);

   401     lua_assert(L->top == L->ci->top || luaG_checkopenop(i));

   402     switch (GET_OPCODE(i)) {

   403       case OP_MOVE: {

   404         setobjs2s(L, ra, RB(i));

   405         continue;

   406       }

   407       case OP_LOADK: {

   408         setobj2s(L, ra, KBx(i));

   409         continue;

   410       }

   411       case OP_LOADBOOL: {

   412         setbvalue(ra, GETARG_B(i));

   413         if (GETARG_C(i)) pc++;  /* skip next instruction (if C) */

   414         continue;

   415       }

   416       case OP_LOADNIL: {

   417         TValue *rb = RB(i);

   418         do {

   419           setnilvalue(rb--);

   420         } while (rb >= ra);

   421         continue;

   422       }

   423       case OP_GETUPVAL: {

   424         int b = GETARG_B(i);

   425         setobj2s(L, ra, cl->upvals[b]->v);

   426         continue;

   427       }

   428       case OP_GETGLOBAL: {

   429         TValue g;

   430         TValue *rb = KBx(i);

   431         sethvalue(L, &g, cl->env);

   432         lua_assert(ttisstring(rb));

   433         Protect(luaV_gettable(L, &g, rb, ra));

   434         continue;

   435       }

   436       case OP_GETTABLE: {

   437         Protect(luaV_gettable(L, RB(i), RKC(i), ra));

   438         continue;

   439       }

   440       case OP_SETGLOBAL: {

   441         TValue g;

   442         sethvalue(L, &g, cl->env);

   443         lua_assert(ttisstring(KBx(i)));

   444         Protect(luaV_settable(L, &g, KBx(i), ra));

   445         continue;

   446       }

   447       case OP_SETUPVAL: {

   448         UpVal *uv = cl->upvals[GETARG_B(i)];

   449         setobj(L, uv->v, ra);

   450         luaC_barrier(L, uv, ra);

   451         continue;

   452       }

   453       case OP_SETTABLE: {

   454         Protect(luaV_settable(L, ra, RKB(i), RKC(i)));

   455         continue;

   456       }

   457       case OP_NEWTABLE: {

   458         int b = GETARG_B(i);

   459         int c = GETARG_C(i);

   460         sethvalue(L, ra, luaH_new(L, luaO_fb2int(b), luaO_fb2int(c)));

   461         Protect(luaC_checkGC(L));

   462         continue;

   463       }

   464       case OP_SELF: {

   465         StkId rb = RB(i);

   466         setobjs2s(L, ra+1, rb);

   467         Protect(luaV_gettable(L, rb, RKC(i), ra));

   468         continue;

   469       }

   470       case OP_ADD: {

   471         arith_op(luai_numadd, TM_ADD);

   472         continue;

   473       }

   474       case OP_SUB: {

   475         arith_op(luai_numsub, TM_SUB);

   476         continue;

   477       }

   478       case OP_MUL: {

   479         arith_op(luai_nummul, TM_MUL);

   480         continue;

   481       }

   482       case OP_DIV: {

   483         arith_op(luai_numdiv, TM_DIV);

   484         continue;

   485       }

   486       case OP_MOD: {

   487         arith_op(luai_nummod, TM_MOD);

   488         continue;

   489       }

   490       case OP_POW: {

   491         arith_op(luai_numpow, TM_POW);

   492         continue;

   493       }

   494       case OP_UNM: {

   495         TValue *rb = RB(i);

   496         if (ttisnumber(rb)) {

   497           lua_Number nb = nvalue(rb);

   498           setnvalue(ra, luai_numunm(nb));

   499         }

   500         else {

   501           Protect(Arith(L, ra, rb, rb, TM_UNM));

   502         }

   503         continue;

   504       }

   505       case OP_NOT: {

   506         int res = l_isfalse(RB(i));  /* next assignment may change this value */

   507         setbvalue(ra, res);

   508         continue;

   509       }

   510       case OP_LEN: {

   511         const TValue *rb = RB(i);

   512         switch (ttype(rb)) {

   513           case LUA_TTABLE: {

   514             setnvalue(ra, cast_num(luaH_getn(hvalue(rb))));

   515             break;

   516           }

   517           case LUA_TSTRING: {

   518             setnvalue(ra, cast_num(tsvalue(rb)->len));

   519             break;

   520           }

   521           default: {  /* try metamethod */

   522             Protect(

   523               if (!call_binTM(L, rb, luaO_nilobject, ra, TM_LEN))

   524                 luaG_typeerror(L, rb, "get length of");

   525             )

   526           }

   527         }

   528         continue;

   529       }

   530       case OP_CONCAT: {

   531         int b = GETARG_B(i);

   532         int c = GETARG_C(i);

   533         Protect(luaV_concat(L, c-b+1, c); luaC_checkGC(L));

   534         setobjs2s(L, RA(i), base+b);

   535         continue;

   536       }

   537       case OP_JMP: {

   538         dojump(L, pc, GETARG_sBx(i));

   539         continue;

   540       }

   541       case OP_EQ: {

   542         TValue *rb = RKB(i);

   543         TValue *rc = RKC(i);

   544         Protect(

   545           if (equalobj(L, rb, rc) == GETARG_A(i))

   546             dojump(L, pc, GETARG_sBx(*pc));

   547         )

   548         pc++;

   549         continue;

   550       }

   551       case OP_LT: {

   552         Protect(

   553           if (luaV_lessthan(L, RKB(i), RKC(i)) == GETARG_A(i))

   554             dojump(L, pc, GETARG_sBx(*pc));

   555         )

   556         pc++;

   557         continue;

   558       }

   559       case OP_LE: {

   560         Protect(

   561           if (lessequal(L, RKB(i), RKC(i)) == GETARG_A(i))

   562             dojump(L, pc, GETARG_sBx(*pc));

   563         )

   564         pc++;

   565         continue;

   566       }

   567       case OP_TEST: {

   568         if (l_isfalse(ra) != GETARG_C(i))

   569           dojump(L, pc, GETARG_sBx(*pc));

   570         pc++;

   571         continue;

   572       }

   573       case OP_TESTSET: {

   574         TValue *rb = RB(i);

   575         if (l_isfalse(rb) != GETARG_C(i)) {

   576           setobjs2s(L, ra, rb);

   577           dojump(L, pc, GETARG_sBx(*pc));

   578         }

   579         pc++;

   580         continue;

   581       }

   582       case OP_CALL: {

   583         int b = GETARG_B(i);

   584         int nresults = GETARG_C(i) - 1;

   585         if (b != 0) L->top = ra+b;  /* else previous instruction set top */

   586         L->savedpc = pc;

   587         switch (luaD_precall(L, ra, nresults)) {

   588           case PCRLUA: {

   589             nexeccalls++;

   590             goto reentry;  /* restart luaV_execute over new Lua function */

   591           }

   592           case PCRC: {

   593             /* it was a C function (`precall' called it); adjust results */

   594             if (nresults >= 0) L->top = L->ci->top;

   595             base = L->base;

   596             continue;

   597           }

   598           default: {

   599             return;  /* yield */

   600           }

   601         }

   602       }

   603       case OP_TAILCALL: {

   604         int b = GETARG_B(i);

   605         if (b != 0) L->top = ra+b;  /* else previous instruction set top */

   606         L->savedpc = pc;

   607         lua_assert(GETARG_C(i) - 1 == LUA_MULTRET);

   608         switch (luaD_precall(L, ra, LUA_MULTRET)) {

   609           case PCRLUA: {

   610             /* tail call: put new frame in place of previous one */

   611             CallInfo *ci = L->ci - 1;  /* previous frame */

   612             int aux;

   613             StkId func = ci->func;

   614             StkId pfunc = (ci+1)->func;  /* previous function index */

   615             if (L->openupval) luaF_close(L, ci->base);

   616             L->base = ci->base = ci->func + ((ci+1)->base - pfunc);

   617             for (aux = 0; pfunc+aux < L->top; aux++)  /* move frame down */

   618               setobjs2s(L, func+aux, pfunc+aux);

   619             ci->top = L->top = func+aux;  /* correct top */

   620             lua_assert(L->top == L->base + clvalue(func)->l.p->maxstacksize);

   621             ci->savedpc = L->savedpc;

   622             ci->tailcalls++;  /* one more call lost */

   623             L->ci--;  /* remove new frame */

   624             goto reentry;

   625           }

   626           case PCRC: {  /* it was a C function (`precall' called it) */

   627             base = L->base;

   628             continue;

   629           }

   630           default: {

   631             return;  /* yield */

   632           }

   633         }

   634       }

   635       case OP_RETURN: {

   636         int b = GETARG_B(i);

   637         if (b != 0) L->top = ra+b-1;

   638         if (L->openupval) luaF_close(L, base);

   639         L->savedpc = pc;

   640         b = luaD_poscall(L, ra);

   641         if (--nexeccalls == 0)  /* was previous function running `here'? */

   642           return;  /* no: return */

   643         else {  /* yes: continue its execution */

   644           if (b) L->top = L->ci->top;

   645           lua_assert(isLua(L->ci));

   646           lua_assert(GET_OPCODE(*((L->ci)->savedpc - 1)) == OP_CALL);

   647           goto reentry;

   648         }

   649       }

   650       case OP_FORLOOP: {

   651         lua_Number step = nvalue(ra+2);

   652         lua_Number idx = luai_numadd(nvalue(ra), step); /* increment index */

   653         lua_Number limit = nvalue(ra+1);

   654         if (luai_numlt(0, step) ? luai_numle(idx, limit)

   655                                 : luai_numle(limit, idx)) {

   656           dojump(L, pc, GETARG_sBx(i));  /* jump back */

   657           setnvalue(ra, idx);  /* update internal index... */

   658           setnvalue(ra+3, idx);  /* ...and external index */

   659         }

   660         continue;

   661       }

   662       case OP_FORPREP: {

   663         const TValue *init = ra;

   664         const TValue *plimit = ra+1;

   665         const TValue *pstep = ra+2;

   666         L->savedpc = pc;  /* next steps may throw errors */

   667         if (!tonumber(init, ra))

   668           luaG_runerror(L, LUA_QL("for") " initial value must be a number");

   669         else if (!tonumber(plimit, ra+1))

   670           luaG_runerror(L, LUA_QL("for") " limit must be a number");

   671         else if (!tonumber(pstep, ra+2))

   672           luaG_runerror(L, LUA_QL("for") " step must be a number");

   673         setnvalue(ra, luai_numsub(nvalue(ra), nvalue(pstep)));

   674         dojump(L, pc, GETARG_sBx(i));

   675         continue;

   676       }

   677       case OP_TFORLOOP: {

   678         StkId cb = ra + 3;  /* call base */

   679         setobjs2s(L, cb+2, ra+2);

   680         setobjs2s(L, cb+1, ra+1);

   681         setobjs2s(L, cb, ra);

   682         L->top = cb+3;  /* func. + 2 args (state and index) */

   683         Protect(luaD_call(L, cb, GETARG_C(i)));

   684         L->top = L->ci->top;

   685         cb = RA(i) + 3;  /* previous call may change the stack */

   686         if (!ttisnil(cb)) {  /* continue loop? */

   687           setobjs2s(L, cb-1, cb);  /* save control variable */

   688           dojump(L, pc, GETARG_sBx(*pc));  /* jump back */

   689         }

   690         pc++;

   691         continue;

   692       }

   693       case OP_SETLIST: {

   694         int n = GETARG_B(i);

   695         int c = GETARG_C(i);

   696         int last;

   697         Table *h;

   698         if (n == 0) {

   699           n = cast_int(L->top - ra) - 1;

   700           L->top = L->ci->top;

   701         }

   702         if (c == 0) c = cast_int(*pc++);

   703         runtime_check(L, ttistable(ra));

   704         h = hvalue(ra);

   705         last = ((c-1)*LFIELDS_PER_FLUSH) + n;

   706         if (last > h->sizearray)  /* needs more space? */

   707           luaH_resizearray(L, h, last);  /* pre-alloc it at once */

   708         for (; n > 0; n--) {

   709           TValue *val = ra+n;

   710           setobj2t(L, luaH_setnum(L, h, last--), val);

   711           luaC_barriert(L, h, val);

   712         }

   713         continue;

   714       }

   715       case OP_CLOSE: {

   716         luaF_close(L, ra);

   717         continue;

   718       }

   719       case OP_CLOSURE: {

   720         Proto *p;

   721         Closure *ncl;

   722         int nup, j;

   723         p = cl->p->p[GETARG_Bx(i)];

   724         nup = p->nups;

   725         ncl = luaF_newLclosure(L, nup, cl->env);

   726         ncl->l.p = p;

   727         for (j=0; j<nup; j++, pc++) {

   728           if (GET_OPCODE(*pc) == OP_GETUPVAL)

   729             ncl->l.upvals[j] = cl->upvals[GETARG_B(*pc)];

   730           else {

   731             lua_assert(GET_OPCODE(*pc) == OP_MOVE);

   732             ncl->l.upvals[j] = luaF_findupval(L, base + GETARG_B(*pc));

   733           }

   734         }

   735         setclvalue(L, ra, ncl);

   736         Protect(luaC_checkGC(L));

   737         continue;

   738       }

   739       case OP_VARARG: {

   740         int b = GETARG_B(i) - 1;

   741         int j;

   742         CallInfo *ci = L->ci;

   743         int n = cast_int(ci->base - ci->func) - cl->p->numparams - 1;

   744         if (b == LUA_MULTRET) {

   745           Protect(luaD_checkstack(L, n));

   746           ra = RA(i);  /* previous call may change the stack */

   747           b = n;

   748           L->top = ra + n;

   749         }

   750         for (j = 0; j < b; j++) {

   751           if (j < n) {

   752             setobjs2s(L, ra + j, ci->base - n + j);

   753           }

   754           else {

   755             setnilvalue(ra + j);

   756           }

   757         }

   758         continue;

   759       }

   760     }

   761   }

   762 }

   763