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

unsafe-fxlshift: fix constant folding

Browse Source 
Closes #2034
This commit is contained in:
Matthew Flatt 2018-04-15 10:22:24 -06:00
parent ecd0aee2b7
commit 8100438afc
3 changed files with 41 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/racket-doc/scribblings/reference/unsafe.scrbl
View File

@ -77,7 +77,7 @@ the result is always a @tech{fixnum}. The @racket[unsafe-fxlshift] and
@racket[arithmetic-shift], but require non-negative arguments;
@racket[unsafe-fxlshift] is a positive (i.e., left) shift, and
@racket[unsafe-fxrshift] is a negative (i.e., right) shift, where the
number of bits to shift must be less than the number of bits used to
number of bits to shift must be no more than the number of bits used to
represent a @tech{fixnum}. In the case of @racket[unsafe-fxlshift],
bits in the result beyond the number of bits used to represent a
@tech{fixnum} are effectively replaced with a copy of the high bit.}

10
pkgs/racket-test-core/tests/racket/unsafe.rktl
View File

@ -718,6 +718,16 @@
<
#:key cdr)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check that constant folding doesn't go wrong for `unsafe-fxlshift`:
(test #t fixnum? (if (eqv? 64 (system-type 'word))
(unsafe-fxlshift 1 62)
(unsafe-fxlshift 1 30)))
(test #t zero? (if (eqv? 64 (system-type 'word))
(unsafe-fxlshift 1 63)
(unsafe-fxlshift 1 31)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

32
racket/src/racket/src/number.c
View File

@ -5424,6 +5424,35 @@ SAFE_EXTFL(log)
SAFE_BIN_EXTFL(expt)
static Scheme_Object *fold_fixnum_bitwise_shift(int argc, Scheme_Object *argv[])
{
intptr_t v, base, amt, kept;
/* Unlike folding for other fixnum operations, even if the arguments
are fixnums, we must specifically ensure that the result is a
fixnum. It's up to the programmer to ensure that fixnums passed
in are ok for all platforms, but we have to bail out of folding
if the result is not going to be consistent for all platforms. */
if (!SCHEME_INTP(argv[0]) || !SCHEME_INTP(argv[1]))
scheme_signal_error("unsafe-fxlshift: arguments are not both fixnums");
amt = SCHEME_INT_VAL(argv[1]);
kept = (sizeof(intptr_t) * 8) - amt - 2; /* bits that are definitely kept */
if ((amt >= 29) || (kept <= 1))
scheme_signal_error("unsafe-fxlshift: shift is too large");
base = SCHEME_INT_VAL(argv[0]);
/* Consistent if potentially unkept bits are all 0 or 1 */
if (!(base - (base & ((1 << kept) - 1)))
|| !(~(base | ((1 << kept) - 1)))) {
v = base << amt;
return scheme_make_integer(v);
} else {
scheme_signal_error("unsafe-fxlshift: result is not clearly consistent across platforms");
return NULL;
}
}
#define UNSAFE_FX(name, op, fold, type) \
static Scheme_Object *name(int argc, Scheme_Object *argv[]) \
@ -5437,8 +5466,7 @@ SAFE_BIN_EXTFL(expt)
UNSAFE_FX(unsafe_fx_and, &, scheme_bitwise_and, intptr_t)
UNSAFE_FX(unsafe_fx_or, |, bitwise_or, intptr_t)
UNSAFE_FX(unsafe_fx_xor, ^, bitwise_xor, intptr_t)
UNSAFE_FX(unsafe_fx_lshift, <<, scheme_bitwise_shift, uintptr_t)
UNSAFE_FX(unsafe_fx_lshift, <<, fold_fixnum_bitwise_shift, uintptr_t)
UNSAFE_FX(unsafe_fx_rshift, >>, neg_bitwise_shift, intptr_t)
static Scheme_Object *unsafe_fx_not (int argc, Scheme_Object *argv[])