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.
This commit is contained in:
Matthew Flatt
parent
83bf0e49ff
commit
c917434a86
2
Makefile
2
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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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?)])
|
||||
|
|
|
|||
|
|
@ -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?]{
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -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")))))
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
||||
;; ----------------------------------------
|
||||
|
|
|
|||
|
|
@ -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 <dir>, --search <dir> : More collects at <dir> (after main collects)\n"
|
||||
" -G <dir>, --config <dir> : Main configuration directory at <dir>\n"
|
||||
" -A <dir>, --addon <dir> : Addon directory at <dir>\n"
|
||||
" -R <paths>, --compiled <paths> : Set compiled-file search roots to <paths>\n"
|
||||
" -U, --no-user-path : Ignore user-specific collects, etc.\n"
|
||||
" -R <paths>, --compiled <paths> : Set compiled-file search roots to <paths>\n"
|
||||
" -C, --cross : Cross-build mode; save current collects and config as host\n"
|
||||
" -N <file>, --name <file> : Sets `(find-system-path 'run-file)' to <file>\n"
|
||||
# ifdef CMDLINE_STDIO_FLAG
|
||||
" -J <name>, ---wm-class <name> : Set WM_CLASS class to <name> (Unix)\n"
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user