first version of vararg facility (plus new function "call").

7 files changed, 217 insertions, 115 deletions

diff --git a/inout.c b/inout.c
index 294d4137..9850974e 100644
--- a/inout.c
+++ b/inout.c
@@ -5,7 +5,7 @@
 ** Also provides some predefined lua functions.
 */
 
-char *rcs_inout="$Id: inout.c,v 2.35 1996/03/19 16:50:24 roberto Exp roberto $";
+char *rcs_inout="$Id: inout.c,v 2.36 1996/03/19 22:28:37 roberto Exp roberto $";
 
 #include <stdio.h>
 
@@ -93,6 +93,17 @@ void lua_closestring (void)
 {
 }
 
+
+static void check_arg (int cond, char *func)
+{
+  if (!cond)
+  {
+    char buff[100];
+    sprintf(buff, "incorrect argument to function `%s'", func);
+    lua_error(buff);
+  }
+}
+
  
 /*
 ** Internal function: do a string
@@ -230,8 +241,7 @@ void luaI_setglobal (void)
 {
   lua_Object name = lua_getparam(1);
   lua_Object value = lua_getparam(2);
-  if (!lua_isstring(name))
-    lua_error("incorrect argument to function `setglobal'");
+  check_arg(lua_isstring(name), "setglobal");
   lua_pushobject(value);
   lua_storeglobal(lua_getstring(name));
   lua_pushobject(value);  /* return given value */
@@ -240,7 +250,50 @@ void luaI_setglobal (void)
 void luaI_getglobal (void)
 {
   lua_Object name = lua_getparam(1);
-  if (!lua_isstring(name))
-    lua_error("incorrect argument to function `getglobal'");
+  check_arg(lua_isstring(name), "getglobal");
   lua_pushobject(lua_getglobal(lua_getstring(name)));
 }
+
+#define MAXPARAMS       256
+void luaI_call (void)
+{
+  lua_Object f = lua_getparam(1);
+  lua_Object arg = lua_getparam(2);
+  lua_Object temp, params[MAXPARAMS];
+  int narg, i;
+  check_arg(lua_istable(arg), "call");
+  check_arg(lua_isfunction(f), "call");
+  /* narg = arg.n */
+  lua_pushobject(arg);
+  lua_pushstring("n");
+  temp = lua_getsubscript();
+  narg = lua_isnumber(temp) ? lua_getnumber(temp) : MAXPARAMS+1;
+  /* read arg[1...n] */
+  for (i=0; i<narg; i++)
+  {
+    if (i>=MAXPARAMS)
+      lua_error("argument list too long in function `call'");
+    lua_pushobject(arg);
+    lua_pushnumber(i+1);
+    params[i] = lua_getsubscript();
+    if (narg == MAXPARAMS+1 && lua_isnil(params[i]))
+    {
+      narg = i;
+      break;
+    }
+  }
+  /* push parameters and do the call */
+  for (i=0; i<narg; i++)
+    lua_pushobject(params[i]);
+  if (lua_callfunction(f))
+  { /* error */
+    lua_error(NULL);
+  }
+  else
+  { /* push results */
+    Object r;
+    arg = lua_getresult(1);
+    luaI_packarg((arg == LUA_NOOBJECT)?NULL:luaI_Address(arg), &r);
+    luaI_pushobject(&r);
+  }
+}
diff --git a/inout.h b/inout.h
index 24281d6b..ee359089 100644
--- a/inout.h
+++ b/inout.h
@@ -1,5 +1,5 @@
 /*
-** $Id: inout.h,v 1.14 1996/03/15 13:13:13 roberto Exp roberto $
+** $Id: inout.h,v 1.15 1996/03/15 18:21:58 roberto Exp roberto $
 */
 
 
@@ -29,5 +29,6 @@ void	luaI_error     (void);
 void    luaI_assert    (void);
 void    luaI_setglobal (void);
 void    luaI_getglobal (void);
+void    luaI_call       (void);
 
 #endif
diff --git a/lex.c b/lex.c
index 27049be0..7c496f9a 100644
--- a/lex.c
+++ b/lex.c
@@ -1,4 +1,4 @@
-char *rcs_lex = "$Id: lex.c,v 2.31 1996/03/19 16:50:24 roberto Exp roberto $";
+char *rcs_lex = "$Id: lex.c,v 2.32 1996/03/21 16:33:47 roberto Exp roberto $";
  
 
 #include <ctype.h>
