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

avoid some C undefined behavior

Browse Source 
Found with `-fsanitize=undefined`. The only changes that are potentially
bug repairs involve some abuses of pointers that can end up misaligned
(which is not an x86 issue, but might be on other platforms). Most of
the changes involve casting a signed integer to unsigned, which
effectively requests the usual two's complement behavior.

Some undefined behavior still present:

  * floating-point operations that can divide by zero or coercions
    from `double` to `float` that can fail;

  * offset calculations such as `&SCHEME_CDR((Scheme_Object *)0x0)`,
    which are supposed to be written with `offsetof`, but using
    a NULL address composes better with macros.

  * unaligned operations in the JIT for x86 (which are ok, because
    they're platform-specific).

Hints for using `-fsanitize=undefined`:

 * Add `-fsanitize=undefined` to both CPPFLAGS and LDFLAGS

 * Add `-fno-sanitize=alignment -fno-sanitize=null` to CPPFLAGS to
   disable those checks.

 * Add `-DSTACK_SAFETY_MARGIN=200000` to CPPFLAGS to avoid stack
   overflow due to large frames.

 * Use `--enable-noopt` so that the JIT compiles.
This commit is contained in:
Matthew Flatt 2016-02-08 08:24:59 -07:00
parent 06c15dbf89
commit 9a8fd2912f
26 changed files with 160 additions and 110 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -75,9 +75,15 @@
(= fx-result unsafe-result)))])
(unless ans
(newline)
(error 'same-results "better die now, rather than continue, what with unsafe ops around:\n fx-result ~s\n unsafe-result ~s"
(error 'same-results (~a "better die now, rather than continue, what with unsafe ops around:\n"
" fx-result ~s\n"
" unsafe-result ~s\n"
" op: ~s\n"
" args: ~s")
fx-result
unsafe-result))
unsafe-result
fx
args))
#t)))
(define (flonum? x) (inexact-real? x))

8
racket/collects/compiler/private/xform.rkt
View File

@ -898,11 +898,11 @@
__get_errno_ptr ; QNX preprocesses errno to __get_errno_ptr
__getreent ; Cygwin
strlen cos cosl sin sinl exp expl pow powl log logl sqrt sqrtl atan2 atan2l
isnan isinf fpclass _fpclass __fpclassify __fpclassifyf __fpclassifyl
_isnan __isfinited __isnanl __isnan
strlen cos cosl sin sinl exp expl pow powl log logl sqrt sqrtl atan2 atan2l frexp
isnan isinf fpclass signbit _signbit _fpclass __fpclassify __fpclassifyf __fpclassifyl
_isnan __isfinited __isnanl __isnan __signbit
__isinff __isinfl isnanf isinff __isinfd __isnanf __isnand __isinf
__inline_isnanl __inline_isnan
__inline_isnanl __inline_isnan __inline_signbitf __inline_signbitd __inline_signbitl
__builtin_popcount __builtin_clz
_Generic
__inline_isinff __inline_isinfl __inline_isinfd __inline_isnanf __inline_isnand __inline_isinf

2
racket/src/racket/gc2/Makefile.in
View File

@ -520,7 +520,7 @@ $(MZFWMMM): ../libracket3m.@LIBSFX@
ln -s Versions/$(FWVERSION)_3m/Racket Racket.framework/Racket
../racket@MMM@@OSX@: $(MZFWMMM) main.@LTO@
@MZLINKER@ -o ../racket@MMM@ @PROFFLAGS@ @LDFLAGS@ main.@LTO@ -Wl,-headerpad_max_install_names -F. -framework Racket
@MZLINKER@ -o ../racket@MMM@ @PROFFLAGS@ @LDFLAGS@ main.@LTO@ -Wl,-headerpad_max_install_names -F. -framework Racket @LIBS@
mkdir -p "../Racket.framework/Versions/$(FWVERSION)_3m"
cp "Racket.framework/Versions/$(FWVERSION)_3m/Racket" "../Racket.framework/Versions/$(FWVERSION)_3m/Racket"
/usr/bin/install_name_tool -change "Racket.framework/Versions/$(FWVERSION)_3m/Racket" "@executable_path/Racket.framework/Versions/$(FWVERSION)_3m/Racket" "../racket@MMM@"

34
racket/src/racket/gc2/block_cache.c
View File

