From 01d15eb9b62e7b0499dba81c41a74d9ea33cc391 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 2 Oct 2009 19:45:41 +0000 Subject: [PATCH] add unsafe-fx->fl; avoid some gcc warnings svn: r16221 --- collects/scribblings/reference/unsafe.scrbl | 5 +++++ collects/scribblings/scribble/manual.scrbl | 2 +- collects/tests/mzscheme/unsafe.ss | 3 +++ src/mzscheme/gc2/newgc.c | 17 +++++++++-------- src/mzscheme/src/bool.c | 3 --- src/mzscheme/src/jit.c | 8 ++++++-- src/mzscheme/src/mzmark.c | 21 --------------------- src/mzscheme/src/mzmarksrc.c | 7 ------- src/mzscheme/src/number.c | 13 +++++++++++++ src/mzscheme/src/read.c | 1 - src/mzscheme/src/schminc.h | 2 +- src/mzscheme/src/schpriv.h | 1 + src/mzscheme/src/schvers.h | 4 ++-- 13 files changed, 41 insertions(+), 46 deletions(-) diff --git a/collects/scribblings/reference/unsafe.scrbl b/collects/scribblings/reference/unsafe.scrbl index 43342ba971..a6764b53ec 100644 --- a/collects/scribblings/reference/unsafe.scrbl +++ b/collects/scribblings/reference/unsafe.scrbl @@ -79,6 +79,11 @@ For @tech{fixnums}: Like @scheme[=], @scheme[<], @scheme[>], @tech{fixnums}.} +@defproc[(unsafe-fx->fl [a fixnum?]) inexact-real?]{ +Like @scheme[exact->inexact], but constrained to consume @tech{fixnums}. +} + + @deftogether[( @defproc[(unsafe-fl+ [a inexact-real?][b inexact-real?]) inexact-real?] @defproc[(unsafe-fl- [a inexact-real?][b inexact-real?]) inexact-real?] diff --git a/collects/scribblings/scribble/manual.scrbl b/collects/scribblings/scribble/manual.scrbl index 7a66abbe1a..a62f9b345c 100644 --- a/collects/scribblings/scribble/manual.scrbl +++ b/collects/scribblings/scribble/manual.scrbl @@ -164,7 +164,7 @@ hyperlinked to the module path's definition as created by @scheme[defmodule].} @defform[(schememodlink datum pre-content-expr ...)]{ -Like @scheme[schememodlink], but separating the module path to link +Like @scheme[schememod], but separating the module path to link from the content to be linked. The @scheme[datum] module path is always linked, even if it is not an identifier.} diff --git a/collects/tests/mzscheme/unsafe.ss b/collects/tests/mzscheme/unsafe.ss index 3a8562a474..5a454fcc97 100644 --- a/collects/tests/mzscheme/unsafe.ss +++ b/collects/tests/mzscheme/unsafe.ss @@ -119,6 +119,9 @@ (test-bin 8 'unsafe-fxrshift 32 2) (test-bin 8 'unsafe-fxrshift 8 0) + (test-un 8.0 'unsafe-fx->fl 8) + (test-un -8.0 'unsafe-fx->fl -8) + (test-un 5 'unsafe-car (cons 5 9)) (test-un 9 'unsafe-cdr (cons 5 9)) (test-un 15 'unsafe-mcar (mcons 15 19)) diff --git a/src/mzscheme/gc2/newgc.c b/src/mzscheme/gc2/newgc.c index d2b420a4bf..e15b9aa797 100644 --- a/src/mzscheme/gc2/newgc.c +++ b/src/mzscheme/gc2/newgc.c @@ -2106,23 +2106,26 @@ void GC_mark(const void *const_p) /* this is what actually does mark propagation */ static inline void propagate_marks_worker(PageMap pagemap, Mark_Proc *mark_table, void *pp) { - void **start; + void **start, **end; int alloc_type; - objhead *info; - mpage *page; - int is_big_page = IS_BIG_PAGE_PTR(pp); - void *p = REMOVE_BIG_PAGE_PTR_TAG(pp); + void *p; /* we can assume a lot here -- like it's a valid pointer with a page -- because we vet bad cases out in GC_mark, above */ - if (is_big_page) { + if (IS_BIG_PAGE_PTR(pp)) { + mpage *page; + p = REMOVE_BIG_PAGE_PTR_TAG(pp); page = pagemap_find_page(pagemap, p); start = PPTR(BIG_PAGE_TO_OBJECT(page)); alloc_type = page->page_type; + end = PAGE_END_VSS(page); } else { + objhead *info; + p = pp; info = OBJPTR_TO_OBJHEAD(p); start = p; alloc_type = info->type; + end = PPTR(info) + info->size; } set_backtrace_source(start, alloc_type); @@ -2144,12 +2147,10 @@ static inline void propagate_marks_worker(PageMap pagemap, Mark_Proc *mark_table break; case PAGE_ARRAY: { - void **end = is_big_page ? PAGE_END_VSS(page) : PPTR(info) + info->size; while(start < end) gcMARK(*start++); break; } case PAGE_TARRAY: { - void **end = is_big_page ? PAGE_END_VSS(page) : PPTR(info) + info->size; const unsigned short tag = *(unsigned short *)start; ASSERT_TAG(tag); end -= INSET_WORDS; diff --git a/src/mzscheme/src/bool.c b/src/mzscheme/src/bool.c index 1bdea7ad2f..77b080cf71 100644 --- a/src/mzscheme/src/bool.c +++ b/src/mzscheme/src/bool.c @@ -29,9 +29,6 @@ #ifdef USE_STACKAVAIL # include #endif -#ifdef USE_IEEE_FP_PREDS -# include -#endif /* global_constants */ Scheme_Object scheme_true[1]; diff --git a/src/mzscheme/src/jit.c b/src/mzscheme/src/jit.c index fced80e7ca..ec3192af2c 100644 --- a/src/mzscheme/src/jit.c +++ b/src/mzscheme/src/jit.c @@ -3660,7 +3660,7 @@ static int generate_arith(mz_jit_state *jitter, Scheme_Object *rator, Scheme_Obj if (for_branch) mz_rs_sync(); } - if (unsafe_fl || (!SCHEME_INTP(rand) && can_fast_double(arith, cmp, 1))) { + if (unsafe_fl || (!unsafe_fx && !SCHEME_INTP(rand) && can_fast_double(arith, cmp, 1))) { /* Maybe they're both doubles... */ if (unsafe_fl) mz_rs_sync(); generate_double_arith(jitter, arith, cmp, reversed, 1, 0, &refd, &refdt, branch_short, unsafe_fl); @@ -3709,7 +3709,7 @@ static int generate_arith(mz_jit_state *jitter, Scheme_Object *rator, Scheme_Obj CHECK_LIMIT(); } - if (unsafe_fl || can_fast_double(arith, cmp, 1)) { + if (unsafe_fl || (!unsafe_fx && can_fast_double(arith, cmp, 1))) { /* Maybe they're both doubles... */ if (unsafe_fl) mz_rs_sync(); generate_double_arith(jitter, arith, cmp, reversed, 1, 0, &refd, &refdt, branch_short, unsafe_fl); @@ -3753,6 +3753,7 @@ static int generate_arith(mz_jit_state *jitter, Scheme_Object *rator, Scheme_Obj if (unsafe_fl || ((orig_args != 2) /* <- heuristic: we could generate code when an exact argument is given, but the extra FP code is probably not worthwhile. */ + && !unsafe_fx && can_fast_double(arith, cmp, 0) /* watch out: divide by 0 is special: */ && ((arith != -2) || v || reversed))) { @@ -4766,6 +4767,9 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in } else if (IS_NAMED_PRIM(rator, "exact->inexact")) { generate_arith(jitter, rator, app->rand, NULL, 1, 12, 0, 0, NULL, 1, 0, 0); return 1; + } else if (IS_NAMED_PRIM(rator, "unsafe-fx->fl")) { + generate_arith(jitter, rator, app->rand, NULL, 1, 12, 0, 0, NULL, 1, 1, 0); + return 1; } else if (IS_NAMED_PRIM(rator, "bitwise-not")) { generate_arith(jitter, rator, app->rand, NULL, 1, 7, 0, 9, NULL, 1, 0, 0); return 1; diff --git a/src/mzscheme/src/mzmark.c b/src/mzscheme/src/mzmark.c index 9df6163088..274dad8988 100644 --- a/src/mzscheme/src/mzmark.c +++ b/src/mzscheme/src/mzmark.c @@ -196,27 +196,6 @@ static int offset_cpointer_obj_FIXUP(void *p) { #define offset_cpointer_obj_IS_CONST_SIZE 1 -static int second_of_cons_SIZE(void *p) { - return - gcBYTES_TO_WORDS(sizeof(Scheme_Simple_Object)); -} - -static int second_of_cons_MARK(void *p) { - gcMARK(SCHEME_PTR2_VAL((Scheme_Object *)p)); - return - gcBYTES_TO_WORDS(sizeof(Scheme_Simple_Object)); -} - -static int second_of_cons_FIXUP(void *p) { - gcFIXUP(SCHEME_PTR2_VAL((Scheme_Object *)p)); - return - gcBYTES_TO_WORDS(sizeof(Scheme_Simple_Object)); -} - -#define second_of_cons_IS_ATOMIC 0 -#define second_of_cons_IS_CONST_SIZE 1 - - static int twoptr_obj_SIZE(void *p) { return gcBYTES_TO_WORDS(sizeof(Scheme_Simple_Object)); diff --git a/src/mzscheme/src/mzmarksrc.c b/src/mzscheme/src/mzmarksrc.c index c0da46ce60..a67d027af9 100644 --- a/src/mzscheme/src/mzmarksrc.c +++ b/src/mzscheme/src/mzmarksrc.c @@ -70,13 +70,6 @@ offset_cpointer_obj { gcBYTES_TO_WORDS(sizeof(Scheme_Offset_Cptr)); } -second_of_cons { - mark: - gcMARK(SCHEME_PTR2_VAL((Scheme_Object *)p)); - size: - gcBYTES_TO_WORDS(sizeof(Scheme_Simple_Object)); -} - twoptr_obj { mark: gcMARK(SCHEME_PTR1_VAL((Scheme_Object *)p)); diff --git a/src/mzscheme/src/number.c b/src/mzscheme/src/number.c index 904b366c07..53f1f83578 100644 --- a/src/mzscheme/src/number.c +++ b/src/mzscheme/src/number.c @@ -104,6 +104,7 @@ static Scheme_Object *fx_xor (int argc, Scheme_Object *argv[]); static Scheme_Object *fx_not (int argc, Scheme_Object *argv[]); static Scheme_Object *fx_lshift (int argc, Scheme_Object *argv[]); static Scheme_Object *fx_rshift (int argc, Scheme_Object *argv[]); +static Scheme_Object *fx_to_fl (int argc, Scheme_Object *argv[]); static double not_a_number_val; @@ -519,6 +520,11 @@ void scheme_init_unsafe_number(Scheme_Env *env) p = scheme_make_folding_prim(fx_rshift, "unsafe-fxrshift", 2, 2, 1); SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED; scheme_add_global_constant("unsafe-fxrshift", p, env); + + p = scheme_make_folding_prim(fx_to_fl, "unsafe-fx->fl", 1, 1, 1); + if (scheme_can_inline_fp_op()) + SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED; + scheme_add_global_constant("unsafe-fx->fl", p, env); } @@ -2801,3 +2807,10 @@ static Scheme_Object *fx_not (int argc, Scheme_Object *argv[]) return scheme_make_integer(v); } +static Scheme_Object *fx_to_fl (int argc, Scheme_Object *argv[]) +{ + long v; + if (scheme_current_thread->constant_folding) return scheme_exact_to_inexact(argc, argv); + v = SCHEME_INT_VAL(argv[0]); + return scheme_make_double(v); +} diff --git a/src/mzscheme/src/read.c b/src/mzscheme/src/read.c index 6cd0f6c751..526bf8395e 100644 --- a/src/mzscheme/src/read.c +++ b/src/mzscheme/src/read.c @@ -46,7 +46,6 @@ #ifdef USE_STACKAVAIL # include #endif -#include "math.h" #define MAX_QUICK_SYMBOL_SIZE 64 diff --git a/src/mzscheme/src/schminc.h b/src/mzscheme/src/schminc.h index 54bfee4a49..37497bc7ab 100644 --- a/src/mzscheme/src/schminc.h +++ b/src/mzscheme/src/schminc.h @@ -14,7 +14,7 @@ #define USE_COMPILED_STARTUP 1 #define EXPECTED_PRIM_COUNT 959 -#define EXPECTED_UNSAFE_COUNT 38 +#define EXPECTED_UNSAFE_COUNT 39 #ifdef MZSCHEME_SOMETHING_OMITTED # undef USE_COMPILED_STARTUP diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h index cadbec9a29..1857e14d86 100644 --- a/src/mzscheme/src/schpriv.h +++ b/src/mzscheme/src/schpriv.h @@ -1651,6 +1651,7 @@ extern int scheme_is_nan(double); # define MZ_IS_NAN(d) _isnan(d) # else /* USE_IEEE_FP_PREDS */ +# include # define MZ_IS_INFINITY(d) (isinf(d)) # define MZ_IS_POS_INFINITY(d) (isinf(d) && (d > 0)) # define MZ_IS_NEG_INFINITY(d) (isinf(d) && (d < 0)) diff --git a/src/mzscheme/src/schvers.h b/src/mzscheme/src/schvers.h index e2ad4abe51..7fe93e462a 100644 --- a/src/mzscheme/src/schvers.h +++ b/src/mzscheme/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "4.2.2.2" +#define MZSCHEME_VERSION "4.2.2.3" #define MZSCHEME_VERSION_X 4 #define MZSCHEME_VERSION_Y 2 #define MZSCHEME_VERSION_Z 2 -#define MZSCHEME_VERSION_W 2 +#define MZSCHEME_VERSION_W 3 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)