lua/opcode.c

/*
** opcode.c
** TecCGraf - PUC-Rio
*/

char *rcs_opcode="$Id: opcode.c,v 2.4 1994/08/05 19:31:09 celes Exp celes $";

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#ifdef __GNUC__
#include <floatingpoint.h>
#endif

#include "mm.h"

#include "opcode.h"
#include "hash.h"
#include "inout.h"
#include "table.h"
#include "lua.h"

#define tonumber(o) ((tag(o) != T_NUMBER) && (lua_tonumber(o) != 0))
#define tostring(o) ((tag(o) != T_STRING) && (lua_tostring(o) != 0))


#define STACK_BUFFER (STACKGAP+128)

static Long    maxstack;
static Object *stack=NULL;
static Object *top, *base;


/*
** Init stack
*/
static int lua_initstack (void)
{
 maxstack = STACK_BUFFER;
 stack = (Object *)calloc(maxstack, sizeof(Object));
 if (stack == NULL)
 {
  lua_error("stack - not enough memory");
  return 1;
 }
 tag(stack) = T_MARK;
 top = base = stack+1;
 return 0;
}


/*
** Check stack overflow and, if necessary, realloc vector
*/
static int lua_checkstack (Word n)
{
 if (stack == NULL)
  return lua_initstack();
 if (n > maxstack)
 {
  Word t = top-stack;
  Word b = base-stack;
  maxstack *= 2;
  stack = (Object *)realloc(stack, maxstack*sizeof(Object));
  if (stack == NULL)
  {
   lua_error("stack - not enough memory");
   return 1;
  }
  top = stack + t;
  base = stack + b;
 }
 return 0;
}


/*
** Concatenate two given string, creating a mark space at the beginning.
** Return the new string pointer.
*/
static char *lua_strconc (char *l, char *r)
{
 static char buffer[1024];
 int n = strlen(l)+strlen(r)+1;
 if (n > 1024)
 {
  lua_error ("string too large");
  return NULL;
 }
 return strcat(strcpy(buffer,l),r);
}

/*
** Convert, if possible, to a number tag.
** Return 0 in success or not 0 on error.
*/ 
static int lua_tonumber (Object *obj)
{
 char *ptr;
 if (tag(obj) != T_STRING)
 {
  lua_reportbug ("unexpected type at conversion to number");
  return 1;
 }
 nvalue(obj) = strtod(svalue(obj), &ptr);
 if (*ptr)
 {
  lua_reportbug ("string to number convertion failed");
  return 2;
 }
 tag(obj) = T_NUMBER;
 return 0;
}

/*
** Test if is possible to convert an object to a number one.
** If possible, return the converted object, otherwise return nil object.
*/ 
static Object *lua_convtonumber (Object *obj)
{
 static Object cvt;
 
 if (tag(obj) == T_NUMBER)
 {
  cvt = *obj;
  return &cvt;
 }
  
 tag(&cvt) = T_NIL;
 if (tag(obj) == T_STRING)
 {
  char *ptr;
  nvalue(&cvt) = strtod(svalue(obj), &ptr);
  if (*ptr == 0)
   tag(&cvt) = T_NUMBER;
 }
 return &cvt;
}



/*
** Convert, if possible, to a string tag
** Return 0 in success or not 0 on error.
*/ 
static int lua_tostring (Object *obj)
{
 static char s[256];
 if (tag(obj) != T_NUMBER)
 {
  lua_reportbug ("unexpected type at conversion to string");
  return 1;
 }
 if ((int) nvalue(obj) == nvalue(obj))
  sprintf (s, "%d", (int) nvalue(obj));
 else
  sprintf (s, "%g", nvalue(obj));
 svalue(obj) = lua_createstring(s);
 if (svalue(obj) == NULL)
  return 1;
 tag(obj) = T_STRING;
 return 0;
}


