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

add cross-system-type and cross-system-library-subpath

Browse Source 
Adjust installation tools to support cross-installation (i.e.,
installation for a platform other than the current one) as triggered
by "system.rktd" in "lib" having different information than the
running Racket executable.
This commit is contained in:
Matthew Flatt 2015-08-26 18:00:43 -06:00
parent a98947e81e
commit 29784bda8e
29 changed files with 830 additions and 495 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/base/info.rkt
View File

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

2
pkgs/racket-doc/pkg/scribblings/lib.scrbl
View File

@ -678,7 +678,7 @@ represented by @racket[dir] and named @racket[pkg-name].}
[pkg-name string] [pkg-name string]
[#:namespace namespace namespace? (make-base-namespace)] [#:namespace namespace namespace? (make-base-namespace)]
[#:system-type sys-type (or/c #f symbol?) (system-type)] [#:system-type sys-type (or/c #f symbol?) (system-type)]
[#:system-library-subpath sys-lib-subpath (or/c #f path?) [#:system-library-subpath sys-lib-subpath (or/c #f path-for-some-system?)
(system-library-subpath #f)]) (system-library-subpath #f)])
(listof (cons/c symbol? string?))]{ (listof (cons/c symbol? string?))]{

3
pkgs/racket-doc/scribblings/raco/common.rkt
View File

@ -7,5 +7,8 @@
(define inside-doc (define inside-doc
'(lib "scribblings/inside/inside.scrbl")) '(lib "scribblings/inside/inside.scrbl"))
(define guide-doc
'(lib "scribblings/guide/guide.scrbl"))
(define reference-doc (define reference-doc
'(lib "scribblings/reference/reference.scrbl")) '(lib "scribblings/reference/reference.scrbl"))

78
pkgs/racket-doc/scribblings/raco/setup.scrbl
View File

@ -14,6 +14,7 @@
setup/collection-name setup/collection-name
setup/collection-search setup/collection-search
setup/matching-platform setup/matching-platform
setup/cross-system
setup/path-to-relative setup/path-to-relative
setup/xref scribble/xref setup/xref scribble/xref
;; info -- no bindings from this are used ;; info -- no bindings from this are used
@ -1782,9 +1783,14 @@ Returns @racket[#t] if @racket[v] is a symbol, string, or regexp value
(in the sense of @racket[regexp?]), @racket[#f] otherwise.} (in the sense of @racket[regexp?]), @racket[#f] otherwise.}
@defproc[(matching-platform? [spec platform-spec?] @defproc[(matching-platform? [spec platform-spec?]
[#:system-type sys-type (or/c #f symbol?) (system-type)] [#:cross? cross? any/c #f]
[#:system-library-subpath sys-lib-subpath (or/c #f path?) [#:system-type sys-type (or/c #f symbol?) (if cross?
(system-library-subpath #f)]) (cross-system-type)
(system-type))]
[#:system-library-subpath sys-lib-subpath (or/c #f path-for-some-system?)
(if cross?
(cross-system-library-subpath #f)
(system-library-subpath #f))])
boolean?]{ boolean?]{
Reports whether @racket[spec] matches @racket[sys-type] or Reports whether @racket[spec] matches @racket[sys-type] or
@ -1800,8 +1806,74 @@ If @racket[spec] is a string, then the result is @racket[#t] if
If @racket[spec] is a regexp value, then the result is @racket[#t] if If @racket[spec] is a regexp value, then the result is @racket[#t] if
the regexp matches @racket[(path->string sys-lib-subpath)], the regexp matches @racket[(path->string sys-lib-subpath)],
@racket[#f] otherwise.
@history[#:changed "6.2.900.11" @elem{Added @racket[#:cross?] argument and
changed the contract on @racket[sys-lib-subpath]
to accept @racket[path-for-some-system?]
instead of just @racket[path?].}]}
@; ------------------------------------------------------------------------
@section[#:tag "cross-system"]{API for Cross-Platform Configuration}
@defmodule[setup/cross-system]{The @racketmodname[setup/cross-system]
library provides functions for querying the system properties of a
destination platform, which can be different than the current platform
in cross-installation modes.}
A Racket installation includes a @filepath{system.rktd} file in the
directory reported by @racket[(find-lib-dir)]. When the information in that file
does not match the running Racket's information, then the
@racketmodname[setup/cross-system] module infers that Racket is being
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}
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).
@history[#:added "6.2.900.11"]
@defproc[(cross-system-type [mode (or/c 'os 'word 'gc 'link 'machine
'so-suffix 'so-mode 'fs-change)
'os])
(or/c symbol? string? bytes? exact-positive-integer? vector?)]{
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].}
@defproc[(cross-system-library-subpath [mode (or/c 'cgc '3m #f)
(system-type 'gc)])
path-for-some-system?]{
Like @racket[system-library-subpath], 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-library-subpath].
In cross-installation mode, the target platform may have a different
path convention than the current platform, so the result is
@racket[path-for-some-system?] instead of @racket[path?].}
@defproc[(cross-installation?) boolean?]{
Returns @racket[#t] if cross-installation mode has been detected,
@racket[#f] otherwise.} @racket[#f] otherwise.}
@; ------------------------------------------------------------------------ @; ------------------------------------------------------------------------
@section[#:tag "xref"]{API for Cross-References for Installed Manuals} @section[#:tag "xref"]{API for Cross-References for Installed Manuals}

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

@ -1,5 +1,6 @@
#lang scribble/doc #lang scribble/doc
@(require "mz.rkt") @(require "mz.rkt"
(for-label setup/cross-system))
@title[#:tag "runtime"]{Environment and Runtime Information} @title[#:tag "runtime"]{Environment and Runtime Information}
@ -9,7 +10,8 @@
(or/c symbol? string? bytes? exact-positive-integer? vector?)]{ (or/c symbol? string? bytes? exact-positive-integer? vector?)]{
Returns information about the operating system, build mode, or machine Returns information about the operating system, build mode, or machine
for a running Racket. for a running Racket. (Installation tools should use @racket[cross-system-type],
instead, to support cross-installation.)
In @indexed-racket['os] mode, In @indexed-racket['os] mode,
the possible symbol results are: the possible symbol results are:
@ -117,7 +119,10 @@ The optional @racket[mode] argument specifies the relevant
garbage-collection variant, which one of the possible results of garbage-collection variant, which one of the possible results of
@racket[(system-type 'gc)]: @racket['cgc] or @racket['3m]. It can also @racket[(system-type 'gc)]: @racket['cgc] or @racket['3m]. It can also
be @racket[#f], in which case the result is independent of the be @racket[#f], in which case the result is independent of the
garbage-collection variant.} garbage-collection variant.
Installation tools should use @racket[cross-system-library-subpath],
instead, to support cross-installation.}
@defproc[(version) (and/c string? immutable?)]{ @defproc[(version) (and/c string? immutable?)]{

19
racket/collects/compiler/distribute.rkt
View File

@ -4,6 +4,7 @@
setup/dirs setup/dirs
racket/list racket/list
setup/variant setup/variant
setup/cross-system
pkg/path pkg/path
setup/main-collects setup/main-collects
dynext/filename-version dynext/filename-version
@ -22,7 +23,7 @@
[_ (unless (directory-exists? dest-dir) [_ (unless (directory-exists? dest-dir)
(make-directory dest-dir))] (make-directory dest-dir))]
[sub-dirs (map (lambda (b type) [sub-dirs (map (lambda (b type)
(case (system-type) (case (cross-system-type)
[(windows) #f] [(windows) #f]
[(unix) "bin"] [(unix) "bin"]
[(macosx) (if (memq type '(gracketcgc gracket3m)) [(macosx) (if (memq type '(gracketcgc gracket3m))
@ -41,7 +42,7 @@
(let-values ([(base name dir?) (split-path b)]) (let-values ([(base name dir?) (split-path b)])
(let ([dest (build-path dest-dir name)]) (let ([dest (build-path dest-dir name)])
(if (and (memq type '(gracketcgc gracket3m)) (if (and (memq type '(gracketcgc gracket3m))
(eq? 'macosx (system-type))) (eq? 'macosx (cross-system-type)))
(begin (begin
(copy-app b dest) (copy-app b dest)
(app-to-file dest)) (app-to-file dest))
@ -51,7 +52,7 @@
orig-binaries orig-binaries
sub-dirs sub-dirs
types)] types)]
[single-mac-app? (and (eq? 'macosx (system-type)) [single-mac-app? (and (eq? 'macosx (cross-system-type))
(= 1 (length types)) (= 1 (length types))
(memq (car types) '(gracketcgc gracket3m)))]) (memq (car types) '(gracketcgc gracket3m)))])
;; Create directories for libs, collects, and extensions: ;; Create directories for libs, collects, and extensions:
@ -111,7 +112,7 @@
(cond (cond
[sub-dir [sub-dir
(build-path 'up relative-dir)] (build-path 'up relative-dir)]
[(and (eq? 'macosx (system-type)) [(and (eq? 'macosx (cross-system-type))
(memq type '(gracketcgc gracket3m)) (memq type '(gracketcgc gracket3m))
(not single-mac-app?)) (not single-mac-app?))
(build-path 'up 'up 'up relative-dir)] (build-path 'up 'up 'up relative-dir)]
@ -139,7 +140,7 @@
(void)))))) (void))))))
(define (install-libs lib-dir types) (define (install-libs lib-dir types)
(case (system-type) (case (cross-system-type)
[(windows) [(windows)
(let ([copy-dll (lambda (name) (let ([copy-dll (lambda (name)
(copy-file* (search-dll (find-dll-dir) name) (copy-file* (search-dll (find-dll-dir) name)
@ -275,7 +276,7 @@
(build-path lib-dir (car files))))) (build-path lib-dir (car files)))))
(define (patch-binaries binaries types) (define (patch-binaries binaries types)
(case (system-type) (case (cross-system-type)
[(windows) [(windows)
(for-each (lambda (b) (for-each (lambda (b)
(update-dll-dir b "lib")) (update-dll-dir b "lib"))
@ -565,7 +566,7 @@
;; Utilities ;; Utilities
(define (shared-libraries?) (define (shared-libraries?)
(eq? 'shared (system-type 'link))) (eq? 'shared (cross-system-type 'link)))
(define (to-path s) (define (to-path s)
(if (string? s) (if (string? s)
@ -580,7 +581,7 @@
(let ([m (regexp-match #rx#"bINARy tYPe:(e?)(.)(.)(.)" (current-input-port))]) (let ([m (regexp-match #rx#"bINARy tYPe:(e?)(.)(.)(.)" (current-input-port))])
(if m (if m
(begin (begin
(when (eq? 'unix (system-type)) (when (eq? 'unix (cross-system-type))
(unless (equal? (cadr m) #"e") (unless (equal? (cadr m) #"e")
(error 'assemble-distribution (error 'assemble-distribution
"file is an original PLT executable, not a stub binary: ~e" "file is an original PLT executable, not a stub binary: ~e"
@ -635,7 +636,7 @@
(copy-directory/files src dest)) (copy-directory/files src dest))
(define (app-to-file b) (define (app-to-file b)
(if (and (eq? 'macosx (system-type)) (if (and (eq? 'macosx (cross-system-type))
(regexp-match #rx#"[.][aA][pP][pP]$" (regexp-match #rx#"[.][aA][pP][pP]$"
(path->bytes (if (string? b) (path->bytes (if (string? b)
(string->path b) (string->path b)

45
racket/collects/compiler/embed.rkt
View File

@ -12,6 +12,7 @@
setup/variant setup/variant
file/ico file/ico
racket/private/so-search racket/private/so-search
setup/cross-system
"private/winsubsys.rkt" "private/winsubsys.rkt"
"private/macfw.rkt" "private/macfw.rkt"
"private/mach-o.rkt" "private/mach-o.rkt"
@ -84,10 +85,10 @@
#f) #f)
(define (embedding-executable-is-actually-directory? mred?) (define (embedding-executable-is-actually-directory? mred?)
(and mred? (eq? 'macosx (system-type)))) (and mred? (eq? 'macosx (cross-system-type))))
(define (embedding-executable-put-file-extension+style+filters mred?) (define (embedding-executable-put-file-extension+style+filters mred?)
(case (system-type) (case (cross-system-type)
[(windows) (values "exe" null '(("Executable" "*.exe")))] [(windows) (values "exe" null '(("Executable" "*.exe")))]
[(macosx) (if mred? [(macosx) (if mred?
(values "app" '(enter-packages) '(("App" "*.app"))) (values "app" '(enter-packages) '(("App" "*.app")))
@ -102,7 +103,7 @@
(if (regexp-match re (path->bytes path)) (if (regexp-match re (path->bytes path))
path path
(path-replace-suffix path sfx)))]) (path-replace-suffix path sfx)))])
(case (system-type) (case (cross-system-type)
[(windows) (fixup #rx#"[.][eE][xX][eE]$" #".exe")] [(windows) (fixup #rx#"[.][eE][xX][eE]$" #".exe")]
[(macosx) (if mred? [(macosx) (if mred?
(fixup #rx#"[.][aA][pP][pP]$" #".app") (fixup #rx#"[.][aA][pP][pP]$" #".app")
@ -118,7 +119,7 @@
dest)) dest))
(define exe-suffix? (define exe-suffix?
(delay (equal? #"i386-cygwin" (path->bytes (system-library-subpath))))) (delay (equal? #"i386-cygwin" (path->bytes (cross-system-library-subpath)))))
;; Find the magic point in the binary: ;; Find the magic point in the binary:
(define (find-cmdline what rx) (define (find-cmdline what rx)
@ -1343,7 +1344,7 @@
cmdline cmdline
[aux null] [aux null]
[launcher? #f] [launcher? #f]
[variant (system-type 'gc)] [variant (cross-system-type 'gc)]
[collects-path #f]) [collects-path #f])
(create-embedding-executable dest (create-embedding-executable dest
#:mred? mred? #:mred? mred?
@ -1374,7 +1375,7 @@
#:cmdline [cmdline null] #:cmdline [cmdline null]
#:aux [aux null] #:aux [aux null]
#:launcher? [launcher? #f] #:launcher? [launcher? #f]
#:variant [variant (system-type 'gc)] #:variant [variant (cross-system-type 'gc)]
#:collects-path [collects-path #f] #:collects-path [collects-path #f]
#:collects-dest [collects-dest #f] #:collects-dest [collects-dest #f]
#:on-extension [on-extension #f] #:on-extension [on-extension #f]
@ -1389,18 +1390,18 @@
(let ([m (assq 'forget-exe? aux)]) (let ([m (assq 'forget-exe? aux)])
(or (not m) (or (not m)
(not (cdr m)))))) (not (cdr m))))))
(define unix-starter? (and (eq? (system-type) 'unix) (define unix-starter? (and (eq? (cross-system-type) 'unix)
(let ([m (assq 'original-exe? aux)]) (let ([m (assq 'original-exe? aux)])
(or (not m) (or (not m)
(not (cdr m)))))) (not (cdr m))))))
(define long-cmdline? (or (eq? (system-type) 'windows) (define long-cmdline? (or (eq? (cross-system-type) 'windows)
(eq? (system-type) 'macosx) (eq? (cross-system-type) 'macosx)
unix-starter?)) unix-starter?))
(define relative? (let ([m (assq 'relative? aux)]) (define relative? (let ([m (assq 'relative? aux)])
(and m (cdr m)))) (and m (cdr m))))
(define collects-path-bytes (collects-path->bytes (define collects-path-bytes (collects-path->bytes
((if (and mred? ((if (and mred?
(eq? 'macosx (system-type))) (eq? 'macosx (cross-system-type)))
mac-mred-collects-path-adjust mac-mred-collects-path-adjust
values) values)
collects-path))) collects-path)))
@ -1417,7 +1418,7 @@
(eprintf "Copying to ~s\n" dest)) (eprintf "Copying to ~s\n" dest))
(let-values ([(dest-exe orig-exe osx?) (let-values ([(dest-exe orig-exe osx?)
(cond (cond
[(and mred? (eq? 'macosx (system-type))) [(and mred? (eq? 'macosx (cross-system-type)))
(values (prepare-macosx-mred exe dest aux variant) (values (prepare-macosx-mred exe dest aux variant)
(mac-dest->executable (build-path (find-lib-dir) "Starter.app") (mac-dest->executable (build-path (find-lib-dir) "Starter.app")
#t) #t)
@ -1452,7 +1453,7 @@
(delete-file dest))) (delete-file dest)))
(raise x))]) (raise x))])
(define old-perms (ensure-writable dest-exe)) (define old-perms (ensure-writable dest-exe))
(when (and (eq? 'macosx (system-type)) (when (and (eq? 'macosx (cross-system-type))
(not unix-starter?)) (not unix-starter?))
(let ([m (or (assq 'framework-root aux) (let ([m (or (assq 'framework-root aux)
(and relative? '(framework-root . #f)))]) (and relative? '(framework-root . #f)))])
@ -1475,7 +1476,7 @@
"/") "/")
dest dest
mred?)))))) mred?))))))
(when (eq? 'windows (system-type)) (when (eq? 'windows (cross-system-type))
(let ([m (or (assq 'dll-dir aux) (let ([m (or (assq 'dll-dir aux)
(and relative? '(dll-dir . #f)))]) (and relative? '(dll-dir . #f)))])
(if m (if m
@ -1505,7 +1506,7 @@
;; adjust relative path (since GRacket is off by one): ;; adjust relative path (since GRacket is off by one):
(update-config-dir (mac-dest->executable dest mred?) (update-config-dir (mac-dest->executable dest mred?)
"../../../etc/")] "../../../etc/")]
[(eq? 'windows (system-type)) [(eq? 'windows (cross-system-type))
(unless keep-exe? (unless keep-exe?
;; adjust relative path (since GRacket is off by one): ;; adjust relative path (since GRacket is off by one):
(update-config-dir dest "etc/"))]))) (update-config-dir dest "etc/"))])))
@ -1539,7 +1540,7 @@
[decl-end-s (number->string decl-end)] [decl-end-s (number->string decl-end)]
[end-s (number->string end)]) [end-s (number->string end)])
(append (if launcher? (append (if launcher?
(if (and (eq? 'windows (system-type)) (if (and (eq? 'windows (cross-system-type))
keep-exe?) keep-exe?)
;; argv[0] replacement: ;; argv[0] replacement:
(list (path->string (list (path->string
@ -1584,7 +1585,7 @@
(display "\0\0\0\0" out))]) (display "\0\0\0\0" out))])
(let-values ([(start decl-end end cmdline-end) (let-values ([(start decl-end end cmdline-end)
(cond (cond
[(eq? (system-type) 'windows) [(eq? (cross-system-type) 'windows)
;; Add as a resource ;; Add as a resource
(define o (open-output-bytes)) (define o (open-output-bytes))
(define decl-len (write-module o)) (define decl-len (write-module o))
@ -1604,7 +1605,7 @@
bstr)) bstr))
(update-resources dest-exe pe new-rsrcs) (update-resources dest-exe pe new-rsrcs)
(values 0 decl-len init-len (+ init-len cmdline-len))] (values 0 decl-len init-len (+ init-len cmdline-len))]
[(and (eq? (system-type) 'macosx) [(and (eq? (cross-system-type) 'macosx)
(not unix-starter?)) (not unix-starter?))
;; For Mach-O, we know how to add a proper segment ;; For Mach-O, we know how to add a proper segment
(define s (open-output-bytes)) (define s (open-output-bytes))
@ -1669,7 +1670,7 @@
[osx? [osx?
;; default path in `gracket' is off by one: ;; default path in `gracket' is off by one:
(set-collects-path dest-exe #"../../../collects")] (set-collects-path dest-exe #"../../../collects")]
[(eq? 'windows (system-type)) [(eq? 'windows (cross-system-type))
(unless keep-exe? (unless keep-exe?
;; off by one in this case, too: ;; off by one in this case, too:
(set-collects-path dest-exe #"collects"))])]) (set-collects-path dest-exe #"collects"))])])
@ -1726,7 +1727,7 @@
"cmdline" "cmdline"
#"\\[Replace me for EXE hack")))] #"\\[Replace me for EXE hack")))]
[anotherpos (and mred? [anotherpos (and mred?
(eq? 'windows (system-type)) (eq? 'windows (cross-system-type))
(let ([m (assq 'single-instance? aux)]) (let ([m (assq 'single-instance? aux)])
(and m (not (cdr m)))) (and m (not (cdr m))))
(with-input-from-file dest-exe (with-input-from-file dest-exe
@ -1758,16 +1759,16 @@
(file-position out))]) (file-position out))])
(file-position out cmdpos) (file-position out cmdpos)
(fprintf out "~a...~a~a" (fprintf out "~a...~a~a"
(if (and keep-exe? (eq? 'windows (system-type))) "*" "?") (if (and keep-exe? (eq? 'windows (cross-system-type))) "*" "?")
(integer->integer-bytes end 4 #t #f) (integer->integer-bytes end 4 #t #f)
(integer->integer-bytes (- new-end end) 4 #t #f))))) (integer->integer-bytes (- new-end end) 4 #t #f)))))
(lambda () (lambda ()
(close-output-port out))) (close-output-port out)))
(let ([m (and (eq? 'windows (system-type)) (let ([m (and (eq? 'windows (cross-system-type))
(assq 'ico aux))]) (assq 'ico aux))])
(when m (when m
(replace-all-icos (read-icos (cdr m)) dest-exe))) (replace-all-icos (read-icos (cdr m)) dest-exe)))
(let ([m (and (eq? 'windows (system-type)) (let ([m (and (eq? 'windows (cross-system-type))
(assq 'subsystem aux))]) (assq 'subsystem aux))])
(when m (when m
(set-subsystem dest-exe (cdr m)))))])))) (set-subsystem dest-exe (cdr m)))))]))))

51
racket/collects/launcher/launcher.rkt
View File

@ -8,6 +8,7 @@
compiler/embed compiler/embed
setup/dirs setup/dirs
setup/variant setup/variant
setup/cross-system
compiler/private/winutf16) compiler/private/winutf16)
@ -69,7 +70,7 @@
installed-desktop-path->icon-path) installed-desktop-path->icon-path)
(define current-launcher-variant (define current-launcher-variant
(make-parameter (system-type 'gc) (make-parameter (cross-system-type 'gc)
(lambda (v) (lambda (v)
(unless (memq v '(3m script-3m cgc script-cgc)) (unless (memq v '(3m script-3m cgc script-cgc))
(raise-type-error (raise-type-error
@ -80,8 +81,8 @@
(define (variant-available? kind cased-kind-name variant) (define (variant-available? kind cased-kind-name variant)
(cond (cond
[(or (eq? 'unix (system-type)) [(or (eq? 'unix (cross-system-type))
(and (eq? 'macosx (system-type)) (and (eq? 'macosx (cross-system-type))
(eq? kind 'mzscheme))) (eq? kind 'mzscheme)))
(let ([bin-dir (if (eq? kind 'mzscheme) (let ([bin-dir (if (eq? kind 'mzscheme)
(find-console-bin-dir) (find-console-bin-dir)
@ -94,13 +95,13 @@
[(mzscheme) 'racket] [(mzscheme) 'racket]
[(mred) 'gracket]) [(mred) 'gracket])
(variant-suffix variant #f))))))] (variant-suffix variant #f))))))]
[(eq? 'macosx (system-type)) [(eq? 'macosx (cross-system-type))
;; kind must be mred, because mzscheme case is caught above ;; kind must be mred, because mzscheme case is caught above
(directory-exists? (build-path (find-lib-dir) (directory-exists? (build-path (find-lib-dir)
(format "~a~a.app" (format "~a~a.app"
cased-kind-name cased-kind-name
(variant-suffix variant #f))))] (variant-suffix variant #f))))]
[(eq? 'windows (system-type)) [(eq? 'windows (cross-system-type))
(file-exists? (file-exists?
(build-path (build-path
(if (eq? kind 'mzscheme) (find-console-bin-dir) (find-lib-dir)) (if (eq? kind 'mzscheme) (find-console-bin-dir) (find-lib-dir))
@ -111,7 +112,7 @@
(let* ([cased-kind-name (if (eq? kind 'mzscheme) (let* ([cased-kind-name (if (eq? kind 'mzscheme)
"Racket" "Racket"
"GRacket")] "GRacket")]
[normal-kind (system-type 'gc)] [normal-kind (cross-system-type 'gc)]
[alt-kind (if (eq? '3m normal-kind) [alt-kind (if (eq? '3m normal-kind)
'cgc 'cgc
'3m)] '3m)]
@ -121,7 +122,7 @@
[alt (if (variant-available? kind cased-kind-name alt-kind) [alt (if (variant-available? kind cased-kind-name alt-kind)
(list alt-kind) (list alt-kind)
null)] null)]
[script (if (and (eq? 'macosx (system-type)) [script (if (and (eq? 'macosx (cross-system-type))
(eq? kind 'mred) (eq? kind 'mred)
(pair? normal)) (pair? normal))
(if (eq? normal-kind '3m) (if (eq? normal-kind '3m)
@ -167,7 +168,7 @@
(define (add-file-suffix path variant mred?) (define (add-file-suffix path variant mred?)
(let ([s (variant-suffix (let ([s (variant-suffix
variant variant
(case (system-type) (case (cross-system-type)
[(unix) #f] [(unix) #f]
[(windows) #t] [(windows) #t]
[(macosx) (and mred? (not (script-variant? variant)))]))]) [(macosx) (and mred? (not (script-variant? variant)))]))])
@ -176,7 +177,7 @@
(path-replace-suffix (path-replace-suffix
path path
(string->bytes/utf-8 (string->bytes/utf-8
(if (and (eq? 'windows (system-type)) (if (and (eq? 'windows (cross-system-type))
(regexp-match #rx#"[.]exe$" (path->bytes path))) (regexp-match #rx#"[.]exe$" (path->bytes path)))
(format "~a.exe" s) (format "~a.exe" s)
s)))))) s))))))
@ -295,7 +296,7 @@
(define (has-exe? exe) (define (has-exe? exe)
(or (file-exists? (build-path "/usr/bin" exe)) (or (file-exists? (build-path "/usr/bin" exe))
(file-exists? (build-path "/bin" exe)))) (file-exists? (build-path "/bin" exe))))
(let* ([has-readlink? (and (not (eq? 'macosx (system-type))) (let* ([has-readlink? (and (not (eq? 'macosx (cross-system-type)))
(has-exe? "readlink"))] (has-exe? "readlink"))]
[dest-explode (normalize+explode-path dest)] [dest-explode (normalize+explode-path dest)]
[bindir-explode (normalize+explode-path bindir)]) [bindir-explode (normalize+explode-path bindir)])
@ -364,7 +365,7 @@
(cdr m) (variant-suffix variant #t) (cdr m) (variant-suffix variant #t)
(cdr m) (variant-suffix variant #t))))] (cdr m) (variant-suffix variant #t))))]
[x-flags? (and (eq? kind 'mred) [x-flags? (and (eq? kind 'mred)
(eq? (system-type) 'unix) (eq? (cross-system-type) 'unix)
(not (script-variant? variant)))] (not (script-variant? variant)))]
[flags (let ([m (assq 'wm-class aux)]) [flags (let ([m (assq 'wm-class aux)])
(if m (if m
@ -397,7 +398,7 @@
(if (and m (cdr m)) (if (and m (cdr m))
(find-lib-dir) (find-lib-dir)
(let ([p (path-only dest)]) (let ([p (path-only dest)])
(if (eq? 'macosx (system-type)) (if (eq? 'macosx (cross-system-type))
(build-path p 'up) (build-path p 'up)
p)))) p))))
(find-console-bin-dir))]) (find-console-bin-dir))])
@ -411,7 +412,7 @@
"librktdir" "librktdir"
"bindir") "bindir")
(or alt-exe (case kind (or alt-exe (case kind
[(mred) (if (eq? 'macosx (system-type)) [(mred) (if (eq? 'macosx (cross-system-type))
(format "GRacket~a.app/Contents/MacOS/Gracket" (format "GRacket~a.app/Contents/MacOS/Gracket"
(variant-suffix variant #t)) (variant-suffix variant #t))
"gracket")] "gracket")]
@ -419,7 +420,7 @@
(if alt-exe (if alt-exe
"" ""
(variant-suffix variant (and (eq? kind 'mred) (variant-suffix variant (and (eq? kind 'mred)
(eq? 'macosx (system-type))))) (eq? 'macosx (cross-system-type)))))
pre-str)] pre-str)]
[args (format [args (format
"~a~a ${1+\"$@\"}\n" "~a~a ${1+\"$@\"}\n"
@ -516,7 +517,7 @@
extension)))) extension))))
(define (check-desktop aux dest) (define (check-desktop aux dest)
(when (eq? 'unix (system-type)) (when (eq? 'unix (cross-system-type))
(let ([im (assoc 'install-mode aux)]) (let ([im (assoc 'install-mode aux)])
(when (and im (member (cdr im) '(main user))) (when (and im (member (cdr im) '(main user)))
(define user? (eq? (cdr im) 'user)) (define user? (eq? (cdr im) 'user))
@ -715,7 +716,7 @@
(close-output-port p))))) (close-output-port p)))))
(define (get-maker) (define (get-maker)
(case (system-type) (case (cross-system-type)
[(unix) make-unix-launcher] [(unix) make-unix-launcher]
[(windows) make-windows-launcher] [(windows) make-windows-launcher]
[(macos) make-macos-launcher] [(macos) make-macos-launcher]
@ -880,7 +881,7 @@
(string-downcase (regexp-replace* #px"\\s" file "-"))) (string-downcase (regexp-replace* #px"\\s" file "-")))
(define (sfx file mred?) (define (sfx file mred?)
(case (system-type) (case (cross-system-type)
[(unix) (unix-sfx file mred?)] [(unix) (unix-sfx file mred?)]
[(windows) [(windows)
(string-append (if mred? file (unix-sfx file mred?)) ".exe")] (string-append (if mred? file (unix-sfx file mred?)) ".exe")]
@ -888,7 +889,7 @@
(define (program-launcher-path name mred? user?) (define (program-launcher-path name mred? user?)
(let* ([variant (current-launcher-variant)] (let* ([variant (current-launcher-variant)]
[mac-script? (and (eq? (system-type) 'macosx) [mac-script? (and (eq? (cross-system-type) 'macosx)
(script-variant? variant))]) (script-variant? variant))])
(let ([p (add-file-suffix (let ([p (add-file-suffix
(build-path (build-path
@ -902,7 +903,7 @@
((if mac-script? unix-sfx sfx) name mred?)) ((if mac-script? unix-sfx sfx) name mred?))
variant variant
mred?)]) mred?)])
(if (and (eq? (system-type) 'macosx) (if (and (eq? (cross-system-type) 'macosx)
(not (script-variant? variant))) (not (script-variant? variant)))
(path-replace-suffix p #".app") (path-replace-suffix p #".app")
p)))) p))))
@ -913,7 +914,7 @@
(gracket-program-launcher-path name #:user? user?)) (gracket-program-launcher-path name #:user? user?))
(define (racket-program-launcher-path name #:user? [user? #f]) (define (racket-program-launcher-path name #:user? [user? #f])
(case (system-type) (case (cross-system-type)
[(macosx) [(macosx)
(add-file-suffix (build-path (if user? (add-file-suffix (build-path (if user?
(find-user-console-bin-dir) (find-user-console-bin-dir)
@ -935,7 +936,7 @@
#f) #f)
(define (gracket-launcher-is-actually-directory?) (define (gracket-launcher-is-actually-directory?)
(and (eq? 'macosx (system-type)) (and (eq? 'macosx (cross-system-type))
(not (script-variant? (current-launcher-variant))))) (not (script-variant? (current-launcher-variant)))))
(define (mred-launcher-is-actually-directory?) (define (mred-launcher-is-actually-directory?)
(gracket-launcher-is-actually-directory?)) (gracket-launcher-is-actually-directory?))
@ -963,16 +964,16 @@
(define (gracket-launcher-put-file-extension+style+filters) (define (gracket-launcher-put-file-extension+style+filters)
(put-file-extension+style+filters (put-file-extension+style+filters
(if (and (eq? 'macosx (system-type)) (if (and (eq? 'macosx (cross-system-type))
(script-variant? (current-launcher-variant))) (script-variant? (current-launcher-variant)))
'unix 'unix
(system-type)))) (cross-system-type))))
(define (mred-launcher-put-file-extension+style+filters) (define (mred-launcher-put-file-extension+style+filters)
(gracket-launcher-put-file-extension+style+filters)) (gracket-launcher-put-file-extension+style+filters))
(define (racket-launcher-put-file-extension+style+filters) (define (racket-launcher-put-file-extension+style+filters)
(put-file-extension+style+filters (put-file-extension+style+filters
(if (eq? 'macosx (system-type)) 'unix (system-type)))) (if (eq? 'macosx (cross-system-type)) 'unix (cross-system-type))))
(define (mzscheme-launcher-put-file-extension+style+filters) (define (mzscheme-launcher-put-file-extension+style+filters)
(racket-launcher-put-file-extension+style+filters)) (racket-launcher-put-file-extension+style+filters))
@ -991,7 +992,7 @@
;; overwritten at that time. So we assume ;; overwritten at that time. So we assume
;; that a Setup-PLT-style independent launcher ;; that a Setup-PLT-style independent launcher
;; is always up-to-date. ;; is always up-to-date.
[(eq? 'windows (system-type)) [(eq? 'windows (cross-system-type))
(and (let ([m (assq 'independent? aux)]) (and m (cdr m))) (and (let ([m (assq 'independent? aux)]) (and m (cdr m)))
(file-exists? dest))] (file-exists? dest))]
;; For any other setting, we could implement ;; For any other setting, we could implement

2
racket/collects/pkg/lib.rkt
View File

@ -280,5 +280,5 @@
[pkg-directory->additional-installs (->* (path-string? string?) [pkg-directory->additional-installs (->* (path-string? string?)
(#:namespace namespace? (#:namespace namespace?
#:system-type (or/c #f symbol?) #:system-type (or/c #f symbol?)
#:system-library-subpath (or/c #f path?)) #:system-library-subpath (or/c #f path-for-some-system?))
(listof (cons/c symbol? string?)))])) (listof (cons/c symbol? string?)))]))

1
racket/collects/pkg/private/addl-installs.rkt
View File

@ -111,6 +111,7 @@
(define v (i 'install-platform (lambda () #rx""))) (define v (i 'install-platform (lambda () #rx"")))
(or (not (platform-spec? v)) (or (not (platform-spec? v))
(matching-platform? v (matching-platform? v
#:cross? #t
#:system-type sys-type #:system-type sys-type
#:system-library-subpath sys-lib-subpath))) #:system-library-subpath sys-lib-subpath)))
(set-union (extract-documents i) (set-union (extract-documents i)

2
racket/collects/pkg/private/dep.rkt
View File

@ -32,5 +32,5 @@
(define (dependency-this-platform? dep) (define (dependency-this-platform? dep)
(define p (dependency-lookup '#:platform dep)) (define p (dependency-lookup '#:platform dep))
(or (not p) (matching-platform? p))) (or (not p) (matching-platform? p #:cross? #t)))

5
racket/collects/pkg/strip.rkt
View File

@ -9,6 +9,7 @@
racket/list racket/list
racket/set racket/set
racket/format racket/format
setup/cross-system
setup/private/dylib setup/private/dylib
setup/private/elf) setup/private/elf)
@ -425,11 +426,11 @@
(fixup uncopied))))) (fixup uncopied)))))
(unmove-tag 'move-foreign-libs find-user-lib-dir (unmove-tag 'move-foreign-libs find-user-lib-dir
(case (system-type) (case (cross-system-type)
[(macosx) [(macosx)
adjust-dylib-path/uninstall] adjust-dylib-path/uninstall]
[else void]) [else void])
(case (system-type) (case (cross-system-type)
[(unix) [(unix)
copy-file/uninstall-elf-rpath] copy-file/uninstall-elf-rpath]
[else [else

77
racket/collects/setup/cross-system.rkt Normal file
View File

@ -0,0 +1,77 @@
#lang racket/base
(require "private/dirs.rkt")
(provide cross-system-type
cross-system-library-subpath
cross-installation?)
(define cross-system-table #f)
(define system-type-symbols '(os word gc link machine so-suffix so-mode fs-change))
(define (compute-cross!)
(unless cross-system-table
(define lib-dir (find-lib-dir))
(define ht (and lib-dir
(let ([f (build-path lib-dir "system.rktd")])
(and (file-exists? f)
(let ([ht (call-with-input-file*
f
read)])
(and (hash? ht)
(for/and ([sym (in-list (list*
'library-subpath
'library-subpath-convention
system-type-symbols))])
(hash-ref ht sym #f))
(not
(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? (bytes->path (hash-ref ht 'library-subpath)
(hash-ref ht 'library-subpath-convention))
(system-library-subpath #f))))
ht))))))
(if ht
(set! cross-system-table ht)
(set! cross-system-table #hasheq()))))
(define cross-system-type
(case-lambda
[()
(compute-cross!)
(or (hash-ref cross-system-table 'os #f)
(system-type 'os))]
[(mode)
(unless (memq mode system-type-symbols)
(raise-argument-error
'cross-system-type
"(or/c 'os 'word 'gc 'link 'machine 'so-suffix 'so-mode 'fs-change)"
mode))
(compute-cross!)
(or (hash-ref cross-system-table mode #f)
(system-type mode))]))
(define (cross-system-library-subpath [mode (begin
(compute-cross!)
(cross-system-type 'gc))])
(unless (memq mode '(#f 3m cgc))
(raise-argument-error
'cross-system-library-subtype
"(or/c #f '3m 'cgc)"
mode))
(compute-cross!)
(define bstr (hash-ref cross-system-table 'library-subpath #f))
(cond
[bstr
(define conv (hash-ref cross-system-table 'library-subpath-convention))
(define path (bytes->path bstr conv))
(case mode
[(#f cgc) path]
[(3m) (build-path path (bytes->path #"3m" conv))])]
[else (system-library-subpath mode)]))
(define (cross-installation?)
(compute-cross!)
(positive? (hash-count cross-system-table)))

320
racket/collects/setup/dirs.rkt
View File

@ -1,268 +1,15 @@
#lang racket/base #lang racket/base
(require racket/promise (require racket/promise
compiler/private/winutf16 compiler/private/winutf16
compiler/private/mach-o compiler/private/mach-o
'#%utils setup/cross-system
(for-syntax racket/base)) "private/dirs.rkt")
;; ---------------------------------------- (provide (except-out (all-from-out "private/dirs.rkt")
;; "config" config:dll-dir
config:bin-dir
(define (find-config-dir) define-finder)
(find-main-config)) find-dll-dir)
(provide find-config-dir)
;; ----------------------------------------
;; config: definitions
(define config-table
(delay/sync
(let ([d (find-config-dir)])
(if d
(let ([p (build-path d "config.rktd")])
(if (file-exists? p)
(call-with-input-file*
p
(lambda (in)
(call-with-default-reading-parameterization
(lambda ()
(read in)))))
#hash()))
#hash()))))
(define (to-path l)
(cond [(string? l) (simplify-path (complete-path (string->path l)))]
[(bytes? l) (simplify-path (complete-path (bytes->path l)))]
[(list? l) (map to-path l)]
[else l]))
(define (complete-path p)
(cond [(complete-path? p) p]
[else
(path->complete-path
p
(find-main-collects))]))
(define-syntax-rule (define-config name key wrap)
(define name (delay/sync
(wrap
(hash-ref (force config-table) key #f)))))
(define-config config:collects-search-dirs 'collects-search-dirs to-path)
(define-config config:doc-dir 'doc-dir to-path)
(define-config config:doc-search-dirs 'doc-search-dirs to-path)
(define-config config:dll-dir 'dll-dir to-path)
(define-config config:lib-dir 'lib-dir to-path)
(define-config config:lib-search-dirs 'lib-search-dirs to-path)
(define-config config:share-dir 'share-dir to-path)
(define-config config:apps-dir 'apps-dir to-path)
(define-config config:include-dir 'include-dir to-path)
(define-config config:include-search-dirs 'include-search-dirs to-path)
(define-config config:bin-dir 'bin-dir to-path)
(define-config config:man-dir 'man-dir to-path)
(define-config config:links-file 'links-file to-path)
(define-config config:links-search-files 'links-search-files to-path)
(define-config config:pkgs-dir 'pkgs-dir to-path)
(define-config config:pkgs-search-dirs 'pkgs-search-dirs to-path)
(define-config config:cgc-suffix 'cgc-suffix values)
(define-config config:3m-suffix '3m-suffix values)
(define-config config:absolute-installation? 'absolute-installation? (lambda (x) (and x #t)))
(define-config config:doc-search-url 'doc-search-url values)
(define-config config:doc-open-url 'doc-open-url values)
(define-config config:installation-name 'installation-name values)
(define-config config:build-stamp 'build-stamp values)
(provide get-absolute-installation?
get-cgc-suffix
get-3m-suffix
get-doc-search-url
get-doc-open-url
get-installation-name
get-build-stamp)
(define (get-absolute-installation?) (force config:absolute-installation?))
(define (get-cgc-suffix) (force config:cgc-suffix))
(define (get-3m-suffix) (force config:3m-suffix))
(define (get-doc-search-url) (or (force config:doc-search-url)
"http://docs.racket-lang.org/local-redirect/index.html"))
(define (get-doc-open-url) (force config:doc-open-url))
(define (get-installation-name) (or (force config:installation-name)
(version)))
(define (get-build-stamp) (force config:build-stamp))
;; ----------------------------------------
;; "collects"
(provide find-collects-dir
get-main-collects-search-dirs
find-user-collects-dir
get-collects-search-dirs)
(define (find-collects-dir)
(find-main-collects))
(define (get-main-collects-search-dirs)
(combine-search (force config:collects-search-dirs)
(list (find-collects-dir))))
(define user-collects-dir
(delay/sync (simplify-path (build-path (find-system-path 'addon-dir)
(get-installation-name)
"collects"))))
(define (find-user-collects-dir)
(force user-collects-dir))
(define (get-collects-search-dirs)
(current-library-collection-paths))
;; ----------------------------------------
;; Helpers
(define (single p) (if p (list p) null))
(define (extra a l) (if (and a (not (member (path->directory-path a)
(map path->directory-path l))))
(append l (list a))
l))
(define (combine-search l default)
;; Replace #f in list with default path:
(if l
(let loop ([l l])
(cond
[(null? l) null]
[(not (car l)) (append default (loop (cdr l)))]
[else (cons (car l) (loop (cdr l)))]))
default))
(define (cons-user u r)
(if (and u (use-user-specific-search-paths))
(cons u r)
r))
(define (get-false) #f)
(define (chain-to f) f)
(define-syntax (define-finder stx)
(syntax-case stx (get-false chain-to)
[(_ provide config:id id user-id #:default user-default default)
#'
(begin
(define-finder provide config:id id get-false default)
(provide user-id)
(define user-dir
(delay/sync (simplify-path (build-path (find-system-path 'addon-dir)
(get-installation-name)
user-default))))
(define (user-id)
(force user-dir)))]
[(_ provide config:id id user-id config:search-id search-id default)
#'
(begin
(define-finder provide config:id id user-id default)
(provide search-id)
(define (search-id)
(combine-search (force config:search-id)
(cons-user (user-id) (single (id))))))]
[(_ provide config:id id user-id config:search-id search-id
extra-search-dir default)
#'
(begin
(define-finder provide config:id id user-id default)
(provide search-id)
(define (search-id)
(combine-search (force config:search-id)
(extra (extra-search-dir)
(cons-user (user-id) (single (id)))))))]
[(_ provide config:id id get-false (chain-to get-default))
(with-syntax ([dir (generate-temporaries #'(id))])
#'(begin
(provide id)
(define dir
(delay/sync
(or (force config:id) (get-default))))
(define (id)
(force dir))))]
[(_ provide config:id id get-false default)
(with-syntax ([dir (generate-temporaries #'(id))])
#'(begin
(provide id)
(define dir
(delay/sync
(or (force config:id)
(let ([p (find-collects-dir)])
(and p (simplify-path (build-path p 'up default)))))))
(define (id)
(force dir))))]
[(_ provide config:id id user-id default)
#'(define-finder provide config:id id user-id #:default default default)]))
(define-syntax no-provide (syntax-rules () [(_ . rest) (begin)]))
;; ----------------------------------------
;; "doc"
(define delayed-#f (delay/sync #f))
(provide find-doc-dir
find-user-doc-dir
get-doc-search-dirs)
(define-finder no-provide
config:doc-dir
find-doc-dir
find-user-doc-dir
delayed-#f
get-new-doc-search-dirs
"doc")
;; For now, include "doc" pseudo-collections in search path:
(define (get-doc-search-dirs)
(combine-search (force config:doc-search-dirs)
(append (get-new-doc-search-dirs)
(map (lambda (p) (build-path p "doc"))
(current-library-collection-paths)))))
;; ----------------------------------------
;; "include"
(define-finder provide
config:include-dir
find-include-dir
find-user-include-dir
config:include-search-dirs
get-include-search-dirs
"include")
;; ----------------------------------------
;; "lib"
(define-finder provide
config:lib-dir
find-lib-dir
find-user-lib-dir
config:lib-search-dirs
get-lib-search-dirs
"lib")
;; ----------------------------------------
;; "share"
(define-finder provide
config:share-dir
find-share-dir
find-user-share-dir
"share")
;; ----------------------------------------
;; "apps"
(define-finder provide
config:apps-dir
find-apps-dir
find-user-apps-dir #:default (build-path "share" "applications")
(chain-to (lambda () (build-path (find-share-dir) "applications"))))
;; ----------------------------------------
;; "man"
(define-finder provide
config:man-dir
find-man-dir
find-user-man-dir
"man")
;; ---------------------------------------- ;; ----------------------------------------
;; Executables ;; Executables
@ -271,7 +18,7 @@
config:bin-dir config:bin-dir
find-console-bin-dir find-console-bin-dir
find-user-console-bin-dir find-user-console-bin-dir
(case (system-type) (case (cross-system-type)
[(windows) 'same] [(windows) 'same]
[(macosx unix) "bin"])) [(macosx unix) "bin"]))
@ -279,7 +26,7 @@
config:bin-dir config:bin-dir
find-gui-bin-dir find-gui-bin-dir
find-user-gui-bin-dir find-user-gui-bin-dir
(case (system-type) (case (cross-system-type)
[(windows macosx) 'same] [(windows macosx) 'same]
[(unix) "bin"])) [(unix) "bin"]))
@ -289,8 +36,9 @@
(provide find-dll-dir) (provide find-dll-dir)
(define dll-dir (define dll-dir
(delay/sync (delay/sync
(case (system-type) (case (cross-system-type)
[(windows) [(windows)
(if (eq? (system-type) 'windows)
;; Extract "lib" location from binary: ;; Extract "lib" location from binary:
(let ([exe (parameterize ([current-directory (find-system-path 'orig-dir)]) (let ([exe (parameterize ([current-directory (find-system-path 'orig-dir)])
(find-executable-path (find-system-path 'exec-file)))]) (find-executable-path (find-system-path 'exec-file)))])
@ -311,8 +59,11 @@
#f #f
;; resolve relative directory: ;; resolve relative directory:
(let ([p (bytes->path (utf-16-bytes->bytes (cadr m)))]) (let ([p (bytes->path (utf-16-bytes->bytes (cadr m)))])
(path->complete-path p dir)))))))))] (path->complete-path p dir)))))))))
;; Cross-compile: assume it's "lib"
(find-lib-dir))]
[(macosx) [(macosx)
(if (eq? (system-type) 'macosx)
(let* ([exe (parameterize ([current-directory (find-system-path 'orig-dir)]) (let* ([exe (parameterize ([current-directory (find-system-path 'orig-dir)])
(let loop ([p (find-executable-path (let loop ([p (find-executable-path
(find-system-path 'exec-file))]) (find-system-path 'exec-file))])
@ -349,46 +100,13 @@
dir dir
(build-path dir (bytes->path b))))) (build-path dir (bytes->path b)))))
(find-system-path 'orig-dir))))))] (find-system-path 'orig-dir))))))]
[else (find-lib-dir)]))] [else (find-lib-dir)]))
;; Cross-compile: assume it's "lib"
(find-lib-dir))]
[else [else
(if (eq? 'shared (system-type 'link)) (if (eq? 'shared (cross-system-type 'link))
(or (force config:dll-dir) (find-lib-dir)) (or (force config:dll-dir) (find-lib-dir))
#f)]))) #f)])))
(define (find-dll-dir) (define (find-dll-dir)
(force dll-dir)) (force dll-dir))
;; ----------------------------------------
;; Links files
(provide find-links-file
get-links-search-files
find-user-links-file)
(define (find-links-file)
(or (force config:links-file)
(build-path (find-share-dir) "links.rktd")))
(define (get-links-search-files)
(combine-search (force config:links-search-files)
(list (find-links-file))))
(define (find-user-links-file [vers (get-installation-name)])
(build-path (find-system-path 'addon-dir)
vers
"links.rktd"))
;; ----------------------------------------
;; Packages
(define-finder provide
config:pkgs-dir
find-pkgs-dir
get-false
config:pkgs-search-dirs
get-pkgs-search-dirs
(chain-to (lambda () (build-path (find-share-dir) "pkgs"))))
(provide find-user-pkgs-dir)
(define (find-user-pkgs-dir [vers (get-installation-name)])
(build-path (find-system-path 'addon-dir)
vers
"pkgs"))

18
racket/collects/setup/matching-platform.rkt
View File

@ -1,4 +1,5 @@
#lang racket/base #lang racket/base
(require setup/cross-system)
(provide platform-spec? (provide platform-spec?
matching-platform?) matching-platform?)
@ -7,20 +8,27 @@
(or (symbol? p) (string? p) (regexp? p))) (or (symbol? p) (string? p) (regexp? p)))
(define (matching-platform? p (define (matching-platform? p
#:cross? [cross? #f]
#:system-type [sys-type #f] #:system-type [sys-type #f]
#:system-library-subpath [sys-lib-subpath #f]) #:system-library-subpath [sys-lib-subpath #f])
(unless (platform-spec? p) (unless (platform-spec? p)
(raise-argument-error 'matching-platform? "platform-spec?" p)) (raise-argument-error 'matching-platform? "platform-spec?" p))
(unless (or (not sys-type) (symbol? sys-type)) (unless (or (not sys-type) (symbol? sys-type))
(raise-argument-error 'matching-platform? "(or/c symbol? #f)" sys-type)) (raise-argument-error 'matching-platform? "(or/c symbol? #f)" sys-type))
(unless (or (not sys-lib-subpath) (path? sys-lib-subpath)) (unless (or (not sys-lib-subpath) (path-for-some-system? sys-lib-subpath))
(raise-argument-error 'matching-platform? "(or/c path? #f)" sys-lib-subpath)) (raise-argument-error 'matching-platform? "(or/c path-for-some-system? #f)" sys-lib-subpath))
(cond (cond
[(symbol? p) [(symbol? p)
(eq? p (or sys-type (system-type)))] (eq? p (or sys-type (if cross?
(cross-system-type)
(system-type))))]
[else [else
(define s (path->string (or sys-lib-subpath (define s (bytes->string/utf-8
(system-library-subpath #f)))) (path->bytes
(or sys-lib-subpath
(if cross?
(cross-system-library-subpath #f)
(system-library-subpath #f))))))
(cond (cond
[(regexp? p) [(regexp? p)
(regexp-match? p s)] (regexp-match? p s)]

6
racket/collects/setup/parallel-do.rkt
View File

@ -9,6 +9,7 @@
racket/path racket/path
racket/class racket/class
racket/stxparam racket/stxparam
setup/dirs
(for-syntax syntax/parse (for-syntax syntax/parse
racket/base)) racket/base))
@ -73,7 +74,10 @@
(define/public (spawn _id _module-path _funcname [initialmsg #f]) (define/public (spawn _id _module-path _funcname [initialmsg #f])
(set! module-path _module-path) (set! module-path _module-path)
(set! funcname _funcname) (set! funcname _funcname)
(define worker-cmdline-list (list (current-executable-path) "-X" (path->string (current-collects-path)) "-e" "(eval(read))")) (define worker-cmdline-list (list (current-executable-path)
"-X" (path->string (current-collects-path))
"-G" (path->string (find-config-dir))
"-e" "(eval(read))"))
(define dynamic-require-cmd `((dynamic-require (string->path ,module-path) (quote ,funcname)) #f)) (define dynamic-require-cmd `((dynamic-require (string->path ,module-path) (quote ,funcname)) #f))
(let-values ([(_process-handle _out _in _err) (apply subprocess #f #f (current-error-port) worker-cmdline-list)]) (let-values ([(_process-handle _out _in _err) (apply subprocess #f #f (current-error-port) worker-cmdline-list)])
(set! id _id) (set! id _id)

314
racket/collects/setup/private/dirs.rkt Normal file
View File

@ -0,0 +1,314 @@
#lang racket/base
(require racket/promise
'#%utils
(for-syntax racket/base))
;; ----------------------------------------
;; "config"
(define (find-config-dir)
(find-main-config))
(provide find-config-dir)
;; ----------------------------------------
;; config: definitions
(define config-table
(delay/sync
(let ([d (find-config-dir)])
(if d
(let ([p (build-path d "config.rktd")])
(if (file-exists? p)
(call-with-input-file*
p
(lambda (in)
(call-with-default-reading-parameterization
(lambda ()
(read in)))))
#hash()))
#hash()))))
(define (to-path l)
(cond [(string? l) (simplify-path (complete-path (string->path l)))]
[(bytes? l) (simplify-path (complete-path (bytes->path l)))]
[(list? l) (map to-path l)]
[else l]))
(define (complete-path p)
(cond [(complete-path? p) p]
[else
(path->complete-path
p
(find-main-collects))]))
(define-syntax-rule (define-config name key wrap)
(define name (delay/sync
(wrap
(hash-ref (force config-table) key #f)))))
(define-config config:collects-search-dirs 'collects-search-dirs to-path)
(define-config config:doc-dir 'doc-dir to-path)
(define-config config:doc-search-dirs 'doc-search-dirs to-path)
(define-config config:dll-dir 'dll-dir to-path)
(define-config config:lib-dir 'lib-dir to-path)
(define-config config:lib-search-dirs 'lib-search-dirs to-path)
(define-config config:share-dir 'share-dir to-path)
(define-config config:apps-dir 'apps-dir to-path)
(define-config config:include-dir 'include-dir to-path)
(define-config config:include-search-dirs 'include-search-dirs to-path)
(define-config config:bin-dir 'bin-dir to-path)
(define-config config:man-dir 'man-dir to-path)
(define-config config:links-file 'links-file to-path)
(define-config config:links-search-files 'links-search-files to-path)
(define-config config:pkgs-dir 'pkgs-dir to-path)
(define-config config:pkgs-search-dirs 'pkgs-search-dirs to-path)
(define-config config:cgc-suffix 'cgc-suffix values)
(define-config config:3m-suffix '3m-suffix values)
(define-config config:absolute-installation? 'absolute-installation? (lambda (x) (and x #t)))
(define-config config:doc-search-url 'doc-search-url values)
(define-config config:doc-open-url 'doc-open-url values)
(define-config config:installation-name 'installation-name values)
(define-config config:build-stamp 'build-stamp values)
(provide get-absolute-installation?
get-cgc-suffix
get-3m-suffix
get-doc-search-url
get-doc-open-url
get-installation-name
get-build-stamp)
(define (get-absolute-installation?) (force config:absolute-installation?))
(define (get-cgc-suffix) (force config:cgc-suffix))
(define (get-3m-suffix) (force config:3m-suffix))
(define (get-doc-search-url) (or (force config:doc-search-url)
"http://docs.racket-lang.org/local-redirect/index.html"))
(define (get-doc-open-url) (force config:doc-open-url))
(define (get-installation-name) (or (force config:installation-name)
(version)))
(define (get-build-stamp) (force config:build-stamp))
;; ----------------------------------------
;; "collects"
(provide find-collects-dir
get-main-collects-search-dirs
find-user-collects-dir
get-collects-search-dirs)
(define (find-collects-dir)
(find-main-collects))
(define (get-main-collects-search-dirs)
(combine-search (force config:collects-search-dirs)
(list (find-collects-dir))))
(define user-collects-dir
(delay/sync (simplify-path (build-path (find-system-path 'addon-dir)
(get-installation-name)
"collects"))))
(define (find-user-collects-dir)
(force user-collects-dir))
(define (get-collects-search-dirs)
(current-library-collection-paths))
;; ----------------------------------------
;; Helpers
(define (single p) (if p (list p) null))
(define (extra a l) (if (and a (not (member (path->directory-path a)
(map path->directory-path l))))
(append l (list a))
l))
(define (combine-search l default)
;; Replace #f in list with default path:
(if l
(let loop ([l l])
(cond
[(null? l) null]
[(not (car l)) (append default (loop (cdr l)))]
[else (cons (car l) (loop (cdr l)))]))
default))
(define (cons-user u r)
(if (and u (use-user-specific-search-paths))
(cons u r)
r))
(define (get-false) #f)
(define (chain-to f) f)
(define-syntax (define-finder stx)
(syntax-case stx (get-false chain-to)
[(_ provide config:id id user-id #:default user-default default)
#'
(begin
(define-finder provide config:id id get-false default)
(provide user-id)
(define user-dir
(delay/sync (simplify-path (build-path (find-system-path 'addon-dir)
(get-installation-name)
user-default))))
(define (user-id)
(force user-dir)))]
[(_ provide config:id id user-id config:search-id search-id default)
#'
(begin
(define-finder provide config:id id user-id default)
(provide search-id)
(define (search-id)
(combine-search (force config:search-id)
(cons-user (user-id) (single (id))))))]
[(_ provide config:id id user-id config:search-id search-id
extra-search-dir default)
#'
(begin
(define-finder provide config:id id user-id default)
(provide search-id)
(define (search-id)
(combine-search (force config:search-id)
(extra (extra-search-dir)
(cons-user (user-id) (single (id)))))))]
[(_ provide config:id id get-false (chain-to get-default))
(with-syntax ([dir (generate-temporaries #'(id))])
#'(begin
(provide id)
(define dir
(delay/sync
(or (force config:id) (get-default))))
(define (id)
(force dir))))]
[(_ provide config:id id get-false default)
(with-syntax ([dir (generate-temporaries #'(id))])
#'(begin
(provide id)
(define dir
(delay/sync
(or (force config:id)
(let ([p (find-collects-dir)])
(and p (simplify-path (build-path p 'up default)))))))
(define (id)
(force dir))))]
[(_ provide config:id id user-id default)
#'(define-finder provide config:id id user-id #:default default default)]))
(define-syntax no-provide (syntax-rules () [(_ . rest) (begin)]))
(provide define-finder)
;; ----------------------------------------
;; "doc"
(define delayed-#f (delay/sync #f))
(provide find-doc-dir
find-user-doc-dir
get-doc-search-dirs)
(define-finder no-provide
config:doc-dir
find-doc-dir
find-user-doc-dir
delayed-#f
get-new-doc-search-dirs
"doc")
;; For now, include "doc" pseudo-collections in search path:
(define (get-doc-search-dirs)
(combine-search (force config:doc-search-dirs)
(append (get-new-doc-search-dirs)
(map (lambda (p) (build-path p "doc"))
(current-library-collection-paths)))))
;; ----------------------------------------
;; "include"
(define-finder provide
config:include-dir
find-include-dir
find-user-include-dir
config:include-search-dirs
get-include-search-dirs
"include")
;; ----------------------------------------
;; "lib"
(define-finder provide
config:lib-dir
find-lib-dir
find-user-lib-dir
config:lib-search-dirs
get-lib-search-dirs
"lib")
;; ----------------------------------------
;; "share"
(define-finder provide
config:share-dir
find-share-dir
find-user-share-dir
"share")
;; ----------------------------------------
;; "apps"
(define-finder provide
config:apps-dir
find-apps-dir
find-user-apps-dir #:default (build-path "share" "applications")
(chain-to (lambda () (build-path (find-share-dir) "applications"))))
;; ----------------------------------------
;; "man"
(define-finder provide
config:man-dir
find-man-dir
find-user-man-dir
"man")
;; ----------------------------------------
;; Executables
;; `setup/dirs`
(provide config:bin-dir)
;; ----------------------------------------
;; DLLs
;; See `setup/dirs`
(provide config:dll-dir)
;; ----------------------------------------
;; Links files
(provide find-links-file
get-links-search-files
find-user-links-file)
(define (find-links-file)
(or (force config:links-file)
(build-path (find-share-dir) "links.rktd")))
(define (get-links-search-files)
(combine-search (force config:links-search-files)
(list (find-links-file))))
(define (find-user-links-file [vers (get-installation-name)])
(build-path (find-system-path 'addon-dir)
vers
"links.rktd"))
;; ----------------------------------------
;; Packages
(define-finder provide
config:pkgs-dir
find-pkgs-dir
get-false
config:pkgs-search-dirs
get-pkgs-search-dirs
(chain-to (lambda () (build-path (find-share-dir) "pkgs"))))
(provide find-user-pkgs-dir)
(define (find-user-pkgs-dir [vers (get-installation-name)])
(build-path (find-system-path 'addon-dir)
vers
"pkgs"))

16
racket/collects/setup/setup-core.rkt
View File

@ -15,6 +15,7 @@
planet/planet-archives planet/planet-archives
planet/private/planet-shared planet/private/planet-shared
(only-in planet/resolver resolve-planet-path) (only-in planet/resolver resolve-planet-path)
setup/cross-system
"option.rkt" "option.rkt"
compiler/compiler compiler/compiler
@ -880,7 +881,7 @@
(string? v) (string? v)
(symbol? v)) (symbol? v))
(error "entry is not regexp, string, or symbol:" v))))) (error "entry is not regexp, string, or symbol:" v)))))
(matching-platform? sys)) (matching-platform? sys #:cross? #t))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Make zo ;; ;; Make zo ;;
@ -1407,7 +1408,7 @@
[(console) (path->relative-string/console-bin p)] [(console) (path->relative-string/console-bin p)]
[else (error 'make-launcher "internal error (~s)" kind)]) [else (error 'make-launcher "internal error (~s)" kind)])
(let ([v (current-launcher-variant)]) (let ([v (current-launcher-variant)])
(if (eq? v (system-type 'gc)) "" (format " [~a]" v)))) (if (eq? v (cross-system-type 'gc)) "" (format " [~a]" v))))
(make-launcher (make-launcher
(or mzlf (or mzlf
(if (cc-collection cc) (if (cc-collection cc)
@ -1563,7 +1564,7 @@
(setup-printf "deleting" "launcher ~a" rel-exe-path) (setup-printf "deleting" "launcher ~a" rel-exe-path)
(delete-directory/files exe-path)]) (delete-directory/files exe-path)])
;; Clean up any associated .desktop file and icon file: ;; Clean up any associated .desktop file and icon file:
(when (eq? 'unix (system-type)) (when (eq? 'unix (cross-system-type))
(let ([desktop (installed-executable-path->desktop-path (let ([desktop (installed-executable-path->desktop-path
exe-path exe-path
user?)]) user?)])
@ -1780,11 +1781,11 @@
(error "entry is not a list of relative path strings:" l))) (error "entry is not a list of relative path strings:" l)))
build-path build-path
this-platform? this-platform?
(case (system-type) (case (cross-system-type)
[(macosx) [(macosx)
adjust-dylib-path/install] adjust-dylib-path/install]
[else void]) [else void])
(case (system-type) (case (cross-system-type)
[(unix) [(unix)
copy-file/install-elf-rpath] copy-file/install-elf-rpath]
[else copy-file]))) [else copy-file])))
@ -1905,7 +1906,8 @@
;; setup Body ;; ;; setup Body ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setup-printf "version" "~a [~a]" (version) (system-type 'gc)) (setup-printf "version" "~a" (version))
(setup-printf "platform" "~a [~a]" (cross-system-library-subpath #f) (cross-system-type 'gc))
(setup-printf "installation name" "~a" (get-installation-name)) (setup-printf "installation name" "~a" (get-installation-name))
(setup-printf "variants" "~a" (string-join (map symbol->string (available-mzscheme-variants)) ", ")) (setup-printf "variants" "~a" (string-join (map symbol->string (available-mzscheme-variants)) ", "))
(setup-printf "main collects" "~a" main-collects-dir) (setup-printf "main collects" "~a" main-collects-dir)
@ -1943,7 +1945,7 @@
(when (make-launchers) (make-launchers-step)) (when (make-launchers) (make-launchers-step))
(when (make-launchers) (when (make-launchers)
(unless (eq? 'windows (system-type)) (unless (eq? 'windows (cross-system-type))
(make-mans-step))) (make-mans-step)))
(when make-docs? (when make-docs?

10
racket/collects/setup/variant.rkt
View File

@ -1,11 +1,17 @@
#lang racket/base #lang racket/base
(require setup/dirs racket/promise) (require setup/dirs
setup/cross-system
racket/promise)
(provide variant-suffix) (provide variant-suffix)
(define plain-mz-is-cgc? (define plain-mz-is-cgc?
(delay/sync (delay/sync
(cond
[(cross-installation?)
(eq? 'cgc (cross-system-type 'gc))]
[else
(let* ([dir (find-console-bin-dir)] (let* ([dir (find-console-bin-dir)]
[exe (cond [(eq? 'windows (system-type)) "Racket.exe"] [exe (cond [(eq? 'windows (system-type)) "Racket.exe"]
[(equal? #".dll" (system-type 'so-suffix)) [(equal? #".dll" (system-type 'so-suffix))
@ -17,7 +23,7 @@
(with-input-from-file f (with-input-from-file f
(lambda () (lambda ()
(regexp-match? #rx#"bINARy tYPe:..c" (regexp-match? #rx#"bINARy tYPe:..c"
(current-input-port)))))))) (current-input-port))))))])))
(define (variant-suffix variant cased?) (define (variant-suffix variant cased?)
(let ([r (case variant (let ([r (case variant

18
racket/src/racket/Makefile.in
View File

@ -86,6 +86,10 @@ common:
$(MAKE) @FOREIGNTARGET@ $(MAKE) @FOREIGNTARGET@
cgc: cgc:
$(MAKE) cgc-core
$(MAKE) sysinfer@CGC@
cgc-core:
$(MAKE) common $(MAKE) common
$(MAKE) dynlib $(MAKE) dynlib
$(MAKE) mzlibrary $(MAKE) mzlibrary
@ -98,9 +102,10 @@ cgc:
cd dynsrc; $(MAKE) dynlib3m cd dynsrc; $(MAKE) dynlib3m
cd gc2; $(MAKE) ../racket@MMM@ cd gc2; $(MAKE) ../racket@MMM@
cd gc2; $(MAKE) ../mzcom@MMM@ cd gc2; $(MAKE) ../mzcom@MMM@
$(MAKE) sysinfer@MMM@
both: both:
$(MAKE) cgc $(MAKE) cgc-core
$(MAKE) 3m $(MAKE) 3m
oskit: oskit:
@ -157,6 +162,16 @@ no-cgc-needed:
$(MAKE) mingw-other $(MAKE) mingw-other
cd dynsrc; $(MAKE) ../starter@EXE_SUFFIX@ cd dynsrc; $(MAKE) ../starter@EXE_SUFFIX@
ALL_CPPFLAGS = -I$(builddir) -I$(srcdir)/include -I$(srcdir)/src $(CPPFLAGS) @OPTIONS@ @GC2OPTIONS@ @MZOPTIONS@
MKSYSTEM_ARGS = -cqu $(srcdir)/mksystem.rkt system.rktd "$(CPP) $(ALL_CPPFLAGS) $(srcdir)/src/systype.c" "@MMM_INSTALLED@"
sysinfer@CGC@:
@RUN_RACKET_CGC@ $(MKSYSTEM_ARGS) "@RUN_RACKET_CGC@" "$(RUN_THIS_RACKET_CGC)"
sysinfer@MMM@:
@RUN_RACKET_MMM@ $(MKSYSTEM_ARGS) "@RUN_RACKET_MMM@" "$(RUN_THIS_RACKET_MMM)"
FOREIGN_USED_LIB = $(FOREIGN_OBJ) $(FOREIGN_LIB) FOREIGN_USED_LIB = $(FOREIGN_OBJ) $(FOREIGN_LIB)
FOREIGN_USED_OBJSLIB = $(FOREIGN_OBJSLIB) FOREIGN_USED_OBJSLIB = $(FOREIGN_OBJSLIB)
FOREIGN_NOT_USED_LIB = $(FOREIGN_OBJ) FOREIGN_NOT_USED_LIB = $(FOREIGN_OBJ)
@ -305,6 +320,7 @@ total_startup:
headers: headers:
@RUN_RACKET_CGC@ -cqu $(srcdir)/mkincludes.rkt @DIRCVTPRE@"$(DESTDIR)$(includepltdir)"@DIRCVTPOST@ "$(srcdir)" . @RUN_RACKET_CGC@ -cqu $(srcdir)/mkincludes.rkt @DIRCVTPRE@"$(DESTDIR)$(includepltdir)"@DIRCVTPOST@ "$(srcdir)" .
cd ..; cp racket/system.rktd "$(DESTDIR)$(libpltdir)/system.rktd"
$(srcdir)/src/schexn.h: $(srcdir)/src/makeexn $(srcdir)/src/schexn.h: $(srcdir)/src/makeexn
$(RACKET) -um $(srcdir)/src/makeexn > $(srcdir)/src/schexn.h $(RACKET) -um $(srcdir)/src/makeexn > $(srcdir)/src/schexn.h

2
racket/src/racket/gc2/Makefile.in
View File

@ -292,7 +292,7 @@ $(XSRCDIR)/setjmpup.c: $(XFORMDEP)
$(XFORM) $(XSRCDIR)/setjmpup.c $(SRCDIR)/setjmpup.c $(XFORM) $(XSRCDIR)/setjmpup.c $(SRCDIR)/setjmpup.c
$(XSRCDIR)/sfs.c: $(XFORMDEP) $(XSRCDIR)/sfs.c: $(XFORMDEP)
$(XFORM) $(XSRCDIR)/sfs.c $(SRCDIR)/sfs.c $(XFORM) $(XSRCDIR)/sfs.c $(SRCDIR)/sfs.c
$(XSRCDIR)/string.c: $(XFORMDEP) $(XSRCDIR)/string.c: $(XFORMDEP) $(SRCDIR)/systype.inc
$(XFORM_SETUP) --cpp "$(CPP) -I../src $(ALL_CPPFLAGS)" @XFORMFLAGS@ -o $(XSRCDIR)/string.c $(SRCDIR)/string.c $(XFORM_SETUP) --cpp "$(CPP) -I../src $(ALL_CPPFLAGS)" @XFORMFLAGS@ -o $(XSRCDIR)/string.c $(SRCDIR)/string.c
$(XSRCDIR)/struct.c: $(XFORMDEP) $(XSRCDIR)/struct.c: $(XFORMDEP)
$(XFORM) $(XSRCDIR)/struct.c $(SRCDIR)/struct.c $(XFORM) $(XSRCDIR)/struct.c $(SRCDIR)/struct.c

75
racket/src/racket/mksystem.rkt Normal file
View File

@ -0,0 +1,75 @@
(module mkincludes '#%kernel
(#%require '#%min-stx)
;; Arguments are
;; <output-file> [<cpp-command> <3m-exe-suffix> <run-racket-command> <this-racket-command>]
(define-values (args) (current-command-line-arguments))
(define-values (ht)
(if (or (= (vector-length args) 1)
(equal? (vector-ref args (- (vector-length args) 1))
(vector-ref args (- (vector-length args) 2))))
;; Not cross-compiling
(hash 'os (system-type 'os)
'word (system-type 'word)
'gc (if (= (vector-length args) 1)
'3m ; GC mode for suffixless executables
(if (string=? "" (vector-ref args 2))
'3m
'cgc))
'link (system-type 'link)
'machine (bytes->string/utf-8 (path->bytes (system-library-subpath #f)))
'so-suffix (system-type 'so-suffix)
'so-mode (system-type 'so-mode)
'fs-change (system-type 'fs-change)
'library-subpath (path->bytes (system-library-subpath #f))
'library-subpath-convention (system-path-convention-type))
;; Cross-compiling; use `cpp` to get details
(begin
(printf "Extracting system information for cross-compile\n")
(let-values ([(p out in err)
(subprocess #f #f #f "/bin/sh" "-c" (vector-ref args 1))])
(close-output-port in)
(letrec-values ([(read-all) (lambda ()
(let-values ([(s) (read-bytes 4096 out)])
(if (eof-object? s)
#""
(bytes-append s (read-all)))))])
(let-values ([(expanded) (read-all)])
(let-values ([(get-string)
(lambda (var)
(let-values ([(m) (regexp-match (string-append " " var " = ([^\n;]*);")
expanded)])
(if m
(bytes->string/utf-8
(regexp-replace* #rx"\\\\\\\\"
(regexp-replace* #rx"^\"|\" *\"|\"$" (cadr m) "")
"\\\\"))
(error 'mksystem "not found in cpp output: ~e" var))))])
(let-values ([(get-symbol)
(lambda (var) (string->symbol (get-string var)))]
[(get-int)
(lambda (var) (string->number (get-string var)))])
(let-values ([(library-subpath)
(get-string "system_library_subpath")]
[(os) (get-symbol "system_type_os")])
(hash 'os os
'word (* 8 (get-int "system_pointer_size"))
'gc (if (string=? "" (vector-ref args 2))
'3m
'cgc)
'link (get-symbol "system_type_link")
'machine library-subpath
'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)
'library-subpath (string->bytes/utf-8 library-subpath)
'library-subpath-convention (if (eq? os 'windows)
'windows
'unix)))))))))))
(call-with-output-file
(vector-ref args 0)
(lambda (o)
(write ht o)
(newline o))
'truncate/replace))

2
racket/src/racket/src/Makefile.in
View File

@ -419,7 +419,7 @@ sfs.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/stypes.h $(srcdir)/mzmark_sfs.inc $(srcdir)/stypes.h $(srcdir)/mzmark_sfs.inc
string.@LTO@: $(COMMON_HEADERS) \ string.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/stypes.h $(srcdir)/schvers.h $(srcdir)/mzmark_string.inc $(srcdir)/strops.inc \ $(srcdir)/stypes.h $(srcdir)/schvers.h $(srcdir)/mzmark_string.inc $(srcdir)/strops.inc \
$(srcdir)/schustr.inc $(srcdir)/schustr.inc $(srcdir)/systype.inc
struct.@LTO@: $(COMMON_HEADERS) \ struct.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/stypes.h $(srcdir)/mzmark_struct.inc $(srcdir)/stypes.h $(srcdir)/mzmark_struct.inc
syntax.@LTO@: $(COMMON_HEADERS) \ syntax.@LTO@: $(COMMON_HEADERS) \

4
racket/src/racket/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.) consistently.)
*/ */
#define MZSCHEME_VERSION "6.2.900.10" #define MZSCHEME_VERSION "6.2.900.11"
#define MZSCHEME_VERSION_X 6 #define MZSCHEME_VERSION_X 6
#define MZSCHEME_VERSION_Y 2 #define MZSCHEME_VERSION_Y 2
#define MZSCHEME_VERSION_Z 900 #define MZSCHEME_VERSION_Z 900
#define MZSCHEME_VERSION_W 10 #define MZSCHEME_VERSION_W 11
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

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

@ -2723,23 +2723,13 @@ void *scheme_environment_variables_to_block(Scheme_Object *ev, int *_need_free)
static void machine_details(char *s); static void machine_details(char *s);
#include "systype.inc"
static Scheme_Object *system_type(int argc, Scheme_Object *argv[]) static Scheme_Object *system_type(int argc, Scheme_Object *argv[])
{ {
if (argc) { if (argc) {
if (SAME_OBJ(argv[0], link_symbol)) { if (SAME_OBJ(argv[0], link_symbol)) {
#if defined(OS_X) && !defined(XONX) return scheme_intern_symbol(MZ_SYSTEM_TYPE_LINK);
return scheme_intern_symbol("framework");
#else
# ifdef DOS_FILE_SYSTEM
return scheme_intern_symbol("dll");
# else
# ifdef MZ_USES_SHARED_LIB
return scheme_intern_symbol("shared");
# else
return scheme_intern_symbol("static");
# endif
# endif
#endif
} }
if (SAME_OBJ(argv[0], machine_symbol)) { if (SAME_OBJ(argv[0], machine_symbol)) {
@ -2759,27 +2749,11 @@ static Scheme_Object *system_type(int argc, Scheme_Object *argv[])
} }
if (SAME_OBJ(argv[0], so_suffix_symbol)) { if (SAME_OBJ(argv[0], so_suffix_symbol)) {
#ifdef DOS_FILE_SYSTEM return scheme_make_byte_string(MZ_SYSTEM_TYPE_SO_SUFFIX);
return scheme_make_byte_string(".dll");
#else
# ifdef OS_X
return scheme_make_byte_string(".dylib");
# else
# ifdef USE_CYGWIN_SO_SUFFIX
return scheme_make_byte_string(".dll");
# else
return scheme_make_byte_string(".so");
# endif
# endif
#endif
} }
if (SAME_OBJ(argv[0], so_mode_symbol)) { if (SAME_OBJ(argv[0], so_mode_symbol)) {
#ifdef USE_DLOPEN_GLOBAL_BY_DEFAULT return scheme_intern_symbol(MZ_SYSTEM_TYPE_SO_MODE);
return scheme_intern_symbol("global");
#else
return scheme_intern_symbol("local");
#endif
} }

16
racket/src/racket/src/systype.c Normal file
View File

@ -0,0 +1,16 @@
/* This file is run through `cpp` by "../mysystem.rkt"
in cross-compilation mode. */
#include "schpriv.h"
#include "systype.inc"
#ifndef SCHEME_PLATFORM_LIBRARY_SUBPATH
# include "schsys.h"
#endif
string system_type_os = SYSTEM_TYPE_NAME;
string system_type_link = MZ_SYSTEM_TYPE_LINK;
string system_type_so_suffix = MZ_SYSTEM_TYPE_SO_SUFFIX;
string system_type_so_mode = MZ_SYSTEM_TYPE_SO_MODE;
string system_library_subpath = SCHEME_PLATFORM_LIBRARY_SUBPATH;
int system_pointer_size = SIZEOF_VOID_P;

37
racket/src/racket/src/systype.inc Normal file
View File

@ -0,0 +1,37 @@
/* Some answers for `system-type`, also consulted for cross-compilation */
#if defined(OS_X) && !defined(XONX)
# define MZ_SYSTEM_TYPE_LINK "framework"
#else
# ifdef DOS_FILE_SYSTEM
# define MZ_SYSTEM_TYPE_LINK "dll"
# else
# ifdef MZ_USES_SHARED_LIB
# define MZ_SYSTEM_TYPE_LINK "shared"
# else
# define MZ_SYSTEM_TYPE_LINK "static"
# endif
# endif
#endif
#ifdef DOS_FILE_SYSTEM
# define MZ_SYSTEM_TYPE_SO_SUFFIX ".dll"
#else
# ifdef OS_X
# define MZ_SYSTEM_TYPE_SO_SUFFIX ".dylib"
# else
# ifdef USE_CYGWIN_SO_SUFFIX
# define MZ_SYSTEM_TYPE_SO_SUFFIX ".dll"
# else
# define MZ_SYSTEM_TYPE_SO_SUFFIX ".so"
# endif
# endif
#endif
#ifdef USE_DLOPEN_GLOBAL_BY_DEFAULT
# define MZ_SYSTEM_TYPE_SO_MODE "global"
#else
# define MZ_SYSTEM_TYPE_SO_MODE "local"
#endif

3
racket/src/worksp/gc2/make.rkt
View File

@ -413,3 +413,6 @@
(copy-file/diff "mzdyn3m.exp" "../../../lib/msvc/mzdyn3m.exp") (copy-file/diff "mzdyn3m.exp" "../../../lib/msvc/mzdyn3m.exp")
(copy-file/diff "mzdyn3m.obj" "../../../lib/msvc/mzdyn3m.obj") (copy-file/diff "mzdyn3m.obj" "../../../lib/msvc/mzdyn3m.obj")
(parameterize ([current-command-line-arguments (vector "../../../lib/system.rktd")])
(dynamic-require "../../racket/mksystem.rkt" #f))

16
racket/src/worksp/racket/racket.vcproj
View File

@ -60,7 +60,7 @@
/> />
<Tool <Tool
Name="VCPostBuildEventTool" Name="VCPostBuildEventTool"
CommandLine="&#x0D;&#x0A;if exist &quot;$(TargetPath)&quot; goto :MzOK&#x0D;&#x0A;echo Error: did not find $(TargetPath)&#x0D;&#x0A;exit 1&#x0D;&#x0A;:MzOK&#x0D;&#x0A;&quot;$(TargetPath)&quot; -cu ..\..\racket\mkincludes.rkt &quot;$(TargetDir)/include/&quot; ..\..\racket ..&#x0D;&#x0A;if errorlevel 1 exit 1&#x0D;&#x0A;cd ..\..\racket\dynsrc&#x0D;&#x0A;call mkmzdyn.bat $(ConfigurationName)&#x0D;&#x0A;cd ..\..\worksp\racket&#x0D;&#x0A;addman.bat&#x0D;&#x0A;&#x0D;&#x0A;" CommandLine="&#x0D;&#x0A;if exist &quot;$(TargetPath)&quot; goto :MzOK&#x0D;&#x0A;echo Error: did not find $(TargetPath)&#x0D;&#x0A;exit 1&#x0D;&#x0A;:MzOK&#x0D;&#x0A;&quot;$(TargetPath)&quot; -cu ..\..\racket\mkincludes.rkt &quot;$(TargetDir)/include/&quot; ..\..\racket ..&#x0D;&#x0A;if errorlevel 1 exit 1&#x0D;&#x0A;&quot;$(TargetPath)&quot; -cu ..\..\racket\mksystem.rkt &quot;$(TargetDir)/lib/system.rktd&quot;&#x0D;&#x0A;if errorlevel 1 exit 1&#x0D;&#x0A;cd ..\..\racket\dynsrc&#x0D;&#x0A;call mkmzdyn.bat $(ConfigurationName)&#x0D;&#x0A;cd ..\..\worksp\racket&#x0D;&#x0A;addman.bat&#x0D;&#x0A;&#x0D;&#x0A;"
/> />
</Configuration> </Configuration>
<Configuration <Configuration
@ -131,7 +131,7 @@
/> />
<Tool <Tool
Name="VCPostBuildEventTool" Name="VCPostBuildEventTool"
CommandLine="&#x0D;&#x0A;if exist &quot;$(TargetPath)&quot; goto :MzOK&#x0D;&#x0A;echo Error: did not find $(TargetPath)&#x0D;&#x0A;exit 1&#x0D;&#x0A;:MzOK&#x0D;&#x0A;&quot;$(TargetPath)&quot; -cu ..\..\racket\mkincludes.rkt &quot;$(TargetDir)/include/&quot; ..\..\racket ..&#x0D;&#x0A;if errorlevel 1 exit 1&#x0D;&#x0A;cd ..\..\racket\dynsrc&#x0D;&#x0A;call mkmzdyn.bat $(ConfigurationName)&#x0D;&#x0A;cd ..\..\worksp\racket&#x0D;&#x0A;addman.bat&#x0D;&#x0A;&#x0D;&#x0A;" CommandLine="&#x0D;&#x0A;if exist &quot;$(TargetPath)&quot; goto :MzOK&#x0D;&#x0A;echo Error: did not find $(TargetPath)&#x0D;&#x0A;exit 1&#x0D;&#x0A;:MzOK&#x0D;&#x0A;&quot;$(TargetPath)&quot; -cu ..\..\racket\mkincludes.rkt &quot;$(TargetDir)/include/&quot; ..\..\racket ..&#x0D;&#x0A;if errorlevel 1 exit 1&#x0D;&#x0A;&quot;$(TargetPath)&quot; -cu ..\..\racket\mksystem.rkt &quot;$(TargetDir)/lib/system.rktd&quot;&#x0D;&#x0A;cd ..\..\racket\dynsrc&#x0D;&#x0A;call mkmzdyn.bat $(ConfigurationName)&#x0D;&#x0A;cd ..\..\worksp\racket&#x0D;&#x0A;addman.bat&#x0D;&#x0A;&#x0D;&#x0A;"
/> />
</Configuration> </Configuration>
<Configuration <Configuration
@ -181,7 +181,7 @@
/> />
<Tool <Tool
Name="VCPostBuildEventTool" Name="VCPostBuildEventTool"
CommandLine="&#x0D;&#x0A;if exist &quot;$(TargetPath)&quot; goto :MzOK&#x0D;&#x0A;echo Error: did not find $(TargetPath)&#x0D;&#x0A;exit 1&#x0D;&#x0A;:MzOK&#x0D;&#x0A;&quot;$(TargetPath)&quot; -cu ..\..\racket\mkincludes.rkt &quot;$(TargetDir)/include/&quot; ..\..\racket ..&#x0D;&#x0A;if errorlevel 1 exit 1&#x0D;&#x0A;cd ..\..\racket\dynsrc&#x0D;&#x0A;call mkmzdyn.bat $(ConfigurationName)&#x0D;&#x0A;cd ..\..\worksp\racket&#x0D;&#x0A;addman.bat&#x0D;&#x0A;&#x0D;&#x0A;" CommandLine="&#x0D;&#x0A;if exist &quot;$(TargetPath)&quot; goto :MzOK&#x0D;&#x0A;echo Error: did not find $(TargetPath)&#x0D;&#x0A;exit 1&#x0D;&#x0A;:MzOK&#x0D;&#x0A;&quot;$(TargetPath)&quot; -cu ..\..\racket\mkincludes.rkt &quot;$(TargetDir)/include/&quot; ..\..\racket ..&#x0D;&#x0A;if errorlevel 1 exit 1&#x0D;&#x0A;&quot;$(TargetPath)&quot; -cu ..\..\racket\mksystem.rkt &quot;$(TargetDir)/lib/system.rktd&quot;&#x0D;&#x0A;cd ..\..\racket\dynsrc&#x0D;&#x0A;call mkmzdyn.bat $(ConfigurationName)&#x0D;&#x0A;cd ..\..\worksp\racket&#x0D;&#x0A;addman.bat&#x0D;&#x0A;&#x0D;&#x0A;"
/> />
</Configuration> </Configuration>
<Configuration <Configuration
@ -233,7 +233,7 @@
/> />
<Tool <Tool
Name="VCPostBuildEventTool" Name="VCPostBuildEventTool"
CommandLine="&#x0D;&#x0A;if exist &quot;$(TargetPath)&quot; goto :MzOK&#x0D;&#x0A;echo Error: did not find $(TargetPath)&#x0D;&#x0A;exit 1&#x0D;&#x0A;:MzOK&#x0D;&#x0A;&quot;$(TargetPath)&quot; -cu ..\..\racket\mkincludes.rkt &quot;$(TargetDir)/include/&quot; ..\..\racket ..&#x0D;&#x0A;if errorlevel 1 exit 1&#x0D;&#x0A;cd ..\..\racket\dynsrc&#x0D;&#x0A;call mkmzdyn.bat $(ConfigurationName)&#x0D;&#x0A;cd ..\..\worksp\racket&#x0D;&#x0A;addman.bat&#x0D;&#x0A;&#x0D;&#x0A;" CommandLine="&#x0D;&#x0A;if exist &quot;$(TargetPath)&quot; goto :MzOK&#x0D;&#x0A;echo Error: did not find $(TargetPath)&#x0D;&#x0A;exit 1&#x0D;&#x0A;:MzOK&#x0D;&#x0A;&quot;$(TargetPath)&quot; -cu ..\..\racket\mkincludes.rkt &quot;$(TargetDir)/include/&quot; ..\..\racket ..&#x0D;&#x0A;if errorlevel 1 exit 1&#x0D;&#x0A;&quot;$(TargetPath)&quot; -cu ..\..\racket\mksystem.rkt &quot;$(TargetDir)/lib/system.rktd&quot;&#x0D;&#x0A;cd ..\..\racket\dynsrc&#x0D;&#x0A;call mkmzdyn.bat $(ConfigurationName)&#x0D;&#x0A;cd ..\..\worksp\racket&#x0D;&#x0A;addman.bat&#x0D;&#x0A;&#x0D;&#x0A;"
/> />
</Configuration> </Configuration>
<Configuration <Configuration
@ -279,7 +279,7 @@
/> />
<Tool <Tool
Name="VCPostBuildEventTool" Name="VCPostBuildEventTool"
CommandLine="&#x0D;&#x0A;if exist &quot;$(TargetPath)&quot; goto :MzOK&#x0D;&#x0A;echo Error: did not find $(TargetPath)&#x0D;&#x0A;exit 1&#x0D;&#x0A;:MzOK&#x0D;&#x0A;&quot;$(TargetPath)&quot; -cu ..\..\racket\mkincludes.rkt &quot;$(TargetDir)/include/&quot; ..\..\racket ..&#x0D;&#x0A;if errorlevel 1 exit 1&#x0D;&#x0A;cd ..\..\racket\dynsrc&#x0D;&#x0A;call mkmzdyn.bat $(ConfigurationName)&#x0D;&#x0A;cd ..\..\worksp\racket&#x0D;&#x0A;addman.bat&#x0D;&#x0A;&#x0D;&#x0A;" CommandLine="&#x0D;&#x0A;if exist &quot;$(TargetPath)&quot; goto :MzOK&#x0D;&#x0A;echo Error: did not find $(TargetPath)&#x0D;&#x0A;exit 1&#x0D;&#x0A;:MzOK&#x0D;&#x0A;&quot;$(TargetPath)&quot; -cu ..\..\racket\mkincludes.rkt &quot;$(TargetDir)/include/&quot; ..\..\racket ..&#x0D;&#x0A;if errorlevel 1 exit 1&#x0D;&#x0A;&quot;$(TargetPath)&quot; -cu ..\..\racket\mksystem.rkt &quot;$(TargetDir)/lib/system.rktd&quot;&#x0D;&#x0A;cd ..\..\racket\dynsrc&#x0D;&#x0A;call mkmzdyn.bat $(ConfigurationName)&#x0D;&#x0A;cd ..\..\worksp\racket&#x0D;&#x0A;addman.bat&#x0D;&#x0A;&#x0D;&#x0A;"
/> />
</Configuration> </Configuration>
<Configuration <Configuration
@ -350,7 +350,7 @@
/> />
<Tool <Tool
Name="VCPostBuildEventTool" Name="VCPostBuildEventTool"
CommandLine="&#x0D;&#x0A;if exist &quot;$(TargetPath)&quot; goto :MzOK&#x0D;&#x0A;echo Error: did not find $(TargetPath)&#x0D;&#x0A;exit 1&#x0D;&#x0A;:MzOK&#x0D;&#x0A;&quot;$(TargetPath)&quot; -cu ..\..\racket\mkincludes.rkt &quot;$(TargetDir)/include/&quot; ..\..\racket ..&#x0D;&#x0A;if errorlevel 1 exit 1&#x0D;&#x0A;cd ..\..\racket\dynsrc&#x0D;&#x0A;call mkmzdyn.bat $(ConfigurationName)&#x0D;&#x0A;cd ..\..\worksp\racket&#x0D;&#x0A;addman.bat&#x0D;&#x0A;&#x0D;&#x0A;" CommandLine="&#x0D;&#x0A;if exist &quot;$(TargetPath)&quot; goto :MzOK&#x0D;&#x0A;echo Error: did not find $(TargetPath)&#x0D;&#x0A;exit 1&#x0D;&#x0A;:MzOK&#x0D;&#x0A;&quot;$(TargetPath)&quot; -cu ..\..\racket\mkincludes.rkt &quot;$(TargetDir)/include/&quot; ..\..\racket ..&#x0D;&#x0A;if errorlevel 1 exit 1&#x0D;&#x0A;&quot;$(TargetPath)&quot; -cu ..\..\racket\mksystem.rkt &quot;$(TargetDir)/lib/system.rktd&quot;&#x0D;&#x0A;cd ..\..\racket\dynsrc&#x0D;&#x0A;call mkmzdyn.bat $(ConfigurationName)&#x0D;&#x0A;cd ..\..\worksp\racket&#x0D;&#x0A;addman.bat&#x0D;&#x0A;&#x0D;&#x0A;"
/> />
</Configuration> </Configuration>
<Configuration <Configuration
@ -400,7 +400,7 @@
/> />
<Tool <Tool
Name="VCPostBuildEventTool" Name="VCPostBuildEventTool"
CommandLine="&#x0D;&#x0A;if exist &quot;$(TargetPath)&quot; goto :MzOK&#x0D;&#x0A;echo Error: did not find $(TargetPath)&#x0D;&#x0A;exit 1&#x0D;&#x0A;:MzOK&#x0D;&#x0A;&quot;$(TargetPath)&quot; -cu ..\..\racket\mkincludes.rkt &quot;$(TargetDir)/include/&quot; ..\..\racket ..&#x0D;&#x0A;if errorlevel 1 exit 1&#x0D;&#x0A;cd ..\..\racket\dynsrc&#x0D;&#x0A;call mkmzdyn.bat $(ConfigurationName)&#x0D;&#x0A;cd ..\..\worksp\racket&#x0D;&#x0A;addman.bat&#x0D;&#x0A;&#x0D;&#x0A;" CommandLine="&#x0D;&#x0A;if exist &quot;$(TargetPath)&quot; goto :MzOK&#x0D;&#x0A;echo Error: did not find $(TargetPath)&#x0D;&#x0A;exit 1&#x0D;&#x0A;:MzOK&#x0D;&#x0A;&quot;$(TargetPath)&quot; -cu ..\..\racket\mkincludes.rkt &quot;$(TargetDir)/include/&quot; ..\..\racket ..&#x0D;&#x0A;if errorlevel 1 exit 1&#x0D;&#x0A;&quot;$(TargetPath)&quot; -cu ..\..\racket\mksystem.rkt &quot;$(TargetDir)/lib/system.rktd&quot;&#x0D;&#x0A;cd ..\..\racket\dynsrc&#x0D;&#x0A;call mkmzdyn.bat $(ConfigurationName)&#x0D;&#x0A;cd ..\..\worksp\racket&#x0D;&#x0A;addman.bat&#x0D;&#x0A;&#x0D;&#x0A;"
/> />
</Configuration> </Configuration>
<Configuration <Configuration
@ -451,7 +451,7 @@
/> />
<Tool <Tool
Name="VCPostBuildEventTool" Name="VCPostBuildEventTool"
CommandLine="&#x0D;&#x0A;if exist &quot;$(TargetPath)&quot; goto :MzOK&#x0D;&#x0A;echo Error: did not find $(TargetPath)&#x0D;&#x0A;exit 1&#x0D;&#x0A;:MzOK&#x0D;&#x0A;&quot;$(TargetPath)&quot; -cu ..\..\racket\mkincludes.rkt &quot;$(TargetDir)/include/&quot; ..\..\racket ..&#x0D;&#x0A;if errorlevel 1 exit 1&#x0D;&#x0A;cd ..\..\racket\dynsrc&#x0D;&#x0A;call mkmzdyn.bat $(ConfigurationName)&#x0D;&#x0A;cd ..\..\worksp\racket&#x0D;&#x0A;addman.bat&#x0D;&#x0A;&#x0D;&#x0A;" CommandLine="&#x0D;&#x0A;if exist &quot;$(TargetPath)&quot; goto :MzOK&#x0D;&#x0A;echo Error: did not find $(TargetPath)&#x0D;&#x0A;exit 1&#x0D;&#x0A;:MzOK&#x0D;&#x0A;&quot;$(TargetPath)&quot; -cu ..\..\racket\mkincludes.rkt &quot;$(TargetDir)/include/&quot; ..\..\racket ..&#x0D;&#x0A;if errorlevel 1 exit 1&#x0D;&#x0A;&quot;$(TargetPath)&quot; -cu ..\..\racket\mksystem.rkt &quot;$(TargetDir)/lib/system.rktd&quot;&#x0D;&#x0A;cd ..\..\racket\dynsrc&#x0D;&#x0A;call mkmzdyn.bat $(ConfigurationName)&#x0D;&#x0A;cd ..\..\worksp\racket&#x0D;&#x0A;addman.bat&#x0D;&#x0A;&#x0D;&#x0A;"
/> />
</Configuration> </Configuration>
</Configurations> </Configurations>