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

fx{+,-,*}/carry now chech that all their arguments are fixnums 

(causes segfaults when unchecked).
This commit is contained in:
Abdulaziz Ghuloum 2009-08-24 15:22:51 +03:00
parent 402c4aa468
commit 8bd012bfeb
2 changed files with 11 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
scheme/ikarus.fixnums.ss
View File

@ -368,19 +368,26 @@
(die 'fxmax "not a fixnum" z)))] (die 'fxmax "not a fixnum" z)))]
[(x) (if (fixnum? x) x (die 'fxmax "not a fixnum" x))])) [(x) (if (fixnum? x) x (die 'fxmax "not a fixnum" x))]))
(define (fx*/carry fx1 fx2 fx3) (define-syntax define-fx
(syntax-rules ()
[(_ (name arg* ...) body)
(define (name arg* ...)
(unless (fixnum? arg*) (die 'name "not a fixnum" arg*)) ...
body)]))
(define-fx (fx*/carry fx1 fx2 fx3)
(let ([s0 ($fx+ ($fx* fx1 fx2) fx3)]) (let ([s0 ($fx+ ($fx* fx1 fx2) fx3)])
(values (values
s0 s0
(sra (+ (* fx1 fx2) (- fx3 s0)) (fixnum-width))))) (sra (+ (* fx1 fx2) (- fx3 s0)) (fixnum-width)))))
(define (fx+/carry fx1 fx2 fx3) (define-fx (fx+/carry fx1 fx2 fx3)
(let ([s0 ($fx+ ($fx+ fx1 fx2) fx3)]) (let ([s0 ($fx+ ($fx+ fx1 fx2) fx3)])
(values (values
s0 s0
(sra (+ (+ fx1 fx2) (- fx3 s0)) (fixnum-width))))) (sra (+ (+ fx1 fx2) (- fx3 s0)) (fixnum-width)))))
(define (fx-/carry fx1 fx2 fx3) (define-fx (fx-/carry fx1 fx2 fx3)
(let ([s0 ($fx- ($fx- fx1 fx2) fx3)]) (let ([s0 ($fx- ($fx- fx1 fx2) fx3)])
(values (values
s0 s0

2
scheme/last-revision
View File

@ -1 +1 @@
1843 1844