@ -168,8 +168,8 @@ static void *bc_alloc_std_page(BlockCache *bc, int dirty_ok, int expect_mprotect
tryagain:
if (!gclist_is_empty(free_head)) {
if (!gclist_first_item(free_head, block_desc*, gclist)->free) {
GC_ASSERT(!gclist_first_item(free_head, block_desc*, gclist)->freecnt);
if (!gclist_first_item(free_head, block_desc, gclist)->free) {
GC_ASSERT(!gclist_first_item(free_head, block_desc, gclist)->freecnt);
gclist_move(free_head->next, &bg->full);
goto tryagain;
}
@ -187,7 +187,7 @@ static void *bc_alloc_std_page(BlockCache *bc, int dirty_ok, int expect_mprotect
}
{
block_desc *bd = gclist_first_item(free_head, block_desc*, gclist);
block_desc *bd = gclist_first_item(free_head, block_desc, gclist);
pfree_list *fl = bd->free;
void *p = fl;
int pos = BD_BLOCK_PTR_TO_POS(p, bd);
@ -284,7 +284,7 @@ static void *block_cache_alloc_page(BlockCache* bc, size_t len, size_t alignment
#if BC_ASSERTS
static int find_addr_in_bd(GCList *head, void *p, char* msg) {
block_desc *b;
gclist_each_item(b, head, block_desc*, gclist) {
gclist_each_item(b, head, block_desc, gclist) {
if (p >= b->block && p < b->block + b->size) {
return 1;
}
@ -349,12 +349,12 @@ static void compute_compacts(block_group *bg)
intptr_t avail, wanted;
wanted = 0;
gclist_each_item(b, &bg->free, block_desc*, gclist) {
gclist_each_item(b, &bg->free, block_desc, gclist) {
wanted += (b->totalcnt - b->freecnt);
}
avail = 0;
gclist_each_item(b, &bg->free, block_desc*, gclist) {
gclist_each_item(b, &bg->free, block_desc, gclist) {
if (avail > wanted)
b->want_compact = 1;
else {
@ -365,8 +365,8 @@ static void compute_compacts(block_group *bg)
}
static int sort_full_to_empty(void *priv, GCList *a, GCList *b) {
block_desc *ba = gclist_item(a, block_desc*, gclist);
block_desc *bb = gclist_item(b, block_desc*, gclist);
block_desc *ba = gclist_item(a, block_desc, gclist);
block_desc *bb = gclist_item(b, block_desc, gclist);
if ((ba->freecnt) <= (bb->freecnt)) {
return -1;
@ -384,13 +384,13 @@ static void block_cache_prep_for_compaction(BlockCache* bc) {
#if 0
{
block_desc *b;
gclist_each_item(b, &bc->atomic.full, block_desc*, gclist) {
gclist_each_item(b, &bc->atomic.full, block_desc, gclist) {
printf(" X ATOMIC _ %05li %03li %p\n", b->freecnt, b->totalcnt, b); }
gclist_each_item(b, &bc->atomic.free, block_desc*, gclist) {
gclist_each_item(b, &bc->atomic.free, block_desc, gclist) {
printf(" ATOMIC %d %05li %03li %p\n", b->want_compact, b->freecnt, b->totalcnt, b); }
gclist_each_item(b, &bc->non_atomic.full, block_desc*, gclist) {
gclist_each_item(b, &bc->non_atomic.full, block_desc, gclist) {
printf(" X NONATOMIC _ %05li %03li %p\n", b->freecnt, b->totalcnt, b); }
gclist_each_item(b, &bc->non_atomic.free, block_desc*, gclist) {
gclist_each_item(b, &bc->non_atomic.free, block_desc, gclist) {
printf(" NONATOMIC %d %05li %03li %p\n", b->want_compact, b->freecnt, b->totalcnt, b); }
}
#endif
@ -407,10 +407,10 @@ static ssize_t block_cache_flush_freed_pages(BlockCache* bc) {
ssize_t size_diff = 0;
ssize_t alloc_cache_size_diff = 0;
gclist_each_item_safe(b, bn, &bc->atomic.free, block_desc*, gclist) {
gclist_each_item_safe(b, bn, &bc->atomic.free, block_desc, gclist) {
if (b->freecnt == b->totalcnt) { size_diff += bc_free_std_block(b, 0); }
}
gclist_each_item_safe(b, bn, &bc->non_atomic.free, block_desc*, gclist) {
gclist_each_item_safe(b, bn, &bc->non_atomic.free, block_desc, gclist) {
if (b->freecnt == b->totalcnt) { size_diff += bc_free_std_block(b, 1); }
}
alloc_cache_size_diff = alloc_cache_flush_freed_pages(bc->bigBlockCache);
@ -475,14 +475,14 @@ static void block_cache_queue_protect_range(BlockCache* bc, void *p, size_t len,
static void block_cache_flush_protect_ranges(BlockCache* bc, int writeable) {
block_group *bg = &bc->non_atomic;
block_desc *b;
gclist_each_item(b, &bg->full, block_desc*, gclist) {
gclist_each_item(b, &bg->full, block_desc, gclist) {
if (b->in_queue) {
b->in_queue = 0;
page_range_add(bc->page_range, b->block, b->size, writeable);
memset(b->protect_map, writeable ? 0 : 255, 1+(b->size >> (LOG_APAGE_SIZE + 3)));
}
}
gclist_each_item(b, &bg->free, block_desc*, gclist) {
gclist_each_item(b, &bg->free, block_desc, gclist) {
if (b->in_queue) {
b->in_queue = 0;
page_range_add(bc->page_range, b->block, b->size, writeable);
@ -497,7 +497,7 @@ static void block_cache_flush_protect_ranges(BlockCache* bc, int writeable) {
static int block_cache_chain_stat(GCList *head, int *blcnt) {
block_desc *b;
int freecnt = 0;
gclist_each_item(b, head, block_desc*, gclist) {
gclist_each_item(b, head, block_desc, gclist) {
pfree_list *fl;
int lfcnt = 0;
for (fl = b->free; fl; fl = fl->next) {

2
racket/src/racket/gc2/gclist.h
View File

@ -70,7 +70,7 @@ static inline void gclist_splice(GCList *head, GCList *list) {
}
#define gclist_item(ptr, type, member) \
((type) (((void*)(ptr)) - ((void *) (&(((type) 0x0)->member)))))
((type*) (((void*)(ptr)) - ((void *) offsetof(type, member))))
#define gclist_first_item(head, type, member) \
gclist_item((head)->next, type, member)

2
racket/src/racket/include/scheme.h
View File

@ -700,7 +700,7 @@ typedef struct Scheme_Offset_Cptr
/* fast basic Scheme constructor macros */
/*========================================================================*/
#define scheme_make_integer(i) LONG_TO_OBJ ((OBJ_TO_LONG(i) << 1) | 0x1)
#define scheme_make_integer(i) LONG_TO_OBJ ((((uintptr_t)OBJ_TO_LONG(i)) << 1) | 0x1)
#define scheme_make_character(ch) ((((mzchar)ch) < 256) ? scheme_char_constants[(unsigned char)(ch)] : scheme_make_char(ch))
#define scheme_make_ascii_character(ch) scheme_char_constants[(unsigned char)(ch)]

2
racket/src/racket/sconfig.h
View File

@ -855,7 +855,7 @@
# define USE_MAP_ANON
# define USE_CARBON_FP_PREDS
# define USE_IEEE_FP_PREDS
# define TRIG_ZERO_NEEDS_SIGN_CHECK
# define USE_DYNAMIC_FDSET_SIZE

8
racket/src/racket/src/bignum.c
View File

@ -193,7 +193,7 @@ Scheme_Object *scheme_make_small_bignum(intptr_t v, Small_Bignum *o)
o->o.iso.so.type = scheme_bignum_type;
SCHEME_SET_BIGPOS(&o->o, ((v >= 0) ? 1 : 0));
if (v < 0)
bv = -v;
bv = -((bigdig)v);
else
bv = v;
@ -414,7 +414,7 @@ int scheme_bignum_get_long_long_val(const Scheme_Object *o, mzlonglong *v)
/* Special case for the most negative number representable in a signed long long */
mzlonglong v2;
v2 = 1;
v2 = (v2 << 63);
v2 = ((umzlonglong)v2 << 63);
*v = v2;
return 1;
} else if ((SCHEME_BIGDIG(o)[MAX_BN_SIZE_FOR_LL - 1] & FIRST_BIT_MASK_LL) != 0) { /* Won't fit into a signed long long */
@ -423,7 +423,7 @@ int scheme_bignum_get_long_long_val(const Scheme_Object *o, mzlonglong *v)
mzlonglong v2;
v2 = SCHEME_BIGDIG(o)[0];
if (SCHEME_BIGLEN(o) > 1) {
v2 |= ((mzlonglong)(SCHEME_BIGDIG(o)[1])) << 32;
v2 |= ((umzlonglong)(SCHEME_BIGDIG(o)[1])) << 32;
}
if (!SCHEME_BIGPOS(o)) {
v2 = -v2;
@ -1658,7 +1658,7 @@ static uintptr_t fixnum_sqrt(uintptr_t n, uintptr_t *rem)
for (i = SQRT_BIT_MAX; i >= 0; i--)
{
try_root = root | ((intptr_t)0x1 << i);
try_root = root | ((uintptr_t)0x1 << i);
try_square = try_root * try_root;
if (try_square <= n)
{

2
racket/src/racket/src/eval.c
View File

@ -6112,7 +6112,7 @@ static void mark_pruned_prefixes(struct NewGC *gc) XFORM_SKIP_PROC
for (i = (maxpos + 31) / 32; i--; ) {
int j;
for (j = 0; j < 32; j++) {
if (!(use_bits[i] & (1 << j))) {
if (!(use_bits[i] & ((unsigned)1 << j))) {
int pos;
pos = (i * 32) + j;
if (pos < pf->num_toplevels)

7
racket/src/racket/src/fun.c
View File

@ -2607,7 +2607,7 @@ Scheme_Object *scheme_get_or_check_procedure_shape(Scheme_Object *e, Scheme_Obje
/* Integer encoding, but shift to use low bit to indicate whether
it preserves marks, which is useful information for the JIT. */
intptr_t i = SCHEME_INT_VAL(p);
i <<= 1;
i = ((uintptr_t)i) << 1;
if (scheme_closure_preserves_marks(e)) {
i |= 0x1;
}
@ -9926,7 +9926,8 @@ static Scheme_Object *seconds_to_date(int argc, Scheme_Object **argv)
{
UNBUNDLE_TIME_TYPE lnow;
int get_gmt;
int hour, min, sec, month, day, year, wday, yday, dst;
int hour, min, sec, month, day, wday, yday, dst;
intptr_t year;
long tzoffset;
#ifdef USE_WIN32_TIME
# define CHECK_TIME_T uintptr_t
@ -10051,7 +10052,7 @@ static Scheme_Object *seconds_to_date(int argc, Scheme_Object **argv)
month = localTime->tm_mon + 1;
day = localTime->tm_mday;
year = localTime->tm_year + 1900;
year = (uintptr_t)localTime->tm_year + 1900;
wday = localTime->tm_wday;
yday = localTime->tm_yday;

13
racket/src/racket/src/hash.c
View File

@ -1459,9 +1459,10 @@ XFORM_NONGCING static uintptr_t fast_equal_hash_key(Scheme_Object *o, uintptr_t
if (!(MZ_OPT_HASH_KEY(&s->iso) & 0x1)) {
/* Interned. Make key depend only on the content. */
if (!(MZ_OPT_HASH_KEY(&s->iso) & 0xFFFC)) {
int i, h = 0;
int i;
unsigned int h = 0;
for (i = s->len; i--; ) {
h += (h << 5) + h + s->s[i];
h += (h << 5) + h + (unsigned int)s->s[i];
}
h += (h << 2);
if (!(((short)h) & 0xFFFC))
@ -2913,7 +2914,7 @@ XFORM_NONGCING static uintptr_t hamt_find_free_code(Scheme_Hash_Tree *tree, int
Scheme_Hash_Tree *subtree;
for (i = 0; i < mzHAMT_WORD_SIZE; i++) {
if (!(tree->bitmap & (1 << i)))
if (!(tree->bitmap & ((unsigned)1 << i)))
return (i << shift) + base;
}
@ -2922,9 +2923,9 @@ XFORM_NONGCING static uintptr_t hamt_find_free_code(Scheme_Hash_Tree *tree, int
minpos = mzHAMT_WORD_SIZE;
for (i = mzHAMT_WORD_SIZE; i--; ) {
if (!HASHTR_SUBTREEP(tree->els[i])) {
uintptr_t code = (i << shift) + base;
uintptr_t code = ((unsigned)i << shift) + base;
if (_mzHAMT_CODE(tree, i, mzHAMT_WORD_SIZE) == code)
return code + (1 << (shift + mzHAMT_LOG_WORD_SIZE));
return code + ((unsigned)1 << (shift + mzHAMT_LOG_WORD_SIZE));
else
return code;
} else {
@ -2938,7 +2939,7 @@ XFORM_NONGCING static uintptr_t hamt_find_free_code(Scheme_Hash_Tree *tree, int
}
return hamt_find_free_code((Scheme_Hash_Tree *)tree->els[minpos],
(minpos << shift) + base,
((unsigned)minpos << shift) + base,
shift + mzHAMT_LOG_WORD_SIZE);
}

2
racket/src/racket/src/jit.h
View File

@ -94,7 +94,7 @@ END_XFORM_ARITH;
# define JIT_LOG_WORD_SIZE 2
#endif
#define JIT_WORD_SIZE (1 << JIT_LOG_WORD_SIZE)
#define WORDS_TO_BYTES(x) ((x) << JIT_LOG_WORD_SIZE)
#define WORDS_TO_BYTES(x) ((unsigned)(x) << JIT_LOG_WORD_SIZE)
#define MAX_TRY_SHIFT 30
#ifdef USE_THREAD_LOCAL

20
racket/src/racket/src/jitarith.c
View File

@ -1640,7 +1640,7 @@ int scheme_generate_arith_for(mz_jit_state *jitter, Scheme_Object *rator, Scheme
__START_INNER_TINY__(branch_short);
/* watch out for negation of most negative fixnum,
which is a positive number too big for a fixnum */
refz = jit_beqi_p(jit_forward(), JIT_R0, (void *)(((intptr_t)1 << ((8 * JIT_WORD_SIZE) - 2))));
refz = jit_beqi_p(jit_forward(), JIT_R0, (void *)(((uintptr_t)1 << ((8 * JIT_WORD_SIZE) - 2))));
__END_INNER_TINY__(branch_short);
if (reversed)
jit_mulr_l(JIT_R2, JIT_R0, JIT_R2);
@ -1678,12 +1678,12 @@ int scheme_generate_arith_for(mz_jit_state *jitter, Scheme_Object *rator, Scheme
if (!unsafe_fx || overflow_refslow) {
GC_CAN_IGNORE jit_insn *refx;
__START_INNER_TINY__(branch_short);
refx = jit_bnei_p(jit_forward(), JIT_R0, (void *)(((intptr_t)1 << ((8 * JIT_WORD_SIZE) - 2))));
refx = jit_bnei_p(jit_forward(), JIT_R0, (void *)(((uintptr_t)1 << ((8 * JIT_WORD_SIZE) - 2))));
__END_INNER_TINY__(branch_short);
/* first argument must have been most negative fixnum,
second argument must have been -1: */
if (reversed)
(void)jit_movi_p(JIT_R0, (void *)(((intptr_t)1 << ((8 * JIT_WORD_SIZE) - 1)) | 0x1));
(void)jit_movi_p(JIT_R0, (void *)(((uintptr_t)1 << ((8 * JIT_WORD_SIZE) - 1)) | 0x1));
else
(void)jit_movi_p(JIT_R0, scheme_make_integer(-1));
(void)jit_jmpi(refslow);
@ -1800,10 +1800,10 @@ int scheme_generate_arith_for(mz_jit_state *jitter, Scheme_Object *rator, Scheme
/* Non-constant arg is in JIT_R0 */
if (arith == ARITH_ADD) {
if (unsafe_fx && !overflow_refslow)
jit_addi_l(dest, JIT_R0, v << 1);
jit_addi_l(dest, JIT_R0, (uintptr_t)v << 1);
else {
jit_movr_p(JIT_R2, JIT_R0);
(void)jit_boaddi_l(refslow, JIT_R2, v << 1);
(void)jit_boaddi_l(refslow, JIT_R2, (uintptr_t)v << 1);
jit_movr_p(dest, JIT_R2);
}
} else if (arith == ARITH_SUB) {
@ -1816,10 +1816,10 @@ int scheme_generate_arith_for(mz_jit_state *jitter, Scheme_Object *rator, Scheme
jit_addi_ul(dest, JIT_R2, 0x1);
} else {
if (unsafe_fx && !overflow_refslow)
jit_subi_l(dest, JIT_R0, v << 1);
jit_subi_l(dest, JIT_R0, (uintptr_t)v << 1);
else {
jit_movr_p(JIT_R2, JIT_R0);
(void)jit_bosubi_l(refslow, JIT_R2, v << 1);
(void)jit_bosubi_l(refslow, JIT_R2, (uintptr_t)v << 1);
jit_movr_p(dest, JIT_R2);
}
}
@ -1851,7 +1851,7 @@ int scheme_generate_arith_for(mz_jit_state *jitter, Scheme_Object *rator, Scheme
jit_ori_ul(dest, JIT_R0, l);
} else if (arith == ARITH_XOR) {
/* xor */
jit_xori_ul(dest, JIT_R0, v << 1);
jit_xori_ul(dest, JIT_R0, (uintptr_t)v << 1);
} else if ((arith == ARITH_LSH) || (arith == ARITH_RSH)) {
/* arithmetic-shift */
/* We only get here when v is between -MAX_TRY_SHIFT and MAX_TRY_SHIFT, inclusive */
@ -1902,7 +1902,7 @@ int scheme_generate_arith_for(mz_jit_state *jitter, Scheme_Object *rator, Scheme
__END_INNER_TINY__(branch_short);
/* watch out for most negative fixnum! */
if (!unsafe_fx || overflow_refslow)
(void)jit_beqi_p(refslow, JIT_R0, (void *)(((intptr_t)1 << ((8 * JIT_WORD_SIZE) - 1)) | 0x1));
(void)jit_beqi_p(refslow, JIT_R0, (void *)(((uintptr_t)1 << ((8 * JIT_WORD_SIZE) - 1)) | 0x1));
(void)jit_movi_p(JIT_R1, scheme_make_integer(0));
jit_subr_l(JIT_R0, JIT_R1, JIT_R0);
jit_ori_l(JIT_R0, JIT_R0, 0x1);
@ -2040,7 +2040,7 @@ int scheme_generate_arith_for(mz_jit_state *jitter, Scheme_Object *rator, Scheme
jit_lshr_l(JIT_R0, JIT_V1, JIT_R0);
ref3 = jit_bmcr_l(jit_forward(), JIT_R1, JIT_R0);
} else {
ref3 = jit_bmci_l(jit_forward(), JIT_R0, 1 << (v+1));
ref3 = jit_bmci_l(jit_forward(), JIT_R0, (uintptr_t)1 << (v+1));
rs_can_keep = 1;
}
break;

16
racket/src/racket/src/jitstate.c
View File

@ -502,7 +502,7 @@ void scheme_extra_pushed(mz_jit_state *jitter, int n)
}
v = (jitter->mappings[jitter->num_mappings]) >> 2;
v += n;
jitter->mappings[jitter->num_mappings] = ((v << 2) | 0x1);
jitter->mappings[jitter->num_mappings] = (((unsigned)v << 2) | 0x1);
}
void scheme_mz_pushr_p_it(mz_jit_state *jitter, int reg)
@ -534,7 +534,7 @@ void scheme_extra_popped(mz_jit_state *jitter, int n)
if (!v)
--jitter->num_mappings;
else
jitter->mappings[jitter->num_mappings] = ((v << 2) | 0x1);
jitter->mappings[jitter->num_mappings] = (((unsigned)v << 2) | 0x1);
}
void scheme_mz_popr_p_it(mz_jit_state *jitter, int reg, int discard)
@ -570,7 +570,7 @@ void scheme_mz_runstack_skipped(mz_jit_state *jitter, int n)
v = (jitter->mappings[jitter->num_mappings]) >> 2;
JIT_ASSERT(v <= 0);
v -= n;
jitter->mappings[jitter->num_mappings] = ((v << 2) | 0x1);
jitter->mappings[jitter->num_mappings] = (((unsigned)v << 2) | 0x1);
jitter->self_pos += n;
}
@ -589,7 +589,7 @@ void scheme_mz_runstack_unskipped(mz_jit_state *jitter, int n)
if (!v)
--jitter->num_mappings;
else
jitter->mappings[jitter->num_mappings] = ((v << 2) | 0x1);
jitter->mappings[jitter->num_mappings] = (((unsigned)v << 2) | 0x1);
jitter->self_pos -= n;
}
@ -603,7 +603,7 @@ void scheme_mz_runstack_pushed(mz_jit_state *jitter, int n)
|| (jitter->mappings[jitter->num_mappings] & 0x3)) {
new_mapping(jitter);
}
jitter->mappings[jitter->num_mappings] += (n << 2);
jitter->mappings[jitter->num_mappings] += ((unsigned)n << 2);
jitter->need_set_rs = 1;
}
@ -614,7 +614,7 @@ void scheme_mz_runstack_closure_pushed(mz_jit_state *jitter, int a, int flags)
jitter->max_depth = jitter->depth;
jitter->self_pos += 1;
new_mapping(jitter);
jitter->mappings[jitter->num_mappings] = (a << 4) | (flags << 2) | 0x2;
jitter->mappings[jitter->num_mappings] = ((unsigned)a << 4) | ((unsigned)flags << 2) | 0x2;
jitter->need_set_rs = 1;
/* closures are never popped; they go away due to returns or tail calls */
}
@ -627,7 +627,7 @@ void scheme_mz_runstack_flonum_pushed(mz_jit_state *jitter, int pos)
jitter->max_depth = jitter->depth;
jitter->self_pos += 1;
new_mapping(jitter);
jitter->mappings[jitter->num_mappings] = (pos << 2) | 0x3;
jitter->mappings[jitter->num_mappings] = ((unsigned)pos << 2) | 0x3;
jitter->need_set_rs = 1;
/* flonums are never popped; they go away due to returns or tail calls */
}
@ -651,7 +651,7 @@ void scheme_mz_runstack_popped(mz_jit_state *jitter, int n)
if (!v)
--jitter->num_mappings;
else
jitter->mappings[jitter->num_mappings] = (v << 2);
jitter->mappings[jitter->num_mappings] = ((unsigned)v << 2);
jitter->need_set_rs = 1;
}

4
racket/src/racket/src/lightning/i386/asm-common.h
View File

@ -111,9 +111,9 @@ typedef uintptr_t _ul;
#define _jit_L(L) _jit_VD(((*_jit.x.ul_pc++)= _jit_UL((L) )))
#define _jit_I_noinc(I) _jit_VD(((*_jit.x.ui_pc)= _jit_UI((I) )))
#define _COPY_HIGH_BIT(N, I) (((uintptr_t)(I) & (1 << ((N)-1))) ? ~_MASK(N) : 0)
#define _COPY_HIGH_BIT(N, I) (((uintptr_t)(I) & ((uintptr_t)1 << ((N)-1))) ? ~_MASK(N) : 0)
#define _MASK(N) ((uintptr_t)(((intptr_t)1<<(N)))-1)
#define _MASK(N) ((uintptr_t)(((uintptr_t)1<<(N)))-1)
#define _siP(N,I) (!((((uintptr_t)(I))^(_COPY_HIGH_BIT(N, I)))&~_MASK(N)))
#define _uiP(N,I) (!(((uintptr_t)(I))&~_MASK(N)))
#define _suiP(N,I) (_siP(N,I) | _uiP(N,I))

4
racket/src/racket/src/marshal.c
View File

@ -983,11 +983,11 @@ static Scheme_Object *read_compiled_closure(Scheme_Object *obj)
for (i = 0; i < len/2; i++) {
v1 = SCHEME_INT_VAL(SCHEME_VEC_ELS(tl_map)[2*i]);
v2 = SCHEME_INT_VAL(SCHEME_VEC_ELS(tl_map)[(2*i) + 1]);
v2 = (v2 << 16) | v1;
v2 = ((unsigned int)v2 << 16) | v1;
n[i+1] = v2;
}
if ((len == 2) && (!(n[1] & 0x80000000)))
data->tl_map = (void *)(intptr_t)((n[1] << 1) | 0x1);
data->tl_map = (void *)(intptr_t)(((uintptr_t)n[1] << 1) | 0x1);
else
data->tl_map = n;
} else

12
racket/src/racket/src/module.c
View File

@ -2249,10 +2249,12 @@ static Scheme_Object *do_namespace_attach_module(const char *who, int argc, Sche
}
past_checkeds = SCHEME_CDR(past_checkeds);
from_modchain = SCHEME_VEC_ELS(from_modchain)[2];
if (phase > orig_phase)
to_modchain = SCHEME_VEC_ELS(to_modchain)[2];
--phase;
if (!SCHEME_NULLP(past_checkeds)) {
from_modchain = SCHEME_VEC_ELS(from_modchain)[2];
if (phase > orig_phase)
to_modchain = SCHEME_VEC_ELS(to_modchain)[2];
--phase;
}
}
/* Notify module name resolver of attached modules: */
@ -4959,7 +4961,7 @@ static void unlock_registry(Scheme_Env *env)
XFORM_NONGCING static intptr_t make_key(int base_phase, int eval_exp, int eval_run)
{
return ((base_phase << 3)
return (((unsigned)base_phase << 3)
| (eval_exp ? ((eval_exp > 0) ? 2 : 4) : 0)
| (eval_run ? 1 : 0));
}

8
racket/src/racket/src/mzclpf_post.inc
View File

@ -58,8 +58,8 @@
map = (((uintptr_t)data->tl_map) >> 1) & 0x7FFFFFFF;
if ((use_bits[0] & map) != map) {
for (i = 0; i < 31; i++) {
if (map & (1 << i)) {
if (!(use_bits[0] & (1 << i))) {
if (map & ((unsigned int)1 << i)) {
if (!(use_bits[0] & ((unsigned int)1 << i))) {
if ((i < pf->num_toplevels) || !pf->num_stxes)
gcMARK2(pf->a[i], gc); /* top level */
else if (i == pf->num_toplevels)
@ -78,8 +78,8 @@
map = u[i+1];
if ((use_bits[i] & map) != map) {
for (j = 0; j < 32; j++) {
if (map & (1 << j)) {
if (!(use_bits[i] & (1 << j))) {
if (map & ((unsigned int)1 << j)) {
if (!(use_bits[i] & ((unsigned int)1 << j))) {
pos = (i * 32) + j;
if ((pos < pf->num_toplevels) || !pf->num_stxes)
gcMARK2(pf->a[pos], gc); /* top level */

15
racket/src/racket/src/numarith.c
View File

@ -592,12 +592,12 @@ static Scheme_Object *ADD(intptr_t a, intptr_t b)
intptr_t r;
Scheme_Object *o;
r = a + b;
r = (uintptr_t)a + (uintptr_t)b;
o = scheme_make_integer(r);
r = SCHEME_INT_VAL(o);
if (b == r - a)
if (b == (uintptr_t)r - (uintptr_t)a)
return o;
else
return ADD_slow(a, b);
@ -615,12 +615,12 @@ static Scheme_Object *SUBTRACT(intptr_t a, intptr_t b)
intptr_t r;
Scheme_Object *o;
r = a - b;
r = (uintptr_t)a - (uintptr_t)b;
o = scheme_make_integer(r);
r = SCHEME_INT_VAL(o);
if (a == r + b)
if (a == (uintptr_t)r + (uintptr_t)b)
return o;
else
return SUBTRACT_slow(a, b);
@ -634,12 +634,15 @@ static Scheme_Object *MULTIPLY(intptr_t a, intptr_t b)
if (!b)
return zeroi;
r = a * b;
r = (uintptr_t)a * (uintptr_t)b;
o = scheme_make_integer(r);
r = SCHEME_INT_VAL(o);
if (a == r / b)
/* if b == -1, division could overflow; otherwise, division is defined */
if ((b == -1)
? (a == (uintptr_t)r * (uintptr_t)-1)
: (a == r / b))
return o;
else {
Small_Bignum sa, sb;

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

@ -1664,7 +1664,7 @@ scheme_make_integer_value_from_long_halves(uintptr_t lowhalf,
#else
mzlonglong v;
v = (mzlonglong)lowhalf | ((mzlonglong)hihalf << 32);
v = (mzlonglong)lowhalf | ((umzlonglong)hihalf << 32);
return scheme_make_integer_value_from_long_long(v);
#endif
@ -1752,7 +1752,11 @@ double scheme_real_to_double(Scheme_Object *r)
XFORM_NONGCING static MZ_INLINE int minus_zero_p(double d)
{
#ifdef MZ_IS_NEG_ZERO
return MZ_IS_NEG_ZERO(d);
#else
return (1 / d) < 0;
#endif
}
int scheme_minus_zero_p(double d)
@ -3246,7 +3250,7 @@ static Scheme_Object *fixnum_expt(intptr_t x, intptr_t y)
intptr_t orig_y = y;
if ((x == 2) && (y <= MAX_SHIFT_TRY))
return scheme_make_integer((intptr_t)1 << y);
return scheme_make_integer((uintptr_t)1 << y);
else {
intptr_t result = 1;
int neg_result = (x < 0) && (y & 0x1);
@ -3993,6 +3997,22 @@ scheme_exact_to_inexact (int argc, Scheme_Object *argv[])
ESCAPED_BEFORE_HERE;
}
XFORM_NONGCING static int double_fits_fixnum(double d)
/* returns TRUE if the number definitely fits in an intptr_t
and might fit in a fixnum */
{
int exp;
if (MZ_IS_NAN(d)
|| MZ_IS_POS_INFINITY(d)
|| MZ_IS_NEG_INFINITY(d))
return 0;
(void)frexp(d, &exp);
return (exp < (8 * sizeof(intptr_t)) - 1);
}
Scheme_Object *
scheme_inexact_to_exact (int argc, Scheme_Object *argv[])
{
@ -4004,9 +4024,12 @@ scheme_inexact_to_exact (int argc, Scheme_Object *argv[])
t = _SCHEME_TYPE(o);
if (t == scheme_double_type) {
double d = SCHEME_DBL_VAL(o);
Scheme_Object *i;
/* Try simple case: */
Scheme_Object *i = scheme_make_integer((intptr_t)d);
i = (double_fits_fixnum(d)
? scheme_make_integer((intptr_t)d)
: scheme_make_integer(0));
if ((double)SCHEME_INT_VAL(i) == d) {
#ifdef NAN_EQUALS_ANYTHING
if (!MZ_IS_NAN(d))
@ -4019,9 +4042,12 @@ scheme_inexact_to_exact (int argc, Scheme_Object *argv[])
#ifdef MZ_USE_SINGLE_FLOATS
if (t == scheme_float_type) {
float d = SCHEME_FLT_VAL(o);
Scheme_Object *i;
/* Try simple case: */
Scheme_Object *i = scheme_make_integer((intptr_t)d);
i = (double_fits_fixnum(d)
? scheme_make_integer((intptr_t)d)
: scheme_make_integer(0));
if ((double)SCHEME_INT_VAL(i) == d) {
# ifdef NAN_EQUALS_ANYTHING
if (!MZ_IS_NAN(d))
@ -4208,7 +4234,7 @@ scheme_bitwise_shift(int argc, Scheme_Object *argv[])
} else if (shift <= MAX_SHIFT_TRY) {
intptr_t n;
n = i << shift;
n = (uintptr_t)i << shift;
if ((n > 0) && (SCHEME_INT_VAL(scheme_make_integer(n)) >> shift == i))
return scheme_make_integer(n);
}
@ -4242,7 +4268,7 @@ static Scheme_Object *bitwise_bit_set_p (int argc, Scheme_Object *argv[])
}
if (SCHEME_INTP(so)) {
if (v < (sizeof(intptr_t) * 8))
return ((((intptr_t)1 << v) & SCHEME_INT_VAL(so)) ? scheme_true : scheme_false);
return ((((uintptr_t)1 << v) & SCHEME_INT_VAL(so)) ? scheme_true : scheme_false);
else
return ((SCHEME_INT_VAL(so) < 0) ? scheme_true : scheme_false);
} else {
@ -4452,7 +4478,7 @@ integer_length(int argc, Scheme_Object *argv[])
/* if base is large enough that our later steps risk overflow
then perform all the arithmetic using bignums. */
if (base >= (((intptr_t)1 << (MAX_SHIFT_TRY - 4))-1)) {
if (base >= (((uintptr_t)1 << (MAX_SHIFT_TRY - 4))-1)) {
/* bignum path */
Scheme_Object *result;
result = scheme_bin_mult(scheme_make_integer_value(base),
@ -5194,11 +5220,13 @@ static Scheme_Object *fl_to_fx (int argc, Scheme_Object *argv[])
scheme_wrong_contract("fl->fx", "(and/c flonum? integer?)", 0, argc, argv);
d = SCHEME_DBL_VAL(argv[0]);
v = (intptr_t)d;
if ((double)v == d) {
o = scheme_make_integer_value(v);
if (SCHEME_INTP(o))
return o;
if (double_fits_fixnum(d)) {
v = (intptr_t)d;
if ((double)v == d) {
o = scheme_make_integer_value(v);
if (SCHEME_INTP(o))
return o;
}
}
scheme_contract_error("fl->fx", "no fixnum representation",
@ -5331,21 +5359,21 @@ SAFE_EXTFL(log)
SAFE_BIN_EXTFL(expt)
#define UNSAFE_FX(name, op, fold) \
#define UNSAFE_FX(name, op, fold, type) \
static Scheme_Object *name(int argc, Scheme_Object *argv[]) \
{ \
intptr_t v; \
if (scheme_current_thread->constant_folding) return fold(argc, argv); \
v = SCHEME_INT_VAL(argv[0]) op SCHEME_INT_VAL(argv[1]); \
v = (type)SCHEME_INT_VAL(argv[0]) op SCHEME_INT_VAL(argv[1]); \
return scheme_make_integer(v); \
}
UNSAFE_FX(unsafe_fx_and, &, scheme_bitwise_and)
UNSAFE_FX(unsafe_fx_or, |, bitwise_or)
UNSAFE_FX(unsafe_fx_xor, ^, bitwise_xor)
UNSAFE_FX(unsafe_fx_lshift, <<, scheme_bitwise_shift)
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_rshift, >>, neg_bitwise_shift)
UNSAFE_FX(unsafe_fx_rshift, >>, neg_bitwise_shift, intptr_t)
static Scheme_Object *unsafe_fx_not (int argc, Scheme_Object *argv[])
{

6
racket/src/racket/src/read.c
View File

@ -3305,7 +3305,7 @@ read_string(int is_byte, Scheme_Object *port,
ch = scheme_peekc_special_ok(port);
if (NOT_EOF_OR_SPECIAL(ch) && scheme_isxdigit(ch)) {
initial[count] = ch;
n = n*16 + (ch<='9' ? ch-'0' : (scheme_toupper(ch)-'A'+10));
n = ((unsigned)n<<4) + (ch<='9' ? ch-'0' : (scheme_toupper(ch)-'A'+10));
scheme_getc(port); /* must be ch */
count++;
} else
@ -4050,7 +4050,7 @@ read_character(Scheme_Object *port,
ch = scheme_peekc_special_ok(port);
if (NOT_EOF_OR_SPECIAL(ch) && scheme_isxdigit(ch)) {
nbuf[count] = ch;
n = n*16 + (ch<='9' ? ch-'0' : (scheme_toupper(ch)-'A'+10));
n = ((unsigned)n<<4) + (ch<='9' ? ch-'0' : (scheme_toupper(ch)-'A'+10));
scheme_getc(port); /* must be ch */
count++;
} else
@ -5617,7 +5617,7 @@ static void install_byecode_hash_code(CPort *rp, char *hash_code)
int i;
for (i = 0; i < 20; i++) {
l ^= ((mzlonglong)(hash_code[i]) << ((i % 8) * 8));
l ^= ((umzlonglong)(hash_code[i]) << ((i % 8) * 8));
}
/* Make sure the hash code leaves lots of room for

4
racket/src/racket/src/regexp.c
View File

@ -5379,7 +5379,9 @@ static Scheme_Object *gen_compare(char *name, int pos,
dropped = scheme_make_integer(0);
m = regexec(name, r, full_s, offset, endset - offset, offset, lazy_string,
m = regexec(name, r, full_s,
offset, (endset < 0 ? endset : endset - offset),
offset, lazy_string,
startp, maybep, endp, match_stack,
iport, unless_evt, nonblock,
&full_s, peek, pos, last_bytes_count, oport,

2
racket/src/racket/src/resolve.c
View File

@ -2858,7 +2858,7 @@ static void set_tl_pos_used(Resolve_Info *info, int pos)
if ((uintptr_t)info->tl_map & 0x1)
info->tl_map = (void *)((uintptr_t)tl_map | ((uintptr_t)1 << (tl_pos + 1)));
else
((int *)tl_map)[1 + (tl_pos / 32)] |= (1 << (tl_pos & 31));
((int *)tl_map)[1 + (tl_pos / 32)] |= ((unsigned)1 << (tl_pos & 31));
}
static void *merge_tl_map(void *tl_map, void *new_tl_map)

2
racket/src/racket/src/schpriv.h
View File

@ -2361,6 +2361,7 @@ extern int scheme_is_nan(double);
# define MZ_IS_POS_INFINITY(d) (!__isfinite(d) && (d > 0))
# define MZ_IS_NEG_INFINITY(d) (!__isfinite(d) && (d < 0))
# define MZ_IS_NAN(d) __isnan(d)
# define MZ_IS_NEG_ZERO(d) signbit(d)
# else
# ifdef USE_MSVC_FP_PREDS
# include <float.h>
@ -2374,6 +2375,7 @@ extern int scheme_is_nan(double);
# define MZ_IS_POS_INFINITY(d) (isinf(d) && (d > 0))
# define MZ_IS_NEG_INFINITY(d) (isinf(d) && (d < 0))
# define MZ_IS_NAN(d) isnan(d)
# define MZ_IS_NEG_ZERO(d) signbit(d)
# endif
# endif
# endif

11
racket/src/racket/src/string.c
View File

@ -179,6 +179,9 @@ static void reset_locale(void);
#define current_locale_name ((const mzchar *)current_locale_name_ptr)
static const mzchar empty_char_string[1] = { 0 };
static const mzchar xes_char_string[2] = { 0x78787878, 0 };
#ifdef USE_ICONV_DLL
static char *nl_langinfo(int which)
{
@ -186,7 +189,7 @@ static char *nl_langinfo(int which)
reset_locale();
if (!current_locale_name)
current_locale_name_ptr = "\0\0\0\0";
current_locale_name_ptr = empty_char_string;
if ((current_locale_name[0] == 'C')
&& !current_locale_name[1])
@ -986,7 +989,7 @@ scheme_init_string (Scheme_Env *env)
void scheme_init_string_places(void) {
REGISTER_SO(current_locale_name_ptr);
current_locale_name_ptr = "xxxx\0\0\0\0";
current_locale_name_ptr = (void *)xes_char_string;
}
/**********************************************************************/
@ -1008,7 +1011,7 @@ Scheme_Object *scheme_make_sized_offset_utf8_string(char *chars, intptr_t d, int
NULL, 0 /* not UTF-16 */, 0xFFFD);
us[ulen] = 0;
} else {
us = (mzchar *)"\0\0\0";
us = (mzchar *)empty_char_string;
ulen = 0;
}
return scheme_make_sized_offset_char_string(us, 0, ulen, 0);
@ -4624,6 +4627,8 @@ static Scheme_Object *string_normalize_kd (int argc, Scheme_Object *argv[])
intptr_t scheme_char_strlen(const mzchar *s)
{
intptr_t i;
if ((intptr_t)s & 0x3)
abort();
for (i = 0; s[i]; i++) {
}
return i;

8
racket/src/racket/src/validate.c
View File

@ -1359,12 +1359,12 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
if ((uintptr_t)tl_use_map & 0x1) {
if (p2 > 31)
scheme_ill_formed_code(port);
if (!((uintptr_t)tl_use_map & (1 << (p2 + 1))))
if (!((uintptr_t)tl_use_map & ((unsigned int)1 << (p2 + 1))))
scheme_ill_formed_code(port);
} else {
if (p2 >= (*(int *)tl_use_map * 32))
scheme_ill_formed_code(port);
if (!(((int *)tl_use_map)[1 + (p2 / 32)] & (1 << (p2 & 31))))
if (!(((int *)tl_use_map)[1 + (p2 / 32)] & ((unsigned int)1 << (p2 & 31))))
scheme_ill_formed_code(port);
}
}
@ -1757,12 +1757,12 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
if ((uintptr_t)tl_use_map & 0x1) {
if (p > 31)
scheme_ill_formed_code(port);
if (!((uintptr_t)tl_use_map & (1 << (p + 1))))
if (!((uintptr_t)tl_use_map & ((unsigned int)1 << (p + 1))))
scheme_ill_formed_code(port);
} else {
if (p >= (*(int *)tl_use_map * 32))
scheme_ill_formed_code(port);
if (!(((int *)tl_use_map)[1 + (p / 32)] & (1 << (p & 31))))
if (!(((int *)tl_use_map)[1 + (p / 32)] & ((unsigned int)1 << (p & 31))))
scheme_ill_formed_code(port);
}
}