ref: 57c066fcdfd6058cf51154ae00e24d6a74f3a192
parent: 642d1e1bd4dadfade218128bcf3eb6980fe7d501
author: JeffBezanson <jeff.bezanson@gmail.com>
date: Mon Jul 20 00:57:17 EDT 2009
simplifying code by eliminating the hybrid stack/heap calling convention other misc. cleanup
--- a/femtolisp/bootstrap.sh
+++ b/femtolisp/bootstrap.sh
@@ -3,7 +3,7 @@
cp flisp.boot flisp.boot.bak
echo "Creating stage 0 boot file..."
-#../../branches/interpreter/femtolisp/flisp mkboot0.lsp system.lsp compiler.lsp > flisp.boot
+#../../branches/interpreter/femtolisp/flisp mkboot0.lsp system.lsp compiler.lsp > flisp.boot.new
./flisp mkboot0.lsp system.lsp compiler.lsp > flisp.boot.new
mv flisp.boot.new flisp.boot
--- a/femtolisp/builtins.c
+++ b/femtolisp/builtins.c
@@ -35,15 +35,8 @@
cons_t *c;
uint32_t i=0;
while (1) {- if (i >= MAX_ARGS) {- lst = car_(args[MAX_ARGS]);
- args[MAX_ARGS] = cdr_(args[MAX_ARGS]);
- if (!iscons(args[MAX_ARGS])) break;
- }
- else {- lst = args[i++];
- if (i >= nargs) break;
- }
+ lst = args[i++];
+ if (i >= nargs) break;
if (iscons(lst)) {*pcdr = lst;
c = (cons_t*)ptr(lst);
--- a/femtolisp/compiler.lsp
+++ b/femtolisp/compiler.lsp
@@ -209,6 +209,8 @@
; number of non-nulls
(define (nnn e) (count (lambda (x) (not (null? x))) e))
+(define (printable? x) (not (iostream? x)))
+
(define (compile-sym g env s Is)
(let ((loc (lookup-sym s env 0 #t)))
(case (car loc)
@@ -216,7 +218,11 @@
(closed (emit g (aref Is 1) (cadr loc) (caddr loc))
; update index of most distant captured frame
(bcode:cdepth g (- (nnn (cdr env)) 1 (cadr loc))))
- (else (emit g (aref Is 2) s)))))
+ (else
+ (if (and (constant? s)
+ (printable? (top-level-value s)))
+ (emit g :loadv (top-level-value s))
+ (emit g (aref Is 2) s))))))
(define (compile-if g env tail? x)
(let ((elsel (make-label g))
@@ -300,8 +306,6 @@
(define (compile-or g env tail? forms)
(compile-short-circuit g env tail? forms #f :brt))
-(define MAX_ARGS 127)
-
(define (list-partition l n)
(define (list-part- l n i subl acc)
(cond ((atom? l) (if (> i 0)
@@ -313,24 +317,17 @@
(error "list-partition: invalid count")
(reverse! (list-part- l n 0 () ()))))
-(define (just-compile-args g lst env)
+(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))
- lst))
+ lst)
+ (length lst))
-(define (compile-arglist g env lst)
- (let ((argtail (length> lst MAX_ARGS)))
- (if argtail
- (begin (just-compile-args g (list-head lst MAX_ARGS) env)
- (let ((rest
- (cons nconc
- (map (lambda (l) (cons list l))
- (list-partition argtail MAX_ARGS)))))
- (compile-in g env #f rest))
- (+ MAX_ARGS 1))
- (begin (just-compile-args g lst env)
- (length lst)))))
-
(define (argc-error head count)
(error (string "compile error: " head " expects " count
(if (= count 1)
@@ -342,7 +339,7 @@
(if (and (pair? head)
(eq? (car head) 'lambda)
(list? (cadr head))
- (not (length> (cadr head) MAX_ARGS)))
+ (not (length> (cadr head) 255)))
(compile-let g env tail? x)
(compile-call g env tail? x))))
@@ -375,6 +372,33 @@
(lambda (b)
(get b2i b #f))))
+(define (compile-builtin-call g env tail? x head b nargs)
+ (let ((count (get arg-counts b #f)))
+ (if (and count
+ (not (length= (cdr x) count)))
+ (argc-error head count))
+ (case b ; handle special cases of vararg builtins
+ (:list (if (= nargs 0) (emit g :loadnil) (emit g b nargs)))
+ (:+ (cond ((= nargs 0) (emit g :load0))
+ ((= nargs 2) (emit g :add2))
+ (else (emit g b nargs))))
+ (:- (cond ((= nargs 0) (argc-error head 1))
+ ((= nargs 1) (emit g :neg))
+ ((= nargs 2) (emit g :sub2))
+ (else (emit g b nargs))))
+ (:* (if (= nargs 0) (emit g :load1)
+ (emit g b nargs)))
+ (:/ (if (= nargs 0)
+ (argc-error head 1)
+ (emit g b nargs)))
+ (:vector (if (= nargs 0)
+ (emit g :loadv [])
+ (emit g b nargs)))
+ (:apply (if (< nargs 2)
+ (argc-error head 2)
+ (emit g (if tail? :tapply :apply) nargs)))
+ (else (emit g b)))))
+
(define (compile-call g env tail? x)
(let ((head (car x)))
(let ((head
@@ -385,38 +409,19 @@
(builtin? (top-level-value head)))
(top-level-value head)
head)))
- (let ((b (and (builtin? head)
- (builtin->instruction head))))
- (if (not b)
- (compile-in g env #f head))
- (let ((nargs (compile-arglist g env (cdr x))))
- (if b
- (let ((count (get arg-counts b #f)))
- (if (and count
- (not (length= (cdr x) count)))
- (argc-error head count))
- (case b ; handle special cases of vararg builtins
- (:list (if (= nargs 0) (emit g :loadnil) (emit g b nargs)))
- (:+ (cond ((= nargs 0) (emit g :load0))
- ((= nargs 2) (emit g :add2))
- (else (emit g b nargs))))
- (:- (cond ((= nargs 0) (argc-error head 1))
- ((= nargs 1) (emit g :neg))
- ((= nargs 2) (emit g :sub2))
- (else (emit g b nargs))))
- (:* (if (= nargs 0) (emit g :load1)
- (emit g b nargs)))
- (:/ (if (= nargs 0)
- (argc-error head 1)
- (emit g b nargs)))
- (:vector (if (= nargs 0)
- (emit g :loadv [])
- (emit g b nargs)))
- (:apply (if (< nargs 2)
- (argc-error head 2)
- (emit g (if tail? :tapply :apply) nargs)))
- (else (emit g b))))
- (emit g (if tail? :tcall :call) nargs)))))))
+ (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)))
+ (let ((b (and (builtin? head)
+ (builtin->instruction head))))
+ (if (not b)
+ (compile-in g env #f head))
+ (let ((nargs (compile-arglist g env (cdr x))))
+ (if b
+ (compile-builtin-call g env tail? x head b nargs)
+ (emit g (if tail? :tcall :call) nargs))))))))
(define (expand-define form body)
(if (symbol? form)
@@ -514,7 +519,7 @@
'lambda
(lastcdr f))))
(cond ((not (null? let?)) (emit g :let))
- ((length> args MAX_ARGS) (emit g (if (null? (lastcdr args))
+ ((length> args 255) (emit g (if (null? (lastcdr args))
:largc :lvargc)
(length args)))
((null? (lastcdr args)) (emit g :argc (length args)))
--- a/femtolisp/cvalues.c
+++ b/femtolisp/cvalues.c
@@ -464,8 +464,6 @@
argcount("array", nargs, 1);cnt = nargs - 1;
- if (nargs > MAX_ARGS)
- cnt += (llength(args[MAX_ARGS])-1);
fltype_t *type = get_array_type(args[0]);
elsize = type->elsz;
sz = elsize * cnt;
--- a/femtolisp/flisp.boot
+++ b/femtolisp/flisp.boot
@@ -1,1 +1,1 @@
-(zero? #function("7000r1~`W;" [] zero?) vector.map #function("8000r2c0e1\x7f31u42;" [#function("8000vc0e1~31u42;" [#function(":000v`\x80azc0qw2~;" [#function(":000r1\x80~i20i21~[31\\;" [])]) vector.alloc]) length] vector.map) vector->list #function("9000r1c0e1~31_u43;" [#function(":000va~c0qw2\x7f;" [#function("8000r1i10\x80~z[\x81Ko01;" [])]) length] vector->list) values #function("9000s0~F16602~NA650~M;\x80~K;" [] #5=[(*values*) ()]) untrace #function("8000r1c0e1~31u42;" [#function("9000ve0~316@0e1\x80e2~31b2[42;^;" [traced? set-top-level-value! function:vals]) top-level-value] untrace) traced? #function("8000r1e0~31e0\x8031>;" [function:code] [#function("\xb9000s0e0c1~K312c2~x2;" [println x #.apply]) ()]) trace #function("8000r1c0e1~31u322c2;" [#function("8000vc0e130u42;" [#function("?000ve0\x8031@6a0e1i10e2c3~c4c5c6c7i10L2~L3L2c8c7\x80L2~L3L3L33142;^;" [traced? set-top-level-value! eval lambda begin println cons quote apply]) gensym]) top-level-value ok] trace) to-proper #function("8000r1~A640~;~?660~L1;~Me0~N31K;" [to-proper] to-proper) table.values #function("9000r1e0c1_~43;" [table.foldl #function("7000r3\x7fg2K;" [])] table.values) table.pairs #function("9000r1e0c1_~43;" [table.foldl #function("7000r3~\x7fKg2K;" [])] table.pairs) table.keys #function("9000r1e0c1_~43;" [table.foldl #function("7000r3~g2K;" [])] table.keys) table.invert #function("8000r1c0e130u42;" [#function("9000ve0c1q_\x80332~;" [table.foldl #function("9000r3e0\x80\x7f~43;" [put!])]) table] table.invert) table.foreach #function("9000r2e0c1q_\x7f43;" [table.foldl #function("8000r3\x80~\x7f322];" [])] table.foreach) table.clone #function("8000r1c0e130u42;" [#function("9000ve0c1q_\x80332~;" [table.foldl #function("9000r3e0\x80~\x7f43;" [put!])]) table] table.clone) symbol-syntax #function("9000r1e0e1~^43;" [get *syntax-environment*] symbol-syntax) string.trim #function("9000r3c0^^u43;" [#function("8000vc0qm02c1qm12c2e3\x8031u42;" [#function(";000r4g2g3X16?02e0\x7fe1~g232326A0\x80~\x7fe2~g232g344;g2;" [string.find string.char string.inc] trim-start) #function("<000r3e0g2`3216D02e1\x7fe2~e3~g23232326?0\x81~\x7fe3~g23243;g2;" [> string.find string.char string.dec] trim-end) #function("<000ve0i10\x80i10i11`~34\x81i10i12~3343;" [string.sub]) length])] string.trim) string.tail #function(";000r2e0~e1~`\x7f3342;" [string.sub string.inc] string.tail) string.rpad #function("<000r3e0~e1g2\x7fe2~31z3242;" [string string.rep string.count] string.rpad) string.rep #function(";000r2\x7fb4X6`0e0\x7f`32650c1;\x7faW680e2~41;\x7fb2W690e2~~42;e2~~~43;e3\x7f316@0e2~e4~\x7faz3242;e4e2~~32\x7fb2U242;" [<= "" string odd? string.rep] string.rep) string.map #function("9000r2c0e130e2\x7f31u43;" [#function("8000vc0`u322e1~41;" [#function(";000v^~\x81X6S02e0\x80i10e1i11~3231322e2i11~32m05\x0b/;" [io.putc string.char string.inc]) io.tostring!]) buffer length] string.map) string.lpad #function(";000r3e0e1g2\x7fe2~31z32~42;" [string string.rep string.count] string.lpad) string.join #function("8000r2~A650c0;c1e230u42;" ["" #function("8000ve0~\x80M322e1c2q\x80N322e3~41;" [io.write for-each #function("8000r1e0\x80i11322e0\x80~42;" [io.write]) io.tostring!]) buffer] string.join) simple-sort #function("8000r1~A17602~NA640~;c0~Mu42;" [#function("9000vc0e1c2q\x80N32u42;" [#function(":000ve0e1~M31\x80L1e1~N3143;" [nconc simple-sort]) separate #function("7000r1~\x80X;" [])])] simple-sort) set-syntax! #function("9000r2e0e1~\x7f43;" [put! *syntax-environment*] set-syntax!) separate #function(":000r2\x80~\x7f__44;" [] #0=[#function(";000r4\x7fA680g2g3K;~\x7fM316@0\x80~\x7fN\x7fMg2Kg344;\x80~\x7fNg2\x7fMg3K44;" [] #0#) ()]) self-evaluating? #function("8000r1~?16602~C@17K02e0~3116A02~C16:02~e1~31<;" [constant? top-level-value] self-evaluating?) reverse! #function("8000r1c0_u42;" [#function("9000v^\x80F6C02\x80N\x80~\x80m02P2o005\x1c/2~;" [])] reverse!) reverse #function("9000r1e0e1_~43;" [foldl cons] reverse) revappend #function("8000r2e0e1~31\x7f42;" [nconc reverse] revappend) repl #function("9000r0c0^^u43;" [#function("6000vc0m02c1qm12\x7f302e240;" [#function("8000r0e0c1312e2e3312c4c5c6tu42;"\ No newline at end of file
+(zero? #function("7000r1~`W;" [] zero?) vector.map #function("8000r2c0e1\x7f31u42;" [#function("8000vc0e1~31u42;" [#function(":000v`\x80azc0qw2~;" [#function(":000r1\x80~i20i21~[31\\;" [])]) vector.alloc]) length] vector.map) vector->list #function("9000r1c0e1~31_u43;" [#function(":000va~c0qw2\x7f;" [#function("8000r1i10\x80~z[\x81Ko01;" [])]) length] vector->list) values #function("9000s0~F16602~NA650~M;\x80~K;" [] #5=[(*values*) ()]) untrace #function("8000r1c0e1~31u42;" [#function("9000ve0~316@0e1\x80e2~31b2[42;^;" [traced? set-top-level-value! function:vals]) top-level-value] untrace) traced? #function("8000r1e0~31e0\x8031>;" [function:code] [#function(":000s0e0c1~K312c2~x2;" [println x #.apply]) ()]) trace #function("8000r1c0e1~31u322c2;" [#function("8000vc0e130u42;" [#function("?000ve0\x8031@6a0e1i10e2c3~c4c5c6c7i10L2~L3L2c8c7\x80L2~L3L3L33142;^;" [traced? set-top-level-value! eval lambda begin println cons quote apply]) gensym]) top-level-value ok] trace) to-proper #function("8000r1~A640~;~?660~L1;~Me0~N31K;" [to-proper] to-proper) table.values #function("9000r1e0c1_~43;" [table.foldl #function("7000r3\x7fg2K;" [])] table.values) table.pairs #function("9000r1e0c1_~43;" [table.foldl #function("7000r3~\x7fKg2K;" [])] table.pairs) table.keys #function("9000r1e0c1_~43;" [table.foldl #function("7000r3~g2K;" [])] table.keys) table.invert #function("8000r1c0e130u42;" [#function("9000ve0c1q_\x80332~;" [table.foldl #function("9000r3e0\x80\x7f~43;" [put!])]) table] table.invert) table.foreach #function("9000r2e0c1q_\x7f43;" [table.foldl #function("8000r3\x80~\x7f322];" [])] table.foreach) table.clone #function("8000r1c0e130u42;" [#function("9000ve0c1q_\x80332~;" [table.foldl #function("9000r3e0\x80~\x7f43;" [put!])]) table] table.clone) symbol-syntax #function("9000r1e0e1~^43;" [get *syntax-environment*] symbol-syntax) string.trim #function("9000r3c0^^u43;" [#function("8000vc0qm02c1qm12c2e3\x8031u42;" [#function(";000r4g2g3X16?02e0\x7fe1~g232326A0\x80~\x7fe2~g232g344;g2;" [string.find string.char string.inc] trim-start) #function("<000r3e0g2`3216D02e1\x7fe2~e3~g23232326?0\x81~\x7fe3~g23243;g2;" [> string.find string.char string.dec] trim-end) #function("<000ve0i10\x80i10i11`~34\x81i10i12~3343;" [string.sub]) length])] string.trim) string.tail #function(";000r2e0~e1~`\x7f3342;" [string.sub string.inc] string.tail) string.rpad #function("<000r3e0~e1g2\x7fe2~31z3242;" [string string.rep string.count] string.rpad) string.rep #function(";000r2\x7fb4X6`0e0\x7f`32650c1;\x7faW680e2~41;\x7fb2W690e2~~42;e2~~~43;e3\x7f316@0e2~e4~\x7faz3242;e4e2~~32\x7fb2U242;" [<= "" string odd? string.rep] string.rep) string.map #function("9000r2c0e130e2\x7f31u43;" [#function("8000vc0`u322e1~41;" [#function(";000v^~\x81X6S02e0\x80i10e1i11~3231322e2i11~32m05\x0b/;" [io.putc string.char string.inc]) io.tostring!]) buffer length] string.map) string.lpad #function(";000r3e0e1g2\x7fe2~31z32~42;" [string string.rep string.count] string.lpad) string.join #function("8000r2~A650c0;c1e230u42;" ["" #function("8000ve0~\x80M322e1c2q\x80N322e3~41;" [io.write for-each #function("8000r1e0\x80i11322e0\x80~42;" [io.write]) io.tostring!]) buffer] string.join) simple-sort #function("8000r1~A17602~NA640~;c0~Mu42;" [#function("9000vc0e1c2q\x80N32u42;" [#function(":000ve0e1~M31\x80L1e1~N3143;" [nconc simple-sort]) separate #function("7000r1~\x80X;" [])])] simple-sort) set-syntax! #function("9000r2e0e1~\x7f43;" [put! *syntax-environment*] set-syntax!) separate #function(":000r2\x80~\x7f__44;" [] #0=[#function(";000r4\x7fA680g2g3K;~\x7fM316@0\x80~\x7fN\x7fMg2Kg344;\x80~\x7fNg2\x7fMg3K44;" [] #0#) ()]) self-evaluating? #function("8000r1~?16602~C@17K02e0~3116A02~C16:02~e1~31<;" [constant? top-level-value] self-evaluating?) reverse! #function("8000r1c0_u42;" [#function("9000v^\x80F6C02\x80N\x80~\x80m02P2o005\x1c/2~;" [])] reverse!) reverse #function("9000r1e0c1_~43;" [foldl #.cons] reverse) revappend #function("8000r2e0e1~31\x7f42;" [nconc reverse] revappend) repl #function("9000r0c0^^u43;" [#function("6000vc0m02c1qm12\x7f302e240;" [#function("8000r0e0c1312e2e3312c4c5c6tu42;" \ No newline at end of file
--- a/femtolisp/flisp.c
+++ b/femtolisp/flisp.c
@@ -578,12 +578,21 @@
gc(0);
}
+static void grow_stack()
+{+ size_t newsz = N_STACK + (N_STACK>>1);
+ value_t *ns = realloc(Stack, newsz*sizeof(value_t));
+ if (ns == NULL)
+ lerror(MemoryError, "stack overflow");
+ Stack = ns;
+ N_STACK = newsz;
+}
+
// utils ----------------------------------------------------------------------
// apply function with n args on the stack
static value_t _applyn(uint32_t n)
{- assert(n <= MAX_ARGS+1);
value_t f = Stack[SP-n-1];
uint32_t saveSP = SP;
value_t v;
@@ -607,10 +616,8 @@
PUSH(f);
while (iscons(v)) {- if ((SP-n-1) == MAX_ARGS) {- PUSH(v);
- break;
- }
+ if (SP >= N_STACK)
+ grow_stack();
PUSH(car_(v));
v = cdr_(v);
}
@@ -622,12 +629,13 @@
value_t applyn(uint32_t n, value_t f, ...)
{- assert(n <= MAX_ARGS);
va_list ap;
va_start(ap, f);
size_t i;
PUSH(f);
+ while (SP+n > N_STACK)
+ grow_stack();
for(i=0; i < n; i++) {value_t a = va_arg(ap, value_t);
PUSH(a);
@@ -644,6 +652,8 @@
uint32_t si = SP;
size_t i;
+ while (SP+n > N_STACK)
+ grow_stack();
for(i=0; i < n; i++) {value_t a = va_arg(ap, value_t);
PUSH(a);
@@ -715,7 +725,7 @@
c->cdr = tagptr(c+1, TAG_CONS);
c++;
}
- if (star || nargs > MAX_ARGS)
+ if (star)
(c-2)->cdr = (c-1)->car;
else
(c-1)->cdr = NIL;
@@ -805,18 +815,8 @@
#define DISPATCH goto dispatch
#endif
-static void grow_stack()
-{- size_t newsz = N_STACK + (N_STACK>>1);
- value_t *ns = realloc(Stack, newsz*sizeof(value_t));
- if (ns == NULL)
- lerror(MemoryError, "stack overflow");
- Stack = ns;
- N_STACK = newsz;
-}
-
/*
- stack on entry: <func> <up to MAX_ARGS args...> <arglist if nargs>MAX_ARGS>
+ stack on entry: <func> <nargs args...>
caller's responsibility:
- put the stack in this state
- provide arg count
@@ -886,18 +886,10 @@
NEXT_OP;
OP(OP_VARGC)
i = *ip++;
+ do_vargc:
s = (fixnum_t)nargs - (fixnum_t)i;
if (s > 0) {v = list(&Stack[bp+i], s);
- if (nargs > MAX_ARGS) {- if (s == 1) {- v = car_(v);
- }
- else {- c = (cons_t*)curheap;
- (c-2)->cdr = (c-1)->car;
- }
- }
Stack[bp+i] = v;
if (s > 1) {Stack[bp+i+1] = Stack[bp+nargs+0];
@@ -923,39 +915,17 @@
nargs = i+1;
NEXT_OP;
OP(OP_LARGC)
- OP(OP_LVARGC)
- // move extra arguments from list to stack
- i = GET_INT32(ip); ip+=4;
- e = Stack[curr_frame-5]; // cloenv
- n = Stack[curr_frame-4]; // prev curr_frame
- POPN(5);
- if (nargs > MAX_ARGS) {- v = POP(); // list of rest args
- nargs--;
- }
- else v = NIL;
- while (nargs < i) {- if (!iscons(v))
+ n = GET_INT32(ip); ip+=4;
+ if (nargs != n) {+ if (nargs > n)
+ lerror(ArgError, "apply: too many arguments");
+ else
lerror(ArgError, "apply: too few arguments");
- PUSH(car_(v));
- nargs++;
- v = cdr_(v);
}
- if (ip[-5] == OP_LVARGC) {- PUSH(v);
- nargs++;
- }
- else {- if (iscons(v))
- lerror(ArgError, "apply: too many arguments");
- }
- PUSH(e);
- PUSH(n);
- PUSH(nargs);
- SP++;//PUSH(0);
- PUSH(0);
- curr_frame = SP;
NEXT_OP;
+ OP(OP_LVARGC)
+ i = GET_INT32(ip); ip+=4;
+ goto do_vargc;
OP(OP_LET)
// last arg is closure environment to use
nargs--;
@@ -1166,15 +1136,10 @@
n = *ip++;
apply_apply:
v = POP(); // arglist
- if (n > MAX_ARGS) {- v = apply_liststar(v, 1);
- }
n = SP-(n-2); // n-2 == # leading arguments not in the list
while (iscons(v)) {- if (SP-n == MAX_ARGS) {- PUSH(v);
- break;
- }
+ if (SP >= N_STACK)
+ grow_stack();
PUSH(car_(v));
v = cdr_(v);
}
@@ -1187,7 +1152,6 @@
apply_add:
s = 0;
i = SP-n;
- if (n > MAX_ARGS) goto add_ovf;
for (; i < SP; i++) { if (isfixnum(Stack[i])) {s += numval(Stack[i]);
@@ -1265,13 +1229,11 @@
apply_mul:
accum = 1;
i = SP-n;
- if (n > MAX_ARGS) goto mul_ovf;
for (; i < SP; i++) { if (isfixnum(Stack[i])) {accum *= numval(Stack[i]);
}
else {- mul_ovf:
v = fl_mul_any(&Stack[i], SP-i, accum);
break;
}
@@ -1343,24 +1305,11 @@
OP(OP_VECTOR)
n = *ip++;
apply_vector:
- if (n > MAX_ARGS) {- i = llength(Stack[SP-1])-1;
- }
- else i = 0;
- v = alloc_vector(n+i, 0);
+ v = alloc_vector(n, 0);
if (n) {memcpy(&vector_elt(v,0), &Stack[SP-n], n*sizeof(value_t));
- e = POP();
- POPN(n-1);
+ POPN(n);
}
- if (n > MAX_ARGS) {- i = n-1;
- while (iscons(e)) {- vector_elt(v,i) = car_(e);
- i++;
- e = cdr_(e);
- }
- }
PUSH(v);
NEXT_OP;
@@ -1684,7 +1633,6 @@
break;
case OP_TAPPLY: case OP_APPLY:
- if (sp+MAX_ARGS+1 > maxsp) maxsp = sp+MAX_ARGS+1;
n = *ip++;
sp -= (n-1);
break;
@@ -1860,15 +1808,8 @@
fl_gc_handle(&lastcons);
uint32_t i=0;
while (1) {- if (i >= MAX_ARGS) {- lst = car_(args[MAX_ARGS]);
- args[MAX_ARGS] = cdr_(args[MAX_ARGS]);
- if (!iscons(args[MAX_ARGS])) break;
- }
- else {- lst = args[i++];
- if (i >= nargs) break;
- }
+ lst = args[i++];
+ if (i >= nargs) break;
if (iscons(lst)) {lst = FL_COPYLIST(lst);
if (first == NIL)
@@ -1893,10 +1834,6 @@
{if (nargs == 1) return args[0];
else if (nargs == 0) argcount("list*", nargs, 1);- if (nargs > MAX_ARGS) {- args[MAX_ARGS] = apply_liststar(args[MAX_ARGS], 1);
- return list(args, nargs);
- }
return _list(args, nargs, 1);
}
--- a/femtolisp/flisp.h
+++ b/femtolisp/flisp.h
@@ -102,22 +102,13 @@
void fl_gc_handle(value_t *pv);
void fl_free_gc_handles(int n);
-// maximum number of explicit arguments. the 128th arg is a list of rest args.
-// the largest value nargs can have is MAX_ARGS+1
-#define MAX_ARGS 127
-
#include "opcodes.h"
// utility for iterating over all arguments in a builtin
// i=index, i0=start index, arg = var for each arg, args = arg array
// assumes "nargs" is the argument count
-// modifies args[MAX_ARGS] when nargs==MAX_ARGS+1
-#define FOR_ARGS(i, i0, arg, args) \
- for(i=i0; (((size_t)i<nargs || \
- (i>MAX_ARGS && iscons(args[MAX_ARGS]))) && \
- ((i>=MAX_ARGS?(arg=car_(args[MAX_ARGS]), \
- args[MAX_ARGS]=cdr_(args[MAX_ARGS])) : \
- (arg = args[i])) || 1)); i++)
+#define FOR_ARGS(i, i0, arg, args) \
+ for(i=i0; ((size_t)i)<nargs && ((arg=args[i]) || 1); i++)
#define N_BUILTINS ((int)N_OPCODES)
--- a/femtolisp/iostream.c
+++ b/femtolisp/iostream.c
@@ -171,7 +171,7 @@
static void do_ioprint(value_t *args, u_int32_t nargs, char *fname)
{- if (nargs < 2 || nargs > MAX_ARGS)
+ if (nargs < 2)
argcount(fname, nargs, 2);
ios_t *s = toiostream(args[0], fname);
unsigned i;
--- a/femtolisp/system.lsp
+++ b/femtolisp/system.lsp
@@ -309,6 +309,11 @@
(or (and (pair? x) (or (eq (car x) '*comma-at*)
(eq (car x) '*comma-dot*)))
(eq x '*comma*)))
+ ; bracket without splicing
+ (define (bq-bracket1 x)
+ (if (and (pair? x) (eq (car x) '*comma*))
+ (cadr x)
+ (bq-process x)))
(cond ((self-evaluating? x)
(if (vector? x)
(let ((body (bq-process (vector->list x))))
@@ -344,12 +349,6 @@
((eq (car x) '*comma-at*) (list 'copy-list (cadr x)))
((eq (car x) '*comma-dot*) (cadr x))
(#t (list list (bq-process x)))))
-
-; bracket without splicing
-(define (bq-bracket1 x)
- (if (and (pair? x) (eq (car x) '*comma*))
- (cadr x)
- (bq-process x)))
; standard macros -------------------------------------------------------------
--- a/femtolisp/table.c
+++ b/femtolisp/table.c
@@ -84,8 +84,6 @@
value_t fl_table(value_t *args, uint32_t nargs)
{size_t cnt = (size_t)nargs;
- if (nargs > MAX_ARGS)
- cnt += (llength(args[MAX_ARGS])-1);
if (cnt & 1)
lerror(ArgError, "table: arguments must come in pairs");
value_t nt;
--- a/femtolisp/todo
+++ b/femtolisp/todo
@@ -1042,7 +1042,8 @@
* stack traces and better debugging support
- make maxstack calculation robust against invalid bytecode
* improve internal define
-- try removing MAX_ARGS trickery
+* try removing MAX_ARGS trickery
+- apply optimization, avoid redundant list copying calling vararg fns
- let eversion
* lambda lifting
* let optimization
--- a/femtolisp/unittest.lsp
+++ b/femtolisp/unittest.lsp
@@ -98,6 +98,8 @@
; long argument lists
(assert (= (apply + (iota 100000)) 4999950000))
+(define MAX_ARGS 255)
+
(define as (apply list* (map-int (lambda (x) (gensym)) (+ MAX_ARGS 1))))
(define f (compile `(lambda ,as ,(lastcdr as))))
(assert (equal? (apply f (iota (+ MAX_ARGS 0))) `()))