ref: 22bf74f3ba2d91944c38a542461c3349eb566ef5
parent: 169db4d362fbfcf10f77fe61a824906f7d413d78
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Sat Jan 4 19:11:42 EST 2025
sort out too many indirect void calls instead of loadvoid opcode
--- a/compiler.lsp
+++ b/compiler.lsp
@@ -474,12 +474,12 @@
(inlineable? x))
(compile-let g env tail? x)
(begin
- (if (not b)
- (begin (compile-in g env #f head)
- (bcode:stack g 1)))
+ (unless b
+ (compile-in g env #f head)
+ (bcode:stack g 1))
(let ((nargs (compile-arglist g env (cdr x))))
(bcode:stack g (- nargs))
- (if (not b) (bcode:stack g -1))
+ (unless b (bcode:stack g -1))
(if b
(compile-builtin-call g env tail? x head b nargs)
(emit g (if tail? 'tcall 'call) nargs)))))))))))
@@ -602,7 +602,7 @@
(body (if (cons? (cddr x))
(cddr x)
(if (symbol? form)
- `(,(void))
+ #.void
(error "compile error: invalid syntax " (print-to-string x))))))
(if (symbol? form)
`(#.void (set! ,form ,(car body)))
@@ -639,7 +639,7 @@
(if (null? V)
new-B
(cons `(λ ,V ,new-B)
- (map (λ (x) (void)) V)))))
+ (map void V)))))
(cond ((or (atom? e) (quoted? e))
e)
((eq? (car e) 'define)
--- a/flisp.boot
+++ b/flisp.boot
@@ -28,10 +28,9 @@
*output-stream* #fn(copy-list))) catch #fn("@000n220502112286e123242586e2262786e22829e2e3262:86e20e3e42;86e22<86e2e4e3e3:" #(#fn(gensym)
trycatch λ if and cons? eq? car quote thrown-value cadr caddr raise)) let* #fn("@000z10H3E02021e1qe12215153e1:2021e173051e1e1220=B3H02024e10=e12215153e1@301515375051e2:" #(#fn(nconc)
λ #fn(copy-list) caar let* cadar)) with-input-from #fn("<000z12021e1220e2e1e12315163:" #(#fn(nconc)
- with-bindings *input-stream* #fn(copy-list))) unless #fn("<000z1200O211Pe4:" #(if begin)) letrec #fn(">000z1202021e12273052e122240522515154e1222605262:" #(#fn(nconc)
+ with-bindings *input-stream* #fn(copy-list))) unless #fn("<000z1200O211Pe4:" #(if begin)) letrec #fn(">000z1202021e12273052e122240522515154e1227605262:" #(#fn(nconc)
λ #fn(map) car #fn("8000n12021e12205162:" #(#fn(nconc) set! #fn(copy-list)))
- #fn(copy-list) #fn("5000n17060:" #(void)))) /= #fn("=000z1202122e10e12315153e2:" #(not #fn(nconc)
- = #fn(copy-list))) time #fn(">000n12050218522e1e2e123024252622e185e32728e5e3e3:" #(#fn(gensym)
+ #fn(copy-list) void)) /= #fn("=000z1202122e10e12315153e2:" #(not #fn(nconc) = #fn(copy-list))) time #fn(">000n12050218522e1e2e123024252622e185e32728e5e3e3:" #(#fn(gensym)
let time-now prog1 princ "Elapsed time: " - " seconds" *linefeed*)) cond #fn(";000z0\x8d\x8a520852185>1_51485<061:" #(#0=#fn("7000z0\x8d:" #() void)
#fn(">000n10H340O:0<85<20Q;I80485<DQ3C085=J6085<:2185=P:85=J@02285<A<0=51e3:85T23C\x98074758551513c07675855151278685<e2e12886217975855151PA<0=51e4e3:2:50278685<e2e1288675855186e2A<0=51e4e3:2885<2185=PA<0=51e4:" #(else
begin or => 1arg-lambda? caddr caadr let if cddr #fn(gensym)) cond-clauses->if))) do #fn("J000z220501<2172052217305221240522587268927882829e12:1=51522829e12:82512887e18;52e153e4e3e2e12887e18:52e3:" #(#fn(gensym)
@@ -52,12 +51,9 @@
1+ #fn("6000n10KM:" #() 1+) 1-
#fn("6000n10K~:" #() 1-) 1arg-lambda? #fn("7000n10B;3E04700<51;3:04710TK62:" #(is-lambda?
length=) 1arg-lambda?)
- <= #fn("<000z1\x8d\x8a620862186>1_51486<0152S:" #(#0#
- #fn("7000n21J40O:1<0L2;IB040\x8e;I;04A<1<1=62:" #() f)) <=)
- > #fn("<000z1\x8d\x8a620862186>1_51486<0162:" #(#0#
- #fn("7000n21V;IE041<0L2;3;04A<1<1=62:" #() f)) >)
- >= #fn("<000z1\x8d\x8a620862186>1_51486<0152S:" #(#0#
- #fn("7000n21J40O:01<L2;IB040\x8e;I;04A<1<1=62:" #() f)) >=)
+ <= #fn(";000z1\x8d\x8a6862086>1_486<^10162:" #(#fn("7000n21V;IL041<0L2;I5040\x8e340O:A<1<1=62:" #())) <=)
+ > #fn(";000z1\x8d\x8a6862086>1_486<^10162:" #(#fn("7000n21V;IE041<0L2;3;04A<1<1=62:" #())) >)
+ >= #fn(";000z1\x8d\x8a6862086>1_486<^10162:" #(#fn("7000n21V;IL0401<L2;I5040\x8e340O:A<1<1=62:" #())) >=)
Instructions #table(call.l 81 trycatch 75 largc 79 loadg.l 68 aref2 23 box 90 cadr 36 argc 62 setg 71 load0 21 nan? 94 vector? 45 fixnum? 41 loadc0 17 loada0 0 div0 59 keyargs 89 call 5 loada.l 69 brt.l 50 sub2 78 add2 29 loadc.l 70 loadc 9 builtin? 43 set-car! 47 brt 25 ret 10 loadi8 66 tapply 77 loadvoid 93 loada1 1 shift 46 boolean? 39 atom? 24 cdr 13 brne.l 83 / 58 loadf 31 equal? 52 apply 54 dup 11 loadt 20 jmp.l 48 null? 38 not 35 = 60 set-cdr! 30 eq? 33 * 57 load1 27 bound? 42 brf 3 function? 44 box.l 91 < 28 brnn.l 84 jmp 16 loadv 2 for 76 lvargc 80 dummy_eof 95 + 55 brne 19 compare 61 neg 37 loadv.l 67 number? 40 vargc 74 brn 85 brbound 88 vector 63 loadc1 22 setg.l 72 cons? 18 brf.l 49 aref 92 symbol? 34 aset! 64 car 12 cons 32 tcall.l 82 - 56 brn.l 86 optargs 87 closure 14 pop 4 eqv? 51 list 53 seta 15 seta.l 73 brnn 26 loadnil 65 loadg 7 loada 8 tcall 6)
__init_globals #fn("5000n020w1422w3424w5476w7478w947:w;:" #(#fn("6000n0702161:" #(princ
"#;> ")) *prompt* "/" *directory-separator* "\n" *linefeed* *stdout* *output-stream* *stdin*
@@ -121,7 +117,7 @@
closure? #fn("6000n10\\;36040[S:" #() closure?) compile
#fn("8000n170q7105162:" #(compile-f lower-define) compile) compile-and #fn("<000n570018283D218467:" #(compile-short-circuit
brf) compile-and)
- compile-app #fn("E000n483<88R3U07088152IK088Z3E0218851[3;0218851@40887283=23523i07401O89544750K524760183=537508:U5247708237028@40298:63:89[;39047:8951892;Cf07089152I\\0212;517;d3P07<83r2523E07401O83T5447702;62:89B3P07=89<513F07>83513=07?01828364:8:IE07401O89544750K52@30O4760183=537508;U5248:I<0750r/52@30O48:3C07@018283898:8;67:770823702A@402B8;63:" #(in-env?
+ compile-app #fn("E000n483<88R3U07088152IK088Z3E0218851[3;0218851@40887283=23523i07401O89544750K524760183=537508:U5247708237028@40298:63:89[;39047:8951892;Cf07089152I\\0212;517;d3P07<83r2523E07401O83T5447702;62:89B3P07=89<513F07>83513=07?01828364:8:360O@B07401O89544750K524760183=537508;U5248:360O@90750r/5248:3C07@018283898:8;67:770823702A@402B8;63:" #(in-env?
#fn(top-level-value) length> 255 compile-in bcode:stack compile-arglist emit tcall.l call.l
builtin->instruction cadr length= is-lambda? inlineable? compile-let compile-builtin-call tcall
call) compile-app)
@@ -244,8 +240,8 @@
#fn("5000n20:" #() local-expansion-env) #fn("<000n20H3400:0<208615221A10>3873P087=B3I0A<87T0=f2F<72875115262:73051893>0A<890=f2162:87;I?0486RS;I60486Z3708860:8624C400:8625C:092<0162:8625C:092<0162:8626C:093<0162:8627C:094<0162:8860:" #(#fn(assq)
#fn(":000n0\x8d\x8a48420AF84>3_484<^19261:" #(#fn("8000n10H3400:0<H3700<@90A<0<F5292<0=51P:" #())))
caddr macrocall? quote λ define let-syntax) expand-in)) expand)
- expand-define #fn("@000n10T70051B3:070051@L085R3;07150e1@=07223740515285R3@025268586<e3e2:252685<2728e185=e129865185<54e3e2:" #(cddr
- void error "compile error: invalid syntax " print-to-string #1# set! #fn(nconc) λ #fn(copy-list)) expand-define)
+ expand-define #fn("@000n10T70051B3:070051@H085R37021@=07223740515285R3@021258586<e3e2:212585<2627e185=e128865185<54e3e2:" #(cddr
+ #1# error "compile error: invalid syntax " print-to-string set! #fn(nconc) λ #fn(copy-list)) expand-define)
extend-env #fn("8000n370182E530P:" #(vars-to-env) extend-env) filter
#fn("9000n2\x8d20210>1?65148601qe163:" #(#0#
#fn("8000n382\x8d1B3Q04A1<513?0821<qPN=?2@30O41=?1@\x0e/4=:" #() filter-)) filter)
@@ -296,10 +292,9 @@
load-process #fn("6000n170061:" #(eval) load-process) lookup-sym
#fn(";000n31J5020:1<2108752883808288P:7201=82KM63:" #(global #fn(assq) lookup-sym) lookup-sym)
lower-define #fn(";000n1\x8d2021?55140H;I804720513400:0<23C<0747505161:760<513K02728e10Te185051e17905164:2:74062:" #(#1#
- #fn("=000n170051B3N071051B3=02270051P@7073051@60745075855176855186J5087:278687e328298652P:" #(cddr
- cdddr begin caddr void get-defined-vars lower-define λ #fn(map)
- #fn("5000n17060:" #(void))) λ-body) quoted? define lower-define expand-define is-lambda? #fn(nconc)
- λ lastcdr #fn(map)) lower-define)
+ #fn("=000n170051B3N071051B3=02270051P@7073051@60745075855176855186J5087:278687e328748652P:" #(cddr
+ cdddr begin caddr void get-defined-vars lower-define λ #fn(map)) λ-body) quoted? define
+ lower-define expand-define is-lambda? #fn(nconc) λ lastcdr #fn(map)) lower-define)
macrocall? #fn("6000n10<R;3904700<61:" #(symbol-syntax) macrocall?) macroexpand-1
#fn("7000n10H3400:7005185390850=}2:0:" #(macrocall?) macroexpand-1) make-code-emitter
#fn("9000n0q2050EqEo5:" #(#fn(table)) make-code-emitter) make-label #fn("5000n12060:" #(#fn(gensym)) make-label)
binary files a/flisp.boot.builtin b/flisp.boot.builtin differ
--- a/system.lsp
+++ b/system.lsp
@@ -23,7 +23,7 @@
`((λ ,(map car binds)
,.(map (λ (b) `(set! ,@b)) binds)
,@body)
- ,.(map (λ (x) (void)) binds)))
+ ,.(map void binds)))
(define-macro (let binds . body)
(let ((lname #f))