/*
** Execute the given opcode. Return 0 in success or 1 on error.
*/
int lua_execute (Byte *pc)
{
 Word oldbase;

 if (stack == NULL)
  lua_initstack();

 oldbase = base-stack;
 base = top;
 while (1)
 {
  OpCode opcode;
  switch (opcode = (OpCode)*pc++)
  {
   case PUSHNIL: tag(top++) = T_NIL; break;
   
   case PUSH0: tag(top) = T_NUMBER; nvalue(top++) = 0; break;
   case PUSH1: tag(top) = T_NUMBER; nvalue(top++) = 1; break;
   case PUSH2: tag(top) = T_NUMBER; nvalue(top++) = 2; break;

   case PUSHBYTE: tag(top) = T_NUMBER; nvalue(top++) = *pc++; break;
   
   case PUSHWORD: 
   {
    CodeWord code;
    get_word(code,pc);
    tag(top) = T_NUMBER; nvalue(top++) = code.w;
   }
   break;
   
   case PUSHFLOAT:
   {
    CodeFloat code;
    get_float(code,pc);
    tag(top) = T_NUMBER; nvalue(top++) = code.f;
   }
   break;

   case PUSHSTRING:
   {
    CodeWord code;
    get_word(code,pc);
    tag(top) = T_STRING; svalue(top++) = lua_constant[code.w];
   }
   break;

   case PUSHFUNCTION:
   {
    CodeCode code;
    get_code(code,pc);
    tag(top) = T_FUNCTION; bvalue(top++) = code.b;
   }
   break;
   
   case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2:
   case PUSHLOCAL3: case PUSHLOCAL4: case PUSHLOCAL5:
   case PUSHLOCAL6: case PUSHLOCAL7: case PUSHLOCAL8:
   case PUSHLOCAL9: *top++ = *(base + (int)(opcode-PUSHLOCAL0)); break;
   
   case PUSHLOCAL: *top++ = *(base + (*pc++)); break;
   
   case PUSHGLOBAL: 
   {
    CodeWord code;
    get_word(code,pc);
    *top++ = s_object(code.w);
   }
   break;
   
   case PUSHINDEXED:
   {
    int s = lua_pushsubscript();
    if (s == 1) return 1;
   }
   break;
   
   case PUSHMARK: tag(top++) = T_MARK; break;
   
   case PUSHOBJECT: *top = *(top-3); top++; break;
   
   case STORELOCAL0: case STORELOCAL1: case STORELOCAL2:
   case STORELOCAL3: case STORELOCAL4: case STORELOCAL5:
   case STORELOCAL6: case STORELOCAL7: case STORELOCAL8:
   case STORELOCAL9: *(base + (int)(opcode-STORELOCAL0)) = *(--top); break;
    
   case STORELOCAL: *(base + (*pc++)) = *(--top); break;
   
   case STOREGLOBAL:
   {
    CodeWord code;
    get_word(code,pc);
    s_object(code.w) = *(--top);
   }
   break;

   case STOREINDEXED0:
   {
    int s = lua_storesubscript();
    if (s == 1) return 1;
   }
   break;
   
   case STOREINDEXED:
   {
    int n = *pc++;
    if (tag(top-3-n) != T_ARRAY)
    {
     lua_reportbug ("indexed expression not a table");
     return 1;
    }
    {
     Object *h = lua_hashdefine (avalue(top-3-n), top-2-n);
     if (h == NULL) return 1;
     *h = *(top-1);
    }
    top--;
   }
   break;
   
   case STORELIST0:
   case STORELIST:
   {
    int m, n;
    Object *arr;
    if (opcode == STORELIST0) m = 0;
    else m = *(pc++) * FIELDS_PER_FLUSH;
    n = *(pc++);
    arr = top-n-1;
    if (tag(arr) != T_ARRAY)
    {
     lua_reportbug ("internal error - table expected");
     return 1;
    }
    while (n)
    {
     tag(top) = T_NUMBER; nvalue(top) = n+m;
     *(lua_hashdefine (avalue(arr), top)) = *(top-1);
     top--;
     n--;
    }
   }
   break;
   
   case STORERECORD:
   {
    int n = *(pc++);
    Object *arr = top-n-1;
    if (tag(arr) != T_ARRAY)
    {
     lua_reportbug ("internal error - table expected");
     return 1;
    }
    while (n)
    {
     CodeWord code;
     get_word(code,pc);
     tag(top) = T_STRING; svalue(top) = lua_constant[code.w];
     *(lua_hashdefine (avalue(arr), top)) = *(top-1);
     top--;
     n--;
    }
   }
   break;
   
   case ADJUST:
   {
    Object *newtop = base + *(pc++);
    while (top < newtop) tag(top++) = T_NIL;
    top = newtop;  /* top could be bigger than newtop */
   }
   break;
   
   case CREATEARRAY:
    if (tag(top-1) == T_NIL) 
     nvalue(top-1) = 101;
    else 
    {
     if (tonumber(top-1)) return 1;
     if (nvalue(top-1) <= 0) nvalue(top-1) = 101;
    }
    avalue(top-1) = lua_createarray(nvalue(top-1));
    if (avalue(top-1) == NULL)
     return 1;
    tag(top-1) = T_ARRAY;
   break;
   
   case EQOP:
   {
    Object *l = top-2;
    Object *r = top-1;
    --top;
    if (tag(l) != tag(r)) 
     tag(top-1) = T_NIL;
    else
    {
     switch (tag(l))
     {
      case T_NIL:       tag(top-1) = T_NUMBER; break;
      case T_NUMBER:    tag(top-1) = (nvalue(l) == nvalue(r)) ? T_NUMBER : T_NIL; break;
      case T_ARRAY:     tag(top-1) = (avalue(l) == avalue(r)) ? T_NUMBER : T_NIL; break;
      case T_FUNCTION:  tag(top-1) = (bvalue(l) == bvalue(r)) ? T_NUMBER : T_NIL; break;
      case T_CFUNCTION: tag(top-1) = (fvalue(l) == fvalue(r)) ? T_NUMBER : T_NIL; break;
      case T_USERDATA:  tag(top-1) = (uvalue(l) == uvalue(r)) ? T_NUMBER : T_NIL; break;
      case T_STRING:    tag(top-1) = (strcmp (svalue(l), svalue(r)) == 0) ? T_NUMBER : T_NIL; break;
      case T_MARK:      return 1;
     }
    }
    nvalue(top-1) = 1;
   }
   break;
    
   case LTOP:
   {
    Object *l = top-2;
    Object *r = top-1;
    --top;
    if (tag(l) == T_NUMBER && tag(r) == T_NUMBER)
     tag(top-1) = (nvalue(l) < nvalue(r)) ? T_NUMBER : T_NIL;
    else
    {
     if (tostring(l) || tostring(r))
      return 1;
     tag(top-1) = (strcmp (svalue(l), svalue(r)) < 0) ? T_NUMBER : T_NIL;
    }
    nvalue(top-1) = 1; 
   }
   break;
   
   case LEOP:
   {
    Object *l = top-2;
    Object *r = top-1;
    --top;
    if (tag(l) == T_NUMBER && tag(r) == T_NUMBER)
     tag(top-1) = (nvalue(l) <= nvalue(r)) ? T_NUMBER : T_NIL;
    else
    {
     if (tostring(l) || tostring(r))
      return 1;
     tag(top-1) = (strcmp (svalue(l), svalue(r)) <= 0) ? T_NUMBER : T_NIL;
    }
    nvalue(top-1) = 1; 
   }
   break;
   
   case ADDOP:
   {
    Object *l = top-2;
    Object *r = top-1;
    if (tonumber(r) || tonumber(l))
     return 1;
    nvalue(l) += nvalue(r);
    --top;
   }
   break; 
   
   case SUBOP:
   {
    Object *l = top-2;
    Object *r = top-1;
    if (tonumber(r) || tonumber(l))
     return 1;
    nvalue(l) -= nvalue(r);
    --top;
   }
   break; 
   
   case MULTOP:
   {
    Object *l = top-2;
    Object *r = top-1;
    if (tonumber(r) || tonumber(l))
     return 1;
    nvalue(l) *= nvalue(r);
    --top;
   }
   break; 
   
   case DIVOP:
   {
    Object *l = top-2;
    Object *r = top-1;
    if (tonumber(r) || tonumber(l))
     return 1;
    nvalue(l) /= nvalue(r);
    --top;
   }
   break; 
   
   case CONCOP:
   {
    Object *l = top-2;
    Object *r = top-1;
    if (tostring(r) || tostring(l))
     return 1;
    svalue(l) = lua_createstring (lua_strconc(svalue(l),svalue(r)));
    if (svalue(l) == NULL)
     return 1;
    --top;
   }
   break; 
   
   case MINUSOP:
    if (tonumber(top-1))
     return 1;
    nvalue(top-1) = - nvalue(top-1);
   break; 
   
   case NOTOP:
    tag(top-1) = tag(top-1) == T_NIL ? T_NUMBER : T_NIL;
   break; 
   
   case ONTJMP:
   {
    CodeWord code;
    get_word(code,pc);
    if (tag(top-1) != T_NIL) pc += code.w;
   }
   break;
   
   case ONFJMP:	   
   {
    CodeWord code;
    get_word(code,pc);
    if (tag(top-1) == T_NIL) pc += code.w;
   }
   break;
   
   case JMP:
   {
    CodeWord code;
    get_word(code,pc);
    pc += code.w;
   }
   break;
    
   case UPJMP:
   {
    CodeWord code;
    get_word(code,pc);
    pc -= code.w;
   }
   break;
   
   case IFFJMP:
   {
    CodeWord code;
    get_word(code,pc);
    top--;
    if (tag(top) == T_NIL) pc += code.w;
   }
   break;

   case IFFUPJMP:
   {
    CodeWord code;
    get_word(code,pc);
    top--;
    if (tag(top) == T_NIL) pc -= code.w;
   }
   break;

   case POP: --top; break;
   
   case CALLFUNC:
   {
    Byte *newpc;
    Object *b = top-1;
    while (tag(b) != T_MARK) b--;
    if (tag(b-1) == T_FUNCTION)
    {
     lua_debugline = 0;			/* always reset debug flag */
     newpc = bvalue(b-1);
     bvalue(b-1) = pc;		        /* store return code */
     nvalue(b) = (base-stack);		/* store base value */
     base = b+1;
     pc = newpc;
     if (lua_checkstack(STACKGAP+(base-stack)))
      return 1;
    }
    else if (tag(b-1) == T_CFUNCTION)
    {
     int nparam; 
     lua_debugline = 0;			/* always reset debug flag */
     nvalue(b) = (base-stack);		/* store base value */
     base = b+1;
     nparam = top-base;			/* number of parameters */
     (fvalue(b-1))();			/* call C function */
     
     /* shift returned values */
     { 
      int i;
      int nretval = top - base - nparam;
      top = base - 2;
      base = stack + (int) nvalue(base-1);
      for (i=0; i<nretval; i++)
      {
       *top = *(top+nparam+2);
       ++top;
      }
     }
    }
    else
    {
     lua_reportbug ("call expression not a function");
     return 1;
    }
   }
   break;
   
   case RETCODE:
   {
    int i;
    int shift = *pc++;
    int nretval = top - base - shift;
    top = base - 2;
    pc = bvalue(base-2);
    base = stack + (int) nvalue(base-1);
    for (i=0; i<nretval; i++)
    {
     *top = *(top+shift+2);
     ++top;
    }
   }
   break;
   
   case HALT:
    base = stack+oldbase;
   return 0;		/* success */
   
   case SETFUNCTION:
   {
    CodeWord file, func;
    get_word(file,pc);
    get_word(func,pc);
    if (lua_pushfunction (file.w, func.w))
     return 1;
   }
   break;
   
   case SETLINE:
   {
    CodeWord code;
    get_word(code,pc);
    lua_debugline = code.w;
   }
   break;
   
   case RESET:
    lua_popfunction ();
   break;
   
   default:
    lua_error ("internal error - opcode didn't match");
   return 1;
  }
 }
}


