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

Fixes bug 191659: add1 and sub1 are slow

This commit is contained in:
Abdulaziz Ghuloum 2008-02-13 18:12:00 -05:00
parent 66b9f6968e
commit f6b35c4506
7 changed files with 58 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
scheme/ikarus.boot.prebuilt
View File

Binary file not shown.

29
scheme/ikarus.fixnums.ss
View File

@ -26,7 +26,7 @@
fixnum->string
fxarithmetic-shift-left fxarithmetic-shift-right fxarithmetic-shift
fxmin fxmax
error@fx+ error@fx* error@fx-)
error@fx+ error@fx* error@fx- error@fxadd1 error@fxsub1)
(import
(ikarus system $fx)
(ikarus system $chars)
@ -52,17 +52,6 @@
[(fixnum? x) #f]
[else (die 'fxzero? "not a fixnum" x)])))
(define fxadd1
(lambda (n)
(if (fixnum? n)
($fxadd1 n)
(die 'fxadd1 "not a fixnum" n))))
(define fxsub1
(lambda (n)
(if (fixnum? n)
($fxsub1 n)
(die 'fxsub1 "not a fixnum" n))))
(define fxlognot
(lambda (x)
@ -107,6 +96,22 @@
[(x y) (sys:fx- x y)]
[(x) (sys:fx- x)]))
(define error@fxadd1
(make-fx-error 'fxadd1 "overflow during addition"))
(define error@fxsub1
(make-fx-error 'fxsub1 "overflow during subtraction"))
(define fxadd1
(lambda (n)
(import (ikarus))
(fxadd1 n)))
(define fxsub1
(lambda (n)
(import (ikarus))
(fxsub1 n)))
(define false-loop
(lambda (who ls)
(if (pair? ls)

33
scheme/ikarus.numerics.ss
View File

@ -406,7 +406,8 @@
exact->inexact inexact floor ceiling round log fl=? fl<? fl<=? fl>?
fl>=? fl+ fl- fl* fl/ flsqrt flmin flzero? flnegative?
sin cos tan asin acos atan sqrt exp
flmax random)
flmax random
error@add1 error@sub1)
(import
(ikarus system $fx)
(ikarus system $flonums)
@ -1720,23 +1721,31 @@
(mk< >= $fx>= fxbn> bnfx> bnbn>= fxfl>= flfx>= bnfl>= flbn>= flfl>=
exrt> rtex> exrt> rtex> flrt>= rtfl>= rtrt>=))
(define error@add1
(lambda (x)
(import (ikarus))
(cond
[(fixnum? x) (+ (greatest-fixnum) 1)]
[(number? x) (+ x 1)]
[else (die 'add1 "not a number" x)])))
(define add1
(lambda (x)
(import (ikarus))
(add1 x)))
(define error@sub1
(lambda (x)
(import (ikarus))
(cond
[(fixnum? x)
(foreign-call "ikrt_fxfxplus" x 1)]
[(bignum? x)
(foreign-call "ikrt_fxbnplus" 1 x)]
[else (die 'add1 "not a number" x)])))
[(fixnum? x) (- (least-fixnum) 1)]
[(number? x) (- x 1)]
[else (die 'sub1 "not a number" x)])))
(define sub1
(lambda (x)
(cond
[(fixnum? x)
(foreign-call "ikrt_fxfxplus" x -1)]
[(bignum? x)
(foreign-call "ikrt_fxbnplus" -1 x)]
[else (die 'sub1 "not a number" x)])))
(import (ikarus))
(sub1 x)))
(define zero?
(lambda (x)

2
scheme/last-revision
View File

@ -1 +1 @@
1382
1383

4
scheme/makefile.ss
View File

@ -567,6 +567,10 @@
[error@fx+ ]
[error@fx* ]
[error@fx- ]
[error@add1 ]
[error@sub1 ]
[error@fxadd1 ]
[error@fxsub1 ]
[fasl-write i]
[lambda i r ba se ne]
[and i r ba se ne]

11
scheme/pass-specify-rep-primops.ss
View File

@ -1199,6 +1199,17 @@
[(E) (nop)]
[(E a . a*) (assert-fixnums a a*)])
(define-primop add1 safe
[(V x) (cogen-value-+ x (K 1))])
(define-primop sub1 safe
[(V x) (cogen-value-+ x (K -1))])
(define-primop fxadd1 safe
[(V x) (cogen-value-+ x (K 1))])
(define-primop fxsub1 safe
[(V x) (cogen-value-+ x (K -1))])
(define-primop * safe
[(V) (K (fxsll 1 fx-shift))]
[(V a b)

4
scheme/pass-specify-rep.ss
View File

@ -58,6 +58,10 @@
[(fx+) 'error@fx+]
[(fx-) 'error@fx-]
[(fx*) 'error@fx*]
[(add1) 'error@add1]
[(sub1) 'error@sub1]
[(fxadd1) 'error@fxadd1]
[(fxsub1) 'error@fxsub1]
[else x]))
(define (make-interrupt-call op args)
(make-funcall