shithub: femtolisp

Info  •  Files  •  Log

making long argument lists more efficient

--- a/femtolisp/compiler.lsp

+++ b/femtolisp/compiler.lsp

@@ -24,7 +24,7 @@

 	  :closure :argc :vargc :trycatch :copyenv :let :for :tapply

 	  :add2 :sub2 :neg :largc :lvargc

-	  :loada0 :loada1 :loadc00 :loadc01

+	  :loada0 :loada1 :loadc00 :loadc01 :call.l :tcall.l

 	  dummy_t dummy_f dummy_nil]))

     (for 0 (1- (length keys))

@@ -148,7 +148,7 @@

 		      ((number? nxt)

 		       (case vi

 			 ((:loadv.l :loadg.l :setg.l :loada.l :seta.l

-			   :largc :lvargc)

+			   :largc :lvargc :call.l :tcall.l)

 			  (io.write bcode (int32 nxt))

 			  (set! i (+ i 1)))

@@ -306,22 +306,6 @@

 (define (compile-or g env tail? forms)

   (compile-short-circuit g env tail? forms #f :brt))

-(define (list-partition l n)

-  (define (list-part- l n  i subl acc)

-    (cond ((atom? l) (if (> i 0)

-			 (cons (reverse! subl) acc)

-			 acc))

-	  ((>= i n)  (list-part- l n 0 () (cons (reverse! subl) acc)))

-	  (else      (list-part- (cdr l) n (+ 1 i) (cons (car l) subl) acc))))

-  (if (<= n 0)

-      (error "list-partition: invalid count")

-      (reverse! (list-part- l n 0 () ()))))

-

-(define (make-nested-arglist args n)

-  (cons nconc

-	(map (lambda (l) (cons list l))

-	     (list-partition args n))))

-

 (define (compile-arglist g env lst)

   (for-each (lambda (a)

 	      (compile-in g env #f a))

@@ -410,10 +394,10 @@

 	       (top-level-value head)

 	       head)))

       (if (length> (cdr x) 255)

-	  ; argument count is a uint8, so for more than 255 arguments

-	  ; we use apply on a list built from sublists that fit the limit

-	  (compile-in g env tail?

-		      `(#.apply ,head ,(make-nested-arglist (cdr x) 255)))

+	  ; more than 255 arguments, need long versions of instructions

+	  (begin (compile-in g env #f head)

+		 (let ((nargs (compile-arglist g env (cdr x))))

+		   (emit g (if tail? :tcall.l :call.l) nargs)))

 	  (let ((b (and (builtin? head)

 			(builtin->instruction head))))

 	    (if (not b)

@@ -590,7 +574,7 @@

 		  (princ (number->string (aref code i)))

 		  (set! i (+ i 1)))

-		 ((:loada.l :seta.l :largc :lvargc)

+		 ((:loada.l :seta.l :largc :lvargc :call.l :tcall.l)

 		  (princ (number->string (ref-int32-LE code i)))

 		  (set! i (+ i 4)))

--- a/femtolisp/flisp.c

+++ b/femtolisp/flisp.c

@@ -1038,6 +1038,8 @@

                 NEXT_OP;

             }

             type_error("apply", "function", func);

+        OP(OP_TCALLL) n = GET_INT32(ip); ip+=4; goto do_tcall;

+        OP(OP_CALLL)  n = GET_INT32(ip); ip+=4; goto do_call;

         OP(OP_JMP) ip += (ptrint_t)GET_INT16(ip); NEXT_OP;

         OP(OP_BRF)

             v = POP();

@@ -1580,7 +1582,7 @@

                 pv[0] = fixnum(n+1);

                 pv++;

                 do {

-                  pv[n] = Stack[bp+n];

+                    pv[n] = Stack[bp+n];

                 } while (n--);

                 // environment representation changed; install

                 // the new representation so everybody can see it

--- a/femtolisp/opcodes.h

+++ b/femtolisp/opcodes.h

@@ -25,7 +25,7 @@

     OP_CLOSURE, OP_ARGC, OP_VARGC, OP_TRYCATCH, OP_COPYENV, OP_LET, OP_FOR,

     OP_TAPPLY, OP_ADD2, OP_SUB2, OP_NEG, OP_LARGC, OP_LVARGC,

-    OP_LOADA0, OP_LOADA1, OP_LOADC00, OP_LOADC01,

+    OP_LOADA0, OP_LOADA1, OP_LOADC00, OP_LOADC01, OP_CALLL, OP_TCALLL,

     OP_BOOL_CONST_T, OP_BOOL_CONST_F, OP_THE_EMPTY_LIST,

@@ -66,7 +66,8 @@

     &&L_OP_LET, &&L_OP_FOR,                                             \

     &&L_OP_TAPPLY, &&L_OP_ADD2, &&L_OP_SUB2, &&L_OP_NEG, &&L_OP_LARGC,  \

     &&L_OP_LVARGC,                                                      \

-    &&L_OP_LOADA0, &&L_OP_LOADA1, &&L_OP_LOADC00, &&L_OP_LOADC01        \

+    &&L_OP_LOADA0, &&L_OP_LOADA1, &&L_OP_LOADC00, &&L_OP_LOADC01,       \

+    &&L_OP_CALLL, &&L_OP_TCALLL                                         \

     }

 #define VM_APPLY_LABELS                                                 \

--- a/femtolisp/todo

+++ b/femtolisp/todo

@@ -972,8 +972,6 @@

 - #+, #- reader macros

 - printing improvements: *print-big*, keep track of horiz. position

   per-stream so indenting works across print calls

-- improve bootstrapping process so compiled version can recompile

-  itself for a broader set of changes

 - remaining c types

 - remaining cvalues functions

 - finish ios