/*
** Function to indexed the values on the top
*/
int lua_pushsubscript (void)
{
 --top;
 if (tag(top-1) != T_ARRAY)
 {
  lua_reportbug ("indexed expression not a table");
  return 1;
 }
 {
  Object *h = lua_hashget (avalue(top-1), top);
  if (h == NULL) return 1;
  *(top-1) = *h;
 }
 return 0;
}


/*
** Function to store indexed based on values at the top
*/
int lua_storesubscript (void)
{
 if (tag(top-3) != T_ARRAY)
 {
  lua_reportbug ("indexed expression not a table");
  return 1;
 }
 {
  Object *h = lua_hashdefine (avalue(top-3), top-2);
  if (h == NULL) return 1;
  *h = *(top-1);
 }
 top -= 3;
 return 0;
}


/*
** Traverse all objects on stack
*/
void lua_travstack (void (*fn)(Object *))
{
 Object *o;
 for (o = top-1; o >= stack; o--)
  fn (o);
}

/*
** Open file, generate opcode and execute global statement. Return 0 on
** success or 1 on error.
*/
int lua_dofile (char *filename)
{
 if (lua_openfile (filename)) return 1;
 if (lua_parse ()) { lua_closefile (); return 1; }
 lua_closefile ();
 return 0;
}

