From c917434a86162a7b96e8766f244d013c9c25dc34 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 25 Apr 2017 06:54:22 -0600 Subject: [PATCH] improve cross-platform support Detangle the target and host DLL and library directories by making `get-lib-search-dirs` and `get-dll-dir` report the host system's directories, and add `get-cross-lib-search-dirs` and `get-cross-dll-dir`. A new `-C`/`--cross` flag causes `racket` to save a host config and collection directory and make them available via `(find-system-path 'host-{config,collects}-dir)`, while plus `(system-type 'cross)` reports whether `-C` mode is in effect. Besides making the host paths available, this change allows a same-platform build to run in corss-platform mode. The immediate problem to solve was the creation of Windows installers on Windows, where recent changes to support 'gui-bin-dir configuration need a clear distinction between the host Racket and the target Racket being built, even if they're the same platform. (The "GRacket.exe" executable didn't work, for example.) The changes in this commit are more than needed for the immediate problem, but they naturally build on the necessary `-C` flag, and they support cross-platform package setup where native libraries are needed during setup. --- Makefile | 2 +- pkgs/racket-doc/scribblings/raco/setup.scrbl | 61 +++++++++-- .../scribblings/reference/filesystem.scrbl | 22 +++- .../scribblings/reference/runtime.scrbl | 19 +++- .../scribblings/reference/startup.scrbl | 26 +++-- racket/collects/compiler/distribute.rkt | 12 +-- racket/collects/compiler/embed.rkt | 4 +- racket/collects/setup/cross-system.rkt | 3 +- racket/collects/setup/dirs.rkt | 56 ++++++++-- racket/collects/setup/private/dirs.rkt | 10 +- racket/src/racket/cmdline.inc | 100 ++++++++++++------ racket/src/racket/include/scheme.h | 3 + racket/src/racket/src/file.c | 35 +++++- racket/src/racket/src/string.c | 23 +++- 14 files changed, 299 insertions(+), 77 deletions(-) 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; } }