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