conservatory
/
femtolisp
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

adding R6RS div, mod, div0, mod0 

small improvement to cmp_eq
explicit -fomit-frame-pointer was causing test failures with gcc4.3.2
This commit is contained in:
JeffBezanson 2009-05-14 17:54:59 +00:00
parent e365cb1d33
commit c38c47d264
7 changed files with 21 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
femtolisp/Makefile
View File

@ -12,7 +12,7 @@ FLAGS = -falign-functions -Wall -Wextra -Wno-strict-aliasing -I$(LLTDIR) $(CFLAG
LIBS = $(LLT) -lm
DEBUGFLAGS = -g -DDEBUG $(FLAGS)
SHIPFLAGS = -O3 -DNDEBUG -fomit-frame-pointer -march=native $(FLAGS)
SHIPFLAGS = -O3 -DNDEBUG -march=native $(FLAGS)
default: release test

4
femtolisp/compiler.lsp
View File

@ -16,7 +16,7 @@
:cons :list :car :cdr :set-car! :set-cdr!
:apply
:+ :- :* :/ :div := :< :compare
:+ :- :* :/ :div0 := :< :compare
:vector :aref :aset!
@ -41,7 +41,7 @@
:set-cdr! 2 := 2
:< 2 :compare 2
:aref 2 :aset! 3
:div 2))
:div0 2))
(define (make-code-emitter) (vector () (table) 0))
(define (emit e inst . args)

4
femtolisp/cvalues.c
View File

@ -1303,9 +1303,9 @@ static value_t fl_idiv2(value_t a, value_t b)
int64_t a64, b64;
if (!num_to_ptr(a, &ai, &ta, &aptr))
type_error("div", "number", a);
type_error("div0", "number", a);
if (!num_to_ptr(b, &bi, &tb, &bptr))
type_error("div", "number", b);
type_error("div0", "number", b);
if (ta == T_UINT64) {
if (tb == T_UINT64) {

10
femtolisp/flisp.boot
View File

@ -96,8 +96,10 @@ nestlist
#function("n3e0f2`326>0_;f1e1f0f0f131f2av33K;" [<= nestlist])
negative?
#function("n1f0`X;" [])
mod
mod0
#function("n2f0f0f1Vf1T2v;" [])
mod
#function("n2f0e0f0f132f1T2v;" [div])
memv
#function("n2f1?6:0^;f1Mf0=6F0f1;e0f0f1N42;" [memv])
member
@ -200,6 +202,8 @@ emit-nothing
#function("n1f0;" [])
emit
#function("o2e0f1c1326I0c2f0a[q325J0^2f0`e3f1f2Kf0`[32\\2f0;" [memq (:loadv :loadg :setg) #function("rc0g00b2[q42;" [#function("rc0g12Mq42;" [#function("rc0e1g10f0326K0e2g10f0325f0e3g10f0g00332g00auk002g00avq42;" [#function("rg30b2g10\\2f0L1k322e0f0c1326Z0c2g31q32k31;^;" [>= 256 #function("rf0e0=6<0e1;f0e2=6G0e3;f0e4=6R0e5;^;" [:loadv :loadv.l :loadg :loadg.l :setg :setg.l])]) has? get put!])])]) nreconc])
div
#function("n2f0f1Vf0`X16Q02f1`X16J02a17Q02b/17W02`u;" [])
display
#function("n1e0f0312];" [princ])
disassemble
@ -297,7 +301,7 @@ array?
argc-error
#function("n2e0e1c2f0c3f1f1aW6J0c45L0c53541;" [error string "compile error: " " expects " " argument." " arguments."])
arg-counts
#table(:not 1 :set-cdr! 2 :div 2 :cons 2 :number? 1 :equal? 2 :cdr 1 :vector? 1 :eqv? 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 := 2 :div0 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("n2f0A6;0f1;f0Me0f0Nf132K;" [append2])
append
@ -315,7 +319,7 @@ __init_globals
MAX_ARGS
127
Instructions
#table(:sub2 70 :nop 0 :set-cdr! 32 :/ 37 :setc 59 :tapply 68 :div 38 :cons 27 dummy_nil 74 :equal? 14 :cdr 30 :call 3 :eqv? 13 := 39 :setg.l 60 :list 28 :atom? 15 :aref 43 :load0 48 :let 66 dummy_t 72 :argc 62 :< 40 :null? 17 :loadg 53 :load1 49 :car 29 :brt.l 10 :vargc 63 :loada 54 :set-car! 31 :setg 57 :aset! 44 :bound? 21 :pair? 22 :symbol? 19 :fixnum? 25 :loadi8 50 :not 16 :* 36 :neg 71 :pop 2 :loadnil 47 :brf 6 :vector 42 :- 35 :loadv 51 :closure 61 dummy_f 73 :number? 20 :trycatch 64 :add2 69 :loadv.l 52 :vector? 24 :brf.l 9 :seta 58 :apply 33 :dup 1 :copyenv 65 :for 67 :loadc 55 :compare 41 :eq? 12 :function? 26 :+ 34 :jmp 5 :loadt 45 :brt 7 :builtin? 23 :loadg.l 56 :tcall 4 :ret 11 :boolean? 18 :loadf 46 :jmp.l 8)
#table(:sub2 70 :nop 0 :set-cdr! 32 :/ 37 :setc 59 :tapply 68 :cons 27 dummy_nil 74 :equal? 14 :cdr 30 :call 3 :eqv? 13 := 39 :setg.l 60 :list 28 :atom? 15 :aref 43 :load0 48 :let 66 dummy_t 72 :argc 62 :< 40 :null? 17 :loadg 53 :load1 49 :car 29 :brt.l 10 :vargc 63 :loada 54 :set-car! 31 :setg 57 :aset! 44 :bound? 21 :pair? 22 :symbol? 19 :fixnum? 25 :loadi8 50 :not 16 :* 36 :neg 71 :pop 2 :loadnil 47 :brf 6 :vector 42 :- 35 :loadv 51 :closure 61 dummy_f 73 :number? 20 :trycatch 64 :add2 69 :loadv.l 52 :vector? 24 :brf.l 9 :seta 58 :apply 33 :dup 1 :div0 38 :copyenv 65 :for 67 :loadc 55 :compare 41 :eq? 12 :function? 26 :+ 34 :jmp 5 :loadt 45 :brt 7 :builtin? 23 :loadg.l 56 :tcall 4 :ret 11 :boolean? 18 :loadf 46 :jmp.l 8)
>=
#function("n2f1f0X17A02f0f1W;" [])
>

2
femtolisp/flisp.c
View File

@ -67,7 +67,7 @@ static char *builtin_names[] =
"apply",
// arithmetic
"+", "-", "*", "/", "div", "=", "<", "compare",
"+", "-", "*", "/", "div0", "=", "<", "compare",
// sequences
"vector", "aref", "aset!",

8
femtolisp/system.lsp
View File

@ -102,8 +102,14 @@
(define (odd? x) (not (even? x)))
(define (1+ n) (+ n 1))
(define (1- n) (- n 1))
(define (mod0 x y) (- x (* (div0 x y) y)))
(define (div x y) (+ (div0 x y)
(or (and (< x 0)
(or (and (< y 0) 1)
-1))
0)))
(define (mod x y) (- x (* (div x y) y)))
(define remainder mod)
(define remainder mod0)
(define (random n)
(if (integer? n)
(mod (rand) n)

2
llt/operators.c
View File

@ -238,7 +238,7 @@ int cmp_lt(void *a, numerictype_t atag, void *b, numerictype_t btag)
int cmp_eq(void *a, numerictype_t atag, void *b, numerictype_t btag,
int equalnans)
{
if (atag==btag && !equalnans)
if (atag==btag && (!equalnans || atag < T_FLOAT))
return cmp_same_eq(a, b, atag);
double da = conv_to_double(a, atag);