ref: 66c671bfeeb94ffaf3f475f30f6dd2c522d3fd2e
parent: 0278b152b887c495dbd4d9c4feb75e384cd996e2
author: JeffBezanson <jeff.bezanson@gmail.com>
date: Tue Jul 21 22:10:20 EDT 2009
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