diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index 12f3ad2a71..61e2738bb2 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -12,7 +12,7 @@ (define collection 'multi) -(define version "7.1.0.5") +(define version "7.1.0.6") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/pkgs/racket-doc/scribblings/reference/eval.scrbl b/pkgs/racket-doc/scribblings/reference/eval.scrbl index 930125ad6c..9561f7876c 100644 --- a/pkgs/racket-doc/scribblings/reference/eval.scrbl +++ b/pkgs/racket-doc/scribblings/reference/eval.scrbl @@ -529,8 +529,8 @@ handler} in tail position with @racket[stx].} @defproc[(compiled-expression-recompile [ce compiled-expression?]) compiled-expression?]{ Recompiles @racket[ce]. If @racket[ce] was compiled as -machine-independent and @racket[compile-machine-independent] is -@racket[#f], then recompiling effectively converts to the current +machine-independent and @racket[current-compile-target-machine] is +not set to @racket[#f], then recompiling effectively converts to the current machine format. Otherwise, recompiling effectively re-runs optimization passes to produce an equivalent compiled form with potentially different performance characteristics. @@ -581,24 +581,42 @@ information to be lost from stack traces (as reported by @racket[continuation-mark-set->context]). The default is @racket[#f], which allows such optimizations.} -@defboolparam[compile-machine-independent on?]{ +@defparam[current-compile-target-machine target (or/c #f (and/c symbol? compile-target-machine?))]{ -A @tech{parameter} that determines whether a newly compiled expression -writes in a machine-independent format (usually in @filepath{.zo} -files). Machine-independent compiled code works for any platform and -any Racket virtual machine. When the machine-independent compiled +A @tech{parameter} that determines the platform and/or virtual machine +target for a newly compiled expression. + +If the target is @racket[#f], the the compiled expression writes in a +machine-independent format (usually in @filepath{.zo} files). +Machine-independent compiled code works for any platform and any +Racket virtual machine. When the machine-independent compiled expression is read back in, it is subject to further compilation for the current platform and virtual machine, which can be considerably slower than reading a format that is fully compiled for a platform and virtual machine. -The default is @racket[#f], unless machine-independent mode is enabled -through the @Flag{M}/@DFlag{compile-any} command-line flag to -stand-alone Racket (or GRacket) or through the -@as-index{@envvar{PLT_COMPILE_ANY}} environment variable (set to any -value). +The default is something other than @racket[#f], unless +machine-independent mode is enabled through the +@Flag{M}/@DFlag{compile-any} command-line flag to stand-alone Racket +(or GRacket) or through the @as-index{@envvar{PLT_COMPILE_ANY}} +environment variable (set to any value). + +@history[#:added "7.1.0.6"]} + + +@defproc[(compile-target-machine? [sym symbol?]) boolean?]{ + +Reports whether @racket[sym] is a supported compilation target for the +currently running Racket. + +When @racket[(system-type 'vm)] reports @racket['racket], then the +only target symbol is @racket['racket]. When @racket[(system-type +'vm)] reports @racket['chez-scheme], then a symbol corresponding to +the current platform is a target, and other targets may also be +supported. + +@history[#:added "7.1.0.6"]} -@history[#:added "7.1.0.5"]} @defboolparam[eval-jit-enabled on?]{ diff --git a/pkgs/racket-doc/scribblings/reference/runtime.scrbl b/pkgs/racket-doc/scribblings/reference/runtime.scrbl index 00e7c25534..899e192e90 100644 --- a/pkgs/racket-doc/scribblings/reference/runtime.scrbl +++ b/pkgs/racket-doc/scribblings/reference/runtime.scrbl @@ -52,7 +52,7 @@ In @indexed-racket['link] mode, the possible symbol results are: @item{@indexed-racket['framework] (Mac OS)} ] -Future ports of Racket may expand the list of @racket['os], +Future ports of Racket may expand the list of @racket['os], @racket['vm], @racket['gc], and @racket['link] results. In @indexed-racket['machine] mode, then the result is a string, which diff --git a/pkgs/racket-doc/scribblings/reference/startup.scrbl b/pkgs/racket-doc/scribblings/reference/startup.scrbl index 07f6ee5789..1f93727275 100644 --- a/pkgs/racket-doc/scribblings/reference/startup.scrbl +++ b/pkgs/racket-doc/scribblings/reference/startup.scrbl @@ -345,8 +345,8 @@ flags: @item{@FlagFirst{M} or @DFlagFirst{compile-any} : Enables machine-independent bytecode by setting the - @racket[compile-machine-independent] parameter to - @racket[#t].} + @racket[current-compile-target-machine] parameter to + @racket[#f].} @item{@FlagFirst{d} or @DFlagFirst{no-delay} : Disables on-demand parsing of compiled code and syntax objects by setting the diff --git a/pkgs/racket-test-core/tests/racket/module.rktl b/pkgs/racket-test-core/tests/racket/module.rktl index feb7dc2ffe..080de3512d 100644 --- a/pkgs/racket-test-core/tests/racket/module.rktl +++ b/pkgs/racket-test-core/tests/racket/module.rktl @@ -2843,7 +2843,7 @@ case of module-leve bindings; it doesn't cover local bindings. ;; machine-dependent recompilation (let () - (define m (parameterize ([compile-machine-independent #t]) + (define m (parameterize ([current-compile-target-machine #f]) (compile ;; The intent of this module is to exercise cross-module ;; inlining when moving from machine-independent to diff --git a/racket/src/cs/linklet.sls b/racket/src/cs/linklet.sls index f36557a90f..fc0aa48916 100644 --- a/racket/src/cs/linklet.sls +++ b/racket/src/cs/linklet.sls @@ -31,7 +31,8 @@ compile-enforce-module-constants compile-context-preservation-enabled compile-allow-set!-undefined - compile-machine-independent + current-compile-target-machine + compile-target-machine? eval-jit-enabled load-on-demand-enabled @@ -821,8 +822,20 @@ (define compile-allow-set!-undefined (make-parameter #f (lambda (v) (and v #t)))) - (define compile-machine-independent - (make-parameter #f (lambda (v) (and v #t)))) + (define current-compile-target-machine + (make-parameter (machine-type) (lambda (v) + (unless (or (not v) + (and (symbol? v) + (compile-target-machine? v))) + (raise-argument-error 'current-compile-target-machine + "(or/c #f (and/c symbol? compile-target-machine?))" + v)) + v))) + + (define (compile-target-machine? v) + (unless (symbol? v) + (raise-argument-error 'compile-target-machine? "symbol?" v)) + (eq? v (machine-type))) (define eval-jit-enabled (make-parameter #t (lambda (v) (and v #t)))) diff --git a/racket/src/cs/main.sps b/racket/src/cs/main.sps index dd92be9284..7de8bc6e96 100644 --- a/racket/src/cs/main.sps +++ b/racket/src/cs/main.sps @@ -41,7 +41,7 @@ platform-independent-zo-mode? linklet-performance-init! linklet-performance-report! - compile-machine-independent)) + current-compile-target-machine)) (linklet-performance-init!) (unless omit-debugging? @@ -570,7 +570,7 @@ (|#%app| use-user-specific-search-paths user-specific-search-paths?) (|#%app| load-on-demand-enabled load-on-demand?) (when compile-machine-independent? - (|#%app| compile-machine-independent #t)) + (|#%app| current-compile-target-machine #f)) (boot) (when (and stderr-logging (not (null? stderr-logging))) diff --git a/racket/src/cs/primitive/kernel.ss b/racket/src/cs/primitive/kernel.ss index 5c27dbfde3..465c4d3d46 100644 --- a/racket/src/cs/primitive/kernel.ss +++ b/racket/src/cs/primitive/kernel.ss @@ -184,7 +184,7 @@ [compile-allow-set!-undefined (known-constant)] [compile-context-preservation-enabled (known-constant)] [compile-enforce-module-constants (known-constant)] - [compile-machine-independent (known-constant)] + [compile-target-machine? (known-procedure 2)] [complete-path? (known-procedure 2)] [complex? (known-procedure/succeeds 2)] [cons (known-procedure/succeeds 4)] @@ -202,6 +202,7 @@ [cos (known-procedure 2)] [current-code-inspector (known-constant)] [current-command-line-arguments (known-constant)] + [current-compile-target-machine (known-constant)] [current-continuation-marks (known-procedure 3)] [current-custodian (known-constant)] [current-directory (known-constant)] diff --git a/racket/src/expander/compile/recompile.rkt b/racket/src/expander/compile/recompile.rkt index c6fcd90392..08e05f7015 100644 --- a/racket/src/expander/compile/recompile.rkt +++ b/racket/src/expander/compile/recompile.rkt @@ -21,7 +21,7 @@ (unless (compiled-expression? c) (raise-argument-error 'compiled-expression-recompile "compiled-expression?" c)) (cond - [(compile-machine-independent) + [(not (current-compile-target-machine)) ;; There's no use for machine-independent mode, and ;; `recompile-bundle` assumes that it should actually compile c] diff --git a/racket/src/expander/eval/main.rkt b/racket/src/expander/eval/main.rkt index 2bb841df94..33218595ba 100644 --- a/racket/src/expander/eval/main.rkt +++ b/racket/src/expander/eval/main.rkt @@ -73,7 +73,7 @@ ;; exported for use by an embedding runtime system.] (define (compile s [ns (current-namespace)] [serializable? #t] [expand expand]) (define to-correlated-linklet? (and serializable? - (compile-machine-independent))) + (not (current-compile-target-machine)))) ;; The given `s` might be an already-compiled expression because it ;; went through some strange path, such as a `load` on a bytecode ;; file, which would wrap `#%top-interaction` around the compiled diff --git a/racket/src/racket/include/scheme.h b/racket/src/racket/include/scheme.h index a368ea7dd4..e6f9eb6153 100644 --- a/racket/src/racket/include/scheme.h +++ b/racket/src/racket/include/scheme.h @@ -1357,7 +1357,7 @@ enum { MZCONFIG_COMPILE_MODULE_CONSTS, MZCONFIG_USE_JIT, MZCONFIG_DISALLOW_INLINE, - MZCONFIG_COMPILE_MACHINE_INDEPENDENT, + MZCONFIG_COMPILE_TARGET_MACHINE, MZCONFIG_CUSTODIAN, MZCONFIG_INSPECTOR, diff --git a/racket/src/racket/src/eval.c b/racket/src/racket/src/eval.c index 6faa0159b8..2165d5e1d5 100644 --- a/racket/src/racket/src/eval.c +++ b/racket/src/racket/src/eval.c @@ -217,7 +217,8 @@ static Scheme_Object *allow_set_undefined(int argc, Scheme_Object **argv); static Scheme_Object *compile_module_constants(int argc, Scheme_Object **argv); static Scheme_Object *use_jit(int argc, Scheme_Object **argv); static Scheme_Object *disallow_inline(int argc, Scheme_Object **argv); -static Scheme_Object *compile_machine_independent(int argc, Scheme_Object **argv); +static Scheme_Object *compile_target_machine(int argc, Scheme_Object **argv); +static Scheme_Object *compile_is_target_machine(int argc, Scheme_Object **argv); void scheme_escape_to_continuation(Scheme_Object *obj, int num_rands, Scheme_Object **rands, Scheme_Object *alt_full); @@ -267,7 +268,9 @@ scheme_init_eval (Scheme_Startup_Env *env) ADD_PARAMETER("compile-enforce-module-constants", compile_module_constants, MZCONFIG_COMPILE_MODULE_CONSTS, env); ADD_PARAMETER("eval-jit-enabled", use_jit, MZCONFIG_USE_JIT, env); ADD_PARAMETER("compile-context-preservation-enabled", disallow_inline, MZCONFIG_DISALLOW_INLINE, env); - ADD_PARAMETER("compile-machine-independent", compile_machine_independent, MZCONFIG_COMPILE_MACHINE_INDEPENDENT, env); + ADD_PARAMETER("current-compile-target-machine", compile_target_machine, MZCONFIG_COMPILE_TARGET_MACHINE, env); + + ADD_PRIM_W_ARITY("compile-target-machine?", compile_is_target_machine, 1, 1, env); } void scheme_init_eval_places() @@ -3911,12 +3914,20 @@ static Scheme_Object *disallow_inline(int argc, Scheme_Object **argv) -1, NULL, NULL, 1); } -static Scheme_Object *compile_machine_independent(int argc, Scheme_Object **argv) +static Scheme_Object *compile_target_machine(int argc, Scheme_Object **argv) { - return scheme_param_config("compile-machine-independent", - scheme_make_integer(MZCONFIG_COMPILE_MACHINE_INDEPENDENT), - argc, argv, - -1, NULL, NULL, 1); + return scheme_param_config2("current-compile-target-machine", + scheme_make_integer(MZCONFIG_COMPILE_TARGET_MACHINE), + argc, argv, + -1, scheme_compile_target_check, + "(or/c #f (and/c symbol? compile-target-machine?))", 0); +} + +static Scheme_Object *compile_is_target_machine(int argc, Scheme_Object **argv) +{ + if (!SCHEME_SYMBOLP(argv[0])) + scheme_wrong_contract("compile-target-machine?", "symbol?", 0, argc, argv); + return scheme_compile_target_check(argc, argv); } static Scheme_Object * diff --git a/racket/src/racket/src/schminc.h b/racket/src/racket/src/schminc.h index 4f2cdd7b5a..fca5fb2a43 100644 --- a/racket/src/racket/src/schminc.h +++ b/racket/src/racket/src/schminc.h @@ -14,7 +14,7 @@ #define USE_COMPILED_STARTUP 1 -#define EXPECTED_PRIM_COUNT 1447 +#define EXPECTED_PRIM_COUNT 1448 #ifdef MZSCHEME_SOMETHING_OMITTED # undef USE_COMPILED_STARTUP diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index aaf5c8e10f..f3bd830c87 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -4025,4 +4025,6 @@ HANDLE scheme_dll_load_library(const char *s, const wchar_t *ws, int *_mode); void *scheme_dll_get_proc_address(HANDLE m, const char *name, int dll_mode); #endif +Scheme_Object *scheme_compile_target_check(int argc, Scheme_Object **argv); + #endif /* __mzscheme_private__ */ diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index 57e34299f6..ff4f7bbc14 100644 --- a/racket/src/racket/src/schvers.h +++ b/racket/src/racket/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "7.1.0.5" +#define MZSCHEME_VERSION "7.1.0.6" #define MZSCHEME_VERSION_X 7 #define MZSCHEME_VERSION_Y 1 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 5 +#define MZSCHEME_VERSION_W 6 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) diff --git a/racket/src/racket/src/startup.inc b/racket/src/racket/src/startup.inc index 71d71b857a..7106460727 100644 --- a/racket/src/racket/src/startup.inc +++ b/racket/src/racket/src/startup.inc @@ -39940,7 +39940,7 @@ static const char *startup_source = "(if(1/compiled-expression? c_0)" "(void)" " (let-values () (raise-argument-error 'compiled-expression-recompile \"compiled-expression?\" c_0)))" -"(if(compile-machine-independent)" +"(if(not(current-compile-target-machine))" "(let-values() c_0)" "(if(let-values(((or-part_0)(linklet-bundle? c_0)))(if or-part_0 or-part_0(linklet-directory? c_0)))" "(let-values()" @@ -48414,7 +48414,7 @@ static const char *startup_source = "(let-values(((expand_0)(if(eq? expand13_0 unsafe-undefined) expand$1 expand13_0)))" "(let-values()" "(let-values(((to-correlated-linklet?_0)" -"(if serializable?_0(compile-machine-independent) #f)))" +"(if serializable?_0(not(current-compile-target-machine)) #f)))" "(let-values(((cs_0)" "(if(1/compiled-expression? s_0)" "(let-values()(list s_0))" diff --git a/racket/src/racket/src/thread.c b/racket/src/racket/src/thread.c index 92ecfecb53..5b00664a7a 100644 --- a/racket/src/racket/src/thread.c +++ b/racket/src/racket/src/thread.c @@ -199,6 +199,7 @@ ROSYM static Scheme_Object *read_symbol, *write_symbol, *execute_symbol, *delete ROSYM static Scheme_Object *client_symbol, *server_symbol; ROSYM static Scheme_Object *major_symbol, *minor_symbol, *incremental_symbol; ROSYM static Scheme_Object *cumulative_symbol; +ROSYM static Scheme_Object *racket_symbol; THREAD_LOCAL_DECL(static int do_atomic = 0); THREAD_LOCAL_DECL(static int missed_context_switch = 0); @@ -530,6 +531,9 @@ void scheme_init_thread(Scheme_Startup_Env *env) REGISTER_SO(cumulative_symbol); cumulative_symbol = scheme_intern_symbol("cumulative"); + REGISTER_SO(racket_symbol); + racket_symbol = scheme_intern_symbol("racket"); + ADD_PRIM_W_ARITY("dump-memory-stats" , scheme_dump_gc_stats, 0, -1, env); ADD_PRIM_W_ARITY("vector-set-performance-stats!", current_stats , 1, 2, env); @@ -7972,7 +7976,7 @@ static void make_initial_config(Scheme_Thread *p) init_param(cells, paramz, MZCONFIG_COMPILE_MODULE_CONSTS, scheme_true); init_param(cells, paramz, MZCONFIG_USE_JIT, scheme_startup_use_jit ? scheme_true : scheme_false); - init_param(cells, paramz, MZCONFIG_COMPILE_MACHINE_INDEPENDENT, scheme_startup_compile_machine_independent ? scheme_true : scheme_false); + init_param(cells, paramz, MZCONFIG_COMPILE_TARGET_MACHINE, scheme_startup_compile_machine_independent ? scheme_false : racket_symbol); { Scheme_Object *s; @@ -8126,6 +8130,14 @@ Scheme_Config *scheme_minimal_config(void) return initial_config; } +Scheme_Object *scheme_compile_target_check(int argc, Scheme_Object **argv) +{ + if (SCHEME_FALSEP(argv[0]) || SAME_OBJ(argv[0], racket_symbol)) + return scheme_true; + else + return scheme_false; +} + void scheme_set_startup_load_on_demand(int on) { scheme_init_load_on_demand = on;