diff --git a/Makefile b/Makefile index 2f9b3ba4c3..00ff7ded9a 100644 --- a/Makefile +++ b/Makefile @@ -335,7 +335,7 @@ REMOTE_USER_AUTO = --catalog $(SVR_CAT) $(USER_AUTO_OPTIONS) REMOTE_INST_AUTO = --catalog $(SVR_CAT) --scope installation $(X_AUTO_OPTIONS) CONFIG_MODE_q = "$(CONFIG)" "$(CONFIG_MODE)" BUNDLE_CONFIG = bundle/racket/etc/config.rktd -BUNDLE_RACO_FLAGS = -G bundle/racket/etc -X bundle/racket/collects -A bundle/user -l raco +BUNDLE_RACO_FLAGS = -C -G bundle/racket/etc -X bundle/racket/collects -A bundle/user -l raco BUNDLE_RACO = $(PLAIN_RACKET) $(BUNDLE_RACO_FLAGS) WIN32_BUNDLE_RACO = $(WIN32_PLAIN_RACKET) $(BUNDLE_RACO_FLAGS) diff --git a/pkgs/racket-doc/scribblings/raco/setup.scrbl b/pkgs/racket-doc/scribblings/raco/setup.scrbl index bf82ade9db..f4166708d3 100644 --- a/pkgs/racket-doc/scribblings/raco/setup.scrbl +++ b/pkgs/racket-doc/scribblings/raco/setup.scrbl @@ -1237,6 +1237,13 @@ function for installing a single @filepath{.plt} file. Many of these paths can be configured through the @tech{configuration directory} (see @secref["config-file"]).} +In cross-platform build mode (see @secref["cross-system"]), the +functions provided by @racketmodname[setup/dirs] generally report +target-system paths, instead of current-system paths. The exceptions are +@racket[get-lib-search-dirs] and @racket[find-dll-dir], which report +current-system paths while @racket[get-cross-lib-search-dirs] and +@racket[find-cross-dll-dir] report target-system paths. + @(define-syntax-rule (see-config id) @elem{See also @racket['id] in @secref["config-file"].}) @@ -1347,26 +1354,55 @@ function for installing a single @filepath{.plt} file. indicated by the returned path may or may not exist.} @defproc[(get-lib-search-dirs) (listof path?)]{ - Returns a list of paths to search for foreign libraries. Unless it is - configured otherwise, the result includes any non-@racket[#f] result of - @racket[(find-lib-dir)] - and @racket[(find-user-lib-dir)]---but the latter is included only if the - value of the @racket[use-user-specific-search-paths] parameter - is @racket[#t]. + Returns a list of paths to search for foreign libraries. + + Unless it is configured otherwise, and except in cross-platform + build mode, the result includes any non-@racket[#f] result of + @racket[(find-lib-dir)] and @racket[(find-user-lib-dir)]---but the + latter is included only if the value of the + @racket[use-user-specific-search-paths] parameter is @racket[#t]. + + In cross-platform build mode (see @secref["cross-system"]), + @racket[get-lib-search-dirs] reports a result suitable for the + current system, instead of the target system. See also + @racket[get-cross-lib-search-dirs]. @see-config[lib-search-dirs] @history[#:changed "6.1.1.4" @elem{Dropped @racket[(find-dll-dir)] from the set of paths to explicitly include in the - default.}]} + default.} + #:changed "6.9.0.1" @elem{Changed behavior in cross-platform build mode.}]} + +@defproc[(get-cross-lib-search-dirs) (listof path?)]{ + Like @racket[get-lib-search-dirs], but in cross-platform build mode, + reports directories for the target system (including any + non-@racket[#f] result of @racket[(find-lib-dir)], etc.) + instead of the current system. + + @history[#:added "6.9.0.1"]} @defproc[(find-dll-dir) (or/c path? #f)]{ Returns a path to the directory that contains DLLs for use with the current executable (e.g., @filepath{libracket.dll} on Windows). The result is @racket[#f] if no such directory is available, or if no specific directory is available (i.e., other than the platform's normal - search path).} + search path). + + In cross-platform build mode (see @secref["cross-system"]), + @racket[find-dll-dir] reports a result suitable for the current + system, instead of the target system. See also + @racket[find-cross-dll-dir]. + + @history[#:changed "6.9.0.1" @elem{Changed behavior in cross-platform build mode.}]} + +@defproc[(find-cross-dll-dir) (or/c path? #f)]{ + Like @racket[find-dll-dir], but in cross-platform build mode, + reports a directory for the target system + instead of the current system. + + @history[#:added "6.9.0.1"]} @defproc[(find-share-dir) (or/c path? #f)]{ Returns a path to the installation's @filepath{share} directory, which contains installed @@ -1958,14 +1994,15 @@ run in cross-installation mode. For example, if an in-place Racket installation for a different platform resides at @nonterm{cross-dir}, then -@commandline{racket -G @nonterm{cross-dir}/etc -X @nonterm{cross-dir}/collects -l- raco pkg} +@commandline{racket -C -G @nonterm{cross-dir}/etc -X @nonterm{cross-dir}/collects -l- raco pkg} runs @exec{raco pkg} using the current platform's @exec{racket} executable, but using the collections and other configuration information of @nonterm{cross-dir}, as well as modifying the packages of @nonterm{cross-dir}. That can work as long as no platform-specific libraries need to run to perform the requested @exec{raco pkg} action -(e.g., when installing built packages). +(e.g., when installing built packages), or as long as the current +platform's installation already includes those libraries. @history[#:added "6.3"] @@ -1978,7 +2015,9 @@ libraries need to run to perform the requested @exec{raco pkg} action Like @racket[system-type], but for the target platform instead of the current platform in cross-installation mode. When not in cross-installation mode, the results are the same as for -@racket[system-type].} +@racket[system-type]. + +See also @racket['cross] mode for @racket[system-type].} @defproc[(cross-system-library-subpath [mode (or/c 'cgc '3m #f) diff --git a/pkgs/racket-doc/scribblings/reference/filesystem.scrbl b/pkgs/racket-doc/scribblings/reference/filesystem.scrbl index 7cbe6f5f1a..29056156e3 100644 --- a/pkgs/racket-doc/scribblings/reference/filesystem.scrbl +++ b/pkgs/racket-doc/scribblings/reference/filesystem.scrbl @@ -106,6 +106,13 @@ by @racket[kind], which must be one of the following: relative path, it is relative to the current executable. The directory might not exist.} + @item{@indexed-racket['host-config-dir] --- like + @racket['config-dir], but when cross-platform build mode has been + selected (through the @Flag{C} or @DFlag{cross} argument to + @exec{racket}; see @secref["mz-cmdline"]), the result refers to a + directory for the current system's installation, instead of for the + target system.} + @item{@indexed-racket['addon-dir] --- a directory for user-specific Racket configuration, packages, and extension. This directory is specified by the @@ -164,6 +171,17 @@ by @racket[kind], which must be one of the following: normally embedded in the Racket executable, but it can be overridden by the @DFlag{collects} or @Flag{X} command-line flag.} + @item{@indexed-racket['host-collects-dir] --- like + @racket['collects-dir], but when cross-platform build mode has been + selected (through the @Flag{C} or @DFlag{cross} argument to + @exec{racket}; see @secref["mz-cmdline"]), the result refers to a + directory for the current system's installation, instead of for the + target system. In cross-platform build mode, collection + files are normally read from the target system's installation, + but some tasks require current-system directories (such as + the one that holds foreign libraries) that are configured relative + to the main library-collection path.} + @item{@indexed-racket['orig-dir] --- the current directory at start-up, which can be useful in converting a relative-path result from @racket[(find-system-path 'exec-file)] or @@ -171,7 +189,9 @@ by @racket[kind], which must be one of the following: ] -@history[#:changed "6.0.0.3" @elem{Added @envvar{PLTUSERHOME}.}]} +@history[#:changed "6.0.0.3" @elem{Added @envvar{PLTUSERHOME}.} + #:changed "6.9.0.1" @elem{Added @racket['host-config-dir] + and @racket['host-collects-dir].}]} @defproc[(path-list-string->path-list [str (or/c string? bytes?)] [default-path-list (listof path?)]) diff --git a/pkgs/racket-doc/scribblings/reference/runtime.scrbl b/pkgs/racket-doc/scribblings/reference/runtime.scrbl index 3ac8b03235..c66d86051b 100644 --- a/pkgs/racket-doc/scribblings/reference/runtime.scrbl +++ b/pkgs/racket-doc/scribblings/reference/runtime.scrbl @@ -5,7 +5,7 @@ @title[#:tag "runtime"]{Environment and Runtime Information} @defproc[(system-type [mode (or/c 'os 'word 'vm 'gc 'link 'machine - 'so-suffix 'so-mode 'fs-change) + 'so-suffix 'so-mode 'fs-change 'cross) 'os]) (or/c symbol? string? bytes? exact-positive-integer? vector?)]{ @@ -90,7 +90,22 @@ are: file's directory; this property is @racket[#f] on Windows} ] -@history[#:changed "6.8.0.2" @elem{Added @racket['vm] mode.}]} +In @indexed-racket['cross] mode, the result reports whether +cross-platform build mode has been selected (through the @Flag{C} or +@DFlag{cross} argument to @exec{racket}; see @secref["mz-cmdline"]). +The possible symbols are: + +@itemize[ +@item{@indexed-racket['infer] --- infer cross-platform mode based on + whether @racket[(system-type)] and @racket[(cross-system-type)] report + the same symbol} +@item{@indexed-racket['force] --- use cross-platform mode, even if the + current and target system types are the same, because the current and target + executables can be different} +] + +@history[#:changed "6.8.0.2" @elem{Added @racket['vm] mode.} + #:changed "6.9.0.1" @elem{Added @racket['cross] mode.}]} @defproc[(system-language+country) string?]{ diff --git a/pkgs/racket-doc/scribblings/reference/startup.scrbl b/pkgs/racket-doc/scribblings/reference/startup.scrbl index bcc18ce0c8..1b07c97c55 100644 --- a/pkgs/racket-doc/scribblings/reference/startup.scrbl +++ b/pkgs/racket-doc/scribblings/reference/startup.scrbl @@ -282,13 +282,6 @@ flags: the @Flag{S}/@DFlag{dir} flag is supplied multiple times, the search order is as supplied.} - @item{@FlagFirst{R} @nonterm{paths} or @DFlagFirst{compiled} - @nonterm{paths} : Sets the initial value of the - @racket[current-compiled-file-roots] parameter, overriding - any @envvar{PLTCOMPILEDROOTS} setting. The @nonterm{paths} - argument is parsed in the same way as @envvar{PLTCOMPILEDROOTS} - (see @racket[current-compiled-file-roots]).} - @item{@FlagFirst{G} @nonterm{dir} or @DFlagFirst{config} @nonterm{dir} : Sets the directory that is returned by @racket[(find-system-path 'config-dir)].} @@ -303,6 +296,25 @@ flags: @racket[use-user-specific-search-paths] parameter to @racket[#f].} + @item{@FlagFirst{A} @nonterm{dir} or @DFlagFirst{addon} + @nonterm{dir} : Sets the directory that is returned by + @racket[(find-system-path 'addon-dir)].} + + @item{@FlagFirst{R} @nonterm{paths} or @DFlagFirst{compiled} + @nonterm{paths} : Sets the initial value of the + @racket[current-compiled-file-roots] parameter, overriding + any @envvar{PLTCOMPILEDROOTS} setting. The @nonterm{paths} + argument is parsed in the same way as @envvar{PLTCOMPILEDROOTS} + (see @racket[current-compiled-file-roots]).} + + @item{@FlagFirst{C} or @DFlagFirst{cross} : Select cross-platform + build mode, causing @racket[(system-type 'cross)] to report + @racket['force], and sets the current configuration of + @racket[(find-system-path 'config-dir)] and + @racket[(find-system-path 'collects-dir)] to be the results of + @racket[(find-system-path 'host-config-dir)] and + @racket[(find-system-path 'host-collects-dir)], respectively.} + @item{@FlagFirst{N} @nonterm{file} or @DFlagFirst{name} @nonterm{file} : sets the name of the executable as reported by @racket[(find-system-path 'run-file)] to diff --git a/racket/collects/compiler/distribute.rkt b/racket/collects/compiler/distribute.rkt index 9ef6fb3784..a800f6dc6b 100644 --- a/racket/collects/compiler/distribute.rkt +++ b/racket/collects/compiler/distribute.rkt @@ -165,10 +165,10 @@ (case (cross-system-type) [(windows) (let ([copy-dll (lambda (name) - (copy-file* (search-dll (find-dll-dir) name) + (copy-file* (search-dll (find-cross-dll-dir) name) (build-path lib-dir name)))] [versionize (lambda (template) - (let ([f (search-dll (find-dll-dir) + (let ([f (search-dll (find-cross-dll-dir) (format template filename-version-part))]) (if (file-exists? f) (format template filename-version-part) @@ -266,7 +266,7 @@ (build-path lib-dir sub-dir "Resources"))))))) (define (find-framework fw-name) - (let ([dll-dir (find-dll-dir)]) + (let ([dll-dir (find-cross-dll-dir)]) (or dll-dir (ormap (lambda (p) (let ([f (build-path p fw-name)]) @@ -283,7 +283,7 @@ (define (copy-shared-lib name lib-dir) (unless avail-lib-files - (set! avail-lib-files (directory-list (find-dll-dir)))) + (set! avail-lib-files (directory-list (find-cross-dll-dir)))) (let* ([rx (byte-regexp (string->bytes/latin-1 (format "lib~a-~a.*[.](?:so|dylib)$" name (version))))] [files (filter (lambda (f) @@ -297,7 +297,7 @@ "found multiple shared-library candidates for ~a: ~e" name files)) - (copy-file* (build-path (find-dll-dir) (car files)) + (copy-file* (build-path (find-cross-dll-dir) (car files)) (build-path lib-dir (car files))))) (define (patch-binaries binaries types) @@ -537,7 +537,7 @@ (map normal-case-path (list* (find-system-path 'addon-dir) (find-share-dir) - (append (get-lib-search-dirs) + (append (get-cross-lib-search-dirs) (get-include-search-dirs)))))] [explode (lambda (src) ;; Sort the path into a root, and keep the root plus diff --git a/racket/collects/compiler/embed.rkt b/racket/collects/compiler/embed.rkt index 64822447f0..283d0fbdfd 100644 --- a/racket/collects/compiler/embed.rkt +++ b/racket/collects/compiler/embed.rkt @@ -1508,7 +1508,7 @@ (if (cdr m) (update-dll-dir dest (cdr m)) ;; adjust relative path, since exe directory can change: - (update-dll-dir dest (find-relative-path* dest (find-dll-dir)))) + (update-dll-dir dest (find-relative-path* dest (find-cross-dll-dir)))) ;; Check whether we need an absolute path to DLLs: (let ([dir (get-current-dll-dir dest)]) (when (relative-path? dir) @@ -1599,7 +1599,7 @@ (list (if relative? (relativize exe dest-exe values) exe) - (let ([dir (find-dll-dir)]) + (let ([dir (find-cross-dll-dir)]) (if dir (if relative? (relativize dir dest-exe values) diff --git a/racket/collects/setup/cross-system.rkt b/racket/collects/setup/cross-system.rkt index 0da414457e..b4c48ab517 100644 --- a/racket/collects/setup/cross-system.rkt +++ b/racket/collects/setup/cross-system.rkt @@ -76,4 +76,5 @@ (define (cross-installation?) (compute-cross!) - (positive? (hash-count cross-system-table))) + (or (eq? (system-type 'cross) 'force) + (positive? (hash-count cross-system-table)))) diff --git a/racket/collects/setup/dirs.rkt b/racket/collects/setup/dirs.rkt index db63babcf4..dd1e5c33b2 100644 --- a/racket/collects/setup/dirs.rkt +++ b/racket/collects/setup/dirs.rkt @@ -1,5 +1,6 @@ #lang racket/base (require racket/promise + racket/private/config compiler/private/winutf16 compiler/private/mach-o setup/cross-system @@ -10,8 +11,12 @@ config:bin-dir config:config-tethered-console-bin-dir config:config-tethered-gui-bin-dir - define-finder) - find-dll-dir) + define-finder + get-config-table + to-path) + find-cross-dll-dir + find-dll-dir + get-lib-search-dirs) ;; ---------------------------------------- ;; Executables @@ -78,12 +83,12 @@ ;; ---------------------------------------- ;; DLLs -(provide find-dll-dir) -(define dll-dir +(define (get-dll-dir get-system-type force-cross?) (delay/sync - (case (cross-system-type) + (case (get-system-type) [(windows) - (if (eq? (system-type) 'windows) + (if (and (eq? (system-type) 'windows) + (not force-cross?)) ;; Extract "lib" location from binary: (let ([exe (parameterize ([current-directory (find-system-path 'orig-dir)]) (find-executable-path (find-system-path 'exec-file)))]) @@ -108,7 +113,8 @@ ;; Cross-compile: assume it's "lib" (find-lib-dir))] [(macosx) - (if (eq? (system-type) 'macosx) + (if (and (eq? (system-type) 'macosx) + (not force-cross?)) (let* ([exe (parameterize ([current-directory (find-system-path 'orig-dir)]) (let loop ([p (find-executable-path (find-system-path 'exec-file))]) @@ -152,6 +158,38 @@ (if (eq? 'shared (cross-system-type 'link)) (or (force config:dll-dir) (find-lib-dir)) #f)]))) -(define (find-dll-dir) - (force dll-dir)) +(define cross-dll-dir + (get-dll-dir cross-system-type + (eq? (system-type 'cross) 'force))) +(define host-dll-dir + (get-dll-dir system-type + #f)) + +(define (find-cross-dll-dir) + (force cross-dll-dir)) + +(define (find-dll-dir) + (force host-dll-dir)) + +;; ---------------------------------------- + +(define (get-lib-search-dirs) + (cond + [(and (eq? (cross-system-type) (system-type)) + (eq? (system-type 'cross) 'infer)) + (get-cross-lib-search-dirs)] + [else + (force host-lib-search-dirs)])) + +(define host-config + (get-config-table + (lambda () (exe-relative-path->complete-path (find-system-path 'host-config-dir))))) + +(define host-lib-search-dirs + (delay/sync + (or (to-path (hash-ref (force host-config) 'lib-search-dirs #f)) + (list (build-path + (exe-relative-path->complete-path (find-system-path 'host-collects-dir)) + 'up + "lib"))))) diff --git a/racket/collects/setup/private/dirs.rkt b/racket/collects/setup/private/dirs.rkt index f0429303b4..74f15bcd6e 100644 --- a/racket/collects/setup/private/dirs.rkt +++ b/racket/collects/setup/private/dirs.rkt @@ -14,7 +14,10 @@ ;; ---------------------------------------- ;; config: definitions -(define config-table +(provide get-config-table + to-path) + +(define (get-config-table find-config-dir) (delay/sync (let ([d (find-config-dir)]) (if d @@ -29,6 +32,9 @@ #hash())) #hash())))) +(define config-table + (get-config-table find-config-dir)) + (define (to-path l) (cond [(string? l) (simplify-path (complete-path (string->path l)))] [(bytes? l) (simplify-path (complete-path (bytes->path l)))] @@ -237,7 +243,7 @@ find-lib-dir find-user-lib-dir config:lib-search-dirs - get-lib-search-dirs + get-cross-lib-search-dirs "lib") ;; ---------------------------------------- diff --git a/racket/src/racket/cmdline.inc b/racket/src/racket/cmdline.inc index fbad6aba1d..87c61379f0 100644 --- a/racket/src/racket/cmdline.inc +++ b/racket/src/racket/cmdline.inc @@ -855,6 +855,51 @@ static Scheme_Object *get_arg_log_level(char *prog, char *real_switch, const cha return get_log_level(prog, real_switch, NULL, what, argv[1]); } +static Scheme_Object *adjust_collects_path(Scheme_Object *collects_path, int *_skip_coll_dirs) +{ + /* Setup path for "collects" collection directory: */ + if (!collects_path) { + if (!scheme_coldir[_coldir_offset]) + collects_path = scheme_make_false(); + else + collects_path = scheme_make_path(scheme_coldir XFORM_OK_PLUS _coldir_offset); + } else if (!SAME_OBJ(collects_path, scheme_make_false())) + collects_path = scheme_path_to_complete_path(collects_path, NULL); + + if (SAME_OBJ(collects_path, scheme_make_false())) { + /* empty list of directories => don't set collection dirs + and don't use collection links files */ + if (_skip_coll_dirs) { + *_skip_coll_dirs = 1; + scheme_set_ignore_link_paths(1); + } + collects_path = scheme_make_path("."); + } + + return collects_path; +} + +static Scheme_Object *adjust_config_path(Scheme_Object *config_path) +{ +# ifdef GETENV_FUNCTION + if (!config_path) { + char *s; + s = getenv("PLTCONFIGDIR"); + if (s) { + s = scheme_expand_filename(s, -1, NULL, NULL, 0); + if (s) config_path = scheme_make_path(s); + } + } +# endif + + if (!config_path) + config_path = scheme_make_path(scheme_configdir XFORM_OK_PLUS _configdir_offset); + else + config_path = scheme_path_to_complete_path(config_path, NULL); + + return config_path; +} + #ifdef USE_OSKIT_CONSOLE /* Hack to disable normal input mode: */ int osk_not_console = 0; @@ -894,6 +939,7 @@ static int run_from_cmd_line(int argc, char *_argv[], int skip_coll_dirs = 0; Scheme_Object *collects_path = NULL, *collects_extra = NULL, *addon_dir = NULL; Scheme_Object *config_path = NULL; + Scheme_Object *host_collects_path = NULL, *host_config_path = NULL; char *compiled_paths = NULL; #ifndef NO_FILE_SYSTEM_UTILS Scheme_Object *collects_paths_l, *collects_paths_r; @@ -923,6 +969,7 @@ static int run_from_cmd_line(int argc, char *_argv[], int was_config_flag = 0, saw_nc_flag = 0; int no_compiled = 0; int init_ns = 0, no_init_ns = 0; + int cross_compile = 0; Scheme_Object *syslog_level = NULL, *stderr_level = NULL; FinishArgs *fa; FinishArgsAtoms *fa_a; @@ -1177,6 +1224,8 @@ static int run_from_cmd_line(int argc, char *_argv[], argv[0] = "-A"; else if (!strcmp("--config", argv[0])) argv[0] = "-G"; + else if (!strcmp("--cross", argv[0])) + argv[0] = "-C"; # ifdef CMDLINE_STDIO_FLAG else if (!strcmp("--stdio", argv[0])) argv[0] = "-z"; @@ -1260,6 +1309,13 @@ static int run_from_cmd_line(int argc, char *_argv[], --argc; addon_dir = check_make_path(prog, real_switch, argv[0]); was_config_flag = 1; + break; + case 'C': + cross_compile = 1; + scheme_set_cross_compile_mode(1); + was_config_flag = 1; + host_config_path = config_path; + host_collects_path = collects_path; break; case 'U': scheme_set_ignore_user_paths(1); @@ -1598,41 +1654,24 @@ static int run_from_cmd_line(int argc, char *_argv[], #endif scheme_set_logging_spec(syslog_level, stderr_level); - + #ifndef NO_FILE_SYSTEM_UTILS - /* Setup path for "collects" collection directory: */ - if (!collects_path) { - if (!scheme_coldir[_coldir_offset]) - collects_path = scheme_make_false(); - else - collects_path = scheme_make_path(scheme_coldir XFORM_OK_PLUS _coldir_offset); - } else if (!SAME_OBJ(collects_path, scheme_make_false())) - collects_path = scheme_path_to_complete_path(collects_path, NULL); - if (SAME_OBJ(collects_path, scheme_make_false())) { - /* empty list of directories => don't set collection dirs - and don't use collection links files */ - skip_coll_dirs = 1; - scheme_set_ignore_link_paths(1); - collects_path = scheme_make_path("."); - } + collects_path = adjust_collects_path(collects_path, &skip_coll_dirs); scheme_set_collects_path(collects_path); -# ifdef GETENV_FUNCTION - if (!config_path) { - char *s; - s = getenv("PLTCONFIGDIR"); - if (s) { - s = scheme_expand_filename(s, -1, NULL, NULL, 0); - if (s) config_path = scheme_make_path(s); - } + if (cross_compile) { + host_collects_path = adjust_collects_path(host_collects_path, NULL); + scheme_set_host_collects_path(host_collects_path); } -# endif - if (!config_path) - config_path = scheme_make_path(scheme_configdir XFORM_OK_PLUS _configdir_offset); - else - config_path = scheme_path_to_complete_path(config_path, NULL); + + config_path = adjust_config_path(config_path); scheme_set_config_path(config_path); + if (cross_compile) { + host_config_path = adjust_config_path(host_config_path); + scheme_set_host_config_path(host_config_path); + } + /* Make list of additional collection paths: */ if (collects_extra) collects_paths_r = reverse_path_list(collects_extra, 1); @@ -1789,8 +1828,9 @@ static int run_from_cmd_line(int argc, char *_argv[], " -S , --search : More collects at (after main collects)\n" " -G , --config : Main configuration directory at \n" " -A , --addon : Addon directory at \n" - " -R , --compiled : Set compiled-file search roots to \n" " -U, --no-user-path : Ignore user-specific collects, etc.\n" + " -R , --compiled : Set compiled-file search roots to \n" + " -C, --cross : Cross-build mode; save current collects and config as host\n" " -N , --name : Sets `(find-system-path 'run-file)' to \n" # ifdef CMDLINE_STDIO_FLAG " -J , ---wm-class : Set WM_CLASS class to (Unix)\n" diff --git a/racket/src/racket/include/scheme.h b/racket/src/racket/include/scheme.h index aa15966882..a2e362ee63 100644 --- a/racket/src/racket/include/scheme.h +++ b/racket/src/racket/include/scheme.h @@ -1906,6 +1906,7 @@ MZ_EXTERN void scheme_set_startup_use_jit(int); MZ_EXTERN void scheme_set_startup_load_on_demand(int); MZ_EXTERN void scheme_set_ignore_user_paths(int); MZ_EXTERN void scheme_set_ignore_link_paths(int); +MZ_EXTERN void scheme_set_cross_compile_mode(int); MZ_EXTERN void scheme_set_logging(int syslog_level, int stderr_level); MZ_EXTERN void scheme_set_logging_spec(Scheme_Object *syslog_level, Scheme_Object *stderr_level); @@ -1974,6 +1975,8 @@ MZ_EXTERN Scheme_Object *scheme_set_exec_cmd(char *s); MZ_EXTERN Scheme_Object *scheme_set_run_cmd(char *s); MZ_EXTERN void scheme_set_collects_path(Scheme_Object *p); MZ_EXTERN void scheme_set_config_path(Scheme_Object *p); +MZ_EXTERN void scheme_set_host_collects_path(Scheme_Object *p); +MZ_EXTERN void scheme_set_host_config_path(Scheme_Object *p); MZ_EXTERN void scheme_set_original_dir(Scheme_Object *d); MZ_EXTERN void scheme_set_addon_dir(Scheme_Object *p); MZ_EXTERN void scheme_set_command_line_arguments(Scheme_Object *vec); diff --git a/racket/src/racket/src/file.c b/racket/src/racket/src/file.c index 057aa0f23f..4404eb6bd4 100644 --- a/racket/src/racket/src/file.c +++ b/racket/src/racket/src/file.c @@ -244,10 +244,12 @@ READ_ONLY static Scheme_Object *init_dir_symbol, *init_file_symbol, *sys_dir_sym READ_ONLY static Scheme_Object *exec_file_symbol, *run_file_symbol, *collects_dir_symbol; READ_ONLY static Scheme_Object *pref_file_symbol, *orig_dir_symbol, *addon_dir_symbol; READ_ONLY static Scheme_Object *config_dir_symbol; +READ_ONLY static Scheme_Object *host_collects_dir_symbol, *host_config_dir_symbol; SHARED_OK static Scheme_Object *exec_cmd; SHARED_OK static Scheme_Object *run_cmd; SHARED_OK static Scheme_Object *collects_path, *config_path; +SHARED_OK static Scheme_Object *host_collects_path, *host_config_path; THREAD_LOCAL_DECL(static Scheme_Object *original_pwd); SHARED_OK static Scheme_Object *addon_dir; @@ -301,6 +303,8 @@ void scheme_init_file(Scheme_Env *env) REGISTER_SO(run_file_symbol); REGISTER_SO(collects_dir_symbol); REGISTER_SO(config_dir_symbol); + REGISTER_SO(host_collects_dir_symbol); + REGISTER_SO(host_config_dir_symbol); REGISTER_SO(orig_dir_symbol); REGISTER_SO(addon_dir_symbol); #endif @@ -329,6 +333,8 @@ void scheme_init_file(Scheme_Env *env) run_file_symbol = scheme_intern_symbol("run-file"); collects_dir_symbol = scheme_intern_symbol("collects-dir"); config_dir_symbol = scheme_intern_symbol("config-dir"); + host_collects_dir_symbol = scheme_intern_symbol("host-collects-dir"); + host_config_dir_symbol = scheme_intern_symbol("host-config-dir"); orig_dir_symbol = scheme_intern_symbol("orig-dir"); addon_dir_symbol = scheme_intern_symbol("addon-dir"); #endif @@ -6726,12 +6732,16 @@ find_system_path(int argc, Scheme_Object **argv) return exec_cmd; } else if (argv[0] == run_file_symbol) { return scheme_get_run_cmd(); - } else if (argv[0] == collects_dir_symbol) { + } else if ((argv[0] == host_collects_dir_symbol) && host_collects_path) + return host_collects_path; + else if ((argv[0] == collects_dir_symbol) || (argv[0] == host_collects_dir_symbol)) { if (!collects_path) { return scheme_make_path("collects"); } return collects_path; - } else if (argv[0] == config_dir_symbol) { + } else if ((argv[0] == host_config_dir_symbol) && host_config_path) + return host_config_path; + else if ((argv[0] == config_dir_symbol) || (argv[0] == host_config_dir_symbol)) { if (!config_path) { return scheme_make_path("lib"); } @@ -6746,7 +6756,8 @@ find_system_path(int argc, Scheme_Object **argv) "(or/c 'home-dir 'pref-dir 'pref-file 'temp-dir\n" " 'init-dir 'init-file 'addon-dir\n" " 'doc-dir 'desk-dir 'sys-dir 'exec-file 'run-file\n" - " 'collects-dir 'config-dir 'orig-dir)", + " 'collects-dir 'config-dir 'orig-dir\n" + " 'host-collects-dir 'host-config-fir)", 0, argc, argv); return NULL; } @@ -7057,6 +7068,24 @@ void scheme_set_config_path(Scheme_Object *p) config_path = p; } +/* should only called from main */ +void scheme_set_host_collects_path(Scheme_Object *p) +{ + if (!host_collects_path) { + REGISTER_SO(host_collects_path); + } + host_collects_path = p; +} + +/* should only called from main */ +void scheme_set_host_config_path(Scheme_Object *p) +{ + if (!host_config_path) { + REGISTER_SO(host_config_path); + } + host_config_path = p; +} + void scheme_set_original_dir(Scheme_Object *d) { diff --git a/racket/src/racket/src/string.c b/racket/src/racket/src/string.c index 37217afdb3..a342241849 100644 --- a/racket/src/racket/src/string.c +++ b/racket/src/racket/src/string.c @@ -377,8 +377,9 @@ static char *string_to_from_locale(int to_bytes, ROSYM static Scheme_Object *sys_symbol; ROSYM static Scheme_Object *link_symbol, *machine_symbol, *vm_symbol, *gc_symbol; ROSYM static Scheme_Object *so_suffix_symbol, *so_mode_symbol, *word_symbol; -ROSYM static Scheme_Object *os_symbol, *fs_change_symbol; +ROSYM static Scheme_Object *os_symbol, *fs_change_symbol, *cross_symbol; ROSYM static Scheme_Object *racket_symbol, *cgc_symbol, *_3m_symbol; +ROSYM static Scheme_Object *force_symbol, *infer_symbol; ROSYM static Scheme_Object *platform_3m_path, *platform_cgc_path; READ_ONLY static Scheme_Object *zero_length_char_string; READ_ONLY static Scheme_Object *zero_length_byte_string; @@ -396,6 +397,8 @@ READ_ONLY static Scheme_Object *complete_symbol, *continues_symbol, *aborts_symb READ_ONLY Scheme_Object *scheme_string_p_proc; READ_ONLY Scheme_Object *scheme_byte_string_p_proc; +READ_ONLY static int cross_compile_mode; + void scheme_init_string (Scheme_Env *env) { @@ -413,6 +416,7 @@ scheme_init_string (Scheme_Env *env) REGISTER_SO(word_symbol); REGISTER_SO(os_symbol); REGISTER_SO(fs_change_symbol); + REGISTER_SO(cross_symbol); link_symbol = scheme_intern_symbol("link"); machine_symbol = scheme_intern_symbol("machine"); vm_symbol = scheme_intern_symbol("vm"); @@ -422,6 +426,7 @@ scheme_init_string (Scheme_Env *env) word_symbol = scheme_intern_symbol("word"); os_symbol = scheme_intern_symbol("os"); fs_change_symbol = scheme_intern_symbol("fs-change"); + cross_symbol = scheme_intern_symbol("cross"); REGISTER_SO(racket_symbol); REGISTER_SO(cgc_symbol); @@ -430,6 +435,11 @@ scheme_init_string (Scheme_Env *env) cgc_symbol = scheme_intern_symbol("cgc"); _3m_symbol = scheme_intern_symbol("3m"); + REGISTER_SO(force_symbol); + REGISTER_SO(infer_symbol); + force_symbol = scheme_intern_symbol("force"); + infer_symbol = scheme_intern_symbol("infer"); + REGISTER_SO(zero_length_char_string); REGISTER_SO(zero_length_byte_string); zero_length_char_string = scheme_alloc_char_string(0, 0); @@ -2763,6 +2773,11 @@ void *scheme_environment_variables_to_block(Scheme_Object *ev, int *_need_free) /* End Environment Variables */ /***********************************************************************/ +void scheme_set_cross_compile_mode(int v) +{ + cross_compile_mode = v; +} + static void machine_details(char *s); #include "systype.inc" @@ -2811,8 +2826,12 @@ static Scheme_Object *system_type(int argc, Scheme_Object *argv[]) return fs_change_props; } + if (SAME_OBJ(argv[0], cross_symbol)) { + return (cross_compile_mode ? force_symbol : infer_symbol); + } + if (!SAME_OBJ(argv[0], os_symbol)) { - scheme_wrong_contract("system-type", "(or/c 'os 'word 'link 'machine 'vm 'gc 'so-suffix 'so-mode 'word 'fs-change)", 0, argc, argv); + scheme_wrong_contract("system-type", "(or/c 'os 'word 'link 'machine 'vm 'gc 'so-suffix 'so-mode 'word 'fs-change 'cross)", 0, argc, argv); return NULL; } }