opcode.c 24 KB

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