lassik
/
upscheme
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

adding return special form 

eliminating some unnecessary top-level bindings
adding opcodes add2, sub2, neg
This commit is contained in:
JeffBezanson 2009-04-26 22:19:32 +00:00
parent 0dc4c16276
commit de19e4f401
6 changed files with 173 additions and 145 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
femtolisp/compiler.lsp
View File

@ -24,7 +24,7 @@
:loadg :loada :loadc :loadg.l :loadg :loada :loadc :loadg.l
:setg :seta :setc :setg.l :setg :seta :setc :setg.l
:closure :trycatch :argc :vargc :close :let :for :tapply :closure :trycatch :argc :vargc :close :let :for :tapply :add2 :sub2 :neg
dummy_t dummy_f dummy_nil])) dummy_t dummy_f dummy_nil]))
@ -69,13 +69,14 @@
(define (make-label e) (gensym)) (define (make-label e) (gensym))
(define (mark-label e l) (emit e :label l)) (define (mark-label e l) (emit e :label l))
(define (count- f l n) (define (count f l)
(if (null? l) (define (count- f l n)
n (if (null? l)
(count- f (cdr l) (if (f (car l)) n
(+ n 1) (count- f (cdr l) (if (f (car l))
n)))) (+ n 1)
(define (count f l) (count- f l 0)) n))))
(count- f l 0))
(define (peephole c) c) (define (peephole c) c)
@ -147,22 +148,17 @@
(io.tostring! bcode)))) (io.tostring! bcode))))
(define (const-to-idx-vec e) (define (const-to-idx-vec e)
(let ((const-to-idx (aref e 1)) (let ((cvec (vector.alloc (aref e 2))))
(nconst (aref e 2))) (table.foreach (lambda (val idx) (aset! cvec idx val))
(let ((cvec (vector.alloc nconst))) (aref e 1))
(table.foreach (lambda (val idx) (aset! cvec idx val)) cvec))
const-to-idx)
cvec)))
(define (index-of item lst start) (define (index-of item lst start)
(cond ((null? lst) #f) (cond ((null? lst) #f)
((eq item (car lst)) start) ((eq? item (car lst)) start)
(#t (index-of item (cdr lst) (+ start 1))))) (else (index-of item (cdr lst) (+ start 1)))))
(define (in-env? s env) (define (in-env? s env) (any (lambda (e) (memq s e)) env))
(and (pair? env)
(or (memq s (car env))
(in-env? s (cdr env)))))
(define (lookup-sym s env lev arg?) (define (lookup-sym s env lev arg?)
(if (null? env) (if (null? env)
@ -185,17 +181,14 @@
(closed (emit g (aref Is 1) (cadr loc) (caddr loc))) (closed (emit g (aref Is 1) (cadr loc) (caddr loc)))
(else (emit g (aref Is 2) s))))) (else (emit g (aref Is 2) s)))))
(define (builtin->instruction b)
(let ((sym (intern (string #\: b))))
(and (has? Instructions sym) sym)))
(define (cond->if form) (define (cond->if form)
(cond-clauses->if (cdr form))) (cond-clauses->if (cdr form)))
(define (cond-clauses->if lst) (define (cond-clauses->if lst)
(if (atom? lst) (if (atom? lst)
#f #f
(let ((clause (car lst))) (let ((clause (car lst)))
(if (eq? (car clause) 'else) (if (or (eq? (car clause) 'else)
(eq? (car clause) #t))
(cons 'begin (cdr clause)) (cons 'begin (cdr clause))
`(if ,(car clause) `(if ,(car clause)
,(cons 'begin (cdr clause)) ,(cons 'begin (cdr clause))
@ -278,13 +271,13 @@
(define MAX_ARGS 127) (define MAX_ARGS 127)
(define (list-part- l n i subl acc)
(cond ((atom? l) (if (> i 0)
(cons (nreverse subl) acc)
acc))
((>= i n) (list-part- l n 0 () (cons (nreverse subl) acc)))
(else (list-part- (cdr l) n (+ 1 i) (cons (car l) subl) acc))))
(define (list-partition l n) (define (list-partition l n)
(define (list-part- l n i subl acc)
(cond ((atom? l) (if (> i 0)
(cons (nreverse subl) acc)
acc))
((>= i n) (list-part- l n 0 () (cons (nreverse subl) acc)))
(else (list-part- (cdr l) n (+ 1 i) (cons (car l) subl) acc))))
(if (<= n 0) (if (<= n 0)
(error "list-partition: invalid count") (error "list-partition: invalid count")
(nreverse (list-part- l n 0 () ())))) (nreverse (list-part- l n 0 () ()))))
@ -339,6 +332,10 @@
(emit g :close) (emit g :close)
(emit g (if tail? :tcall :call) (+ 1 nargs))))) (emit g (if tail? :tcall :call) (+ 1 nargs)))))
(define (builtin->instruction b)
(let ((sym (intern (string #\: b))))
(and (has? Instructions sym) sym)))
(define (compile-call g env tail? x) (define (compile-call g env tail? x)
(let ((head (car x))) (let ((head (car x)))
(let ((head (let ((head
@ -361,11 +358,13 @@
(argc-error head count)) (argc-error head count))
(case b ; handle special cases of vararg builtins (case b ; handle special cases of vararg builtins
(:list (if (= nargs 0) (emit g :loadnil) (emit g b nargs))) (:list (if (= nargs 0) (emit g :loadnil) (emit g b nargs)))
(:+ (if (= nargs 0) (emit g :load0) (:+ (cond ((= nargs 0) (emit g :load0))
(emit g b nargs))) ((= nargs 2) (emit g :add2))
(:- (if (= nargs 0) (else (emit g b nargs))))
(argc-error head 1) (:- (cond ((= nargs 0) (argc-error head 1))
(emit g b nargs))) ((= nargs 1) (emit g :neg))
((= nargs 2) (emit g :sub2))
(else (emit g b nargs))))
(:* (if (= nargs 0) (emit g :load1) (:* (if (= nargs 0) (emit g :load1)
(emit g b nargs))) (emit g b nargs)))
(:/ (if (= nargs 0) (:/ (if (= nargs 0)
@ -403,6 +402,8 @@
(or (compile-or g env tail? (cdr x))) (or (compile-or g env tail? (cdr x)))
(while (compile-while g env (cadr x) (cons 'begin (cddr x)))) (while (compile-while g env (cadr x) (cons 'begin (cddr x))))
(for (compile-for g env (cadr x) (caddr x) (cadddr x))) (for (compile-for g env (cadr x) (caddr x) (cadddr x)))
(return (compile-in g env #t (cadr x))
(emit g :ret))
(set! (compile-in g env #f (caddr x)) (set! (compile-in g env #f (caddr x))
(compile-sym g env (cadr x) [:seta :setc :setg])) (compile-sym g env (cadr x) [:seta :setc :setg]))
(trycatch (compile-in g env #f `(lambda () ,(cadr x))) (trycatch (compile-in g env #f `(lambda () ,(cadr x)))
@ -440,14 +441,19 @@
(define (hex5 n) (define (hex5 n)
(pad-l (number->string n 16) 5 #\0)) (pad-l (number->string n 16) 5 #\0))
(define (disassemble- f lev) (define (disassemble f . lev?)
(let ((fvec (function->vector f))) (if (null? lev?)
(begin (disassemble f 0)
(newline)
(return #t)))
(let ((fvec (function->vector f))
(lev (car lev?)))
(let ((code (aref fvec 0)) (let ((code (aref fvec 0))
(vals (aref fvec 1))) (vals (aref fvec 1)))
(define (print-val v) (define (print-val v)
(if (and (function? v) (not (builtin? v))) (if (and (function? v) (not (builtin? v)))
(begin (princ "\n") (begin (princ "\n")
(disassemble- v (+ lev 1))) (disassemble v (+ lev 1)))
(print v))) (print v)))
(let ((i 0) (let ((i 0)
(N (length code))) (N (length code)))
@ -488,6 +494,4 @@
(else #f)))))))) (else #f))))))))
(define (disassemble f) (disassemble- f 0) (newline))
#t #t

74
femtolisp/flisp.boot
View File

@ -41,7 +41,7 @@ splice-form?
set-syntax! set-syntax!
#function("n2d0d1e0e143;" [put! *syntax-environment*]) #function("n2d0d1e0e143;" [put! *syntax-environment*])
separate separate
#function("n2f00e0e1^^44;" [] #0=[#function("n4e1A6>0e2e3K;e0e1M316[0f00e0e1Ne1Me2Ke344;\\6r0f00e0e1Ne2e1Me3K44;];" [] #0#) ()]) #function("n2f00e0e1^^44;" [] #0=[#function("n4e1A6>0e2e3K;e0e1M316[0f00e0e1Ne1Me2Ke344;f00e0e1Ne2e1Me3K44;" [] #0#) ()])
reverse reverse
#function("n1d0d1^e043;" [foldl cons]) #function("n1d0d1^e043;" [foldl cons])
revappend revappend
@ -49,9 +49,9 @@ revappend
remainder remainder
#function("n2e0e0e1U2e1T2S2;" []) #function("n2e0e0e1U2e1T2S2;" [])
ref-uint32-LE ref-uint32-LE
#function("n2d0e0e1_R2Z_32d0e0e1`R2Za832d0e0e1a2R2Za@32d0e0e1a3R2ZaH32R4;" [ash]) #function("n2d0e0e1_tZ_32d0e0e1`tZa832d0e0e1a2tZa@32d0e0e1a3tZaH32R4;" [ash])
ref-uint16-LE ref-uint16-LE
#function("n2d0e0e1_R2Z_32d0e0e1`R2Za832R2;" [ash]) #function("n2d0e0e1_tZ_32d0e0e1`tZa832t;" [ash])
repl repl
#function("n0b0]]p43;" [#function("q3b0li02b1li12e1302d240;" [#function("n0d0b1312d2d3312b4b5lb6lmp42;" [princ "> " io.flush *output-stream* #function("q2d0d131@16I02b2d3e031p42;" [io.eof? *input-stream* #function("q2d0e0312e0h12\\;" [print that]) load-process]) #function("n0d040;" [read]) #function("n1d0d1312d2e041;" [io.discardbuffer *input-stream* raise])]) #function("n0b0lb1lm6G0d2302f0140;];" [#function("n0f003016@02d040;" [newline]) #function("n1d0e041;" [print-exception]) newline]) newline])]) #function("n0b0]]p43;" [#function("q3b0li02b1li12e1302d240;" [#function("n0d0b1312d2d3312b4b5lb6lmp42;" [princ "> " io.flush *output-stream* #function("q2d0d131@16I02b2d3e031p42;" [io.eof? *input-stream* #function("q2d0e0312e0h12\\;" [print that]) load-process]) #function("n0d040;" [read]) #function("n1d0d1312d2e041;" [io.discardbuffer *input-stream* raise])]) #function("n0b0lb1lm6G0d2302f0140;];" [#function("n0f003016@02d040;" [newline]) #function("n1d0e041;" [print-exception]) newline]) newline])])
self-evaluating? self-evaluating?
@ -91,21 +91,19 @@ nestlist
newline newline
#function("n0d0d1312\\;" [princ *linefeed*]) #function("n0d0d1312\\;" [princ *linefeed*])
memv memv
#function("n2e1?6:0];e1Me0=6F0e1;\\6T0d0e0e1N42;];" [memv]) #function("n2e1?6:0];e1Me0=6F0e1;d0e0e1N42;" [memv])
mod mod
#function("n2e0e0e1U2e1T2S2;" []) #function("n2e0e0e1U2e1T2S2;" [])
member member
#function("n2e1?6:0];e1Me0>6F0e1;\\6T0d0e0e1N42;];" [member]) #function("n2e1?6:0];e1Me0>6F0e1;d0e0e1N42;" [member])
mark-label mark-label
#function("n2d0e0d1e143;" [emit :label]) #function("n2d0e0d1e143;" [emit :label])
map! map!
#function("n2e1]e1F6O02e1e0e1M31O2e1Ni15502;" []) #function("n2e1]e1F6O02e1e0e1M31O2e1Ni15502;" [])
map-int map-int
#function("n2d0e1_326>0^;b1e0_31^K^p43;" [<= #function("q3e0i12`f01`S2b0lr2e0;" [#function("n1f01f10e031^KP2f01Nj01;" [])])]) #function("n2d0e1_326>0^;b1e0_31^K^p43;" [<= #function("q3e0i12`f01`S2b0lr2e0;" [#function("n1f01f10e031^KP2f01Nj01;" [])])])
mapcar
#function("o1f00e0e142;" [] #0=[#function("n2e1A6=0e040;e1M?6H0e1M;\\6h0e0d0d1e132Qf00e0d0d2e13232K;];" [map car cdr] #0#) ()])
make-system-image make-system-image
#function("n1b0d1e0d2d3d434b5p43;" [#function("q3d0b1ld230322d3e041;" [for-each #function("n1e0E16m02d0e031@16m02d1e031G@16m02d2e0f0132@16m02d3d1e03131@6\x9c0d4f00e0322d5f00b6322d4f00d1e031322d5f00b642;];" [constant? top-level-value memq iostream? io.print io.write "\n"]) environment io.close]) file :write :create :truncate (*linefeed* *directory-separator* *argv* that *print-pretty* *print-width*)]) #function("n1b0d1e0d2d3d434b5d6p44;" [#function("q4]h02b1lb2lmd3e0312e2h02;" [*print-pretty* #function("n0d0b1ld23042;" [for-each #function("n1e0E16m02d0e031@16m02d1e031G@16m02d2e0f0132@16m02d3d1e03131@6\x9c0d4f00e0322d5f00b6322d4f00d1e031322d5f00b642;];" [constant? top-level-value memq iostream? io.print io.write "\n"]) environment]) #function("n1d0f00312f02h12d2e041;" [io.close *print-pretty* raise]) io.close]) file :write :create :truncate (*linefeed* *directory-separator* *argv* that *print-pretty* *print-width*) *print-pretty*])
make-enum-table make-enum-table
#function("n2b0d130p42;" [#function("q2_d0d1f013131b2lr;" [1- length #function("n1d0f00f11e0Zf10e0R243;" [put!])]) table]) #function("n2b0d130p42;" [#function("q2_d0d1f013131b2lr;" [1- length #function("n1d0f00f11e0Zf10e0R243;" [put!])]) table])
macroexpand-1 macroexpand-1
@ -124,8 +122,8 @@ make-label
#function("n1d040;" [gensym]) #function("n1d040;" [gensym])
map map
#function("n2e1?6;0e1;e0e1M31d0e0e1N32K;" [map]) #function("n2e1?6;0e1;e0e1M31d0e0e1N32K;" [map])
listp mapcar
#function("n1e0A17=02e0F;" []) #function("o1f00e0e142;" [] #0=[#function("n2e1A6=0e040;e1M?6H0e1M;e0d0d1e132Qf00e0d0d2e13232K;" [map car cdr] #0#) ()])
load load
#function("n1b0d1e0d232p42;" [#function("q2b0lb1lm;" [#function("n0b0]p32]]]43;" [#function("q2b0li0;" [#function("n3d0f1031@6R0f00d1f1031e0d2e13143;d3f10312d2e141;" [io.eof? read load-process io.close])])]) #function("n1d0f00312d1b2f10e0L341;" [io.close raise load-error])]) file :read]) #function("n1b0d1e0d232p42;" [#function("q2b0lb1lm;" [#function("n0b0]p32]]]43;" [#function("q2b0li0;" [#function("n3d0f1031@6R0f00d1f1031e0d2e13143;d3f10312d2e141;" [io.eof? read load-process io.close])])]) #function("n1d0f00312d1b2f10e0L341;" [io.close raise load-error])]) file :read])
list-tail list-tail
@ -138,10 +136,8 @@ list*
#function("o0e0N?6=0e0M;e0Md0e0NQK;" [list*]) #function("o0e0N?6=0e0M;e0Md0e0NQK;" [list*])
list->vector list->vector
#function("n1d0e0s;" [vector]) #function("n1d0e0s;" [vector])
list-part-
#function("n5e0?6O0d0e2_326L0d1e331e4K;e4;d2e2e1326n0d3e0e1_^d1e331e4K45;d3e0Ne1`e2R2e0Me3Ke445;" [> nreverse >= list-part-])
list-partition list-partition
#function("n2d0e1_326C0d1b241;d3d4e0e1_^^3541;" [<= error "list-partition: invalid count" nreverse list-part-]) #function("n2b0]p42;" [#function("q2b0li02d1f01_326J0d2b341;d4e0f00f01_^^3541;" [#function("n5e0?6O0d0e2_326L0d1e331e4K;e4;d2e2e1326o0f00e0e1_^d1e331e4K45;f00e0Ne1`e2R2e0Me3Ke445;" [> nreverse >=]) <= error "list-partition: invalid count" nreverse])])
list? list?
#function("n1e0A17I02e0F16I02d0e0N41;" [list?]) #function("n1e0A17I02e0F16I02d0e0N41;" [list?])
load-process load-process
@ -153,7 +149,7 @@ length=
lastcdr lastcdr
#function("n1e0?6;0e0;d0e0N41;" [lastcdr]) #function("n1e0?6;0e0;d0e0N41;" [lastcdr])
last-pair last-pair
#function("n1e0?6;0e0;e0N?6E0e0;\\6Q0d0e0N41;];" [last-pair]) #function("n1e0?6;0e0;e0N?6E0e0;d0e0N41;" [last-pair])
iota iota
#function("n1d0d1e042;" [map-int identity]) #function("n1d0d1e042;" [map-int identity])
just-compile-args just-compile-args
@ -161,13 +157,13 @@ just-compile-args
io.readline io.readline
#function("n1d0e0b142;" [io.readuntil #\x000a]) #function("n1d0e0b142;" [io.readuntil #\x000a])
in-env? in-env?
#function("n2e1F16Q02d0e0e1M3217Q02d1e0e1N42;" [memq in-env?]) #function("n2d0b1le142;" [any #function("n1d0f00e042;" [memq])])
hex5 hex5
#function("n1d0d1e0a@32a5b243;" [pad-l number->string #\0]) #function("n1d0d1e0a@32a5b243;" [pad-l number->string #\0])
identity identity
#function("n1e0;" []) #function("n1e0;" [])
index-of index-of
#function("n3e1A6:0];e0e1M<6F0e2;\\6Y0d0e0e1Ne2`R243;];" [index-of]) #function("n3e1A6:0];e0e1M<6F0e2;d0e0e1Ne2`R243;" [index-of])
get-defined-vars get-defined-vars
#function("n1d0f00e03141;" [delete-duplicates] #0=[#function("n1e0?6:0^;e0Mb0<16I02e0NF6\x8c0d1e031C16`02d1e031L117\x8b02d1e031F16\x8502d2e031C16\x8502d2e031L117\x8b02^;e0Mb3<6\xa30d4d5f00e0N32s;^;" [define cadr caadr begin append map] #0#) ()]) #function("n1d0f00e03141;" [delete-duplicates] #0=[#function("n1e0?6:0^;e0Mb0<16I02e0NF6\x8c0d1e031C16`02d1e031L117\x8b02d1e031F16\x8502d2e031C16\x8502d2e031L117\x8b02^;e0Mb3<6\xa30d4d5f00e0N32s;^;" [define cadr caadr begin append map] #0#) ()])
for-each for-each
@ -177,9 +173,9 @@ foldr
foldl foldl
#function("n3e2A6;0e1;d0e0e0e2Me132e2N43;" [foldl]) #function("n3e2A6;0e1;d0e0e0e2Me132e2N43;" [foldl])
filter filter
#function("n2f00e0e1^43;" [] #0=[#function("n3e1A6;0e2;e0e1M316V0f00e0e1Ne1Me2K43;\\6g0f00e0e1Ne243;];" [] #0#) ()]) #function("n2f00e0e1^43;" [] #0=[#function("n3e1A6;0e2;e0e1M316V0f00e0e1Ne1Me2K43;f00e0e1Ne243;" [] #0#) ()])
f-body f-body
#function("n1b0f00e031p42;" [#function("q2b0d1e031p42;" [#function("q2e0A6<0f00;b0e0f00L3d1b2le032K;" [lambda map #function("n1];" [])]) get-defined-vars])] [#function("n1e0?6:0];e0N^<6F0e0M;\\6P0b0e0K;];" [begin]) ()]) #function("n1b0f00e031p42;" [#function("q2b0d1e031p42;" [#function("q2e0A6<0f00;b0e0f00L3d1b2le032K;" [lambda map #function("n1];" [])]) get-defined-vars])] [#function("n1e0?6:0];e0N^<6F0e0M;b0e0K;" [begin]) ()])
expand expand
#function("n1d0e041;" [macroexpand]) #function("n1d0e041;" [macroexpand])
every every
@ -198,24 +194,20 @@ emit
#function("o2d0e1b1326I0b2e0`Zp325J0]2e0_d3e1e2Ke0_Z32[2e0;" [memq (:loadv :loadg :setg) #function("q2b0f00a2Zp42;" [#function("q2b0f12Mp42;" [#function("q2b0d1f10e0326L0d2f10e0325i0d3f10e0f00332f00`R2j002f00`S2p42;" [#function("q2f30a2f10[2e0L1j322d0e0b1326[0b2f31p32j31;];" [>= 256 #function("q2e0d0=6=0d1;e0d2=6H0d3;e0d4=6S0d5;];" [:loadv :loadv.l :loadg :loadg.l :setg :setg.l])]) has? get put!])])]) nreconc]) #function("o2d0e1b1326I0b2e0`Zp325J0]2e0_d3e1e2Ke0_Z32[2e0;" [memq (:loadv :loadg :setg) #function("q2b0f00a2Zp42;" [#function("q2b0f12Mp42;" [#function("q2b0d1f10e0326L0d2f10e0325i0d3f10e0f00332f00`R2j002f00`S2p42;" [#function("q2f30a2f10[2e0L1j322d0e0b1326[0b2f31p32j31;];" [>= 256 #function("q2e0d0=6=0d1;e0d2=6H0d3;e0d4=6S0d5;];" [:loadv :loadv.l :loadg :loadg.l :setg :setg.l])]) has? get put!])])]) nreconc])
display display
#function("n1d0e0312\\;" [princ]) #function("n1d0e0312\\;" [princ])
disassemble-
#function("n2b0d1e031p42;" [#function("q2b0e0_Ze0`Zp43;" [#function("q3b0]p42;" [#function("q2b0li02b1_d2f0031p43;" [#function("n1e0J16>02e0G@6U0d0b1312d2e0f31`R242;d3e041;" [princ "\n" disassemble- print]) #function("q3]e0e1W6P02b0d1d2f10e0Z32p32530;" [#function("q2d0f00_326D0d1305E0]2_f41`S2b2lr2d3d4f0031b5d6d7e031`32b8342f00`R2j002b9e0p42;" [> newline #function("n1d0b141;" [princ "\t"]) princ hex5 ": " string.tail string "\t" #function("q2d0e0b1326\\0f20f31d2f30f1032Z312f10a4R2j10;d0e0b3326\x820f20f31f30f10ZZ312f10`R2j10;d0e0b4326\xa70d5d6f30f10Z31312f10`R2j10;d0e0b7326\xe80d5d6f30f10Z31b8322f10`R2j102d5d6f30f10Z31312f10`R2j10;d0e0b9326\x130d5b:d;d<f30f103231322f10a2R2j10;d0e0b=326>1d5b:d;d2f30f103231322f10a4R2j10;];" [memv (:loadv.l :loadg.l :setg.l) ref-uint32-LE (:loadv :loadg :setg) (:loada :seta :call :tcall :list :+ :- :* :/ :vector :argc :vargc :loadi8 :let) princ number->string (:loadc :setc) " " (:jmp :brf :brt) "@" hex5 ref-uint16-LE (:jmp.l :brf.l :brt.l)])]) get 1/Instructions]) length])])]) function->vector])
disassemble disassemble
#function("n1d0e0_322d140;" [disassemble- newline]) #function("o1e1A6J0d0e0_322d1302\\;5K0]2b2d3e031e1Mp43;" [disassemble newline #function("q3b0e0_Ze0`Zp43;" [#function("q3b0]p42;" [#function("q2b0li02b1_d2f0031p43;" [#function("n1e0J16>02e0G@6T0d0b1312d2e0f21`t42;d3e041;" [princ "\n" disassemble print]) #function("q3]e0e1W6P02b0d1d2f10e0Z32p32530;" [#function("q2d0f00_326D0d1305E0]2_f31`ub2lr2d3d4f0031b5d6d7e031`32b8342f00`tj002b9e0p42;" [> newline #function("n1d0b141;" [princ "\t"]) princ hex5 ": " string.tail string "\t" #function("q2d0e0b1326[0f20f31d2f30f1032Z312f10a4tj10;d0e0b3326\x800f20f31f30f10ZZ312f10`tj10;d0e0b4326\xa40d5d6f30f10Z31312f10`tj10;d0e0b7326\xe30d5d6f30f10Z31b8322f10`tj102d5d6f30f10Z31312f10`tj10;d0e0b9326\x0d0d5b:d;d<f30f103231322f10a2tj10;d0e0b=32671d5b:d;d2f30f103231322f10a4tj10;];" [memv (:loadv.l :loadg.l :setg.l) ref-uint32-LE (:loadv :loadg :setg) (:loada :seta :call :tcall :list :+ :- :* :/ :vector :argc :vargc :loadi8 :let) princ number->string (:loadc :setc) " " (:jmp :brf :brt) "@" hex5 ref-uint16-LE (:jmp.l :brf.l :brt.l)])]) get 1/Instructions]) length])])]) function->vector])
delete-duplicates delete-duplicates
#function("n1e0?6;0e0;b0e0Me0Np43;" [#function("q3d0e0e1326D0d1e141;e0d1e131K;" [member delete-duplicates])]) #function("n1e0?6;0e0;b0e0Me0Np43;" [#function("q3d0e0e1326D0d1e141;e0d1e131K;" [member delete-duplicates])])
count-
#function("n3e1A6;0e2;d0e0e1Ne0e1M316T0e2`R25V0e243;" [count-])
copy-tree copy-tree
#function("n1e0?6;0e0;d0e0M31d0e0N31K;" [copy-tree]) #function("n1e0?6;0e0;d0e0M31d0e0N31K;" [copy-tree])
count count
#function("n2d0e0e1_43;" [count-]) #function("n2b0]p42;" [#function("q2b0li02e0f00f01_43;" [#function("n3e1A6;0e2;f00e0e1Ne0e1M316U0e2`R25W0e243;" [])])])
copy-list copy-list
#function("n1e0?6;0e0;e0Md0e0N31K;" [copy-list]) #function("n1e0?6;0e0;e0Md0e0N31K;" [copy-list])
const-to-idx-vec const-to-idx-vec
#function("n1b0e0`Ze0a2Zp43;" [#function("q3b0d1e131p42;" [#function("q2d0b1lf00322e0;" [table.foreach #function("n2f00e1e0[;" [])]) vector.alloc])]) #function("n1b0d1e0a2Z31p42;" [#function("q2d0b1lf00`Z322e0;" [table.foreach #function("n2f00e1e0[;" [])]) vector.alloc])
cond-clauses->if cond-clauses->if
#function("n1e0?6:0];b0e0Mp42;" [#function("q2e0Mb0<6B0b1e0NK;b2e0Mb1e0NKd3f00N31L4;" [else begin if cond-clauses->if])]) #function("n1e0?6:0];b0e0Mp42;" [#function("q2e0Mb0<17B02e0M\\<6L0b1e0NK;b2e0Mb1e0NKd3f00N31L4;" [else begin if cond-clauses->if])])
compile-while compile-while
#function("n4b0d1e031d1e031p43;" [#function("q3d0f00f01]]342d1f00e0322d0f00f01]f02342d2f00d3e1332d2f00d4322d0f00f01]f03342d2f00d5e0332d1f00e142;" [compile-in mark-label emit :brf :pop :jmp]) make-label]) #function("n4b0d1e031d1e031p43;" [#function("q3d0f00f01]]342d1f00e0322d0f00f01]f02342d2f00d3e1332d2f00d4322d0f00f01]f03342d2f00d5e0332d1f00e142;" [compile-in mark-label emit :brf :pop :jmp]) make-label])
cond->if cond->if
@ -237,21 +229,21 @@ compile-if
compile-for compile-for
#function("n5d0e4316h0d1e0e1]e2342d1e0e1]e3342d1e0e1]e4342d2e0d342;d4b541;" [1arg-lambda? compile-in emit :for error "for: third form must be a 1-argument lambda"]) #function("n5d0e4316h0d1e0e1]e2342d1e0e1]e3342d1e0e1]e4342d2e0d342;d4b541;" [1arg-lambda? compile-in emit :for error "for: third form must be a 1-argument lambda"])
compile-call compile-call
#function("n4b0e3Mp42;" [#function("q2b0e0C16e02d1e0f0132@16e02e0E16e02d2e03116e02d3e031G6q0d3e0315s0e0p42;" [#function("q2b0e0G16B02d1e031p42;" [#function("q2e0@6I0d0f20f21]f00345J0]2b1d2f20f21f23N33p42;" [compile-in #function("q2f006H0b0d1d2f00]33p42;d3f30f326X0d45Z0d5e043;" [#function("q2e016D02d0f43Ne032@6S0d1f20e0325T0]2b2f10p42;" [length= argc-error #function("q2e0d0=6Z0f10_V6L0d1f50d242;d1f50f20f1043;e0d3=6\x820f10_V6t0d1f50d442;d1f50f20f1043;e0d5=6\xa90f10_V6\x9b0d6f30`42;d1f50f20f1043;e0d7=6\xd10f10_V6\xc30d1f50d842;d1f50f20f1043;e0d9=6\xf80f10_V6\xea0d6f30`42;d1f50f20f1043;e0d:=6\"0f10_V6\x140d1f50d;b<43;d1f50f20f1043;d1f50f5216512f20d=<6=1d>5@1f2042;" [:list emit :loadnil :+ :load0 :- argc-error :* :load1 :/ :vector :loadv [] :apply :tapply])]) get arg-counts emit :tcall :call]) compile-arglist]) builtin->instruction]) in-env? constant? top-level-value])]) #function("n4b0e3Mp42;" [#function("q2b0e0C16e02d1e0f0132@16e02e0E16e02d2e03116e02d3e031G6q0d3e0315s0e0p42;" [#function("q2b0e0G16B02d1e031p42;" [#function("q2e0@6I0d0f20f21]f00345J0]2b1d2f20f21f23N33p42;" [compile-in #function("q2f006H0b0d1d2f00]33p42;d3f30f326X0d45Z0d5e043;" [#function("q2e016D02d0f43Ne032@6S0d1f20e0325T0]2b2f10p42;" [length= argc-error #function("q2e0d0=6Z0f10_V6L0d1f50d242;d1f50f20f1043;e0d3=6\x950f10_V6t0d1f50d442;f10a2V6\x870d1f50d542;d1f50f20f1043;e0d6=6\xe10f10_V6\xae0d7f30`42;f10`V6\xc00d1f50d842;f10a2V6\xd30d1f50d942;d1f50f20f1043;e0d:=6\x090f10_V6\xfb0d1f50d;42;d1f50f20f1043;e0d<=601f10_V6\"0d7f30`42;d1f50f20f1043;e0d==6Z1f10_V6L1d1f50d>b?43;d1f50f20f1043;d1f50f5216m12f20d@<6u1dA5x1f2042;" [:list emit :loadnil :+ :load0 :add2 :- argc-error :neg :sub2 :* :load1 :/ :vector :loadv [] :apply :tapply])]) get arg-counts emit :tcall :call]) compile-arglist]) builtin->instruction]) in-env? constant? top-level-value])])
compile-begin compile-begin
#function("n4e3?6D0d0e0e1e2]44;e3N?6Y0d0e0e1e2e3M44;d0e0e1]e3M342d1e0d2322d3e0e1e2e3N44;" [compile-in emit :pop compile-begin]) #function("n4e3?6D0d0e0e1e2]44;e3N?6Y0d0e0e1e2e3M44;d0e0e1]e3M342d1e0d2322d3e0e1e2e3N44;" [compile-in emit :pop compile-begin])
compile-and compile-and
#function("n4d0e0e1e2e3\\d146;" [compile-short-circuit :brf]) #function("n4d0e0e1e2e3\\d146;" [compile-short-circuit :brf])
compile
#function("n1d0^e042;" [compile-f])
compile-app compile-app
#function("n4b0e3Mp42;" [#function("q2e0F16O02e0Mb0<16O02d1d2e031316c0d3f00f01f02f0344;d4f00f01f02f0344;" [lambda list? cadr compile-let compile-call])]) #function("n4b0e3Mp42;" [#function("q2e0F16O02e0Mb0<16O02d1d2e031316c0d3f00f01f02f0344;d4f00f01f02f0344;" [lambda list? cadr compile-let compile-call])])
compile
#function("n1d0^e042;" [compile-f])
compile-arglist compile-arglist
#function("n3b0d1e2d232p42;" [#function("q2e06i0d0f00d1f02d232f01332b3d4d5b6ld7e0d23232Kp322d2`R2;d0f00f02f01332d8f0241;" [just-compile-args list-head MAX_ARGS #function("q2d0f10f11]e044;" [compile-in]) nconc map #function("n1d0e0K;" [list]) list-partition length]) length> MAX_ARGS]) #function("n3b0d1e2d232p42;" [#function("q2e06i0d0f00d1f02d232f01332b3d4d5b6ld7e0d23232Kp322d2`R2;d0f00f02f01332d8f0241;" [just-compile-args list-head MAX_ARGS #function("q2d0f10f11]e044;" [compile-in]) nconc map #function("n1d0e0K;" [list]) list-partition length]) length> MAX_ARGS])
compile-f compile-f
#function("o2b0d130d2e131p43;" [#function("q3f02A@6O0d0e0d1d2d3e13131335\x820d4e131A6j0d0e0d5d3e131335\x820d0e0d6e1?6z0_5\x800d3e131332d7e0d8e131f00K\\d9f0131342d0e0d:322d;d<e0_Z31d=e03142;" [emit :let 1+ length lastcdr :argc :vargc compile-in to-proper caddr :ret function encode-byte-code const-to-idx-vec]) make-code-emitter cadr]) #function("o2b0d130d2e131p43;" [#function("q3f02A@6O0d0e0d1d2d3e13131335\x820d4e131A6j0d0e0d5d3e131335\x820d0e0d6e1?6z0_5\x800d3e131332d7e0d8e131f00K\\d9f0131342d0e0d:322d;d<e0_Z31d=e03142;" [emit :let 1+ length lastcdr :argc :vargc compile-in to-proper caddr :ret function encode-byte-code const-to-idx-vec]) make-code-emitter cadr])
compile-in compile-in
#function("n4e3C6E0d0e0e1e3b144;e3?6\xd10e3_<6[0d2e0d342;e3`<6k0d2e0d442;e3\\<6{0d2e0d542;e3]<6\x8b0d2e0d642;e3^<6\x9b0d2e0d742;e3I16\xb802d8e3a\xb03216\xb802d9e3a\xaf326\xc60d2e0d:e343;d2e0d;e343;b<e3Mp42;" [compile-sym [:loada :loadc :loadg] emit :load0 :load1 :loadt :loadf :loadnil >= <= :loadi8 :loadv #function("q2e0b0=6K0d1f00d2d3f033143;e0b4=6h0d5f00f01f02d6f033144;e0b7=6\x810d8f00f01f02f0344;e0b9=6\x9b0d:f00f01f02f03N44;e0b;=6\xb10d<f00f01f0343;e0b==6\xd70d1f00d2d>f01f0332332d1f00d?42;e0b@=6\xf10dAf00f01f02f03N44;e0bB=6\x0b0dCf00f01f02f03N44;e0bD=6/0dEf00f01d3f0331b9dFf0331K44;e0bG=6W1dHf00f01d3f0331dIf0331dJf033145;e0bK=6\x861d5f00f01]dIf0331342dLf00f01d3f0331bM44;e0bN=6\xdc1d5f00f01]b=^d3f0331L3342dOdIf0331316\xb81]5\xbe1dPbQ312d5f00f01]dIf0331342d1f00dR42;dSf00f01f02f0344;" [quote emit :loadv cadr cond compile-in cond->if if compile-if begin compile-begin prog1 compile-prog1 lambda compile-f :closure and compile-and or compile-or while compile-while cddr for compile-for caddr cadddr set! compile-sym [:seta :setc :setg] trycatch 1arg-lambda? error "trycatch: second form must be a 1-argument lambda" :trycatch compile-app])]) #function("n4e3C6E0d0e0e1e3b144;e3?6\xd10e3_<6[0d2e0d342;e3`<6k0d2e0d442;e3\\<6{0d2e0d542;e3]<6\x8b0d2e0d642;e3^<6\x9b0d2e0d742;e3I16\xb802d8e3a\xb03216\xb802d9e3a\xaf326\xc60d2e0d:e343;d2e0d;e343;b<e3Mp42;" [compile-sym [:loada :loadc :loadg] emit :load0 :load1 :loadt :loadf :loadnil >= <= :loadi8 :loadv #function("q2e0b0=6K0d1f00d2d3f033143;e0b4=6h0d5f00f01f02d6f033144;e0b7=6\x810d8f00f01f02f0344;e0b9=6\x9b0d:f00f01f02f03N44;e0b;=6\xb10d<f00f01f0343;e0b==6\xd70d1f00d2d>f01f0332332d1f00d?42;e0b@=6\xf10dAf00f01f02f03N44;e0bB=6\x0b0dCf00f01f02f03N44;e0bD=6/0dEf00f01d3f0331b9dFf0331K44;e0bG=6W1dHf00f01d3f0331dIf0331dJf033145;e0bK=6|1d5f00f01\\d3f0331342d1f00dL42;e0bM=6\xab1d5f00f01]dIf0331342dNf00f01d3f0331bO44;e0bP=6\x011d5f00f01]b=^d3f0331L3342dQdIf0331316\xdd1]5\xe31dRbS312d5f00f01]dIf0331342d1f00dT42;dUf00f01f02f0344;" [quote emit :loadv cadr cond compile-in cond->if if compile-if begin compile-begin prog1 compile-prog1 lambda compile-f :closure and compile-and or compile-or while compile-while cddr for compile-for caddr cadddr return :ret set! compile-sym [:seta :setc :setg] trycatch 1arg-lambda? error "trycatch: second form must be a 1-argument lambda" :trycatch compile-app])])
char? char?
#function("n1d0e031b1<;" [typeof wchar]) #function("n1d0e031b1<;" [typeof wchar])
cddr cddr
@ -282,24 +274,24 @@ cadr
#function("n1e0NM;" []) #function("n1e0NM;" [])
builtin->instruction builtin->instruction
#function("n1b0d1d2b3e03231p42;" [#function("q2d0d1e03216A02e0;" [has? Instructions]) intern string #\:]) #function("n1b0d1d2b3e03231p42;" [#function("q2d0d1e03216A02e0;" [has? Instructions]) intern string #\:])
bq-bracket
#function("n1e0?6C0d0d1e031L2;e0Mb2<6W0d0d3e031L2;e0Mb4<6k0b5d3e031L2;e0Mb6<6{0d3e041;d0d1e031L2;" [list bq-process *comma* cadr *comma-at* copy-list *comma-dot*])
bq-bracket1 bq-bracket1
#function("n1e0F16@02e0Mb0<6J0d1e041;d2e041;" [*comma* cadr bq-process]) #function("n1e0F16@02e0Mb0<6J0d1e041;d2e041;" [*comma* cadr bq-process])
bq-process bq-process
#function("n1d0e0316T0e0H6Q0b1d2d3e03131p42;e0;e0?6a0b4e0L2;e0Mb5<6y0d2d2d6e0313141;e0Mb7<6\x890d6e041;d8d9e032@6\xa90b:d;e031d<d=e032p43;\\6\xb60b>e0^p43;];" [self-evaluating? #function("q2e0Mb0<6B0d1e0NK;d2d1e0L3;" [list vector apply]) bq-process vector->list quote backquote cadr *comma* any splice-form? #function("q3e0A6>0b0e1K;d1b2e1Kd3e031L142;" [list nconc nlist* bq-process]) lastcdr map bq-bracket1 #function("q3]e0F16B02e0Mb0<@6[02d1e0M31e1Ki12e0Ni05302b2e0F6u0d3e1d4e031L1325\x9a0e0A6\x840d5e1315\x9a0\\6\x990d3e1d6e031L1325\x9a0]p42;" [*comma* bq-bracket #function("q2e0NA6=0e0M;b0e0K;" [nconc]) nreconc cadr nreverse bq-process])]) #function("n1d0e0316T0e0H6Q0b1d2d3e03131p42;e0;e0?6a0b4e0L2;e0Mb5<6y0d2d2d6e0313141;e0Mb7<6\x890d6e041;d8d9e032@6\xa90b:d;e031d<d=e032p43;b>e0^p43;" [self-evaluating? #function("q2e0Mb0<6B0d1e0NK;d2d1e0L3;" [list vector apply]) bq-process vector->list quote backquote cadr *comma* any splice-form? #function("q3e0A6>0b0e1K;d1b2e1Kd3e031L142;" [list nconc nlist* bq-process]) lastcdr map bq-bracket1 #function("q3]e0F16B02e0Mb0<@6[02d1e0M31e1Ki12e0Ni05302b2e0F6u0d3e1d4e031L1325\x920e0A6\x840d5e1315\x920d3e1d6e031L132p42;" [*comma* bq-bracket #function("q2e0NA6=0e0M;b0e0K;" [nconc]) nreconc cadr nreverse bq-process])])
bq-bracket
#function("n1e0?6C0d0d1e031L2;e0Mb2<6W0d0d3e031L2;e0Mb4<6k0b5d3e031L2;e0Mb6<6{0d3e041;\\6\x8a0d0d1e031L2;];" [list bq-process *comma* cadr *comma-at* copy-list *comma-dot*])
assv assv
#function("n2e1?6:0];d0e131e0=6J0e1M;\\6X0d1e0e1N42;];" [caar assv]) #function("n2e1?6:0];d0e131e0=6J0e1M;d1e0e1N42;" [caar assv])
assoc assoc
#function("n2e1?6:0];d0e131e0>6J0e1M;\\6X0d1e0e1N42;];" [caar assoc]) #function("n2e1?6:0];d0e131e0>6J0e1M;d1e0e1N42;" [caar assoc])
argc-error argc-error
#function("n2d0d1b2e0b3e1e1`V6J0b45L0b53541;" [error string "compile error: " " expects " " argument." " arguments."]) #function("n2d0d1b2e0b3e1e1`V6J0b45L0b53541;" [error string "compile error: " " expects " " argument." " arguments."])
arg-counts arg-counts
#table(:not 1 :set-cdr! 2 :cons 2 :number? 1 :equal? 2 :cdr 1 :vector? 1 :eqv? 2 :apply 2 := 2 :atom? 1 :aref 2 :compare 2 :< 2 :null? 1 :eq? 2 :car 1 :set-car! 2 :builtin? 1 :aset! 3 :bound? 1 :boolean? 1 :pair? 1 :symbol? 1 :fixnum? 1) #table(:not 1 :set-cdr! 2 :cons 2 :number? 1 :equal? 2 :cdr 1 :vector? 1 :eqv? 2 :apply 2 := 2 :atom? 1 :aref 2 :compare 2 :< 2 :null? 1 :eq? 2 :car 1 :set-car! 2 :builtin? 1 :aset! 3 :bound? 1 :boolean? 1 :pair? 1 :symbol? 1 :fixnum? 1)
append2 append2
#function("n2e0A6;0e1;e0Md0e0Ne132K;" [append2]) #function("n2e0A6;0e1;e0Md0e0Ne132K;" [append2])
any append
#function("n2e1F16O02e0e1M3117O02d0e0e1N42;" [any]) #function("o0e0A6:0^;e0NA6E0e0M;d0e0Md1e0NQ42;" [append2 append])
abs abs
#function("n1e0_W6>0e0S1;e0;" []) #function("n1e0_W6>0e0S1;e0;" [])
__script __script
@ -308,12 +300,12 @@ __init_globals
#function("n0d0b1<17K02d0b2<17K02d0b3<6Z0b4h52b6h75c0b8h52b9h72d:h;2d<h=;" [*os-name* win32 win64 windows "\\" *directory-separator* "\r\n" *linefeed* "/" "\n" *stdout* *output-stream* *stdin* *input-stream*]) #function("n0d0b1<17K02d0b2<17K02d0b3<6Z0b4h52b6h75c0b8h52b9h72d:h;2d<h=;" [*os-name* win32 win64 windows "\\" *directory-separator* "\r\n" *linefeed* "/" "\n" *stdout* *output-stream* *stdin* *input-stream*])
__start __start
#function("n1d0302e0NF6Q0e0Nh12d2d3e031315a0e0h12d4d5312d6302d7_41;" [__init_globals *argv* __script cadr princ *banner* repl exit]) #function("n1d0302e0NF6Q0e0Nh12d2d3e031315a0e0h12d4d5312d6302d7_41;" [__init_globals *argv* __script cadr princ *banner* repl exit])
append any
#function("o0e0A6:0^;e0NA6E0e0M;\\6W0d0e0Md1e0NQ42;];" [append2 append]) #function("n2e1F16O02e0e1M3117O02d0e0e1N42;" [any])
MAX_ARGS MAX_ARGS
127 127
Instructions Instructions
#table(:nop 0 :set-cdr! 32 :/ 37 :setc 58 :tapply 67 :cons 27 dummy_nil 70 :equal? 14 :cdr 30 :call 3 :eqv? 13 := 38 :setg.l 59 :list 28 :atom? 15 :aref 42 :load0 47 :let 65 dummy_t 68 :argc 62 :< 39 :null? 17 :loadg 52 :load1 48 :car 29 :brt.l 10 :vargc 63 :loada 53 :set-car! 31 :setg 56 :aset! 43 :bound? 21 :pair? 22 :symbol? 19 :fixnum? 25 :loadi8 49 :not 16 :* 36 :pop 2 :loadnil 46 :brf 6 :vector 41 :- 35 :loadv 50 :closure 60 dummy_f 69 :number? 20 :trycatch 61 :loadv.l 51 :vector? 24 :brf.l 9 :seta 57 :apply 33 :dup 1 :for 66 :loadc 54 :compare 40 :eq? 12 :function? 26 :+ 34 :jmp 5 :loadt 44 :brt 7 :builtin? 23 :loadg.l 55 :close 64 :tcall 4 :ret 11 :boolean? 18 :loadf 45 :jmp.l 8) #table(:sub2 69 :nop 0 :set-cdr! 32 :/ 37 :setc 58 :tapply 67 :cons 27 dummy_nil 73 :equal? 14 :cdr 30 :call 3 :eqv? 13 := 38 :setg.l 59 :list 28 :atom? 15 :aref 42 :load0 47 :let 65 dummy_t 71 :argc 62 :< 39 :null? 17 :loadg 52 :load1 48 :car 29 :brt.l 10 :vargc 63 :loada 53 :set-car! 31 :setg 56 :aset! 43 :bound? 21 :pair? 22 :symbol? 19 :fixnum? 25 :loadi8 49 :not 16 :* 36 :neg 70 :pop 2 :loadnil 46 :brf 6 :vector 41 :- 35 :loadv 50 :closure 60 dummy_f 72 :number? 20 :trycatch 61 :add2 68 :loadv.l 51 :vector? 24 :brf.l 9 :seta 57 :apply 33 :dup 1 :for 66 :loadc 54 :compare 40 :eq? 12 :function? 26 :+ 34 :jmp 5 :loadt 44 :brt 7 :builtin? 23 :loadg.l 55 :close 64 :tcall 4 :ret 11 :boolean? 18 :loadf 45 :jmp.l 8)
>= >=
#function("n2e1e0W17A02e0e1V;" []) #function("n2e1e0W17A02e0e1V;" [])
> >
@ -323,7 +315,7 @@ Instructions
1arg-lambda? 1arg-lambda?
#function("n1e0F16e02e0Mb0<16e02e0NF16e02d1e031F16e02d2d1e031`42;" [lambda cadr length=]) #function("n1e0F16e02e0Mb0<16e02e0NF16e02d1e031F16e02d2d1e031`42;" [lambda cadr length=])
1/Instructions 1/Instructions
#table(2 :pop 45 :loadf 67 :tapply 59 :setg.l 38 := 15 :atom? 50 :loadv 61 :trycatch 14 :equal? 30 :cdr 40 :compare 11 :ret 69 dummy_f 28 :list 48 :load1 22 :pair? 36 :* 60 :closure 41 :vector 0 :nop 17 :null? 29 :car 56 :setg 23 :builtin? 4 :tcall 43 :aset! 3 :call 58 :setc 21 :bound? 8 :jmp.l 39 :< 63 :vargc 51 :loadv.l 53 :loada 66 :for 44 :loadt 65 :let 55 :loadg.l 5 :jmp 27 :cons 46 :loadnil 34 :+ 6 :brf 13 :eqv? 42 :aref 68 dummy_t 10 :brt.l 31 :set-car! 19 :symbol? 25 :fixnum? 16 :not 54 :loadc 47 :load0 35 :- 32 :set-cdr! 62 :argc 20 :number? 9 :brf.l 12 :eq? 26 :function? 7 :brt 70 dummy_nil 37 :/ 49 :loadi8 52 :loadg 24 :vector? 1 :dup 64 :close 18 :boolean? 33 :apply 57 :seta) #table(2 :pop 45 :loadf 67 :tapply 59 :setg.l 15 :atom? 38 := 50 :loadv 71 dummy_t 61 :trycatch 14 :equal? 30 :cdr 40 :compare 11 :ret 69 :sub2 28 :list 48 :load1 22 :pair? 36 :* 60 :closure 41 :vector 0 :nop 17 :null? 29 :car 56 :setg 72 dummy_f 23 :builtin? 4 :tcall 43 :aset! 3 :call 58 :setc 21 :bound? 8 :jmp.l 39 :< 63 :vargc 51 :loadv.l 53 :loada 66 :for 44 :loadt 65 :let 55 :loadg.l 5 :jmp 27 :cons 46 :loadnil 34 :+ 6 :brf 13 :eqv? 42 :aref 10 :brt.l 31 :set-car! 73 dummy_nil 19 :symbol? 25 :fixnum? 16 :not 68 :add2 47 :load0 35 :- 32 :set-cdr! 62 :argc 20 :number? 9 :brf.l 54 :loadc 12 :eq? 26 :function? 7 :brt 70 :neg 37 :/ 49 :loadi8 52 :loadg 24 :vector? 1 :dup 64 :close 18 :boolean? 33 :apply 57 :seta)
/= /=
#function("n2e0e1V@;" []) #function("n2e0e1V@;" [])
1+ 1+

114
femtolisp/flisp.c
View File

@ -716,6 +716,8 @@ static value_t do_trycatch()
return v; return v;
} }
#define fn_vals(f) (((value_t*)ptr(f))[4])
/* /*
stack on entry: <func> <args...> stack on entry: <func> <args...>
caller's responsibility: caller's responsibility:
@ -744,7 +746,7 @@ static value_t apply_cl(uint32_t nargs)
uint8_t *code; uint8_t *code;
value_t func, v, x, e; value_t func, v, x, e;
function_t *fn; function_t *fn;
value_t *pvals, *lenv, *pv; value_t *lenv, *pv;
symbol_t *sym; symbol_t *sym;
cons_t *c; cons_t *c;
@ -761,8 +763,6 @@ static value_t apply_cl(uint32_t nargs)
bp = SP-nargs; bp = SP-nargs;
PUSH(fn->env); PUSH(fn->env);
PUSH(fn->vals);
pvals = &Stack[SP-1];
ip = 0; ip = 0;
while (1) { while (1) {
@ -786,15 +786,11 @@ static value_t apply_cl(uint32_t nargs)
} }
Stack[bp+i] = v; Stack[bp+i] = v;
Stack[bp+i+1] = Stack[bp+nargs]; Stack[bp+i+1] = Stack[bp+nargs];
Stack[bp+i+2] = Stack[bp+nargs+1];
pvals = &Stack[bp+i+2];
} }
else { else {
PUSH(NIL); PUSH(NIL);
Stack[SP-1] = Stack[SP-2]; Stack[SP-1] = Stack[SP-2];
Stack[SP-2] = Stack[SP-3]; Stack[SP-2] = NIL;
Stack[SP-3] = NIL;
pvals = &Stack[SP-1];
} }
nargs = i+1; nargs = i+1;
break; break;
@ -802,9 +798,7 @@ static value_t apply_cl(uint32_t nargs)
ip++; ip++;
// last arg is closure environment to use // last arg is closure environment to use
nargs--; nargs--;
Stack[SP-2] = Stack[SP-1];
POPN(1); POPN(1);
pvals = &Stack[SP-1];
break; break;
case OP_NOP: break; case OP_NOP: break;
case OP_DUP: v = Stack[SP-1]; PUSH(v); break; case OP_DUP: v = Stack[SP-1]; PUSH(v); break;
@ -1029,43 +1023,61 @@ static value_t apply_cl(uint32_t nargs)
POPN(n); POPN(n);
PUSH(v); PUSH(v);
break; break;
case OP_ADD2:
if (bothfixnums(Stack[SP-1], Stack[SP-2])) {
accum = (int64_t)numval(Stack[SP-1]) + numval(Stack[SP-2]);
if (fits_fixnum(accum))
v = fixnum(accum);
else
v = return_from_int64(accum);
}
else {
v = fl_add_any(&Stack[SP-2], 2, 0);
}
POPN(1);
Stack[SP-1] = v;
break;
case OP_SUB: case OP_SUB:
n = code[ip++]; n = code[ip++];
apply_sub: apply_sub:
if (n == 2) goto do_sub2;
if (n == 1) goto do_neg;
i = SP-n; i = SP-n;
if (n == 1) { // we need to pass the full arglist on to fl_add_any
if (__likely(isfixnum(Stack[i]))) // so it can handle rest args properly
Stack[SP-1] = fixnum(-numval(Stack[i])); PUSH(Stack[i]);
else Stack[i] = fixnum(0);
Stack[SP-1] = fl_neg(Stack[i]); Stack[i+1] = fl_neg(fl_add_any(&Stack[i], n, 0));
break; Stack[i] = POP();
}
if (n == 2) {
if (__likely(bothfixnums(Stack[i], Stack[i+1]))) {
s = numval(Stack[i]) - numval(Stack[i+1]);
if (__likely(fits_fixnum(s))) {
POPN(1);
Stack[SP-1] = fixnum(s);
break;
}
Stack[i+1] = fixnum(-numval(Stack[i+1]));
}
else {
Stack[i+1] = fl_neg(Stack[i+1]);
}
}
else {
// we need to pass the full arglist on to fl_add_any
// so it can handle rest args properly
PUSH(Stack[i]);
Stack[i] = fixnum(0);
Stack[i+1] = fl_neg(fl_add_any(&Stack[i], n, 0));
Stack[i] = POP();
}
v = fl_add_any(&Stack[i], 2, 0); v = fl_add_any(&Stack[i], 2, 0);
POPN(n); POPN(n);
PUSH(v); PUSH(v);
break; break;
case OP_NEG:
do_neg:
if (__likely(isfixnum(Stack[SP-1])))
Stack[SP-1] = fixnum(-numval(Stack[SP-1]));
else
Stack[SP-1] = fl_neg(Stack[SP-1]);
break;
case OP_SUB2:
do_sub2:
if (__likely(bothfixnums(Stack[SP-2], Stack[SP-1]))) {
s = numval(Stack[SP-2]) - numval(Stack[SP-1]);
if (__likely(fits_fixnum(s))) {
POPN(1);
Stack[SP-1] = fixnum(s);
break;
}
Stack[SP-1] = fixnum(-numval(Stack[SP-1]));
}
else {
Stack[SP-1] = fl_neg(Stack[SP-1]);
}
v = fl_add_any(&Stack[SP-2], 2, 0);
POPN(1);
Stack[SP-1] = v;
break;
case OP_MUL: case OP_MUL:
n = code[ip++]; n = code[ip++];
apply_mul: apply_mul:
@ -1219,20 +1231,24 @@ static value_t apply_cl(uint32_t nargs)
case OP_LOAD1: PUSH(fixnum(1)); break; case OP_LOAD1: PUSH(fixnum(1)); break;
case OP_LOADI8: s = (int8_t)code[ip++]; PUSH(fixnum(s)); break; case OP_LOADI8: s = (int8_t)code[ip++]; PUSH(fixnum(s)); break;
case OP_LOADV: case OP_LOADV:
assert(code[ip] < vector_size(*pvals)); v = fn_vals(Stack[bp-1]);
v = vector_elt(*pvals, code[ip]); ip++; assert(code[ip] < vector_size(v));
v = vector_elt(v, code[ip]); ip++;
PUSH(v); PUSH(v);
break; break;
case OP_LOADVL: case OP_LOADVL:
v = vector_elt(*pvals, *(uint32_t*)&code[ip]); ip+=4; v = fn_vals(Stack[bp-1]);
v = vector_elt(v, *(uint32_t*)&code[ip]); ip+=4;
PUSH(v); PUSH(v);
break; break;
case OP_LOADGL: case OP_LOADGL:
v = vector_elt(*pvals, *(uint32_t*)&code[ip]); ip+=4; v = fn_vals(Stack[bp-1]);
v = vector_elt(v, *(uint32_t*)&code[ip]); ip+=4;
goto do_loadg; goto do_loadg;
case OP_LOADG: case OP_LOADG:
assert(code[ip] < vector_size(*pvals)); v = fn_vals(Stack[bp-1]);
v = vector_elt(*pvals, code[ip]); ip++; assert(code[ip] < vector_size(v));
v = vector_elt(v, code[ip]); ip++;
do_loadg: do_loadg:
assert(issymbol(v)); assert(issymbol(v));
sym = (symbol_t*)ptr(v); sym = (symbol_t*)ptr(v);
@ -1242,11 +1258,13 @@ static value_t apply_cl(uint32_t nargs)
break; break;
case OP_SETGL: case OP_SETGL:
v = vector_elt(*pvals, *(uint32_t*)&code[ip]); ip+=4; v = fn_vals(Stack[bp-1]);
v = vector_elt(v, *(uint32_t*)&code[ip]); ip+=4;
goto do_setg; goto do_setg;
case OP_SETG: case OP_SETG:
assert(code[ip] < vector_size(*pvals)); v = fn_vals(Stack[bp-1]);
v = vector_elt(*pvals, code[ip]); ip++; assert(code[ip] < vector_size(v));
v = vector_elt(v, code[ip]); ip++;
do_setg: do_setg:
assert(issymbol(v)); assert(issymbol(v));
sym = (symbol_t*)ptr(v); sym = (symbol_t*)ptr(v);

2
femtolisp/opcodes.h
View File

@ -21,7 +21,7 @@ enum {
OP_SETG, OP_SETA, OP_SETC, OP_SETGL, OP_SETG, OP_SETA, OP_SETC, OP_SETGL,
OP_CLOSURE, OP_TRYCATCH, OP_ARGC, OP_VARGC, OP_CLOSE, OP_LET, OP_FOR, OP_CLOSURE, OP_TRYCATCH, OP_ARGC, OP_VARGC, OP_CLOSE, OP_LET, OP_FOR,
OP_TAPPLY, OP_TAPPLY, OP_ADD2, OP_SUB2, OP_NEG,
OP_BOOL_CONST_T, OP_BOOL_CONST_F, OP_THE_EMPTY_LIST, OP_BOOL_CONST_T, OP_BOOL_CONST_F, OP_THE_EMPTY_LIST,

30
femtolisp/system.lsp
View File

@ -134,7 +134,6 @@
(or (pred (car lst)) (or (pred (car lst))
(any pred (cdr lst))))) (any pred (cdr lst)))))
(define (listp a) (or (null? a) (pair? a)))
(define (list? a) (or (null? a) (and (pair? a) (list? (cdr a))))) (define (list? a) (or (null? a) (and (pair? a) (list? (cdr a)))))
(define (list-tail lst n) (define (list-tail lst n)
@ -728,18 +727,23 @@
(define (make-system-image fname) (define (make-system-image fname)
(let ((f (file fname :write :create :truncate)) (let ((f (file fname :write :create :truncate))
(excludes '(*linefeed* *directory-separator* *argv* that (excludes '(*linefeed* *directory-separator* *argv* that
*print-pretty* *print-width*))) *print-pretty* *print-width*))
(for-each (lambda (s) (pp *print-pretty*))
(if (and (bound? s) (set! *print-pretty* #f)
(not (constant? s)) (unwind-protect
(not (builtin? (top-level-value s))) (for-each (lambda (s)
(not (memq s excludes)) (if (and (bound? s)
(not (iostream? (top-level-value s)))) (not (constant? s))
(begin (not (builtin? (top-level-value s)))
(io.print f s) (io.write f "\n") (not (memq s excludes))
(io.print f (top-level-value s)) (io.write f "\n")))) (not (iostream? (top-level-value s))))
(environment)) (begin
(io.close f))) (io.print f s) (io.write f "\n")
(io.print f (top-level-value s)) (io.write f "\n"))))
(environment))
(begin
(io.close f)
(set! *print-pretty* pp)))))
; initialize globals that need to be set at load time ; initialize globals that need to be set at load time
(define (__init_globals) (define (__init_globals)

12
femtolisp/todo
View File

@ -1030,4 +1030,14 @@ new evaluator todo:
* let optimization * let optimization
* have macroexpand use its own global syntax table * have macroexpand use its own global syntax table
* be able to create/load an image file * be able to create/load an image file
- opcodes NEG, ADD2 - fix trace and untrace
- opcodes NEG, ADD2, (CADR ?), sub-immediate, add-immediate
- EQTO N, compare directly to stored datum N
- peephole opt
constant+pop => nothing, e.g. 2-arg 'if' in statement position
not+brf => brt
not+brt => brf
loadt+brf => nothing
loadf+brt => nothing
loadt+brt => jmp
loadf+brf => jmp