opcode.c 26 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325
  1. /*
  2. ** opcode.c
  3. ** TecCGraf - PUC-Rio
  4. */
  5. char *rcs_opcode="$Id: opcode.c,v 3.69 1996/05/28 21:07:32 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 non 0 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 2;
  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 non 0 on error.
  483. */
  484. int lua_dostring (char *str)
  485. {
  486. int status;
  487. if (str == NULL)
  488. return 1;
  489. lua_openstring(str);
  490. status = do_protectedmain();
  491. lua_closestring();
  492. return status;
  493. }
  494. /*
  495. ** API: set a function as a fallback
  496. */
  497. lua_Object lua_setfallback (char *name, lua_CFunction fallback)
  498. {
  499. adjustC(1); /* one slot for the pseudo-function */
  500. stack[CBase].tag = LUA_T_CFUNCTION;
  501. stack[CBase].value.f = luaI_setfallback;
  502. lua_pushstring(name);
  503. lua_pushcfunction(fallback);
  504. if (do_protectedrun(1) == 0)
  505. return (Ref(top-1));
  506. else
  507. return LUA_NOOBJECT;
  508. }
  509. /*
  510. ** API: receives on the stack the table and the index.
  511. ** returns the value.
  512. */
  513. lua_Object lua_getsubscript (void)
  514. {
  515. adjustC(2);
  516. pushsubscript();
  517. CBase++; /* incorporate object in the stack */
  518. return (Ref(top-1));
  519. }
  520. #define MAX_C_BLOCKS 10
  521. static int numCblocks = 0;
  522. static StkId Cblocks[MAX_C_BLOCKS];
  523. /*
  524. ** API: starts a new block
  525. */
  526. void lua_beginblock (void)
  527. {
  528. if (numCblocks >= MAX_C_BLOCKS)
  529. lua_error("`lua_beginblock': too many nested blocks");
  530. Cblocks[numCblocks] = CBase;
  531. numCblocks++;
  532. }
  533. /*
  534. ** API: ends a block
  535. */
  536. void lua_endblock (void)
  537. {
  538. --numCblocks;
  539. CBase = Cblocks[numCblocks];
  540. adjustC(0);
  541. }
  542. /*
  543. ** API: receives on the stack the table, the index, and the new value.
  544. */
  545. void lua_storesubscript (void)
  546. {
  547. adjustC(3);
  548. storesubscript();
  549. }
  550. /*
  551. ** API: creates a new table
  552. */
  553. lua_Object lua_createtable (void)
  554. {
  555. adjustC(0);
  556. avalue(top) = lua_createarray(0);
  557. tag(top) = LUA_T_ARRAY;
  558. incr_top;
  559. CBase++; /* incorporate object in the stack */
  560. return Ref(top-1);
  561. }
  562. /*
  563. ** Get a parameter, returning the object handle or LUA_NOOBJECT on error.
  564. ** 'number' must be 1 to get the first parameter.
  565. */
  566. lua_Object lua_getparam (int number)
  567. {
  568. if (number <= 0 || number > CnResults) return LUA_NOOBJECT;
  569. /* Ref(stack+(CBase-CnResults+number-1)) ==
  570. stack+(CBase-CnResults+number-1)-stack+1 == */
  571. return CBase-CnResults+number;
  572. }
  573. int lua_isnumber (lua_Object object)
  574. {
  575. return (object != LUA_NOOBJECT) && (tonumber(Address(object)) == 0);
  576. }
  577. int lua_isstring (lua_Object object)
  578. {
  579. int t = lua_type(object);
  580. return (t == LUA_T_STRING) || (t == LUA_T_NUMBER);
  581. }
  582. int lua_isfunction (lua_Object object)
  583. {
  584. int t = lua_type(object);
  585. return (t == LUA_T_FUNCTION) || (t == LUA_T_CFUNCTION);
  586. }
  587. /*
  588. ** Given an object handle, return its number value. On error, return 0.0.
  589. */
  590. real lua_getnumber (lua_Object object)
  591. {
  592. if (object == LUA_NOOBJECT) return 0.0;
  593. if (tonumber (Address(object))) return 0.0;
  594. else return (nvalue(Address(object)));
  595. }
  596. /*
  597. ** Given an object handle, return its string pointer. On error, return NULL.
  598. */
  599. char *lua_getstring (lua_Object object)
  600. {
  601. if (object == LUA_NOOBJECT) return NULL;
  602. if (tostring (Address(object))) return NULL;
  603. else return (svalue(Address(object)));
  604. }
  605. /*
  606. ** Given an object handle, return its cfuntion pointer. On error, return NULL.
  607. */
  608. lua_CFunction lua_getcfunction (lua_Object object)
  609. {
  610. if (object == LUA_NOOBJECT || tag(Address(object)) != LUA_T_CFUNCTION)
  611. return NULL;
  612. else return (fvalue(Address(object)));
  613. }
  614. /*
  615. ** Given an object handle, return its user data. On error, return NULL.
  616. */
  617. void *lua_getuserdata (lua_Object object)
  618. {
  619. if (object == LUA_NOOBJECT || tag(Address(object)) < LUA_T_USERDATA)
  620. return NULL;
  621. else return (uvalue(Address(object)));
  622. }
  623. lua_Object lua_getref (int ref)
  624. {
  625. Object *o = luaI_getref(ref);
  626. if (o == NULL)
  627. return LUA_NOOBJECT;
  628. adjustC(0);
  629. luaI_pushobject(o);
  630. CBase++; /* incorporate object in the stack */
  631. return Ref(top-1);
  632. }
  633. void lua_pushref (int ref)
  634. {
  635. Object *o = luaI_getref(ref);
  636. if (o == NULL)
  637. lua_error("access to invalid (possibly garbage collected) reference");
  638. luaI_pushobject(o);
  639. }
  640. int lua_ref (int lock)
  641. {
  642. adjustC(1);
  643. return luaI_ref(--top, lock);
  644. }
  645. /*
  646. ** Get a global object.
  647. */
  648. lua_Object lua_getglobal (char *name)
  649. {
  650. adjustC(0);
  651. getglobal(luaI_findsymbolbyname(name));
  652. CBase++; /* incorporate object in the stack */
  653. return Ref(top-1);
  654. }
  655. /*
  656. ** Store top of the stack at a global variable array field.
  657. */
  658. void lua_storeglobal (char *name)
  659. {
  660. Word n = luaI_findsymbolbyname(name);
  661. adjustC(1);
  662. s_object(n) = *(--top);
  663. }
  664. /*
  665. ** Push a nil object
  666. */
  667. void lua_pushnil (void)
  668. {
  669. tag(top) = LUA_T_NIL;
  670. incr_top;
  671. }
  672. /*
  673. ** Push an object (tag=number) to stack.
  674. */
  675. void lua_pushnumber (real n)
  676. {
  677. tag(top) = LUA_T_NUMBER; nvalue(top) = n;
  678. incr_top;
  679. }
  680. /*
  681. ** Push an object (tag=string) to stack.
  682. */
  683. void lua_pushstring (char *s)
  684. {
  685. if (s == NULL)
  686. tag(top) = LUA_T_NIL;
  687. else
  688. {
  689. tsvalue(top) = lua_createstring(s);
  690. tag(top) = LUA_T_STRING;
  691. }
  692. incr_top;
  693. }
  694. /*>>>>>>>>>#undef lua_pushliteral
  695. void lua_pushliteral(char *s) { lua_pushstring(s); }*/
  696. /*
  697. ** Push an object (tag=cfunction) to stack.
  698. */
  699. void lua_pushcfunction (lua_CFunction fn)
  700. {
  701. tag(top) = LUA_T_CFUNCTION; fvalue(top) = fn;
  702. incr_top;
  703. }
  704. /*
  705. ** Push an object (tag=userdata) to stack.
  706. */
  707. void lua_pushusertag (void *u, int tag)
  708. {
  709. if (tag < LUA_T_USERDATA)
  710. lua_error("invalid tag in `lua_pushusertag'");
  711. tag(top) = tag; uvalue(top) = u;
  712. incr_top;
  713. }
  714. /*
  715. ** Push an object on the stack.
  716. */
  717. void luaI_pushobject (Object *o)
  718. {
  719. *top = *o;
  720. incr_top;
  721. }
  722. /*
  723. ** Push a lua_Object on stack.
  724. */
  725. void lua_pushobject (lua_Object o)
  726. {
  727. if (o == LUA_NOOBJECT)
  728. lua_error("attempt to push a NOOBJECT");
  729. luaI_pushobject(Address(o));
  730. }
  731. int lua_type (lua_Object o)
  732. {
  733. if (o == LUA_NOOBJECT)
  734. return LUA_T_NIL;
  735. else
  736. return tag(Address(o));
  737. }
  738. void luaI_gcFB (Object *o)
  739. {
  740. *top = *o;
  741. incr_top;
  742. callFB(FB_GC);
  743. }
  744. static void call_arith (char *op)
  745. {
  746. lua_pushstring(op);
  747. callFB(FB_ARITH);
  748. }
  749. static void comparison (lua_Type tag_less, lua_Type tag_equal,
  750. lua_Type tag_great, char *op)
  751. {
  752. Object *l = top-2;
  753. Object *r = top-1;
  754. int result;
  755. if (tag(l) == LUA_T_NUMBER && tag(r) == LUA_T_NUMBER)
  756. result = (nvalue(l) < nvalue(r)) ? -1 : (nvalue(l) == nvalue(r)) ? 0 : 1;
  757. else if (tostring(l) || tostring(r))
  758. {
  759. lua_pushstring(op);
  760. callFB(FB_ORDER);
  761. return;
  762. }
  763. else
  764. result = strcmp(svalue(l), svalue(r));
  765. top--;
  766. nvalue(top-1) = 1;
  767. tag(top-1) = (result < 0) ? tag_less : (result == 0) ? tag_equal : tag_great;
  768. }
  769. void luaI_packarg (Object *firstelem, Object *arg)
  770. {
  771. int nvararg = (firstelem != NULL) ? top-firstelem : 0;
  772. int i;
  773. if (nvararg < 0) nvararg = 0;
  774. avalue(arg) = lua_createarray(nvararg+1); /* +1 for field 'n' */
  775. tag(arg) = LUA_T_ARRAY;
  776. for (i=0; i<nvararg; i++)
  777. {
  778. Object index;
  779. tag(&index) = LUA_T_NUMBER;
  780. nvalue(&index) = i+1;
  781. *(lua_hashdefine(avalue(arg), &index)) = *(firstelem+i);
  782. }
  783. /* store counter in field "n" */
  784. {
  785. Object index, extra;
  786. tag(&index) = LUA_T_STRING;
  787. tsvalue(&index) = lua_createstring("n");
  788. tag(&extra) = LUA_T_NUMBER;
  789. nvalue(&extra) = nvararg;
  790. *(lua_hashdefine(avalue(arg), &index)) = extra;
  791. }
  792. }
  793. static void adjust_varargs (StkId first_extra_arg)
  794. {
  795. Object arg;
  796. luaI_packarg(stack+first_extra_arg, &arg);
  797. adjust_top(first_extra_arg);
  798. *top = arg; incr_top;
  799. }
  800. /*
  801. ** Execute the given opcode, until a RET. Parameters are between
  802. ** [stack+base,top). Returns n such that the the results are between
  803. ** [stack+n,top).
  804. */
  805. static StkId lua_execute (Byte *pc, StkId base)
  806. {
  807. if (lua_callhook)
  808. callHook (base, LUA_T_MARK, 0);
  809. while (1)
  810. {
  811. OpCode opcode;
  812. switch (opcode = (OpCode)*pc++)
  813. {
  814. case PUSHNIL: tag(top) = LUA_T_NIL; incr_top; break;
  815. case PUSH0: case PUSH1: case PUSH2:
  816. tag(top) = LUA_T_NUMBER;
  817. nvalue(top) = opcode-PUSH0;
  818. incr_top;
  819. break;
  820. case PUSHBYTE:
  821. tag(top) = LUA_T_NUMBER; nvalue(top) = *pc++; incr_top; break;
  822. case PUSHWORD:
  823. {
  824. Word w;
  825. get_word(w,pc);
  826. tag(top) = LUA_T_NUMBER; nvalue(top) = w;
  827. incr_top;
  828. }
  829. break;
  830. case PUSHFLOAT:
  831. {
  832. real num;
  833. get_float(num,pc);
  834. tag(top) = LUA_T_NUMBER; nvalue(top) = num;
  835. incr_top;
  836. }
  837. break;
  838. case PUSHSTRING:
  839. {
  840. Word w;
  841. get_word(w,pc);
  842. tag(top) = LUA_T_STRING; tsvalue(top) = lua_constant[w];
  843. incr_top;
  844. }
  845. break;
  846. case PUSHFUNCTION:
  847. {
  848. TFunc *f;
  849. get_code(f,pc);
  850. luaI_insertfunction(f); /* may take part in GC */
  851. top->tag = LUA_T_FUNCTION;
  852. top->value.tf = f;
  853. incr_top;
  854. }
  855. break;
  856. case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2:
  857. case PUSHLOCAL3: case PUSHLOCAL4: case PUSHLOCAL5:
  858. case PUSHLOCAL6: case PUSHLOCAL7: case PUSHLOCAL8:
  859. case PUSHLOCAL9:
  860. *top = *((stack+base) + (int)(opcode-PUSHLOCAL0)); incr_top; break;
  861. case PUSHLOCAL: *top = *((stack+base) + (*pc++)); incr_top; break;
  862. case PUSHGLOBAL:
  863. {
  864. Word w;
  865. get_word(w,pc);
  866. getglobal(w);
  867. }
  868. break;
  869. case PUSHINDEXED:
  870. pushsubscript();
  871. break;
  872. case PUSHSELF:
  873. {
  874. Object receiver = *(top-1);
  875. Word w;
  876. get_word(w,pc);
  877. tag(top) = LUA_T_STRING; tsvalue(top) = lua_constant[w];
  878. incr_top;
  879. pushsubscript();
  880. *top = receiver;
  881. incr_top;
  882. break;
  883. }
  884. case STORELOCAL0: case STORELOCAL1: case STORELOCAL2:
  885. case STORELOCAL3: case STORELOCAL4: case STORELOCAL5:
  886. case STORELOCAL6: case STORELOCAL7: case STORELOCAL8:
  887. case STORELOCAL9:
  888. *((stack+base) + (int)(opcode-STORELOCAL0)) = *(--top);
  889. break;
  890. case STORELOCAL: *((stack+base) + (*pc++)) = *(--top); break;
  891. case STOREGLOBAL:
  892. {
  893. Word w;
  894. get_word(w,pc);
  895. s_object(w) = *(--top);
  896. }
  897. break;
  898. case STOREINDEXED0:
  899. storesubscript();
  900. break;
  901. case STOREINDEXED:
  902. {
  903. int n = *pc++;
  904. if (tag(top-3-n) != LUA_T_ARRAY)
  905. {
  906. lua_checkstack(top+2);
  907. *(top+1) = *(top-1);
  908. *(top) = *(top-2-n);
  909. *(top-1) = *(top-3-n);
  910. top += 2;
  911. callFB(FB_SETTABLE);
  912. }
  913. else
  914. {
  915. Object *h = lua_hashdefine (avalue(top-3-n), top-2-n);
  916. *h = *(top-1);
  917. top--;
  918. }
  919. }
  920. break;
  921. case STORELIST0:
  922. case STORELIST:
  923. {
  924. int m, n;
  925. Object *arr;
  926. if (opcode == STORELIST0) m = 0;
  927. else m = *(pc++) * FIELDS_PER_FLUSH;
  928. n = *(pc++);
  929. arr = top-n-1;
  930. while (n)
  931. {
  932. tag(top) = LUA_T_NUMBER; nvalue(top) = n+m;
  933. *(lua_hashdefine (avalue(arr), top)) = *(top-1);
  934. top--;
  935. n--;
  936. }
  937. }
  938. break;
  939. case STORERECORD:
  940. {
  941. int n = *(pc++);
  942. Object *arr = top-n-1;
  943. while (n)
  944. {
  945. Word w;
  946. get_word(w,pc);
  947. tag(top) = LUA_T_STRING; tsvalue(top) = lua_constant[w];
  948. *(lua_hashdefine (avalue(arr), top)) = *(top-1);
  949. top--;
  950. n--;
  951. }
  952. }
  953. break;
  954. case ADJUST0:
  955. adjust_top(base);
  956. break;
  957. case ADJUST:
  958. adjust_top(base + *(pc++));
  959. break;
  960. case VARARGS:
  961. adjust_varargs(base + *(pc++));
  962. break;
  963. case CREATEARRAY:
  964. {
  965. Word size;
  966. get_word(size,pc);
  967. avalue(top) = lua_createarray(size);
  968. tag(top) = LUA_T_ARRAY;
  969. incr_top;
  970. }
  971. break;
  972. case EQOP:
  973. {
  974. int res = lua_equalObj(top-2, top-1);
  975. --top;
  976. tag(top-1) = res ? LUA_T_NUMBER : LUA_T_NIL;
  977. nvalue(top-1) = 1;
  978. }
  979. break;
  980. case LTOP:
  981. comparison(LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, "lt");
  982. break;
  983. case LEOP:
  984. comparison(LUA_T_NUMBER, LUA_T_NUMBER, LUA_T_NIL, "le");
  985. break;
  986. case GTOP:
  987. comparison(LUA_T_NIL, LUA_T_NIL, LUA_T_NUMBER, "gt");
  988. break;
  989. case GEOP:
  990. comparison(LUA_T_NIL, LUA_T_NUMBER, LUA_T_NUMBER, "ge");
  991. break;
  992. case ADDOP:
  993. {
  994. Object *l = top-2;
  995. Object *r = top-1;
  996. if (tonumber(r) || tonumber(l))
  997. call_arith("add");
  998. else
  999. {
  1000. nvalue(l) += nvalue(r);
  1001. --top;
  1002. }
  1003. }
  1004. break;
  1005. case SUBOP:
  1006. {
  1007. Object *l = top-2;
  1008. Object *r = top-1;
  1009. if (tonumber(r) || tonumber(l))
  1010. call_arith("sub");
  1011. else
  1012. {
  1013. nvalue(l) -= nvalue(r);
  1014. --top;
  1015. }
  1016. }
  1017. break;
  1018. case MULTOP:
  1019. {
  1020. Object *l = top-2;
  1021. Object *r = top-1;
  1022. if (tonumber(r) || tonumber(l))
  1023. call_arith("mul");
  1024. else
  1025. {
  1026. nvalue(l) *= nvalue(r);
  1027. --top;
  1028. }
  1029. }
  1030. break;
  1031. case DIVOP:
  1032. {
  1033. Object *l = top-2;
  1034. Object *r = top-1;
  1035. if (tonumber(r) || tonumber(l))
  1036. call_arith("div");
  1037. else
  1038. {
  1039. nvalue(l) /= nvalue(r);
  1040. --top;
  1041. }
  1042. }
  1043. break;
  1044. case POWOP:
  1045. call_arith("pow");
  1046. break;
  1047. case CONCOP:
  1048. {
  1049. Object *l = top-2;
  1050. Object *r = top-1;
  1051. if (tostring(r) || tostring(l))
  1052. callFB(FB_CONCAT);
  1053. else
  1054. {
  1055. tsvalue(l) = lua_createstring (lua_strconc(svalue(l),svalue(r)));
  1056. --top;
  1057. }
  1058. }
  1059. break;
  1060. case MINUSOP:
  1061. if (tonumber(top-1))
  1062. {
  1063. tag(top) = LUA_T_NIL;
  1064. incr_top;
  1065. call_arith("unm");
  1066. }
  1067. else
  1068. nvalue(top-1) = - nvalue(top-1);
  1069. break;
  1070. case NOTOP:
  1071. tag(top-1) = (tag(top-1) == LUA_T_NIL) ? LUA_T_NUMBER : LUA_T_NIL;
  1072. nvalue(top-1) = 1;
  1073. break;
  1074. case ONTJMP:
  1075. {
  1076. Word w;
  1077. get_word(w,pc);
  1078. if (tag(top-1) != LUA_T_NIL) pc += w;
  1079. }
  1080. break;
  1081. case ONFJMP:
  1082. {
  1083. Word w;
  1084. get_word(w,pc);
  1085. if (tag(top-1) == LUA_T_NIL) pc += w;
  1086. }
  1087. break;
  1088. case JMP:
  1089. {
  1090. Word w;
  1091. get_word(w,pc);
  1092. pc += w;
  1093. }
  1094. break;
  1095. case UPJMP:
  1096. {
  1097. Word w;
  1098. get_word(w,pc);
  1099. pc -= w;
  1100. }
  1101. break;
  1102. case IFFJMP:
  1103. {
  1104. Word w;
  1105. get_word(w,pc);
  1106. top--;
  1107. if (tag(top) == LUA_T_NIL) pc += w;
  1108. }
  1109. break;
  1110. case IFFUPJMP:
  1111. {
  1112. Word w;
  1113. get_word(w,pc);
  1114. top--;
  1115. if (tag(top) == LUA_T_NIL) pc -= w;
  1116. }
  1117. break;
  1118. case POP: --top; break;
  1119. case CALLFUNC:
  1120. {
  1121. int nParams = *(pc++);
  1122. int nResults = *(pc++);
  1123. StkId newBase = (top-stack)-nParams;
  1124. do_call(newBase, nResults);
  1125. }
  1126. break;
  1127. case RETCODE0:
  1128. case RETCODE:
  1129. if (lua_callhook)
  1130. callHook (base, LUA_T_MARK, 1);
  1131. return (base + ((opcode==RETCODE0) ? 0 : *pc));
  1132. case SETLINE:
  1133. {
  1134. Word line;
  1135. get_word(line,pc);
  1136. if ((stack+base-1)->tag != LUA_T_LINE)
  1137. {
  1138. /* open space for LINE value */
  1139. open_stack((top-stack)-base);
  1140. base++;
  1141. (stack+base-1)->tag = LUA_T_LINE;
  1142. }
  1143. (stack+base-1)->value.i = line;
  1144. if (lua_linehook)
  1145. lineHook (line);
  1146. break;
  1147. }
  1148. default:
  1149. lua_error ("internal error - opcode doesn't match");
  1150. }
  1151. }
  1152. }