suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

system-type: add 'target-machine

Browse Source 
The 'target-machine result from `system-type` reports the
default value of `current-compile-target-machine`.

Also, fill in pieces to make `setup/cross-system` work
for RacketCS, although cross-compilation is still several
steps away.
This commit is contained in:
Matthew Flatt 2018-11-25 11:30:37 -07:00
parent 7cdf9f1c0b
commit 4a080ada04
9 changed files with 66 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
pkgs/racket-doc/scribblings/reference/eval.scrbl
View File

@ -613,7 +613,8 @@ When @racket[(system-type 'vm)] reports @racket['racket], then the
only target symbol is @racket['racket]. When @racket[(system-type
'vm)] reports @racket['chez-scheme], then a symbol corresponding to
the current platform is a target, and other targets may also be
supported.
supported. The @racket['target-machine] mode of @racket[system-type]
reports the running Racket's native target machine.
@history[#:added "7.1.0.6"]}

14
pkgs/racket-doc/scribblings/reference/runtime.scrbl
View File

@ -4,10 +4,10 @@
@title[#:tag "runtime"]{Environment and Runtime Information}
@defproc[(system-type [mode (or/c 'os 'word 'vm 'gc 'link 'machine
@defproc[(system-type [mode (or/c 'os 'word 'vm 'gc 'link 'machine 'target-machine
'so-suffix 'so-mode 'fs-change 'cross)
'os])
(or/c symbol? string? bytes? exact-positive-integer? vector?)]{
(or/c symbol? string? bytes? exact-positive-integer? vector? #f)]{
Returns information about the operating system, build mode, or machine
for a running Racket. (Installation tools should use @racket[cross-system-type],
@ -59,6 +59,13 @@ In @indexed-racket['machine] mode, then the result is a string, which
contains further details about the current machine in a
platform-specific format.
In @indexed-racket['target-machine] mode, the result is a symbol for
the running Racket's native bytecode format, or it is @racket[#f] if
there is no native format other than the machine-independent format.
If the result is a symbol, then @racket[compile-target-machine?] returns
@racket[#t] when applied to the symbol; see also
@racket[current-compile-target-machine].
In @indexed-racket['so-suffix] mode, then the result is a byte string
that represents the file extension used for shared objects on the
current platform. The byte string starts with a period, so it is
@ -107,7 +114,8 @@ The possible symbols are:
]
@history[#:changed "6.8.0.2" @elem{Added @racket['vm] mode.}
#:changed "6.9.0.1" @elem{Added @racket['cross] mode.}]}
#:changed "6.9.0.1" @elem{Added @racket['cross] mode.}
#:changed "7.1.0.6" @elem{Added @racket['target-machine] mode.}]}
@defproc[(system-language+country) string?]{

12
racket/collects/setup/cross-system.rkt
View File

@ -7,13 +7,12 @@
(define cross-system-table #f)
(define system-type-symbols '(os word gc vm link machine so-suffix so-mode fs-change))
(define system-type-symbols '(os word gc vm link machine so-suffix so-mode fs-change target-machine))
(define (compute-cross!)
(unless cross-system-table
(define lib-dir (find-lib-dir))
(define ht (and lib-dir
(eq? (system-type 'vm) 'racket) ; only the Racket VM supports cross-compilation, for now
(let ([f (build-path lib-dir "system.rktd")])
(and (file-exists? f)
(let ([ht (call-with-default-reading-parameterization
@ -22,6 +21,11 @@
f
read)))])
(and (hash? ht)
;; If 'vm doesn't match, then assuming that we're looking
;; at a multi-vm overlay, instead of cross-compiling,
;; because cross-compiling requires the same VM.
(eq? (system-type 'vm)
(hash-ref ht 'vm #f))
(for/and ([sym (in-list (list*
'library-subpath
'library-subpath-convention
@ -31,7 +35,7 @@
(and (for/and ([sym (in-list system-type-symbols)]
#:unless (or (eq? sym 'machine)
(eq? sym 'gc)))
(equal? (hash-ref ht sym) (system-type sym)))
(equal? (hash-ref ht sym #f) (system-type sym)))
(equal? (bytes->path (hash-ref ht 'library-subpath)
(hash-ref ht 'library-subpath-convention))
(system-library-subpath #f))))
@ -50,7 +54,7 @@
(unless (memq mode system-type-symbols)
(raise-argument-error
'cross-system-type
"(or/c 'os 'word 'gc 'vm 'link 'machine 'so-suffix 'so-mode 'fs-change)"
"(or/c 'os 'word 'gc 'vm 'link 'machine 'target-machine 'so-suffix 'so-mode 'fs-change)"
mode))
(compute-cross!)
(or (hash-ref cross-system-table mode #f)

1
racket/src/cs/c/Makefile.in
View File

@ -237,6 +237,7 @@ common-install:
$(STRIP_DEBUG) "$(DESTDIR)$(libpltdir)/starter"
$(ICP) $(srcdir)/../../start/starter-sh "$(DESTDIR)$(libpltdir)/starter-sh"
$(RACKET) -cu "$(srcdir)/../../racket/collects-path.rkt" "$(DESTDIR)$(libpltdir)/starter" $(DESTDIR)@COLLECTS_PATH@ $(DESTDIR)@CONFIG_PATH@
$(RACKET) -cu "$(srcdir)/gen-system.rkt" $(DESTDIR)$(libpltdir)/system$(CS_INSTALLED).rktd $(MACH)
unix-install:
$(MAKE) common-install

22
racket/src/cs/c/gen-system.rkt Normal file
View File

@ -0,0 +1,22 @@
(module gen-system '#%kernel
;; Command-line argument: <dest-file> <target-machine>
(define-values (ht)
(hash 'os (system-type 'os)
'word (system-type 'word)
'gc 'cs
'vm 'chez-scheme
'link 'static
'machine (bytes->string/utf-8 (path->bytes (system-library-subpath #f)))
'so-suffix (system-type 'so-suffix)
'so-mode 'local
'fs-change '#(#f #f #f #f)
'target-machine (string->symbol (vector-ref (current-command-line-arguments) 1))))
(call-with-output-file
(vector-ref (current-command-line-arguments) 0)
(lambda (o)
(write ht o)
(newline o))
'truncate/replace))

5
racket/src/cs/rumble/system.ss
View File

@ -31,11 +31,12 @@
[(a6nt ta6nt i3nt ti3nt) (string->utf8 ".dll")]
[else (string->utf8 ".so")])]
[(so-mode) 'local]
[(fs-change) '#(#f #f #f #f)]
[(fs-change) '#(#f #f #f #f)] ; when this changes, change "gen-system.rkt", too
[(target-machine) (machine-type)]
[(cross) cross-mode]
[else (raise-argument-error 'system-type
(string-append
"(or/c 'os 'word 'vm 'gc 'link 'machine\n"
"(or/c 'os 'word 'vm 'gc 'link 'machine 'target-machine\n"
" 'so-suffix 'so-mode 'fs-change 'cross)")
mode)]))

4
racket/src/racket/mksystem.rkt
View File

@ -1,4 +1,4 @@
(module mkincludes '#%kernel
(module mksystem '#%kernel
;; Arguments are
;; <output-file> [<cpp-command> <3m-exe-suffix> <run-racket-command> <this-racket-command>]
(define-values (args) (current-command-line-arguments))
@ -22,6 +22,7 @@
'so-suffix (system-type 'so-suffix)
'so-mode (system-type 'so-mode)
'fs-change (system-type 'fs-change)
'target-machine 'racket
'library-subpath (path->bytes (system-library-subpath #f))
'library-subpath-convention (system-path-convention-type))
;; Cross-compiling; use `cpp` to get details
@ -64,6 +65,7 @@
'so-suffix (string->bytes/utf-8 (get-string "system_type_so_suffix"))
'so-mode (get-symbol "system_type_so_mode")
'fs-change '#(#f #f #f #f)
'target-machine 'racket
'library-subpath (string->bytes/utf-8 library-subpath)
'library-subpath-convention (if (eq? os 'windows)
'windows

13
racket/src/racket/src/string.c
View File

@ -196,7 +196,7 @@ 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, *cross_symbol;
ROSYM static Scheme_Object *os_symbol, *fs_change_symbol, *target_machine_symbol, *cross_symbol;
ROSYM static Scheme_Object *racket_symbol, *cgc_symbol, *_3m_symbol, *cs_symbol;
ROSYM static Scheme_Object *force_symbol, *infer_symbol;
ROSYM static Scheme_Object *platform_3m_path, *platform_cgc_path, *platform_cs_path;
@ -246,6 +246,7 @@ scheme_init_string (Scheme_Startup_Env *env)
REGISTER_SO(word_symbol);
REGISTER_SO(os_symbol);
REGISTER_SO(fs_change_symbol);
REGISTER_SO(target_machine_symbol);
REGISTER_SO(cross_symbol);
link_symbol = scheme_intern_symbol("link");
machine_symbol = scheme_intern_symbol("machine");
@ -256,6 +257,7 @@ scheme_init_string (Scheme_Startup_Env *env)
word_symbol = scheme_intern_symbol("word");
os_symbol = scheme_intern_symbol("os");
fs_change_symbol = scheme_intern_symbol("fs-change");
target_machine_symbol = scheme_intern_symbol("target-machine");
cross_symbol = scheme_intern_symbol("cross");
REGISTER_SO(racket_symbol);
@ -2412,12 +2414,19 @@ static Scheme_Object *system_type(int argc, Scheme_Object *argv[])
return fs_change_props;
}
if (SAME_OBJ(argv[0], target_machine_symbol)) {
return racket_symbol;
}
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 'cross)", 0, argc, argv);
scheme_wrong_contract("system-type",
("(or/c 'os 'word 'link 'machine 'target-machine\n"
" 'vm 'gc 'so-suffix 'so-mode 'word 'fs-change 'cross)"),
0, argc, argv);
return NULL;
}
}

5
racket/src/worksp/csbuild.rkt
View File

@ -256,3 +256,8 @@
(format "mrstart~a.sln" pltslnver)
"/p:Configuration=Release"
(format "/p:Platform=~a" buildmode)))
(system*! (find-exe)
"../cs/c/gen-system.rkt"
(format "../../lib/system~a.rktd" cs-suffix)
machine)