@@ -280,7 +280,13 @@ int luaY_lex (void)
         if (current == '.')
         {
           save_and_next();
-          return CONC;
+          if (current == '.')
+          {
+            save_and_next();
+            return DOTS;   /* ... */
+          }
+          else
+            return CONC;   /* .. */
         }
         else if (!isdigit(current)) return '.';
         /* current is a digit: goes through to number */
diff --git a/lua.stx b/lua.stx
index 5df83550..5982a5a7 100644
--- a/lua.stx
+++ b/lua.stx
@@ -1,9 +1,10 @@
 %{
 
-char *rcs_luastx = "$Id: lua.stx,v 3.35 1996/03/08 12:02:37 roberto Exp roberto $";
+char *rcs_luastx = "$Id: lua.stx,v 3.36 1996/03/21 16:31:32 roberto Exp roberto $";
 
 #include <stdio.h>
 #include <stdlib.h>
+#include <string.h>
 
 #include "luadebug.h"
 #include "mem.h"
@@ -67,49 +68,45 @@ static void yyerror (char *s)
  lua_error (msg);
 }
 
+static void check_space (int i)
+{
+  if (pc+i>maxcurr-1)  /* 1 byte free to code HALT of main code */
+    maxcurr = growvector(&basepc, maxcurr, Byte, codeEM, MAX_INT);
+}
+
 static void code_byte (Byte c)
 {
- if (pc>maxcurr-2)  /* 1 byte free to code HALT of main code */
-   maxcurr = growvector(&basepc, maxcurr, Byte, codeEM, MAX_INT);
+ check_space(1);
  basepc[pc++] = c;
 }
 
 static void code_word (Word n)
 {
- CodeWord code;
- code.w = n;
- code_byte(code.m.c1);
- code_byte(code.m.c2);
+  check_space(sizeof(Word));
+  memcpy(basepc+pc, &n, sizeof(Word));
+  pc += sizeof(Word);
 }
 
-static void code_float (float n)
+static void code_float (real n)
 {
- CodeFloat code;
- code.f = n;
- code_byte(code.m.c1);
- code_byte(code.m.c2);
- code_byte(code.m.c3);
- code_byte(code.m.c4);
+  check_space(sizeof(real));
+  memcpy(basepc+pc, &n, sizeof(real));
+  pc += sizeof(real);
 }
 
 static void code_code (TFunc *tf)
 {
- CodeCode code;
- code.tf = tf;
- code_byte(code.m.c1);
- code_byte(code.m.c2);
- code_byte(code.m.c3);
- code_byte(code.m.c4);
+  check_space(sizeof(TFunc *));
+  memcpy(basepc+pc, &tf, sizeof(TFunc *));
+  pc += sizeof(TFunc *);
 }
 
 static void code_word_at (Byte *p, int n)
 {
- CodeWord code;
- if ((Word)n != n)
-   yyerror("block too big");
- code.w = (Word)n;
- *p++ = code.m.c1;
- *p++ = code.m.c2;
+  Word w = n;
+  if (w != n)
+    yyerror("block too big");
+  memcpy(p, &w, sizeof(Word));
 }
 
 static void push_field (Word name)
@@ -322,6 +319,19 @@ static void adjust_mult_assign (int vars, Long exps, int temps)
     lua_codeadjust(temps);
 }
 
+static int close_parlist (int dots)
+{
+  if (!dots)
+    lua_codeadjust(0);
+  else
+  {
+    code_byte(VARARGS);
+    code_byte(nlocalvar);
+    add_localvar(luaI_createfixedstring("arg"));
+  }
+  return lua_linenumber;
+}
+
 static void storesinglevar (Long v)
 {
  if (v > 0)             /* global var */
@@ -426,6 +436,7 @@ void lua_parse (TFunc *tf)
 %token RETURN
 %token LOCAL
 %token FUNCTION
+%token DOTS
 %token <vFloat> NUMBER
 %token <vWord>  STRING
 %token <pTStr>  NAME 
@@ -440,7 +451,7 @@ void lua_parse (TFunc *tf)
 %type <vInt>  fieldlist, localdeclist, decinit
 %type <vInt>  ffieldlist, ffieldlist1, semicolonpart
 %type <vInt>  lfieldlist, lfieldlist1
-%type <vInt>  parlist
+%type <vInt>  parlist, parlist1, par
 %type <vLong> var, singlevar, funcname
 %type <pFunc> body
 
@@ -674,13 +685,21 @@ exprlist1 :  expr	{ if ($1 != 0) $$ = $1; else $$ = -1; }
         }
           ;
 