/*
** Generate opcode stored on string and execute global statement. Return 0 on
** success or 1 on error.
*/
int lua_dostring (char *string)
{
 if (lua_openstring (string)) return 1;
 if (lua_parse ()) return 1;
 lua_closestring();
 return 0;
}

/*
** Execute the given function. Return 0 on success or 1 on error.
*/
int lua_call (char *functionname, int nparam)
{
 static Byte startcode[] = {CALLFUNC, HALT};
 int i; 
 Object func = s_object(lua_findsymbol(functionname));
 if (tag(&func) != T_FUNCTION) return 1;
 for (i=1; i<=nparam; i++)
  *(top-i+2) = *(top-i);
 top += 2;
 tag(top-nparam-1) = T_MARK;
 *(top-nparam-2) = func;
 return (lua_execute (startcode));
}

/*
** Execute the given lua function. Return 0 on success or 1 on error.
*/
int lua_callfunction (Object *function, int nparam)
{
 static Byte startcode[] = {CALLFUNC, HALT};
 int i; 
 if (tag(function) != T_FUNCTION) return 1;
 for (i=1; i<=nparam; i++)
  *(top-i+2) = *(top-i);
 top += 2;
 tag(top-nparam-1) = T_MARK;
 *(top-nparam-2) = *function;
 return (lua_execute (startcode));
}

