opcode.c 20 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036
  1. /*
  2. ** opcode.c
  3. ** TecCGraf - PUC-Rio
  4. */
  5. char *rcs_opcode="$Id: opcode.c,v 2.1 1994/04/20 22:07:57 celes Exp celes $";
  6. #include <stdio.h>
  7. #include <stdlib.h>
  8. #include <string.h>
  9. #ifdef __GNUC__
  10. #include <floatingpoint.h>
  11. #endif
  12. #include "mm.h"
  13. #include "opcode.h"
  14. #include "hash.h"
  15. #include "inout.h"
  16. #include "table.h"
  17. #include "lua.h"
  18. #define tonumber(o) ((tag(o) != T_NUMBER) && (lua_tonumber(o) != 0))
  19. #define tostring(o) ((tag(o) != T_STRING) && (lua_tostring(o) != 0))
  20. #define STACK_BUFFER (STACKGAP+128)
  21. static Word maxstack;
  22. static Object *stack=NULL;
  23. static Object *top, *base;
  24. /*
  25. ** Init stack
  26. */
  27. static int lua_initstack (void)
  28. {
  29. maxstack = STACK_BUFFER;
  30. stack = (Object *)calloc(maxstack, sizeof(Object));
  31. if (stack == NULL)
  32. {
  33. lua_error("stack - not enough memory");
  34. return 1;
  35. }
  36. tag(stack) = T_MARK;
  37. top = base = stack+1;
  38. return 0;
  39. }
  40. /*
  41. ** Check stack overflow and, if necessary, realloc vector
  42. */
  43. static int lua_checkstack (Word n)
  44. {
  45. if (stack == NULL)
  46. return lua_initstack();
  47. if (n > maxstack)
  48. {
  49. Word t = top-stack;
  50. Word b = base-stack;
  51. maxstack *= 2;
  52. stack = (Object *)realloc(stack, maxstack*sizeof(Object));
  53. if (stack == NULL)
  54. {
  55. lua_error("stack - not enough memory");
  56. return 1;
  57. }
  58. top = stack + t;
  59. base = stack + b;
  60. }
  61. return 0;
  62. }
  63. /*
  64. ** Concatenate two given string, creating a mark space at the beginning.
  65. ** Return the new string pointer.
  66. */
  67. static char *lua_strconc (char *l, char *r)
  68. {
  69. static char buffer[1024];
  70. int n = strlen(l)+strlen(r)+1;
  71. if (n > 1024)
  72. {
  73. lua_error ("string too large");
  74. return NULL;
  75. }
  76. return strcat(strcpy(buffer,l),r);
  77. }
  78. /*
  79. ** Convert, if possible, to a number tag.
  80. ** Return 0 in success or not 0 on error.
  81. */
  82. static int lua_tonumber (Object *obj)
  83. {
  84. char *ptr;
  85. if (tag(obj) != T_STRING)
  86. {
  87. lua_reportbug ("unexpected type at conversion to number");
  88. return 1;
  89. }
  90. nvalue(obj) = strtod(svalue(obj), &ptr);
  91. if (*ptr)
  92. {
  93. lua_reportbug ("string to number convertion failed");
  94. return 2;
  95. }
  96. tag(obj) = T_NUMBER;
  97. return 0;
  98. }
  99. /*
  100. ** Test if is possible to convert an object to a number one.
  101. ** If possible, return the converted object, otherwise return nil object.
  102. */
  103. static Object *lua_convtonumber (Object *obj)
  104. {
  105. static Object cvt;
  106. if (tag(obj) == T_NUMBER)
  107. {
  108. cvt = *obj;
  109. return &cvt;
  110. }
  111. tag(&cvt) = T_NIL;
  112. if (tag(obj) == T_STRING)
  113. {
  114. char *ptr;
  115. nvalue(&cvt) = strtod(svalue(obj), &ptr);
  116. if (*ptr == 0)
  117. tag(&cvt) = T_NUMBER;
  118. }
  119. return &cvt;
  120. }
  121. /*
  122. ** Convert, if possible, to a string tag
  123. ** Return 0 in success or not 0 on error.
  124. */
  125. static int lua_tostring (Object *obj)
  126. {
  127. static char s[256];
  128. if (tag(obj) != T_NUMBER)
  129. {
  130. lua_reportbug ("unexpected type at conversion to string");
  131. return 1;
  132. }
  133. if ((int) nvalue(obj) == nvalue(obj))
  134. sprintf (s, "%d", (int) nvalue(obj));
  135. else
  136. sprintf (s, "%g", nvalue(obj));
  137. svalue(obj) = lua_createstring(s);
  138. if (svalue(obj) == NULL)
  139. return 1;
  140. tag(obj) = T_STRING;
  141. return 0;
  142. }
  143. /*
  144. ** Execute the given opcode. Return 0 in success or 1 on error.
  145. */
  146. int lua_execute (Byte *pc)
  147. {
  148. Word oldbase;
  149. if (stack == NULL)
  150. lua_initstack();
  151. oldbase = base-stack;
  152. base = top;
  153. while (1)
  154. {
  155. OpCode opcode;
  156. switch (opcode = (OpCode)*pc++)
  157. {
  158. case PUSHNIL: tag(top++) = T_NIL; break;
  159. case PUSH0: tag(top) = T_NUMBER; nvalue(top++) = 0; break;
  160. case PUSH1: tag(top) = T_NUMBER; nvalue(top++) = 1; break;
  161. case PUSH2: tag(top) = T_NUMBER; nvalue(top++) = 2; break;
  162. case PUSHBYTE: tag(top) = T_NUMBER; nvalue(top++) = *pc++; break;
  163. case PUSHWORD:
  164. {
  165. CodeWord code;
  166. get_word(code,pc);
  167. tag(top) = T_NUMBER; nvalue(top++) = code.w;
  168. }
  169. break;
  170. case PUSHFLOAT:
  171. {
  172. CodeFloat code;
  173. get_float(code,pc);
  174. tag(top) = T_NUMBER; nvalue(top++) = code.f;
  175. }
  176. break;
  177. case PUSHSTRING:
  178. {
  179. CodeWord code;
  180. get_word(code,pc);
  181. tag(top) = T_STRING; svalue(top++) = lua_constant[code.w];
  182. }
  183. break;
  184. case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2:
  185. case PUSHLOCAL3: case PUSHLOCAL4: case PUSHLOCAL5:
  186. case PUSHLOCAL6: case PUSHLOCAL7: case PUSHLOCAL8:
  187. case PUSHLOCAL9: *top++ = *(base + (int)(opcode-PUSHLOCAL0)); break;
  188. case PUSHLOCAL: *top++ = *(base + (*pc++)); break;
  189. case PUSHGLOBAL:
  190. {
  191. CodeWord code;
  192. get_word(code,pc);
  193. *top++ = s_object(code.w);
  194. }
  195. break;
  196. case PUSHINDEXED:
  197. --top;
  198. if (tag(top-1) != T_ARRAY)
  199. {
  200. lua_reportbug ("indexed expression not a table");
  201. return 1;
  202. }
  203. {
  204. Object *h = lua_hashdefine (avalue(top-1), top);
  205. if (h == NULL) return 1;
  206. *(top-1) = *h;
  207. }
  208. break;
  209. case PUSHMARK: tag(top++) = T_MARK; break;
  210. case PUSHOBJECT: *top = *(top-3); top++; break;
  211. case STORELOCAL0: case STORELOCAL1: case STORELOCAL2:
  212. case STORELOCAL3: case STORELOCAL4: case STORELOCAL5:
  213. case STORELOCAL6: case STORELOCAL7: case STORELOCAL8:
  214. case STORELOCAL9: *(base + (int)(opcode-STORELOCAL0)) = *(--top); break;
  215. case STORELOCAL: *(base + (*pc++)) = *(--top); break;
  216. case STOREGLOBAL:
  217. {
  218. CodeWord code;
  219. get_word(code,pc);
  220. s_object(code.w) = *(--top);
  221. }
  222. break;
  223. case STOREINDEXED0:
  224. if (tag(top-3) != T_ARRAY)
  225. {
  226. lua_reportbug ("indexed expression not a table");
  227. return 1;
  228. }
  229. {
  230. Object *h = lua_hashdefine (avalue(top-3), top-2);
  231. if (h == NULL) return 1;
  232. *h = *(top-1);
  233. }
  234. top -= 3;
  235. break;
  236. case STOREINDEXED:
  237. {
  238. int n = *pc++;
  239. if (tag(top-3-n) != T_ARRAY)
  240. {
  241. lua_reportbug ("indexed expression not a table");
  242. return 1;
  243. }
  244. {
  245. Object *h = lua_hashdefine (avalue(top-3-n), top-2-n);
  246. if (h == NULL) return 1;
  247. *h = *(top-1);
  248. }
  249. top--;
  250. }
  251. break;
  252. case STORELIST0:
  253. case STORELIST:
  254. {
  255. int m, n;
  256. Object *arr;
  257. if (opcode == STORELIST0) m = 0;
  258. else m = *(pc++) * FIELDS_PER_FLUSH;
  259. n = *(pc++);
  260. arr = top-n-1;
  261. if (tag(arr) != T_ARRAY)
  262. {
  263. lua_reportbug ("internal error - table expected");
  264. return 1;
  265. }
  266. while (n)
  267. {
  268. tag(top) = T_NUMBER; nvalue(top) = n+m;
  269. *(lua_hashdefine (avalue(arr), top)) = *(top-1);
  270. top--;
  271. n--;
  272. }
  273. }
  274. break;
  275. case STORERECORD:
  276. {
  277. int n = *(pc++);
  278. Object *arr = top-n-1;
  279. if (tag(arr) != T_ARRAY)
  280. {
  281. lua_reportbug ("internal error - table expected");
  282. return 1;
  283. }
  284. while (n)
  285. {
  286. CodeWord code;
  287. get_word(code,pc);
  288. tag(top) = T_STRING; svalue(top) = lua_constant[code.w];
  289. *(lua_hashdefine (avalue(arr), top)) = *(top-1);
  290. top--;
  291. n--;
  292. }
  293. }
  294. break;
  295. case ADJUST:
  296. {
  297. Object *newtop = base + *(pc++);
  298. while (top < newtop) tag(top++) = T_NIL;
  299. top = newtop; /* top could be bigger than newtop */
  300. }
  301. break;
  302. case CREATEARRAY:
  303. if (tag(top-1) == T_NIL)
  304. nvalue(top-1) = 101;
  305. else
  306. {
  307. if (tonumber(top-1)) return 1;
  308. if (nvalue(top-1) <= 0) nvalue(top-1) = 101;
  309. }
  310. avalue(top-1) = lua_createarray(nvalue(top-1));
  311. if (avalue(top-1) == NULL)
  312. return 1;
  313. tag(top-1) = T_ARRAY;
  314. break;
  315. case EQOP:
  316. {
  317. Object *l = top-2;
  318. Object *r = top-1;
  319. --top;
  320. if (tag(l) != tag(r))
  321. tag(top-1) = T_NIL;
  322. else
  323. {
  324. switch (tag(l))
  325. {
  326. case T_NIL: tag(top-1) = T_NUMBER; break;
  327. case T_NUMBER: tag(top-1) = (nvalue(l) == nvalue(r)) ? T_NUMBER : T_NIL; break;
  328. case T_ARRAY: tag(top-1) = (avalue(l) == avalue(r)) ? T_NUMBER : T_NIL; break;
  329. case T_FUNCTION: tag(top-1) = (bvalue(l) == bvalue(r)) ? T_NUMBER : T_NIL; break;
  330. case T_CFUNCTION: tag(top-1) = (fvalue(l) == fvalue(r)) ? T_NUMBER : T_NIL; break;
  331. case T_USERDATA: tag(top-1) = (uvalue(l) == uvalue(r)) ? T_NUMBER : T_NIL; break;
  332. case T_STRING: tag(top-1) = (strcmp (svalue(l), svalue(r)) == 0) ? T_NUMBER : T_NIL; break;
  333. case T_MARK: return 1;
  334. }
  335. }
  336. nvalue(top-1) = 1;
  337. }
  338. break;
  339. case LTOP:
  340. {
  341. Object *l = top-2;
  342. Object *r = top-1;
  343. --top;
  344. if (tag(l) == T_NUMBER && tag(r) == T_NUMBER)
  345. tag(top-1) = (nvalue(l) < nvalue(r)) ? T_NUMBER : T_NIL;
  346. else
  347. {
  348. if (tostring(l) || tostring(r))
  349. return 1;
  350. tag(top-1) = (strcmp (svalue(l), svalue(r)) < 0) ? T_NUMBER : T_NIL;
  351. }
  352. nvalue(top-1) = 1;
  353. }
  354. break;
  355. case LEOP:
  356. {
  357. Object *l = top-2;
  358. Object *r = top-1;
  359. --top;
  360. if (tag(l) == T_NUMBER && tag(r) == T_NUMBER)
  361. tag(top-1) = (nvalue(l) <= nvalue(r)) ? T_NUMBER : T_NIL;
  362. else
  363. {
  364. if (tostring(l) || tostring(r))
  365. return 1;
  366. tag(top-1) = (strcmp (svalue(l), svalue(r)) <= 0) ? T_NUMBER : T_NIL;
  367. }
  368. nvalue(top-1) = 1;
  369. }
  370. break;
  371. case ADDOP:
  372. {
  373. Object *l = top-2;
  374. Object *r = top-1;
  375. if (tonumber(r) || tonumber(l))
  376. return 1;
  377. nvalue(l) += nvalue(r);
  378. --top;
  379. }
  380. break;
  381. case SUBOP:
  382. {
  383. Object *l = top-2;
  384. Object *r = top-1;
  385. if (tonumber(r) || tonumber(l))
  386. return 1;
  387. nvalue(l) -= nvalue(r);
  388. --top;
  389. }
  390. break;
  391. case MULTOP:
  392. {
  393. Object *l = top-2;
  394. Object *r = top-1;
  395. if (tonumber(r) || tonumber(l))
  396. return 1;
  397. nvalue(l) *= nvalue(r);
  398. --top;
  399. }
  400. break;
  401. case DIVOP:
  402. {
  403. Object *l = top-2;
  404. Object *r = top-1;
  405. if (tonumber(r) || tonumber(l))
  406. return 1;
  407. nvalue(l) /= nvalue(r);
  408. --top;
  409. }
  410. break;
  411. case CONCOP:
  412. {
  413. Object *l = top-2;
  414. Object *r = top-1;
  415. if (tostring(r) || tostring(l))
  416. return 1;
  417. svalue(l) = lua_createstring (lua_strconc(svalue(l),svalue(r)));
  418. if (svalue(l) == NULL)
  419. return 1;
  420. --top;
  421. }
  422. break;
  423. case MINUSOP:
  424. if (tonumber(top-1))
  425. return 1;
  426. nvalue(top-1) = - nvalue(top-1);
  427. break;
  428. case NOTOP:
  429. tag(top-1) = tag(top-1) == T_NIL ? T_NUMBER : T_NIL;
  430. break;
  431. case ONTJMP:
  432. {
  433. CodeWord code;
  434. get_word(code,pc);
  435. if (tag(top-1) != T_NIL) pc += code.w;
  436. }
  437. break;
  438. case ONFJMP:
  439. {
  440. CodeWord code;
  441. get_word(code,pc);
  442. if (tag(top-1) == T_NIL) pc += code.w;
  443. }
  444. break;
  445. case JMP:
  446. {
  447. CodeWord code;
  448. get_word(code,pc);
  449. pc += code.w;
  450. }
  451. break;
  452. case UPJMP:
  453. {
  454. CodeWord code;
  455. get_word(code,pc);
  456. pc -= code.w;
  457. }
  458. break;
  459. case IFFJMP:
  460. {
  461. CodeWord code;
  462. get_word(code,pc);
  463. top--;
  464. if (tag(top) == T_NIL) pc += code.w;
  465. }
  466. break;
  467. case IFFUPJMP:
  468. {
  469. CodeWord code;
  470. get_word(code,pc);
  471. top--;
  472. if (tag(top) == T_NIL) pc -= code.w;
  473. }
  474. break;
  475. case POP: --top; break;
  476. case CALLFUNC:
  477. {
  478. Byte *newpc;
  479. Object *b = top-1;
  480. while (tag(b) != T_MARK) b--;
  481. if (tag(b-1) == T_FUNCTION)
  482. {
  483. lua_debugline = 0; /* always reset debug flag */
  484. newpc = bvalue(b-1);
  485. bvalue(b-1) = pc; /* store return code */
  486. nvalue(b) = (base-stack); /* store base value */
  487. base = b+1;
  488. pc = newpc;
  489. if (lua_checkstack(STACKGAP+(base-stack)))
  490. return 1;
  491. }
  492. else if (tag(b-1) == T_CFUNCTION)
  493. {
  494. int nparam;
  495. lua_debugline = 0; /* always reset debug flag */
  496. nvalue(b) = (base-stack); /* store base value */
  497. base = b+1;
  498. nparam = top-base; /* number of parameters */
  499. (fvalue(b-1))(); /* call C function */
  500. /* shift returned values */
  501. {
  502. int i;
  503. int nretval = top - base - nparam;
  504. top = base - 2;
  505. base = stack + (int) nvalue(base-1);
  506. for (i=0; i<nretval; i++)
  507. {
  508. *top = *(top+nparam+2);
  509. ++top;
  510. }
  511. }
  512. }
  513. else
  514. {
  515. lua_reportbug ("call expression not a function");
  516. return 1;
  517. }
  518. }
  519. break;
  520. case RETCODE:
  521. {
  522. int i;
  523. int shift = *pc++;
  524. int nretval = top - base - shift;
  525. top = base - 2;
  526. pc = bvalue(base-2);
  527. base = stack + (int) nvalue(base-1);
  528. for (i=0; i<nretval; i++)
  529. {
  530. *top = *(top+shift+2);
  531. ++top;
  532. }
  533. }
  534. break;
  535. case HALT:
  536. base = stack+oldbase;
  537. return 0; /* success */
  538. case SETFUNCTION:
  539. {
  540. CodeWord file, func;
  541. get_word(file,pc);
  542. get_word(func,pc);
  543. if (lua_pushfunction (file.w, func.w))
  544. return 1;
  545. }
  546. break;
  547. case SETLINE:
  548. {
  549. CodeWord code;
  550. get_word(code,pc);
  551. lua_debugline = code.w;
  552. }
  553. break;
  554. case RESET:
  555. lua_popfunction ();
  556. break;
  557. default:
  558. lua_error ("internal error - opcode didn't match");
  559. return 1;
  560. }
  561. }
  562. }
  563. /*
  564. ** Traverse all objects on stack
  565. */
  566. void lua_travstack (void (*fn)(Object *))
  567. {
  568. Object *o;
  569. for (o = top-1; o >= stack; o--)
  570. fn (o);
  571. }
  572. /*
  573. ** Open file, generate opcode and execute global statement. Return 0 on
  574. ** success or 1 on error.
  575. */
  576. int lua_dofile (char *filename)
  577. {
  578. if (lua_openfile (filename)) return 1;
  579. if (lua_parse ()) { lua_closefile (); return 1; }
  580. lua_closefile ();
  581. return 0;
  582. }
  583. /*
  584. ** Generate opcode stored on string and execute global statement. Return 0 on
  585. ** success or 1 on error.
  586. */
  587. int lua_dostring (char *string)
  588. {
  589. if (lua_openstring (string)) return 1;
  590. if (lua_parse ()) return 1;
  591. lua_closestring();
  592. return 0;
  593. }
  594. /*
  595. ** Execute the given function. Return 0 on success or 1 on error.
  596. */
  597. int lua_call (char *functionname, int nparam)
  598. {
  599. static Byte startcode[] = {CALLFUNC, HALT};
  600. int i;
  601. Object func = s_object(lua_findsymbol(functionname));
  602. if (tag(&func) != T_FUNCTION) return 1;
  603. for (i=1; i<=nparam; i++)
  604. *(top-i+2) = *(top-i);
  605. top += 2;
  606. tag(top-nparam-1) = T_MARK;
  607. *(top-nparam-2) = func;
  608. return (lua_execute (startcode));
  609. }
  610. /*
  611. ** Get a parameter, returning the object handle or NULL on error.
  612. ** 'number' must be 1 to get the first parameter.
  613. */
  614. Object *lua_getparam (int number)
  615. {
  616. if (number <= 0 || number > top-base) return NULL;
  617. return (base+number-1);
  618. }
  619. /*
  620. ** Given an object handle, return its number value. On error, return 0.0.
  621. */
  622. real lua_getnumber (Object *object)
  623. {
  624. if (object == NULL || tag(object) == T_NIL) return 0.0;
  625. if (tonumber (object)) return 0.0;
  626. else return (nvalue(object));
  627. }
  628. /*
  629. ** Given an object handle, return its string pointer. On error, return NULL.
  630. */
  631. char *lua_getstring (Object *object)
  632. {
  633. if (object == NULL || tag(object) == T_NIL) return NULL;
  634. if (tostring (object)) return NULL;
  635. else return (svalue(object));
  636. }
  637. /*
  638. ** Given an object handle, return a copy of its string. On error, return NULL.
  639. */
  640. char *lua_copystring (Object *object)
  641. {
  642. if (object == NULL || tag(object) == T_NIL) return NULL;
  643. if (tostring (object)) return NULL;
  644. else return (strdup(svalue(object)));
  645. }
  646. /*
  647. ** Given an object handle, return its cfuntion pointer. On error, return NULL.
  648. */
  649. lua_CFunction lua_getcfunction (Object *object)
  650. {
  651. if (object == NULL) return NULL;
  652. if (tag(object) != T_CFUNCTION) return NULL;
  653. else return (fvalue(object));
  654. }
  655. /*
  656. ** Given an object handle, return its user data. On error, return NULL.
  657. */
  658. void *lua_getuserdata (Object *object)
  659. {
  660. if (object == NULL) return NULL;
  661. if (tag(object) != T_USERDATA) return NULL;
  662. else return (uvalue(object));
  663. }
  664. /*
  665. ** Given an object handle and a field name, return its field object.
  666. ** On error, return NULL.
  667. */
  668. Object *lua_getfield (Object *object, char *field)
  669. {
  670. if (object == NULL) return NULL;
  671. if (tag(object) != T_ARRAY)
  672. return NULL;
  673. else
  674. {
  675. Object ref;
  676. tag(&ref) = T_STRING;
  677. svalue(&ref) = lua_createstring(field);
  678. return (lua_hashdefine(avalue(object), &ref));
  679. }
  680. }
  681. /*
  682. ** Given an object handle and an index, return its indexed object.
  683. ** On error, return NULL.
  684. */
  685. Object *lua_getindexed (Object *object, float index)
  686. {
  687. if (object == NULL) return NULL;
  688. if (tag(object) != T_ARRAY)
  689. return NULL;
  690. else
  691. {
  692. Object ref;
  693. tag(&ref) = T_NUMBER;
  694. nvalue(&ref) = index;
  695. return (lua_hashdefine(avalue(object), &ref));
  696. }
  697. }
  698. /*
  699. ** Get a global object. Return the object handle or NULL on error.
  700. */
  701. Object *lua_getglobal (char *name)
  702. {
  703. int n = lua_findsymbol(name);
  704. if (n < 0) return NULL;
  705. return &s_object(n);
  706. }
  707. /*
  708. ** Pop and return an object
  709. */
  710. Object *lua_pop (void)
  711. {
  712. if (top <= base) return NULL;
  713. top--;
  714. return top;
  715. }
  716. /*
  717. ** Push a nil object
  718. */
  719. int lua_pushnil (void)
  720. {
  721. if (lua_checkstack(top-stack+1) == 1)
  722. return 1;
  723. tag(top++) = T_NIL;
  724. return 0;
  725. }
  726. /*
  727. ** Push an object (tag=number) to stack. Return 0 on success or 1 on error.
  728. */
  729. int lua_pushnumber (real n)
  730. {
  731. if (lua_checkstack(top-stack+1) == 1)
  732. return 1;
  733. tag(top) = T_NUMBER; nvalue(top++) = n;
  734. return 0;
  735. }
  736. /*
  737. ** Push an object (tag=string) to stack. Return 0 on success or 1 on error.
  738. */
  739. int lua_pushstring (char *s)
  740. {
  741. if (lua_checkstack(top-stack+1) == 1)
  742. return 1;
  743. tag(top) = T_STRING;
  744. svalue(top++) = lua_createstring(s);
  745. return 0;
  746. }
  747. /*
  748. ** Push an object (tag=cfunction) to stack. Return 0 on success or 1 on error.
  749. */
  750. int lua_pushcfunction (lua_CFunction fn)
  751. {
  752. if (lua_checkstack(top-stack+1) == 1)
  753. return 1;
  754. tag(top) = T_CFUNCTION; fvalue(top++) = fn;
  755. return 0;
  756. }
  757. /*
  758. ** Push an object (tag=userdata) to stack. Return 0 on success or 1 on error.
  759. */
  760. int lua_pushuserdata (void *u)
  761. {
  762. if (lua_checkstack(top-stack+1) == 1)
  763. return 1;
  764. tag(top) = T_USERDATA; uvalue(top++) = u;
  765. return 0;
  766. }
  767. /*
  768. ** Push an object to stack.
  769. */
  770. int lua_pushobject (Object *o)
  771. {
  772. if (lua_checkstack(top-stack+1) == 1)
  773. return 1;
  774. *top++ = *o;
  775. return 0;
  776. }
  777. /*
  778. ** Store top of the stack at a global variable array field.
  779. ** Return 1 on error, 0 on success.
  780. */
  781. int lua_storeglobal (char *name)
  782. {
  783. int n = lua_findsymbol (name);
  784. if (n < 0) return 1;
  785. if (tag(top-1) == T_MARK) return 1;
  786. s_object(n) = *(--top);
  787. return 0;
  788. }
  789. /*
  790. ** Store top of the stack at an array field. Return 1 on error, 0 on success.
  791. */
  792. int lua_storefield (lua_Object object, char *field)
  793. {
  794. if (tag(object) != T_ARRAY)
  795. return 1;
  796. else
  797. {
  798. Object ref, *h;
  799. tag(&ref) = T_STRING;
  800. svalue(&ref) = lua_createstring(field);
  801. h = lua_hashdefine(avalue(object), &ref);
  802. if (h == NULL) return 1;
  803. if (tag(top-1) == T_MARK) return 1;
  804. *h = *(--top);
  805. }
  806. return 0;
  807. }
  808. /*
  809. ** Store top of the stack at an array index. Return 1 on error, 0 on success.
  810. */
  811. int lua_storeindexed (lua_Object object, float index)
  812. {
  813. if (tag(object) != T_ARRAY)
  814. return 1;
  815. else
  816. {
  817. Object ref, *h;
  818. tag(&ref) = T_NUMBER;
  819. nvalue(&ref) = index;
  820. h = lua_hashdefine(avalue(object), &ref);
  821. if (h == NULL) return 1;
  822. if (tag(top-1) == T_MARK) return 1;
  823. *h = *(--top);
  824. }
  825. return 0;
  826. }
  827. /*
  828. ** Given an object handle, return if it is nil.
  829. */
  830. int lua_isnil (Object *object)
  831. {
  832. return (object != NULL && tag(object) == T_NIL);
  833. }
  834. /*
  835. ** Given an object handle, return if it is a number one.
  836. */
  837. int lua_isnumber (Object *object)
  838. {
  839. return (object != NULL && tag(object) == T_NUMBER);
  840. }
  841. /*
  842. ** Given an object handle, return if it is a string one.
  843. */
  844. int lua_isstring (Object *object)
  845. {
  846. return (object != NULL && tag(object) == T_STRING);
  847. }
  848. /*
  849. ** Given an object handle, return if it is an array one.
  850. */
  851. int lua_istable (Object *object)
  852. {
  853. return (object != NULL && tag(object) == T_ARRAY);
  854. }
  855. /*
  856. ** Given an object handle, return if it is a cfunction one.
  857. */
  858. int lua_iscfunction (Object *object)
  859. {
  860. return (object != NULL && tag(object) == T_CFUNCTION);
  861. }
  862. /*
  863. ** Given an object handle, return if it is an user data one.
  864. */
  865. int lua_isuserdata (Object *object)
  866. {
  867. return (object != NULL && tag(object) == T_USERDATA);
  868. }
  869. /*
  870. ** Internal function: return an object type.
  871. */
  872. void lua_type (void)
  873. {
  874. Object *o = lua_getparam(1);
  875. if (lua_constant == NULL)
  876. lua_initconstant();
  877. lua_pushstring (lua_constant[tag(o)]);
  878. }
  879. /*
  880. ** Internal function: convert an object to a number
  881. */
  882. void lua_obj2number (void)
  883. {
  884. Object *o = lua_getparam(1);
  885. lua_pushobject (lua_convtonumber(o));
  886. }
  887. /*
  888. ** Internal function: print object values
  889. */
  890. void lua_print (void)
  891. {
  892. int i=1;
  893. Object *obj;
  894. while ((obj=lua_getparam (i++)) != NULL)
  895. {
  896. if (lua_isnumber(obj)) printf("%g\n",lua_getnumber (obj));
  897. else if (lua_isstring(obj)) printf("%s\n",lua_getstring (obj));
  898. else if (lua_iscfunction(obj)) printf("cfunction: %p\n",lua_getcfunction (obj));
  899. else if (lua_isuserdata(obj)) printf("userdata: %p\n",lua_getuserdata (obj));
  900. else if (lua_istable(obj)) printf("table: %p\n",obj);
  901. else if (lua_isnil(obj)) printf("nil\n");
  902. else printf("invalid value to print\n");
  903. }
  904. }
  905. /*
  906. ** Internal function: do a file
  907. */
  908. void lua_internaldofile (void)
  909. {
  910. lua_Object obj = lua_getparam (1);
  911. if (lua_isstring(obj) && !lua_dofile(lua_getstring(obj)))
  912. lua_pushnumber(1);
  913. else
  914. lua_pushnil();
  915. }
  916. /*
  917. ** Internal function: do a string
  918. */
  919. void lua_internaldostring (void)
  920. {
  921. lua_Object obj = lua_getparam (1);
  922. if (lua_isstring(obj) && !lua_dostring(lua_getstring(obj)))
  923. lua_pushnumber(1);
  924. else
  925. lua_pushnil();
  926. }