some optimizations

lbuiltin.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lbuiltin.c,v 1.93 2000/02/22 18:12:46 roberto Exp roberto $
+** $Id: lbuiltin.c,v 1.94 2000/03/03 14:58:26 roberto Exp $
 ** Built-in functions
 ** See Copyright Notice in lua.h
 */
@@ -553,13 +553,8 @@ static int sort_comp (lua_State *L, lua_Object f, const TObject *a,
     L->top--;
     return (ttype(L->top) != LUA_T_NIL);
   }
-  else {  /* a < b? */
-    int res;
-    *(L->top) = *a;
-    *(L->top+1) = *b;
-    res = luaV_lessthan(L, L->top, L->top+1);
-    return res;
-  }
+  else  /* a < b? */
+    return luaV_lessthan(L, a, b, L->top);
 }
 
 static void auxsort (lua_State *L, Hash *a, int l, int u, lua_Object f) {

lcode.c

@@ -88,6 +88,16 @@ static void luaK_sub (LexState *ls) {
 }
 
 
+static void luaK_conc (LexState *ls) {
+  Instruction *previous = previous_instruction(ls);
+  luaK_deltastack(ls, -1);
+  switch(GET_OPCODE(*previous)) {
+    case CONCOP: *previous = SETARG_U(*previous, GETARG_U(*previous)+1); break;
+    default: luaK_primitivecode(ls, CREATE_U(CONCOP, 2));
+  }
+}
+
+
 void luaK_retcode (LexState *ls, int nlocals, int nexps) {
   Instruction *previous = previous_instruction(ls);
   if (nexps > 0 && GET_OPCODE(*previous) == CALL) {
@@ -286,7 +296,7 @@ void luaK_posfix (LexState *ls, int op, expdesc *v1, expdesc *v2) {
     case '*': luaK_0(ls, MULTOP, -1); break;
     case '/': luaK_0(ls, DIVOP, -1); break;
     case '^': luaK_0(ls, POWOP, -1); break;
-    case CONC: luaK_0(ls, CONCOP, -1); break;
+    case CONC: luaK_conc(ls); break;
     case EQ: luaK_0(ls, EQOP, -1); break;
     case NE: luaK_0(ls, NEQOP, -1); break;
     case '>': luaK_0(ls, GTOP, -1); break;

lopcodes.h

@@ -24,34 +24,51 @@
   is the usigned value minus 2^23.
 ===========================================================================*/
 
-#define EXCESS_S	(1<<23)		/* == 2^23 */
+#define SIZE_OP		8
+#define SIZE_U		24
+#define POS_U		8
+#define SIZE_S		24
+#define POS_S		8
+#define SIZE_A		16
+#define POS_A		16
+#define SIZE_B		8
+#define POS_B		8
+
+#define EXCESS_S	(1<<(SIZE_S-1))		/* == 2^23 */
+
+
+/* creates a mask with `n' 1 bits at position `p' */
+#define MASK1(n,p)	((~((~0ul)<<n))<<p)
+
+/* creates a mask with `n' 0 bits at position `p' */
+#define MASK0(n,p)	(~MASK1(n,p))
 
 /*
 ** the following macros help to manipulate instructions
 */
 
-#define MAXARG_U	((1<<24)-1)
-#define MAXARG_S	((1<<23)-1)
-#define MAXARG_A	((1<<16)-1)
-#define MAXARG_B	((1<<8)-1)
+#define MAXARG_U	((1<<SIZE_U)-1)
+#define MAXARG_S	((1<<(SIZE_S-1))-1)  /* `S' is signed */
+#define MAXARG_A	((1<<SIZE_A)-1)
+#define MAXARG_B	((1<<SIZE_B)-1)
 
-#define GET_OPCODE(i)	((OpCode)((i)&0xFF))
-#define GETARG_U(i)	((int)((i)>>8))
-#define GETARG_S(i)	((int)((i)>>8)-EXCESS_S)
-#define GETARG_A(i)	((int)((i)>>16))
-#define GETARG_B(i)	((int)(((i)>>8) & 0xFF))
+#define GET_OPCODE(i)	((OpCode)((i)&MASK1(SIZE_OP,0)))
+#define GETARG_U(i)	((int)((i)>>POS_U))
+#define GETARG_S(i)	((int)((i)>>POS_S)-EXCESS_S)
+#define GETARG_A(i)	((int)((i)>>POS_A))
+#define GETARG_B(i)	((int)(((i)>>POS_B) & MASK1(SIZE_B,0)))
 
-#define SET_OPCODE(i,o)	(((i)&0xFFFFFF00u) | (Instruction)(o))
-#define SETARG_U(i,u)	(((i)&0x000000FFu) | ((Instruction)(u)<<8))
-#define SETARG_S(i,s)	(((i)&0x000000FFu) | ((Instruction)((s)+EXCESS_S)<<8))
-#define SETARG_A(i,a)	(((i)&0x0000FFFFu) | ((Instruction)(a)<<16))
-#define SETARG_B(i,b)	(((i)&0xFFFF00FFu) | ((Instruction)(b)<<8))
+#define SET_OPCODE(i,o)	(((i)&MASK0(SIZE_OP,0)) | (Instruction)(o))
+#define SETARG_U(i,u)	(((i)&MASK0(SIZE_U,POS_U)) | ((Instruction)(u)<<POS_U))
+#define SETARG_S(i,s)	(((i)&MASK0(SIZE_S,POS_S)) | ((Instruction)((s)+EXCESS_S)<<POS_S))
+#define SETARG_A(i,a)	(((i)&MASK0(SIZE_A,POS_A)) | ((Instruction)(a)<<POS_A))
+#define SETARG_B(i,b)	(((i)&MASK0(SIZE_B,POS_B)) | ((Instruction)(b)<<POS_B))
 
 #define CREATE_0(o)	 ((Instruction)(o))
-#define CREATE_U(o,u)	 ((Instruction)(o) | (Instruction)(u)<<8)
-#define CREATE_S(o,s)	 ((Instruction)(o) | ((Instruction)(s)+EXCESS_S)<<8)
-#define CREATE_AB(o,a,b) ((Instruction)(o) | ((Instruction)(a)<<16) \
-                                           |  ((Instruction)(b)<<8))
+#define CREATE_U(o,u)	 ((Instruction)(o) | (Instruction)(u)<<POS_U)
+#define CREATE_S(o,s)	 ((Instruction)(o) | ((Instruction)(s)+EXCESS_S)<<POS_S)
+#define CREATE_AB(o,a,b) ((Instruction)(o) | ((Instruction)(a)<<POS_A) \
+                                           |  ((Instruction)(b)<<POS_B))
 
 
 /*
@@ -111,7 +128,7 @@ SUBOP,/*	-	y x		x-y				*/
 MULTOP,/*	-	y x		x*y				*/
 DIVOP,/*	-	y x		x/y				*/
 POWOP,/*	-	y x		x^y				*/
-CONCOP,/*	-	y x		x..y				*/
+CONCOP,/*	U	v_u-v_1		v1..-..v_u			*/
 MINUSOP,/*	-	x		-x				*/
 NOTOP,/*	-	x		(x==nil)? 1 : nil		*/
 

lparser.c

@@ -716,7 +716,7 @@ static int get_priority (int op, int *rp) {
 
     case  '+': case  '-': *rp = 5; return 5;
 
-    case  CONC: *rp = 4; return 4;  /* left associative (?) */
+    case  CONC: *rp = 3; return 4;  /* right associative (?) */
 
     case EQ: case  NE: case  '>': case  '<': case  LE: case  GE:
       *rp = 2; return 2;
@@ -941,18 +941,17 @@ static void namestat (LexState *ls) {
 
 
 static void ifpart (LexState *ls, int line) {
-  /* ifpart -> cond THEN block [ELSE block | ELSEIF ifpart] */
+  /* ifpart -> cond THEN block (ELSEIF ifpart | [ELSE block] END) */
   FuncState *fs = ls->fs;
   int c;  /* address of the conditional jump */
-  int je;  /* address of the unconditional jump (to skip `else' part) */
   int elseinit;
   next(ls);  /* skip IF or ELSEIF */
   exp1(ls);  /* cond */
-  c = luaK_S(ls, IFFJMP, 0, -1);  /* jump over `then' part if `cond' is false */
+  c = luaK_S(ls, IFFJMP, 0, -1);  /* 1st jump: over `then' part */
   check(ls, THEN);
   block(ls);  /* `then' part */
-  je = luaK_S(ls, JMP, 0, 0);  /* jump over `else' part after `then' */
-  elseinit = luaK_getlabel(ls);
+  luaK_S(ls, JMP, 0, 0);  /* 2nd jump: over `else' part */
+  elseinit = luaK_getlabel(ls);  /* address of 2nd jump == elseinit-1 */
   if (ls->token == ELSEIF)
     ifpart(ls, line);
   else {
@@ -961,13 +960,12 @@ static void ifpart (LexState *ls, int line) {
     check_match(ls, END, IF, line);
   }
   if (fs->pc > elseinit) {  /* is there an `else' part? */
-    luaK_fixjump(ls, je, luaK_getlabel(ls));  /* last jump jumps over it */
-    luaK_fixjump(ls, c, elseinit);  /* fix first jump to `else' part */
+    luaK_fixjump(ls, c, elseinit);  /* fix 1st jump to `else' part */
+    luaK_fixjump(ls, elseinit-1, luaK_getlabel(ls));  /* fix 2nd jump */
   }
   else {  /* no else part */
-    fs->pc--;  /* remove last jump */
-    LUA_ASSERT(L, fs->pc == je, "jump out of place");
-    luaK_fixjump(ls, c, luaK_getlabel(ls));  /* fix first jump to `if' end */
+    fs->pc--;  /* remove 2nd jump */
+    luaK_fixjump(ls, c, luaK_getlabel(ls));  /* fix 1st jump to `if' end */
   }
 }
 

lvm.c

@@ -39,17 +39,6 @@
 
 
 
-static TaggedString *strconc (lua_State *L, const TaggedString *l,
-                                            const TaggedString *r) {
-  long nl = l->u.s.len;
-  long nr = r->u.s.len;
-  char *buffer = luaL_openspace(L, nl+nr);
-  memcpy(buffer, l->str, nl);
-  memcpy(buffer+nl, r->str, nr);
-  return luaS_newlstr(L, buffer, nl+nr);
-}
-
-
 int luaV_tonumber (TObject *obj) {  /* LUA_NUMBER */
   if (ttype(obj) != LUA_T_STRING)
     return 1;
@@ -253,22 +242,16 @@ static int luaV_strcomp (const TaggedString *ls, const TaggedString *rs) {
 }
 
 
-int luaV_lessthan (lua_State *L, TObject *l, TObject *r) {
+int luaV_lessthan (lua_State *L, const TObject *l, const TObject *r, StkId top) {
   if (ttype(l) == LUA_T_NUMBER && ttype(r) == LUA_T_NUMBER)
     return (nvalue(l) < nvalue(r));
   else if (ttype(l) == LUA_T_STRING && ttype(r) == LUA_T_STRING)
     return (luaV_strcomp(tsvalue(l), tsvalue(r)) < 0);
-  else {
-    /* update top and put arguments in correct order to call TM */
-    if (l<r)  /* are arguments in correct order? */
-      L->top = r+1;  /* yes; 2nd is on top */
-    else {  /* no; exchange them */
-      TObject temp = *r;
-      *r = *l;
-      *l = temp;
-      L->top = l+1;  /* 1st is on top */
-    }
-    call_binTM(L, L->top, IM_LT, "unexpected type in comparison");
+  else {  /* call TM */
+    luaD_checkstack(L, 2);
+    *top++ = *l;
+    *top++ = *r;
+    call_binTM(L, top, IM_LT, "unexpected type in comparison");
     L->top--;
     return (ttype(L->top) != LUA_T_NIL);
   }
@@ -280,6 +263,34 @@ int luaV_lessthan (lua_State *L, TObject *l, TObject *r) {
                         else ttype(o) = LUA_T_NIL
 
 
+static void strconc (lua_State *L, int total, StkId top) {
+  do {
+    int n = 2;  /* number of elements handled in this pass (at least 2) */
+    if (tostring(L, top-2) || tostring(L, top-1))
+      call_binTM(L, top, IM_CONCAT, "unexpected type for concatenation");
+    else {  /* at least two string values; get as many as possible */
+      long tl = tsvalue(top-2)->u.s.len + tsvalue(top-1)->u.s.len;
+      char *buffer;
+      int i;
+      while (n < total && !tostring(L, top-n-1)) {  /* collect total length */
+        tl += tsvalue(top-n-1)->u.s.len;
+        n++;
+      }
+      buffer = luaL_openspace(L, tl);
+      tl = 0;
+      for (i=n; i>0; i--) {  /* concat all strings */
+        long l = tsvalue(top-i)->u.s.len;
+        memcpy(buffer+tl, tsvalue(top-i)->str, l);
+        tl += l;
+      }
+      tsvalue(top-n) = luaS_newlstr(L, buffer, tl);
+    }
+    total -= n-1;  /* got `n' strings to create 1 new */
+    top -= n-1;
+  } while (total > 1);  /* repeat until only 1 result left */
+}
+
+
 void luaV_pack (lua_State *L, StkId firstelem, int nvararg, TObject *tab) {
   int i;
   Hash *htab;
@@ -479,22 +490,22 @@ StkId luaV_execute (lua_State *L, const Closure *cl, const TProtoFunc *tf,
 
       case LTOP:
         top--;
-        setbool(top-1, luaV_lessthan(L, top-1, top));
+        setbool(top-1, luaV_lessthan(L, top-1, top, top+1));
         break;
 
       case LEOP:  /* a <= b  ===  !(b<a) */
         top--;
-        setbool(top-1, !luaV_lessthan(L, top, top-1));
+        setbool(top-1, !luaV_lessthan(L, top, top-1, top+1));
         break;
 
       case GTOP:  /* a > b  ===  (b<a) */
         top--;
-        setbool(top-1, luaV_lessthan(L, top, top-1));
+        setbool(top-1, luaV_lessthan(L, top, top-1, top+1));
         break;
 
       case GEOP:  /* a >= b  ===  !(a<b) */
         top--;
-        setbool(top-1, !luaV_lessthan(L, top-1, top));
+        setbool(top-1, !luaV_lessthan(L, top-1, top, top+1));
         break;
 
       case ADDOP:
@@ -544,15 +555,14 @@ StkId luaV_execute (lua_State *L, const Closure *cl, const TProtoFunc *tf,
         top--;
         break;
 
-      case CONCOP:
-        if (tostring(L, top-2) || tostring(L, top-1))
-          call_binTM(L, top, IM_CONCAT, "unexpected type for concatenation");
-        else
-          tsvalue(top-2) = strconc(L, tsvalue(top-2), tsvalue(top-1));
-        top--;
+      case CONCOP: {
+        int n = GETARG_U(i);
+        strconc(L, n, top);
+        top -= n-1;
         L->top = top;
         luaC_checkGC(L);
         break;
+      }
 
       case MINUSOP:
         if (tonumber(top-1)) {

lvm.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lvm.h,v 1.16 2000/02/22 18:12:46 roberto Exp roberto $
+** $Id: lvm.h,v 1.17 2000/03/03 14:58:26 roberto Exp $
 ** Lua virtual machine
 ** See Copyright Notice in lua.h
 */
@@ -28,6 +28,6 @@ void luaV_getglobal (lua_State *L, GlobalVar *gv, StkId top);
 void luaV_setglobal (lua_State *L, GlobalVar *gv, StkId top);
 StkId luaV_execute (lua_State *L, const Closure *cl, const TProtoFunc *tf, StkId base);
 void luaV_closure (lua_State *L, int nelems);
-int luaV_lessthan (lua_State *L, TObject *l, TObject *r);
+int luaV_lessthan (lua_State *L, const TObject *l, const TObject *r, StkId top);
 
 #endif