lvm.c 20 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678
  1. /*
  2. ** $Id: lvm.c,v 1.242 2002/06/24 14:11:14 roberto Exp roberto $
  3. ** Lua virtual machine
  4. ** See Copyright Notice in lua.h
  5. */
  6. #include <stdarg.h>
  7. #include <stdlib.h>
  8. #include <string.h>
  9. #include "lua.h"
  10. #include "ldebug.h"
  11. #include "ldo.h"
  12. #include "lfunc.h"
  13. #include "lgc.h"
  14. #include "lobject.h"
  15. #include "lopcodes.h"
  16. #include "lstate.h"
  17. #include "lstring.h"
  18. #include "ltable.h"
  19. #include "ltm.h"
  20. #include "lvm.h"
  21. /* function to convert a lua_Number to a string */
  22. #ifndef lua_number2str
  23. #include <stdio.h>
  24. #define lua_number2str(s,n) sprintf((s), LUA_NUMBER_FMT, (n))
  25. #endif
  26. /* limit for table tag-method chains (to avoid loops) */
  27. #define MAXTAGLOOP 10000
  28. static void luaV_checkGC (lua_State *L, StkId top) {
  29. if (G(L)->nblocks >= G(L)->GCthreshold) {
  30. L->top = top; /* limit for active registers */
  31. luaC_collectgarbage(L);
  32. L->top = L->ci->top; /* restore old top position */
  33. }
  34. }
  35. const TObject *luaV_tonumber (const TObject *obj, TObject *n) {
  36. lua_Number num;
  37. if (ttype(obj) == LUA_TNUMBER) return obj;
  38. if (ttype(obj) == LUA_TSTRING && luaO_str2d(svalue(obj), &num)) {
  39. setnvalue(n, num);
  40. return n;
  41. }
  42. else
  43. return NULL;
  44. }
  45. int luaV_tostring (lua_State *L, TObject *obj) {
  46. if (ttype(obj) != LUA_TNUMBER)
  47. return 0;
  48. else {
  49. char s[32]; /* 16 digits, sign, point and \0 (+ some extra...) */
  50. lua_number2str(s, nvalue(obj));
  51. setsvalue(obj, luaS_new(L, s));
  52. return 1;
  53. }
  54. }
  55. static void traceexec (lua_State *L) {
  56. CallInfo *ci = L->ci;
  57. Proto *p = ci_func(ci)->l.p;
  58. int newline = getline(p, pcRel(*ci->pc, p));
  59. if (pcRel(*ci->pc, p) == 0) /* tracing may be starting now? */
  60. ci->savedpc = *ci->pc; /* initialize `savedpc' */
  61. /* calls linehook when enters a new line or jumps back (loop) */
  62. if (*ci->pc <= ci->savedpc || newline != getline(p, pcRel(ci->savedpc, p))) {
  63. luaD_lineHook(L, newline);
  64. ci = L->ci; /* previous call may reallocate `ci' */
  65. }
  66. ci->savedpc = *ci->pc;
  67. }
  68. static void callTMres (lua_State *L, const TObject *f,
  69. const TObject *p1, const TObject *p2) {
  70. setobj(L->top, f); /* push function */
  71. setobj(L->top+1, p1); /* 1st argument */
  72. setobj(L->top+2, p2); /* 2nd argument */
  73. luaD_checkstack(L, 3); /* cannot check before (could invalidate p1, p2) */
  74. L->top += 3;
  75. luaD_call(L, L->top - 3, 1);
  76. L->top--; /* result will be in L->top */
  77. }
  78. static void callTM (lua_State *L, const TObject *f,
  79. const TObject *p1, const TObject *p2, const TObject *p3) {
  80. setobj(L->top, f); /* push function */
  81. setobj(L->top+1, p1); /* 1st argument */
  82. setobj(L->top+2, p2); /* 2nd argument */
  83. setobj(L->top+3, p3); /* 3th argument */
  84. luaD_checkstack(L, 4); /* cannot check before (could invalidate p1...p3) */
  85. L->top += 4;
  86. luaD_call(L, L->top - 4, 0);
  87. }
  88. /*
  89. ** Function to index a table.
  90. ** Receives the table at `t' and the key at `key'.
  91. ** leaves the result at `res'.
  92. */
  93. const TObject *luaV_gettable (lua_State *L, const TObject *t, TObject *key) {
  94. const TObject *tm;
  95. int loop = 0;
  96. do {
  97. if (ttype(t) == LUA_TTABLE) { /* `t' is a table? */
  98. Table *h = hvalue(t);
  99. const TObject *v = luaH_get(h, key); /* do a primitive get */
  100. if (ttype(v) != LUA_TNIL || /* result is no nil? */
  101. (tm = fasttm(L, h->metatable, TM_INDEX)) == NULL) { /* or no TM? */
  102. return v;
  103. }
  104. /* else will try the tag method */
  105. }
  106. else if (ttype(tm = luaT_gettmbyobj(L, t, TM_GETTABLE)) == LUA_TNIL)
  107. luaG_typeerror(L, t, "index");
  108. if (ttype(tm) == LUA_TFUNCTION) {
  109. callTMres(L, tm, t, key);
  110. return L->top;
  111. }
  112. t = tm; /* else repeat access with `tm' */
  113. } while (++loop <= MAXTAGLOOP);
  114. luaG_runerror(L, "loop in gettable");
  115. return NULL; /* to avoid warnings */
  116. }
  117. /*
  118. ** Receives table at `t', key at `key' and value at `val'.
  119. */
  120. void luaV_settable (lua_State *L, const TObject *t, TObject *key, StkId val) {
  121. const TObject *tm;
  122. int loop = 0;
  123. do {
  124. if (ttype(t) == LUA_TTABLE) { /* `t' is a table? */
  125. Table *h = hvalue(t);
  126. TObject *oldval = luaH_set(L, h, key); /* do a primitive set */
  127. if (ttype(oldval) != LUA_TNIL || /* result is no nil? */
  128. (tm = fasttm(L, h->metatable, TM_NEWINDEX)) == NULL) { /* or no TM? */
  129. setobj(oldval, val);
  130. return;
  131. }
  132. /* else will try the tag method */
  133. }
  134. else if (ttype(tm = luaT_gettmbyobj(L, t, TM_SETTABLE)) == LUA_TNIL)
  135. luaG_typeerror(L, t, "index");
  136. if (ttype(tm) == LUA_TFUNCTION) {
  137. callTM(L, tm, t, key, val);
  138. return;
  139. }
  140. t = tm; /* else repeat with `tm' */
  141. } while (++loop <= MAXTAGLOOP);
  142. luaG_runerror(L, "loop in settable");
  143. }
  144. static int call_binTM (lua_State *L, const TObject *p1, const TObject *p2,
  145. TObject *res, TMS event) {
  146. ptrdiff_t result = savestack(L, res);
  147. const TObject *tm = luaT_gettmbyobj(L, p1, event); /* try first operand */
  148. if (ttype(tm) == LUA_TNIL)
  149. tm = luaT_gettmbyobj(L, p2, event); /* try second operand */
  150. if (ttype(tm) != LUA_TFUNCTION) return 0;
  151. callTMres(L, tm, p1, p2);
  152. res = restorestack(L, result); /* previous call may change stack */
  153. setobj(res, L->top);
  154. return 1;
  155. }
  156. static int luaV_strcmp (const TString *ls, const TString *rs) {
  157. const char *l = getstr(ls);
  158. size_t ll = ls->tsv.len;
  159. const char *r = getstr(rs);
  160. size_t lr = rs->tsv.len;
  161. for (;;) {
  162. int temp = strcoll(l, r);
  163. if (temp != 0) return temp;
  164. else { /* strings are equal up to a `\0' */
  165. size_t len = strlen(l); /* index of first `\0' in both strings */
  166. if (len == lr) /* r is finished? */
  167. return (len == ll) ? 0 : 1;
  168. else if (len == ll) /* l is finished? */
  169. return -1; /* l is smaller than r (because r is not finished) */
  170. /* both strings longer than `len'; go on comparing (after the `\0') */
  171. len++;
  172. l += len; ll -= len; r += len; lr -= len;
  173. }
  174. }
  175. }
  176. int luaV_lessthan (lua_State *L, const TObject *l, const TObject *r) {
  177. if (ttype(l) != ttype(r))
  178. return luaG_ordererror(L, l, r);
  179. else if (ttype(l) == LUA_TNUMBER)
  180. return nvalue(l) < nvalue(r);
  181. else if (ttype(l) == LUA_TSTRING)
  182. return luaV_strcmp(tsvalue(l), tsvalue(r)) < 0;
  183. else if (call_binTM(L, l, r, L->top, TM_LT))
  184. return !l_isfalse(L->top);
  185. return luaG_ordererror(L, l, r);
  186. }
  187. static int luaV_lessequal (lua_State *L, const TObject *l, const TObject *r) {
  188. if (ttype(l) != ttype(r))
  189. return luaG_ordererror(L, l, r);
  190. else if (ttype(l) == LUA_TNUMBER)
  191. return nvalue(l) <= nvalue(r);
  192. else if (ttype(l) == LUA_TSTRING)
  193. return luaV_strcmp(tsvalue(l), tsvalue(r)) <= 0;
  194. else if (call_binTM(L, l, r, L->top, TM_LE)) /* first try `le' */
  195. return !l_isfalse(L->top);
  196. else if (call_binTM(L, r, l, L->top, TM_LT)) /* else try `lt' */
  197. return l_isfalse(L->top);
  198. return luaG_ordererror(L, l, r);
  199. }
  200. int luaV_equalval (lua_State *L, const TObject *t1, const TObject *t2) {
  201. const TObject *tm = NULL;
  202. lua_assert(ttype(t1) == ttype(t2));
  203. switch (ttype(t1)) {
  204. case LUA_TNIL: return 1;
  205. case LUA_TNUMBER: return nvalue(t1) == nvalue(t2);
  206. case LUA_TSTRING: return tsvalue(t1) == tsvalue(t2);
  207. case LUA_TBOOLEAN: return bvalue(t1) == bvalue(t2); /* true must be 1 !! */
  208. case LUA_TUDATAVAL: return pvalue(t1) == pvalue(t2);
  209. case LUA_TFUNCTION: return clvalue(t1) == clvalue(t2);
  210. case LUA_TUSERDATA:
  211. if (uvalue(t1) == uvalue(t2)) return 1;
  212. else if ((tm = fasttm(L, uvalue(t1)->uv.metatable, TM_EQ)) == NULL &&
  213. (tm = fasttm(L, uvalue(t2)->uv.metatable, TM_EQ)) == NULL)
  214. return 0; /* no TM */
  215. else break; /* will try TM */
  216. case LUA_TTABLE:
  217. if (hvalue(t1) == hvalue(t2)) return 1;
  218. else if ((tm = fasttm(L, hvalue(t1)->metatable, TM_EQ)) == NULL &&
  219. (tm = fasttm(L, hvalue(t2)->metatable, TM_EQ)) == NULL)
  220. return 0; /* no TM */
  221. else break; /* will try TM */
  222. }
  223. callTMres(L, tm, t1, t2); /* call TM */
  224. return !l_isfalse(L->top);
  225. }
  226. void luaV_concat (lua_State *L, int total, int last) {
  227. do {
  228. StkId top = L->ci->base + last + 1;
  229. int n = 2; /* number of elements handled in this pass (at least 2) */
  230. if (!tostring(L, top-2) || !tostring(L, top-1)) {
  231. if (!call_binTM(L, top-2, top-1, top-2, TM_CONCAT))
  232. luaG_concaterror(L, top-2, top-1);
  233. } else if (tsvalue(top-1)->tsv.len > 0) { /* if len=0, do nothing */
  234. /* at least two string values; get as many as possible */
  235. lu_mem tl = cast(lu_mem, tsvalue(top-1)->tsv.len) +
  236. cast(lu_mem, tsvalue(top-2)->tsv.len);
  237. char *buffer;
  238. int i;
  239. while (n < total && tostring(L, top-n-1)) { /* collect total length */
  240. tl += tsvalue(top-n-1)->tsv.len;
  241. n++;
  242. }
  243. if (tl > MAX_SIZET) luaG_runerror(L, "string size overflow");
  244. buffer = luaO_openspace(L, tl, char);
  245. tl = 0;
  246. for (i=n; i>0; i--) { /* concat all strings */
  247. size_t l = tsvalue(top-i)->tsv.len;
  248. memcpy(buffer+tl, svalue(top-i), l);
  249. tl += l;
  250. }
  251. setsvalue(top-n, luaS_newlstr(L, buffer, tl));
  252. }
  253. total -= n-1; /* got `n' strings to create 1 new */
  254. last -= n-1;
  255. } while (total > 1); /* repeat until only 1 result left */
  256. }
  257. static void Arith (lua_State *L, StkId ra, StkId rb, StkId rc, TMS op) {
  258. TObject tempb, tempc;
  259. const TObject *b, *c;
  260. if ((b = luaV_tonumber(rb, &tempb)) != NULL &&
  261. (c = luaV_tonumber(rc, &tempc)) != NULL) {
  262. switch (op) {
  263. case TM_ADD: setnvalue(ra, nvalue(b) + nvalue(c)); break;
  264. case TM_SUB: setnvalue(ra, nvalue(b) - nvalue(c)); break;
  265. case TM_MUL: setnvalue(ra, nvalue(b) * nvalue(c)); break;
  266. case TM_DIV: setnvalue(ra, nvalue(b) / nvalue(c)); break;
  267. case TM_POW: {
  268. const TObject *f = luaH_getstr(hvalue(registry(L)),
  269. G(L)->tmname[TM_POW]);
  270. ptrdiff_t res = savestack(L, ra);
  271. if (ttype(f) != LUA_TFUNCTION)
  272. luaG_runerror(L, "`pow' (for `^' operator) is not a function");
  273. callTMres(L, f, b, c);
  274. ra = restorestack(L, res); /* previous call may change stack */
  275. setobj(ra, L->top);
  276. break;
  277. }
  278. default: lua_assert(0); break;
  279. }
  280. }
  281. else if (!call_binTM(L, rb, rc, ra, op))
  282. luaG_aritherror(L, rb, rc);
  283. }
  284. /*
  285. ** some macros for common tasks in `luaV_execute'
  286. */
  287. #define runtime_check(L, c) { if (!(c)) return 0; }
  288. #define RA(i) (base+GETARG_A(i))
  289. #define RB(i) (base+GETARG_B(i))
  290. #define RC(i) (base+GETARG_C(i))
  291. #define RKC(i) ((GETARG_C(i) < MAXSTACK) ? \
  292. base+GETARG_C(i) : \
  293. k+GETARG_C(i)-MAXSTACK)
  294. #define KBx(i) (k+GETARG_Bx(i))
  295. #define dojump(pc, i) ((pc) += (i))
  296. StkId luaV_execute (lua_State *L) {
  297. StkId base;
  298. LClosure *cl;
  299. TObject *k;
  300. const Instruction *pc;
  301. callentry: /* entry point when calling new functions */
  302. L->ci->pc = &pc;
  303. L->ci->pb = &base;
  304. pc = L->ci->savedpc;
  305. retentry: /* entry point when returning to old functions */
  306. base = L->ci->base;
  307. cl = &clvalue(base - 1)->l;
  308. k = cl->p->k;
  309. /* main loop of interpreter */
  310. for (;;) {
  311. const Instruction i = *pc++;
  312. StkId ra;
  313. if (L->linehook)
  314. traceexec(L);
  315. ra = RA(i);
  316. lua_assert(L->top <= L->stack + L->stacksize && L->top >= L->ci->base);
  317. lua_assert(L->top == L->ci->top ||
  318. GET_OPCODE(i) == OP_CALL || GET_OPCODE(i) == OP_TAILCALL ||
  319. GET_OPCODE(i) == OP_RETURN || GET_OPCODE(i) == OP_SETLISTO);
  320. switch (GET_OPCODE(i)) {
  321. case OP_MOVE: {
  322. setobj(ra, RB(i));
  323. break;
  324. }
  325. case OP_LOADK: {
  326. setobj(ra, KBx(i));
  327. break;
  328. }
  329. case OP_LOADBOOL: {
  330. setbvalue(ra, GETARG_B(i));
  331. if (GETARG_C(i)) pc++; /* skip next instruction (if C) */
  332. break;
  333. }
  334. case OP_LOADNIL: {
  335. TObject *rb = RB(i);
  336. do {
  337. setnilvalue(rb--);
  338. } while (rb >= ra);
  339. break;
  340. }
  341. case OP_GETUPVAL: {
  342. int b = GETARG_B(i);
  343. setobj(ra, cl->upvals[b]->v);
  344. break;
  345. }
  346. case OP_GETGLOBAL: {
  347. lua_assert(ttype(KBx(i)) == LUA_TSTRING && ttype(&cl->g) == LUA_TTABLE);
  348. setobj(RA(i), luaV_gettable(L, &cl->g, KBx(i)));
  349. break;
  350. }
  351. case OP_GETTABLE: {
  352. setobj(RA(i), luaV_gettable(L, RB(i), RKC(i)));
  353. break;
  354. }
  355. case OP_SETGLOBAL: {
  356. lua_assert(ttype(KBx(i)) == LUA_TSTRING && ttype(&cl->g) == LUA_TTABLE);
  357. luaV_settable(L, &cl->g, KBx(i), ra);
  358. break;
  359. }
  360. case OP_SETUPVAL: {
  361. int b = GETARG_B(i);
  362. setobj(cl->upvals[b]->v, ra);
  363. break;
  364. }
  365. case OP_SETTABLE: {
  366. luaV_settable(L, RB(i), RKC(i), ra);
  367. break;
  368. }
  369. case OP_NEWTABLE: {
  370. int b = GETARG_B(i);
  371. if (b > 0) b = twoto(b-1);
  372. sethvalue(ra, luaH_new(L, b, GETARG_C(i)));
  373. luaV_checkGC(L, ra+1);
  374. break;
  375. }
  376. case OP_SELF: {
  377. StkId rb = RB(i);
  378. setobj(ra+1, rb);
  379. setobj(RA(i), luaV_gettable(L, rb, RKC(i)));
  380. break;
  381. }
  382. case OP_ADD: {
  383. StkId rb = RB(i);
  384. StkId rc = RKC(i);
  385. if (ttype(rb) == LUA_TNUMBER && ttype(rc) == LUA_TNUMBER) {
  386. setnvalue(ra, nvalue(rb) + nvalue(rc));
  387. }
  388. else
  389. Arith(L, ra, rb, rc, TM_ADD);
  390. break;
  391. }
  392. case OP_SUB: {
  393. StkId rb = RB(i);
  394. StkId rc = RKC(i);
  395. if (ttype(rb) == LUA_TNUMBER && ttype(rc) == LUA_TNUMBER) {
  396. setnvalue(ra, nvalue(rb) - nvalue(rc));
  397. }
  398. else
  399. Arith(L, ra, rb, rc, TM_SUB);
  400. break;
  401. }
  402. case OP_MUL: {
  403. StkId rb = RB(i);
  404. StkId rc = RKC(i);
  405. if (ttype(rb) == LUA_TNUMBER && ttype(rc) == LUA_TNUMBER) {
  406. setnvalue(ra, nvalue(rb) * nvalue(rc));
  407. }
  408. else
  409. Arith(L, ra, rb, rc, TM_MUL);
  410. break;
  411. }
  412. case OP_DIV: {
  413. StkId rb = RB(i);
  414. StkId rc = RKC(i);
  415. if (ttype(rb) == LUA_TNUMBER && ttype(rc) == LUA_TNUMBER) {
  416. setnvalue(ra, nvalue(rb) / nvalue(rc));
  417. }
  418. else
  419. Arith(L, ra, rb, rc, TM_DIV);
  420. break;
  421. }
  422. case OP_POW: {
  423. Arith(L, ra, RB(i), RKC(i), TM_POW);
  424. break;
  425. }
  426. case OP_UNM: {
  427. const TObject *rb = RB(i);
  428. TObject temp;
  429. if (tonumber(rb, &temp)) {
  430. setnvalue(ra, -nvalue(rb));
  431. }
  432. else {
  433. setnilvalue(&temp);
  434. if (!call_binTM(L, RB(i), &temp, ra, TM_UNM))
  435. luaG_aritherror(L, RB(i), &temp);
  436. }
  437. break;
  438. }
  439. case OP_NOT: {
  440. int res = l_isfalse(RB(i)); /* next assignment may change this value */
  441. setbvalue(ra, res);
  442. break;
  443. }
  444. case OP_CONCAT: {
  445. int b = GETARG_B(i);
  446. int c = GETARG_C(i);
  447. luaV_concat(L, c-b+1, c); /* may change `base' (and `ra') */
  448. setobj(base+GETARG_A(i), base+b);
  449. luaV_checkGC(L, base+c+1);
  450. break;
  451. }
  452. case OP_JMP: {
  453. dojump(pc, GETARG_sBx(i));
  454. break;
  455. }
  456. case OP_EQ: { /* skip next instruction if test fails */
  457. if (equalobj(L, ra, RKC(i)) != GETARG_B(i)) pc++;
  458. else dojump(pc, GETARG_sBx(*pc) + 1);
  459. break;
  460. }
  461. case OP_LT: {
  462. if (luaV_lessthan(L, ra, RKC(i)) != GETARG_B(i)) pc++;
  463. else dojump(pc, GETARG_sBx(*pc) + 1);
  464. break;
  465. }
  466. case OP_LE: {
  467. if (luaV_lessequal(L, ra, RKC(i)) != GETARG_B(i)) pc++;
  468. else dojump(pc, GETARG_sBx(*pc) + 1);
  469. break;
  470. }
  471. case OP_GT: {
  472. if (luaV_lessthan(L, RKC(i), ra) != GETARG_B(i)) pc++;
  473. else dojump(pc, GETARG_sBx(*pc) + 1);
  474. break;
  475. }
  476. case OP_GE: {
  477. if (luaV_lessequal(L, RKC(i), ra) != GETARG_B(i)) pc++;
  478. else dojump(pc, GETARG_sBx(*pc) + 1);
  479. break;
  480. }
  481. case OP_TEST: {
  482. StkId rc = RKC(i);
  483. if (l_isfalse(rc) == GETARG_B(i)) pc++;
  484. else {
  485. setobj(ra, rc);
  486. dojump(pc, GETARG_sBx(*pc) + 1);
  487. }
  488. break;
  489. }
  490. case OP_CALL: {
  491. StkId firstResult;
  492. int b = GETARG_B(i);
  493. int nresults;
  494. if (b != 0) L->top = ra+b; /* else previous instruction set top */
  495. nresults = GETARG_C(i) - 1;
  496. firstResult = luaD_precall(L, ra);
  497. if (firstResult) {
  498. if (firstResult > L->top) { /* yield? */
  499. (L->ci-1)->savedpc = pc;
  500. return NULL;
  501. }
  502. /* it was a C function (`precall' called it); adjust results */
  503. luaD_poscall(L, nresults, firstResult);
  504. if (nresults >= 0) L->top = L->ci->top;
  505. }
  506. else { /* it is a Lua function: `call' it */
  507. (L->ci-1)->savedpc = pc;
  508. goto callentry;
  509. }
  510. break;
  511. }
  512. case OP_TAILCALL: {
  513. int b = GETARG_B(i);
  514. if (L->openupval) luaF_close(L, base);
  515. if (b != 0) L->top = ra+b; /* else previous instruction set top */
  516. luaD_poscall(L, LUA_MULTRET, ra); /* move down function and args. */
  517. ra = luaD_precall(L, base-1);
  518. if (ra == NULL) goto callentry; /* it is a Lua function */
  519. else if (ra > L->top) return NULL; /* yield??? */
  520. else goto ret;
  521. }
  522. case OP_RETURN: {
  523. int b;
  524. if (L->openupval) luaF_close(L, base);
  525. b = GETARG_B(i);
  526. if (b != 0) L->top = ra+b-1;
  527. lua_assert(L->ci->pc == &pc);
  528. }
  529. ret: {
  530. CallInfo *ci;
  531. ci = L->ci - 1;
  532. if (ci->pc != &pc) /* previous function was running `here'? */
  533. return ra; /* no: return */
  534. else { /* yes: continue its execution */
  535. int nresults;
  536. lua_assert(ttype(ci->base-1) == LUA_TFUNCTION);
  537. pc = ci->savedpc;
  538. lua_assert(GET_OPCODE(*(pc-1)) == OP_CALL);
  539. nresults = GETARG_C(*(pc-1)) - 1;
  540. luaD_poscall(L, nresults, ra);
  541. if (nresults >= 0) L->top = L->ci->top;
  542. goto retentry;
  543. }
  544. }
  545. case OP_FORLOOP: {
  546. lua_Number step, index, limit;
  547. const TObject *plimit = ra+1;
  548. const TObject *pstep = ra+2;
  549. if (ttype(ra) != LUA_TNUMBER)
  550. luaG_runerror(L, "`for' initial value must be a number");
  551. if (!tonumber(plimit, ra+1))
  552. luaG_runerror(L, "`for' limit must be a number");
  553. if (!tonumber(pstep, ra+2))
  554. luaG_runerror(L, "`for' step must be a number");
  555. step = nvalue(pstep);
  556. index = nvalue(ra) + step; /* increment index */
  557. limit = nvalue(plimit);
  558. if (step > 0 ? index <= limit : index >= limit) {
  559. dojump(pc, GETARG_sBx(i)); /* jump back */
  560. chgnvalue(ra, index); /* update index */
  561. }
  562. break;
  563. }
  564. case OP_TFORLOOP: {
  565. setobj(ra+4, ra+2);
  566. setobj(ra+3, ra+1);
  567. setobj(ra+2, ra);
  568. L->top = ra+5;
  569. luaD_call(L, ra+2, GETARG_C(i) + 1);
  570. L->top = L->ci->top;
  571. if (ttype(ra+2) == LUA_TNIL) pc++; /* skip jump (break loop) */
  572. else dojump(pc, GETARG_sBx(*pc) + 1); /* else jump back */
  573. break;
  574. }
  575. case OP_TFORPREP: {
  576. if (ttype(ra) == LUA_TTABLE) {
  577. setobj(ra+1, ra);
  578. setsvalue(ra, luaS_new(L, "next"));
  579. setobj(RA(i), luaV_gettable(L, gt(L), ra));
  580. }
  581. dojump(pc, GETARG_sBx(i));
  582. break;
  583. }
  584. case OP_SETLIST:
  585. case OP_SETLISTO: {
  586. int bc;
  587. int n;
  588. Table *h;
  589. runtime_check(L, ttype(ra) == LUA_TTABLE);
  590. h = hvalue(ra);
  591. bc = GETARG_Bx(i);
  592. if (GET_OPCODE(i) == OP_SETLIST)
  593. n = (bc&(LFIELDS_PER_FLUSH-1)) + 1;
  594. else {
  595. n = L->top - ra - 1;
  596. L->top = L->ci->top;
  597. }
  598. bc &= ~(LFIELDS_PER_FLUSH-1); /* bc = bc - bc%FPF */
  599. for (; n > 0; n--)
  600. setobj(luaH_setnum(L, h, bc+n), ra+n);
  601. break;
  602. }
  603. case OP_CLOSE: {
  604. luaF_close(L, ra);
  605. break;
  606. }
  607. case OP_CLOSURE: {
  608. Proto *p;
  609. Closure *ncl;
  610. int nup, j;
  611. p = cl->p->p[GETARG_Bx(i)];
  612. nup = p->nupvalues;
  613. ncl = luaF_newLclosure(L, nup, &cl->g);
  614. ncl->l.p = p;
  615. for (j=0; j<nup; j++, pc++) {
  616. if (GET_OPCODE(*pc) == OP_GETUPVAL)
  617. ncl->l.upvals[j] = cl->upvals[GETARG_B(*pc)];
  618. else {
  619. lua_assert(GET_OPCODE(*pc) == OP_MOVE);
  620. ncl->l.upvals[j] = luaF_findupval(L, base + GETARG_B(*pc));
  621. }
  622. }
  623. setclvalue(ra, ncl);
  624. luaV_checkGC(L, L->top);
  625. break;
  626. }
  627. }
  628. }
  629. }