making long argument lists more efficient
This commit is contained in:
parent
0278b152b8
commit
66c671bfee
|
@ -24,7 +24,7 @@
|
||||||
|
|
||||||
:closure :argc :vargc :trycatch :copyenv :let :for :tapply
|
:closure :argc :vargc :trycatch :copyenv :let :for :tapply
|
||||||
:add2 :sub2 :neg :largc :lvargc
|
:add2 :sub2 :neg :largc :lvargc
|
||||||
:loada0 :loada1 :loadc00 :loadc01
|
:loada0 :loada1 :loadc00 :loadc01 :call.l :tcall.l
|
||||||
|
|
||||||
dummy_t dummy_f dummy_nil]))
|
dummy_t dummy_f dummy_nil]))
|
||||||
(for 0 (1- (length keys))
|
(for 0 (1- (length keys))
|
||||||
|
@ -148,7 +148,7 @@
|
||||||
((number? nxt)
|
((number? nxt)
|
||||||
(case vi
|
(case vi
|
||||||
((:loadv.l :loadg.l :setg.l :loada.l :seta.l
|
((:loadv.l :loadg.l :setg.l :loada.l :seta.l
|
||||||
:largc :lvargc)
|
:largc :lvargc :call.l :tcall.l)
|
||||||
(io.write bcode (int32 nxt))
|
(io.write bcode (int32 nxt))
|
||||||
(set! i (+ i 1)))
|
(set! i (+ i 1)))
|
||||||
|
|
||||||
|
@ -306,22 +306,6 @@
|
||||||
(define (compile-or g env tail? forms)
|
(define (compile-or g env tail? forms)
|
||||||
(compile-short-circuit g env tail? forms #f :brt))
|
(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)
|
(define (compile-arglist g env lst)
|
||||||
(for-each (lambda (a)
|
(for-each (lambda (a)
|
||||||
(compile-in g env #f a))
|
(compile-in g env #f a))
|
||||||
|
@ -410,10 +394,10 @@
|
||||||
(top-level-value head)
|
(top-level-value head)
|
||||||
head)))
|
head)))
|
||||||
(if (length> (cdr x) 255)
|
(if (length> (cdr x) 255)
|
||||||
; argument count is a uint8, so for more than 255 arguments
|
; more than 255 arguments, need long versions of instructions
|
||||||
; we use apply on a list built from sublists that fit the limit
|
(begin (compile-in g env #f head)
|
||||||
(compile-in g env tail?
|
(let ((nargs (compile-arglist g env (cdr x))))
|
||||||
`(#.apply ,head ,(make-nested-arglist (cdr x) 255)))
|
(emit g (if tail? :tcall.l :call.l) nargs)))
|
||||||
(let ((b (and (builtin? head)
|
(let ((b (and (builtin? head)
|
||||||
(builtin->instruction head))))
|
(builtin->instruction head))))
|
||||||
(if (not b)
|
(if (not b)
|
||||||
|
@ -590,7 +574,7 @@
|
||||||
(princ (number->string (aref code i)))
|
(princ (number->string (aref code i)))
|
||||||
(set! i (+ i 1)))
|
(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)))
|
(princ (number->string (ref-int32-LE code i)))
|
||||||
(set! i (+ i 4)))
|
(set! i (+ i 4)))
|
||||||
|
|
||||||
|
|
File diff suppressed because one or more lines are too long
|
@ -1038,6 +1038,8 @@ static value_t apply_cl(uint32_t nargs)
|
||||||
NEXT_OP;
|
NEXT_OP;
|
||||||
}
|
}
|
||||||
type_error("apply", "function", func);
|
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_JMP) ip += (ptrint_t)GET_INT16(ip); NEXT_OP;
|
||||||
OP(OP_BRF)
|
OP(OP_BRF)
|
||||||
v = POP();
|
v = POP();
|
||||||
|
|
|
@ -25,7 +25,7 @@ enum {
|
||||||
|
|
||||||
OP_CLOSURE, OP_ARGC, OP_VARGC, OP_TRYCATCH, OP_COPYENV, OP_LET, OP_FOR,
|
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_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,
|
OP_BOOL_CONST_T, OP_BOOL_CONST_F, OP_THE_EMPTY_LIST,
|
||||||
|
|
||||||
|
@ -66,7 +66,8 @@ enum {
|
||||||
&&L_OP_LET, &&L_OP_FOR, \
|
&&L_OP_LET, &&L_OP_FOR, \
|
||||||
&&L_OP_TAPPLY, &&L_OP_ADD2, &&L_OP_SUB2, &&L_OP_NEG, &&L_OP_LARGC, \
|
&&L_OP_TAPPLY, &&L_OP_ADD2, &&L_OP_SUB2, &&L_OP_NEG, &&L_OP_LARGC, \
|
||||||
&&L_OP_LVARGC, \
|
&&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 \
|
#define VM_APPLY_LABELS \
|
||||||
|
|
|
@ -972,8 +972,6 @@ consolidated todo list as of 7/8:
|
||||||
- #+, #- reader macros
|
- #+, #- reader macros
|
||||||
- printing improvements: *print-big*, keep track of horiz. position
|
- printing improvements: *print-big*, keep track of horiz. position
|
||||||
per-stream so indenting works across print calls
|
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 c types
|
||||||
- remaining cvalues functions
|
- remaining cvalues functions
|
||||||
- finish ios
|
- finish ios
|
||||||
|
|
Loading…
Reference in New Issue