add unsafe-fx->fl; avoid some gcc warnings

svn: r16221

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?]

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.}
 

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))

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;
+  void *p;
-  mpage *page;
-  int is_big_page = IS_BIG_PAGE_PTR(pp);
-  void *p = REMOVE_BIG_PAGE_PTR_TAG(pp);
 
   /* 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;

src/mzscheme/src/bool.c

@@ -29,9 +29,6 @@
 #ifdef USE_STACKAVAIL
 # include <malloc.c>
 #endif
-#ifdef USE_IEEE_FP_PREDS
-# include <math.h>
-#endif
 
 /* global_constants */
 Scheme_Object scheme_true[1];

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;

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));

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));

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);
+}

src/mzscheme/src/read.c

@@ -46,7 +46,6 @@
 #ifdef USE_STACKAVAIL
 # include <malloc.h>
 #endif
-#include "math.h"
 
 #define MAX_QUICK_SYMBOL_SIZE 64
 

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

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 <math.h>
 #      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))

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)