From 323eb3c2858f3ef7c98b05c191ea899ea8a48736 Mon Sep 17 00:00:00 2001 From: Bob Burger Date: Fri, 5 May 2017 15:11:59 -0400 Subject: [PATCH] fix overflow detection for fxsll, fxarithmetic-shift-left and fxarithmetic-shift original commit: f286688b64f877248ab8d8f00528d19363c6ceba --- LOG | 3 + mats/fx.ms | 265 ++++++++++++++++--------------- mats/root-experr-compile-0-f-f-f | 19 +-- mats/root-experr-compile-2-f-f-f | 19 +-- release_notes/release_notes.stex | 11 +- s/library.ss | 45 ++++-- 6 files changed, 201 insertions(+), 161 deletions(-) diff --git a/LOG b/LOG index 15a3ee5724..922b7b077f 100644 --- a/LOG +++ b/LOG @@ -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 diff --git a/mats/fx.ms b/mats/fx.ms index b11de34b44..0aabaa625d 100644 --- a/mats/fx.ms +++ b/mats/fx.ms @@ -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)) diff --git a/mats/root-experr-compile-0-f-f-f b/mats/root-experr-compile-0-f-f-f index 17fd63b457..234b9d6634 100644 --- a/mats/root-experr-compile-0-f-f-f +++ b/mats/root-experr-compile-0-f-f-f @@ -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: 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 ". fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments 1 and ". -fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments 4096 and ". +fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments 4097 and ". fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments -1 and ". fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments and 1". fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments and 10". -fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments 4096 and ". +fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments -4097 and ". 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 ". -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: 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: 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 ". -fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments 4096 and ". +fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments 4097 and ". fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: invalid shift count ". fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments and 1". fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments and 10". -fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments 4096 and ". +fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments -4097 and ". 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 ". @@ -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: is not a fixnum". fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments 1 and ". -fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments 4096 and ". +fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments 4097 and ". fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: invalid shift count ". fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments and 1". fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments and 10". -fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments 4096 and ". +fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments -4097 and ". 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)". diff --git a/mats/root-experr-compile-2-f-f-f b/mats/root-experr-compile-2-f-f-f index 17fd63b457..234b9d6634 100644 --- a/mats/root-experr-compile-2-f-f-f +++ b/mats/root-experr-compile-2-f-f-f @@ -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: 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 ". fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments 1 and ". -fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments 4096 and ". +fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments 4097 and ". fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments -1 and ". fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments and 1". fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments and 10". -fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments 4096 and ". +fx.mo:Expected error in mat fxsll: "fxsll: fixnum overflow with arguments -4097 and ". 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 ". -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: 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: 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 ". -fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments 4096 and ". +fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments 4097 and ". fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: invalid shift count ". fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments and 1". fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments and 10". -fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments 4096 and ". +fx.mo:Expected error in mat fxarithmetic-shift-left: "fxarithmetic-shift-left: fixnum overflow with arguments -4097 and ". 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 ". @@ -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: is not a fixnum". fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments 1 and ". -fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments 4096 and ". +fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments 4097 and ". fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: invalid shift count ". fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments and 1". fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments and 10". -fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments 4096 and ". +fx.mo:Expected error in mat fxarithmetic-shift: "fxarithmetic-shift: fixnum overflow with arguments -4097 and ". 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)". diff --git a/release_notes/release_notes.stex b/release_notes/release_notes.stex index 685643d6b7..0fa5d70ae0 100644 --- a/release_notes/release_notes.stex +++ b/release_notes/release_notes.stex @@ -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.] diff --git a/s/library.ss b/s/library.ss index cdfc7e306a..9fb3a7eeaf 100644 --- a/s/library.ss +++ b/s/library.ss @@ -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)]))