/*
** Get a parameter, returning the object handle or NULL on error.
** 'number' must be 1 to get the first parameter.
*/
Object *lua_getparam (int number)
{
 if (number <= 0 || number > top-base) return NULL;
 return (base+number-1);
}

/*
** Given an object handle, return its number value. On error, return 0.0.
*/
real lua_getnumber (Object *object)
{
 if (object == NULL || tag(object) == T_NIL) return 0.0;
 if (tonumber (object)) return 0.0;
 else                   return (nvalue(object));
}

/*
** Given an object handle, return its string pointer. On error, return NULL.
*/
char *lua_getstring (Object *object)
{
 if (object == NULL || tag(object) == T_NIL) return NULL;
 if (tostring (object)) return NULL;
 else                   return (svalue(object));
}

/*
** Given an object handle, return a copy of its string. On error, return NULL.
*/
char *lua_copystring (Object *object)
{
 if (object == NULL || tag(object) == T_NIL) return NULL;
 if (tostring (object)) return NULL;
 else                   return (strdup(svalue(object)));
}

/*
** Given an object handle, return its cfuntion pointer. On error, return NULL.
*/
lua_CFunction lua_getcfunction (Object *object)
{
 if (object == NULL) return NULL;
 if (tag(object) != T_CFUNCTION) return NULL;
 else                            return (fvalue(object));
}

