xref: /netbsd-src/external/mit/lua/dist/src/lvm.c (revision 63aea4bd5b445e491ff0389fe27ec78b3099dba3)
1 /*	$NetBSD: lvm.c,v 1.8 2015/10/11 09:21:15 mbalmer Exp $	*/
2 
3 /*
4 ** Id: lvm.c,v 2.245 2015/06/09 15:53:35 roberto Exp
5 ** Lua virtual machine
6 ** See Copyright Notice in lua.h
7 */
8 
9 #define lvm_c
10 #define LUA_CORE
11 
12 #include "lprefix.h"
13 
14 #ifndef _KERNEL
15 #include <float.h>
16 #include <limits.h>
17 #include <math.h>
18 #include <stdio.h>
19 #include <stdlib.h>
20 #include <string.h>
21 #endif
22 
23 #include "lua.h"
24 
25 #include "ldebug.h"
26 #include "ldo.h"
27 #include "lfunc.h"
28 #include "lgc.h"
29 #include "lobject.h"
30 #include "lopcodes.h"
31 #include "lstate.h"
32 #include "lstring.h"
33 #include "ltable.h"
34 #include "ltm.h"
35 #include "lvm.h"
36 
37 
38 /* limit for table tag-method chains (to avoid loops) */
39 #define MAXTAGLOOP	2000
40 
41 
42 #ifndef _KERNEL
43 /*
44 ** 'l_intfitsf' checks whether a given integer can be converted to a
45 ** float without rounding. Used in comparisons. Left undefined if
46 ** all integers fit in a float precisely.
47 */
48 #if !defined(l_intfitsf)
49 
50 /* number of bits in the mantissa of a float */
51 #define NBM		(l_mathlim(MANT_DIG))
52 
53 /*
54 ** Check whether some integers may not fit in a float, that is, whether
55 ** (maxinteger >> NBM) > 0 (that implies (1 << NBM) <= maxinteger).
56 ** (The shifts are done in parts to avoid shifting by more than the size
57 ** of an integer. In a worst case, NBM == 113 for long double and
58 ** sizeof(integer) == 32.)
59 */
60 #if ((((LUA_MAXINTEGER >> (NBM / 4)) >> (NBM / 4)) >> (NBM / 4)) \
61 	>> (NBM - (3 * (NBM / 4))))  >  0
62 
63 #define l_intfitsf(i)  \
64   (-((lua_Integer)1 << NBM) <= (i) && (i) <= ((lua_Integer)1 << NBM))
65 
66 #endif
67 
68 #endif
69 #endif /*_KERNEL */
70 
71 #ifndef _KERNEL
72 /*
73 ** Try to convert a value to a float. The float case is already handled
74 ** by the macro 'tonumber'.
75 */
76 int luaV_tonumber_ (const TValue *obj, lua_Number *n) {
77   TValue v;
78   if (ttisinteger(obj)) {
79     *n = cast_num(ivalue(obj));
80     return 1;
81   }
82   else if (cvt2num(obj) &&  /* string convertible to number? */
83             luaO_str2num(svalue(obj), &v) == vslen(obj) + 1) {
84     *n = nvalue(&v);  /* convert result of 'luaO_str2num' to a float */
85     return 1;
86   }
87   else
88     return 0;  /* conversion failed */
89 }
90 #endif
91 
92 
93 /*
94 ** try to convert a value to an integer, rounding according to 'mode':
95 ** mode == 0: accepts only integral values
96 ** mode == 1: takes the floor of the number
97 ** mode == 2: takes the ceil of the number
98 */
99 int luaV_tointeger (const TValue *obj, lua_Integer *p, int mode) {
100   TValue v;
101  again:
102 #ifndef _KERNEL
103   if (ttisfloat(obj)) {
104     lua_Number n = fltvalue(obj);
105     lua_Number f = l_floor(n);
106     if (n != f) {  /* not an integral value? */
107       if (mode == 0) return 0;  /* fails if mode demands integral value */
108       else if (mode > 1)  /* needs ceil? */
109         f += 1;  /* convert floor to ceil (remember: n != f) */
110     }
111     return lua_numbertointeger(f, p);
112   }
113   else if (ttisinteger(obj)) {
114 #else /* _KERNEL */
115   if (ttisinteger(obj)) {
116     UNUSED(mode);
117 #endif
118     *p = ivalue(obj);
119     return 1;
120   }
121   else if (cvt2num(obj) &&
122             luaO_str2num(svalue(obj), &v) == vslen(obj) + 1) {
123     obj = &v;
124     goto again;  /* convert result from 'luaO_str2num' to an integer */
125   }
126   return 0;  /* conversion failed */
127 }
128 
129 
130 #ifndef _KERNEL
131 /*
132 ** Try to convert a 'for' limit to an integer, preserving the
133 ** semantics of the loop.
134 ** (The following explanation assumes a non-negative step; it is valid
135 ** for negative steps mutatis mutandis.)
136 ** If the limit can be converted to an integer, rounding down, that is
137 ** it.
138 ** Otherwise, check whether the limit can be converted to a number.  If
139 ** the number is too large, it is OK to set the limit as LUA_MAXINTEGER,
140 ** which means no limit.  If the number is too negative, the loop
141 ** should not run, because any initial integer value is larger than the
142 ** limit. So, it sets the limit to LUA_MININTEGER. 'stopnow' corrects
143 ** the extreme case when the initial value is LUA_MININTEGER, in which
144 ** case the LUA_MININTEGER limit would still run the loop once.
145 */
146 static int forlimit (const TValue *obj, lua_Integer *p, lua_Integer step,
147                      int *stopnow) {
148   *stopnow = 0;  /* usually, let loops run */
149   if (!luaV_tointeger(obj, p, (step < 0 ? 2 : 1))) {  /* not fit in integer? */
150     lua_Number n;  /* try to convert to float */
151     if (!tonumber(obj, &n)) /* cannot convert to float? */
152       return 0;  /* not a number */
153     if (luai_numlt(0, n)) {  /* if true, float is larger than max integer */
154       *p = LUA_MAXINTEGER;
155       if (step < 0) *stopnow = 1;
156     }
157     else {  /* float is smaller than min integer */
158       *p = LUA_MININTEGER;
159       if (step >= 0) *stopnow = 1;
160     }
161   }
162   return 1;
163 }
164 #endif
165 
166 
167 /*
168 ** Main function for table access (invoking metamethods if needed).
169 ** Compute 'val = t[key]'
170 */
171 void luaV_gettable (lua_State *L, const TValue *t, TValue *key, StkId val) {
172   int loop;  /* counter to avoid infinite loops */
173   for (loop = 0; loop < MAXTAGLOOP; loop++) {
174     const TValue *tm;
175     if (ttistable(t)) {  /* 't' is a table? */
176       Table *h = hvalue(t);
177       const TValue *res = luaH_get(h, key); /* do a primitive get */
178       if (!ttisnil(res) ||  /* result is not nil? */
179           (tm = fasttm(L, h->metatable, TM_INDEX)) == NULL) { /* or no TM? */
180         setobj2s(L, val, res);  /* result is the raw get */
181         return;
182       }
183       /* else will try metamethod */
184     }
185     else if (ttisnil(tm = luaT_gettmbyobj(L, t, TM_INDEX)))
186       luaG_typeerror(L, t, "index");  /* no metamethod */
187     if (ttisfunction(tm)) {  /* metamethod is a function */
188       luaT_callTM(L, tm, t, key, val, 1);
189       return;
190     }
191     t = tm;  /* else repeat access over 'tm' */
192   }
193   luaG_runerror(L, "gettable chain too long; possible loop");
194 }
195 
196 
197 /*
198 ** Main function for table assignment (invoking metamethods if needed).
199 ** Compute 't[key] = val'
200 */
201 void luaV_settable (lua_State *L, const TValue *t, TValue *key, StkId val) {
202   int loop;  /* counter to avoid infinite loops */
203   for (loop = 0; loop < MAXTAGLOOP; loop++) {
204     const TValue *tm;
205     if (ttistable(t)) {  /* 't' is a table? */
206       Table *h = hvalue(t);
207       TValue *oldval = cast(TValue *, luaH_get(h, key));
208       /* if previous value is not nil, there must be a previous entry
209          in the table; a metamethod has no relevance */
210       if (!ttisnil(oldval) ||
211          /* previous value is nil; must check the metamethod */
212          ((tm = fasttm(L, h->metatable, TM_NEWINDEX)) == NULL &&
213          /* no metamethod; is there a previous entry in the table? */
214          (oldval != luaO_nilobject ||
215          /* no previous entry; must create one. (The next test is
216             always true; we only need the assignment.) */
217          (oldval = luaH_newkey(L, h, key), 1)))) {
218         /* no metamethod and (now) there is an entry with given key */
219         setobj2t(L, oldval, val);  /* assign new value to that entry */
220         invalidateTMcache(h);
221         luaC_barrierback(L, h, val);
222         return;
223       }
224       /* else will try the metamethod */
225     }
226     else  /* not a table; check metamethod */
227       if (ttisnil(tm = luaT_gettmbyobj(L, t, TM_NEWINDEX)))
228         luaG_typeerror(L, t, "index");
229     /* try the metamethod */
230     if (ttisfunction(tm)) {
231       luaT_callTM(L, tm, t, key, val, 0);
232       return;
233     }
234     t = tm;  /* else repeat assignment over 'tm' */
235   }
236   luaG_runerror(L, "settable chain too long; possible loop");
237 }
238 
239 
240 /*
241 ** Compare two strings 'ls' x 'rs', returning an integer smaller-equal-
242 ** -larger than zero if 'ls' is smaller-equal-larger than 'rs'.
243 ** The code is a little tricky because it allows '\0' in the strings
244 ** and it uses 'strcoll' (to respect locales) for each segments
245 ** of the strings.
246 */
247 static int l_strcmp (const TString *ls, const TString *rs) {
248   const char *l = getstr(ls);
249   size_t ll = tsslen(ls);
250   const char *r = getstr(rs);
251   size_t lr = tsslen(rs);
252   for (;;) {  /* for each segment */
253     int temp = strcoll(l, r);
254     if (temp != 0)  /* not equal? */
255       return temp;  /* done */
256     else {  /* strings are equal up to a '\0' */
257       size_t len = strlen(l);  /* index of first '\0' in both strings */
258       if (len == lr)  /* 'rs' is finished? */
259         return (len == ll) ? 0 : 1;  /* check 'ls' */
260       else if (len == ll)  /* 'ls' is finished? */
261         return -1;  /* 'ls' is smaller than 'rs' ('rs' is not finished) */
262       /* both strings longer than 'len'; go on comparing after the '\0' */
263       len++;
264       l += len; ll -= len; r += len; lr -= len;
265     }
266   }
267 }
268 
269 
270 /*
271 ** Check whether integer 'i' is less than float 'f'. If 'i' has an
272 ** exact representation as a float ('l_intfitsf'), compare numbers as
273 ** floats. Otherwise, if 'f' is outside the range for integers, result
274 ** is trivial. Otherwise, compare them as integers. (When 'i' has no
275 ** float representation, either 'f' is "far away" from 'i' or 'f' has
276 ** no precision left for a fractional part; either way, how 'f' is
277 ** truncated is irrelevant.) When 'f' is NaN, comparisons must result
278 ** in false.
279 */
280 static int LTintfloat (lua_Integer i, lua_Number f) {
281 #if defined(l_intfitsf)
282   if (!l_intfitsf(i)) {
283     if (f >= -cast_num(LUA_MININTEGER))  /* -minint == maxint + 1 */
284       return 1;  /* f >= maxint + 1 > i */
285     else if (f > cast_num(LUA_MININTEGER))  /* minint < f <= maxint ? */
286       return (i < cast(lua_Integer, f));  /* compare them as integers */
287     else  /* f <= minint <= i (or 'f' is NaN)  -->  not(i < f) */
288       return 0;
289   }
290 #endif
291   return luai_numlt(cast_num(i), f);  /* compare them as floats */
292 }
293 
294 
295 /*
296 ** Check whether integer 'i' is less than or equal to float 'f'.
297 ** See comments on previous function.
298 */
299 static int LEintfloat (lua_Integer i, lua_Number f) {
300 #if defined(l_intfitsf)
301   if (!l_intfitsf(i)) {
302     if (f >= -cast_num(LUA_MININTEGER))  /* -minint == maxint + 1 */
303       return 1;  /* f >= maxint + 1 > i */
304     else if (f >= cast_num(LUA_MININTEGER))  /* minint <= f <= maxint ? */
305       return (i <= cast(lua_Integer, f));  /* compare them as integers */
306     else  /* f < minint <= i (or 'f' is NaN)  -->  not(i <= f) */
307       return 0;
308   }
309 #endif
310   return luai_numle(cast_num(i), f);  /* compare them as floats */
311 }
312 
313 
314 /*
315 ** Return 'l < r', for numbers.
316 */
317 static int LTnum (const TValue *l, const TValue *r) {
318 #ifdef _KERNEL
319     lua_Integer li = ivalue(l);
320     return li < ivalue(r);  /* both must be integers */
321 #else
322   if (ttisinteger(l)) {
323     lua_Integer li = ivalue(l);
324     if (ttisinteger(r))
325       return li < ivalue(r);  /* both are integers */
326     else  /* 'l' is int and 'r' is float */
327       return LTintfloat(li, fltvalue(r));  /* l < r ? */
328   }
329   else {
330     lua_Number lf = fltvalue(l);  /* 'l' must be float */
331     if (ttisfloat(r))
332       return luai_numlt(lf, fltvalue(r));  /* both are float */
333     else if (luai_numisnan(lf))  /* 'r' is int and 'l' is float */
334       return 0;  /* NaN < i is always false */
335     else  /* without NaN, (l < r)  <-->  not(r <= l) */
336       return !LEintfloat(ivalue(r), lf);  /* not (r <= l) ? */
337   }
338 #endif
339 }
340 
341 
342 /*
343 ** Return 'l <= r', for numbers.
344 */
345 static int LEnum (const TValue *l, const TValue *r) {
346 #ifdef _KERNEL
347     lua_Integer li = ivalue(l);
348     return li <= ivalue(r);  /* both must be integers */
349 #else
350   if (ttisinteger(l)) {
351     lua_Integer li = ivalue(l);
352     if (ttisinteger(r))
353       return li <= ivalue(r);  /* both are integers */
354     else  /* 'l' is int and 'r' is float */
355       return LEintfloat(li, fltvalue(r));  /* l <= r ? */
356   }
357   else {
358     lua_Number lf = fltvalue(l);  /* 'l' must be float */
359     if (ttisfloat(r))
360       return luai_numle(lf, fltvalue(r));  /* both are float */
361     else if (luai_numisnan(lf))  /* 'r' is int and 'l' is float */
362       return 0;  /*  NaN <= i is always false */
363     else  /* without NaN, (l <= r)  <-->  not(r < l) */
364       return !LTintfloat(ivalue(r), lf);  /* not (r < l) ? */
365   }
366 #endif
367 }
368 
369 
370 /*
371 ** Main operation less than; return 'l < r'.
372 */
373 int luaV_lessthan (lua_State *L, const TValue *l, const TValue *r) {
374   int res;
375   if (ttisnumber(l) && ttisnumber(r))  /* both operands are numbers? */
376     return LTnum(l, r);
377   else if (ttisstring(l) && ttisstring(r))  /* both are strings? */
378     return l_strcmp(tsvalue(l), tsvalue(r)) < 0;
379   else if ((res = luaT_callorderTM(L, l, r, TM_LT)) < 0)  /* no metamethod? */
380     luaG_ordererror(L, l, r);  /* error */
381   return res;
382 }
383 
384 
385 /*
386 ** Main operation less than or equal to; return 'l <= r'. If it needs
387 ** a metamethod and there is no '__le', try '__lt', based on
388 ** l <= r iff !(r < l) (assuming a total order). If the metamethod
389 ** yields during this substitution, the continuation has to know
390 ** about it (to negate the result of r<l); bit CIST_LEQ in the call
391 ** status keeps that information.
392 */
393 int luaV_lessequal (lua_State *L, const TValue *l, const TValue *r) {
394   int res;
395   if (ttisnumber(l) && ttisnumber(r))  /* both operands are numbers? */
396     return LEnum(l, r);
397   else if (ttisstring(l) && ttisstring(r))  /* both are strings? */
398     return l_strcmp(tsvalue(l), tsvalue(r)) <= 0;
399   else if ((res = luaT_callorderTM(L, l, r, TM_LE)) >= 0)  /* try 'le' */
400     return res;
401   else {  /* try 'lt': */
402     L->ci->callstatus |= CIST_LEQ;  /* mark it is doing 'lt' for 'le' */
403     res = luaT_callorderTM(L, r, l, TM_LT);
404     L->ci->callstatus ^= CIST_LEQ;  /* clear mark */
405     if (res < 0)
406       luaG_ordererror(L, l, r);
407     return !res;  /* result is negated */
408   }
409 }
410 
411 
412 /*
413 ** Main operation for equality of Lua values; return 't1 == t2'.
414 ** L == NULL means raw equality (no metamethods)
415 */
416 int luaV_equalobj (lua_State *L, const TValue *t1, const TValue *t2) {
417   const TValue *tm;
418   if (ttype(t1) != ttype(t2)) {  /* not the same variant? */
419 #ifndef _KERNEL
420     if (ttnov(t1) != ttnov(t2) || ttnov(t1) != LUA_TNUMBER)
421       return 0;  /* only numbers can be equal with different variants */
422     else {  /* two numbers with different variants */
423       lua_Integer i1, i2;  /* compare them as integers */
424       return (tointeger(t1, &i1) && tointeger(t2, &i2) && i1 == i2);
425     }
426 #else /* _KERNEL */
427       return 0; /* numbers have only the integer variant */
428 #endif
429   }
430   /* values have same type and same variant */
431   switch (ttype(t1)) {
432     case LUA_TNIL: return 1;
433     case LUA_TNUMINT: return (ivalue(t1) == ivalue(t2));
434 #ifndef _KERNEL
435     case LUA_TNUMFLT: return luai_numeq(fltvalue(t1), fltvalue(t2));
436 #endif
437     case LUA_TBOOLEAN: return bvalue(t1) == bvalue(t2);  /* true must be 1 !! */
438     case LUA_TLIGHTUSERDATA: return pvalue(t1) == pvalue(t2);
439     case LUA_TLCF: return fvalue(t1) == fvalue(t2);
440     case LUA_TSHRSTR: return eqshrstr(tsvalue(t1), tsvalue(t2));
441     case LUA_TLNGSTR: return luaS_eqlngstr(tsvalue(t1), tsvalue(t2));
442     case LUA_TUSERDATA: {
443       if (uvalue(t1) == uvalue(t2)) return 1;
444       else if (L == NULL) return 0;
445       tm = fasttm(L, uvalue(t1)->metatable, TM_EQ);
446       if (tm == NULL)
447         tm = fasttm(L, uvalue(t2)->metatable, TM_EQ);
448       break;  /* will try TM */
449     }
450     case LUA_TTABLE: {
451       if (hvalue(t1) == hvalue(t2)) return 1;
452       else if (L == NULL) return 0;
453       tm = fasttm(L, hvalue(t1)->metatable, TM_EQ);
454       if (tm == NULL)
455         tm = fasttm(L, hvalue(t2)->metatable, TM_EQ);
456       break;  /* will try TM */
457     }
458     default:
459       return gcvalue(t1) == gcvalue(t2);
460   }
461   if (tm == NULL)  /* no TM? */
462     return 0;  /* objects are different */
463   luaT_callTM(L, tm, t1, t2, L->top, 1);  /* call TM */
464   return !l_isfalse(L->top);
465 }
466 
467 
468 /* macro used by 'luaV_concat' to ensure that element at 'o' is a string */
469 #define tostring(L,o)  \
470 	(ttisstring(o) || (cvt2str(o) && (luaO_tostring(L, o), 1)))
471 
472 #define isemptystr(o)	(ttisshrstring(o) && tsvalue(o)->shrlen == 0)
473 
474 /*
475 ** Main operation for concatenation: concat 'total' values in the stack,
476 ** from 'L->top - total' up to 'L->top - 1'.
477 */
478 void luaV_concat (lua_State *L, int total) {
479   lua_assert(total >= 2);
480   do {
481     StkId top = L->top;
482     int n = 2;  /* number of elements handled in this pass (at least 2) */
483     if (!(ttisstring(top-2) || cvt2str(top-2)) || !tostring(L, top-1))
484       luaT_trybinTM(L, top-2, top-1, top-2, TM_CONCAT);
485     else if (isemptystr(top - 1))  /* second operand is empty? */
486       cast_void(tostring(L, top - 2));  /* result is first operand */
487     else if (isemptystr(top - 2)) {  /* first operand is an empty string? */
488       setobjs2s(L, top - 2, top - 1);  /* result is second op. */
489     }
490     else {
491       /* at least two non-empty string values; get as many as possible */
492       size_t tl = vslen(top - 1);
493       char *buffer;
494       int i;
495       /* collect total length */
496       for (i = 1; i < total && tostring(L, top-i-1); i++) {
497         size_t l = vslen(top - i - 1);
498         if (l >= (MAX_SIZE/sizeof(char)) - tl)
499           luaG_runerror(L, "string length overflow");
500         tl += l;
501       }
502       buffer = luaZ_openspace(L, &G(L)->buff, tl);
503       tl = 0;
504       n = i;
505       do {  /* copy all strings to buffer */
506         size_t l = vslen(top - i);
507         memcpy(buffer+tl, svalue(top-i), l * sizeof(char));
508         tl += l;
509       } while (--i > 0);
510       setsvalue2s(L, top-n, luaS_newlstr(L, buffer, tl));  /* create result */
511     }
512     total -= n-1;  /* got 'n' strings to create 1 new */
513     L->top -= n-1;  /* popped 'n' strings and pushed one */
514   } while (total > 1);  /* repeat until only 1 result left */
515 }
516 
517 
518 /*
519 ** Main operation 'ra' = #rb'.
520 */
521 void luaV_objlen (lua_State *L, StkId ra, const TValue *rb) {
522   const TValue *tm;
523   switch (ttype(rb)) {
524     case LUA_TTABLE: {
525       Table *h = hvalue(rb);
526       tm = fasttm(L, h->metatable, TM_LEN);
527       if (tm) break;  /* metamethod? break switch to call it */
528       setivalue(ra, luaH_getn(h));  /* else primitive len */
529       return;
530     }
531     case LUA_TSHRSTR: {
532       setivalue(ra, tsvalue(rb)->shrlen);
533       return;
534     }
535     case LUA_TLNGSTR: {
536       setivalue(ra, tsvalue(rb)->u.lnglen);
537       return;
538     }
539     default: {  /* try metamethod */
540       tm = luaT_gettmbyobj(L, rb, TM_LEN);
541       if (ttisnil(tm))  /* no metamethod? */
542         luaG_typeerror(L, rb, "get length of");
543       break;
544     }
545   }
546   luaT_callTM(L, tm, rb, rb, ra, 1);
547 }
548 
549 
550 /*
551 ** Integer division; return 'm // n', that is, floor(m/n).
552 ** C division truncates its result (rounds towards zero).
553 ** 'floor(q) == trunc(q)' when 'q >= 0' or when 'q' is integer,
554 ** otherwise 'floor(q) == trunc(q) - 1'.
555 */
556 lua_Integer luaV_div (lua_State *L, lua_Integer m, lua_Integer n) {
557   if (l_castS2U(n) + 1u <= 1u) {  /* special cases: -1 or 0 */
558     if (n == 0)
559       luaG_runerror(L, "attempt to divide by zero");
560     return intop(-, 0, m);   /* n==-1; avoid overflow with 0x80000...//-1 */
561   }
562   else {
563     lua_Integer q = m / n;  /* perform C division */
564     if ((m ^ n) < 0 && m % n != 0)  /* 'm/n' would be negative non-integer? */
565       q -= 1;  /* correct result for different rounding */
566     return q;
567   }
568 }
569 
570 
571 /*
572 ** Integer modulus; return 'm % n'. (Assume that C '%' with
573 ** negative operands follows C99 behavior. See previous comment
574 ** about luaV_div.)
575 */
576 lua_Integer luaV_mod (lua_State *L, lua_Integer m, lua_Integer n) {
577   if (l_castS2U(n) + 1u <= 1u) {  /* special cases: -1 or 0 */
578     if (n == 0)
579       luaG_runerror(L, "attempt to perform 'n%%0'");
580     return 0;   /* m % -1 == 0; avoid overflow with 0x80000...%-1 */
581   }
582   else {
583     lua_Integer r = m % n;
584     if (r != 0 && (m ^ n) < 0)  /* 'm/n' would be non-integer negative? */
585       r += n;  /* correct result for different rounding */
586     return r;
587   }
588 }
589 
590 
591 /* number of bits in an integer */
592 #define NBITS	cast_int(sizeof(lua_Integer) * CHAR_BIT)
593 
594 /*
595 ** Shift left operation. (Shift right just negates 'y'.)
596 */
597 lua_Integer luaV_shiftl (lua_Integer x, lua_Integer y) {
598   if (y < 0) {  /* shift right? */
599     if (y <= -NBITS) return 0;
600     else return intop(>>, x, -y);
601   }
602   else {  /* shift left */
603     if (y >= NBITS) return 0;
604     else return intop(<<, x, y);
605   }
606 }
607 
608 
609 /*
610 ** check whether cached closure in prototype 'p' may be reused, that is,
611 ** whether there is a cached closure with the same upvalues needed by
612 ** new closure to be created.
613 */
614 static LClosure *getcached (Proto *p, UpVal **encup, StkId base) {
615   LClosure *c = p->cache;
616   if (c != NULL) {  /* is there a cached closure? */
617     int nup = p->sizeupvalues;
618     Upvaldesc *uv = p->upvalues;
619     int i;
620     for (i = 0; i < nup; i++) {  /* check whether it has right upvalues */
621       TValue *v = uv[i].instack ? base + uv[i].idx : encup[uv[i].idx]->v;
622       if (c->upvals[i]->v != v)
623         return NULL;  /* wrong upvalue; cannot reuse closure */
624     }
625   }
626   return c;  /* return cached closure (or NULL if no cached closure) */
627 }
628 
629 
630 /*
631 ** create a new Lua closure, push it in the stack, and initialize
632 ** its upvalues. Note that the closure is not cached if prototype is
633 ** already black (which means that 'cache' was already cleared by the
634 ** GC).
635 */
636 static void pushclosure (lua_State *L, Proto *p, UpVal **encup, StkId base,
637                          StkId ra) {
638   int nup = p->sizeupvalues;
639   Upvaldesc *uv = p->upvalues;
640   int i;
641   LClosure *ncl = luaF_newLclosure(L, nup);
642   ncl->p = p;
643   setclLvalue(L, ra, ncl);  /* anchor new closure in stack */
644   for (i = 0; i < nup; i++) {  /* fill in its upvalues */
645     if (uv[i].instack)  /* upvalue refers to local variable? */
646       ncl->upvals[i] = luaF_findupval(L, base + uv[i].idx);
647     else  /* get upvalue from enclosing function */
648       ncl->upvals[i] = encup[uv[i].idx];
649     ncl->upvals[i]->refcount++;
650     /* new closure is white, so we do not need a barrier here */
651   }
652   if (!isblack(p))  /* cache will not break GC invariant? */
653     p->cache = ncl;  /* save it on cache for reuse */
654 }
655 
656 
657 /*
658 ** finish execution of an opcode interrupted by an yield
659 */
660 void luaV_finishOp (lua_State *L) {
661   CallInfo *ci = L->ci;
662   StkId base = ci->u.l.base;
663   Instruction inst = *(ci->u.l.savedpc - 1);  /* interrupted instruction */
664   OpCode op = GET_OPCODE(inst);
665   switch (op) {  /* finish its execution */
666 #ifndef _KERNEL
667     case OP_ADD: case OP_SUB: case OP_MUL: case OP_DIV: case OP_IDIV:
668 #else
669     case OP_ADD: case OP_SUB: case OP_MUL: case OP_IDIV:
670 #endif
671     case OP_BAND: case OP_BOR: case OP_BXOR: case OP_SHL: case OP_SHR:
672 #ifndef _KERNEL
673     case OP_MOD: case OP_POW:
674 #else
675     case OP_MOD:
676 #endif
677     case OP_UNM: case OP_BNOT: case OP_LEN:
678     case OP_GETTABUP: case OP_GETTABLE: case OP_SELF: {
679       setobjs2s(L, base + GETARG_A(inst), --L->top);
680       break;
681     }
682     case OP_LE: case OP_LT: case OP_EQ: {
683       int res = !l_isfalse(L->top - 1);
684       L->top--;
685       if (ci->callstatus & CIST_LEQ) {  /* "<=" using "<" instead? */
686         lua_assert(op == OP_LE);
687         ci->callstatus ^= CIST_LEQ;  /* clear mark */
688         res = !res;  /* negate result */
689       }
690       lua_assert(GET_OPCODE(*ci->u.l.savedpc) == OP_JMP);
691       if (res != GETARG_A(inst))  /* condition failed? */
692         ci->u.l.savedpc++;  /* skip jump instruction */
693       break;
694     }
695     case OP_CONCAT: {
696       StkId top = L->top - 1;  /* top when 'luaT_trybinTM' was called */
697       int b = GETARG_B(inst);      /* first element to concatenate */
698       int total = cast_int(top - 1 - (base + b));  /* yet to concatenate */
699       setobj2s(L, top - 2, top);  /* put TM result in proper position */
700       if (total > 1) {  /* are there elements to concat? */
701         L->top = top - 1;  /* top is one after last element (at top-2) */
702         luaV_concat(L, total);  /* concat them (may yield again) */
703       }
704       /* move final result to final position */
705       setobj2s(L, ci->u.l.base + GETARG_A(inst), L->top - 1);
706       L->top = ci->top;  /* restore top */
707       break;
708     }
709     case OP_TFORCALL: {
710       lua_assert(GET_OPCODE(*ci->u.l.savedpc) == OP_TFORLOOP);
711       L->top = ci->top;  /* correct top */
712       break;
713     }
714     case OP_CALL: {
715       if (GETARG_C(inst) - 1 >= 0)  /* nresults >= 0? */
716         L->top = ci->top;  /* adjust results */
717       break;
718     }
719     case OP_TAILCALL: case OP_SETTABUP: case OP_SETTABLE:
720       break;
721     default: lua_assert(0);
722   }
723 }
724 
725 
726 
727 
728 /*
729 ** {==================================================================
730 ** Function 'luaV_execute': main interpreter loop
731 ** ===================================================================
732 */
733 
734 
735 /*
736 ** some macros for common tasks in 'luaV_execute'
737 */
738 
739 #if !defined(luai_runtimecheck)
740 #define luai_runtimecheck(L, c)		/* void */
741 #endif
742 
743 
744 #define RA(i)	(base+GETARG_A(i))
745 /* to be used after possible stack reallocation */
746 #define RB(i)	check_exp(getBMode(GET_OPCODE(i)) == OpArgR, base+GETARG_B(i))
747 #define RC(i)	check_exp(getCMode(GET_OPCODE(i)) == OpArgR, base+GETARG_C(i))
748 #define RKB(i)	check_exp(getBMode(GET_OPCODE(i)) == OpArgK, \
749 	ISK(GETARG_B(i)) ? k+INDEXK(GETARG_B(i)) : base+GETARG_B(i))
750 #define RKC(i)	check_exp(getCMode(GET_OPCODE(i)) == OpArgK, \
751 	ISK(GETARG_C(i)) ? k+INDEXK(GETARG_C(i)) : base+GETARG_C(i))
752 #define KBx(i)  \
753   (k + (GETARG_Bx(i) != 0 ? GETARG_Bx(i) - 1 : GETARG_Ax(*ci->u.l.savedpc++)))
754 
755 
756 /* execute a jump instruction */
757 #define dojump(ci,i,e) \
758   { int a = GETARG_A(i); \
759     if (a > 0) luaF_close(L, ci->u.l.base + a - 1); \
760     ci->u.l.savedpc += GETARG_sBx(i) + e; }
761 
762 /* for test instructions, execute the jump instruction that follows it */
763 #define donextjump(ci)	{ i = *ci->u.l.savedpc; dojump(ci, i, 1); }
764 
765 
766 #define Protect(x)	{ {x;}; base = ci->u.l.base; }
767 
768 #define checkGC(L,c)  \
769   Protect( luaC_condGC(L,{L->top = (c);  /* limit of live values */ \
770                           luaC_step(L); \
771                           L->top = ci->top;})  /* restore top */ \
772            luai_threadyield(L); )
773 
774 
775 #define vmdispatch(o)	switch(o)
776 #define vmcase(l)	case l:
777 #define vmbreak		break
778 
779 void luaV_execute (lua_State *L) {
780   CallInfo *ci = L->ci;
781   LClosure *cl;
782   TValue *k;
783   StkId base;
784  newframe:  /* reentry point when frame changes (call/return) */
785   lua_assert(ci == L->ci);
786   cl = clLvalue(ci->func);
787   k = cl->p->k;
788   base = ci->u.l.base;
789   /* main loop of interpreter */
790   for (;;) {
791     Instruction i = *(ci->u.l.savedpc++);
792     StkId ra;
793     if ((L->hookmask & (LUA_MASKLINE | LUA_MASKCOUNT)) &&
794         (--L->hookcount == 0 || L->hookmask & LUA_MASKLINE)) {
795       Protect(luaG_traceexec(L));
796     }
797     /* WARNING: several calls may realloc the stack and invalidate 'ra' */
798     ra = RA(i);
799     lua_assert(base == ci->u.l.base);
800     lua_assert(base <= L->top && L->top < L->stack + L->stacksize);
801     vmdispatch (GET_OPCODE(i)) {
802       vmcase(OP_MOVE) {
803         setobjs2s(L, ra, RB(i));
804         vmbreak;
805       }
806       vmcase(OP_LOADK) {
807         TValue *rb = k + GETARG_Bx(i);
808         setobj2s(L, ra, rb);
809         vmbreak;
810       }
811       vmcase(OP_LOADKX) {
812         TValue *rb;
813         lua_assert(GET_OPCODE(*ci->u.l.savedpc) == OP_EXTRAARG);
814         rb = k + GETARG_Ax(*ci->u.l.savedpc++);
815         setobj2s(L, ra, rb);
816         vmbreak;
817       }
818       vmcase(OP_LOADBOOL) {
819         setbvalue(ra, GETARG_B(i));
820         if (GETARG_C(i)) ci->u.l.savedpc++;  /* skip next instruction (if C) */
821         vmbreak;
822       }
823       vmcase(OP_LOADNIL) {
824         int b = GETARG_B(i);
825         do {
826           setnilvalue(ra++);
827         } while (b--);
828         vmbreak;
829       }
830       vmcase(OP_GETUPVAL) {
831         int b = GETARG_B(i);
832         setobj2s(L, ra, cl->upvals[b]->v);
833         vmbreak;
834       }
835       vmcase(OP_GETTABUP) {
836         int b = GETARG_B(i);
837         Protect(luaV_gettable(L, cl->upvals[b]->v, RKC(i), ra));
838         vmbreak;
839       }
840       vmcase(OP_GETTABLE) {
841         Protect(luaV_gettable(L, RB(i), RKC(i), ra));
842         vmbreak;
843       }
844       vmcase(OP_SETTABUP) {
845         int a = GETARG_A(i);
846         Protect(luaV_settable(L, cl->upvals[a]->v, RKB(i), RKC(i)));
847         vmbreak;
848       }
849       vmcase(OP_SETUPVAL) {
850         UpVal *uv = cl->upvals[GETARG_B(i)];
851         setobj(L, uv->v, ra);
852         luaC_upvalbarrier(L, uv);
853         vmbreak;
854       }
855       vmcase(OP_SETTABLE) {
856         Protect(luaV_settable(L, ra, RKB(i), RKC(i)));
857         vmbreak;
858       }
859       vmcase(OP_NEWTABLE) {
860         int b = GETARG_B(i);
861         int c = GETARG_C(i);
862         Table *t = luaH_new(L);
863         sethvalue(L, ra, t);
864         if (b != 0 || c != 0)
865           luaH_resize(L, t, luaO_fb2int(b), luaO_fb2int(c));
866         checkGC(L, ra + 1);
867         vmbreak;
868       }
869       vmcase(OP_SELF) {
870         StkId rb = RB(i);
871         setobjs2s(L, ra+1, rb);
872         Protect(luaV_gettable(L, rb, RKC(i), ra));
873         vmbreak;
874       }
875       vmcase(OP_ADD) {
876         TValue *rb = RKB(i);
877         TValue *rc = RKC(i);
878 #ifndef _KERNEL
879         lua_Number nb; lua_Number nc;
880         if (ttisinteger(rb) && ttisinteger(rc)) {
881           lua_Integer ib = ivalue(rb); lua_Integer ic = ivalue(rc);
882           setivalue(ra, intop(+, ib, ic));
883         }
884         else if (tonumber(rb, &nb) && tonumber(rc, &nc)) {
885           setfltvalue(ra, luai_numadd(L, nb, nc));
886         }
887 #else /* _KERNEL */
888         lua_Integer ib; lua_Integer ic;
889         if (tointeger(rb, &ib) && tointeger(rc, &ic)) {
890           setivalue(ra, intop(+, ib, ic));
891         }
892 #endif
893         else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_ADD)); }
894         vmbreak;
895       }
896       vmcase(OP_SUB) {
897         TValue *rb = RKB(i);
898         TValue *rc = RKC(i);
899 #ifndef _KERNEL
900         lua_Number nb; lua_Number nc;
901         if (ttisinteger(rb) && ttisinteger(rc)) {
902           lua_Integer ib = ivalue(rb); lua_Integer ic = ivalue(rc);
903           setivalue(ra, intop(-, ib, ic));
904         }
905         else if (tonumber(rb, &nb) && tonumber(rc, &nc)) {
906           setfltvalue(ra, luai_numsub(L, nb, nc));
907         }
908 #else /* _KERNEL */
909         lua_Integer ib; lua_Integer ic;
910         if (tointeger(rb, &ib) && tointeger(rc, &ic)) {
911           setivalue(ra, intop(-, ib, ic));
912         }
913 #endif
914         else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_SUB)); }
915         vmbreak;
916       }
917       vmcase(OP_MUL) {
918         TValue *rb = RKB(i);
919         TValue *rc = RKC(i);
920 #ifndef _KERNEL
921         lua_Number nb; lua_Number nc;
922         if (ttisinteger(rb) && ttisinteger(rc)) {
923           lua_Integer ib = ivalue(rb); lua_Integer ic = ivalue(rc);
924           setivalue(ra, intop(*, ib, ic));
925         }
926         else if (tonumber(rb, &nb) && tonumber(rc, &nc)) {
927           setfltvalue(ra, luai_nummul(L, nb, nc));
928         }
929 #else /* _KERNEL */
930         lua_Integer ib; lua_Integer ic;
931         if (tointeger(rb, &ib) && tointeger(rc, &ic)) {
932           setivalue(ra, intop(*, ib, ic));
933         }
934 #endif
935         else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_MUL)); }
936         vmbreak;
937       }
938 #ifndef _KERNEL
939       vmcase(OP_DIV) {  /* float division (always with floats) */
940         TValue *rb = RKB(i);
941         TValue *rc = RKC(i);
942         lua_Number nb; lua_Number nc;
943         if (tonumber(rb, &nb) && tonumber(rc, &nc)) {
944           setfltvalue(ra, luai_numdiv(L, nb, nc));
945         }
946         else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_DIV)); }
947         vmbreak;
948       }
949 #endif
950       vmcase(OP_BAND) {
951         TValue *rb = RKB(i);
952         TValue *rc = RKC(i);
953         lua_Integer ib; lua_Integer ic;
954         if (tointeger(rb, &ib) && tointeger(rc, &ic)) {
955           setivalue(ra, intop(&, ib, ic));
956         }
957         else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_BAND)); }
958         vmbreak;
959       }
960       vmcase(OP_BOR) {
961         TValue *rb = RKB(i);
962         TValue *rc = RKC(i);
963         lua_Integer ib; lua_Integer ic;
964         if (tointeger(rb, &ib) && tointeger(rc, &ic)) {
965           setivalue(ra, intop(|, ib, ic));
966         }
967         else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_BOR)); }
968         vmbreak;
969       }
970       vmcase(OP_BXOR) {
971         TValue *rb = RKB(i);
972         TValue *rc = RKC(i);
973         lua_Integer ib; lua_Integer ic;
974         if (tointeger(rb, &ib) && tointeger(rc, &ic)) {
975           setivalue(ra, intop(^, ib, ic));
976         }
977         else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_BXOR)); }
978         vmbreak;
979       }
980       vmcase(OP_SHL) {
981         TValue *rb = RKB(i);
982         TValue *rc = RKC(i);
983         lua_Integer ib; lua_Integer ic;
984         if (tointeger(rb, &ib) && tointeger(rc, &ic)) {
985           setivalue(ra, luaV_shiftl(ib, ic));
986         }
987         else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_SHL)); }
988         vmbreak;
989       }
990       vmcase(OP_SHR) {
991         TValue *rb = RKB(i);
992         TValue *rc = RKC(i);
993         lua_Integer ib; lua_Integer ic;
994         if (tointeger(rb, &ib) && tointeger(rc, &ic)) {
995           setivalue(ra, luaV_shiftl(ib, -ic));
996         }
997         else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_SHR)); }
998         vmbreak;
999       }
1000       vmcase(OP_MOD) {
1001         TValue *rb = RKB(i);
1002         TValue *rc = RKC(i);
1003 #ifndef _KERNEL
1004         lua_Number nb; lua_Number nc;
1005         if (ttisinteger(rb) && ttisinteger(rc)) {
1006           lua_Integer ib = ivalue(rb); lua_Integer ic = ivalue(rc);
1007           setivalue(ra, luaV_mod(L, ib, ic));
1008         }
1009         else if (tonumber(rb, &nb) && tonumber(rc, &nc)) {
1010           lua_Number m;
1011           luai_nummod(L, nb, nc, m);
1012           setfltvalue(ra, m);
1013         }
1014 #else /* _KERNEL */
1015         lua_Integer ib; lua_Integer ic;
1016         if (tointeger(rb, &ib) && tointeger(rc, &ic)) {
1017           setivalue(ra, luaV_mod(L, ib, ic));
1018         }
1019 #endif
1020         else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_MOD)); }
1021         vmbreak;
1022       }
1023       vmcase(OP_IDIV) {  /* floor division */
1024         TValue *rb = RKB(i);
1025         TValue *rc = RKC(i);
1026 #ifndef _KERNEL
1027         lua_Number nb; lua_Number nc;
1028         if (ttisinteger(rb) && ttisinteger(rc)) {
1029           lua_Integer ib = ivalue(rb); lua_Integer ic = ivalue(rc);
1030           setivalue(ra, luaV_div(L, ib, ic));
1031         }
1032         else if (tonumber(rb, &nb) && tonumber(rc, &nc)) {
1033           setfltvalue(ra, luai_numidiv(L, nb, nc));
1034         }
1035 #else /* _KERNEL */
1036         lua_Integer ib; lua_Integer ic;
1037         if (tointeger(rb, &ib) && tointeger(rc, &ic)) {
1038           setivalue(ra, luaV_div(L, ib, ic));
1039         }
1040 #endif
1041         else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_IDIV)); }
1042         vmbreak;
1043       }
1044 #ifndef _KERNEL
1045       vmcase(OP_POW) {
1046         TValue *rb = RKB(i);
1047         TValue *rc = RKC(i);
1048         lua_Number nb; lua_Number nc;
1049         if (tonumber(rb, &nb) && tonumber(rc, &nc)) {
1050           setfltvalue(ra, luai_numpow(L, nb, nc));
1051         }
1052         else { Protect(luaT_trybinTM(L, rb, rc, ra, TM_POW)); }
1053         vmbreak;
1054       }
1055 #endif
1056       vmcase(OP_UNM) {
1057         TValue *rb = RB(i);
1058 #ifndef _KERNEL
1059         lua_Number nb;
1060         if (ttisinteger(rb)) {
1061           lua_Integer ib = ivalue(rb);
1062           setivalue(ra, intop(-, 0, ib));
1063         }
1064         else if (tonumber(rb, &nb)) {
1065           setfltvalue(ra, luai_numunm(L, nb));
1066         }
1067 #else /* _KERNEL */
1068         lua_Integer ib;
1069         if (tointeger(rb, &ib)) {
1070           setivalue(ra, intop(-, 0, ib));
1071         }
1072 #endif
1073         else {
1074           Protect(luaT_trybinTM(L, rb, rb, ra, TM_UNM));
1075         }
1076         vmbreak;
1077       }
1078       vmcase(OP_BNOT) {
1079         TValue *rb = RB(i);
1080         lua_Integer ib;
1081         if (tointeger(rb, &ib)) {
1082           setivalue(ra, intop(^, ~l_castS2U(0), ib));
1083         }
1084         else {
1085           Protect(luaT_trybinTM(L, rb, rb, ra, TM_BNOT));
1086         }
1087         vmbreak;
1088       }
1089       vmcase(OP_NOT) {
1090         TValue *rb = RB(i);
1091         int res = l_isfalse(rb);  /* next assignment may change this value */
1092         setbvalue(ra, res);
1093         vmbreak;
1094       }
1095       vmcase(OP_LEN) {
1096         Protect(luaV_objlen(L, ra, RB(i)));
1097         vmbreak;
1098       }
1099       vmcase(OP_CONCAT) {
1100         int b = GETARG_B(i);
1101         int c = GETARG_C(i);
1102         StkId rb;
1103         L->top = base + c + 1;  /* mark the end of concat operands */
1104         Protect(luaV_concat(L, c - b + 1));
1105         ra = RA(i);  /* 'luav_concat' may invoke TMs and move the stack */
1106         rb = base + b;
1107         setobjs2s(L, ra, rb);
1108         checkGC(L, (ra >= rb ? ra + 1 : rb));
1109         L->top = ci->top;  /* restore top */
1110         vmbreak;
1111       }
1112       vmcase(OP_JMP) {
1113         dojump(ci, i, 0);
1114         vmbreak;
1115       }
1116       vmcase(OP_EQ) {
1117         TValue *rb = RKB(i);
1118         TValue *rc = RKC(i);
1119         Protect(
1120           if (cast_int(luaV_equalobj(L, rb, rc)) != GETARG_A(i))
1121             ci->u.l.savedpc++;
1122           else
1123             donextjump(ci);
1124         )
1125         vmbreak;
1126       }
1127       vmcase(OP_LT) {
1128         Protect(
1129           if (luaV_lessthan(L, RKB(i), RKC(i)) != GETARG_A(i))
1130             ci->u.l.savedpc++;
1131           else
1132             donextjump(ci);
1133         )
1134         vmbreak;
1135       }
1136       vmcase(OP_LE) {
1137         Protect(
1138           if (luaV_lessequal(L, RKB(i), RKC(i)) != GETARG_A(i))
1139             ci->u.l.savedpc++;
1140           else
1141             donextjump(ci);
1142         )
1143         vmbreak;
1144       }
1145       vmcase(OP_TEST) {
1146         if (GETARG_C(i) ? l_isfalse(ra) : !l_isfalse(ra))
1147             ci->u.l.savedpc++;
1148           else
1149           donextjump(ci);
1150         vmbreak;
1151       }
1152       vmcase(OP_TESTSET) {
1153         TValue *rb = RB(i);
1154         if (GETARG_C(i) ? l_isfalse(rb) : !l_isfalse(rb))
1155           ci->u.l.savedpc++;
1156         else {
1157           setobjs2s(L, ra, rb);
1158           donextjump(ci);
1159         }
1160         vmbreak;
1161       }
1162       vmcase(OP_CALL) {
1163         int b = GETARG_B(i);
1164         int nresults = GETARG_C(i) - 1;
1165         if (b != 0) L->top = ra+b;  /* else previous instruction set top */
1166         if (luaD_precall(L, ra, nresults)) {  /* C function? */
1167           if (nresults >= 0) L->top = ci->top;  /* adjust results */
1168           base = ci->u.l.base;
1169         }
1170         else {  /* Lua function */
1171           ci = L->ci;
1172           ci->callstatus |= CIST_REENTRY;
1173           goto newframe;  /* restart luaV_execute over new Lua function */
1174         }
1175         vmbreak;
1176       }
1177       vmcase(OP_TAILCALL) {
1178         int b = GETARG_B(i);
1179         if (b != 0) L->top = ra+b;  /* else previous instruction set top */
1180         lua_assert(GETARG_C(i) - 1 == LUA_MULTRET);
1181         if (luaD_precall(L, ra, LUA_MULTRET))  /* C function? */
1182           base = ci->u.l.base;
1183         else {
1184           /* tail call: put called frame (n) in place of caller one (o) */
1185           CallInfo *nci = L->ci;  /* called frame */
1186           CallInfo *oci = nci->previous;  /* caller frame */
1187           StkId nfunc = nci->func;  /* called function */
1188           StkId ofunc = oci->func;  /* caller function */
1189           /* last stack slot filled by 'precall' */
1190           StkId lim = nci->u.l.base + getproto(nfunc)->numparams;
1191           int aux;
1192           /* close all upvalues from previous call */
1193           if (cl->p->sizep > 0) luaF_close(L, oci->u.l.base);
1194           /* move new frame into old one */
1195           for (aux = 0; nfunc + aux < lim; aux++)
1196             setobjs2s(L, ofunc + aux, nfunc + aux);
1197           oci->u.l.base = ofunc + (nci->u.l.base - nfunc);  /* correct base */
1198           oci->top = L->top = ofunc + (L->top - nfunc);  /* correct top */
1199           oci->u.l.savedpc = nci->u.l.savedpc;
1200           oci->callstatus |= CIST_TAIL;  /* function was tail called */
1201           ci = L->ci = oci;  /* remove new frame */
1202           lua_assert(L->top == oci->u.l.base + getproto(ofunc)->maxstacksize);
1203           goto newframe;  /* restart luaV_execute over new Lua function */
1204         }
1205         vmbreak;
1206       }
1207       vmcase(OP_RETURN) {
1208         int b = GETARG_B(i);
1209         if (cl->p->sizep > 0) luaF_close(L, base);
1210         b = luaD_poscall(L, ra, (b != 0 ? b - 1 : L->top - ra));
1211         if (!(ci->callstatus & CIST_REENTRY))  /* 'ci' still the called one */
1212           return;  /* external invocation: return */
1213         else {  /* invocation via reentry: continue execution */
1214           ci = L->ci;
1215           if (b) L->top = ci->top;
1216           lua_assert(isLua(ci));
1217           lua_assert(GET_OPCODE(*((ci)->u.l.savedpc - 1)) == OP_CALL);
1218           goto newframe;  /* restart luaV_execute over new Lua function */
1219         }
1220       }
1221       vmcase(OP_FORLOOP) {
1222 #ifndef _KERNEL
1223         if (ttisinteger(ra)) {  /* integer loop? */
1224 #endif
1225           lua_Integer step = ivalue(ra + 2);
1226           lua_Integer idx = ivalue(ra) + step; /* increment index */
1227           lua_Integer limit = ivalue(ra + 1);
1228           if ((0 < step) ? (idx <= limit) : (limit <= idx)) {
1229             ci->u.l.savedpc += GETARG_sBx(i);  /* jump back */
1230             chgivalue(ra, idx);  /* update internal index... */
1231             setivalue(ra + 3, idx);  /* ...and external index */
1232           }
1233 #ifndef _KERNEL
1234         }
1235         else {  /* floating loop */
1236           lua_Number step = fltvalue(ra + 2);
1237           lua_Number idx = luai_numadd(L, fltvalue(ra), step); /* inc. index */
1238           lua_Number limit = fltvalue(ra + 1);
1239           if (luai_numlt(0, step) ? luai_numle(idx, limit)
1240                                   : luai_numle(limit, idx)) {
1241             ci->u.l.savedpc += GETARG_sBx(i);  /* jump back */
1242             chgfltvalue(ra, idx);  /* update internal index... */
1243             setfltvalue(ra + 3, idx);  /* ...and external index */
1244           }
1245         }
1246 #endif
1247         vmbreak;
1248       }
1249       vmcase(OP_FORPREP) {
1250         TValue *init = ra;
1251         TValue *plimit = ra + 1;
1252         TValue *pstep = ra + 2;
1253         lua_Integer ilimit;
1254 #ifndef _KERNEL
1255         int stopnow;
1256         if (ttisinteger(init) && ttisinteger(pstep) &&
1257             forlimit(plimit, &ilimit, ivalue(pstep), &stopnow)) {
1258           /* all values are integer */
1259           lua_Integer initv = (stopnow ? 0 : ivalue(init));
1260           setivalue(plimit, ilimit);
1261           setivalue(init, initv - ivalue(pstep));
1262         }
1263         else {  /* try making all values floats */
1264           lua_Number ninit; lua_Number nlimit; lua_Number nstep;
1265           if (!tonumber(plimit, &nlimit))
1266             luaG_runerror(L, "'for' limit must be a number");
1267           setfltvalue(plimit, nlimit);
1268           if (!tonumber(pstep, &nstep))
1269             luaG_runerror(L, "'for' step must be a number");
1270           setfltvalue(pstep, nstep);
1271           if (!tonumber(init, &ninit))
1272             luaG_runerror(L, "'for' initial value must be a number");
1273           setfltvalue(init, luai_numsub(L, ninit, nstep));
1274         }
1275 #else /* _KERNEL */
1276         lua_Integer initv; lua_Integer step;
1277         if (!tointeger(plimit, &ilimit))
1278           luaG_runerror(L, "'for' limit must be a number");
1279         setivalue(plimit, ilimit);
1280         if (!tointeger(pstep, &step))
1281           luaG_runerror(L, "'for' step must be a number");
1282         setivalue(pstep, step);
1283         if (!tointeger(init, &initv))
1284           luaG_runerror(L, "'for' initial value must be a number");
1285         setivalue(init, initv - step);
1286 #endif
1287         ci->u.l.savedpc += GETARG_sBx(i);
1288         vmbreak;
1289       }
1290       vmcase(OP_TFORCALL) {
1291         StkId cb = ra + 3;  /* call base */
1292         setobjs2s(L, cb+2, ra+2);
1293         setobjs2s(L, cb+1, ra+1);
1294         setobjs2s(L, cb, ra);
1295         L->top = cb + 3;  /* func. + 2 args (state and index) */
1296         Protect(luaD_call(L, cb, GETARG_C(i), 1));
1297         L->top = ci->top;
1298         i = *(ci->u.l.savedpc++);  /* go to next instruction */
1299         ra = RA(i);
1300         lua_assert(GET_OPCODE(i) == OP_TFORLOOP);
1301         goto l_tforloop;
1302       }
1303       vmcase(OP_TFORLOOP) {
1304         l_tforloop:
1305         if (!ttisnil(ra + 1)) {  /* continue loop? */
1306           setobjs2s(L, ra, ra + 1);  /* save control variable */
1307            ci->u.l.savedpc += GETARG_sBx(i);  /* jump back */
1308         }
1309         vmbreak;
1310       }
1311       vmcase(OP_SETLIST) {
1312         int n = GETARG_B(i);
1313         int c = GETARG_C(i);
1314         unsigned int last;
1315         Table *h;
1316         if (n == 0) n = cast_int(L->top - ra) - 1;
1317         if (c == 0) {
1318           lua_assert(GET_OPCODE(*ci->u.l.savedpc) == OP_EXTRAARG);
1319           c = GETARG_Ax(*ci->u.l.savedpc++);
1320         }
1321         luai_runtimecheck(L, ttistable(ra));
1322         h = hvalue(ra);
1323         last = ((c-1)*LFIELDS_PER_FLUSH) + n;
1324         if (last > h->sizearray)  /* needs more space? */
1325           luaH_resizearray(L, h, last);  /* pre-allocate it at once */
1326         for (; n > 0; n--) {
1327           TValue *val = ra+n;
1328           luaH_setint(L, h, last--, val);
1329           luaC_barrierback(L, h, val);
1330         }
1331         L->top = ci->top;  /* correct top (in case of previous open call) */
1332         vmbreak;
1333       }
1334       vmcase(OP_CLOSURE) {
1335         Proto *p = cl->p->p[GETARG_Bx(i)];
1336         LClosure *ncl = getcached(p, cl->upvals, base);  /* cached closure */
1337         if (ncl == NULL)  /* no match? */
1338           pushclosure(L, p, cl->upvals, base, ra);  /* create a new one */
1339         else
1340           setclLvalue(L, ra, ncl);  /* push cashed closure */
1341         checkGC(L, ra + 1);
1342         vmbreak;
1343       }
1344       vmcase(OP_VARARG) {
1345         int b = GETARG_B(i) - 1;
1346         int j;
1347         int n = cast_int(base - ci->func) - cl->p->numparams - 1;
1348         if (b < 0) {  /* B == 0? */
1349           b = n;  /* get all var. arguments */
1350           Protect(luaD_checkstack(L, n));
1351           ra = RA(i);  /* previous call may change the stack */
1352           L->top = ra + n;
1353         }
1354         for (j = 0; j < b; j++) {
1355           if (j < n) {
1356             setobjs2s(L, ra + j, base - n + j);
1357           }
1358           else {
1359             setnilvalue(ra + j);
1360           }
1361         }
1362         vmbreak;
1363       }
1364       vmcase(OP_EXTRAARG) {
1365         lua_assert(0);
1366         vmbreak;
1367       }
1368     }
1369   }
1370 }
1371 
1372 /* }================================================================== */
1373 
1374