suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix overflow detection for fxsll, fxarithmetic-shift-left and fxarithmetic-shift

Browse Source 
original commit: f286688b64f877248ab8d8f00528d19363c6ceba
This commit is contained in:
Bob Burger 2017-05-05 15:11:59 -04:00
parent d1a5bcf399
commit 323eb3c285
6 changed files with 201 additions and 161 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
LOG
View File

@ -453,3 +453,6 @@
- fix invalid memory reference when enum-set-indexer procedure is not
passed a symbol
enum.ss, enum.ms, root-experr*, release_notes.stex
- fix overflow detection for fxsll, fxarithmetic-shift-left, and
fxarithmetic-shift
library.ss, fx.ms, release_notes.stex

265
mats/fx.ms
View File

@ -1418,80 +1418,89 @@
)
(mat fxsll
(error? (fxsll 1 -1))
(eqv? (fxsll 1 0) 1)
(eqv? (fxsll 1 1) 2)
(eqv? (fxsll 1 2) 4)
(eqv? (fxsll 1 3) 8)
(eqv? (fxsll 1 4) 16)
(eqv? (fxsll 1 (/ 8 2)) 16)
; check for overflow error when sign changes
(error? (fxsll 1 (integer-length (most-positive-fixnum))))
(error? (fxsll #x1000 (integer-length (most-positive-fixnum))))
(error? (fxsll -1 (+ (integer-length (most-positive-fixnum)) 1)))
(error? (fxsll (most-positive-fixnum) 1))
(error? (fxsll (most-positive-fixnum) 10))
(error? (fxsll #x1000 (integer-length (most-positive-fixnum))))
(error? (fxsll (most-negative-fixnum) 1))
(eqv? (fxsll 0 (+ (integer-length (most-positive-fixnum)) 1)) 0)
(let ()
(define expt2
(lambda (i)
(if (= i 0)
1
(* 2 (expt2 (- i 1))))))
(trace-define check
(lambda (i)
(eqv? (fxsll 1 i) (expt2 i))))
(do ([i 0 (fx+ i 1)] [a #t (and a (check i))])
((fx= i (integer-length (most-positive-fixnum))) a)))
(test-cp0-expansion eqv? '(fxsll 1 0) 1)
(test-cp0-expansion eqv? '(fxsll 1 1) 2)
(test-cp0-expansion eqv? '(fxsll 1 2) 4)
(test-cp0-expansion eqv? '(fxsll 1 3) 8)
(test-cp0-expansion eqv? '(fxsll 1 4) 16)
(test-cp0-expansion eqv? '(fxsll 1 (/ 8 2)) 16)
)
(error? (fxsll 1 -1))
(eqv? (fxsll 1 0) 1)
(eqv? (fxsll 1 1) 2)
(eqv? (fxsll 1 2) 4)
(eqv? (fxsll 1 3) 8)
(eqv? (fxsll 1 4) 16)
(eqv? (fxsll 1 (/ 8 2)) 16)
(eqv? (fxsll (fxsra (most-positive-fixnum) 1) 1) (- (most-positive-fixnum) 1))
(eqv? (fxsll (fxsra (most-negative-fixnum) 1) 1) (most-negative-fixnum))
(error? (fxsll 0 (+ (fixnum-width) 1)))
; check for overflow error when sign changes
(error? (fxsll 1 (- (fixnum-width) 1)))
(error? (fxsll #x1001 (- (fixnum-width) 2)))
(error? (fxsll -1 (fixnum-width)))
(error? (fxsll (most-positive-fixnum) 1))
(error? (fxsll (most-positive-fixnum) 10))
(error? (fxsll #x-1001 (- (fixnum-width) 2)))
(error? (fxsll (most-negative-fixnum) 1))
(eqv? (fxsll 0 (fixnum-width)) 0)
(let ()
(define expt2
(lambda (i)
(if (= i 0)
1
(* 2 (expt2 (- i 1))))))
(define check ; use trace-define to debug
(lambda (i)
(let ([x (expt2 i)])
(and (eqv? (fxsll 1 i) x)
(eqv? (fxsll -1 i) (- x))))))
(do ([i 0 (fx+ i 1)] [a #t (and a (check i))])
((fx= i (- (fixnum-width) 1)) a)))
(test-cp0-expansion eqv? '(fxsll 1 0) 1)
(test-cp0-expansion eqv? '(fxsll 1 1) 2)
(test-cp0-expansion eqv? '(fxsll 1 2) 4)
(test-cp0-expansion eqv? '(fxsll 1 3) 8)
(test-cp0-expansion eqv? '(fxsll 1 4) 16)
(test-cp0-expansion eqv? '(fxsll 1 (/ 8 2)) 16)
)
(mat fxarithmetic-shift-left
; bound on shift count is one less than for fxsll
(error? (fxarithmetic-shift-left 0 (fixnum-width)))
(error? (fxarithmetic-shift-left 0 'a))
(error? (fxarithmetic-shift-left 0 1e23))
(error? (fxarithmetic-shift-left 0 (+ (most-positive-fixnum) 1)))
(error? (fxarithmetic-shift-left 1 -1))
(eqv? (fxarithmetic-shift-left 1 0) 1)
(eqv? (fxarithmetic-shift-left 1 1) 2)
(eqv? (fxarithmetic-shift-left 1 2) 4)
(eqv? (fxarithmetic-shift-left 1 3) 8)
(eqv? (fxarithmetic-shift-left 1 4) 16)
(eqv? (fxarithmetic-shift-left 1 (/ 8 2)) 16)
; check for overflow error when sign changes
(error? (fxarithmetic-shift-left 1 (integer-length (most-positive-fixnum))))
(error? (fxarithmetic-shift-left #x1000 (integer-length (most-positive-fixnum))))
(error? (fxarithmetic-shift-left -1 (+ (integer-length (most-positive-fixnum)) 1)))
(error? (fxarithmetic-shift-left (most-positive-fixnum) 1))
(error? (fxarithmetic-shift-left (most-positive-fixnum) 10))
(error? (fxarithmetic-shift-left #x1000 (integer-length (most-positive-fixnum))))
(error? (fxarithmetic-shift-left (most-negative-fixnum) 1))
(let ()
(define expt2
(lambda (i)
(if (= i 0)
1
(* 2 (expt2 (- i 1))))))
(trace-define check
(lambda (i)
(eqv? (fxarithmetic-shift-left 1 i) (expt2 i))))
(do ([i 0 (fx+ i 1)] [a #t (and a (check i))])
((fx= i (integer-length (most-positive-fixnum))) a)))
(test-cp0-expansion eqv? '(fxarithmetic-shift-left 1 0) 1)
(test-cp0-expansion eqv? '(fxarithmetic-shift-left 1 1) 2)
(test-cp0-expansion eqv? '(fxarithmetic-shift-left 1 2) 4)
(test-cp0-expansion eqv? '(fxarithmetic-shift-left 1 3) 8)
(test-cp0-expansion eqv? '(fxarithmetic-shift-left 1 4) 16)
(test-cp0-expansion eqv? '(fxarithmetic-shift-left 1 (/ 8 2)) 16)
)
(error? (fxarithmetic-shift-left 0 (fixnum-width)))
(error? (fxarithmetic-shift-left 0 'a))
(error? (fxarithmetic-shift-left 0 1e23))
(error? (fxarithmetic-shift-left 0 (+ (most-positive-fixnum) 1)))
(error? (fxarithmetic-shift-left 1 -1))
(eqv? (fxarithmetic-shift-left 1 0) 1)
(eqv? (fxarithmetic-shift-left 1 1) 2)
(eqv? (fxarithmetic-shift-left 1 2) 4)
(eqv? (fxarithmetic-shift-left 1 3) 8)
(eqv? (fxarithmetic-shift-left 1 4) 16)
(eqv? (fxarithmetic-shift-left 1 (/ 8 2)) 16)
(eqv? (fxarithmetic-shift-left (fxsra (most-positive-fixnum) 1) 1) (- (most-positive-fixnum) 1))
(eqv? (fxarithmetic-shift-left (fxsra (most-negative-fixnum) 1) 1) (most-negative-fixnum))
; check for overflow error when sign changes
(error? (fxarithmetic-shift-left 1 (- (fixnum-width) 1)))
(error? (fxarithmetic-shift-left #x1001 (- (fixnum-width) 2)))
(error? (fxarithmetic-shift-left -1 (fixnum-width)))
(error? (fxarithmetic-shift-left (most-positive-fixnum) 1))
(error? (fxarithmetic-shift-left (most-positive-fixnum) 10))
(error? (fxarithmetic-shift-left #x-1001 (- (fixnum-width) 2)))
(error? (fxarithmetic-shift-left (most-negative-fixnum) 1))
(let ()
(define expt2
(lambda (i)
(if (= i 0)
1
(* 2 (expt2 (- i 1))))))
(define check ; use trace-define to debug
(lambda (i)
(let ([x (expt2 i)])
(and (eqv? (fxarithmetic-shift-left 1 i) x)
(eqv? (fxarithmetic-shift-left -1 i) (- x))))))
(do ([i 0 (fx+ i 1)] [a #t (and a (check i))])
((fx= i (- (fixnum-width) 1)) a)))
(test-cp0-expansion eqv? '(fxarithmetic-shift-left 1 0) 1)
(test-cp0-expansion eqv? '(fxarithmetic-shift-left 1 1) 2)
(test-cp0-expansion eqv? '(fxarithmetic-shift-left 1 2) 4)
(test-cp0-expansion eqv? '(fxarithmetic-shift-left 1 3) 8)
(test-cp0-expansion eqv? '(fxarithmetic-shift-left 1 4) 16)
(test-cp0-expansion eqv? '(fxarithmetic-shift-left 1 (/ 8 2)) 16)
)
(mat fxsrl
(error? (fxsrl 1 -1))
@ -1571,61 +1580,65 @@
)
(mat fxarithmetic-shift
(error? (fxarithmetic-shift 1 (fixnum-width)))
(error? (fxarithmetic-shift 1 (- (fixnum-width))))
(error? (fxarithmetic-shift 1 'a))
(error? (fxarithmetic-shift 'a 17))
(error? (fxarithmetic-shift (+ (most-positive-fixnum) 1) 2))
(eqv? (fxarithmetic-shift 0 (- (fixnum-width) 1)) 0)
(eqv? (fxarithmetic-shift 16 -5) 0)
(eqv? (fxarithmetic-shift 16 -4) 1)
(eqv? (fxarithmetic-shift 16 -3) 2)
(eqv? (fxarithmetic-shift 16 -2) 4)
(eqv? (fxarithmetic-shift 16 -1) 8)
(eqv? (fxarithmetic-shift 16 -0) 16)
(eqv? (fxarithmetic-shift -1 -1) -1)
(eqv? (fxarithmetic-shift 16 (/ -8 2)) 1)
(eqv? (fxarithmetic-shift 1 0) 1)
(eqv? (fxarithmetic-shift 1 1) 2)
(eqv? (fxarithmetic-shift 1 2) 4)
(eqv? (fxarithmetic-shift 1 3) 8)
(eqv? (fxarithmetic-shift 1 4) 16)
(eqv? (fxarithmetic-shift 1 (/ 8 2)) 16)
; check for overflow error when sign changes
(error? (fxarithmetic-shift 1 (integer-length (most-positive-fixnum))))
(error? (fxarithmetic-shift #x1000 (integer-length (most-positive-fixnum))))
(error? (fxarithmetic-shift -1 (+ (integer-length (most-positive-fixnum)) 1)))
(error? (fxarithmetic-shift (most-positive-fixnum) 1))
(error? (fxarithmetic-shift (most-positive-fixnum) 10))
(error? (fxarithmetic-shift #x1000 (integer-length (most-positive-fixnum))))
(error? (fxarithmetic-shift (most-negative-fixnum) 1))
(let ()
(define expt2
(lambda (i)
(if (= i 0)
1
(* 2 (expt2 (- i 1))))))
(trace-define check
(lambda (i)
(eqv? (fxarithmetic-shift 1 i) (expt2 i))))
(do ([i 0 (fx+ i 1)] [a #t (and a (check i))])
((fx= i (integer-length (most-positive-fixnum))) a)))
(test-cp0-expansion eqv? '(fxarithmetic-shift 0 (- (fixnum-width) 1)) 0)
(test-cp0-expansion eqv? '(fxarithmetic-shift 16 -5) 0)
(test-cp0-expansion eqv? '(fxarithmetic-shift 16 -4) 1)
(test-cp0-expansion eqv? '(fxarithmetic-shift 16 -3) 2)
(test-cp0-expansion eqv? '(fxarithmetic-shift 16 -2) 4)
(test-cp0-expansion eqv? '(fxarithmetic-shift 16 -1) 8)
(test-cp0-expansion eqv? '(fxarithmetic-shift 16 -0) 16)
(test-cp0-expansion eqv? '(fxarithmetic-shift -1 -1) -1)
(test-cp0-expansion eqv? '(fxarithmetic-shift 16 (/ -8 2)) 1)
(test-cp0-expansion eqv? '(fxarithmetic-shift 1 0) 1)
(test-cp0-expansion eqv? '(fxarithmetic-shift 1 1) 2)
(test-cp0-expansion eqv? '(fxarithmetic-shift 1 2) 4)
(test-cp0-expansion eqv? '(fxarithmetic-shift 1 3) 8)
(test-cp0-expansion eqv? '(fxarithmetic-shift 1 4) 16)
(test-cp0-expansion eqv? '(fxarithmetic-shift 1 (/ 8 2)) 16)
)
(error? (fxarithmetic-shift 1 (fixnum-width)))
(error? (fxarithmetic-shift 1 (- (fixnum-width))))
(error? (fxarithmetic-shift 1 'a))
(error? (fxarithmetic-shift 'a 17))
(error? (fxarithmetic-shift (+ (most-positive-fixnum) 1) 2))
(eqv? (fxarithmetic-shift 0 (- (fixnum-width) 1)) 0)
(eqv? (fxarithmetic-shift 16 -5) 0)
(eqv? (fxarithmetic-shift 16 -4) 1)
(eqv? (fxarithmetic-shift 16 -3) 2)
(eqv? (fxarithmetic-shift 16 -2) 4)
(eqv? (fxarithmetic-shift 16 -1) 8)
(eqv? (fxarithmetic-shift 16 -0) 16)
(eqv? (fxarithmetic-shift -1 -1) -1)
(eqv? (fxarithmetic-shift 16 (/ -8 2)) 1)
(eqv? (fxarithmetic-shift 1 0) 1)
(eqv? (fxarithmetic-shift 1 1) 2)
(eqv? (fxarithmetic-shift 1 2) 4)
(eqv? (fxarithmetic-shift 1 3) 8)
(eqv? (fxarithmetic-shift 1 4) 16)
(eqv? (fxarithmetic-shift 1 (/ 8 2)) 16)
(eqv? (fxarithmetic-shift (fxsra (most-positive-fixnum) 1) 1) (- (most-positive-fixnum) 1))
(eqv? (fxarithmetic-shift (fxsra (most-negative-fixnum) 1) 1) (most-negative-fixnum))
; check for overflow error when sign changes
(error? (fxarithmetic-shift 1 (- (fixnum-width) 1)))
(error? (fxarithmetic-shift #x1001 (- (fixnum-width) 2)))
(error? (fxarithmetic-shift -1 (fixnum-width)))
(error? (fxarithmetic-shift (most-positive-fixnum) 1))
(error? (fxarithmetic-shift (most-positive-fixnum) 10))
(error? (fxarithmetic-shift #x-1001 (- (fixnum-width) 2)))
(error? (fxarithmetic-shift (most-negative-fixnum) 1))
(let ()
(define expt2
(lambda (i)
(if (= i 0)
1
(* 2 (expt2 (- i 1))))))
(define check ; use trace-define to debug
(lambda (i)
(let ([x (expt2 i)])
(and (eqv? (fxarithmetic-shift 1 i) x)
(eqv? (fxarithmetic-shift -1 i) (- x))))))
(do ([i 0 (fx+ i 1)] [a #t (and a (check i))])
((fx= i (- (fixnum-width) 1)) a)))
(test-cp0-expansion eqv? '(fxarithmetic-shift 0 (- (fixnum-width) 1)) 0)
(test-cp0-expansion eqv? '(fxarithmetic-shift 16 -5) 0)
(test-cp0-expansion eqv? '(fxarithmetic-shift 16 -4) 1)
(test-cp0-expansion eqv? '(fxarithmetic-shift 16 -3) 2)
(test-cp0-expansion eqv? '(fxarithmetic-shift 16 -2) 4)
(test-cp0-expansion eqv? '(fxarithmetic-shift 16 -1) 8)
(test-cp0-expansion eqv? '(fxarithmetic-shift 16 -0) 16)
(test-cp0-expansion eqv? '(fxarithmetic-shift -1 -1) -1)
(test-cp0-expansion eqv? '(fxarithmetic-shift 16 (/ -8 2)) 1)
(test-cp0-expansion eqv? '(fxarithmetic-shift 1 0) 1)
(test-cp0-expansion eqv? '(fxarithmetic-shift 1 1) 2)
(test-cp0-expansion eqv? '(fxarithmetic-shift 1 2) 4)
(test-cp0-expansion eqv? '(fxarithmetic-shift 1 3) 8)
(test-cp0-expansion eqv? '(fxarithmetic-shift 1 4) 16)
(test-cp0-expansion eqv? '(fxarithmetic-shift 1 (/ 8 2)) 16)
)
(mat fxbit-field
(error? (fxbit-field))

19
mats/root-experr-compile-0-f-f-f
View File

@ -8572,24 +8572,25 @@ fx.mo:Expected error in mat fxnot: "fxnot: "hello" is not a fixnum".
fx.mo:Expected error in mat fxnot: "fxnot: <int> is not a fixnum".
fx.mo:Expected error in mat fxnot: "fxnot: <-int> is not a fixnum".
fx.mo:Expected error in mat fxsll: "fxsll: invalid shift count -1".
fx.mo:Expected error in mat fxsll: "fxsll: invalid shift count <int>".
fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments 1 and <int>".
fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments 4096 and <int>".
fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments 4097 and <int>".
fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments -1 and <int>".
fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments <int> and 1".
fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments <int> and 10".
fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments 4096 and <int>".
fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments -4097 and <int>".
fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments <-int> and 1".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: invalid shift count <int>".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxsll: a is not a fixnum".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxsll: 1e23 is not a fixnum".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxsll: <int> is not a fixnum".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: a is not a fixnum".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: 1e23 is not a fixnum".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: <int> is not a fixnum".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: invalid shift count -1".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments 1 and <int>".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments 4096 and <int>".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments 4097 and <int>".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: invalid shift count <int>".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments <int> and 1".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments <int> and 10".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments 4096 and <int>".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments -4097 and <int>".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments <-int> and 1".
fx.mo:Expected error in mat fxsrl: "fxsrl: invalid shift count -1".
fx.mo:Expected error in mat fxsrl: "fxsrl: invalid shift count <int>".
@ -8614,11 +8615,11 @@ fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: a is not a
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: a is not a fixnum".
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: <int> is not a fixnum".
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments 1 and <int>".
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments 4096 and <int>".
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments 4097 and <int>".
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: invalid shift count <int>".
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments <int> and 1".
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments <int> and 10".
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments 4096 and <int>".
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments -4097 and <int>".
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments <-int> and 1".
fx.mo:Expected error in mat fxbit-field: "incorrect argument count in call (fxbit-field)".
fx.mo:Expected error in mat fxbit-field: "incorrect argument count in call (fxbit-field 35)".

19
mats/root-experr-compile-2-f-f-f
View File

@ -8572,24 +8572,25 @@ fx.mo:Expected error in mat fxnot: "fxnot: "hello" is not a fixnum".
fx.mo:Expected error in mat fxnot: "fxnot: <int> is not a fixnum".
fx.mo:Expected error in mat fxnot: "fxnot: <-int> is not a fixnum".
fx.mo:Expected error in mat fxsll: "fxsll: invalid shift count -1".
fx.mo:Expected error in mat fxsll: "fxsll: invalid shift count <int>".
fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments 1 and <int>".
fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments 4096 and <int>".
fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments 4097 and <int>".
fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments -1 and <int>".
fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments <int> and 1".
fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments <int> and 10".
fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments 4096 and <int>".
fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments -4097 and <int>".
fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments <-int> and 1".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: invalid shift count <int>".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxsll: a is not a fixnum".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxsll: 1e23 is not a fixnum".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxsll: <int> is not a fixnum".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: a is not a fixnum".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: 1e23 is not a fixnum".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: <int> is not a fixnum".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: invalid shift count -1".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments 1 and <int>".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments 4096 and <int>".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments 4097 and <int>".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: invalid shift count <int>".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments <int> and 1".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments <int> and 10".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments 4096 and <int>".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments -4097 and <int>".
fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments <-int> and 1".
fx.mo:Expected error in mat fxsrl: "fxsrl: invalid shift count -1".
fx.mo:Expected error in mat fxsrl: "fxsrl: invalid shift count <int>".
@ -8614,11 +8615,11 @@ fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: a is not a
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: a is not a fixnum".
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: <int> is not a fixnum".
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments 1 and <int>".
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments 4096 and <int>".
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments 4097 and <int>".
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: invalid shift count <int>".
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments <int> and 1".
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments <int> and 10".
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments 4096 and <int>".
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments -4097 and <int>".
fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments <-int> and 1".
fx.mo:Expected error in mat fxbit-field: "incorrect argument count in call (fxbit-field)".
fx.mo:Expected error in mat fxbit-field: "incorrect argument count in call (fxbit-field 35)".

11
release_notes/release_notes.stex
View File

@ -1490,6 +1490,15 @@ in fasl files does not generally make sense.
%-----------------------------------------------------------------------------
\section{Bug Fixes}\label{section:bugfixes}
\subsection{Overflow detection for \protect\scheme{fxsll},
\protect\scheme{fxarithmetic-shift-left}, and
\protect\scheme{fxarithmetic-shift}}
A bug that caused \scheme{fxsll}, \scheme{fxarithmetic-shift-left},
and \scheme{fxarithmetic-shift} to fail to detect overflow in certain
cases was fixed.
[This bug dated back to Version 7.1 or earlier.]
\subsection{Invalid memory reference when \protect\scheme{enum-set-indexer} procedure is not passed a symbol}
A bug that caused the procedure returned by \scheme{enum-set-indexer}
@ -1503,7 +1512,7 @@ The C heap storage for inaccessible mutexes and conditions is now reclaimed.
\subsection{Missing guardian entries when a thread exits (9.4.1)}
A bug that causes guardian entries for a thread to be lost when a
A bug that caused guardian entries for a thread to be lost when a
thread exits has been fixed.
[This bug dated back to Version 6.5.]

45
s/library.ss
View File

@ -475,22 +475,31 @@
(cond
[(not (fixnum? x)) (fxnonfixnum1 'fxsll x)]
[(not (fixnum? y)) (fxnonfixnum1 'fxsll y)]
[(fx<= 0 y (constant fixnum-bits))
(let ([n (#3%fxsll x y)])
(if (if (fx< x 0) (fx> n x) (fx< n x))
(fxoops2 'fxsll x y)
n))]
[(fx= 0 y) x]
[($fxu< y (constant fixnum-bits))
(if (fx>= x 0)
(if (fx< x (fxsll 1 (fx- (- (constant fixnum-bits) 1) y)))
(fxsll x y)
(fxoops2 'fxsll x y))
(if (fx>= x (fxsll -1 (fx- (- (constant fixnum-bits) 1) y)))
(fxsll x y)
(fxoops2 'fxsll x y)))]
[(fx= y (constant fixnum-bits)) (if (fx= x 0) x (fxoops2 'fxsll x y))]
[else (shift-count-oops 'fxsll y)]))
(define-library-entry (fxarithmetic-shift-left x y)
(cond
[(not (fixnum? x)) (fxnonfixnum1 'fxsll x)]
[(not (fixnum? y)) (fxnonfixnum1 'fxsll y)]
[(fx<= 0 y (- (constant fixnum-bits) 1))
(let ([n (#3%fxarithmetic-shift-left x y)])
(if (if (fx< x 0) (fx> n x) (fx< n x))
(fxoops2 'fxarithmetic-shift-left x y)
n))]
[(not (fixnum? x)) (fxnonfixnum1 'fxarithmetic-shift-left x)]
[(not (fixnum? y)) (fxnonfixnum1 'fxarithmetic-shift-left y)]
[(fx= 0 y) x]
[($fxu< y (constant fixnum-bits))
(if (fx>= x 0)
(if (fx< x (fxsll 1 (fx- (- (constant fixnum-bits) 1) y)))
(fxsll x y)
(fxoops2 'fxarithmetic-shift-left x y))
(if (fx>= x (fxsll -1 (fx- (- (constant fixnum-bits) 1) y)))
(fxsll x y)
(fxoops2 'fxarithmetic-shift-left x y)))]
[else (shift-count-oops 'fxarithmetic-shift-left y)]))
(define-library-entry (fxsrl x y)
@ -515,11 +524,15 @@
(cond
[(not (fixnum? x)) (fxnonfixnum1 'fxarithmetic-shift x)]
[(not (fixnum? y)) (fxnonfixnum1 'fxarithmetic-shift y)]
[(fx= 0 y) x]
[($fxu< y (constant fixnum-bits))
(let ([n (#3%fxsll x y)])
(if (if (fx< x 0) (fx> n x) (fx< n x))
(fxoops2 'fxarithmetic-shift x y)
n))]
(if (fx>= x 0)
(if (fx< x (fxsll 1 (fx- (- (constant fixnum-bits) 1) y)))
(fxsll x y)
(fxoops2 'fxarithmetic-shift x y))
(if (fx>= x (fxsll -1 (fx- (- (constant fixnum-bits) 1) y)))
(fxsll x y)
(fxoops2 'fxarithmetic-shift x y)))]
[(fx< (fx- (constant fixnum-bits)) y 0) (fxsra x (fx- y))]
[else (shift-count-oops 'fxarithmetic-shift y)]))