diff --git a/collects/compiler/private/mach-o.ss b/collects/compiler/private/mach-o.ss index d669ab1df9..530c2b9b94 100644 --- a/collects/compiler/private/mach-o.ss +++ b/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)) diff --git a/collects/dynext/compile-unit.ss b/collects/dynext/compile-unit.ss index f2d9099cb6..8e1e9a2b5d 100644 --- a/collects/dynext/compile-unit.ss +++ b/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]) diff --git a/collects/dynext/link-unit.ss b/collects/dynext/link-unit.ss index 14120dccde..cf2849e587 100644 --- a/collects/dynext/link-unit.ss +++ b/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")])) diff --git a/collects/scribblings/reference/module-reflect.scrbl b/collects/scribblings/reference/module-reflect.scrbl index 3bb996be5b..8bae45866a 100644 --- a/collects/scribblings/reference/module-reflect.scrbl +++ b/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 -a use of the binding is expanded and evaluated in a fresh namespace to -which the module is attached, which means that the module is -@tech{visit}ed in the fresh namespace. If the module has no such -exported variable or syntax, then @scheme[fail-thunk] is called; the -default @scheme[fail-thunk] raises @scheme[exn:fail:contract]. If the -variable named by @scheme[provided] is exported protected (see -@secref["modprotect"]), then the @exnraise[exn:fail:contract]. +@tech{visit}ed or made @tech{available} in higher phases. If the +module exports @scheme[provide] as syntax, then a use of the binding +is expanded and evaluated in a fresh namespace to which the module is +attached, which means that the module is @tech{visit}ed in the fresh +namespace. If the module has no such exported variable or syntax, then +@scheme[fail-thunk] is called; the default @scheme[fail-thunk] raises +@scheme[exn:fail:contract]. If the variable named by @scheme[provided] +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"]), diff --git a/collects/tests/mzscheme/optimize.ss b/collects/tests/mzscheme/optimize.ss index 0ca86f8881..9f9d3ba63e 100644 --- a/collects/tests/mzscheme/optimize.ss +++ b/collects/tests/mzscheme/optimize.ss @@ -236,6 +236,12 @@ (un (expt 2 30) 'abs (- (expt 2 30))) (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) diff --git a/src/README b/src/README index 2585cf042d..1e36c25615 100644 --- a/src/README +++ b/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 ======================================================================== diff --git a/src/configure b/src/configure index 6e69ace383..153990bb3a 100755 --- a/src/configure +++ b/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,25 +5941,27 @@ case $OS in fi # Force 32-bit build, for now - if test `${UNAME} -m` = "i386" ; then - if test "${ORIG_CC}" = "" ; then - CC="${CC} -m32" - SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CC="'"'"${CC}"'"' - fi - if test "${ORIG_CPP}" = "" ; then - CPP="${CPP} -m32" - SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CPP="'"'"${CPP}"'"' - fi - if test "${ORIG_CXX}" = "" ; then - CXX="${CXX} -m32" - SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CXX="'"'"${CXX}"'"' - fi - if test "${ORIG_CXXCPP}" = "" ; then - CXXCPP="${CXXCPP} -m32" - SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CPPCXX="'"'"${CPPCXX}"'"' - fi - if test "${ORIG_CC_FOR_BUILD}" = "" ; then - CC_FOR_BUILD="${CC_FOR_BUILD} -m32" + if test "${enable_mac64}" != "yes" ; then + if test `${UNAME} -m` = "i386" ; then + if test "${ORIG_CC}" = "" ; then + CC="${CC} -m32" + SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CC="'"'"${CC}"'"' + fi + if test "${ORIG_CPP}" = "" ; then + CPP="${CPP} -m32" + SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CPP="'"'"${CPP}"'"' + fi + if test "${ORIG_CXX}" = "" ; then + CXX="${CXX} -m32" + SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CXX="'"'"${CXX}"'"' + fi + if test "${ORIG_CXXCPP}" = "" ; then + CXXCPP="${CXXCPP} -m32" + SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CPPCXX="'"'"${CPPCXX}"'"' + fi + if test "${ORIG_CC_FOR_BUILD}" = "" ; then + CC_FOR_BUILD="${CC_FOR_BUILD} -m32" + fi fi fi diff --git a/src/mzscheme/configure.ac b/src/mzscheme/configure.ac index d470b122e7..6bc47e8a47 100644 --- a/src/mzscheme/configure.ac +++ b/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,25 +665,27 @@ case $OS in fi # Force 32-bit build, for now - if test `${UNAME} -m` = "i386" ; then - if test "${ORIG_CC}" = "" ; then - CC="${CC} -m32" - SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CC="'"'"${CC}"'"' - fi - if test "${ORIG_CPP}" = "" ; then - CPP="${CPP} -m32" - SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CPP="'"'"${CPP}"'"' - fi - if test "${ORIG_CXX}" = "" ; then - CXX="${CXX} -m32" - SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CXX="'"'"${CXX}"'"' - fi - if test "${ORIG_CXXCPP}" = "" ; then - CXXCPP="${CXXCPP} -m32" - SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CPPCXX="'"'"${CPPCXX}"'"' - fi - if test "${ORIG_CC_FOR_BUILD}" = "" ; then - CC_FOR_BUILD="${CC_FOR_BUILD} -m32" + if test "${enable_mac64}" != "yes" ; then + if test `${UNAME} -m` = "i386" ; then + if test "${ORIG_CC}" = "" ; then + CC="${CC} -m32" + SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CC="'"'"${CC}"'"' + fi + if test "${ORIG_CPP}" = "" ; then + CPP="${CPP} -m32" + SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CPP="'"'"${CPP}"'"' + fi + if test "${ORIG_CXX}" = "" ; then + CXX="${CXX} -m32" + SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CXX="'"'"${CXX}"'"' + fi + if test "${ORIG_CXXCPP}" = "" ; then + CXXCPP="${CXXCPP} -m32" + SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CPPCXX="'"'"${CPPCXX}"'"' + fi + if test "${ORIG_CC_FOR_BUILD}" = "" ; then + CC_FOR_BUILD="${CC_FOR_BUILD} -m32" + fi fi fi diff --git a/src/mzscheme/gc/include/private/gcconfig.h b/src/mzscheme/gc/include/private/gcconfig.h index 7395faf5c7..cbb1297392 100644 --- a/src/mzscheme/gc/include/private/gcconfig.h +++ b/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) diff --git a/src/mzscheme/gc2/vm_osx.c b/src/mzscheme/gc2/vm_osx.c index b182bc8de3..93ea4a2b17 100644 --- a/src/mzscheme/gc2/vm_osx.c +++ b/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 +# include #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; diff --git a/src/mzscheme/sconfig.h b/src/mzscheme/sconfig.h index f91a994f0a..091bb5c083 100644 --- a/src/mzscheme/sconfig.h +++ b/src/mzscheme/sconfig.h @@ -645,13 +645,21 @@ # ifdef __POWERPC__ # define SCHEME_PLATFORM_LIBRARY_SUBPATH "ppc-darwin" # else -# define SCHEME_PLATFORM_LIBRARY_SUBPATH "i386-darwin" +# 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 -# define SCHEME_PLATFORM_LIBRARY_SUBPATH "i386-macosx" +# ifdef __x86_64__ +# define SCHEME_PLATFORM_LIBRARY_SUBPATH "x86_64-macosx" +# else +# define SCHEME_PLATFORM_LIBRARY_SUBPATH "i386-macosx" +# endif # endif #endif @@ -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 diff --git a/src/mzscheme/src/jit.c b/src/mzscheme/src/jit.c index 4b1eab186e..01784ea05c 100644 --- a/src/mzscheme/src/jit.c +++ b/src/mzscheme/src/jit.c @@ -1101,7 +1101,9 @@ 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 -# define STACK_ALIGN_WORDS 3 +# ifndef JIT_X86_64 +# define STACK_ALIGN_WORDS 3 +# endif # endif # ifdef JIT_X86_64 # define X86_ALIGN_STACK @@ -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. */ - jit_ldxi_d_fppush(JIT_FPR1, JIT_R0, &((Scheme_Double *)0x0)->double_val); + 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 -# 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 + generate_alloc_double(jitter); 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; diff --git a/src/mzscheme/src/lightning/i386/fp.h b/src/mzscheme/src/lightning/i386/fp.h index 204eb11b10..d9f54757ff 100644 --- a/src/mzscheme/src/lightning/i386/fp.h +++ b/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)) diff --git a/src/mzscheme/src/module.c b/src/mzscheme/src/module.c index bf4da9a0b4..3205df0239 100644 --- a/src/mzscheme/src/module.c +++ b/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)) { - scheme_wrong_type(errname, "symbol, #f, or void", 1, argc, argv); + if (SCHEME_TRUEP(name) + && !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, 1, 0, base_phase, scheme_null); - else - start_module(m, env, 0, modidx, 0, 1, base_phase, scheme_null); + start_module(m, env, 0, modidx, + (SCHEME_VOIDP(name) + ? 1 + : (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; diff --git a/src/mzscheme/src/number.c b/src/mzscheme/src/number.c index 5584477529..904b366c07 100644 --- a/src/mzscheme/src/number.c +++ 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, - "exact->inexact", - 1, 1, 1), - env); + + p = scheme_make_folding_prim(scheme_exact_to_inexact, + "exact->inexact", + 1, 1, 1); + 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",