opcode.c

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