diff --git a/pkgs/racket-test-core/tests/racket/fixnum.rktl b/pkgs/racket-test-core/tests/racket/fixnum.rktl index 11063640c5..b75e01919a 100644 --- a/pkgs/racket-test-core/tests/racket/fixnum.rktl +++ b/pkgs/racket-test-core/tests/racket/fixnum.rktl @@ -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)) diff --git a/racket/collects/compiler/private/xform.rkt b/racket/collects/compiler/private/xform.rkt index ce0b2d9559..2add772c4b 100644 --- a/racket/collects/compiler/private/xform.rkt +++ b/racket/collects/compiler/private/xform.rkt @@ -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 diff --git a/racket/src/racket/gc2/Makefile.in b/racket/src/racket/gc2/Makefile.in index 0e0d8f4987..74f84046a2 100644 --- a/racket/src/racket/gc2/Makefile.in +++ b/racket/src/racket/gc2/Makefile.in @@ -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@" diff --git a/racket/src/racket/gc2/block_cache.c b/racket/src/racket/gc2/block_cache.c index 0de6e63b5d..bfa65d17a7 100644 --- a/racket/src/racket/gc2/block_cache.c +++ b/racket/src/racket/gc2/block_cache.c @@ -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) { diff --git a/racket/src/racket/gc2/gclist.h b/racket/src/racket/gc2/gclist.h index 8d10259542..e883f5edbb 100644 --- a/racket/src/racket/gc2/gclist.h +++ b/racket/src/racket/gc2/gclist.h @@ -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) diff --git a/racket/src/racket/include/scheme.h b/racket/src/racket/include/scheme.h index dcaa235510..c2fc8206c1 100644 --- a/racket/src/racket/include/scheme.h +++ b/racket/src/racket/include/scheme.h @@ -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)] diff --git a/racket/src/racket/sconfig.h b/racket/src/racket/sconfig.h index 4df1b80d59..ca5cce6611 100644 --- a/racket/src/racket/sconfig.h +++ b/racket/src/racket/sconfig.h @@ -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 diff --git a/racket/src/racket/src/bignum.c b/racket/src/racket/src/bignum.c index f73197ba3b..88d6e26d44 100644 --- a/racket/src/racket/src/bignum.c +++ b/racket/src/racket/src/bignum.c @@ -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) { diff --git a/racket/src/racket/src/eval.c b/racket/src/racket/src/eval.c index c00b679ded..857b30609f 100644 --- a/racket/src/racket/src/eval.c +++ b/racket/src/racket/src/eval.c @@ -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) diff --git a/racket/src/racket/src/fun.c b/racket/src/racket/src/fun.c index 859154d01d..5dffc0f897 100644 --- a/racket/src/racket/src/fun.c +++ b/racket/src/racket/src/fun.c @@ -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; diff --git a/racket/src/racket/src/hash.c b/racket/src/racket/src/hash.c index 185a4c61e2..e327c4b973 100644 --- a/racket/src/racket/src/hash.c +++ b/racket/src/racket/src/hash.c @@ -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); } diff --git a/racket/src/racket/src/jit.h b/racket/src/racket/src/jit.h index 5d097e6011..27f44cb196 100644 --- a/racket/src/racket/src/jit.h +++ b/racket/src/racket/src/jit.h @@ -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 diff --git a/racket/src/racket/src/jitarith.c b/racket/src/racket/src/jitarith.c index e363df3050..926c791d69 100644 --- a/racket/src/racket/src/jitarith.c +++ b/racket/src/racket/src/jitarith.c @@ -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; diff --git a/racket/src/racket/src/jitstate.c b/racket/src/racket/src/jitstate.c index e3e71591c2..863f9c9ade 100644 --- a/racket/src/racket/src/jitstate.c +++ b/racket/src/racket/src/jitstate.c @@ -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; } diff --git a/racket/src/racket/src/lightning/i386/asm-common.h b/racket/src/racket/src/lightning/i386/asm-common.h index 478ad1fd98..a1a4349d60 100644 --- a/racket/src/racket/src/lightning/i386/asm-common.h +++ b/racket/src/racket/src/lightning/i386/asm-common.h @@ -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)) diff --git a/racket/src/racket/src/marshal.c b/racket/src/racket/src/marshal.c index f3041afe1d..68721d5cc4 100644 --- a/racket/src/racket/src/marshal.c +++ b/racket/src/racket/src/marshal.c @@ -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 diff --git a/racket/src/racket/src/module.c b/racket/src/racket/src/module.c index d9f871e219..564453d10c 100644 --- a/racket/src/racket/src/module.c +++ b/racket/src/racket/src/module.c @@ -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)); } diff --git a/racket/src/racket/src/mzclpf_post.inc b/racket/src/racket/src/mzclpf_post.inc index 9b47dc1f48..fd12642e10 100644 --- a/racket/src/racket/src/mzclpf_post.inc +++ b/racket/src/racket/src/mzclpf_post.inc @@ -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 */ diff --git a/racket/src/racket/src/numarith.c b/racket/src/racket/src/numarith.c index 36030db974..a05222d94d 100644 --- a/racket/src/racket/src/numarith.c +++ b/racket/src/racket/src/numarith.c @@ -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; diff --git a/racket/src/racket/src/number.c b/racket/src/racket/src/number.c index 9a403a8749..a24dda3990 100644 --- a/racket/src/racket/src/number.c +++ b/racket/src/racket/src/number.c @@ -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[]) { diff --git a/racket/src/racket/src/read.c b/racket/src/racket/src/read.c index 93bcdbd24e..a2c3c13a32 100644 --- a/racket/src/racket/src/read.c +++ b/racket/src/racket/src/read.c @@ -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 diff --git a/racket/src/racket/src/regexp.c b/racket/src/racket/src/regexp.c index d3858ded49..e501539f5d 100644 --- a/racket/src/racket/src/regexp.c +++ b/racket/src/racket/src/regexp.c @@ -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, diff --git a/racket/src/racket/src/resolve.c b/racket/src/racket/src/resolve.c index 90b728ac11..7c65eb3ac2 100644 --- a/racket/src/racket/src/resolve.c +++ b/racket/src/racket/src/resolve.c @@ -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) diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index 8bc90a71d4..fc08d6c35c 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -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 @@ -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 diff --git a/racket/src/racket/src/string.c b/racket/src/racket/src/string.c index 07d341c095..a3ebd33032 100644 --- a/racket/src/racket/src/string.c +++ b/racket/src/racket/src/string.c @@ -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; diff --git a/racket/src/racket/src/validate.c b/racket/src/racket/src/validate.c index 3edcfe0d40..3654e62e0c 100644 --- a/racket/src/racket/src/validate.c +++ b/racket/src/racket/src/validate.c @@ -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); } }