ref: de19e4f401b874c9597cddf36d9141a5229e4850
parent: 0dc4c16276ce0220b12da32ca92895a514c752d5
author: JeffBezanson <jeff.bezanson@gmail.com>
date: Sun Apr 26 18:19:32 EDT 2009
adding return special form eliminating some unnecessary top-level bindings adding opcodes add2, sub2, neg
--- a/femtolisp/compiler.lsp
+++ b/femtolisp/compiler.lsp
@@ -24,7 +24,7 @@
:loadg :loada :loadc :loadg.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]))
@@ -69,13 +69,14 @@
(define (make-label e) (gensym))
(define (mark-label e l) (emit e :label l))
-(define (count- f l n)
- (if (null? l)
- n
- (count- f (cdr l) (if (f (car l))
- (+ n 1)
- n))))
-(define (count f l) (count- f l 0))
+(define (count f l)
+ (define (count- f l n)
+ (if (null? l)
+ n
+ (count- f (cdr l) (if (f (car l))
+ (+ n 1)
+ n))))
+ (count- f l 0))
(define (peephole c) c)
@@ -147,22 +148,17 @@
(io.tostring! bcode))))
(define (const-to-idx-vec e)
- (let ((const-to-idx (aref e 1))
- (nconst (aref e 2)))
- (let ((cvec (vector.alloc nconst)))
- (table.foreach (lambda (val idx) (aset! cvec idx val))
- const-to-idx)
- cvec)))
+ (let ((cvec (vector.alloc (aref e 2))))
+ (table.foreach (lambda (val idx) (aset! cvec idx val))
+ (aref e 1))
+ cvec))
(define (index-of item lst start)
(cond ((null? lst) #f)
- ((eq item (car lst)) start)
- (#t (index-of item (cdr lst) (+ start 1)))))
+ ((eq? item (car lst)) start)
+ (else (index-of item (cdr lst) (+ start 1)))))
-(define (in-env? s env)
- (and (pair? env)
- (or (memq s (car env))
- (in-env? s (cdr env)))))
+(define (in-env? s env) (any (lambda (e) (memq s e)) env))
(define (lookup-sym s env lev arg?)
(if (null? env)
@@ -185,10 +181,6 @@
(closed (emit g (aref Is 1) (cadr loc) (caddr loc)))
(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)
(cond-clauses->if (cdr form)))
(define (cond-clauses->if lst)
@@ -195,7 +187,8 @@
(if (atom? lst)
#f
(let ((clause (car lst)))
- (if (eq? (car clause) 'else)
+ (if (or (eq? (car clause) 'else)
+ (eq? (car clause) #t))
(cons 'begin (cdr clause))
`(if ,(car clause)
,(cons 'begin (cdr clause))
@@ -278,13 +271,13 @@
(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-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)
(error "list-partition: invalid count")
(nreverse (list-part- l n 0 () ()))))
@@ -339,6 +332,10 @@
(emit g :close)
(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)
(let ((head (car x)))
(let ((head
@@ -361,11 +358,13 @@
(argc-error head count))
(case b ; handle special cases of vararg builtins
(:list (if (= nargs 0) (emit g :loadnil) (emit g b nargs)))
- (:+ (if (= nargs 0) (emit g :load0)
- (emit g b nargs)))
- (:- (if (= nargs 0)
- (argc-error head 1)
- (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)
@@ -403,6 +402,8 @@
(or (compile-or g env tail? (cdr x)))
(while (compile-while g env (cadr x) (cons 'begin (cddr 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))
(compile-sym g env (cadr x) [:seta :setc :setg]))
(trycatch (compile-in g env #f `(lambda () ,(cadr x)))
@@ -440,14 +441,19 @@
(define (hex5 n)
(pad-l (number->string n 16) 5 #\0))
-(define (disassemble- f lev)
- (let ((fvec (function->vector f)))
+(define (disassemble f . lev?)
+ (if (null? lev?)
+ (begin (disassemble f 0)
+ (newline)
+ (return #t)))
+ (let ((fvec (function->vector f))
+ (lev (car lev?)))
(let ((code (aref fvec 0))
(vals (aref fvec 1)))
(define (print-val v)
(if (and (function? v) (not (builtin? v)))
(begin (princ "\n")
- (disassemble- v (+ lev 1)))
+ (disassemble v (+ lev 1)))
(print v)))
(let ((i 0)
(N (length code)))
@@ -487,7 +493,5 @@
(set! i (+ i 4)))
(else #f))))))))
-
-(define (disassemble f) (disassemble- f 0) (newline))
#t
--- a/femtolisp/flisp.boot
+++ b/femtolisp/flisp.boot
@@ -41,7 +41,7 @@
set-syntax!
#function("n2d0d1e0e143;" [put! *syntax-environment*])separate
-#function("n2f00e0e1^^44;" [] #0=[#function("n4e1A6>0e2e3K;e0e1M316[0f00e0e1Ne1Me2Ke344;\\6r0f00e0e1Ne2e1Me3K44;];" [] #0#) ()])+#function("n2f00e0e1^^44;" [] #0=[#function("n4e1A6>0e2e3K;e0e1M316[0f00e0e1Ne1Me2Ke344;f00e0e1Ne2e1Me3K44;" [] #0#) ()])reverse
#function("n1d0d1^e043;" [foldl cons])revappend
@@ -49,9 +49,9 @@
remainder
#function("n2e0e0e1U2e1T2S2;" [])ref-uint32-LE
-#function("n2d0e0e1_R2Z_32d0e0e1`R2Za832d0e0e1a2R2Za@32d0e0e1a3R2ZaH32R4;" [ash])+#function("n2d0e0e1_tZ_32d0e0e1`tZa832d0e0e1a2tZa@32d0e0e1a3tZaH32R4;" [ash])ref-uint16-LE
-#function("n2d0e0e1_R2Z_32d0e0e1`R2Za832R2;" [ash])+#function("n2d0e0e1_tZ_32d0e0e1`tZa832t;" [ash])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])])self-evaluating?
@@ -91,11 +91,11 @@
newline
#function("n0d0d1312\\;" [princ *linefeed*])memv
-#function("n2e1?6:0];e1Me0=6F0e1;\\6T0d0e0e1N42;];" [memv])+#function("n2e1?6:0];e1Me0=6F0e1;d0e0e1N42;" [memv])mod
#function("n2e0e0e1U2e1T2S2;" [])member
-#function("n2e1?6:0];e1Me0>6F0e1;\\6T0d0e0e1N42;];" [member])+#function("n2e1?6:0];e1Me0>6F0e1;d0e0e1N42;" [member])mark-label
#function("n2d0e0d1e143;" [emit :label])map!
@@ -102,10 +102,8 @@
#function("n2e1]e1F6O02e1e0e1M31O2e1Ni15502;" [])map-int
#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
-#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
#function("n2b0d130p42;" [#function("q2_d0d1f013131b2lr;" [1- length #function("n1d0f00f11e0Zf10e0R243;" [put!])]) table])macroexpand-1
@@ -124,8 +122,8 @@
#function("n1d040;" [gensym])map
#function("n2e1?6;0e1;e0e1M31d0e0e1N32K;" [map])-listp
-#function("n1e0A17=02e0F;" [])+mapcar
+#function("o1f00e0e142;" [] #0=[#function("n2e1A6=0e040;e1M?6H0e1M;e0d0d1e132Qf00e0d0d2e13232K;" [map car cdr] #0#) ()])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])list-tail
@@ -138,10 +136,8 @@
#function("o0e0N?6=0e0M;e0Md0e0NQK;" [list*])list->vector
#function("n1d0e0s;" [vector])-list-part-
-#function("n5e0?6O0d0e2_326L0d1e331e4K;e4;d2e2e1326n0d3e0e1_^d1e331e4K45;d3e0Ne1`e2R2e0Me3Ke445;" [> nreverse >= list-part-])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?
#function("n1e0A17I02e0F16I02d0e0N41;" [list?])load-process
@@ -153,7 +149,7 @@
lastcdr
#function("n1e0?6;0e0;d0e0N41;" [lastcdr])last-pair
-#function("n1e0?6;0e0;e0N?6E0e0;\\6Q0d0e0N41;];" [last-pair])+#function("n1e0?6;0e0;e0N?6E0e0;d0e0N41;" [last-pair])iota
#function("n1d0d1e042;" [map-int identity])just-compile-args
@@ -161,13 +157,13 @@
io.readline
#function("n1d0e0b142;" [io.readuntil #\x000a])in-env?
-#function("n2e1F16Q02d0e0e1M3217Q02d1e0e1N42;" [memq in-env?])+#function("n2d0b1le142;" [any #function("n1d0f00e042;" [memq])])hex5
#function("n1d0d1e0a@32a5b243;" [pad-l number->string #\0])identity
#function("n1e0;" [])index-of
-#function("n3e1A6:0];e0e1M<6F0e2;\\6Y0d0e0e1Ne2`R243;];" [index-of])+#function("n3e1A6:0];e0e1M<6F0e2;d0e0e1Ne2`R243;" [index-of])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#) ()])for-each
@@ -177,9 +173,9 @@
foldl
#function("n3e2A6;0e1;d0e0e0e2Me132e2N43;" [foldl])filter
-#function("n2f00e0e1^43;" [] #0=[#function("n3e1A6;0e2;e0e1M316V0f00e0e1Ne1Me2K43;\\6g0f00e0e1Ne243;];" [] #0#) ()])+#function("n2f00e0e1^43;" [] #0=[#function("n3e1A6;0e2;e0e1M316V0f00e0e1Ne1Me2K43;f00e0e1Ne243;" [] #0#) ()])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
#function("n1d0e041;" [macroexpand])every
@@ -198,24 +194,20 @@
#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
#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
-#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
#function("n1e0?6;0e0;b0e0Me0Np43;" [#function("q3d0e0e1326D0d1e141;e0d1e131K;" [member delete-duplicates])])-count-
-#function("n3e1A6;0e2;d0e0e1Ne0e1M316T0e2`R25V0e243;" [count-])copy-tree
#function("n1e0?6;0e0;d0e0M31d0e0N31K;" [copy-tree])count
-#function("n2d0e0e1_43;" [count-])+#function("n2b0]p42;" [#function("q2b0li02e0f00f01_43;" [#function("n3e1A6;0e2;f00e0e1Ne0e1M316U0e2`R25W0e243;" [])])])copy-list
#function("n1e0?6;0e0;e0Md0e0N31K;" [copy-list])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
-#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
#function("n4b0d1e031d1e031p43;" [#function("q3d0f00f01]]342d1f00e0322d0f00f01]f02342d2f00d3e1332d2f00d4322d0f00f01]f03342d2f00d5e0332d1f00e142;" [compile-in mark-label emit :brf :pop :jmp]) make-label])cond->if
@@ -237,21 +229,21 @@
compile-for
#function("n5d0e4316h0d1e0e1]e2342d1e0e1]e3342d1e0e1]e4342d2e0d342;d4b541;" [1arg-lambda? compile-in emit :for error "for: third form must be a 1-argument lambda"])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
#function("n4e3?6D0d0e0e1e2]44;e3N?6Y0d0e0e1e2e3M44;d0e0e1]e3M342d1e0d2322d3e0e1e2e3N44;" [compile-in emit :pop compile-begin])compile-and
#function("n4d0e0e1e2e3\\d146;" [compile-short-circuit :brf])-compile
-#function("n1d0^e042;" [compile-f])compile-app
#function("n4b0e3Mp42;" [#function("q2e0F16O02e0Mb0<16O02d1d2e031316c0d3f00f01f02f0344;d4f00f01f02f0344;" [lambda list? cadr compile-let compile-call])])+compile
+#function("n1d0^e042;" [compile-f])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])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])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?
#function("n1d0e031b1<;" [typeof wchar])cddr
@@ -282,16 +274,16 @@
#function("n1e0NM;" [])builtin->instruction
#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
#function("n1e0F16@02e0Mb0<6J0d1e041;d2e041;" [*comma* cadr 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])])-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*])+#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])])assv
-#function("n2e1?6:0];d0e131e0=6J0e1M;\\6X0d1e0e1N42;];" [caar assv])+#function("n2e1?6:0];d0e131e0=6J0e1M;d1e0e1N42;" [caar assv])assoc
-#function("n2e1?6:0];d0e131e0>6J0e1M;\\6X0d1e0e1N42;];" [caar assoc])+#function("n2e1?6:0];d0e131e0>6J0e1M;d1e0e1N42;" [caar assoc])argc-error
#function("n2d0d1b2e0b3e1e1`V6J0b45L0b53541;" [error string "compile error: " " expects " " argument." " arguments."])arg-counts
@@ -298,8 +290,8 @@
#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
#function("n2e0A6;0e1;e0Md0e0Ne132K;" [append2])-any
-#function("n2e1F16O02e0e1M3117O02d0e0e1N42;" [any])+append
+#function("o0e0A6:0^;e0NA6E0e0M;d0e0Md1e0NQ42;" [append2 append])abs
#function("n1e0_W6>0e0S1;e0;" [])__script
@@ -308,12 +300,12 @@
#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
#function("n1d0302e0NF6Q0e0Nh12d2d3e031315a0e0h12d4d5312d6302d7_41;" [__init_globals *argv* __script cadr princ *banner* repl exit])-append
-#function("o0e0A6:0^;e0NA6E0e0M;\\6W0d0e0Md1e0NQ42;];" [append2 append])+any
+#function("n2e1F16O02e0e1M3117O02d0e0e1N42;" [any])MAX_ARGS
127
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;" [])>
@@ -323,7 +315,7 @@
1arg-lambda?
#function("n1e0F16e02e0Mb0<16e02e0NF16e02d1e031F16e02d2d1e031`42;" [lambda cadr length=])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@;" [])1+
--- a/femtolisp/flisp.c
+++ b/femtolisp/flisp.c
@@ -716,6 +716,8 @@
return v;
}
+#define fn_vals(f) (((value_t*)ptr(f))[4])
+
/*
stack on entry: <func> <args...>
caller's responsibility:
@@ -744,7 +746,7 @@
uint8_t *code;
value_t func, v, x, e;
function_t *fn;
- value_t *pvals, *lenv, *pv;
+ value_t *lenv, *pv;
symbol_t *sym;
cons_t *c;
@@ -761,8 +763,6 @@
bp = SP-nargs;
PUSH(fn->env);
- PUSH(fn->vals);
- pvals = &Stack[SP-1];
ip = 0;
while (1) {@@ -786,15 +786,11 @@
}
Stack[bp+i] = v;
Stack[bp+i+1] = Stack[bp+nargs];
- Stack[bp+i+2] = Stack[bp+nargs+1];
- pvals = &Stack[bp+i+2];
}
else {PUSH(NIL);
Stack[SP-1] = Stack[SP-2];
- Stack[SP-2] = Stack[SP-3];
- Stack[SP-3] = NIL;
- pvals = &Stack[SP-1];
+ Stack[SP-2] = NIL;
}
nargs = i+1;
break;
@@ -802,9 +798,7 @@
ip++;
// last arg is closure environment to use
nargs--;
- Stack[SP-2] = Stack[SP-1];
POPN(1);
- pvals = &Stack[SP-1];
break;
case OP_NOP: break;
case OP_DUP: v = Stack[SP-1]; PUSH(v); break;
@@ -1029,42 +1023,60 @@
POPN(n);
PUSH(v);
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:
n = code[ip++];
apply_sub:
+ if (n == 2) goto do_sub2;
+ if (n == 1) goto do_neg;
i = SP-n;
- if (n == 1) {- if (__likely(isfixnum(Stack[i])))
- Stack[SP-1] = fixnum(-numval(Stack[i]));
- else
- Stack[SP-1] = fl_neg(Stack[i]);
- break;
- }
- 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]));
+ // 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);
+ POPN(n);
+ PUSH(v);
+ 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;
}
- else {- Stack[i+1] = fl_neg(Stack[i+1]);
- }
+ Stack[SP-1] = fixnum(-numval(Stack[SP-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();
+ Stack[SP-1] = fl_neg(Stack[SP-1]);
}
- v = fl_add_any(&Stack[i], 2, 0);
- POPN(n);
- PUSH(v);
+ v = fl_add_any(&Stack[SP-2], 2, 0);
+ POPN(1);
+ Stack[SP-1] = v;
break;
case OP_MUL:
n = code[ip++];
@@ -1219,20 +1231,24 @@
case OP_LOAD1: PUSH(fixnum(1)); break;
case OP_LOADI8: s = (int8_t)code[ip++]; PUSH(fixnum(s)); break;
case OP_LOADV:
- assert(code[ip] < vector_size(*pvals));
- v = vector_elt(*pvals, code[ip]); ip++;
+ v = fn_vals(Stack[bp-1]);
+ assert(code[ip] < vector_size(v));
+ v = vector_elt(v, code[ip]); ip++;
PUSH(v);
break;
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);
break;
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;
case OP_LOADG:
- assert(code[ip] < vector_size(*pvals));
- v = vector_elt(*pvals, code[ip]); ip++;
+ v = fn_vals(Stack[bp-1]);
+ assert(code[ip] < vector_size(v));
+ v = vector_elt(v, code[ip]); ip++;
do_loadg:
assert(issymbol(v));
sym = (symbol_t*)ptr(v);
@@ -1242,11 +1258,13 @@
break;
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;
case OP_SETG:
- assert(code[ip] < vector_size(*pvals));
- v = vector_elt(*pvals, code[ip]); ip++;
+ v = fn_vals(Stack[bp-1]);
+ assert(code[ip] < vector_size(v));
+ v = vector_elt(v, code[ip]); ip++;
do_setg:
assert(issymbol(v));
sym = (symbol_t*)ptr(v);
--- a/femtolisp/opcodes.h
+++ b/femtolisp/opcodes.h
@@ -21,7 +21,7 @@
OP_SETG, OP_SETA, OP_SETC, OP_SETGL,
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,
--- a/femtolisp/system.lsp
+++ b/femtolisp/system.lsp
@@ -134,7 +134,6 @@
(or (pred (car 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-tail lst n)
@@ -728,18 +727,23 @@
(define (make-system-image fname)
(let ((f (file fname :write :create :truncate))
(excludes '(*linefeed* *directory-separator* *argv* that
- *print-pretty* *print-width*)))
- (for-each (lambda (s)
- (if (and (bound? s)
- (not (constant? s))
- (not (builtin? (top-level-value s)))
- (not (memq s excludes))
- (not (iostream? (top-level-value s))))
- (begin
- (io.print f s) (io.write f "\n")
- (io.print f (top-level-value s)) (io.write f "\n"))))
- (environment))
- (io.close f)))
+ *print-pretty* *print-width*))
+ (pp *print-pretty*))
+ (set! *print-pretty* #f)
+ (unwind-protect
+ (for-each (lambda (s)
+ (if (and (bound? s)
+ (not (constant? s))
+ (not (builtin? (top-level-value s)))
+ (not (memq s excludes))
+ (not (iostream? (top-level-value s))))
+ (begin
+ (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
(define (__init_globals)
--- a/femtolisp/todo
+++ b/femtolisp/todo
@@ -1030,4 +1030,14 @@
* let optimization
* have macroexpand use its own global syntax table
* 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