diff --git a/Makefile b/Makefile index dc4bddf08e..21975b3807 100644 --- a/Makefile +++ b/Makefile @@ -225,16 +225,17 @@ racket/src/build/Makefile: racket/src/$(SRC_MAKEFILE_CONFIG) racket/src/Makefile mkdir -p racket/src/build cd racket/src/build; ../$(SRC_MAKEFILE_CONFIG) $(CONFIGURE_ARGS_qq) $(MORE_CONFIGURE_ARGS) +MORE_CROSS_CONFIGURE_ARGS = # For cross-compilation, build a native executable with no configure options: native-for-cross: mkdir -p racket/src/build/cross $(MAKE) racket/src/build/cross/Makefile - cd racket/src/build/cross; $(MAKE) reconfigure + cd racket/src/build/cross; $(MAKE) reconfigure MORE_CONFIGURE_ARGS="$(MORE_CROSS_CONFIGURE_ARGS)" cd racket/src/build/cross/racket; $(MAKE) racket/src/build/cross/Makefile: racket/src/configure racket/src/Makefile.in - cd racket/src/build/cross; ../../configure + cd racket/src/build/cross; ../../configure $(MORE_CROSS_CONFIGURE_ARGS) # ------------------------------------------------------------ # Racket-on-Chez build @@ -361,24 +362,26 @@ run-cfg-cs: no-cfg-cs: echo done +BUILD_FOR_FOR_SCHEME_DIR = racket/src/build + scheme-src: - $(MAKE) racket/src/build/ChezScheme + $(MAKE) $(BUILD_FOR_FOR_SCHEME_DIR)/ChezScheme $(MAKE) update-ChezScheme -racket/src/build/ChezScheme: - mkdir -p racket/src/build +$(BUILD_FOR_FOR_SCHEME_DIR)/ChezScheme: + mkdir -p $(BUILD_FOR_FOR_SCHEME_DIR) if [ "$(EXTRA_REPOS_BASE)" = "" ] ; \ - then cd racket/src/build && git clone $(GIT_CLONE_ARGS_qq) $(CHEZ_SCHEME_REPO) ChezScheme ; \ + then cd $(BUILD_FOR_FOR_SCHEME_DIR) && git clone $(GIT_CLONE_ARGS_qq) $(CHEZ_SCHEME_REPO) ChezScheme ; \ else $(MAKE) clone-ChezScheme-as-extra GIT_CLONE_ARGS_qq="" ; fi update-ChezScheme: - cd racket/src/build/ChezScheme && git pull -q && git submodule -q update + cd $(BUILD_FOR_FOR_SCHEME_DIR)/ChezScheme && git pull -q && git submodule -q update clone-ChezScheme-as-extra: - cd racket/src/build && git clone $(GIT_CLONE_ARGS_qq) $(EXTRA_REPOS_BASE)ChezScheme/.git - cd racket/src/build/ChezScheme && git clone $(GIT_CLONE_ARGS_qq) $(EXTRA_REPOS_BASE)nanopass/.git - cd racket/src/build/ChezScheme && git clone $(GIT_CLONE_ARGS_qq) $(EXTRA_REPOS_BASE)stex/.git - cd racket/src/build/ChezScheme && git clone $(GIT_CLONE_ARGS_qq) $(EXTRA_REPOS_BASE)zlib/.git + cd $(BUILD_FOR_FOR_SCHEME_DIR) && git clone $(GIT_CLONE_ARGS_qq) $(EXTRA_REPOS_BASE)ChezScheme/.git + cd $(BUILD_FOR_FOR_SCHEME_DIR)/ChezScheme && git clone $(GIT_CLONE_ARGS_qq) $(EXTRA_REPOS_BASE)nanopass/.git + cd $(BUILD_FOR_FOR_SCHEME_DIR)/ChezScheme && git clone $(GIT_CLONE_ARGS_qq) $(EXTRA_REPOS_BASE)stex/.git + cd $(BUILD_FOR_FOR_SCHEME_DIR)/ChezScheme && git clone $(GIT_CLONE_ARGS_qq) $(EXTRA_REPOS_BASE)zlib/.git WIN32_CS_COPY_ARGS_EXCEPT_PKGS_SUT = SRC_CATALOG="$(SRC_CATALOG)" RACKETCS_SUFFIX="$(RACKETCS_SUFFIX)" \ SCHEME_SRC="$(SCHEME_SRC)" EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" @@ -422,22 +425,26 @@ win32-just-cs: native-cs-for-cross: if [ "$(SCHEME_SRC)" = "" ] ; \ then $(MAKE) scheme-src-then-cross ; \ - else $(MAKE) native-cs-for-cross-after-scheme-src ; fi + else $(MAKE) native-cs-for-cross-after-scheme-src MAKE_BUILD_SCHEME=n ; fi + +CS_CROSS_SCHEME_CONFIG = SCHEME_SRC="`pwd`/racket/src/build/cross/ChezScheme" MAKE_BUILD_SCHEME=y scheme-src-then-cross: - $(MAKE) scheme-src - $(MAKE) native-cs-for-cross-after-scheme-src SCHEME_SRC="`pwd`/racket/src/build/ChezScheme" + $(MAKE) scheme-src BUILD_FOR_FOR_SCHEME_DIR="racket/src/build/cross/" + $(MAKE) native-cs-for-cross-after-scheme-src $(CS_CROSS_SCHEME_CONFIG) native-cs-for-cross-after-scheme-src: if [ "$(RACKET)" = "" ] ; \ then $(MAKE) native-for-cross-racket-then-cross ; \ - else $(MAKE) native-cs-for-cross-after-scheme-src-and-racket ; fi + else $(MAKE) native-cs-for-cross-finish ; fi + +CS_CROSS_CONFIG_CONFIG = MORE_CROSS_CONFIGURE_ARGS="$(MORE_CROSS_CONFIGURE_ARGS) --enable-csdefault" native-for-cross-racket-then-cross: - $(MAKE) native-for-cross - $(MAKE) native-cs-for-cross-after-scheme-src-and-racket RACKET="`pwd`/racket/src/build/racket/racket3m" + $(MAKE) native-for-cross $(CS_CROSS_CONFIG_CONFIG) + $(MAKE) native-cs-for-cross-finish RACKET="`pwd`/racket/src/build/cross/racket/racket3m" -native-cs-for-cross-after-scheme-src-and-racket: +native-cs-for-cross-finish: mkdir -p racket/src/build/cross/cs/c $(MAKE) racket/src/build/cross/cs/c/Makefile cd racket/src/build/cross/cs/c; $(MAKE) reconfigure @@ -599,7 +606,7 @@ SVR_CAT = http://$(SVR_PRT)/$(SERVER_CATALOG_PATH) # Helper macros: USER_CONFIG = -G build/user/config -X racket/collects -A build/user $(SETUP_MACHINE_FLAGS) USER_RACKET = $(PLAIN_RACKET) $(USER_CONFIG) -USER_RACO = $(PLAIN_RACKET) $(SETUP_MACHINE_FLAGS) $(USER_CONFIG) -N raco -l- raco +USER_RACO = $(PLAIN_RACKET) $(USER_CONFIG) -N raco -l- raco WIN32_RACKET = $(WIN32_PLAIN_RACKET) $(USER_CONFIG) WIN32_RACO = $(WIN32_PLAIN_RACKET) $(USER_CONFIG) -N raco -l- raco X_AUTO_OPTIONS = --skip-installed --deps search-auto --pkgs $(JOB_OPTIONS) @@ -643,6 +650,9 @@ with-setup-flags: then $(MAKE) $(NEXT_TARGET) $(ANY_COMPILE_MACHINE_ARGS_qq) ; \ else $(MAKE) $(NEXT_TARGET) ; fi +random: + echo $(MORE_CONFIGURE_ARGS) + # ------------------------------------------------------------ # On a server platform (for an installer build): @@ -808,7 +818,7 @@ bundle-from-server: $(USER_RACKET) -l setup/winstrip bundle/racket $(USER_RACKET) -l setup/winvers-change bundle/racket $(USER_RACKET) -l- distro-build/unpack-collects $(UNPACK_COLLECTS_FLAGS) http://$(SVR_PRT)/$(SERVER_COLLECTS_PATH) - $(IN_BUNDLE_RACO) setup -l racket/base + $(IN_BUNDLE_RACO) setup $(IN_BUNDLE_RACO) pkg install $(REMOTE_INST_AUTO) $(PKG_SOURCE_MODE) $(REQUIRED_PKGS) $(IN_BUNDLE_RACO) pkg install $(REMOTE_INST_AUTO) $(PKG_SOURCE_MODE) $(PKGS) $(USER_RACKET) -l setup/unixstyle-install post-adjust "$(SOURCE_MODE)" "$(PKG_SOURCE_MODE)" racket bundle/racket @@ -817,7 +827,8 @@ bundle-from-server: # installing packages. The host build must have all native libraries # that installation will need. bundle-cross-from-server: - $(MAKE) bundle-from-server $(COPY_ARGS) IN_BUNDLE_RACO="$(BUNDLE_RACO)" + rm -rf "build/zo`pwd`/bundle" + $(MAKE) bundle-from-server $(COPY_ARGS) IN_BUNDLE_RACO="$(PLAIN_RACKET) $(SETUP_MACHINE_FLAGS) $(BUNDLE_RACO_FLAGS)" UPLOAD_q = --readme "$(README)" --upload "$(UPLOAD)" --desc "$(DIST_DESC)" DIST_ARGS_q = $(UPLOAD_q) $(RELEASE_MODE) $(SOURCE_MODE) $(VERSIONLESS_MODE) \ diff --git a/racket/collects/compiler/private/cm-minimal.rkt b/racket/collects/compiler/private/cm-minimal.rkt index 26ebda46e4..3e1dbb02fd 100644 --- a/racket/collects/compiler/private/cm-minimal.rkt +++ b/racket/collects/compiler/private/cm-minimal.rkt @@ -494,7 +494,9 @@ [(and (equal? recompile-from zo-name) (not (current-compile-target-machine))) ;; We don't actually need to do anything, so - ;; avoid updating the file + ;; avoid updating the file. + (check-recompile-module-dependencies use-existing-deps + collection-cache) #f] [recompile-from (recompile-module-code recompile-from @@ -590,13 +592,7 @@ zo-name) (define (recompile-module-code recompile-from src-path deps collection-cache) - ;; Force potential recompilation of dependencies. Otherwise, we - ;; end up relying on cross-module optimization demands, which might - ;; not happen and are unlikely to cover everything. - (for ([d (in-list (deps-imports deps))] - #:unless (external-dep? d)) - (define path (collects-relative*->path (dep->encoded-path d) collection-cache)) - (module-path-index-resolve (module-path-index-join path #f) #t)) + (check-recompile-module-dependencies deps collection-cache) ;; Recompile the module: (define-values (base name dir?) (split-path src-path)) (parameterize ([current-load-relative-directory @@ -605,6 +601,15 @@ (call-with-input-file* recompile-from read))) (compiled-expression-recompile code))) +;; Force potential recompilation of dependencies. Otherwise, we +;; end up relying on cross-module optimization demands, which might +;; not happen and are unlikely to cover everything. +(define (check-recompile-module-dependencies deps collection-cache) + (for ([d (in-list (deps-imports deps))] + #:unless (external-dep? d)) + (define path (collects-relative*->path (dep->encoded-path d) collection-cache)) + (module-path-index-resolve (module-path-index-join path #f) #t))) + (define (install-module-hashes! s [start 0] [len (bytes-length s)]) (define vlen (bytes-ref s (+ start 2))) (define vmlen (bytes-ref s (+ start 3 vlen))) @@ -694,6 +699,7 @@ ;; needs to compile, recompile, or touch: (define (build #:just-touch? [just-touch? #f] #:recompile-from [recompile-from #f] + #:recompile-from-machine [recompile-from-machine #f] #:assume-compiled-sha1 [assume-compiled-sha1 #f] #:use-existing-deps [use-existing-deps #f]) (define lc (parallel-lock-client)) @@ -710,8 +716,16 @@ (touch zo-name)] [else (when just-touch? (set! just-touch? #f)) - (log-compile-event path (if recompile-from 'start-recompile 'start-compile)) - (trace-printf "~acompiling ~a" (if recompile-from "re" "") actual-path) + (define mi-recompile-from (select-machine-independent recompile-from + recompile-from-machine + path + roots + path->mode)) + (define recompile-from-exists? (and mi-recompile-from + ;; Checking existence now after taking lock: + (file-exists? mi-recompile-from))) + (trace-printf "~acompiling ~a" (if recompile-from-exists? "re" "") actual-path) + (log-compile-event path (if recompile-from-exists? 'start-recompile 'start-compile)) (parameterize ([depth (+ (depth) 1)]) (with-handlers ([exn:get-module-code? (lambda (ex) @@ -719,17 +733,14 @@ (exn:get-module-code-path ex) (exn-message ex)) (raise ex))]) - (define recompile-from-exists? (and recompile-from - ;; Checking existence now after taking lock: - (file-exists? recompile-from))) (compile-zo*/cross-compile path->mode roots path src-sha1 read-src-syntax zo-name up-to-date collection-cache #:recompile-from (and recompile-from-exists? - recompile-from) + mi-recompile-from) #:assume-compiled-sha1 (and recompile-from-exists? (force assume-compiled-sha1)) #:use-existing-deps (and recompile-from-exists? use-existing-deps)))) - (trace-printf "~acompiled ~a" (if recompile-from "re" "") actual-path)]))) + (trace-printf "~acompiled ~a" (if recompile-from-exists? "re" "") actual-path)]))) (lambda () (log-compile-event path (if (or (not lc) locked?) (cond @@ -742,8 +753,9 @@ #f) ;; Called to recompile bytecode that is currently in ;; machine-independent form: - (define (build/recompile) + (define (build/recompile zo-name-machine) (build #:recompile-from zo-name + #:recompile-from-machine zo-name-machine #:assume-compiled-sha1 (or (deps-assume-compiled-sha1 deps) ;; delay until lock is held: (delay (call-with-input-file* zo-name sha1))) @@ -780,7 +792,7 @@ ;; so we don't need to rebuild if just looking for the hash. (cond [trying-sha1? #f] - [else (build/recompile)])] + [else (build/recompile (deps-machine deps))])] [else ;; No need to build (cond @@ -828,7 +840,7 @@ ;; that module will cause this one to be recompiled (i.e., back here ;; with `trying-sha1?` as #f) #f] - [else (build/recompile)])])] + [else (build/recompile (deps-machine deps))])])] [trying-sha1? ;; Needs to be built, but we can't build now #t] @@ -929,14 +941,8 @@ #:sha1-only? [sha1-only? #f]) (define orig-path (simple-form-path path0)) (define (read-deps path) - (with-handlers ([exn:fail:filesystem? (lambda (ex) - (trace-printf "failed reading ~a" path) - (list #f "none" '(#f . #f)))]) - (with-module-reading-parameterization - (lambda () - (call-with-input-file* - (path-add-extension (get-compilation-path path->mode roots path) #".dep") - read))))) + (read-deps-file + (path-add-extension (get-compilation-path path->mode roots path) #".dep"))) (define (do-check) (let* ([main-path orig-path] [alt-path (rkt->ss orig-path)] @@ -1065,6 +1071,38 @@ (trace-printf "checking: ~a" orig-path) (do-check)]))) +(define (read-deps-file dep-path) + (with-handlers ([exn:fail:filesystem? (lambda (ex) + (trace-printf "failed reading ~a" dep-path) + (list #f "none" '(#f . #f)))]) + (with-module-reading-parameterization + (lambda () + (call-with-input-file* dep-path read))))) + +;; Make sure `recompile-from` is machine-independent so that +;; recompilation makes sense. +;; The compilation lock must is held for the source of `recompile-from`. +(define (select-machine-independent recompile-from + recompile-from-machine + path + roots + path->mode) + (cond + [(not recompile-from) #f] + [(not recompile-from-machine) recompile-from] + [(and (pair? roots) (pair? (cdr roots))) + ;; We have a machine-dependent ".zo" file. Maybe we'll + ;; fine a machine-independent version by checking the + ;; last compilation path + (define-values (code-dir code-name) + (get-compilation-dir+name path #:modes (list (path->mode path)) #:roots (list (last roots)))) + (define alt-recompile-from + (build-path code-dir (path-add-suffix code-name #".zo"))) + (define deps (read-deps-file (path-replace-suffix alt-recompile-from #".dep"))) + (and (not (deps-machine deps)) + alt-recompile-from)] + [else #f])) + (define (ormap-strict f l) (cond [(null? l) #f] diff --git a/racket/collects/setup/cross-system.rkt b/racket/collects/setup/cross-system.rkt index eadf5d93a2..99a6384cb8 100644 --- a/racket/collects/setup/cross-system.rkt +++ b/racket/collects/setup/cross-system.rkt @@ -27,10 +27,8 @@ (eq? (system-type 'vm) (hash-ref ht 'vm #f)) (for/and ([sym (in-list (append - (if (eq? 'racket (system-type 'vm)) - '(library-subpath - library-subpath-convention) - null) + '(library-subpath + library-subpath-convention) system-type-symbols))]) (not (void? (hash-ref ht sym (void))))) (not @@ -44,10 +42,9 @@ (and (not v) (eq? sym 'target-machine) (eq? (system-type 'cross) 'infer)))) - (or (not (eq? 'racket (system-type 'vm))) - (equal? (bytes->path (hash-ref ht 'library-subpath) - (hash-ref ht 'library-subpath-convention)) - (system-library-subpath #f))))) + (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) diff --git a/racket/collects/setup/setup-core.rkt b/racket/collects/setup/setup-core.rkt index 32b19f9ec7..3725706449 100644 --- a/racket/collects/setup/setup-core.rkt +++ b/racket/collects/setup/setup-core.rkt @@ -2027,7 +2027,9 @@ (setup-printf "version" "~a" (version)) (setup-printf "platform" "~a [~a]" (cross-system-library-subpath #f) (cross-system-type 'gc)) - (setup-printf "target machine" "~a" (or (current-compile-target-machine) 'any)) + (setup-printf "target machine" "~a" (or (current-compile-target-machine) + (cross-system-type 'target-machine) + 'any)) (when (cross-installation?) (setup-printf "cross-installation" "yes")) (setup-printf "installation name" "~a" (get-installation-name)) diff --git a/racket/src/cs/c/gen-system.rkt b/racket/src/cs/c/gen-system.rkt index b00dcdc090..6d5a56494f 100644 --- a/racket/src/cs/c/gen-system.rkt +++ b/racket/src/cs/c/gen-system.rkt @@ -2,42 +2,46 @@ ;; Command-line argument: + ;; This file includes various inferences for cross-compilation, so it has + ;; to be updated for new cross-compilation targets. + (define-values (machine) (string->symbol (vector-ref (current-command-line-arguments) 1))) + (define-values (machine-lookup) + (lambda (l default) + (if (null? l) + default + (if (eq? (caar l) machine) + (cdar l) + (machine-lookup (cdr l) default))))) + ;; Check for cross-compile to Windows: - (define-values (windows?) (if (eq? machine 'ta6nt) - #t - (if (eq? machine 'ti3nt) - #t - (if (eq? machine 'a6nt) - #t - (if (eq? machine 'i3nt) - #t - #f))))) + (define-values (windows?) (machine-lookup '((ta6nt . #t) + (a6nt . #t) + (ti3nt . #t) + (i3nt . #t)) + #f)) + + (define-values (lib-subpath) + (machine-lookup '((ta6nt . "win32\\x86_64") + (a6nt . "win32\\x86_64") + (ti3nt . "win32\\i386") + (i3nt . "win32\\i386")) + (bytes->string/utf-8 (path->bytes (system-library-subpath #f))))) (define-values (ht) (hash 'os (if windows? 'windows (system-type 'os)) - 'word (if (eq? machine 'ta6nt) - 64 - (if (eq? machine 'a6nt) - 64 - (if (eq? machine 'ti3nt) - 32 - (if (eq? machine 'i3nt) - 32 - (system-type 'word))))) + 'word (machine-lookup '((ta6nt . 64) + (a6nt . 64) + (ti3nt . 32) + (i3nt . 32)) + (system-type 'word)) 'gc 'cs 'vm 'chez-scheme 'link 'static - 'machine (if (eq? machine 'ta6nt) - "win32\\x86_64" - (if (eq? machine 'a6nt) - "win32\\x86_64" - (if (eq? machine 'ti3nt) - "win32\\i386" - (if (eq? machine 'i3nt) - "win32\\i386" - (bytes->string/utf-8 (path->bytes (system-library-subpath #f))))))) + 'machine lib-subpath + 'library-subpath (string->bytes/utf-8 lib-subpath) + 'library-subpath-convention (if windows? 'windows 'unix) 'so-suffix (if windows? #".dll" (system-type 'so-suffix)) 'so-mode 'local 'fs-change '#(#f #f #f #f) diff --git a/racket/src/cs/main/help.ss b/racket/src/cs/main/help.ss index 8d67c66391..888826e695 100644 --- a/racket/src/cs/main/help.ss +++ b/racket/src/cs/main/help.ss @@ -65,8 +65,8 @@ " -O , --stdout : Set stdout logging to \n" " -L , --syslog : Set syslog logging to \n" " --compile-machine : Compile for \n" - " --cross-compiler : Use compiler plugin for \n" - " --cross-server : Drive cross-compiler plugin (as only option)\n" + " --cross-compiler : Use compiler plugin for \n" + " --cross-server : Drive cross-compiler (as only option)\n" " Meta options:\n" " -- : No argument following this switch is used as a switch\n" " -h, --help : Show this information and exits, ignoring other options\n" diff --git a/racket/src/cs/rumble/correlated.ss b/racket/src/cs/rumble/correlated.ss index e8173eafff..1503f803eb 100644 --- a/racket/src/cs/rumble/correlated.ss +++ b/racket/src/cs/rumble/correlated.ss @@ -34,7 +34,8 @@ (if props (correlated-props props) empty-hasheq)))] - [(ignored datum src) (datum->correlated ignored datum src #f)])) + [(ignored datum src) (datum->correlated ignored datum src #f)] + [(ignored datum) (datum->correlated ignored datum #f #f)])) (define (correlated->datum e) (cond