bitwise-bit-field: repair fixnum overflow problems

Bug reported by Roman Klochkov
This commit is contained in:
Matthew Flatt 2014-06-17 06:44:02 +01:00
parent f3c8638366
commit 36aaf3dd7b
2 changed files with 29 additions and 4 deletions

View File

@ -1243,6 +1243,31 @@
(test 1 bitwise-bit-field (bitwise-not (expt 2 101)) 70 71)
(test 7144187 bitwise-bit-field (expt 3 75) 0 24)
;; More boundary checking, especially for returning a
;; value that goes negative if mistreated as a fixnum:
(let ()
(define (bitwise-bit-field* n start end)
(bitwise-and (sub1 (arithmetic-shift 1 (- end start)))
(arithmetic-shift n (- start))))
(define (check-bit-field n)
(for ([i (in-range 200)])
(define lo 0)
(define hi i)
(test (bitwise-bit-field* n lo hi)
bitwise-bit-field n lo hi))
(for ([j (in-range 0 100)])
(for ([i (in-range j 200)])
(define lo (- i j))
(define hi i)
(test (bitwise-bit-field* n lo hi)
bitwise-bit-field n lo hi))))
(check-bit-field -1)
(check-bit-field (sub1 (expt 2 30)))
(check-bit-field (sub1 (expt 2 62)))
(check-bit-field (sub1 (arithmetic-shift 1 300))))
(test 42 bitwise-bit-field 42 0 32)
(test (sub1 (expt 2 32)) bitwise-bit-field -1 32 64)

View File

@ -4276,9 +4276,9 @@ static Scheme_Object *bitwise_bit_field (int argc, Scheme_Object *argv[])
if (v2 < (sizeof(intptr_t) * 8)) {
if (SCHEME_INTP(so)) {
if (v1 < (sizeof(intptr_t) * 8)) {
intptr_t res;
res = ((SCHEME_INT_VAL(so) >> v1) & (((intptr_t)1 << v2) - 1));
return scheme_make_integer(res);
uintptr_t res;
res = ((uintptr_t)(SCHEME_INT_VAL(so) >> v1) & (((uintptr_t)1 << v2) - 1));
return scheme_make_integer_value_from_unsigned(res);
} else if (SCHEME_INT_VAL(so) > 0)
return scheme_make_integer(0);
} else if (SCHEME_BIGPOS(so)) {
@ -4297,7 +4297,7 @@ static Scheme_Object *bitwise_bit_field (int argc, Scheme_Object *argv[])
d |= (((Scheme_Bignum *)so)->digits[vd + 1] << avail);
}
d = (d & (((bigdig)1 << v2) - 1));
return scheme_make_integer(d);
return scheme_make_integer_value_from_unsigned(d);
}
}
}