opcode.c 20 KB

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