/*
** Given an object handle, return its user data. On error, return NULL.
*/
void *lua_getuserdata (Object *object)
{
 if (object == NULL) return NULL;
 if (tag(object) != T_USERDATA) return NULL;
 else                           return (uvalue(object));
}

/*
** Given an object handle, return its table. On error, return NULL.
*/
void *lua_gettable (Object *object)
{
 if (object == NULL) return NULL;
 if (tag(object) != T_ARRAY) return NULL;
 else                        return (avalue(object));
}

/*
** Given an object handle and a field name, return its field object.
** On error, return NULL.
*/
Object *lua_getfield (Object *object, char *field)
{
 if (object == NULL) return NULL;
 if (tag(object) != T_ARRAY)
  return NULL;
 else
 {
  Object ref;
  tag(&ref) = T_STRING;
  svalue(&ref) = lua_createstring(field);
  return (lua_hashget(avalue(object), &ref));
 }
}

/*
** Given an object handle and an index, return its indexed object.
** On error, return NULL.
*/
Object *lua_getindexed (Object *object, float index)
{
 if (object == NULL) return NULL;
 if (tag(object) != T_ARRAY)
  return NULL;
 else
 {
  Object ref;
  tag(&ref) = T_NUMBER;
  nvalue(&ref) = index;
  return (lua_hashget(avalue(object), &ref));
 }
}

/*
** Get a global object. Return the object handle or NULL on error.
*/
Object *lua_getglobal (char *name)
{
 int n = lua_findsymbol(name);
 if (n < 0) return NULL;
 return &s_object(n);
}

/*
** Pop and return an object
*/
Object *lua_pop (void)
{
 if (top <= base) return NULL;
 top--;
 return top;
}

/*
** Push a nil object
*/
int lua_pushnil (void)
{
 if (lua_checkstack(top-stack+1) == 1)
  return 1;
 tag(top++) = T_NIL;
 return 0;
}

/*
** Push an object (tag=number) to stack. Return 0 on success or 1 on error.
*/
int lua_pushnumber (real n)
{
 if (lua_checkstack(top-stack+1) == 1)
  return 1;
 tag(top) = T_NUMBER; nvalue(top++) = n;
 return 0;
}

/*
** Push an object (tag=string) to stack. Return 0 on success or 1 on error.
*/
int lua_pushstring (char *s)
{
 if (lua_checkstack(top-stack+1) == 1)
  return 1;
 tag(top) = T_STRING; 
 svalue(top++) = lua_createstring(s);
 return 0;
}

/*
** Push an object (tag=cfunction) to stack. Return 0 on success or 1 on error.
*/
int lua_pushcfunction (lua_CFunction fn)
{
 if (lua_checkstack(top-stack+1) == 1)
  return 1;
 tag(top) = T_CFUNCTION; fvalue(top++) = fn;
 return 0;
}

/*
** Push an object (tag=userdata) to stack. Return 0 on success or 1 on error.
*/
int lua_pushuserdata (void *u)
{
 if (lua_checkstack(top-stack+1) == 1)
  return 1;
 tag(top) = T_USERDATA; uvalue(top++) = u;
 return 0;
}

/*
** Push an object (tag=userdata) to stack. Return 0 on success or 1 on error.
*/
int lua_pushtable (void *t)
{
 if (lua_checkstack(top-stack+1) == 1)
  return 1;
 tag(top) = T_ARRAY; avalue(top++) = t;
 return 0;
}

/*
** Push an object to stack.
*/
int lua_pushobject (Object *o)
{
 if (lua_checkstack(top-stack+1) == 1)
  return 1;
 *top++ = *o;
 return 0;
}

/*
** Store top of the stack at a global variable array field. 
** Return 1 on error, 0 on success.
*/
int lua_storeglobal (char *name)
{
 int n = lua_findsymbol (name);
 if (n < 0) return 1;
 if (tag(top-1) == T_MARK) return 1;
 s_object(n) = *(--top);
 return 0;
}