-parlist  :      /* empty */ { lua_codeadjust(0); $$ = lua_linenumber; }
-          |     parlist1    { lua_codeadjust(0); $$ = lua_linenumber; }
+parlist  :      /* empty */ { $$ = close_parlist(0); }
+          |     parlist1    { $$ = close_parlist($1); }
           ;
                 
-parlist1 :      NAME              { add_localvar($1); }
-          |     parlist1 ',' NAME { add_localvar($3); }
+parlist1 :      par               { $$ = $1; }
+          |     parlist1 ',' par
+        {
+          if ($1)
+            lua_error("invalid parameter list");
+          $$ = $3;
+        }
           ;
+
+par : NAME      { add_localvar($1); $$ = 0; }
+    | DOTS      { $$ = 1; }
                 
 fieldlist  : lfieldlist
              { flush_list($1/FIELDS_PER_FLUSH, $1%FIELDS_PER_FLUSH); }
diff --git a/opcode.c b/opcode.c
index 13d476f4..237be758 100644
--- a/opcode.c
+++ b/opcode.c
@@ -3,7 +3,7 @@
 ** TecCGraf - PUC-Rio
 */
 
-char *rcs_opcode="$Id: opcode.c,v 3.67 1996/04/22 18:00:37 roberto Exp roberto $";
+char *rcs_opcode="$Id: opcode.c,v 3.68 1996/04/25 14:10:00 roberto Exp roberto $";
 
 #include <setjmp.h>
 #include <stdio.h>
@@ -117,7 +117,7 @@ static void growstack (void)
 */
 static char *lua_strconc (char *l, char *r)
 {
-  int nl = strlen(l);
+  size_t nl = strlen(l);
   char *buffer = luaI_buffer(nl+strlen(r)+1);
   strcpy(buffer, l);
   strcpy(buffer+nl, r);
@@ -886,6 +886,40 @@ static void comparison (lua_Type tag_less, lua_Type tag_equal,
 }
 
 
+void luaI_packarg (Object *firstelem, Object *arg)
+{
+  int nvararg = (firstelem != NULL) ? top-firstelem : 0;
+  int i;
+  if (nvararg < 0) nvararg = 0;
+  avalue(arg)  = lua_createarray(nvararg+1);  /* +1 for field 'n' */
+  tag(arg) = LUA_T_ARRAY;
+  for (i=0; i<nvararg; i++)
+  {
+    Object index;
+    tag(&index) = LUA_T_NUMBER;
+    nvalue(&index) = i+1;
+    *(lua_hashdefine(avalue(arg), &index)) = *(firstelem+i);
+  }
+  /* store counter in field "n" */
+  {
+    Object index, extra;
+    tag(&index) = LUA_T_STRING;
+    tsvalue(&index) = lua_createstring("n");
+    tag(&extra) = LUA_T_NUMBER;
+    nvalue(&extra) = nvararg;
+    *(lua_hashdefine(avalue(arg), &index)) = extra;
+  }
+}
+
+
+static void adjust_varargs (StkId first_extra_arg)
+{
+  Object arg;
+  luaI_packarg(stack+first_extra_arg, &arg);
+  adjust_top(first_extra_arg);
+  *top = arg; incr_top;
+}
+
 
 /*
 ** Execute the given opcode, until a RET. Parameters are between
@@ -914,38 +948,38 @@ static StkId lua_execute (Byte *pc, StkId base)
 
    case PUSHWORD:
    {
-    CodeWord code;
-    get_word(code,pc);
-    tag(top) = LUA_T_NUMBER; nvalue(top) = code.w;
+    Word w;
+    get_word(w,pc);
+    tag(top) = LUA_T_NUMBER; nvalue(top) = w;
     incr_top;
    }
    break;
 
    case PUSHFLOAT:
    {
-    CodeFloat code;
-    get_float(code,pc);
-    tag(top) = LUA_T_NUMBER; nvalue(top) = code.f;
+    real num;
+    get_float(num,pc);
+    tag(top) = LUA_T_NUMBER; nvalue(top) = num;
     incr_top;
    }
    break;
 
    case PUSHSTRING:
    {
-    CodeWord code;
-    get_word(code,pc);
-    tag(top) = LUA_T_STRING; tsvalue(top) = lua_constant[code.w];
+    Word w;
+    get_word(w,pc);
+    tag(top) = LUA_T_STRING; tsvalue(top) = lua_constant[w];
     incr_top;
    }
    break;
 
    case PUSHFUNCTION:
    {
-    CodeCode code;
-    get_code(code,pc);
-    luaI_insertfunction(code.tf);  /* may take part in GC */
+    TFunc *f;
+    get_code(f,pc);
+    luaI_insertfunction(f);  /* may take part in GC */
     top->tag = LUA_T_FUNCTION;
-    top->value.tf = code.tf;
+    top->value.tf = f;
     incr_top;
    }
    break;
