ref: c61dc10002d41b6be70bd328038eef014f293074
parent: 88d08edecc4c24d4ad0cca3d15ab01090a559de9
author: JeffBezanson <jeff.bezanson@gmail.com>
date: Fri Jul 24 00:20:09 EDT 2009
adding some combined instructions and teaching the compiler to emit them: brn, brnn, brne, cadr
--- a/femtolisp/compiler.lsp
+++ b/femtolisp/compiler.lsp
@@ -25,6 +25,7 @@
:closure :argc :vargc :trycatch :copyenv :let :for :tapply
:add2 :sub2 :neg :largc :lvargc
:loada0 :loada1 :loadc00 :loadc01 :call.l :tcall.l
+ :brne :brne.l :cadr :brnn :brnn.l :brn :brn.l
dummy_t dummy_f dummy_nil]))
(for 0 (1- (length keys))
@@ -62,7 +63,10 @@
(aset! b 2 (+ nconst 1)))))))
(define (emit e inst . args)
(if (null? args)
- (aset! e 0 (cons inst (aref e 0)))
+ (if (and (eq? inst :car) (pair? (aref e 0))
+ (eq? (car (aref e 0)) :cdr))
+ (set-car! (aref e 0) :cadr)
+ (aset! e 0 (cons inst (aref e 0))))
(begin
(if (memq inst '(:loadv :loadg :setg))
(set! args (list (bcode:indexfor e (car args)))))
@@ -92,7 +96,23 @@
((equal? args '(0 1))
(set! inst :loadc01)
(set! args ()))))
- (aset! e 0 (nreconc (cons inst args) (aref e 0)))))
+
+ (let ((lasti (if (pair? (aref e 0))
+ (car (aref e 0)) ()))
+ (bc (aref e 0)))
+ (cond ((and (eq? inst :brf) (eq? lasti :not)
+ (eq? (cadr bc) :null?))
+ (aset! e 0 (cons (car args) (cons :brn (cddr bc)))))
+ ((and (eq? inst :brf) (eq? lasti :not))
+ (aset! e 0 (cons (car args) (cons :brt (cdr bc)))))
+ ((and (eq? inst :brf) (eq? lasti :eq?))
+ (aset! e 0 (cons (car args) (cons :brne (cdr bc)))))
+ ((and (eq? inst :brf) (eq? lasti :null?))
+ (aset! e 0 (cons (car args) (cons :brnn (cdr bc)))))
+ ((and (eq? inst :brt) (eq? lasti :null?))
+ (aset! e 0 (cons (car args) (cons :brn (cdr bc)))))
+ (else
+ (aset! e 0 (nreconc (cons inst args) bc)))))))
e)
(define (make-label e) (gensym))
@@ -134,14 +154,17 @@
(get Instructions
(if long?
(case vi
- (:jmp :jmp.l)
- (:brt :brt.l)
- (:brf :brf.l)
+ (:jmp :jmp.l)
+ (:brt :brt.l)
+ (:brf :brf.l)
+ (:brne :brne.l)
+ (:brnn :brnn.l)
+ (:brn :brn.l)
(else vi))
vi))))
(set! i (+ i 1))
(set! nxt (if (< i n) (aref v i) #f))
- (cond ((memq vi '(:jmp :brf :brt))
+ (cond ((memq vi '(:jmp :brf :brt :brne :brnn :brn))
(put! fixup-to-label (sizeof bcode) nxt)
(io.write bcode ((if long? int32 int16) 0))
(set! i (+ i 1)))
@@ -400,12 +423,19 @@
(emit g (if tail? :tcall.l :call.l) nargs)))
(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))))))))
+ (if (and (eq? head 'cadr)
+ (not (in-env? head env))
+ (equal? (top-level-value 'cadr) cadr)
+ (length= x 2))
+ (begin (compile-in g env #f (cadr x))
+ (emit g :cadr))
+ (begin
+ (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)
@@ -590,11 +620,11 @@
(princ (number->string (ref-int32-LE code i)))
(set! i (+ i 4)))
- ((:jmp :brf :brt)
+ ((:jmp :brf :brt :brne :brnn :brn)
(princ "@" (hex5 (+ i -4 (ref-int16-LE code i))))
(set! i (+ i 2)))
- ((:jmp.l :brf.l :brt.l)
+ ((:jmp.l :brf.l :brt.l :brne.l :brnn.l :brn.l)
(princ "@" (hex5 (+ i -4 (ref-int32-LE code i))))
(set! i (+ i 4)))
--- 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(":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
+(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\x80317a0e1i10e2c3~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("9000r1~\x8740~;~?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~\x8750c0;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("6000r4\x7f\x8780g2g3K;~\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("8000r0e0c1312e2e3312c4c5c6tu\ No newline at end of file
--- a/femtolisp/flisp.c
+++ b/femtolisp/flisp.c
@@ -1062,6 +1062,36 @@
if (v != FL_F) ip += (ptrint_t)GET_INT32(ip);
else ip += 4;
NEXT_OP;
+ OP(OP_BRNE)
+ if (Stack[SP-2] != Stack[SP-1]) ip += (ptrint_t)GET_INT16(ip);
+ else ip += 2;
+ POPN(2);
+ NEXT_OP;
+ OP(OP_BRNEL)
+ if (Stack[SP-2] != Stack[SP-1]) ip += (ptrint_t)GET_INT32(ip);
+ else ip += 4;
+ POPN(2);
+ NEXT_OP;
+ OP(OP_BRNN)
+ v = POP();
+ if (v != NIL) ip += (ptrint_t)GET_INT16(ip);
+ else ip += 2;
+ NEXT_OP;
+ OP(OP_BRNNL)
+ v = POP();
+ if (v != NIL) ip += (ptrint_t)GET_INT32(ip);
+ else ip += 4;
+ NEXT_OP;
+ OP(OP_BRN)
+ v = POP();
+ if (v == NIL) ip += (ptrint_t)GET_INT16(ip);
+ else ip += 2;
+ NEXT_OP;
+ OP(OP_BRNL)
+ v = POP();
+ if (v == NIL) ip += (ptrint_t)GET_INT32(ip);
+ else ip += 4;
+ NEXT_OP;
OP(OP_RET)
v = POP();
SP = curr_frame;
@@ -1151,6 +1181,13 @@
v = Stack[SP-1];
if (!iscons(v)) type_error("cdr", "cons", v);Stack[SP-1] = cdr_(v);
+ NEXT_OP;
+ OP(OP_CADR)
+ v = Stack[SP-1];
+ if (!iscons(v)) type_error("cdr", "cons", v);+ v = cdr_(v);
+ if (!iscons(v)) type_error("car", "cons", v);+ Stack[SP-1] = car_(v);
NEXT_OP;
OP(OP_SETCAR)
car(Stack[SP-2]) = Stack[SP-1];
--- a/femtolisp/opcodes.h
+++ b/femtolisp/opcodes.h
@@ -26,6 +26,7 @@
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_LOADA0, OP_LOADA1, OP_LOADC00, OP_LOADC01, OP_CALLL, OP_TCALLL,
+ OP_BRNE, OP_BRNEL, OP_CADR, OP_BRNN, OP_BRNNL, OP_BRN, OP_BRNL,
OP_BOOL_CONST_T, OP_BOOL_CONST_F, OP_THE_EMPTY_LIST,
@@ -67,7 +68,8 @@
&&L_OP_TAPPLY, &&L_OP_ADD2, &&L_OP_SUB2, &&L_OP_NEG, &&L_OP_LARGC, \
&&L_OP_LVARGC, \
&&L_OP_LOADA0, &&L_OP_LOADA1, &&L_OP_LOADC00, &&L_OP_LOADC01, \
- &&L_OP_CALLL, &&L_OP_TCALLL \
+ &&L_OP_CALLL, &&L_OP_TCALLL, &&L_OP_BRNE, &&L_OP_BRNEL, &&L_OP_CADR,\
+ &&L_OP_BRNN, &&L_OP_BRNNL, &&L_OP_BRN, &&L_OP_BRNL \
}
#define VM_APPLY_LABELS \
--- a/femtolisp/todo
+++ b/femtolisp/todo
@@ -1053,9 +1053,17 @@
- opcodes CAAR, CADR, CDAR, CDDR
- EQTO N, compare directly to stored datum N
- peephole opt
+ done:
+ not brf => brt
+ eq brf => brne
+ null brf => brnn
+ null brt => brn
+ null not brf => brn
+ cdr car => cadr
+
+ not yet:
+ not brt => brf
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