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

fx- now checks for overflow.

This commit is contained in:
Abdulaziz Ghuloum 2008-02-12 15:03:43 -05:00
parent 1683997a12
commit bde9000c06
6 changed files with 22 additions and 27 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.

43
scheme/ikarus.fixnums.ss
View File

@ -26,13 +26,13 @@
fixnum->string fixnum->string
fxarithmetic-shift-left fxarithmetic-shift-right fxarithmetic-shift fxarithmetic-shift-left fxarithmetic-shift-right fxarithmetic-shift
fxmin fxmax fxmin fxmax
error@fx+ error@fx*) error@fx+ error@fx* error@fx-)
(import (import
(ikarus system $fx) (ikarus system $fx)
(ikarus system $chars) (ikarus system $chars)
(ikarus system $pairs) (ikarus system $pairs)
(ikarus system $strings) (ikarus system $strings)
(prefix (only (ikarus) fx+ fx*) sys:) (prefix (only (ikarus) fx+ fx* fx-) sys:)
(except (ikarus) fxzero? fxadd1 fxsub1 fxlognot fx+ fx- fx* (except (ikarus) fxzero? fxadd1 fxsub1 fxlognot fx+ fx- fx*
fxquotient fxremainder fxmodulo fxlogor fxlogand fxquotient fxremainder fxmodulo fxlogor fxlogand
fxlogxor fxsll fxsra fx= fx< fx<= fx> fx>= fxlogxor fxsll fxsra fx= fx< fx<= fx> fx>=
@ -76,38 +76,29 @@
(die 'fxnot "not a fixnum" x)) (die 'fxnot "not a fixnum" x))
($fxlognot x))) ($fxlognot x)))
(define (make-fx-error who msg)
(define error@fx+
(lambda (x y) (lambda (x y)
(if (fixnum? x) (if (fixnum? x)
(if (fixnum? y) (if (fixnum? y)
(die 'fx+ "overflow when adding numbers" x y) (die who msg x y)
(die 'fx+ "not a fixnum" y)) (die who "not a fixnum" y))
(die 'fx+ "not a fixnum" x)))) (die who "not a fixnum" x))))
(define error@fx+
(make-fx-error 'fx+ "overflow when adding numbers"))
(define error@fx-
(make-fx-error 'fx- "overflow when subtracting numbers"))
(define error@fx* (define error@fx*
(lambda (x y) (make-fx-error 'fx* "overflow when multiplying numbers"))
(if (fixnum? x)
(if (fixnum? y)
(die 'fx* "overflow when multiplying numbers" x y)
(die 'fx* "not a fixnum" y))
(die 'fx* "not a fixnum" x))))
(define fx+ (define (fx+ x y) (sys:fx+ x y))
(lambda (x y)
(sys:fx+ x y)))
(define fx- (define (fx* x y) (sys:fx* x y))
(lambda (x y)
(unless (fixnum? x) (define (fx- x y) (sys:fx- x y))
(die 'fx- "not a fixnum" x))
(unless (fixnum? y)
(die 'fx- "not a fixnum" y))
($fx- x y)))
(define fx*
(lambda (x y)
(sys:fx* x y)))
(define false-loop (define false-loop

2
scheme/last-revision
View File

@ -1 +1 @@
1379 1380

1
scheme/makefile.ss
View File

@ -566,6 +566,7 @@
[make-traced-procedure i] [make-traced-procedure i]
[error@fx+ ] [error@fx+ ]
[error@fx* ] [error@fx* ]
[error@fx- ]
[fasl-write i] [fasl-write i]
[lambda i r ba se ne] [lambda i r ba se ne]
[and i r ba se ne] [and i r ba se ne]

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

@ -1247,6 +1247,8 @@
(define-primop fx+ safe (define-primop fx+ safe
[(V x y) (cogen-value-+ x y)]) [(V x y) (cogen-value-+ x y)])
(define-primop fx- safe
[(V x y) (cogen-value-- x y)])
(define-primop fx* safe (define-primop fx* safe
[(V a b) [(V a b)

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

@ -56,6 +56,7 @@
(define (primop-interrupt-handler x) (define (primop-interrupt-handler x)
(case x (case x
[(fx+) 'error@fx+] [(fx+) 'error@fx+]
[(fx-) 'error@fx-]
[(fx*) 'error@fx*] [(fx*) 'error@fx*]
[else x])) [else x]))
(define (make-interrupt-call op args) (define (make-interrupt-call op args)