dynamic-require and 0 mode; repair to unsafe-fl ops; x86_64 for Mac OS X

svn: r15985

collects/compiler/private/mach-o.ss

@@ -24,13 +24,18 @@
 
 (define move-link-edit? #t)
 
+(define exe-id
+  (if (equal? (path->bytes (system-library-subpath #f)) #"x86_64-macosx")
+      #xFeedFacf
+      #xFeedFace))
+
 (define (add-plt-segment file segdata)
   (let-values ([(p out) (open-input-output-file file #:exists 'update)])
     (dynamic-wind
         void
         (lambda ()
           (file-stream-buffer-mode out 'none)
-          (check-same #xFeedFace (read-ulong p))
+          (check-same exe-id (read-ulong p))
           (read-ulong p)
           (read-ulong p)
           (check-same #x2 (read-ulong p))
@@ -235,7 +240,7 @@
     (dynamic-wind
         void
         (lambda ()
-          (check-same #xFeedFace (read-ulong p))
+          (check-same exe-id (read-ulong p))
           (read-ulong p)
           (read-ulong p)
           (check-same #x2 (read-ulong p))

collects/dynext/compile-unit.ss

@@ -65,15 +65,15 @@
       (define gcc-cpp-flags 
 	(add-variant-flags (case (string->symbol (path->string (system-library-subpath #f)))
 			     [(parisc-hpux) '("-D_HPUX_SOURCE")]
-			     [(ppc-macosx) '("-DOS_X")]
+			     [(ppc-macosx x86_64-macosx) '("-DOS_X")]
 			     [(i386-macosx) '("-DOS_X" "-m32")]
-			     [(ppc-darwin) '("-DOS_X" "-DXONX")]
+			     [(ppc-darwin x86_64-darwin) '("-DOS_X" "-DXONX")]
 			     [(i386-darwin) '("-DOS_X" "-DXONX" "-m32")]
 			     [else null])))
 
       (define gcc-compile-flags (append '("-c" "-O2" "-fPIC")
 					(case (string->symbol (path->string (system-library-subpath #f)))
-					  [(ppc-macosx i386-macosx) '("-fno-common")]
+					  [(ppc-macosx i386-macosx x86_64-macosx) '("-fno-common")]
 					  [(ppc-darwin) '("-fno-common")]
 					  [(win32\\i386) '("-DAS_MSVC_EXTENSION")]
 					  [else null])

collects/dynext/link-unit.ss

@@ -140,7 +140,7 @@
 			    (format "-bE:~a/ext.exp" include-dir)
 			    "-bnoentry")]
 	  [(parisc-hpux) (list "-b")]
-	  [(ppc-macosx ppc-darwin) mac-link-flags]
+	  [(ppc-macosx ppc-darwin x86_64-macosx x86_86-darwin) mac-link-flags]
           [(i386-macosx i386-darwin) (append mac-link-flags '("-m32"))]
 	  [(i386-cygwin) win-gcc-linker-flags]
 	  [else (list "-fPIC" "-shared")]))

collects/scribblings/reference/module-reflect.scrbl

@@ -318,7 +318,7 @@ See also @scheme[module->language-info].}
 @section[#:tag "dynreq"]{Dynamic Module Access}
 
 @defproc[(dynamic-require [mod module-path?]
-                          [provided (or/c symbol? #f void?)]
+                          [provided (or/c symbol? #f 0 void?)]
                           [fail-thunk (-> any) (lambda () ....)])
          any]{
 
@@ -337,14 +337,20 @@ above the @tech{base phase}.
 
 When @scheme[provided] is a symbol, the value of the module's export
 with the given name is returned, and still the module is not
-@tech{visit}ed. If the module exports @scheme[provide] as syntax, then
+@tech{visit}ed or made @tech{available} in higher phases. If the
-a use of the binding is expanded and evaluated in a fresh namespace to
+module exports @scheme[provide] as syntax, then a use of the binding
-which the module is attached, which means that the module is
+is expanded and evaluated in a fresh namespace to which the module is
-@tech{visit}ed in the fresh namespace. If the module has no such
+attached, which means that the module is @tech{visit}ed in the fresh
-exported variable or syntax, then @scheme[fail-thunk] is called; the
+namespace. If the module has no such exported variable or syntax, then
-default @scheme[fail-thunk] raises @scheme[exn:fail:contract]. If the
+@scheme[fail-thunk] is called; the default @scheme[fail-thunk] raises
-variable named by @scheme[provided] is exported protected (see
+@scheme[exn:fail:contract]. If the variable named by @scheme[provided]
-@secref["modprotect"]), then the @exnraise[exn:fail:contract].
+is exported protected (see @secref["modprotect"]), then the
+@exnraise[exn:fail:contract].
+
+If @scheme[provided] is @scheme[0], then the module is
+@tech{instantiate}d but not @tech{visit}ed, the same as when
+@scheme[provided] is @scheme[#f]. With @scheme[0], however, the module
+is made @tech{available} in higher phases.
 
 If @scheme[provided] is @|void-const|, then the module is
 @tech{visit}ed but not @tech{instantiate}d (see @secref["mod-parse"]),

collects/tests/mzscheme/optimize.ss

@@ -237,6 +237,12 @@
     (un (sub1 (expt 2 62)) 'abs (sub1 (expt 2 62)))
     (un (expt 2 62) 'abs (- (expt 2 62)))
     
+    (un 1.0 'exact->inexact 1)
+    (un 1073741823.0 'exact->inexact (sub1 (expt 2 30)))
+    (un -1073741824.0 'exact->inexact (- (expt 2 30)))
+    (un 4611686018427387903.0 'exact->inexact (sub1 (expt 2 62)))
+    (un -4611686018427387904.0 'exact->inexact (- (expt 2 62)))
+
     (bin 11 '+ 4 7)
     (bin -3 '+ 4 -7)
     (bin (expt 2 30) '+ (expt 2 29) (expt 2 29))

src/README

@@ -67,6 +67,12 @@ the Unix instructions below, but note the following:
    directory structure on top of an existing Unix-style directory
    structure.)
 
+ * Under Mac OS X 10.6 and later, `configure' by default selects
+   32-bit mode for building MzScheme and MrEd. To build MzScheme in
+   64-bit mode (MrEd is not support in that mode), use the following
+   arguments to `configure': --enable-mac64, --enable-sgc, and
+   --disable-mred.
+
 ========================================================================
  Compiling for supported Unix variants (including Linux) or Cygwin
 ========================================================================

src/configure

@@ -1369,6 +1369,7 @@ Optional Features:
   --enable-libfw          install Mac OS X frameworks to /Library/Frameworks
   --enable-userfw         install Mac OS X frameworks to ~/Library/Frameworks
   --enable-macprefix      allow --prefix with a Mac OS X install
+  --enable-mac64          do not force 32-bit build
 
 Optional Packages:
   --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]
@@ -2017,6 +2018,11 @@ if test "${enable_macprefix+set}" = set; then
   enableval=$enable_macprefix;
 fi
 
+# Check whether --enable-mac64 was given.
+if test "${enable_mac64+set}" = set; then
+  enableval=$enable_mac64;
+fi
+
 
 
 ###### Get OS Type #######
@@ -5935,6 +5941,7 @@ case $OS in
     fi
 
     # Force 32-bit build, for now
+    if test "${enable_mac64}" != "yes" ; then
       if test `${UNAME} -m` = "i386" ; then
         if test "${ORIG_CC}" = "" ; then
            CC="${CC} -m32"
@@ -5956,6 +5963,7 @@ case $OS in
            CC_FOR_BUILD="${CC_FOR_BUILD} -m32"
         fi
       fi
+    fi
 
     if test "${enable_quartz}" = "yes" ; then
       WXVARIANT="wx_mac"

src/mzscheme/configure.ac

@@ -74,6 +74,7 @@ AC_ARG_ENABLE(xonx,    [  --enable-xonx           compile X11 (not Quartz) MrEd
 AC_ARG_ENABLE(libfw,   [  --enable-libfw          install Mac OS X frameworks to /Library/Frameworks])
 AC_ARG_ENABLE(libfw,   [  --enable-userfw         install Mac OS X frameworks to ~/Library/Frameworks])
 AC_ARG_ENABLE(macprefix, [  --enable-macprefix      allow --prefix with a Mac OS X install])
+AC_ARG_ENABLE(mac64,   [  --enable-mac64          do not force 32-bit build])
 
 
 ###### Get OS Type #######
@@ -664,6 +665,7 @@ case $OS in
     fi
 
     # Force 32-bit build, for now
+    if test "${enable_mac64}" != "yes" ; then
       if test `${UNAME} -m` = "i386" ; then
         if test "${ORIG_CC}" = "" ; then
            CC="${CC} -m32"
@@ -685,6 +687,7 @@ case $OS in
            CC_FOR_BUILD="${CC_FOR_BUILD} -m32"
         fi
       fi
+    fi
 
     if test "${enable_quartz}" = "yes" ; then
       WXVARIANT="wx_mac"

src/mzscheme/gc/include/private/gcconfig.h

@@ -307,6 +307,10 @@
 #    define I386
 #    define mach_type_known
 #   endif
+#   if defined(__x86_64__)
+#    define X86_64
+#    define mach_type_known
+#   endif
 # endif
 # if defined(NeXT) && defined(mc68000)
 #   define M68K
@@ -2026,6 +2030,16 @@
 	extern char etext[];
 #	define SEARCH_FOR_DATA_START
 #   endif
+#   ifdef DARWIN
+#     define DARWIN_DONT_PARSE_STACK
+#     define DYNAMIC_LOADING
+#     define DATASTART ((ptr_t) get_etext())
+#     define DATAEND	((ptr_t) get_end())
+#     define STACKBOTTOM ((ptr_t) 0xc0000000)
+#     define USE_MMAP
+#     define USE_MMAP_ANON
+#     define USE_ASM_PUSH_REGS
+#   endif
 # endif
 
 #if defined(LINUX) && defined(USE_MMAP)

src/mzscheme/gc2/vm_osx.c

@@ -35,10 +35,17 @@ static int designate_modified(void *p);
 int designate_modified(void *p);
 #endif
 
-#ifdef __POWERPC__
+#if defined(__POWERPC__)
 # define ARCH_thread_state_t ppc_thread_state_t
 # define ARCH_THREAD_STATE PPC_THREAD_STATE
 # define ARCH_THREAD_STATE_COUNT PPC_THREAD_STATE_COUNT
+#elif defined(__x86_64__)
+# define ARCH_thread_state_t x86_thread_state64_t
+# define ARCH_THREAD_STATE x86_THREAD_STATE64
+# define ARCH_THREAD_STATE_COUNT x86_THREAD_STATE64_COUNT
+# define USE_THREAD_STATE
+# include <mach/thread_status.h>
+# include <mach/exception.h>
 #else
 # define ARCH_thread_state_t i386_thread_state_t
 # define ARCH_THREAD_STATE i386_THREAD_STATE
@@ -209,7 +216,18 @@ kern_return_t GC_catch_exception_raise(mach_port_t port,
   /* kernel return value is in exception_data[0], faulting address in
      exception_data[1] */
   if(exception_data[0] == KERN_PROTECTION_FAILURE) {
-    if (designate_modified((void*)exception_data[1]))
+    void *p;
+#ifndef USE_THREAD_STATE
+    p = (void*)exception_data[1];
+#else
+    /* We have to do it this way for 64-bit mode: */
+    x86_exception_state64_t exc_state;
+    mach_msg_type_number_t exc_state_count = x86_EXCEPTION_STATE64_COUNT;
+    (void)thread_get_state(thread_port, x86_EXCEPTION_STATE64, (natural_t*)&exc_state,
+                           &exc_state_count);
+    p = (void *)exc_state.__faultvaddr;
+#endif
+    if (designate_modified(p))
       return KERN_SUCCESS;
     else
       return KERN_FAILURE;

src/mzscheme/sconfig.h

@@ -645,15 +645,23 @@
 # ifdef __POWERPC__
 #  define SCHEME_PLATFORM_LIBRARY_SUBPATH "ppc-darwin"
 # else
+#  ifdef __x86_64__
+#   define SCHEME_PLATFORM_LIBRARY_SUBPATH "x86_64-darwin"
+#  else
 #   define SCHEME_PLATFORM_LIBRARY_SUBPATH "i386-darwin"
 #  endif
+# endif
 #else
 # ifdef __POWERPC__
 #  define SCHEME_PLATFORM_LIBRARY_SUBPATH "ppc-macosx"
 # else
+#  ifdef __x86_64__
+#   define SCHEME_PLATFORM_LIBRARY_SUBPATH "x86_64-macosx"
+#  else
 #   define SCHEME_PLATFORM_LIBRARY_SUBPATH "i386-macosx"
 #  endif
 # endif
+#endif
 
 # include "uconfig.h"
 
@@ -693,8 +701,10 @@
 #  define OS_X 1
 #endif
 
-#ifdef __POWERPC__
+#if defined(__POWERPC__)
 # define MZ_USE_JIT_PPC
+#elif defined(__x86_64__)
+# define MZ_USE_JIT_X86_64
 #else
 # define MZ_USE_JIT_I386
 # define ASM_DBLPREC_CONTROL_87

src/mzscheme/src/jit.c

@@ -1101,8 +1101,10 @@ static void _jit_prolog_again(mz_jit_state *jitter, int n, int ret_addr_reg)
 # define mz_patch_ucbranch_at(a, v) jit_patch_ucbranch_at(a, v)
 # ifdef _CALL_DARWIN
 #  define X86_ALIGN_STACK
+#  ifndef JIT_X86_64
 #   define STACK_ALIGN_WORDS 3
 #  endif
+# endif
 # ifdef JIT_X86_64
 #  define X86_ALIGN_STACK
 #  define STACK_ALIGN_WORDS 1
@@ -3260,7 +3262,8 @@ static int can_fast_double(int arith, int cmp, int two_args)
       || (arith == -1)
       || (arith == 2)
       || (arith == -2)
-      || (arith == 11))
+      || (arith == 11)
+      || (arith == 12))
     return 1;
 #endif
 #ifdef INLINE_FP_COMP
@@ -3308,6 +3311,25 @@ static int can_fast_double(int arith, int cmp, int two_args)
 #define jit_bantieqr_d_fppop(d, s1, s2) jit_bantieqr_d(d, s1, s2)
 #endif
 
+static int generate_alloc_double(mz_jit_state *jitter)
+{
+#ifdef INLINE_FP_OPS
+# ifdef CAN_INLINE_ALLOC
+  inline_alloc(jitter, sizeof(Scheme_Double), scheme_double_type, 0, 0, 1, 0);
+  CHECK_LIMIT();
+  jit_addi_p(JIT_R0, JIT_V1, GC_OBJHEAD_SIZE);
+  (void)jit_stxi_d_fppop(&((Scheme_Double *)0x0)->double_val, JIT_R0, JIT_FPR1);
+# else
+  (void)jit_sti_d_fppop(&double_result, JIT_FPR1);    
+  JIT_UPDATE_THREAD_RSPTR_IF_NEEDED();
+  mz_prepare(0);
+  (void)mz_finish(malloc_double);
+  jit_retval(JIT_R0);
+# endif
+#endif
+  return 1;
+}
+
 static int generate_double_arith(mz_jit_state *jitter, int arith, int cmp, int reversed, int two_args, int second_const,
                                  jit_insn **_refd, jit_insn **_refdt,
                                  int branch_short, int unsafe_fl)
@@ -3342,13 +3364,17 @@ static int generate_double_arith(mz_jit_state *jitter, int arith, int cmp, int r
     (void)jit_movi_p(JIT_R0, scheme_make_integer(0));
   } else {
     /* Yes, they're doubles. */
+    if (arith != 12) {
       jit_ldxi_d_fppush(JIT_FPR1, JIT_R0, &((Scheme_Double *)0x0)->double_val);
+    }
     if (two_args) {
       jit_ldxi_d_fppush(JIT_FPR0, JIT_R1, &((Scheme_Double *)0x0)->double_val);
     } else if ((arith == -1) && !second_const && reversed) {
       reversed = 0;
     } else if (arith == 11) {
       /* abs needs no extra number */
+    } else if (arith == 12) {
+      /* exact->inexact needs no extra number */
     } else {
       double d = second_const;      
       jit_movi_d_fppush(JIT_FPR0, d);
@@ -3403,29 +3429,18 @@ static int generate_double_arith(mz_jit_state *jitter, int arith, int cmp, int r
       case 11: /* abs */
         jit_abs_d_fppop(JIT_FPR1, JIT_FPR1);
         break;
+      case 12: /* exact->inexact */
+        no_alloc = 1;
+        break;
       default:
         break;
       }
       CHECK_LIMIT();
 
       if (!no_alloc) {
-#ifdef INLINE_FP_OPS
+        generate_alloc_double(jitter);
-# ifdef CAN_INLINE_ALLOC
-        inline_alloc(jitter, sizeof(Scheme_Double), scheme_double_type, 0, 0, 1, 0);
-        CHECK_LIMIT();
-        jit_addi_p(JIT_R0, JIT_V1, GC_OBJHEAD_SIZE);
-        (void)jit_stxi_d_fppop(&((Scheme_Double *)0x0)->double_val, JIT_R0, JIT_FPR1);
-# else
-        (void)jit_sti_d_fppop(&double_result, JIT_FPR1);    
-        JIT_UPDATE_THREAD_RSPTR_IF_NEEDED();
-        mz_prepare(0);
-        (void)mz_finish(malloc_double);
-        jit_retval(JIT_R0);
-# endif
-#endif
         CHECK_LIMIT();
       }
-
     } else {
       /* The "anti" variants below invert the branch. Unlike the "un" 
          variants, the "anti" variants invert the comparison result
@@ -3499,6 +3514,7 @@ static int generate_arith(mz_jit_state *jitter, Scheme_Object *rator, Scheme_Obj
         arith = 9 -> min
         arith = 10 -> max
         arith = 11 -> abs
+        arith = 12 -> exact->inexact
         cmp = 0 -> = or zero?
         cmp = +/-1 -> >=/<=
         cmp = +/-2 -> >/< or positive/negative?
@@ -3639,6 +3655,7 @@ static int generate_arith(mz_jit_state *jitter, Scheme_Object *rator, Scheme_Obj
 
     if (unsafe_fl || (!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);
       CHECK_LIMIT();
     }
@@ -3687,6 +3704,7 @@ static int generate_arith(mz_jit_state *jitter, Scheme_Object *rator, Scheme_Obj
 
     if (unsafe_fl || 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);
       CHECK_LIMIT();
     }
@@ -4046,6 +4064,15 @@ static int generate_arith(mz_jit_state *jitter, Scheme_Object *rator, Scheme_Obj
             mz_patch_branch(refc);
             __END_INNER_TINY__(branch_short);
             CHECK_LIMIT();
+          } else if (arith == 12) {
+            /* exact->inexact */
+            jit_rshi_l(JIT_R0, JIT_R0, 1);
+            jit_extr_l_d_fppush(JIT_FPR0, JIT_R0);
+            CHECK_LIMIT();
+            __END_SHORT_JUMPS__(branch_short);
+            generate_alloc_double(jitter);
+            __START_SHORT_JUMPS__(branch_short);
+            CHECK_LIMIT();
           }
         }
       }
@@ -4729,6 +4756,9 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
     } else if (IS_NAMED_PRIM(rator, "abs")) {
       generate_arith(jitter, rator, app->rand, NULL, 1, 11, 0, 0, NULL, 1, 0, 0);
       return 1;
+    } 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, "bitwise-not")) {
       generate_arith(jitter, rator, app->rand, NULL, 1, 7, 0, 9, NULL, 1, 0, 0);
       return 1;

src/mzscheme/src/lightning/i386/fp.h

@@ -206,6 +206,16 @@ union jit_double_imm {
    : (FILDLm(0, _ESP, 0, 0), FSTPr ((rd) + 1))),       \
   POPLr((rs)))
 
+#define jit_extr_i_d_fppush(rd, rs)  \
+  (PUSHLr((rs)), FILDLm(0, _ESP, 0, 0), POPLr((rs)))
+#ifdef JIT_X86_64
+# define jit_extr_l_d_fppush(rd, rs)  \
+  (PUSHQr((rs)), FILDQm(0, _ESP, 0, 0), POPQr((rs)))
+#else
+# define jit_extr_l_d_fppush(rd, rs) jit_extr_i_d_fppush(rd, rs)
+#endif
+
+
 #define jit_stxi_f(id, rd, rs) jit_fxch ((rs), FPX(), FSTSm((id), (rd), 0, 0))
 #define jit_stxr_f(d1, d2, rs) jit_fxch ((rs), FPX(), FSTSm(0, (d1), (d2), 1))
 #define jit_stxi_d(id, rd, rs) jit_fxch ((rs), FPX(), FSTLm((id), (rd), 0, 0))

src/mzscheme/src/module.c

@@ -844,8 +844,11 @@ static Scheme_Object *_dynamic_require(int argc, Scheme_Object *argv[],
 		: "dynamic-require-for-syntax" )
 	     : "dynamic-require");
 
-  if (SCHEME_TRUEP(name) && !SCHEME_SYMBOLP(name) && !SCHEME_VOIDP(name)) {
+  if (SCHEME_TRUEP(name) 
-    scheme_wrong_type(errname, "symbol, #f, or void", 1, argc, argv);
+      && !SCHEME_SYMBOLP(name) 
+      && !SAME_OBJ(name, scheme_make_integer(0))
+      && !SCHEME_VOIDP(name)) {
+    scheme_wrong_type(errname, "symbol, #f, 0, or void", 1, argc, argv);
     return NULL;
   }
 
@@ -991,10 +994,17 @@ static Scheme_Object *_dynamic_require(int argc, Scheme_Object *argv[],
     }
   }
 
-  if (SCHEME_VOIDP(name))
+  start_module(m, env, 0, modidx, 
-    start_module(m, env, 0, modidx, 1, 0, base_phase, scheme_null);
+               (SCHEME_VOIDP(name)
-  else
+                ? 1
-    start_module(m, env, 0, modidx, 0, 1, base_phase, scheme_null);
+                : (SAME_OBJ(name, scheme_make_integer(0)) 
+                   ? -1
+                   : 0)), 
+               (SCHEME_VOIDP(name)
+                ? 0
+                : 1),
+               base_phase, 
+               scheme_null);
 
   if (SCHEME_SYMBOLP(name)) {
     Scheme_Bucket *b;

src/mzscheme/src/number.c

@@ -477,11 +477,14 @@ scheme_init_number (Scheme_Env *env)
 						      "magnitude",
 						      1, 1, 1),
 			     env);
-  scheme_add_global_constant("exact->inexact", 
+  
-			     scheme_make_folding_prim(scheme_exact_to_inexact,
+  p = scheme_make_folding_prim(scheme_exact_to_inexact,
                                "exact->inexact",
-						      1, 1, 1),
+                               1, 1, 1);
-			     env);
+  if (scheme_can_inline_fp_op())
+    SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
+  scheme_add_global_constant("exact->inexact", p, env);
+
   scheme_add_global_constant("inexact->exact", 
 			     scheme_make_folding_prim(scheme_inexact_to_exact,
 						      "inexact->exact",