opcode.c 25 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323
  1. /*
  2. ** opcode.c
  3. ** TecCGraf - PUC-Rio
  4. */
  5. char *rcs_opcode="$Id: opcode.c,v 3.68 1996/04/25 14:10:00 roberto Exp roberto $";
  6. #include <setjmp.h>
  7. #include <stdio.h>
  8. #include <string.h>
  9. #include "luadebug.h"
  10. #include "mem.h"
  11. #include "opcode.h"
  12. #include "hash.h"
  13. #include "inout.h"
  14. #include "table.h"
  15. #include "lua.h"
  16. #include "fallback.h"
  17. #include "undump.h"
  18. #define tonumber(o) ((tag(o) != LUA_T_NUMBER) && (lua_tonumber(o) != 0))
  19. #define tostring(o) ((tag(o) != LUA_T_STRING) && (lua_tostring(o) != 0))
  20. #define STACK_SIZE 128
  21. #ifndef STACK_LIMIT
  22. #define STACK_LIMIT 6000
  23. #endif
  24. typedef int StkId; /* index to stack elements */
  25. static Object initial_stack;
  26. static Object *stackLimit = &initial_stack+1;
  27. static Object *stack = &initial_stack;
  28. static Object *top = &initial_stack;
  29. /* macros to convert from lua_Object to (Object *) and back */
  30. #define Address(lo) ((lo)+stack-1)
  31. #define Ref(st) ((st)-stack+1)
  32. /* macro to increment stack top. There must be always an empty slot in
  33. * the stack
  34. */
  35. #define incr_top if (++top >= stackLimit) growstack()
  36. static StkId CBase = 0; /* when Lua calls C or C calls Lua, points to */
  37. /* the first slot after the last parameter. */
  38. static int CnResults = 0; /* when Lua calls C, has the number of parameters; */
  39. /* when C calls Lua, has the number of results. */
  40. static jmp_buf *errorJmp = NULL; /* current error recover point */
  41. /* Hooks */
  42. lua_LHFunction lua_linehook = NULL;
  43. lua_CHFunction lua_callhook = NULL;
  44. static StkId lua_execute (Byte *pc, StkId base);
  45. static void do_call (StkId base, int nResults);
  46. Object *luaI_Address (lua_Object o)
  47. {
  48. return Address(o);
  49. }
  50. /*
  51. ** Init stack
  52. */
  53. static void lua_initstack (void)
  54. {
  55. Long maxstack = STACK_SIZE;
  56. stack = newvector(maxstack, Object);
  57. stackLimit = stack+maxstack;
  58. top = stack;
  59. *(top++) = initial_stack;
  60. }
  61. /*
  62. ** Check stack overflow and, if necessary, realloc vector
  63. */
  64. #define lua_checkstack(nt) if ((nt) >= stackLimit) growstack()
  65. static void growstack (void)
  66. {
  67. if (stack == &initial_stack)
  68. lua_initstack();
  69. else
  70. {
  71. static int limit = STACK_LIMIT;
  72. StkId t = top-stack;
  73. Long stacksize = stackLimit - stack;
  74. stacksize = growvector(&stack, stacksize, Object, stackEM, limit+100);
  75. stackLimit = stack+stacksize;
  76. top = stack + t;
  77. if (stacksize >= limit)
  78. {
  79. limit = stacksize;
  80. lua_error(stackEM);
  81. }
  82. }
  83. }
  84. /*
  85. ** Concatenate two given strings. Return the new string pointer.
  86. */
  87. static char *lua_strconc (char *l, char *r)
  88. {
  89. size_t nl = strlen(l);
  90. char *buffer = luaI_buffer(nl+strlen(r)+1);
  91. strcpy(buffer, l);
  92. strcpy(buffer+nl, r);
  93. return buffer;
  94. }
  95. /*
  96. ** Convert, if possible, to a number object.
  97. ** Return 0 if success, not 0 if error.
  98. */
  99. static int lua_tonumber (Object *obj)
  100. {
  101. float t;
  102. char c;
  103. if (tag(obj) != LUA_T_STRING)
  104. return 1;
  105. else if (sscanf(svalue(obj), "%f %c",&t, &c) == 1)
  106. {
  107. nvalue(obj) = t;
  108. tag(obj) = LUA_T_NUMBER;
  109. return 0;
  110. }
  111. else
  112. return 2;
  113. }
  114. /*
  115. ** Convert, if possible, to a string tag
  116. ** Return 0 in success or not 0 on error.
  117. */
  118. static int lua_tostring (Object *obj)
  119. {
  120. char s[256];
  121. if (tag(obj) != LUA_T_NUMBER)
  122. return 1;
  123. if ((int) nvalue(obj) == nvalue(obj))
  124. sprintf (s, "%d", (int) nvalue(obj));
  125. else
  126. sprintf (s, "%g", nvalue(obj));
  127. tsvalue(obj) = lua_createstring(s);
  128. tag(obj) = LUA_T_STRING;
  129. return 0;
  130. }
  131. /*
  132. ** Adjust stack. Set top to the given value, pushing NILs if needed.
  133. */
  134. static void adjust_top (StkId newtop)
  135. {
  136. Object *nt;
  137. lua_checkstack(stack+newtop);
  138. nt = stack+newtop; /* warning: previous call may change stack */
  139. while (top < nt) tag(top++) = LUA_T_NIL;
  140. top = nt; /* top could be bigger than newtop */
  141. }
  142. #define adjustC(nParams) adjust_top(CBase+nParams)
  143. /*
  144. ** Open a hole below "nelems" from the top.
  145. */
  146. static void open_stack (int nelems)
  147. {
  148. int i;
  149. for (i=0; i<nelems; i++)
  150. *(top-i) = *(top-i-1);
  151. incr_top;
  152. }
  153. /*
  154. ** call Line hook
  155. */
  156. static void lineHook (int line)
  157. {
  158. StkId oldBase = CBase;
  159. int oldCnResults = CnResults;
  160. StkId old_top = CBase = top-stack;
  161. CnResults = 0;
  162. (*lua_linehook)(line);
  163. top = stack+old_top;
  164. CnResults = oldCnResults;
  165. CBase = oldBase;
  166. }
  167. /*
  168. ** Call hook
  169. ** The function being called is in [stack+base-1]
  170. */
  171. static void callHook (StkId base, lua_Type type, int isreturn)
  172. {
  173. StkId oldBase = CBase;
  174. int oldCnResults = CnResults;
  175. StkId old_top = CBase = top-stack;
  176. CnResults = 0;
  177. if (isreturn)
  178. (*lua_callhook)(LUA_NOOBJECT, "(return)", 0);
  179. else
  180. {
  181. Object *f = stack+base-1;
  182. if (type == LUA_T_MARK)
  183. (*lua_callhook)(Ref(f), f->value.tf->fileName, f->value.tf->lineDefined);
  184. else
  185. (*lua_callhook)(Ref(f), "(C)", -1);
  186. }
  187. top = stack+old_top;
  188. CnResults = oldCnResults;
  189. CBase = oldBase;
  190. }
  191. /*
  192. ** Call a C function. CBase will point to the top of the stack,
  193. ** and CnResults is the number of parameters. Returns an index
  194. ** to the first result from C.
  195. */
  196. static StkId callC (lua_CFunction func, StkId base)
  197. {
  198. StkId oldBase = CBase;
  199. int oldCnResults = CnResults;
  200. StkId firstResult;
  201. CnResults = (top-stack) - base;
  202. /* incorporate parameters on the stack */
  203. CBase = base+CnResults; /* == top-stack */
  204. if (lua_callhook)
  205. callHook(base, LUA_T_CMARK, 0);
  206. (*func)();
  207. if (lua_callhook) /* func may have changed lua_callhook */
  208. callHook(base, LUA_T_CMARK, 1);
  209. firstResult = CBase;
  210. CBase = oldBase;
  211. CnResults = oldCnResults;
  212. return firstResult;
  213. }
  214. /*
  215. ** Call the specified fallback, putting it on the stack below its arguments
  216. */
  217. static void callFB (int fb)
  218. {
  219. int nParams = luaI_fallBacks[fb].nParams;
  220. open_stack(nParams);
  221. *(top-nParams-1) = luaI_fallBacks[fb].function;
  222. do_call((top-stack)-nParams, luaI_fallBacks[fb].nResults);
  223. }
  224. /*
  225. ** Call a function (C or Lua). The parameters must be on the stack,
  226. ** between [stack+base,top). The function to be called is at stack+base-1.
  227. ** When returns, the results are on the stack, between [stack+base-1,top).
  228. ** The number of results is nResults, unless nResults=MULT_RET.
  229. */
  230. static void do_call (StkId base, int nResults)
  231. {
  232. StkId firstResult;
  233. Object *func = stack+base-1;
  234. int i;
  235. if (tag(func) == LUA_T_CFUNCTION)
  236. {
  237. tag(func) = LUA_T_CMARK;
  238. firstResult = callC(fvalue(func), base);
  239. }
  240. else if (tag(func) == LUA_T_FUNCTION)
  241. {
  242. tag(func) = LUA_T_MARK;
  243. firstResult = lua_execute(func->value.tf->code, base);
  244. }
  245. else
  246. { /* func is not a function */
  247. /* Call the fallback for invalid functions */
  248. open_stack((top-stack)-(base-1));
  249. stack[base-1] = luaI_fallBacks[FB_FUNCTION].function;
  250. do_call(base, nResults);
  251. return;
  252. }
  253. /* adjust the number of results */
  254. if (nResults != MULT_RET && top - (stack+firstResult) != nResults)
  255. adjust_top(firstResult+nResults);
  256. /* move results to base-1 (to erase parameters and function) */
  257. base--;
  258. nResults = top - (stack+firstResult); /* actual number of results */
  259. for (i=0; i<nResults; i++)
  260. *(stack+base+i) = *(stack+firstResult+i);
  261. top -= firstResult-base;
  262. }
  263. /*
  264. ** Function to index a table. Receives the table at top-2 and the index
  265. ** at top-1.
  266. */
  267. static void pushsubscript (void)
  268. {
  269. if (tag(top-2) != LUA_T_ARRAY)
  270. callFB(FB_GETTABLE);
  271. else
  272. {
  273. Object *h = lua_hashget(avalue(top-2), top-1);
  274. if (h == NULL || tag(h) == LUA_T_NIL)
  275. callFB(FB_INDEX);
  276. else
  277. {
  278. --top;
  279. *(top-1) = *h;
  280. }
  281. }
  282. }
  283. /*
  284. ** Function to store indexed based on values at the top
  285. */
  286. static void storesubscript (void)
  287. {
  288. if (tag(top-3) != LUA_T_ARRAY)
  289. callFB(FB_SETTABLE);
  290. else
  291. {
  292. Object *h = lua_hashdefine (avalue(top-3), top-2);
  293. *h = *(top-1);
  294. top -= 3;
  295. }
  296. }
  297. static void getglobal (Word n)
  298. {
  299. *top = lua_table[n].object;
  300. incr_top;
  301. if (tag(top-1) == LUA_T_NIL)
  302. { /* must call getglobal fallback */
  303. tag(top-1) = LUA_T_STRING;
  304. tsvalue(top-1) = lua_table[n].varname;
  305. callFB(FB_GETGLOBAL);
  306. }
  307. }
  308. /*
  309. ** Traverse all objects on stack
  310. */
  311. void lua_travstack (int (*fn)(Object *))
  312. {
  313. Object *o;
  314. for (o = top-1; o >= stack; o--)
  315. fn (o);
  316. }
  317. /*
  318. ** Error messages and debug functions
  319. */
  320. static void lua_message (char *s)
  321. {
  322. lua_pushstring(s);
  323. callFB(FB_ERROR);
  324. }
  325. /*
  326. ** Reports an error, and jumps up to the available recover label
  327. */
  328. void lua_error (char *s)
  329. {
  330. if (s) lua_message(s);
  331. if (errorJmp)
  332. longjmp(*errorJmp, 1);
  333. else
  334. {
  335. fprintf (stderr, "lua: exit(1). Unable to recover\n");
  336. exit(1);
  337. }
  338. }
  339. lua_Function lua_stackedfunction (int level)
  340. {
  341. Object *p = top;
  342. while (--p >= stack)
  343. if (p->tag == LUA_T_MARK || p->tag == LUA_T_CMARK)
  344. if (level-- == 0)
  345. return Ref(p);
  346. return LUA_NOOBJECT;
  347. }
  348. int lua_currentline (lua_Function func)
  349. {
  350. Object *f = Address(func);
  351. return (f+1 < top && (f+1)->tag == LUA_T_LINE) ? (f+1)->value.i : -1;
  352. }
  353. lua_Object lua_getlocal (lua_Function func, int local_number, char **name)
  354. {
  355. Object *f = luaI_Address(func);
  356. *name = luaI_getlocalname(f->value.tf, local_number, lua_currentline(func));
  357. if (*name)
  358. {
  359. /* if "*name", there must be a LUA_T_LINE */
  360. /* therefore, f+2 points to function base */
  361. return Ref((f+2)+(local_number-1));
  362. }
  363. else
  364. return LUA_NOOBJECT;
  365. }
  366. int lua_setlocal (lua_Function func, int local_number)
  367. {
  368. Object *f = Address(func);
  369. char *name = luaI_getlocalname(f->value.tf, local_number, lua_currentline(func));
  370. adjustC(1);
  371. --top;
  372. if (name)
  373. {
  374. /* if "name", there must be a LUA_T_LINE */
  375. /* therefore, f+2 points to function base */
  376. *((f+2)+(local_number-1)) = *top;
  377. return 1;
  378. }
  379. else
  380. return 0;
  381. }
  382. /*
  383. ** Execute a protected call. Assumes that function is at CBase and
  384. ** parameters are on top of it. Leave nResults on the stack.
  385. */
  386. static int do_protectedrun (int nResults)
  387. {
  388. jmp_buf myErrorJmp;
  389. int status;
  390. StkId oldCBase = CBase;
  391. jmp_buf *oldErr = errorJmp;
  392. errorJmp = &myErrorJmp;
  393. if (setjmp(myErrorJmp) == 0)
  394. {
  395. do_call(CBase+1, nResults);
  396. CnResults = (top-stack) - CBase; /* number of results */
  397. CBase += CnResults; /* incorporate results on the stack */
  398. status = 0;
  399. }
  400. else
  401. { /* an error occurred: restore CBase and top */
  402. CBase = oldCBase;
  403. top = stack+CBase;
  404. status = 1;
  405. }
  406. errorJmp = oldErr;
  407. return status;
  408. }
  409. int luaI_dorun (TFunc *tf)
  410. {
  411. int status;
  412. adjustC(1); /* one slot for the pseudo-function */
  413. stack[CBase].tag = LUA_T_FUNCTION;
  414. stack[CBase].value.tf = tf;
  415. status = do_protectedrun(0);
  416. adjustC(0);
  417. return status;
  418. }
  419. static int do_protectedmain (void)
  420. {
  421. TFunc tf;
  422. int status;
  423. jmp_buf myErrorJmp;
  424. jmp_buf *oldErr = errorJmp;
  425. errorJmp = &myErrorJmp;
  426. luaI_initTFunc(&tf);
  427. tf.fileName = lua_parsedfile;
  428. if (setjmp(myErrorJmp) == 0)
  429. {
  430. lua_parse(&tf);
  431. status = luaI_dorun(&tf);
  432. }
  433. else
  434. {
  435. status = 1;
  436. adjustC(0); /* erase extra slot */
  437. }
  438. errorJmp = oldErr;
  439. luaI_free(tf.code);
  440. return status;
  441. }
  442. /*
  443. ** Execute the given lua function. Return 0 on success or 1 on error.
  444. */
  445. int lua_callfunction (lua_Object function)
  446. {
  447. if (function == LUA_NOOBJECT)
  448. return 1;
  449. else
  450. {
  451. open_stack((top-stack)-CBase);
  452. stack[CBase] = *Address(function);
  453. return do_protectedrun (MULT_RET);
  454. }
  455. }
  456. int lua_call (char *funcname)
  457. {
  458. Word n = luaI_findsymbolbyname(funcname);
  459. open_stack((top-stack)-CBase);
  460. stack[CBase] = s_object(n);
  461. return do_protectedrun(MULT_RET);
  462. }
  463. /*
  464. ** Open file, generate opcode and execute global statement. Return 0 on
  465. ** success or 1 on error.
  466. */
  467. int lua_dofile (char *filename)
  468. {
  469. int status;
  470. int c;
  471. FILE *f = lua_openfile(filename);
  472. if (f == NULL)
  473. return 1;
  474. c = fgetc(f);
  475. ungetc(c, f);
  476. status = (c == ID_CHUNK) ? luaI_undump(f) : do_protectedmain();
  477. lua_closefile();
  478. return status;
  479. }
  480. /*
  481. ** Generate opcode stored on string and execute global statement. Return 0 on
  482. ** success or 1 on error.
  483. */
  484. int lua_dostring (char *string)
  485. {
  486. int status;
  487. lua_openstring(string);
  488. status = do_protectedmain();
  489. lua_closestring();
  490. return status;
  491. }
  492. /*
  493. ** API: set a function as a fallback
  494. */
  495. lua_Object lua_setfallback (char *name, lua_CFunction fallback)
  496. {
  497. adjustC(1); /* one slot for the pseudo-function */
  498. stack[CBase].tag = LUA_T_CFUNCTION;
  499. stack[CBase].value.f = luaI_setfallback;
  500. lua_pushstring(name);
  501. lua_pushcfunction(fallback);
  502. if (do_protectedrun(1) == 0)
  503. return (Ref(top-1));
  504. else
  505. return LUA_NOOBJECT;
  506. }
  507. /*
  508. ** API: receives on the stack the table and the index.
  509. ** returns the value.
  510. */
  511. lua_Object lua_getsubscript (void)
  512. {
  513. adjustC(2);
  514. pushsubscript();
  515. CBase++; /* incorporate object in the stack */
  516. return (Ref(top-1));
  517. }
  518. #define MAX_C_BLOCKS 10
  519. static int numCblocks = 0;
  520. static StkId Cblocks[MAX_C_BLOCKS];
  521. /*
  522. ** API: starts a new block
  523. */
  524. void lua_beginblock (void)
  525. {
  526. if (numCblocks >= MAX_C_BLOCKS)
  527. lua_error("`lua_beginblock': too many nested blocks");
  528. Cblocks[numCblocks] = CBase;
  529. numCblocks++;
  530. }
  531. /*
  532. ** API: ends a block
  533. */
  534. void lua_endblock (void)
  535. {
  536. --numCblocks;
  537. CBase = Cblocks[numCblocks];
  538. adjustC(0);
  539. }
  540. /*
  541. ** API: receives on the stack the table, the index, and the new value.
  542. */
  543. void lua_storesubscript (void)
  544. {
  545. adjustC(3);
  546. storesubscript();
  547. }
  548. /*
  549. ** API: creates a new table
  550. */
  551. lua_Object lua_createtable (void)
  552. {
  553. adjustC(0);
  554. avalue(top) = lua_createarray(0);
  555. tag(top) = LUA_T_ARRAY;
  556. incr_top;
  557. CBase++; /* incorporate object in the stack */
  558. return Ref(top-1);
  559. }
  560. /*
  561. ** Get a parameter, returning the object handle or LUA_NOOBJECT on error.
  562. ** 'number' must be 1 to get the first parameter.
  563. */
  564. lua_Object lua_getparam (int number)
  565. {
  566. if (number <= 0 || number > CnResults) return LUA_NOOBJECT;
  567. /* Ref(stack+(CBase-CnResults+number-1)) ==
  568. stack+(CBase-CnResults+number-1)-stack+1 == */
  569. return CBase-CnResults+number;
  570. }
  571. int lua_isnumber (lua_Object object)
  572. {
  573. return (object != LUA_NOOBJECT) && (tonumber(Address(object)) == 0);
  574. }
  575. int lua_isstring (lua_Object object)
  576. {
  577. int t = lua_type(object);
  578. return (t == LUA_T_STRING) || (t == LUA_T_NUMBER);
  579. }
  580. int lua_isfunction (lua_Object object)
  581. {
  582. int t = lua_type(object);
  583. return (t == LUA_T_FUNCTION) || (t == LUA_T_CFUNCTION);
  584. }
  585. /*
  586. ** Given an object handle, return its number value. On error, return 0.0.
  587. */
  588. real lua_getnumber (lua_Object object)
  589. {
  590. if (object == LUA_NOOBJECT) return 0.0;
  591. if (tonumber (Address(object))) return 0.0;
  592. else return (nvalue(Address(object)));
  593. }
  594. /*
  595. ** Given an object handle, return its string pointer. On error, return NULL.
  596. */
  597. char *lua_getstring (lua_Object object)
  598. {
  599. if (object == LUA_NOOBJECT) return NULL;
  600. if (tostring (Address(object))) return NULL;
  601. else return (svalue(Address(object)));
  602. }
  603. /*
  604. ** Given an object handle, return its cfuntion pointer. On error, return NULL.
  605. */
  606. lua_CFunction lua_getcfunction (lua_Object object)
  607. {
  608. if (object == LUA_NOOBJECT || tag(Address(object)) != LUA_T_CFUNCTION)
  609. return NULL;
  610. else return (fvalue(Address(object)));
  611. }
  612. /*
  613. ** Given an object handle, return its user data. On error, return NULL.
  614. */
  615. void *lua_getuserdata (lua_Object object)
  616. {
  617. if (object == LUA_NOOBJECT || tag(Address(object)) < LUA_T_USERDATA)
  618. return NULL;
  619. else return (uvalue(Address(object)));
  620. }
  621. lua_Object lua_getref (int ref)
  622. {
  623. Object *o = luaI_getref(ref);
  624. if (o == NULL)
  625. return LUA_NOOBJECT;
  626. adjustC(0);
  627. luaI_pushobject(o);
  628. CBase++; /* incorporate object in the stack */
  629. return Ref(top-1);
  630. }
  631. void lua_pushref (int ref)
  632. {
  633. Object *o = luaI_getref(ref);
  634. if (o == NULL)
  635. lua_error("access to invalid (possibly garbage collected) reference");
  636. luaI_pushobject(o);
  637. }
  638. int lua_ref (int lock)
  639. {
  640. adjustC(1);
  641. return luaI_ref(--top, lock);
  642. }
  643. /*
  644. ** Get a global object.
  645. */
  646. lua_Object lua_getglobal (char *name)
  647. {
  648. adjustC(0);
  649. getglobal(luaI_findsymbolbyname(name));
  650. CBase++; /* incorporate object in the stack */
  651. return Ref(top-1);
  652. }
  653. /*
  654. ** Store top of the stack at a global variable array field.
  655. */
  656. void lua_storeglobal (char *name)
  657. {
  658. Word n = luaI_findsymbolbyname(name);
  659. adjustC(1);
  660. s_object(n) = *(--top);
  661. }
  662. /*
  663. ** Push a nil object
  664. */
  665. void lua_pushnil (void)
  666. {
  667. tag(top) = LUA_T_NIL;
  668. incr_top;
  669. }
  670. /*
  671. ** Push an object (tag=number) to stack.
  672. */
  673. void lua_pushnumber (real n)
  674. {
  675. tag(top) = LUA_T_NUMBER; nvalue(top) = n;
  676. incr_top;
  677. }
  678. /*
  679. ** Push an object (tag=string) to stack.
  680. */
  681. void lua_pushstring (char *s)
  682. {
  683. if (s == NULL)
  684. tag(top) = LUA_T_NIL;
  685. else
  686. {
  687. tsvalue(top) = lua_createstring(s);
  688. tag(top) = LUA_T_STRING;
  689. }
  690. incr_top;
  691. }
  692. /*>>>>>>>>>#undef lua_pushliteral
  693. void lua_pushliteral(char *s) { lua_pushstring(s); }*/
  694. /*
  695. ** Push an object (tag=cfunction) to stack.
  696. */
  697. void lua_pushcfunction (lua_CFunction fn)
  698. {
  699. tag(top) = LUA_T_CFUNCTION; fvalue(top) = fn;
  700. incr_top;
  701. }
  702. /*
  703. ** Push an object (tag=userdata) to stack.
  704. */
  705. void lua_pushusertag (void *u, int tag)
  706. {
  707. if (tag < LUA_T_USERDATA)
  708. lua_error("invalid tag in `lua_pushusertag'");
  709. tag(top) = tag; uvalue(top) = u;
  710. incr_top;
  711. }
  712. /*
  713. ** Push an object on the stack.
  714. */
  715. void luaI_pushobject (Object *o)
  716. {
  717. *top = *o;
  718. incr_top;
  719. }
  720. /*
  721. ** Push a lua_Object on stack.
  722. */
  723. void lua_pushobject (lua_Object o)
  724. {
  725. if (o == LUA_NOOBJECT)
  726. lua_error("attempt to push a NOOBJECT");
  727. luaI_pushobject(Address(o));
  728. }
  729. int lua_type (lua_Object o)
  730. {
  731. if (o == LUA_NOOBJECT)
  732. return LUA_T_NIL;
  733. else
  734. return tag(Address(o));
  735. }
  736. void luaI_gcFB (Object *o)
  737. {
  738. *top = *o;
  739. incr_top;
  740. callFB(FB_GC);
  741. }
  742. static void call_arith (char *op)
  743. {
  744. lua_pushstring(op);
  745. callFB(FB_ARITH);
  746. }
  747. static void comparison (lua_Type tag_less, lua_Type tag_equal,
  748. lua_Type tag_great, char *op)
  749. {
  750. Object *l = top-2;
  751. Object *r = top-1;
  752. int result;
  753. if (tag(l) == LUA_T_NUMBER && tag(r) == LUA_T_NUMBER)
  754. result = (nvalue(l) < nvalue(r)) ? -1 : (nvalue(l) == nvalue(r)) ? 0 : 1;
  755. else if (tostring(l) || tostring(r))
  756. {
  757. lua_pushstring(op);
  758. callFB(FB_ORDER);
  759. return;
  760. }
  761. else
  762. result = strcmp(svalue(l), svalue(r));
  763. top--;
  764. nvalue(top-1) = 1;
  765. tag(top-1) = (result < 0) ? tag_less : (result == 0) ? tag_equal : tag_great;
  766. }
  767. void luaI_packarg (Object *firstelem, Object *arg)
  768. {
  769. int nvararg = (firstelem != NULL) ? top-firstelem : 0;
  770. int i;
  771. if (nvararg < 0) nvararg = 0;
  772. avalue(arg) = lua_createarray(nvararg+1); /* +1 for field 'n' */
  773. tag(arg) = LUA_T_ARRAY;
  774. for (i=0; i<nvararg; i++)
  775. {
  776. Object index;
  777. tag(&index) = LUA_T_NUMBER;
  778. nvalue(&index) = i+1;
  779. *(lua_hashdefine(avalue(arg), &index)) = *(firstelem+i);
  780. }
  781. /* store counter in field "n" */
  782. {
  783. Object index, extra;
  784. tag(&index) = LUA_T_STRING;
  785. tsvalue(&index) = lua_createstring("n");
  786. tag(&extra) = LUA_T_NUMBER;
  787. nvalue(&extra) = nvararg;
  788. *(lua_hashdefine(avalue(arg), &index)) = extra;
  789. }
  790. }
  791. static void adjust_varargs (StkId first_extra_arg)
  792. {
  793. Object arg;
  794. luaI_packarg(stack+first_extra_arg, &arg);
  795. adjust_top(first_extra_arg);
  796. *top = arg; incr_top;
  797. }
  798. /*
  799. ** Execute the given opcode, until a RET. Parameters are between
  800. ** [stack+base,top). Returns n such that the the results are between
  801. ** [stack+n,top).
  802. */
  803. static StkId lua_execute (Byte *pc, StkId base)
  804. {
  805. if (lua_callhook)
  806. callHook (base, LUA_T_MARK, 0);
  807. while (1)
  808. {
  809. OpCode opcode;
  810. switch (opcode = (OpCode)*pc++)
  811. {
  812. case PUSHNIL: tag(top) = LUA_T_NIL; incr_top; break;
  813. case PUSH0: case PUSH1: case PUSH2:
  814. tag(top) = LUA_T_NUMBER;
  815. nvalue(top) = opcode-PUSH0;
  816. incr_top;
  817. break;
  818. case PUSHBYTE:
  819. tag(top) = LUA_T_NUMBER; nvalue(top) = *pc++; incr_top; break;
  820. case PUSHWORD:
  821. {
  822. Word w;
  823. get_word(w,pc);
  824. tag(top) = LUA_T_NUMBER; nvalue(top) = w;
  825. incr_top;
  826. }
  827. break;
  828. case PUSHFLOAT:
  829. {
  830. real num;
  831. get_float(num,pc);
  832. tag(top) = LUA_T_NUMBER; nvalue(top) = num;
  833. incr_top;
  834. }
  835. break;
  836. case PUSHSTRING:
  837. {
  838. Word w;
  839. get_word(w,pc);
  840. tag(top) = LUA_T_STRING; tsvalue(top) = lua_constant[w];
  841. incr_top;
  842. }
  843. break;
  844. case PUSHFUNCTION:
  845. {
  846. TFunc *f;
  847. get_code(f,pc);
  848. luaI_insertfunction(f); /* may take part in GC */
  849. top->tag = LUA_T_FUNCTION;
  850. top->value.tf = f;
  851. incr_top;
  852. }
  853. break;
  854. case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2:
  855. case PUSHLOCAL3: case PUSHLOCAL4: case PUSHLOCAL5:
  856. case PUSHLOCAL6: case PUSHLOCAL7: case PUSHLOCAL8:
  857. case PUSHLOCAL9:
  858. *top = *((stack+base) + (int)(opcode-PUSHLOCAL0)); incr_top; break;
  859. case PUSHLOCAL: *top = *((stack+base) + (*pc++)); incr_top; break;
  860. case PUSHGLOBAL:
  861. {
  862. Word w;
  863. get_word(w,pc);
  864. getglobal(w);
  865. }
  866. break;
  867. case PUSHINDEXED:
  868. pushsubscript();
  869. break;
  870. case PUSHSELF:
  871. {
  872. Object receiver = *(top-1);
  873. Word w;
  874. get_word(w,pc);
  875. tag(top) = LUA_T_STRING; tsvalue(top) = lua_constant[w];
  876. incr_top;
  877. pushsubscript();
  878. *top = receiver;
  879. incr_top;
  880. break;
  881. }
  882. case STORELOCAL0: case STORELOCAL1: case STORELOCAL2:
  883. case STORELOCAL3: case STORELOCAL4: case STORELOCAL5:
  884. case STORELOCAL6: case STORELOCAL7: case STORELOCAL8:
  885. case STORELOCAL9:
  886. *((stack+base) + (int)(opcode-STORELOCAL0)) = *(--top);
  887. break;
  888. case STORELOCAL: *((stack+base) + (*pc++)) = *(--top); break;
  889. case STOREGLOBAL:
  890. {
  891. Word w;
  892. get_word(w,pc);
  893. s_object(w) = *(--top);
  894. }
  895. break;
  896. case STOREINDEXED0:
  897. storesubscript();
  898. break;
  899. case STOREINDEXED:
  900. {
  901. int n = *pc++;
  902. if (tag(top-3-n) != LUA_T_ARRAY)
  903. {
  904. lua_checkstack(top+2);
  905. *(top+1) = *(top-1);
  906. *(top) = *(top-2-n);
  907. *(top-1) = *(top-3-n);
  908. top += 2;
  909. callFB(FB_SETTABLE);
  910. }
  911. else
  912. {
  913. Object *h = lua_hashdefine (avalue(top-3-n), top-2-n);
  914. *h = *(top-1);
  915. top--;
  916. }
  917. }
  918. break;
  919. case STORELIST0:
  920. case STORELIST:
  921. {
  922. int m, n;
  923. Object *arr;
  924. if (opcode == STORELIST0) m = 0;
  925. else m = *(pc++) * FIELDS_PER_FLUSH;
  926. n = *(pc++);
  927. arr = top-n-1;
  928. while (n)
  929. {
  930. tag(top) = LUA_T_NUMBER; nvalue(top) = n+m;
  931. *(lua_hashdefine (avalue(arr), top)) = *(top-1);
  932. top--;
  933. n--;
  934. }
  935. }
  936. break;
  937. case STORERECORD:
  938. {
  939. int n = *(pc++);
  940. Object *arr = top-n-1;
  941. while (n)
  942. {
  943. Word w;
  944. get_word(w,pc);
  945. tag(top) = LUA_T_STRING; tsvalue(top) = lua_constant[w];
  946. *(lua_hashdefine (avalue(arr), top)) = *(top-1);
  947. top--;
  948. n--;
  949. }
  950. }
  951. break;
  952. case ADJUST0:
  953. adjust_top(base);
  954. break;
  955. case ADJUST:
  956. adjust_top(base + *(pc++));
  957. break;
  958. case VARARGS:
  959. adjust_varargs(base + *(pc++));
  960. break;
  961. case CREATEARRAY:
  962. {
  963. Word size;
  964. get_word(size,pc);
  965. avalue(top) = lua_createarray(size);
  966. tag(top) = LUA_T_ARRAY;
  967. incr_top;
  968. }
  969. break;
  970. case EQOP:
  971. {
  972. int res = lua_equalObj(top-2, top-1);
  973. --top;
  974. tag(top-1) = res ? LUA_T_NUMBER : LUA_T_NIL;
  975. nvalue(top-1) = 1;
  976. }
  977. break;
  978. case LTOP:
  979. comparison(LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, "lt");
  980. break;
  981. case LEOP:
  982. comparison(LUA_T_NUMBER, LUA_T_NUMBER, LUA_T_NIL, "le");
  983. break;
  984. case GTOP:
  985. comparison(LUA_T_NIL, LUA_T_NIL, LUA_T_NUMBER, "gt");
  986. break;
  987. case GEOP:
  988. comparison(LUA_T_NIL, LUA_T_NUMBER, LUA_T_NUMBER, "ge");
  989. break;
  990. case ADDOP:
  991. {
  992. Object *l = top-2;
  993. Object *r = top-1;
  994. if (tonumber(r) || tonumber(l))
  995. call_arith("add");
  996. else
  997. {
  998. nvalue(l) += nvalue(r);
  999. --top;
  1000. }
  1001. }
  1002. break;
  1003. case SUBOP:
  1004. {
  1005. Object *l = top-2;
  1006. Object *r = top-1;
  1007. if (tonumber(r) || tonumber(l))
  1008. call_arith("sub");
  1009. else
  1010. {
  1011. nvalue(l) -= nvalue(r);
  1012. --top;
  1013. }
  1014. }
  1015. break;
  1016. case MULTOP:
  1017. {
  1018. Object *l = top-2;
  1019. Object *r = top-1;
  1020. if (tonumber(r) || tonumber(l))
  1021. call_arith("mul");
  1022. else
  1023. {
  1024. nvalue(l) *= nvalue(r);
  1025. --top;
  1026. }
  1027. }
  1028. break;
  1029. case DIVOP:
  1030. {
  1031. Object *l = top-2;
  1032. Object *r = top-1;
  1033. if (tonumber(r) || tonumber(l))
  1034. call_arith("div");
  1035. else
  1036. {
  1037. nvalue(l) /= nvalue(r);
  1038. --top;
  1039. }
  1040. }
  1041. break;
  1042. case POWOP:
  1043. call_arith("pow");
  1044. break;
  1045. case CONCOP:
  1046. {
  1047. Object *l = top-2;
  1048. Object *r = top-1;
  1049. if (tostring(r) || tostring(l))
  1050. callFB(FB_CONCAT);
  1051. else
  1052. {
  1053. tsvalue(l) = lua_createstring (lua_strconc(svalue(l),svalue(r)));
  1054. --top;
  1055. }
  1056. }
  1057. break;
  1058. case MINUSOP:
  1059. if (tonumber(top-1))
  1060. {
  1061. tag(top) = LUA_T_NIL;
  1062. incr_top;
  1063. call_arith("unm");
  1064. }
  1065. else
  1066. nvalue(top-1) = - nvalue(top-1);
  1067. break;
  1068. case NOTOP:
  1069. tag(top-1) = (tag(top-1) == LUA_T_NIL) ? LUA_T_NUMBER : LUA_T_NIL;
  1070. nvalue(top-1) = 1;
  1071. break;
  1072. case ONTJMP:
  1073. {
  1074. Word w;
  1075. get_word(w,pc);
  1076. if (tag(top-1) != LUA_T_NIL) pc += w;
  1077. }
  1078. break;
  1079. case ONFJMP:
  1080. {
  1081. Word w;
  1082. get_word(w,pc);
  1083. if (tag(top-1) == LUA_T_NIL) pc += w;
  1084. }
  1085. break;
  1086. case JMP:
  1087. {
  1088. Word w;
  1089. get_word(w,pc);
  1090. pc += w;
  1091. }
  1092. break;
  1093. case UPJMP:
  1094. {
  1095. Word w;
  1096. get_word(w,pc);
  1097. pc -= w;
  1098. }
  1099. break;
  1100. case IFFJMP:
  1101. {
  1102. Word w;
  1103. get_word(w,pc);
  1104. top--;
  1105. if (tag(top) == LUA_T_NIL) pc += w;
  1106. }
  1107. break;
  1108. case IFFUPJMP:
  1109. {
  1110. Word w;
  1111. get_word(w,pc);
  1112. top--;
  1113. if (tag(top) == LUA_T_NIL) pc -= w;
  1114. }
  1115. break;
  1116. case POP: --top; break;
  1117. case CALLFUNC:
  1118. {
  1119. int nParams = *(pc++);
  1120. int nResults = *(pc++);
  1121. StkId newBase = (top-stack)-nParams;
  1122. do_call(newBase, nResults);
  1123. }
  1124. break;
  1125. case RETCODE0:
  1126. case RETCODE:
  1127. if (lua_callhook)
  1128. callHook (base, LUA_T_MARK, 1);
  1129. return (base + ((opcode==RETCODE0) ? 0 : *pc));
  1130. case SETLINE:
  1131. {
  1132. Word line;
  1133. get_word(line,pc);
  1134. if ((stack+base-1)->tag != LUA_T_LINE)
  1135. {
  1136. /* open space for LINE value */
  1137. open_stack((top-stack)-base);
  1138. base++;
  1139. (stack+base-1)->tag = LUA_T_LINE;
  1140. }
  1141. (stack+base-1)->value.i = line;
  1142. if (lua_linehook)
  1143. lineHook (line);
  1144. break;
  1145. }
  1146. default:
  1147. lua_error ("internal error - opcode doesn't match");
  1148. }
  1149. }
  1150. }