@@ -960,9 +994,9 @@ static StkId lua_execute (Byte *pc, StkId base)
 
    case PUSHGLOBAL:
    {
-    CodeWord code;
-    get_word(code,pc);
-    getglobal(code.w);
+    Word w;
+    get_word(w,pc);
+    getglobal(w);
    }
    break;
 
@@ -973,9 +1007,9 @@ static StkId lua_execute (Byte *pc, StkId base)
    case PUSHSELF:
    {
      Object receiver = *(top-1);
-     CodeWord code;
-     get_word(code,pc);
-     tag(top) = LUA_T_STRING; tsvalue(top) = lua_constant[code.w];
+     Word w;
+     get_word(w,pc);
+     tag(top) = LUA_T_STRING; tsvalue(top) = lua_constant[w];
      incr_top;
      pushsubscript();
      *top = receiver;
@@ -994,9 +1028,9 @@ static StkId lua_execute (Byte *pc, StkId base)
 
    case STOREGLOBAL:
    {
-    CodeWord code;
-    get_word(code,pc);
-    s_object(code.w) = *(--top);
+    Word w;
+    get_word(w,pc);
+    s_object(w) = *(--top);
    }
    break;
 
@@ -1050,9 +1084,9 @@ static StkId lua_execute (Byte *pc, StkId base)
     Object *arr = top-n-1;
     while (n)
     {
-     CodeWord code;
-     get_word(code,pc);
-     tag(top) = LUA_T_STRING; tsvalue(top) = lua_constant[code.w];
+     Word w;
+     get_word(w,pc);
+     tag(top) = LUA_T_STRING; tsvalue(top) = lua_constant[w];
      *(lua_hashdefine (avalue(arr), top)) = *(top-1);
      top--;
      n--;
@@ -1068,11 +1102,15 @@ static StkId lua_execute (Byte *pc, StkId base)
      adjust_top(base + *(pc++));
      break;
 
+   case VARARGS:
+     adjust_varargs(base + *(pc++));
+     break;
+
    case CREATEARRAY:
    {
-    CodeWord size;
+    Word size;
     get_word(size,pc);
-    avalue(top) = lua_createarray(size.w);
+    avalue(top) = lua_createarray(size);
     tag(top) = LUA_T_ARRAY;
     incr_top;
    }
@@ -1195,51 +1233,51 @@ static StkId lua_execute (Byte *pc, StkId base)
 
    case ONTJMP:
    {
-    CodeWord code;
-    get_word(code,pc);
-    if (tag(top-1) != LUA_T_NIL) pc += code.w;
+    Word w;
+    get_word(w,pc);
+    if (tag(top-1) != LUA_T_NIL) pc += w;
    }
    break;
 
    case ONFJMP: 
    {
-    CodeWord code;
-    get_word(code,pc);
-    if (tag(top-1) == LUA_T_NIL) pc += code.w;
+    Word w;
+    get_word(w,pc);
+    if (tag(top-1) == LUA_T_NIL) pc += w;
    }
    break;
 
    case JMP:
    {
-    CodeWord code;
-    get_word(code,pc);
-    pc += code.w;
+    Word w;
+    get_word(w,pc);
+    pc += w;
    }
    break;
 
    case UPJMP:
    {
-    CodeWord code;
-    get_word(code,pc);
-    pc -= code.w;
+    Word w;
+    get_word(w,pc);
+    pc -= w;
    }
    break;
 
    case IFFJMP:
    {
-    CodeWord code;
-    get_word(code,pc);
+    Word w;
+    get_word(w,pc);
     top--;
-    if (tag(top) == LUA_T_NIL) pc += code.w;
+    if (tag(top) == LUA_T_NIL) pc += w;
    }
    break;
 
    case IFFUPJMP:
    {
-    CodeWord code;
-    get_word(code,pc);
+    Word w;
+    get_word(w,pc);
     top--;
-    if (tag(top) == LUA_T_NIL) pc -= code.w;
+    if (tag(top) == LUA_T_NIL) pc -= w;
    }
    break;
 
@@ -1262,8 +1300,8 @@ static StkId lua_execute (Byte *pc, StkId base)
 
    case SETLINE:
    {
-    CodeWord code;
-    get_word(code,pc);
+    Word line;
+    get_word(line,pc);
     if ((stack+base-1)->tag != LUA_T_LINE)
     {
       /* open space for LINE value */
@@ -1271,9 +1309,9 @@ static StkId lua_execute (Byte *pc, StkId base)
       base++;
       (stack+base-1)->tag = LUA_T_LINE;
     }
-    (stack+base-1)->value.i = code.w;
+    (stack+base-1)->value.i = line;
     if (lua_linehook)
-      lineHook (code.w);
+      lineHook (line);
     break;
    }
 
diff --git a/opcode.h b/opcode.h
index 9b404a83..85ec1cb8 100644
--- a/opcode.h
+++ b/opcode.h
@@ -1,6 +1,6 @@
 /*
 ** TeCGraf - PUC-Rio
-** $Id: opcode.h,v 3.19 1996/03/06 13:11:23 roberto Exp $
+** $Id: opcode.h,v 3.20 1996/03/15 13:13:13 roberto Exp roberto $
 */
 
 #ifndef opcode_h
@@ -65,7 +65,8 @@ typedef enum
  CALLFUNC,
  RETCODE0,
  RETCODE,
- SETLINE
+ SETLINE,
+ VARARGS
 } OpCode;
 
 #define MULT_RET        255
@@ -107,28 +108,10 @@ typedef struct Object
 #define s_fvalue(i)     (fvalue(&s_object(i)))
 #define s_uvalue(i)     (uvalue(&s_object(i)))
 
-typedef union
-{
- struct {Byte c1; Byte c2;} m;
- Word w;
-} CodeWord;
-#define get_word(code,pc)    {code.m.c1 = *pc++; code.m.c2 = *pc++;}
-
-typedef union
-{
- struct {Byte c1; Byte c2; Byte c3; Byte c4;} m;
- float f;
-} CodeFloat;
-#define get_float(code,pc)   {code.m.c1 = *pc++; code.m.c2 = *pc++;\
-                              code.m.c3 = *pc++; code.m.c4 = *pc++;}
-
-typedef union
-{
- struct {Byte c1; Byte c2; Byte c3; Byte c4;} m;
- TFunc *tf;
-} CodeCode;
-#define get_code(code,pc)    {code.m.c1 = *pc++; code.m.c2 = *pc++;\
-                              code.m.c3 = *pc++; code.m.c4 = *pc++;}
+#define get_word(code,pc) {memcpy(&code, pc, sizeof(Word)); pc+=sizeof(Word);}
+#define get_float(code,pc){memcpy(&code, pc, sizeof(real)); pc+=sizeof(real);}
+#define get_code(code,pc) {memcpy(&code, pc, sizeof(TFunc *)); \
+                           pc+=sizeof(TFunc *);}
 
 
 /* Exported functions */
@@ -139,5 +122,6 @@ Object *luaI_Address (lua_Object o);
 void    luaI_pushobject (Object *o);
 void    luaI_gcFB       (Object *o);
 int     luaI_dorun (TFunc *tf);
+void    luaI_packarg (Object *firstelem, Object *arg);
 
 #endif
diff --git a/table.c b/table.c
index 56f7fb82..c16924cc 100644
--- a/table.c
+++ b/table.c
@@ -3,7 +3,7 @@
 ** Module to control static tables
 */
 
-char *rcs_table="$Id: table.c,v 2.53 1996/04/29 18:53:53 roberto Exp roberto $";
+char *rcs_table="$Id: table.c,v 2.54 1996/05/06 14:29:35 roberto Exp roberto $";
 
 #include "mem.h"
 #include "opcode.h"
@@ -39,6 +39,7 @@ static struct {
   lua_CFunction func;
 } int_funcs[] = {
   {"assert", luaI_assert},
+  {"call", luaI_call},
   {"dofile", lua_internaldofile},
   {"dostring", lua_internaldostring},
   {"error", luaI_error},