revise compile-target parameter

Replace `compile-machine-independent` with
`current-compile-target-machine` to set up
better for future cross-compilation support.
This commit is contained in:
Matthew Flatt 2018-11-22 17:36:31 -07:00
parent c5f000c4fc
commit 19e709d27b
17 changed files with 97 additions and 40 deletions

View File

@ -12,7 +12,7 @@
(define collection 'multi) (define collection 'multi)
(define version "7.1.0.5") (define version "7.1.0.6")
(define deps `("racket-lib" (define deps `("racket-lib"
["racket" #:version ,version])) ["racket" #:version ,version]))

View File

@ -529,8 +529,8 @@ handler} in tail position with @racket[stx].}
@defproc[(compiled-expression-recompile [ce compiled-expression?]) compiled-expression?]{ @defproc[(compiled-expression-recompile [ce compiled-expression?]) compiled-expression?]{
Recompiles @racket[ce]. If @racket[ce] was compiled as Recompiles @racket[ce]. If @racket[ce] was compiled as
machine-independent and @racket[compile-machine-independent] is machine-independent and @racket[current-compile-target-machine] is
@racket[#f], then recompiling effectively converts to the current not set to @racket[#f], then recompiling effectively converts to the current
machine format. Otherwise, recompiling effectively re-runs machine format. Otherwise, recompiling effectively re-runs
optimization passes to produce an equivalent compiled form with optimization passes to produce an equivalent compiled form with
potentially different performance characteristics. 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], @racket[continuation-mark-set->context]). The default is @racket[#f],
which allows such optimizations.} 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 A @tech{parameter} that determines the platform and/or virtual machine
writes in a machine-independent format (usually in @filepath{.zo} target for a newly compiled expression.
files). Machine-independent compiled code works for any platform and
any Racket virtual machine. When the machine-independent compiled 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 expression is read back in, it is subject to further compilation for
the current platform and virtual machine, which can be considerably the current platform and virtual machine, which can be considerably
slower than reading a format that is fully compiled for a platform and slower than reading a format that is fully compiled for a platform and
virtual machine. virtual machine.
The default is @racket[#f], unless machine-independent mode is enabled The default is something other than @racket[#f], unless
through the @Flag{M}/@DFlag{compile-any} command-line flag to machine-independent mode is enabled through the
stand-alone Racket (or GRacket) or through the @Flag{M}/@DFlag{compile-any} command-line flag to stand-alone Racket
@as-index{@envvar{PLT_COMPILE_ANY}} environment variable (set to any (or GRacket) or through the @as-index{@envvar{PLT_COMPILE_ANY}}
value). 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?]{ @defboolparam[eval-jit-enabled on?]{

View File

@ -52,7 +52,7 @@ In @indexed-racket['link] mode, the possible symbol results are:
@item{@indexed-racket['framework] (Mac OS)} @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. @racket['gc], and @racket['link] results.
In @indexed-racket['machine] mode, then the result is a string, which In @indexed-racket['machine] mode, then the result is a string, which

View File

@ -345,8 +345,8 @@ flags:
@item{@FlagFirst{M} or @DFlagFirst{compile-any} : Enables @item{@FlagFirst{M} or @DFlagFirst{compile-any} : Enables
machine-independent bytecode by setting the machine-independent bytecode by setting the
@racket[compile-machine-independent] parameter to @racket[current-compile-target-machine] parameter to
@racket[#t].} @racket[#f].}
@item{@FlagFirst{d} or @DFlagFirst{no-delay} : Disables on-demand @item{@FlagFirst{d} or @DFlagFirst{no-delay} : Disables on-demand
parsing of compiled code and syntax objects by setting the parsing of compiled code and syntax objects by setting the

View File

@ -2843,7 +2843,7 @@ case of module-leve bindings; it doesn't cover local bindings.
;; machine-dependent recompilation ;; machine-dependent recompilation
(let () (let ()
(define m (parameterize ([compile-machine-independent #t]) (define m (parameterize ([current-compile-target-machine #f])
(compile (compile
;; The intent of this module is to exercise cross-module ;; The intent of this module is to exercise cross-module
;; inlining when moving from machine-independent to ;; inlining when moving from machine-independent to

View File

@ -31,7 +31,8 @@
compile-enforce-module-constants compile-enforce-module-constants
compile-context-preservation-enabled compile-context-preservation-enabled
compile-allow-set!-undefined compile-allow-set!-undefined
compile-machine-independent current-compile-target-machine
compile-target-machine?
eval-jit-enabled eval-jit-enabled
load-on-demand-enabled load-on-demand-enabled
@ -821,8 +822,20 @@
(define compile-allow-set!-undefined (define compile-allow-set!-undefined
(make-parameter #f (lambda (v) (and v #t)))) (make-parameter #f (lambda (v) (and v #t))))
(define compile-machine-independent (define current-compile-target-machine
(make-parameter #f (lambda (v) (and v #t)))) (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 (define eval-jit-enabled
(make-parameter #t (lambda (v) (and v #t)))) (make-parameter #t (lambda (v) (and v #t))))

View File

@ -41,7 +41,7 @@
platform-independent-zo-mode? platform-independent-zo-mode?
linklet-performance-init! linklet-performance-init!
linklet-performance-report! linklet-performance-report!
compile-machine-independent)) current-compile-target-machine))
(linklet-performance-init!) (linklet-performance-init!)
(unless omit-debugging? (unless omit-debugging?
@ -570,7 +570,7 @@
(|#%app| use-user-specific-search-paths user-specific-search-paths?) (|#%app| use-user-specific-search-paths user-specific-search-paths?)
(|#%app| load-on-demand-enabled load-on-demand?) (|#%app| load-on-demand-enabled load-on-demand?)
(when compile-machine-independent? (when compile-machine-independent?
(|#%app| compile-machine-independent #t)) (|#%app| current-compile-target-machine #f))
(boot) (boot)
(when (and stderr-logging (when (and stderr-logging
(not (null? stderr-logging))) (not (null? stderr-logging)))

View File

@ -184,7 +184,7 @@
[compile-allow-set!-undefined (known-constant)] [compile-allow-set!-undefined (known-constant)]
[compile-context-preservation-enabled (known-constant)] [compile-context-preservation-enabled (known-constant)]
[compile-enforce-module-constants (known-constant)] [compile-enforce-module-constants (known-constant)]
[compile-machine-independent (known-constant)] [compile-target-machine? (known-procedure 2)]
[complete-path? (known-procedure 2)] [complete-path? (known-procedure 2)]
[complex? (known-procedure/succeeds 2)] [complex? (known-procedure/succeeds 2)]
[cons (known-procedure/succeeds 4)] [cons (known-procedure/succeeds 4)]
@ -202,6 +202,7 @@
[cos (known-procedure 2)] [cos (known-procedure 2)]
[current-code-inspector (known-constant)] [current-code-inspector (known-constant)]
[current-command-line-arguments (known-constant)] [current-command-line-arguments (known-constant)]
[current-compile-target-machine (known-constant)]
[current-continuation-marks (known-procedure 3)] [current-continuation-marks (known-procedure 3)]
[current-custodian (known-constant)] [current-custodian (known-constant)]
[current-directory (known-constant)] [current-directory (known-constant)]

View File

@ -21,7 +21,7 @@
(unless (compiled-expression? c) (unless (compiled-expression? c)
(raise-argument-error 'compiled-expression-recompile "compiled-expression?" c)) (raise-argument-error 'compiled-expression-recompile "compiled-expression?" c))
(cond (cond
[(compile-machine-independent) [(not (current-compile-target-machine))
;; There's no use for machine-independent mode, and ;; There's no use for machine-independent mode, and
;; `recompile-bundle` assumes that it should actually compile ;; `recompile-bundle` assumes that it should actually compile
c] c]

View File

@ -73,7 +73,7 @@
;; exported for use by an embedding runtime system.] ;; exported for use by an embedding runtime system.]
(define (compile s [ns (current-namespace)] [serializable? #t] [expand expand]) (define (compile s [ns (current-namespace)] [serializable? #t] [expand expand])
(define to-correlated-linklet? (and serializable? (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 ;; The given `s` might be an already-compiled expression because it
;; went through some strange path, such as a `load` on a bytecode ;; went through some strange path, such as a `load` on a bytecode
;; file, which would wrap `#%top-interaction` around the compiled ;; file, which would wrap `#%top-interaction` around the compiled

View File

@ -1357,7 +1357,7 @@ enum {
MZCONFIG_COMPILE_MODULE_CONSTS, MZCONFIG_COMPILE_MODULE_CONSTS,
MZCONFIG_USE_JIT, MZCONFIG_USE_JIT,
MZCONFIG_DISALLOW_INLINE, MZCONFIG_DISALLOW_INLINE,
MZCONFIG_COMPILE_MACHINE_INDEPENDENT, MZCONFIG_COMPILE_TARGET_MACHINE,
MZCONFIG_CUSTODIAN, MZCONFIG_CUSTODIAN,
MZCONFIG_INSPECTOR, MZCONFIG_INSPECTOR,

View File

@ -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 *compile_module_constants(int argc, Scheme_Object **argv);
static Scheme_Object *use_jit(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 *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); 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("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("eval-jit-enabled", use_jit, MZCONFIG_USE_JIT, env);
ADD_PARAMETER("compile-context-preservation-enabled", disallow_inline, MZCONFIG_DISALLOW_INLINE, 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() void scheme_init_eval_places()
@ -3911,12 +3914,20 @@ static Scheme_Object *disallow_inline(int argc, Scheme_Object **argv)
-1, NULL, NULL, 1); -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", return scheme_param_config2("current-compile-target-machine",
scheme_make_integer(MZCONFIG_COMPILE_MACHINE_INDEPENDENT), scheme_make_integer(MZCONFIG_COMPILE_TARGET_MACHINE),
argc, argv, argc, argv,
-1, NULL, NULL, 1); -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 * static Scheme_Object *

View File

@ -14,7 +14,7 @@
#define USE_COMPILED_STARTUP 1 #define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 1447 #define EXPECTED_PRIM_COUNT 1448
#ifdef MZSCHEME_SOMETHING_OMITTED #ifdef MZSCHEME_SOMETHING_OMITTED
# undef USE_COMPILED_STARTUP # undef USE_COMPILED_STARTUP

View File

@ -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); void *scheme_dll_get_proc_address(HANDLE m, const char *name, int dll_mode);
#endif #endif
Scheme_Object *scheme_compile_target_check(int argc, Scheme_Object **argv);
#endif /* __mzscheme_private__ */ #endif /* __mzscheme_private__ */

View File

@ -13,12 +13,12 @@
consistently.) consistently.)
*/ */
#define MZSCHEME_VERSION "7.1.0.5" #define MZSCHEME_VERSION "7.1.0.6"
#define MZSCHEME_VERSION_X 7 #define MZSCHEME_VERSION_X 7
#define MZSCHEME_VERSION_Y 1 #define MZSCHEME_VERSION_Y 1
#define MZSCHEME_VERSION_Z 0 #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_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

View File

@ -39940,7 +39940,7 @@ static const char *startup_source =
"(if(1/compiled-expression? c_0)" "(if(1/compiled-expression? c_0)"
"(void)" "(void)"
" (let-values () (raise-argument-error 'compiled-expression-recompile \"compiled-expression?\" c_0)))" " (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)" "(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)))" "(if(let-values(((or-part_0)(linklet-bundle? c_0)))(if or-part_0 or-part_0(linklet-directory? c_0)))"
"(let-values()" "(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(((expand_0)(if(eq? expand13_0 unsafe-undefined) expand$1 expand13_0)))"
"(let-values()" "(let-values()"
"(let-values(((to-correlated-linklet?_0)" "(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)" "(let-values(((cs_0)"
"(if(1/compiled-expression? s_0)" "(if(1/compiled-expression? s_0)"
"(let-values()(list s_0))" "(let-values()(list s_0))"

View File

@ -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 *client_symbol, *server_symbol;
ROSYM static Scheme_Object *major_symbol, *minor_symbol, *incremental_symbol; ROSYM static Scheme_Object *major_symbol, *minor_symbol, *incremental_symbol;
ROSYM static Scheme_Object *cumulative_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 do_atomic = 0);
THREAD_LOCAL_DECL(static int missed_context_switch = 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); REGISTER_SO(cumulative_symbol);
cumulative_symbol = scheme_intern_symbol("cumulative"); 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("dump-memory-stats" , scheme_dump_gc_stats, 0, -1, env);
ADD_PRIM_W_ARITY("vector-set-performance-stats!", current_stats , 1, 2, 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_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_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; Scheme_Object *s;
@ -8126,6 +8130,14 @@ Scheme_Config *scheme_minimal_config(void)
return initial_config; 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) void scheme_set_startup_load_on_demand(int on)
{ {
scheme_init_load_on_demand = on; scheme_init_load_on_demand = on;