From 9981effa4ba4c7ff611d1afec13a228f6fee3799 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 3 Mar 2019 08:57:20 -0700 Subject: [PATCH] cs: revise cross-compilation protocol and fill in build steps Makefile and configure refinements, including targets to let the distro-build package drive a cross-build from scratch. A cross build on Mac OS for Windows now works, for example. --- Makefile | 48 ++++++++- .../collects/compiler/private/cm-minimal.rkt | 4 +- racket/collects/setup/cross-system.rkt | 15 +-- racket/src/cs/Makefile | 16 +-- racket/src/cs/c/Makefile.in | 97 +++++++++++++------ racket/src/cs/c/boot.c | 39 +++++++- racket/src/cs/c/configure | 19 ++-- racket/src/cs/c/configure.ac | 16 +-- racket/src/cs/c/cross-serve.ss | 56 +++++++++++ racket/src/cs/c/mk-cross-serve.ss | 2 + racket/src/cs/linklet.sls | 17 +++- racket/src/cs/linklet/annotation.ss | 66 ------------- racket/src/cs/linklet/cross-compile.ss | 70 ++++++++++--- racket/src/cs/linklet/write.ss | 8 +- racket/src/cs/main.sps | 23 ++--- racket/src/cs/main/cross-compile.ss | 34 ------- .../expander/compile/correlated-linklet.rkt | 16 +++ racket/src/expander/compile/recompile.rkt | 21 +++- 18 files changed, 353 insertions(+), 214 deletions(-) create mode 100644 racket/src/cs/c/cross-serve.ss create mode 100644 racket/src/cs/c/mk-cross-serve.ss delete mode 100644 racket/src/cs/main/cross-compile.ss diff --git a/Makefile b/Makefile index 63b26a5a93..dc4bddf08e 100644 --- a/Makefile +++ b/Makefile @@ -262,7 +262,10 @@ GIT_CLONE_ARGS_qq = -q --depth 1 # Altenative source for Chez Scheme repo, normally set by # the distro-build client driver -EXTRA_REPOS_BASE = +EXTRA_REPOS_BASE = + +# Set to "-cross" for a cross build: +CS_CROSS_SUFFIX = # Redirected for `cs-as-is` and `cs-base`: CS_SETUP_TARGET = plain-in-place-after-base @@ -299,11 +302,11 @@ cs-after-racket: then $(MAKE) cs-after-racket-with-racket RACKET="$(RACKET_BUILT_FOR_CS)" SETUP_BOOT_MODE=--boot ; \ else $(MAKE) cs-after-racket-with-racket RACKET="$(RACKET)" CS_CONFIG_TARGET=run-cfg-cs ; fi -RACKETCS_SUFFIX_CONFIG = MORE_CONFIGURE_ARGS="$(MORE_CONFIGURE_ARGS) --enable-csdefault" PLAIN_RACKET="$(PLAIN_RACKET)3m" +RACKETCS_NOSUFFIX_CONFIG = MORE_CONFIGURE_ARGS="$(MORE_CONFIGURE_ARGS) --enable-csdefault" racket-then-cs: if [ "$(RACKETCS_SUFFIX)" = "" ] ; \ - then $(MAKE) racket-configured-then-cs $(RACKETCS_SUFFIX_CONFIG) ; \ + then $(MAKE) racket-configured-then-cs $(RACKETCS_NOSUFFIX_CONFIG) PLAIN_RACKET="$(PLAIN_RACKET)3m" ; \ else $(MAKE) racket-configured-then-cs ; fi racket-configured-then-cs: @@ -312,7 +315,9 @@ racket-configured-then-cs: cs-only: $(MAKE) racket/src/build/Makefile SRC_MAKEFILE_CONFIG=cfg-cs - $(MAKE) cs-after-racket-with-racket RACKET="$(RACKET)" + if [ "$(RACKETCS_SUFFIX)" = "" ] ; \ + then $(MAKE) cs-after-racket-with-racket $(RACKETCS_NOSUFFIX_CONFIG) RACKET="$(RACKET)" ; \ + else $(MAKE) cs-after-racket-with-racket RACKET="$(RACKET)" ; fi SETUP_BOOT_MODE = --chain ABS_SETUP_BOOT = -l- setup $(SETUP_BOOT_MODE) racket/src/setup-go.rkt racket/src/build/compiled @@ -334,8 +339,14 @@ cs-after-racket-with-abs-paths: cd racket/src/build/cs/c; $(MAKE) RACKET="$(RACKET)" SCHEME_SRC="$(SCHEME_SRC)" MAKE_BUILD_SCHEME="$(MAKE_BUILD_SCHEME)" $(MAKE) base-config cd racket/src/build; $(MAKE) install-cs RACKET="$(RACKET)" CS_INSTALLED=$(RACKETCS_SUFFIX) $(INSTALL_SETUP_ARGS) + $(MAKE) cs-setup$(CS_CROSS_SUFFIX) + +cs-setup: $(MAKE) $(CS_SETUP_TARGET) PLAIN_RACKET=racket/bin/racket$(RACKETCS_SUFFIX) +cs-setup-cross: + $(MAKE) $(CS_SETUP_TARGET) PLAIN_RACKET="$(RACKET)" PLT_SETUP_OPTIONS="--no-pkg-deps $(PLT_SETUP_OPTIONS)" + nothing-after-base: echo base done @@ -406,6 +417,35 @@ win32-just-cs: racket\racket$(RACKETCS_SUFFIX) -G build\config -N raco -l- raco setup $(JOB_OPTIONS) $(PLT_SETUP_OPTIONS) $(MAKE) $(WIN32_CS_SETUP_TARGET) WIN32_PLAIN_RACKET=racket\racket$(RACKETCS_SUFFIX) $(WIN32_CS_COPY_ARGS) + +# For cross-compilation, build a native executable with no configure options: +native-cs-for-cross: + if [ "$(SCHEME_SRC)" = "" ] ; \ + then $(MAKE) scheme-src-then-cross ; \ + else $(MAKE) native-cs-for-cross-after-scheme-src ; fi + +scheme-src-then-cross: + $(MAKE) scheme-src + $(MAKE) native-cs-for-cross-after-scheme-src SCHEME_SRC="`pwd`/racket/src/build/ChezScheme" + +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 + +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" + +native-cs-for-cross-after-scheme-src-and-racket: + 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 + cd racket/src/build/cross/cs/c; $(MAKE) + +racket/src/build/cross/cs/c/Makefile: racket/src/cs/c/configure racket/src/cs/c/Makefile.in + cd racket/src/build/cross/cs/c; ../../../../cs/c/configure + # ------------------------------------------------------------ # Both traditional Racket and RacketCS # ... but update packages and builds docs only once diff --git a/racket/collects/compiler/private/cm-minimal.rkt b/racket/collects/compiler/private/cm-minimal.rkt index edcc9ab9ba..26ebda46e4 100644 --- a/racket/collects/compiler/private/cm-minimal.rkt +++ b/racket/collects/compiler/private/cm-minimal.rkt @@ -355,14 +355,14 @@ ""))]))) (define (cross-multi-compile? roots) - ;; Combination of cross-installation mode, compiling to non-default target machine, + ;; Combination of cross-installation mode, compiling to machine-independent form, ;; and multiple compiled-file roots triggers a special multi-target compilation mode. ;; Write code compiled for the running Racket to the first root, and write code for ;; the cross-compile target to the second root --- but count the cross-compile target ;; as machine-independent if it would be the same as the current target. (and ((length roots) . > . 1) (cross-installation?) - (not (eq? (system-type 'target-machine) (current-compile-target-machine))))) + (not (current-compile-target-machine)))) ;; Handle cross-multi-compile mode, or just continue on to `compile-zo*` (define (compile-zo*/cross-compile path->mode roots path src-sha1 read-src-syntax orig-zo-name diff --git a/racket/collects/setup/cross-system.rkt b/racket/collects/setup/cross-system.rkt index c1ffd67b35..eadf5d93a2 100644 --- a/racket/collects/setup/cross-system.rkt +++ b/racket/collects/setup/cross-system.rkt @@ -26,9 +26,11 @@ ;; because cross-compiling requires the same VM. (eq? (system-type 'vm) (hash-ref ht 'vm #f)) - (for/and ([sym (in-list (list* - 'library-subpath - 'library-subpath-convention + (for/and ([sym (in-list (append + (if (eq? 'racket (system-type 'vm)) + '(library-subpath + library-subpath-convention) + null) system-type-symbols))]) (not (void? (hash-ref ht sym (void))))) (not @@ -42,9 +44,10 @@ (and (not v) (eq? sym 'target-machine) (eq? (system-type 'cross) 'infer)))) - (equal? (bytes->path (hash-ref ht 'library-subpath) - (hash-ref ht 'library-subpath-convention)) - (system-library-subpath #f)))) + (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))))) ht)))))) (if ht (set! cross-system-table ht) diff --git a/racket/src/cs/Makefile b/racket/src/cs/Makefile index 0af1458d2f..77d341ac76 100644 --- a/racket/src/cs/Makefile +++ b/racket/src/cs/Makefile @@ -44,7 +44,7 @@ CONVERT_DEPS = $(PRIMITIVES_TABLES) CONVERT_RACKET = $(RACKET) -l- setup --chain ../setup-go.rkt $(BUILDDIR)compiled CONVERT = $(CONVERT_RACKET) '(CONVERTED)' $(BUILDDIR)compiled/convert.d convert.rkt $(UNSAFE_COMP) -# This extension changes for cross builds: +# This extension is for libraries, and it changes for cross builds: CSO = so # Depenency chain for ".so" files: @@ -69,8 +69,8 @@ cross: expander-demo: $(BUILDDIR)expander.$(CSO) demo/expander.ss ../../bin/racket $(SCHEME) $(EXPANDER_DEPS) $(BUILDDIR)expander.$(CSO) demo/expander.ss -run: $(BUILDDIR)main.$(CSO) ../../bin/racket - $(SCHEME) --script $(BUILDDIR)main.$(CSO) $(RACKET_SETUP_ARGS) $(ARGS) +run: $(BUILDDIR)main.so ../../bin/racket + $(SCHEME) --script $(BUILDDIR)main.so $(RACKET_SETUP_ARGS) $(ARGS) setup: $(MAKE) run ARGS="-l- setup $(ARGS)" @@ -81,13 +81,12 @@ setup-v: run-wpo: $(BUILDDIR)racket.so ../../bin/racket $(SCHEME) --script $(BUILDDIR)racket.so $(RACKET_SETUP_ARGS) $(ARGS) -$(BUILDDIR)racket.so: $(BUILDDIR)main.$(CSO) $(COMPILE_FILE_DEPS) +$(BUILDDIR)racket.so: $(BUILDDIR)main.so $(COMPILE_FILE_DEPS) $(COMPILE_FILE) --whole-program $(BUILDDIR)racket.so $(BUILDDIR)main.wpo -MAIN_SRCS = main/help.ss \ - main/cross-compile.ss +MAIN_SRCS = main/help.ss -$(BUILDDIR)main.$(CSO): $(MAIN_DEPS) main.sps $(MAIN_SRCS) $(COMPILE_FILE_DEPS) +$(BUILDDIR)main.so: $(MAIN_DEPS) main.sps $(MAIN_SRCS) $(COMPILE_FILE_DEPS) $(COMPILE_FILE) main.sps $(MAIN_DEPS) strip: @@ -309,8 +308,9 @@ $(BUILDDIR)chezpart.$(CSO): chezpart.sls $(COMPILE_FILE_DEPS) clean: rm -f chezpart.$(CSO) rumble.$(CSO) regexp.$(CSO) io.$(CSO) linklet.$(CSO) expander.$(CSO) schemify.$(CSO) + rm -f chezpart.so rumble.so regexp.so io.so linklet.so expander.so schemify.so rm -f chezpart.wpo rumble.wpo regexp.wpo io.wpo linklet.wpo expander.wpo schemify.wpo - rm -f thread.$(CSO) thread.wpo main.wpo main.$(CSO) + rm -f thread.$(CSO) thread.wpo main.wpo main.so rm -rf compiled diff --git a/racket/src/cs/c/Makefile.in b/racket/src/cs/c/Makefile.in index 5caa9d4a6a..d117ab52b4 100644 --- a/racket/src/cs/c/Makefile.in +++ b/racket/src/cs/c/Makefile.in @@ -42,6 +42,7 @@ libpltdir_rel = @libpltdir_rel@ etcpltdir = @etcpltdir@ sharepltdir = @sharepltdir@ collectsdir = @collectsdir@ +configdir = @etcpltdir@ ALLDIRINFO = "$(DESTDIR)$(bindir)" \ "$(DESTDIR)$(libpltdir)" @@ -83,7 +84,7 @@ RACKET_SO_ENV = @CONFIGURE_RACKET_SO_COMPILE@ env COMPILED_SCM_DIR="$(builddir)/ CS_PROGS = RACKET="$(RACKET)" SCHEME="$(SCHEME)" CONVERT_RACKET="$(CONVERT_RACKET)" CS_OPTS = COMPRESS_COMP=@COMPRESS_COMP@ -CS_OPTScross = $(CS_OPTS) CSO=@MACH@ CROSS_COMP="--xpatch $(SCHEME_SRC)/@TARGET_MACH@/s/xpatch" +CS_OPTScross = $(CS_OPTS) CSO=$(MACH) CROSS_COMP="--xpatch $(SCHEME_SRC)/$(TARGET_MACH)/s/xpatch" build-racket-so: $(MAKE) @RKTL_PRE@expander@RKTL_POST@ @@ -132,36 +133,36 @@ scheme: SCHEME_CONFIG_VARS = CC="$(CC)" CFLAGS="$(BASE_CFLAGS)" LD="$(LD)" LDFLAGS="$(LDFLAGS)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" RANLIB="$(RANLIB)" scheme-make: - cd @SCHEME_SRC@ && git submodule -q init && git submodule -q update - cd @SCHEME_SRC@ && ./configure @SCHEME_CONFIG_ARGS@ $(SCHEME_CONFIG_VARS) - mkdir -p @SCHEME_SRC@/@MACH@/boot/@MACH@ - $(MAKE) @SCHEME_SRC@/@MACH@/boot/@MACH@/equates.h - $(MAKE) @SCHEME_SRC@/@MACH@/boot/@MACH@/petite.boot - $(MAKE) @SCHEME_SRC@/@MACH@/boot/@MACH@/scheme.boot - cd @SCHEME_SRC@ && $(MAKE) + cd $(SCHEME_SRC) && git submodule -q init && git submodule -q update + cd $(SCHEME_SRC) && ./configure @SCHEME_CONFIG_ARGS@ $(SCHEME_CONFIG_VARS) + mkdir -p $(SCHEME_SRC)/$(MACH)/boot/$(MACH) + $(MAKE) $(SCHEME_SRC)/$(MACH)/boot/$(MACH)/equates.h + $(MAKE) $(SCHEME_SRC)/$(MACH)/boot/$(MACH)/petite.boot + $(MAKE) $(SCHEME_SRC)/$(MACH)/boot/$(MACH)/scheme.boot + cd $(SCHEME_SRC) && $(MAKE) # Replace "equates.h", etc., if they seem to be out of date. # Otherwise, `make` on Chez Scheme can fail. -@SCHEME_SRC@/@MACH@/boot/@MACH@/equates.h: @SCHEME_SRC@/boot/@MACH@/equates.h - cp @SCHEME_SRC@/boot/@MACH@/equates.h @SCHEME_SRC@/@MACH@/boot/@MACH@/equates.h -@SCHEME_SRC@/@MACH@/boot/@MACH@/petite.boot: @SCHEME_SRC@/boot/@MACH@/petite.boot - cp @SCHEME_SRC@/boot/@MACH@/petite.boot @SCHEME_SRC@/@MACH@/boot/@MACH@/petite.boot -@SCHEME_SRC@/@MACH@/boot/@MACH@/scheme.boot: @SCHEME_SRC@/boot/@MACH@/scheme.boot - cp @SCHEME_SRC@/boot/@MACH@/scheme.boot @SCHEME_SRC@/@MACH@/boot/@MACH@/scheme.boot +$(SCHEME_SRC)/$(MACH)/boot/$(MACH)/equates.h: $(SCHEME_SRC)/boot/$(MACH)/equates.h + cp $(SCHEME_SRC)/boot/$(MACH)/equates.h $(SCHEME_SRC)/$(MACH)/boot/$(MACH)/equates.h +$(SCHEME_SRC)/$(MACH)/boot/$(MACH)/petite.boot: $(SCHEME_SRC)/boot/$(MACH)/petite.boot + cp $(SCHEME_SRC)/boot/$(MACH)/petite.boot $(SCHEME_SRC)/$(MACH)/boot/$(MACH)/petite.boot +$(SCHEME_SRC)/$(MACH)/boot/$(MACH)/scheme.boot: $(SCHEME_SRC)/boot/$(MACH)/scheme.boot + cp $(SCHEME_SRC)/boot/$(MACH)/scheme.boot $(SCHEME_SRC)/$(MACH)/boot/$(MACH)/scheme.boot scheme-cross: - cd @SCHEME_SRC@ && git submodule -q init && git submodule -q update - cd @SCHEME_SRC@ && ./configure @SCHEME_CROSS_CONFIG_ARGS@ $(SCHEME_CONFIG_VARS) - cd @SCHEME_SRC@/@TARGET_MACH@/c && $(MAKE) o=o cross=t - $(MAKE) @SCHEME_SRC@/@TARGET_MACH@/boot/@TARGET_MACH@/scheme.boot + cd $(SCHEME_SRC) && git submodule -q init && git submodule -q update + cd $(SCHEME_SRC) && ./configure @SCHEME_CROSS_CONFIG_ARGS@ $(SCHEME_CONFIG_VARS) + cd $(SCHEME_SRC)/$(TARGET_MACH)/c && $(MAKE) o=o cross=t + $(MAKE) $(SCHEME_SRC)/$(TARGET_MACH)/s/xpatch -# Rebuild cross "petite.boot" and "scheme.boot" when older +# Rebuild patch file and cross "petite.boot" and "scheme.boot" when older # than the build-host "scheme.boot" -@SCHEME_SRC@/@TARGET_MACH@/boot/@TARGET_MACH@/scheme.boot@DIFF_MACH@: @SCHEME_SRC@/@MACH@/boot/@MACH@/scheme.boot - cd @SCHEME_SRC@/@TARGET_MACH@/s && $(MAKE) -f Mf-cross m=@MACH@ xm=@TARGET_MACH@ Scheme="$(SCHEME_BIN)" SCHEMEHEAPDIRS="$(SCHEME_INC)" +$(SCHEME_SRC)/$(TARGET_MACH)/s/xpatch: $(SCHEME_SRC)/$(MACH)/boot/$(MACH)/scheme.boot + cd $(SCHEME_SRC)/$(TARGET_MACH)/s && $(MAKE) -f Mf-cross m=$(MACH) xm=$(TARGET_MACH) Scheme="$(SCHEME_BIN)" SCHEMEHEAPDIRS="$(SCHEME_INC)" XPATCH = -XPATCHcross = --xpatch $(SCHEME_SRC)/@TARGET_MACH@/s/xpatch +XPATCHcross = --xpatch $(SCHEME_SRC)/$(TARGET_MACH)/s/xpatch racket.boot: racket.so $(SCHEME) --script $(srcdir)/convert-to-boot.ss @COMPRESS_COMP@ $(XPATCH@CROSS_MODE@) racket.so racket.boot $(TARGET_MACH) @@ -252,7 +253,7 @@ EXE_DESTS = ++exe raw_racketcs.exe RacketCS.exe ++exe raw_gracketcs.exe GRacketC V_BOOTS = petite-v.boot scheme-v.boot racket-v.boot RacketCS.exe GRacketCS.exe $(RKT_DLL): raw_libracketcs.dll raw_gracketcs.exe raw_racketcs.exe $(EMBED_DEPS) $(V_BOOTS) - $(BOOTSTRAP_RACKET) $(srcdir)/embed-boot.rkt --target @TARGET_MACH@ @COMPRESS_COMP@ $(EXE_DESTS) raw_libracketcs.dll $(RKT_DLL) $(V_BOOTS) + $(BOOTSTRAP_RACKET) $(srcdir)/embed-boot.rkt --target $(TARGET_MACH) @COMPRESS_COMP@ $(EXE_DESTS) raw_libracketcs.dll $(RKT_DLL) $(V_BOOTS) raw_racketcs.exe: main.o MemoryModule.o rres.o $(CC) $(CFLAGS) -o raw_racketcs.exe main.o MemoryModule.o rres.o $(LDFLAGS) @@ -294,30 +295,40 @@ gstart_rc.o: $(srcdir)/../../worksp/starters/start.rc @WINDRES@ -DMRSTART -i $(srcdir)/../../worksp/starters/start.rc -o gstart_rc.o install@MINGW@: - $(MAKE) plain-install CS_INSTALLED=`echo $(CS_INSTALLED) | awk '{print toupper($0)}'` + $(MAKE) plain-install plain-install@MINGW@: + $(MAKE) plain-install-upcased CS_INSTALLED=`echo $(CS_INSTALLED) | awk '{print toupper($0)}'` + +plain-install-upcased: $(ICP) libracketcsxxxxxxx.dll $(libdir)/libracketcsxxxxxxx.dll $(ICP) RacketCS.exe $(prefix)/Racket$(CS_INSTALLED).exe $(ICP) GRacketCS.exe $(libpltdir)/GRacket$(CS_INSTALLED).exe $(ICP) MzStart.exe $(libpltdir)/MzStart.exe $(ICP) MrStart.exe $(libpltdir)/MrStart.exe $(MAKE) system-install - $(MAKE) racket-xpatch.$(TARGET_MACH) + $(MAKE) compile-xpatch.$(TARGET_MACH) + $(MAKE) library-xpatch.$(TARGET_MACH) + +SCHEME_XPATCH = $(SCHEME_SRC)/$(TARGET_MACH)/s/xpatch + +compile-xpatch.$(TARGET_MACH): $(SCHEME_XPATCH) $(srcdir)/mk-cross-serve.ss $(srcdir)/cross-serve.ss + $(SCHEME) --script $(srcdir)/mk-cross-serve.ss $(srcdir)/cross-serve.ss + cat cross-serve.so $(SCHEME_XPATCH) > compile-xpatch.$(TARGET_MACH) -SCHEME_XPATCH = $(SCHEME_SRC)/@TARGET_MACH@/s/xpatch RACKET_XPATCH = chezpart.$(MACH) rumble.$(MACH) thread.$(MACH) \ io.$(MACH) regexp.$(MACH) schemify.$(MACH) linklet.$(MACH) expander.$(MACH) -ALL_XPATCH = $(SCHEME_XPATCH) $(RACKET_XPATCH) -racket-xpatch.$(TARGET_MACH): $(ALL_XPATCH) - cat $(ALL_XPATCH) > racket-xpatch.$(TARGET_MACH) +library-xpatch.$(TARGET_MACH): $(RACKET_XPATCH) + cat $(RACKET_XPATCH) > library-xpatch.$(TARGET_MACH) # ---------------------------------------- # Common -DEF_COLLECTS_DIR = -DINITIAL_COLLECTS_DIRECTORY='"'"`cd $(srcdir)/../../../collects; pwd`"'"' -DEF_CONFIG_DIR = -DINITIAL_CONFIG_DIRECTORY='"'"`cd $(srcdir)/../../..; pwd`/etc"'"' +DEF_COLLECTS_DIR@NOT_MINGW@ = -DINITIAL_COLLECTS_DIRECTORY='"'"`cd $(srcdir)/../../../collects; pwd`"'"' +DEF_CONFIG_DIR@NOT_MINGW@ = -DINITIAL_CONFIG_DIRECTORY='"'"`cd $(srcdir)/../../..; pwd`/etc"'"' +DEF_COLLECTS_DIR@MINGW@ = +DEF_CONFIG_DIR@MINGW@ = DEF_C_DIRS = $(DEF_COLLECTS_DIR) $(DEF_CONFIG_DIR) COMP_SUBDIR = -DCS_COMPILED_SUBDIR=@CS_COMPILED_SUBDIR@ @@ -344,8 +355,18 @@ install@NOT_MINGW@: $(MAKE) plain-install $(MAKE) setup-install +# RUN_RACKET typically redirects to RUN_THIS_RACKET, but it can also +# redirect to a compatible existing Racket executable (e.g., for +# cross-compilation) +RUN_THIS_RACKET = $(DESTDIR)$(bindir)/racket$(CS_INSTALLED) + +INST_CONFIG = -X "$(DESTDIR)$(collectsdir)" -G "$(DESTDIR)$(configdir)" +SETUP_RACKET_FLAGS = $(INST_CONFIG) $(SETUP_MACHINE_FLAGS) $(SELF_RACKET_FLAGS) @INSTALL_SETUP_RACKET_FLAGS@ +SETUP_SETUP_FLAGS = @INSTALL_SETUP_FLAGS@ $(PLT_SETUP_OPTIONS) $(PLT_ISO) +SETUP_ARGS = $(SETUP_RACKET_FLAGS) -N "raco" -l- setup $(SETUP_SETUP_FLAGS) + setup-install: - $(DESTDIR)$(bindir)/racket$(CS_INSTALLED) $(SELF_RACKET_FLAGS) -N raco -l- raco setup $(PLT_SETUP_OPTIONS) + @RUN_RACKET@ $(SELF_RACKET_FLAGS) $(SETUP_ARGS) no-setup-install: echo done @@ -410,3 +431,15 @@ macos-install-gracket: $(STRIP_DEBUG) $(DESTDIR)"$(libpltdir)/GRacket$(CS_GR_INSTALLED).app/Contents/MacOS/GRacket$(CS_GR_INSTALLED)" rm -rf $(DESTDIR)"$(libpltdir)/Starter.app" $(ICP) -r Starter.app $(DESTDIR)"$(libpltdir)/." + +# ---------------------------------------- +# Reconfigure + +CONFIGURE_SRCS = $(srcdir)/configure $(srcdir)/Makefile.in \ + $(srcdir)/../../rktio/Makefile.in $(srcdir)/../../rktio/configure + +reconfigure: + $(MAKE) Makefile + +Makefile: $(CONFIGURE_SRCS) + $(srcdir)/configure $(CONFIGURE_ARGS_qq) $(MORE_CONFIGURE_ARGS) diff --git a/racket/src/cs/c/boot.c b/racket/src/cs/c/boot.c index bcc400aff1..8e2fc12d2f 100644 --- a/racket/src/cs/c/boot.c +++ b/racket/src/cs/c/boot.c @@ -128,9 +128,14 @@ void racket_boot(int argc, char **argv, char *exec_file, char *run_file, #if !defined(RACKET_USE_FRAMEWORK) || !defined(RACKET_AS_BOOT) int fd; #endif +#ifdef RACKET_AS_BOOT + int skip_racket_boot = 0; +#endif #ifdef RACKET_USE_FRAMEWORK const char *fw_path; #endif + const char *cross_server_patch_file = NULL; + const char *cross_server_library_file = NULL; #ifdef WIN32 if (dlldir) @@ -141,12 +146,21 @@ void racket_boot(int argc, char **argv, char *exec_file, char *run_file, Sscheme_init(NULL); + if ((argc == 3) && !strcmp(argv[0], "--cross-server")) { + cross_server_patch_file = argv[1]; + cross_server_library_file = argv[2]; +#ifdef RACKET_AS_BOOT + skip_racket_boot = 1; +#endif + } + #ifdef RACKET_USE_FRAMEWORK fw_path = get_framework_path(); Sregister_boot_file(path_append(fw_path, "petite.boot")); Sregister_boot_file(path_append(fw_path, "scheme.boot")); # ifdef RACKET_AS_BOOT - Sregister_boot_file(path_append(fw_path, "racket.boot")); + if (!skip_racket_boot) + Sregister_boot_file(path_append(fw_path, "racket.boot")); # endif #else fd = open(boot_exe, O_RDONLY | BOOT_O_BINARY); @@ -163,15 +177,32 @@ void racket_boot(int argc, char **argv, char *exec_file, char *run_file, Sregister_boot_file_fd("scheme", fd2); # ifdef RACKET_AS_BOOT - fd = open(boot_exe, O_RDONLY | BOOT_O_BINARY); - lseek(fd, pos3, SEEK_SET); - Sregister_boot_file_fd("racket", fd); + if (!skip_racket_boot) { + fd = open(boot_exe, O_RDONLY | BOOT_O_BINARY); + lseek(fd, pos3, SEEK_SET); + Sregister_boot_file_fd("racket", fd); + } # endif } #endif Sbuild_heap(NULL, init_foreign); + if (cross_server_patch_file) { + /* Don't run Racket as usual. Instead, load the patch + file and run `serve-cross-compile` */ + ptr c, a; + c = Stop_level_value(Sstring_to_symbol("load")); + a = Sstring(cross_server_patch_file); + (void)Scall1(c, a); + c = Stop_level_value(Sstring_to_symbol("load")); /* this is the patched load */ + a = Sstring(cross_server_library_file); + (void)Scall1(c, a); + c = Stop_level_value(Sstring_to_symbol("serve-cross-compile")); + (void)Scall0(c); + racket_exit(0); + } + { ptr l = Snil; int i; diff --git a/racket/src/cs/c/configure b/racket/src/cs/c/configure index b9834f327f..e3ddc8653f 100755 --- a/racket/src/cs/c/configure +++ b/racket/src/cs/c/configure @@ -622,6 +622,9 @@ ac_includes_default="\ ac_subst_vars='LTLIBOBJS LIBOBJS +INSTALL_SETUP_RACKET_FLAGS +INSTALL_SETUP_FLAGS +RUN_RACKET CROSS_COMPILE_TARGET_KIND CS_COMPILED_SUBDIR CS_INSTALLED @@ -2808,6 +2811,10 @@ FRAMEWORK_INSTALL_DIR='$(libpltdir)' FRAMEWORK_PREFIX='@executable_path/../lib/' RACKET='$(DEFAULT_RACKET)' +RUN_RACKET='$(RUN_THIS_RACKET)' + +INSTALL_SETUP_FLAGS= +INSTALL_SETUP_RACKET_FLAGS= enable_pthread_by_default=yes @@ -4098,16 +4105,9 @@ else fi if test "${CROSS_MODE}" = "cross" ; then - if test "${enable_scheme}" = "" ; then - echo "Need --enable-scheme=... for cross-build mode" - exit 1 - fi - if test "${enable_racket}" = "" ; then - echo "Need --enable-racket=... for cross-build mode" - exit 1 - fi T_CROSS_MODE="-cross" TT_CROSS_MODE="--cross" + RUN_RACKET='$(RACKET)' else T_CROSS_MODE="" TT_CROSS_MODE="" @@ -4964,6 +4964,9 @@ CPPFLAGS="$CPPFLAGS $PREFLAGS" + + + diff --git a/racket/src/cs/c/configure.ac b/racket/src/cs/c/configure.ac index aca56f3fa3..240258a67a 100644 --- a/racket/src/cs/c/configure.ac +++ b/racket/src/cs/c/configure.ac @@ -123,6 +123,10 @@ FRAMEWORK_INSTALL_DIR='$(libpltdir)' FRAMEWORK_PREFIX='@executable_path/../lib/' RACKET='$(DEFAULT_RACKET)' +RUN_RACKET='$(RUN_THIS_RACKET)' + +INSTALL_SETUP_FLAGS= +INSTALL_SETUP_RACKET_FLAGS= enable_pthread_by_default=yes @@ -354,16 +358,9 @@ else fi if test "${CROSS_MODE}" = "cross" ; then - if test "${enable_scheme}" = "" ; then - echo "Need --enable-scheme=... for cross-build mode" - exit 1 - fi - if test "${enable_racket}" = "" ; then - echo "Need --enable-racket=... for cross-build mode" - exit 1 - fi T_CROSS_MODE="-cross" TT_CROSS_MODE="--cross" + RUN_RACKET='$(RACKET)' else T_CROSS_MODE="" TT_CROSS_MODE="" @@ -621,6 +618,9 @@ AC_SUBST(FRAMEWORK_REL_INSTALL) AC_SUBST(CS_INSTALLED) AC_SUBST(CS_COMPILED_SUBDIR) AC_SUBST(CROSS_COMPILE_TARGET_KIND) +AC_SUBST(RUN_RACKET) +AC_SUBST(INSTALL_SETUP_FLAGS) +AC_SUBST(INSTALL_SETUP_RACKET_FLAGS) makefiles="Makefile" diff --git a/racket/src/cs/c/cross-serve.ss b/racket/src/cs/c/cross-serve.ss new file mode 100644 index 0000000000..08ed84b187 --- /dev/null +++ b/racket/src/cs/c/cross-serve.ss @@ -0,0 +1,56 @@ +;; The client half of this interaction is in "cs/linklet/cross-compile.ss". + +;; Communication uses the Chez Scheme printer and reader so make the +;; server independent from Racket, although it is run by the Racket +;; executable. + +;; Suppress printout on startup: +(define original-output-port (current-output-port)) +(let-values ([(o get) (open-bytevector-output-port (current-transcoder))]) + (current-output-port o)) + +;; Server function to run after cross-compiler is loaded: +(define (serve-cross-compile) + ;; Don't exit due to Ctl-C: + (keyboard-interrupt-handler void) + ;; Restore output + (current-output-port original-output-port) + ;; Set up the enviornment + (expand `(import (rename (rumble) + [correlated? syntax?] + [correlated-source syntax-source] + [correlated-line syntax-line] + [correlated-column syntax-column] + [correlated-position syntax-position] + [correlated-span syntax-span] + [correlated-e syntax-e] + [correlated->datum syntax->datum] + [datum->correlated datum->syntax] + [correlated-property syntax-property] + [correlated-property-symbol-keys syntax-property-symbol-keys]) + (thread) + (io) + (regexp) + (linklet))) + (expand-omit-library-invocations #t) + ;; Serve requests to compile or to fasl data: + (let loop () + (let ([cmd (read)]) + (unless (eof-object? cmd) + (let-values ([(o get) (open-bytevector-output-port)]) + (case cmd + [(compile) + (compile-to-port (list `(lambda () ,(read-fasled))) o)] + [else + (error 'serve-cross-compile (format "unrecognized command: ~s" cmd))]) + (let ([result (get)]) + (write result) + (newline) + (flush-output-port))) + (loop))))) + +;; ---------------------------------------- + +(define (read-fasled) + (let ([bstr (read)]) + (fasl-read (open-bytevector-input-port bstr)))) diff --git a/racket/src/cs/c/mk-cross-serve.ss b/racket/src/cs/c/mk-cross-serve.ss new file mode 100644 index 0000000000..26ae7cdb5e --- /dev/null +++ b/racket/src/cs/c/mk-cross-serve.ss @@ -0,0 +1,2 @@ +(let ([args (command-line-arguments)]) + (compile-file (car args) "cross-serve.so")) diff --git a/racket/src/cs/linklet.sls b/racket/src/cs/linklet.sls index 9cc2254ac4..34e4d2ebf2 100644 --- a/racket/src/cs/linklet.sls +++ b/racket/src/cs/linklet.sls @@ -30,7 +30,6 @@ variable-reference-from-unsafe? add-cross-compiler! ; not exported to racket - unmarshal-annotation ; not exported to racket compile-enforce-module-constants compile-context-preservation-enabled @@ -88,11 +87,15 @@ find-system-path build-path format + ;; Used by cross-compiler: get-original-error-port subprocess write-string flush-output - read-line) + read-line + split-path + path->complete-path + file-exists?) (only (thread) current-process-milliseconds ;; Used by cross-compiler: @@ -249,7 +252,9 @@ (define (make-cross-compile-to-bytevector machine) (lambda (s paths format) (let ([bv (cond - [(eq? format 'interpret) (cross-fasl-to-string machine s)] + [(eq? format 'interpret) + ;; fasl format is not machine-specific: + (compile-to-bytevector s paths format)] [else (cross-compile machine s)])]) (if compress-code? (bytevector-compress bv) @@ -532,7 +537,11 @@ (lambda (expr arity-mask name) (performance-region 'compile-nested - (let ([code ((if serializable? compile*-to-bytevector compile*) + (let ([code ((if serializable? + (if cross-machine + (lambda (s) (cross-compile cross-machine s)) + compile*-to-bytevector) + compile*) (show lambda-on? "lambda" (correlated->annotation expr)))]) (if serializable? (make-wrapped-code code arity-mask name) diff --git a/racket/src/cs/linklet/annotation.ss b/racket/src/cs/linklet/annotation.ss index 2ec572b942..740302bd38 100644 --- a/racket/src/cs/linklet/annotation.ss +++ b/racket/src/cs/linklet/annotation.ss @@ -94,69 +94,3 @@ s (cons a d)))] [else s])) - -;; -------------------------------------------------- - -;; Used for cross-compiler communication - -(define-record-type marshaled-annotation - (fields expression source-object) - (nongenerative #{marshaled-annotation gd3r4cl07w9emgzjvdmpf3qpq-0})) - -(define (marshal-annotation v) - (cond - [(annotation? v) - (make-marshaled-annotation (marshal-annotation (annotation-expression v)) - (mashal-source-object (annotation-source v)))] - [(pair? v) - (let ([a (marshal-annotation (car v))] - [d (marshal-annotation (cdr v))]) - (if (and (eq? a (car v)) - (eq? d (cdr v))) - v - (cons a d)))] - [else v])) - -(define (mashal-source-object s) - (vector (source-file-descriptor-path (source-object-sfd s)) - (source-object-bfp s) - (source-object-efp s) - (source-object-line s) - (source-object-column s))) - -(define (unmarshal-annotation v) - (let ([ht (make-hashtable equal-hash equal?)]) - (let-values ([(a stripped) - (let loop ([v v]) - (cond - [(marshaled-annotation? v) - (let-values ([(e s-e) (loop (marshaled-annotation-expression v))]) - (values (make-annotation e - (unmarshal-source-object - (marshaled-annotation-source-object v) - ht) - s-e) - s-e))] - [(pair? v) - (let-values ([(a s-a) (loop (car v))] - [(d s-d) (loop (cdr v))]) - (if (and (eq? a (car v)) - (eq? d (cdr v))) - (values v v) - (values (cons a d) (cons s-a s-d))))] - [else (values v v)]))]) - a))) - -(define (unmarshal-source-object s ht) - (let ([p (#%vector-ref s 0)] - [bfp (#%vector-ref s 1)] - [efp (#%vector-ref s 2)] - [line (#%vector-ref s 3)] - [column (#%vector-ref s 4)]) - (let ([sfd (or (hashtable-ref ht p #f) - (let ([sfd (source-file-descriptor p 0)]) - (hashtable-set! ht p sfd) - sfd))]) - (cond - [line (make-source-object sfd bfp efp line column)] - [else (make-source-object sfd bfp efp)])))) diff --git a/racket/src/cs/linklet/cross-compile.ss b/racket/src/cs/linklet/cross-compile.ss index 5efd0c7b86..a588bfa543 100644 --- a/racket/src/cs/linklet/cross-compile.ss +++ b/racket/src/cs/linklet/cross-compile.ss @@ -1,4 +1,4 @@ -;; The server half of this interaction is in "../main/cross-compile.ss". +;; The server half of this interaction is in "../c/cross-serve.ss". ;; Currently, cross-compilation support in Chez Scheme replaces the ;; compiler for the build machine. Until that changes, we can't load @@ -52,23 +52,17 @@ (unsafe-place-local-set! cross-machine-compiler-cache (cons a (unsafe-place-local-ref cross-machine-compiler-cache))))) -(define (do-cross machine msg v) +(define (cross-compile machine v) (let* ([a (find-cross 'cross-compile machine)] [ch (cadr a)] [reply-ch (make-channel)]) - (channel-put ch (list msg - (marshal-annotation v) + (channel-put ch (list 'compile + v reply-ch)) (begin0 (channel-get reply-ch) (cache-cross-compiler a)))) -(define (cross-compile machine v) - (do-cross machine 'compile v)) - -(define (cross-fasl-to-string machine v) - (do-cross machine 'fasl v)) - ;; Start a compiler as a Racket thread under the root custodian. ;; Using Racket's scheduler lets us use the event and I/O system, ;; including support for running a process and managing resources @@ -84,8 +78,8 @@ (let clean-up () (when (will-try-execute we) (clean-up))) - (let ([exe (car exe+x)] - [xpatch (cdr exe+x)] + (let ([exe (find-exe (car exe+x))] + [xpatch-dir (cdr exe+x)] [msg-ch (make-channel)] [c (unsafe-make-custodian-at-root)]) (with-continuation-mark @@ -98,11 +92,14 @@ ;; At this point, we're under the root custodian (thread (lambda () + (define (patchfile base) + (build-path xpatch-dir (string-append base "-xpatch." (symbol->string machine)))) (let-values ([(subproc from to err) (subprocess #f #f (get-original-error-port) exe "--cross-server" - xpatch)]) + (patchfile "compile") + (patchfile "library"))]) (define (->string v) (#%format "~s\n" v)) (define (string-> str) (#%read (open-string-input-port str))) ;; If this compiler instance becomes unreachable because the @@ -112,8 +109,53 @@ (let ([msg (channel-get msg-ch)]) ;; msg is (list ) (write-string (->string (car msg)) to) - (write-string (->string (cadr msg)) to) + (write-string (->string (fasl-to-bytevector (cadr msg))) to) (flush-output to) (channel-put (caddr msg) (string-> (read-line from))) (loop))))))) (list machine msg-ch)))) + +(define (fasl-to-bytevector v) + (let-values ([(o get) (open-bytevector-output-port)]) + (fasl-write v o) + (get))) + +(define (find-exe exe) + (let-values ([(base name dir?) (split-path exe)]) + (cond + [(eq? base 'relative) + (let loop ([paths (get-exe-search-path)]) + (cond + [(null? paths) exe] + [else + (let ([f (build-path (car paths) exe)]) + (if (file-exists? f) + f + (loop (cdr paths))))]))] + [else + (path->complete-path exe (find-system-path 'orig-dir))]))) + +(define (get-exe-search-path) + (define (accum->path one-accum) + (bytes->path (u8-list->bytevector (reverse one-accum)))) + (let ([path (environment-variables-ref + (|#%app| current-environment-variables) + (string->utf8 "PATH"))]) + (cond + [(not path) '()] + [else + (let loop ([bytes (bytevector->u8-list path)] [one-accum '()] [accum '()]) + (cond + [(null? bytes) (let ([accum (if (null? one-accum) + accum + (cons (accum->path one-accum) + accum))]) + (reverse accum))] + [(eqv? (car bytes) (if (eq? 'windows (system-type)) + (char->integer #\;) + (char->integer #\:))) + (if (null? one-accum) + (loop (cdr bytes) '() accum) + (loop (cdr bytes) '() (cons (accum->path one-accum) accum)))] + [else + (loop (cdr bytes) (cons (car bytes) one-accum) accum)]))]))) diff --git a/racket/src/cs/linklet/write.ss b/racket/src/cs/linklet/write.ss index f671987b79..23a8a01c0d 100644 --- a/racket/src/cs/linklet/write.ss +++ b/racket/src/cs/linklet/write.ss @@ -5,11 +5,9 @@ (define (write-linklet-bundle-hash ht dest-o) (let-values ([(ht cross-machine) (encode-linklet-paths ht)]) - (let ([bstr (if cross-machine - (cross-fasl-to-string cross-machine ht) - (let-values ([(o get) (open-bytevector-output-port)]) - (fasl-write* ht o) - (get)))]) + (let ([bstr (let-values ([(o get) (open-bytevector-output-port)]) + (fasl-write* ht o) + (get))]) (write-bytes (integer->integer-bytes (bytes-length bstr) 4 #f #f) dest-o) (write-bytes bstr dest-o)))) diff --git a/racket/src/cs/main.sps b/racket/src/cs/main.sps index 8e255355db..d042190e5c 100644 --- a/racket/src/cs/main.sps +++ b/racket/src/cs/main.sps @@ -46,8 +46,7 @@ linklet-performance-report! current-compile-target-machine compile-target-machine? - add-cross-compiler! - unmarshal-annotation)) + add-cross-compiler!)) (linklet-performance-init!) (unless omit-debugging? @@ -148,7 +147,6 @@ (machine-type))) (define compiled-roots-path-list-string (getenv "PLTCOMPILEDROOTS")) (define embedded-load-in-places #f) - (define cross-compile-server-patch-file #f) (define (see saw . args) (let loop ([saw saw] [args args]) @@ -296,7 +294,6 @@ loads))) (include "main/help.ss") - (include "main/cross-compile.ss") (define-syntax string-case ;; Assumes that `arg` is a variable @@ -533,17 +530,18 @@ (loop rest-args))] [("--cross-compiler") (let-values ([(mach rest-args) (next-arg "target machine" arg within-arg args)]) - (let-values ([(xpatch-file rest-args) (next-arg "cross-compiler path" arg within-arg (cons arg rest-args))]) + (let-values ([(xpatch-dir rest-args) (next-arg "cross-compiler path" arg within-arg (cons arg rest-args))]) (add-cross-compiler! (string->symbol mach) - (path->complete-path (->path (find-original-bytes xpatch-file))) + (path->complete-path (->path (find-original-bytes xpatch-dir))) (find-system-path 'exec-file)) (loop rest-args)))] [("--cross-server") - (let-values ([(xpatch-file rest-args) (next-arg "xpatch path" arg within-arg args)]) - (set! cross-compile-server-patch-file xpatch-file) - (when (or (saw-something? saw) - (not (null? rest-args))) - (raise-user-error 'racket "--cross-server cannot be combined with any other arguments")) + (let-values ([(scheme-xpatch-file rest-args) (next-arg "compiler xpatch path" arg within-arg args)]) + (let-values ([(scheme-xpatch-file rest-args) (next-arg "library xpatch path" arg within-arg (cons arg rest-args))]) + (when (or (saw-something? saw) + (not (null? rest-args))) + (raise-user-error 'racket "--cross-server cannot be combined with any other arguments"))) + (raise-user-error 'racket "--cross-server should have been handled earlier") (flags-loop null (see saw 'non-config)))] [("-j" "--no-jit") (loop (cdr args))] @@ -765,9 +763,6 @@ (call-in-main-thread (lambda () (initialize-place!) - (when cross-compile-server-patch-file - ;; does not return: - (serve-cross-compile cross-compile-server-patch-file)) (when init-library (namespace-require+ init-library)) diff --git a/racket/src/cs/main/cross-compile.ss b/racket/src/cs/main/cross-compile.ss deleted file mode 100644 index 6c084b8e6d..0000000000 --- a/racket/src/cs/main/cross-compile.ss +++ /dev/null @@ -1,34 +0,0 @@ -;; The client half of this interaction is in "../linklet/cross-compile.ss". -;; Communication uses the Chez Scheme printer and reader so make the -;; server as independent from Racket as possible. We don't even need -;; this code to run as part of Racket CS, but it's convenient to -;; organize things that way. - -(define (serve-cross-compile cross-compile-server-patch-file) - (break-enabled #f) ; exit on EOF, but not on a break signal - (unsafe-start-atomic) - (call-with-system-wind - (lambda () - (let-values ([(o get) (open-bytevector-output-port (current-transcoder))]) - (parameterize ([#%current-output-port o]) - ;; Loading the patch file disables normal `compile` and makes - ;; `compile-to-port` compile to some other machine type: - (#%load cross-compile-server-patch-file))) - ;; Serve requests to compile or to fasl data: - (let loop () - (let ([cmd (#%read)]) - (unless (eof-object? cmd) - (let-values ([(o get) (open-bytevector-output-port)]) - (case cmd - [(fasl) - (fasl-write (unmarshal-annotation (#%read)) o)] - [(compile) - (compile-to-port (list `(lambda () ,(unmarshal-annotation (#%read)))) o)] - [else - (#%error 'serve-cross-compile (#%format "unrecognized command: ~s" cmd))]) - (let ([result (get)]) - (#%write result) - (#%newline) - (#%flush-output-port))) - (loop)))))) - (exit)) diff --git a/racket/src/expander/compile/correlated-linklet.rkt b/racket/src/expander/compile/correlated-linklet.rkt index 26282d67b0..102b501167 100644 --- a/racket/src/expander/compile/correlated-linklet.rkt +++ b/racket/src/expander/compile/correlated-linklet.rkt @@ -10,6 +10,7 @@ correlated-linklet-name force-compile-linklet + eval-correlated-linklet correlated-linklet-vm-bytes write-correlated-linklet-bundle-hash @@ -33,6 +34,21 @@ c))] [else l])) +;; Ignore compiled version, if any, and evaluate from correlated source: +(define (eval-correlated-linklet l) + (cond + [(correlated-linklet? l) + (eval-linklet + ;; Omitting `'serializable` should generate a preferred and + ;; executable compilation + (compile-linklet (correlated-linklet-expr l) + (correlated-linklet-name l) + #f + (lambda (import-key) (values #f #f)) + '()))] + [else + (error 'eval-correlated-linklet "cannot evaluate unknown linklet: ~s" l)])) + ;; ---------------------------------------- (define correlated-linklet-vm-bytes #"linklet") diff --git a/racket/src/expander/compile/recompile.rkt b/racket/src/expander/compile/recompile.rkt index 1055919d1a..3cf18ddf52 100644 --- a/racket/src/expander/compile/recompile.rkt +++ b/racket/src/expander/compile/recompile.rkt @@ -20,8 +20,9 @@ (define (compiled-expression-recompile c) (unless (compiled-expression? c) (raise-argument-error 'compiled-expression-recompile "compiled-expression?" c)) + (define target-machine (current-compile-target-machine)) (cond - [(not (current-compile-target-machine)) + [(not target-machine) ;; There's no use for machine-independent mode, and ;; `recompile-bundle` assumes that it should actually compile c] @@ -43,7 +44,8 @@ "submodule path" k)) (hash-set! recompileds k (recompile-bundle b force-recompile-bundle - ns))) + ns + target-machine))) (hash-ref recompileds k)) (for ([k (in-hash-keys bundles)]) (force-recompile-bundle k)) @@ -95,7 +97,7 @@ #:authentic) ;; Takes a bundle and returns a recompiled -(define (recompile-bundle b get-submodule-recompiled ns) +(define (recompile-bundle b get-submodule-recompiled ns target-machine) ;; We have to execute the parts of the bundle that supply data, such ;; as the mpis and link modules, then use that data for cross-module ;; optimization while recompiling the per-phase body units, and then @@ -111,11 +113,20 @@ (values k (force-compile-linklet v))] [else (values k v)]))) + ;; For now, there's ony one target machine that is supported by each VM: + (define can-eval-compiled? + (eq? target-machine (system-type 'target-machine))) + + (define (eval-metadata-linklet key) + (if can-eval-compiled? + (eval-linklet (hash-ref h key)) + (eval-correlated-linklet (hash-ref orig-h key)))) + (define data-instance - (instantiate-linklet (eval-linklet (hash-ref h 'data)) + (instantiate-linklet (eval-metadata-linklet 'data) (list deserialize-instance))) (define declaration-instance - (instantiate-linklet (eval-linklet (hash-ref h 'decl)) + (instantiate-linklet (eval-metadata-linklet 'decl) (list deserialize-instance data-instance))) (define (decl key)