shithub: femtolisp

Download patch

ref: 14d625bd83715b043d530349cfa40e3c843ffd91
parent: de19e4f401b874c9597cddf36d9141a5229e4850
author: JeffBezanson <jeff.bezanson@gmail.com>
date: Sun Apr 26 23:21:53 EDT 2009

some performance tweaks


--- a/femtolisp/Makefile
+++ b/femtolisp/Makefile
@@ -12,7 +12,7 @@
 LIBS = $(LLT) -lm
 
 DEBUGFLAGS = -g -DDEBUG $(FLAGS)
-SHIPFLAGS = -O3 -DNDEBUG -fomit-frame-pointer $(FLAGS)
+SHIPFLAGS = -O3 -DNDEBUG -fomit-frame-pointer -mtune=generic -march=i686 $(FLAGS)
 
 default: release test
 
--- a/femtolisp/compiler.lsp
+++ b/femtolisp/compiler.lsp
@@ -377,18 +377,18 @@
 		   (emit g (if (and tail? (eq? b :apply)) :tapply b)))))
 	      (emit g (if tail? :tcall :call) nargs)))))))
 
+(define (fits-i8 x) (and (fixnum? x) (>= x -128) (<= x 127)))
+
 (define (compile-in g env tail? x)
   (cond ((symbol? x) (compile-sym g env x [:loada :loadc :loadg]))
 	((atom? x)
-	 (cond ((eq? x 0)  (emit g :load0))
-	       ((eq? x 1)  (emit g :load1))
-	       ((eq? x #t) (emit g :loadt))
-	       ((eq? x #f) (emit g :loadf))
-	       ((eq? x ()) (emit g :loadnil))
-	       ((and (fixnum? x)
-		     (>= x -128)
-		     (<= x 127)) (emit g :loadi8 x))
-	       (else       (emit g :loadv x))))
+	 (cond ((eq? x 0)   (emit g :load0))
+	       ((eq? x 1)   (emit g :load1))
+	       ((eq? x #t)  (emit g :loadt))
+	       ((eq? x #f)  (emit g :loadf))
+	       ((eq? x ())  (emit g :loadnil))
+	       ((fits-i8 x) (emit g :loadi8 x))
+	       (else        (emit g :loadv x))))
 	(else
 	 (case (car x)
 	   (quote    (emit g :loadv (cadr x)))
--- a/femtolisp/flisp.c
+++ b/femtolisp/flisp.c
@@ -765,7 +765,8 @@
     PUSH(fn->env);
 
     ip = 0;
-    while (1) {
+    { 
+    next_op:
         op = code[ip++];
     dispatch:
         switch (op) {
@@ -773,7 +774,7 @@
             if (nargs > code[ip++]) {
                 lerror(ArgError, "apply: too many arguments");
             }
-            break;
+            goto next_op;
         case OP_VARGC:
             i = code[ip++];
             s = (fixnum_t)nargs - (fixnum_t)i;
@@ -793,33 +794,33 @@
                 Stack[SP-2] = NIL;
             }
             nargs = i+1;
-            break;
+            goto next_op;
         case OP_LET:
             ip++;
             // last arg is closure environment to use
             nargs--;
             POPN(1);
-            break;
-        case OP_NOP: break;
-        case OP_DUP: v = Stack[SP-1]; PUSH(v); break;
-        case OP_POP: POPN(1); break;
+            goto next_op;
+        case OP_NOP: goto next_op;
+        case OP_DUP: v = Stack[SP-1]; PUSH(v); goto next_op;
+        case OP_POP: POPN(1); goto next_op;
         case OP_TCALL:
+            n = code[ip++];  // nargs
+            if (isfunction(Stack[SP-n-1])) {
+                for(s=-1; s < (fixnum_t)n; s++)
+                    Stack[bp+s] = Stack[SP-n+s];
+                SP = bp+n;
+                nargs = n;
+                goto apply_cl_top;
+            }
+            goto do_call;
         case OP_CALL:
             n = code[ip++];  // nargs
         do_call:
-            s = SP;
             func = Stack[SP-n-1];
+            s = SP;
             if (isfunction(func)) {
-                if (op == OP_TCALL) {
-                    for(s=-1; s < (fixnum_t)n; s++)
-                        Stack[bp+s] = Stack[SP-n+s];
-                    SP = bp+n;
-                    nargs = n;
-                    goto apply_cl_top;
-                }
-                else {
-                    v = apply_cl(n);
-                }
+                v = apply_cl(n);
             }
             else if (isbuiltinish(func)) {
                 op = uintval(func);
@@ -853,36 +854,36 @@
             else {
                 type_error("apply", "function", func);
             }
-            SP = s-n-1;
-            PUSH(v);
-            break;
-        case OP_JMP: ip = (uint32_t)*(uint16_t*)&code[ip]; break;
+            SP = s-n;
+            Stack[SP-1] = v;
+            goto next_op;
+        case OP_JMP: ip = (uint32_t)*(uint16_t*)&code[ip]; goto next_op;
         case OP_BRF:
             v = POP();
             if (v == FL_F) ip = (uint32_t)*(uint16_t*)&code[ip];
             else ip += 2;
-            break;
+            goto next_op;
         case OP_BRT:
             v = POP();
             if (v != FL_F) ip = (uint32_t)*(uint16_t*)&code[ip];
             else ip += 2;
-            break;
-        case OP_JMPL: ip = *(uint32_t*)&code[ip]; break;
+            goto next_op;
+        case OP_JMPL: ip = *(uint32_t*)&code[ip]; goto next_op;
         case OP_BRFL:
             v = POP();
             if (v == FL_F) ip = *(uint32_t*)&code[ip];
             else ip += 4;
-            break;
+            goto next_op;
         case OP_BRTL:
             v = POP();
             if (v != FL_F) ip = *(uint32_t*)&code[ip];
             else ip += 4;
-            break;
+            goto next_op;
         case OP_RET: v = POP(); return v;
 
         case OP_EQ:
             Stack[SP-2] = ((Stack[SP-2] == Stack[SP-1]) ? FL_T : FL_F);
-            POPN(1); break;
+            POPN(1); goto next_op;
         case OP_EQV:
             if (Stack[SP-2] == Stack[SP-1]) {
                 v = FL_T;
@@ -895,7 +896,7 @@
                     FL_T : FL_F;
             }
             Stack[SP-2] = v; POPN(1);
-            break;
+            goto next_op;
         case OP_EQUAL:
             if (Stack[SP-2] == Stack[SP-1]) {
                 v = FL_T;
@@ -908,41 +909,41 @@
                     FL_T : FL_F;
             }
             Stack[SP-2] = v; POPN(1);
-            break;
+            goto next_op;
         case OP_PAIRP:
-            Stack[SP-1] = (iscons(Stack[SP-1]) ? FL_T : FL_F); break;
+            Stack[SP-1] = (iscons(Stack[SP-1]) ? FL_T : FL_F); goto next_op;
         case OP_ATOMP:
-            Stack[SP-1] = (iscons(Stack[SP-1]) ? FL_F : FL_T); break;
+            Stack[SP-1] = (iscons(Stack[SP-1]) ? FL_F : FL_T); goto next_op;
         case OP_NOT:
-            Stack[SP-1] = ((Stack[SP-1]==FL_F) ? FL_T : FL_F); break;
+            Stack[SP-1] = ((Stack[SP-1]==FL_F) ? FL_T : FL_F); goto next_op;
         case OP_NULLP:
-            Stack[SP-1] = ((Stack[SP-1]==NIL) ? FL_T : FL_F); break;
+            Stack[SP-1] = ((Stack[SP-1]==NIL) ? FL_T : FL_F); goto next_op;
         case OP_BOOLEANP:
             v = Stack[SP-1];
-            Stack[SP-1] = ((v == FL_T || v == FL_F) ? FL_T : FL_F); break;
+            Stack[SP-1] = ((v == FL_T || v == FL_F) ? FL_T : FL_F); goto next_op;
         case OP_SYMBOLP:
-            Stack[SP-1] = (issymbol(Stack[SP-1]) ? FL_T : FL_F); break;
+            Stack[SP-1] = (issymbol(Stack[SP-1]) ? FL_T : FL_F); goto next_op;
         case OP_NUMBERP:
             v = Stack[SP-1];
-            Stack[SP-1] = (isfixnum(v) || iscprim(v) ? FL_T : FL_F); break;
+            Stack[SP-1] = (isfixnum(v) || iscprim(v) ? FL_T : FL_F); goto next_op;
         case OP_FIXNUMP:
-            Stack[SP-1] = (isfixnum(Stack[SP-1]) ? FL_T : FL_F); break;
+            Stack[SP-1] = (isfixnum(Stack[SP-1]) ? FL_T : FL_F); goto next_op;
         case OP_BOUNDP:
             sym = tosymbol(Stack[SP-1], "bound?");
             Stack[SP-1] = ((sym->binding == UNBOUND) ? FL_F : FL_T);
-            break;
+            goto next_op;
         case OP_BUILTINP:
             v = Stack[SP-1];
             Stack[SP-1] = ((isbuiltinish(v) && v!=FL_F && v!=FL_T && v!=NIL)
                            ? FL_T : FL_F);
-            break;
+            goto next_op;
         case OP_FUNCTIONP:
             v = Stack[SP-1];
             Stack[SP-1] = ((isbuiltinish(v) && v!=FL_F && v!=FL_T && v!=NIL) ||
                            isfunction(v)) ? FL_T : FL_F;
-            break;
+            goto next_op;
         case OP_VECTORP:
-            Stack[SP-1] = (isvector(Stack[SP-1]) ? FL_T : FL_F); break;
+            Stack[SP-1] = (isvector(Stack[SP-1]) ? FL_T : FL_F); goto next_op;
 
         case OP_CONS:
             if (curheap > lim)
@@ -952,23 +953,23 @@
             c->car = Stack[SP-2];
             c->cdr = Stack[SP-1];
             Stack[SP-2] = tagptr(c, TAG_CONS);
-            POPN(1); break;
+            POPN(1); goto next_op;
         case OP_CAR:
             v = Stack[SP-1];
             if (!iscons(v)) type_error("car", "cons", v);
             Stack[SP-1] = car_(v);
-            break;
+            goto next_op;
         case OP_CDR:
             v = Stack[SP-1];
             if (!iscons(v)) type_error("cdr", "cons", v);
             Stack[SP-1] = cdr_(v);
-            break;
+            goto next_op;
         case OP_SETCAR:
             car(Stack[SP-2]) = Stack[SP-1];
-            POPN(1); break;
+            POPN(1); goto next_op;
         case OP_SETCDR:
             cdr(Stack[SP-2]) = Stack[SP-1];
-            POPN(1); break;
+            POPN(1); goto next_op;
         case OP_LIST:
             n = code[ip++];
         apply_list:
@@ -980,7 +981,7 @@
             else {
                 PUSH(NIL);
             }
-            break;
+            goto next_op;
 
         case OP_TAPPLY:
         case OP_APPLY:
@@ -1022,14 +1023,14 @@
                 v = fixnum(s);
             POPN(n);
             PUSH(v);
-            break;
+            goto next_op;
         case OP_ADD2:
             if (bothfixnums(Stack[SP-1], Stack[SP-2])) {
-                accum = (int64_t)numval(Stack[SP-1]) + numval(Stack[SP-2]);
-                if (fits_fixnum(accum))
-                    v = fixnum(accum);
+                s = numval(Stack[SP-1]) + numval(Stack[SP-2]);
+                if (fits_fixnum(s))
+                    v = fixnum(s);
                 else
-                    v = return_from_int64(accum);
+                    v = mk_long(s);
             }
             else {
                 v = fl_add_any(&Stack[SP-2], 2, 0);
@@ -1036,7 +1037,7 @@
             }
             POPN(1);
             Stack[SP-1] = v;
-            break;
+            goto next_op;
         case OP_SUB:
             n = code[ip++];
         apply_sub:
@@ -1052,7 +1053,7 @@
             v = fl_add_any(&Stack[i], 2, 0);
             POPN(n);
             PUSH(v);
-            break;
+            goto next_op;
         case OP_NEG:
         do_neg:
             if (__likely(isfixnum(Stack[SP-1])))
@@ -1059,25 +1060,23 @@
                 Stack[SP-1] = fixnum(-numval(Stack[SP-1]));
             else
                 Stack[SP-1] = fl_neg(Stack[SP-1]);
-            break;
+            goto next_op;
         case OP_SUB2:
         do_sub2:
             if (__likely(bothfixnums(Stack[SP-2], Stack[SP-1]))) {
                 s = numval(Stack[SP-2]) - numval(Stack[SP-1]);
-                if (__likely(fits_fixnum(s))) {
-                    POPN(1);
-                    Stack[SP-1] = fixnum(s);
-                    break;
-                }
-                Stack[SP-1] = fixnum(-numval(Stack[SP-1]));
+                if (__likely(fits_fixnum(s)))
+                    v = fixnum(s);
+                else
+                    v = mk_long(s);
             }
             else {
                 Stack[SP-1] = fl_neg(Stack[SP-1]);
+                v = fl_add_any(&Stack[SP-2], 2, 0);
             }
-            v = fl_add_any(&Stack[SP-2], 2, 0);
             POPN(1);
             Stack[SP-1] = v;
-            break;
+            goto next_op;
         case OP_MUL:
             n = code[ip++];
         apply_mul:
@@ -1102,7 +1101,7 @@
             }
             POPN(n);
             PUSH(v);
-            break;
+            goto next_op;
         case OP_DIV:
             n = code[ip++];
         apply_div:
@@ -1121,7 +1120,7 @@
                 POPN(n);
                 PUSH(v);
             }
-            break;
+            goto next_op;
         case OP_NUMEQ:
             v = Stack[SP-2]; e = Stack[SP-1];
             if (bothfixnums(v, e)) {
@@ -1132,7 +1131,7 @@
             }
             POPN(1);
             Stack[SP-1] = v;
-            break;
+            goto next_op;
         case OP_LT:
             if (bothfixnums(Stack[SP-2], Stack[SP-1])) {
                 v = (numval(Stack[SP-2]) < numval(Stack[SP-1])) ? FL_T : FL_F;
@@ -1143,11 +1142,11 @@
             }
             POPN(1);
             Stack[SP-1] = v;
-            break;
+            goto next_op;
         case OP_COMPARE:
             Stack[SP-2] = compare(Stack[SP-2], Stack[SP-1]);
             POPN(1);
-            break;
+            goto next_op;
 
         case OP_VECTOR:
             n = code[ip++];
@@ -1171,7 +1170,7 @@
                 }
             }
             PUSH(v);
-            break;
+            goto next_op;
 
         case OP_AREF:
             v = Stack[SP-2];
@@ -1189,7 +1188,7 @@
             }
             POPN(1);
             Stack[SP-1] = v;
-            break;
+            goto next_op;
         case OP_ASET:
             e = Stack[SP-3];
             if (isvector(e)) {
@@ -1206,7 +1205,7 @@
             }
             POPN(2);
             Stack[SP-1] = v;
-            break;
+            goto next_op;
         case OP_FOR:
             lo = tofixnum(Stack[SP-3], "for");
             hi = tofixnum(Stack[SP-2], "for");
@@ -1222,25 +1221,25 @@
             }
             POPN(4);
             Stack[SP-1] = v;
-            break;
+            goto next_op;
 
-        case OP_LOADT: PUSH(FL_T); break;
-        case OP_LOADF: PUSH(FL_F); break;
-        case OP_LOADNIL: PUSH(NIL); break;
-        case OP_LOAD0: PUSH(fixnum(0)); break;
-        case OP_LOAD1: PUSH(fixnum(1)); break;
-        case OP_LOADI8: s = (int8_t)code[ip++]; PUSH(fixnum(s)); break;
+        case OP_LOADT: PUSH(FL_T); goto next_op;
+        case OP_LOADF: PUSH(FL_F); goto next_op;
+        case OP_LOADNIL: PUSH(NIL); goto next_op;
+        case OP_LOAD0: PUSH(fixnum(0)); goto next_op;
+        case OP_LOAD1: PUSH(fixnum(1)); goto next_op;
+        case OP_LOADI8: s = (int8_t)code[ip++]; PUSH(fixnum(s)); goto next_op;
         case OP_LOADV:
             v = fn_vals(Stack[bp-1]);
             assert(code[ip] < vector_size(v));
             v = vector_elt(v, code[ip]); ip++;
             PUSH(v);
-            break;
+            goto next_op;
         case OP_LOADVL:
             v = fn_vals(Stack[bp-1]);
             v = vector_elt(v, *(uint32_t*)&code[ip]); ip+=4;
             PUSH(v);
-            break;
+            goto next_op;
         case OP_LOADGL:
             v = fn_vals(Stack[bp-1]);
             v = vector_elt(v, *(uint32_t*)&code[ip]); ip+=4;
@@ -1255,7 +1254,7 @@
             if (sym->binding == UNBOUND)
                 raise(list2(UnboundError, v));
             PUSH(sym->binding);
-            break;
+            goto next_op;
 
         case OP_SETGL:
             v = fn_vals(Stack[bp-1]);
@@ -1271,7 +1270,7 @@
             v = Stack[SP-1];
             if (sym->syntax != TAG_CONST)
                 sym->binding = v;
-            break;
+            goto next_op;
 
         case OP_LOADA:
             assert(nargs > 0);
@@ -1287,7 +1286,7 @@
                 v = Stack[bp+i];
             }
             PUSH(v);
-            break;
+            goto next_op;
         case OP_SETA:
             assert(nargs > 0);
             v = Stack[SP-1];
@@ -1302,7 +1301,7 @@
                 assert(bp+i < SP);
                 Stack[bp+i] = v;
             }
-            break;
+            goto next_op;
         case OP_LOADC:
         case OP_SETC:
             s = code[ip++];
@@ -1316,7 +1315,7 @@
                 vector_elt(v, i) = Stack[SP-1];
             else
                 PUSH(vector_elt(v, i));
-            break;
+            goto next_op;
 
         case OP_CLOSURE:
         case OP_CLOSE:
@@ -1352,15 +1351,17 @@
                 POPN(1);
                 Stack[SP-1] = tagptr(pv, TAG_CVALUE);
             }
-            break;
+            goto next_op;
 
         case OP_TRYCATCH:
             v = do_trycatch();
             POPN(1);
             Stack[SP-1] = v;
-            break;
+            goto next_op;
         }
     }
+    assert(0);
+    return UNBOUND;
 }
 
 // initialization -------------------------------------------------------------