/*
** Store top of the stack at an array field. Return 1 on error, 0 on success.
*/
int lua_storefield (lua_Object object, char *field)
{
 if (tag(object) != T_ARRAY)
  return 1;
 else
 {
  Object ref, *h;
  tag(&ref) = T_STRING;
  svalue(&ref) = lua_createstring(field);
  h = lua_hashdefine(avalue(object), &ref);
  if (h == NULL) return 1;
  if (tag(top-1) == T_MARK) return 1;
  *h = *(--top);
 }
 return 0;
}


/*
** Store top of the stack at an array index. Return 1 on error, 0 on success.
*/
int lua_storeindexed (lua_Object object, float index)
{
 if (tag(object) != T_ARRAY)
  return 1;
 else
 {
  Object ref, *h;
  tag(&ref) = T_NUMBER;
  nvalue(&ref) = index;
  h = lua_hashdefine(avalue(object), &ref);
  if (h == NULL) return 1;
  if (tag(top-1) == T_MARK) return 1;
  *h = *(--top);
 }
 return 0;
}


/*
** Given an object handle, return if it is nil.
*/
int lua_isnil (Object *object)
{
 return (object != NULL && tag(object) == T_NIL);
}

/*
** Given an object handle, return if it is a number one.
*/
int lua_isnumber (Object *object)
{
 return (object != NULL && tag(object) == T_NUMBER);
}

/*
** Given an object handle, return if it is a string one.
*/
int lua_isstring (Object *object)
{
 return (object != NULL && tag(object) == T_STRING);
}

/*
** Given an object handle, return if it is an array one.
*/
int lua_istable (Object *object)
{
 return (object != NULL && tag(object) == T_ARRAY);
}

/*
** Given an object handle, return if it is a lua function.
*/
int lua_isfunction (Object *object)
{
 return (object != NULL && tag(object) == T_FUNCTION);
}
 
/*
** Given an object handle, return if it is a cfunction one.
*/
int lua_iscfunction (Object *object)
{
 return (object != NULL && tag(object) == T_CFUNCTION);
}

/*
** Given an object handle, return if it is an user data one.
*/
int lua_isuserdata (Object *object)
{
 return (object != NULL && tag(object) == T_USERDATA);
}

/*
** Internal function: return an object type. 
*/
void lua_type (void)
{
 Object *o = lua_getparam(1);

 if (lua_constant == NULL)
  lua_initconstant();
 lua_pushstring (lua_constant[tag(o)]);
}

/*
** Internal function: convert an object to a number
*/
void lua_obj2number (void)
{
 Object *o = lua_getparam(1);
 lua_pushobject (lua_convtonumber(o));
}

/*
** Internal function: print object values
*/
void lua_print (void)
{
 int i=1;
 Object *obj;
 while ((obj=lua_getparam (i++)) != NULL)
 {
  if      (lua_isnumber(obj))    printf("%g\n",lua_getnumber (obj));
  else if (lua_isstring(obj))    printf("%s\n",lua_getstring (obj));
  else if (lua_isfunction(obj))  printf("function: %p\n",bvalue(obj));
  else if (lua_iscfunction(obj)) printf("cfunction: %p\n",lua_getcfunction (obj));
  else if (lua_isuserdata(obj))  printf("userdata: %p\n",lua_getuserdata (obj));
  else if (lua_istable(obj))     printf("table: %p\n",obj);
  else if (lua_isnil(obj))       printf("nil\n");
  else			         printf("invalid value to print\n");
 }
}

/*
** Internal function: do a file
*/
void lua_internaldofile (void)
{
 lua_Object obj = lua_getparam (1);
 if (lua_isstring(obj) && !lua_dofile(lua_getstring(obj)))
  lua_pushnumber(1);
 else
  lua_pushnil();
}

/*
** Internal function: do a string
*/
void lua_internaldostring (void)
{
 lua_Object obj = lua_getparam (1);
 if (lua_isstring(obj) && !lua_dostring(lua_getstring(obj)))
  lua_pushnumber(1);
 else
  lua_pushnil();
}