opcode.c 24 KB

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