add machine-independent compilation mode

The `compile-machine-indendent` parameter controls whether `compile`
creates a compiled expression that writes (usually in a ".zo" file) to
a machine-independent form that works for anhy Racket platform and
virtual machine. The parameter can be set through the
`-M`/`--compile-any` command-line flag or the `PLT_COMPILE_ANY`
environment variable.

Loading machine-independent code is too slow for many purposes, but
separating macro expansion from backend compilation seems likely to be
a piece of the puzzle from cross-compilation and faster distribution
builds.

pkgs/base/info.rkt

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

pkgs/racket-doc/scribblings/reference/eval.scrbl

@@ -581,6 +581,25 @@ information to be lost from stack traces (as reported by
 @racket[continuation-mark-set->context]). The default is @racket[#f],
 which allows such optimizations.}
 
+@defboolparam[compile-machine-independent on?]{
+
+A @tech{parameter} that determines whether a newly compiled expression
+writes in a machine-independent format (usually in @filepath{.zo}
+files). Machine-independent compiled code works for any platform and
+any Racket virtual machine. When the machine-independent compiled
+expression is read back in, it is subject to further compilation for
+the current platform and virtual machine, which can be considerably
+slower than reading a format that is fully compiled for a platform and
+virtual machine.
+
+The default is @racket[#f], unless machine-independent mode is enabled
+through the @Flag{M}/@DFlag{compile-any} command-line flag to
+stand-alone Racket (or GRacket) or through the
+@as-index{@envvar{PLT_COMPILE_ANY}} environment variable (set to any
+value).
+
+@history[#:added "7.1.0.5"]}
+
 @defboolparam[eval-jit-enabled on?]{
 
 @guidealso["JIT"]

pkgs/racket-doc/scribblings/reference/startup.scrbl

@@ -343,6 +343,11 @@ flags:
         native-code just-in-time compiler by setting the
         @racket[eval-jit-enabled] parameter to @racket[#f].}
 
+  @item{@FlagFirst{M} or @DFlagFirst{compile-any} : Enables
+        machine-independent bytecode by setting the
+        @racket[compile-machine-independent] parameter to
+        @racket[#t].}
+
   @item{@FlagFirst{d} or @DFlagFirst{no-delay} : Disables on-demand
         parsing of compiled code and syntax objects by setting the
         @racket[read-on-demand-source] parameter to @racket[#f].}
@@ -456,7 +461,8 @@ of the collapsed set.
 Extra arguments following the last option are available from the
 @indexed-racket[current-command-line-arguments] parameter.
 
-@history[#:changed "6.90.0.17" @elem{Added @Flag{O}/@DFlag{stdout}.}]
+@history[#:changed "6.90.0.17" @elem{Added @Flag{O}/@DFlag{stdout}.}
+         #:changed "7.1.0.5" @elem{Added @Flag{M}/@DFlag{compile-any}.}]
 
 @; ----------------------------------------------------------------------
 

racket/src/cs/linklet.sls

@@ -31,6 +31,7 @@
           compile-enforce-module-constants
           compile-context-preservation-enabled
           compile-allow-set!-undefined
+          compile-machine-independent
           eval-jit-enabled
           load-on-demand-enabled
 
@@ -820,6 +821,9 @@
   (define compile-allow-set!-undefined
     (make-parameter #f (lambda (v) (and v #t))))
 
+  (define compile-machine-independent
+    (make-parameter #f (lambda (v) (and v #t))))
+
   (define eval-jit-enabled
     (make-parameter #t (lambda (v) (and v #t))))
   

racket/src/cs/main.sps

@@ -40,7 +40,8 @@
                omit-debugging?
                platform-independent-zo-mode?
                linklet-performance-init!
-               linklet-performance-report!))
+               linklet-performance-report!
+               compile-machine-independent))
 
  (linklet-performance-init!)
  (unless omit-debugging?
@@ -108,6 +109,7 @@
                           [else "compiled"]))))
    (define user-specific-search-paths? #t)
    (define load-on-demand? #t)
+   (define compile-machine-independent? (getenv "PLT_COMPILE_ANY"))
 
    (define (see saw . args)
      (let loop ([saw saw] [args args])
@@ -424,6 +426,9 @@
                 (loop (cdr args))]
                [else
                 (raise-bad-switch arg within-arg)])]
+             [("-M")
+              (set! compile-machine-independent? #t)
+              (loop (cdr args))]
              [("--")
               (cond
                [(or (null? (cdr args)) (not (pair? (cadr args))))
@@ -564,6 +569,8 @@
      (|#%app| use-compiled-file-paths compiled-file-paths)
      (|#%app| use-user-specific-search-paths user-specific-search-paths?)
      (|#%app| load-on-demand-enabled load-on-demand?)
+     (when compile-machine-independent?
+       (|#%app| compile-machine-independent #t))
      (boot)
      (when (and stderr-logging
                 (not (null? stderr-logging)))

racket/src/cs/primitive/kernel.ss

@@ -184,6 +184,7 @@
   [compile-allow-set!-undefined (known-constant)]
   [compile-context-preservation-enabled (known-constant)]
   [compile-enforce-module-constants (known-constant)]
+  [compile-machine-independent (known-constant)]
   [complete-path? (known-procedure 2)]
   [complex? (known-procedure/succeeds 2)]
   [cons (known-procedure/succeeds 4)]

racket/src/expander/compile/correlated-linklet.rkt

@@ -0,0 +1,125 @@
+#lang racket/base
+(require racket/fasl
+         "../host/linklet.rkt"
+         "../host/correlate.rkt")
+
+(provide correlated-linklet?
+         make-correlated-linklet
+
+         correlated-linklet-expr
+         correlated-linklet-name
+
+         force-compile-linklet
+
+         correlated-linklet-vm-bytes
+         write-correlated-linklet-bundle-hash
+         read-correlated-linklet-bundle-hash)
+
+(struct correlated-linklet (expr name [compiled #:mutable])
+  #:authentic)
+
+(define (make-correlated-linklet expr name)
+  (correlated-linklet expr name #f))
+
+;; ----------------------------------------
+
+(define (force-compile-linklet l)
+  (cond
+    [(correlated-linklet? l)
+     (or (correlated-linklet-compiled l)
+         (let ([c (compile-linklet (correlated-linklet-expr l)
+                                   (correlated-linklet-name l))])
+           (set-correlated-linklet-compiled! l c)
+           c))]
+    [else l]))
+
+;; ----------------------------------------
+
+(define correlated-linklet-vm-bytes #"linklet")
+
+(struct faslable-correlated (e source position line column span name)
+  #:prefab)
+
+(struct faslable-correlated-linklet (expr name)
+  #:prefab)
+
+;; ----------------------------------------
+
+(define (write-correlated-linklet-bundle-hash ht o)
+  (s-exp->fasl (->faslable ht) o))
+
+(define (->faslable v)
+  (cond
+    [(pair? v)
+     (define a (->faslable (car v)))
+     (define d (->faslable (cdr v)))
+     (if (and (eq? a (car v))
+              (eq? d (cdr v)))
+         v
+         (cons a d))]
+    [(correlated? v)
+     (faslable-correlated
+      (->faslable (correlated-e v))
+      (correlated-source v)
+      (correlated-position v)
+      (correlated-line v)
+      (correlated-column v)
+      (correlated-span v)
+      (correlated-property v 'inferred-name))]
+    [(hash? v)
+     (cond
+       [(hash-eq? v)
+        (for/hasheq ([(key value) (in-hash v)])
+          (values (->faslable key) (->faslable value)))]
+       [(hash-eqv? v)
+        (for/hasheqv ([(key value) (in-hash v)])
+          (values (->faslable key) (->faslable value)))]
+       [else
+        (for/hash ([(key value) (in-hash v)])
+          (values (->faslable key) (->faslable value)))])]
+    [(correlated-linklet? v)
+     (faslable-correlated-linklet (->faslable (correlated-linklet-expr v))
+                                  (->faslable (correlated-linklet-name v)))]
+    [else v]))
+
+;; ----------------------------------------
+
+(define (read-correlated-linklet-bundle-hash in)
+  (faslable-> (fasl->s-exp in)))
+
+(define (faslable-> v)
+  (cond
+    [(pair? v)
+     (define a (faslable-> (car v)))
+     (define d (faslable-> (cdr v)))
+     (if (and (eq? a (car v))
+              (eq? d (cdr v)))
+         v
+         (cons a d))]
+    [(faslable-correlated? v)
+     (define name (faslable-correlated-name v))
+     (define c (datum->correlated (faslable-> (faslable-correlated-e v))
+                                  (vector
+                                   (faslable-correlated-source v)
+                                   (faslable-correlated-line v)
+                                   (faslable-correlated-column v)
+                                   (faslable-correlated-position v)
+                                   (faslable-correlated-span v))))
+     (if name
+         (correlated-property c 'inferred-name name)
+         c)]
+    [(hash? v)
+     (cond
+       [(hash-eq? v)
+        (for/hasheq ([(key value) (in-hash v)])
+          (values (faslable-> key) (faslable-> value)))]
+       [(hash-eqv? v)
+        (for/hasheqv ([(key value) (in-hash v)])
+          (values (faslable-> key) (faslable-> value)))]
+       [else
+        (for/hash ([(key value) (in-hash v)])
+          (values (faslable-> key) (faslable-> value)))])]
+    [(faslable-correlated-linklet? v)
+     (make-correlated-linklet (faslable-> (faslable-correlated-linklet-expr v))
+                              (faslable-> (faslable-correlated-linklet-name v)))]
+    [else v]))

racket/src/expander/compile/form.rkt

@@ -23,7 +23,8 @@
          "namespace-scope.rkt"
          "expr.rkt"
          "extra-inspector.rkt"
-         "correlate.rkt")
+         "correlate.rkt"
+         "correlated-linklet.rkt")
 
 (provide compile-forms
 
@@ -45,6 +46,7 @@
                        #:other-form-callback [other-form-callback void]
                        #:get-module-linklet-info [get-module-linklet-info (lambda (mod-name p) #f)] ; to support submodules
                        #:serializable? [serializable? #t]
+                       #:to-correlated-linklet? [to-correlated-linklet? #f]
                        #:cross-linklet-inlining? [cross-linklet-inlining? #t])
   (define phase (compile-context-phase cctx))
   (define self (compile-context-self cctx))
@@ -246,44 +248,38 @@
       (define module-use*s
         (module-uses-add-extra-inspectorsss (link-info-link-module-uses li)
                                             (link-info-extra-inspectorsss li)))
-      ;; Compile the linklet with support for cross-module inlining, which
+      (define body-linklet
-      ;; means that the set of imports can change:
+        `(linklet
+             ;; imports
+             (,@body-imports
+              ,@(link-info-imports li))
+             ;; exports
+             (,@(link-info-def-decls li)
+              ,@(for/list ([binding-sym (in-list (header-binding-syms-in-order
+                                                  (hash-ref phase-to-header phase)))])
+                  (define def-sym (hash-ref binding-sym-to-define-sym binding-sym))
+                  (if (eq? def-sym binding-sym)
+                      def-sym
+                      `[,def-sym ,binding-sym])))
+           ;; body
+           ,@(reverse bodys)
+           ,@body-suffix-forms))
       (define-values (linklet new-module-use*s)
-        (performance-region
+        (cond
-         ['compile '_ 'linklet]
+          [to-correlated-linklet?
-         ((lambda (l name keys getter)
+           (values (make-correlated-linklet body-linklet 'module) module-use*s)]
-            (compile-linklet l name keys getter (if serializable? '(serializable) '())))
+          [else
-          `(linklet
+           ;; Compile the linklet with support for cross-module inlining, which
-            ;; imports
+           ;; means that the set of imports can change:
-            (,@body-imports
+           (compile-module-linklet body-linklet
-             ,@(link-info-imports li))
+                                   #:body-imports body-imports
-            ;; exports
+                                   #:body-import-instances body-import-instances
-            (,@(link-info-def-decls li)
+                                   #:get-module-linklet-info get-module-linklet-info
-             ,@(for/list ([binding-sym (in-list (header-binding-syms-in-order
+                                   #:serializable? serializable?
-                                                 (hash-ref phase-to-header phase)))])
+                                   #:module-use*s module-use*s
-                 (define def-sym (hash-ref binding-sym-to-define-sym binding-sym))
+                                   #:cross-linklet-inlining? cross-linklet-inlining?
-                 (if (eq? def-sym binding-sym)
+                                   #:namespace (compile-context-namespace cctx))]))
-                     def-sym
+      (values phase (cons linklet new-module-use*s))))
-                     `[,def-sym ,binding-sym])))
-            ;; body
-            ,@(reverse bodys)
-            ,@body-suffix-forms)
-          'module
-          ;; Support for cross-module optimization starts with a vector
-          ;; of keys for the linklet imports; we use `module-use` values
-          ;; as keys, plus #f or an instance (=> cannot be pruned) for
-          ;; each boilerplate linklet
-          (list->vector (append body-import-instances
-                                module-use*s))
-          ;; To complete cross-module support, map a key (which is a `module-use`)
-          ;; to a linklet and an optional vector of keys for that linklet's
-          ;; imports:
-          (make-module-use-to-linklet cross-linklet-inlining?
-                                      (compile-context-namespace cctx)
-                                      get-module-linklet-info
-                                      module-use*s))))
-      (values phase (cons linklet (list-tail (vector->list new-module-use*s)
-                                             (length body-imports))))))
   
   (define body-linklets
     (for/hasheq ([(phase l+mu*s) (in-hash body-linklets+module-use*s)])
@@ -301,7 +297,8 @@
                 [(extra-inspectorsss) (in-value (module-uses-extract-extra-inspectorsss
                                                  (cdr l+mu*s)
                                                  (car l+mu*s)
-                                                 cross-linklet-inlining?
+                                                 (and cross-linklet-inlining?
+                                                      (not to-correlated-linklet?))
                                                  (length body-imports)))]
                 #:when extra-inspectorsss)
       (values phase extra-inspectorsss)))
@@ -385,6 +382,42 @@
 
 ;; ----------------------------------------
 
+;; Compile the linklet with support for cross-module inlining, which
+;; means that the set of imports can change: return a compiled linklet
+;; and a list of `module-use*`
+(define (compile-module-linklet body-linklet
+                                #:body-imports body-imports
+                                #:body-import-instances body-import-instances
+                                #:get-module-linklet-info get-module-linklet-info
+                                #:serializable? serializable?
+                                #:module-use*s module-use*s
+                                #:cross-linklet-inlining? cross-linklet-inlining?
+                                #:namespace namespace)
+  (define-values (linklet new-module-use*s)
+    (performance-region
+     ['compile '_ 'linklet]
+     ((lambda (l name keys getter)
+        (compile-linklet l name keys getter (if serializable? '(serializable) '())))
+      body-linklet
+      'module
+      ;; Support for cross-module optimization starts with a vector
+      ;; of keys for the linklet imports; we use `module-use` values
+      ;; as keys, plus #f or an instance (=> cannot be pruned) for
+      ;; each boilerplate linklet
+      (list->vector (append body-import-instances
+                            module-use*s))
+      ;; To complete cross-module support, map a key (which is a `module-use`)
+      ;; to a linklet and an optional vector of keys for that linklet's
+      ;; imports:
+      (make-module-use-to-linklet cross-linklet-inlining?
+                                  namespace
+                                  get-module-linklet-info
+                                  module-use*s))))
+  (values linklet (list-tail (vector->list new-module-use*s)
+                             (length body-imports))))
+
+;; ----------------------------------------
+
 (define (make-module-use-to-linklet cross-linklet-inlining? ns get-module-linklet-info init-mu*s)
   ;; Inlining might reach the same module though different indirections;
   ;; use a consistent `module-use` value so that the compiler knows to

racket/src/expander/compile/linklet.rkt

@@ -1,7 +1,8 @@
 #lang racket/base
 (require "../common/contract.rkt"
          "../host/linklet.rkt"
-         "write-linklet.rkt")
+         "write-linklet.rkt"
+         "correlated-linklet.rkt")
 
 (provide linklet-directory?
          linklet-bundle?
@@ -15,6 +16,7 @@
 (struct linklet-directory (ht)
   #:property prop:custom-write (lambda (ld port mode)
                                  (write-linklet-directory ld
+                                                          (correlated-linklet-directory? ld)
                                                           linklet-directory->hash
                                                           linklet-bundle->hash
                                                           port)))
@@ -22,6 +24,7 @@
 (struct linklet-bundle (ht)
   #:property prop:custom-write (lambda (b port mode)
                                  (write-linklet-bundle b
+                                                       (correlated-linklet-bundle? b)
                                                        linklet-bundle->hash
                                                        port)))
 
@@ -73,3 +76,19 @@
 (define/who (linklet-bundle->hash ld)
   (check who linklet-bundle? ld)
   (linklet-bundle-ht ld))
+
+;; ----------------------------------------
+
+;; If there are no values that satisfy `linklet?`, then
+;; assume that we have `correlated-linklet?` values.
+
+(define (correlated-linklet-directory? ld)
+  (for/and ([(k v) (in-hash (linklet-directory->hash ld))])
+    (cond
+      [(not k) (correlated-linklet-bundle? v)]
+      [(symbol? k) (correlated-linklet-directory? v)]
+      [else #t])))
+      
+(define (correlated-linklet-bundle? b)
+  (for/and ([(k v) (in-hash (linklet-bundle->hash b))])
+    (not (linklet? v))))

racket/src/expander/compile/module.rkt

@@ -22,6 +22,7 @@
          "form.rkt"
          "compiled-in-memory.rkt"
          "linklet.rkt"
+         "correlated-linklet.rkt"
          "../eval/reflect.rkt"
          "../eval/reflect-name.rkt")
 
@@ -32,6 +33,7 @@
 (define (compile-module p cctx
                         #:force-linklet-directory? [force-linklet-directory? #f]
                         #:serializable? [serializable? #f]
+                        #:to-correlated-linklet? [to-correlated-linklet? #f]
                         #:modules-being-compiled [modules-being-compiled (make-hasheq)]
                         #:need-compiled-submodule-rename? [need-compiled-submodule-rename? #t])
 
@@ -74,6 +76,7 @@
                                 #:full-module-name full-module-name
                                 #:force-linklet-directory? force-linklet-directory?
                                 #:serializable? serializable?
+                                #:to-correlated-linklet? to-correlated-linklet?
                                 #:modules-being-compiled modules-being-compiled
                                 #:pre-submodules pre-submodules
                                 #:post-submodules post-submodules
@@ -85,6 +88,7 @@
                                     #:full-module-name full-module-name
                                     #:force-linklet-directory? force-linklet-directory?
                                     #:serializable? serializable?
+                                    #:to-correlated-linklet? to-correlated-linklet?
                                     #:modules-being-compiled modules-being-compiled
                                     #:pre-submodules pre-submodules
                                     #:post-submodules post-submodules
@@ -167,7 +171,8 @@
                                                 (define ht (and modules-being-compiled
                                                                 (hash-ref modules-being-compiled mod-name #f)))
                                                 (and ht (hash-ref ht phase #f)))
-                    #:serializable? serializable?))
+                    #:serializable? serializable?
+                    #:to-correlated-linklet? to-correlated-linklet?))
    
    (when modules-being-compiled
      ;; Record this module's linklets for cross-module inlining among (sub)modules
@@ -189,9 +194,12 @@
    ;; declaration, and is shared among instances
    (define declaration-linklet
      (and serializable?
-          ((lambda (s) (performance-region
+          ((lambda (s)
-                        ['compile 'module 'linklet]
+             (if to-correlated-linklet?
-                        (compile-linklet s 'decl)))
+                 (make-correlated-linklet s 'decl)
+                 (performance-region
+                  ['compile 'module 'linklet]
+                  (compile-linklet s 'decl))))
            `(linklet
              ;; imports
              (,deserialize-imports
@@ -214,17 +222,19 @@
    (define syntax-literals-linklet
      (and (not (syntax-literals-empty? syntax-literals))
           ((lambda (s)
-             (performance-region
+             (if to-correlated-linklet?
-              ['compile 'module 'linklet]
+                 (make-correlated-linklet s 'syntax-literals)
-              (define-values (linklet new-keys)
+                 (performance-region
-                (compile-linklet s 'syntax-literals
+                  ['compile 'module 'linklet]
-                                 (vector deserialize-instance
+                  (define-values (linklet new-keys)
-                                         empty-top-syntax-literal-instance
+                    (compile-linklet s 'syntax-literals
-                                         empty-syntax-literals-data-instance
+                                     (vector deserialize-instance
-                                         empty-instance-instance)
+                                             empty-top-syntax-literal-instance
-                                 (lambda (inst) (values inst #f))
+                                             empty-syntax-literals-data-instance
-                                 (if serializable? '(serializable) '())))
+                                             empty-instance-instance)
-              linklet))
+                                     (lambda (inst) (values inst #f))
+                                     (if serializable? '(serializable) '())))
+                  linklet)))
            `(linklet
              ;; imports
              (,deserialize-imports
@@ -262,9 +272,11 @@
    (define syntax-literals-data-linklet
      (and serializable?
           (not (syntax-literals-empty? syntax-literals))
-          ((lambda (s) (performance-region
+          ((lambda (s) (if to-correlated-linklet?
-                        ['compile 'module 'linklet]
+                           (make-correlated-linklet s 'syntax-literals-data)
-                        (compile-linklet s 'syntax-literals-data)))
+                           (performance-region
+                            ['compile 'module 'linklet]
+                            (compile-linklet s 'syntax-literals-data))))
            `(linklet
              ;; imports
              (,deserialize-imports
@@ -284,9 +296,11 @@
    ;; across module instances.
    (define data-linklet
      (and serializable?
-          ((lambda (s) (performance-region
+          ((lambda (s) (if to-correlated-linklet?
-                        ['compile 'module 'linklet]
+                           (make-correlated-linklet s 'data)
-                        (compile-linklet s 'data)))
+                           (performance-region
+                            ['compile 'module 'linklet]
+                            (compile-linklet s 'data))))
            `(linklet
              ;; imports
              (,deserialize-imports)
@@ -348,12 +362,13 @@
        ;; Just use the bundle representation directly:
        bundle]
       [else
-       (hash->linklet-directory
+       (define ht
-        (for/fold ([ht (hasheq #f bundle)]) ([sm (in-list (append pre-submodules post-submodules))])
+         (for/fold ([ht (hasheq #f bundle)]) ([sm (in-list (append pre-submodules post-submodules))])
-          (hash-set ht
+           (hash-set ht
-                    (car sm)
+                     (car sm)
-                    (compiled-in-memory-linklet-directory
+                     (compiled-in-memory-linklet-directory
-                     (cdr sm)))))]))
+                      (cdr sm)))))
+       (hash->linklet-directory ht)]))
 
   ;; Save mpis and syntax for direct evaluation, instead of unmarshaling:
   (compiled-in-memory ld

racket/src/expander/compile/multi-top.rkt

@@ -19,6 +19,7 @@
 ;; top of a tree, we repeat work only twice and avoid non-linear
 ;; behavior.)
 (define (compiled-tops->compiled-top all-cims
+                                     #:to-correlated-linklet? [to-correlated-linklet? #f]
                                      #:merge-serialization? [merge-serialization? #f]
                                      #:namespace [ns #f]) ; need for `merge-serialization?`
   (define cims (remove-nontail-purely-functional all-cims))

racket/src/expander/compile/read-linklet.rkt

@@ -1,7 +1,8 @@
 #lang racket/base
 (require "version-bytes.rkt"
          "linklet.rkt"
-         "../host/linklet.rkt")
+         "../host/linklet.rkt"
+         "correlated-linklet.rkt")
 
 (provide read-linklet-bundle-or-directory)
 
@@ -23,7 +24,9 @@
                                         in))))
     (define vm-len (min 63 (read-byte in)))
     (define vm (read-bytes vm-len in))
-    (unless (equal? vm vm-bytes)
+    (define as-correlated-linklet? (equal? vm correlated-linklet-vm-bytes))
+    (unless (or as-correlated-linklet?
+                (equal? vm vm-bytes))
       (raise-arguments-error 'read-compiled-linklet
                              "virtual-machine mismatch"
                              "expected" (bytes->string/utf-8 vm-bytes)
@@ -37,7 +40,9 @@
     (cond
       [(eqv? tag (char->integer #\B))
        (define sha-1 (read-bytes 20 in))
-       (define b-ht (read-linklet-bundle-hash in))
+       (define b-ht (if as-correlated-linklet?
+                        (read-correlated-linklet-bundle-hash in)
+                        (read-linklet-bundle-hash in)))
        (hash->linklet-bundle
         (add-hash-code (if initial?
                            (strip-submodule-references b-ht)

racket/src/expander/compile/top.rkt

@@ -20,7 +20,8 @@
          "form.rkt"
          "multi-top.rkt"
          "namespace-scope.rkt"
-         "side-effect.rkt")
+         "side-effect.rkt"
+         "correlated-linklet.rkt")
 
 (provide compile-single
          compile-top)
@@ -39,7 +40,8 @@
 ;; used.
 (define (compile-top p cctx
                      #:serializable? [serializable? #t]
-                     #:single-expression? [single-expression? #f])
+                     #:single-expression? [single-expression? #f]
+                     #:to-correlated-linklet? [to-correlated-linklet? #f])
   (performance-region
    ['compile (if single-expression? 'transformer 'top)]
 
@@ -71,6 +73,7 @@
                                                   empty-top-syntax-literal-instance
                                                   empty-instance-instance)
                     #:serializable? serializable?
+                    #:to-correlated-linklet? to-correlated-linklet?
                     #:definition-callback (lambda () (set! purely-functional? #f))
                     #:compiled-expression-callback
                     (lambda (e expected-results phase required-reference?)
@@ -106,15 +109,17 @@
 
          (define link-linklet
            ((lambda (s)
-              (performance-region
+              (if to-correlated-linklet?
-               ['compile 'top 'linklet]
+                  (make-correlated-linklet s #f)
-               (define-values (linklet new-keys)
+                  (performance-region
-                 (compile-linklet s
+                   ['compile 'top 'linklet]
-                                  #f
+                   (define-values (linklet new-keys)
-                                  (vector deserialize-instance
+                     (compile-linklet s
-                                          empty-eager-instance-instance)
+                                      #f
-                                  (lambda (inst) (values inst #f))))
+                                      (vector deserialize-instance
-               linklet))
+                                              empty-eager-instance-instance)
+                                      (lambda (inst) (values inst #f))))
+                   linklet)))
             `(linklet
               ;; imports
               (,deserialize-imports

racket/src/expander/compile/write-linklet.rkt

@@ -1,11 +1,12 @@
 #lang racket/base
 (require "../host/linklet.rkt"
-         "version-bytes.rkt")
+         "version-bytes.rkt"
+         "correlated-linklet.rkt")
 
 (provide write-linklet-bundle
          write-linklet-directory)
 
-(define (write-linklet-bundle b linklet-bundle->hash port)
+(define (write-linklet-bundle b as-correlated-linklet? linklet-bundle->hash port)
   ;; Various tools expect a particular header:
   ;;   "#~"
   ;;   length of version byte string (< 64) as one byte
@@ -15,19 +16,24 @@
   (write-bytes #"#~" port)
   (write-bytes (bytes (bytes-length version-bytes)) port)
   (write-bytes version-bytes port)
-  (write-bytes (bytes (bytes-length vm-bytes)) port)
+  (let ([vm-bytes (if as-correlated-linklet?
-  (write-bytes vm-bytes port)
+                      correlated-linklet-vm-bytes
+                      vm-bytes)])
+    (write-bytes (bytes (bytes-length vm-bytes)) port)
+    (write-bytes vm-bytes port))
   (write-bytes #"B" port)
   (write-bytes (make-bytes 20 0) port)
   ;; The rest is whatever the VM wants
-  (write-linklet-bundle-hash (linklet-bundle->hash b) port))
+  (if as-correlated-linklet?
+      (write-correlated-linklet-bundle-hash (linklet-bundle->hash b) port)
+      (write-linklet-bundle-hash (linklet-bundle->hash b) port)))
 
-(define (linklet-bundle->bytes b linklet-bundle->hash)
+(define (linklet-bundle->bytes b as-correlated-linklet? linklet-bundle->hash)
   (define o (open-output-bytes))
-  (write-linklet-bundle b linklet-bundle->hash o)
+  (write-linklet-bundle b as-correlated-linklet? linklet-bundle->hash o)
   (get-output-bytes o))
 
-(define (write-linklet-directory ld linklet-directory->hash linklet-bundle->hash port)
+(define (write-linklet-directory ld as-correlated-linklet? linklet-directory->hash linklet-bundle->hash port)
   ;; Various tools expect a particular header:
   ;;   "#~"
   ;;   length of version byte string (< 64) as one byte
@@ -46,51 +52,54 @@
   ;; A bundle name corresponds to a list of symbols. Each symbol in the list is
   ;; prefixed with either: its length as a byte if less than 255; 255 followed by
   ;; a 4-byte integer for the length.
-  (write-bytes #"#~" port)
+  (let ([vm-bytes (if as-correlated-linklet?
-  (write-byte (bytes-length version-bytes) port)
+                      correlated-linklet-vm-bytes
-  (write-bytes version-bytes port)
+                      vm-bytes)])
-  (write-byte (bytes-length vm-bytes) port)
+    (write-bytes #"#~" port)
-  (write-bytes vm-bytes port)
+    (write-byte (bytes-length version-bytes) port)
-  (write-bytes #"D" port)
+    (write-bytes version-bytes port)
-  ;; Flatten a directory of bundles into a vector of pairs, where
+    (write-byte (bytes-length vm-bytes) port)
-  ;; each pair has the encoded bundle name and the bundle bytes  
+    (write-bytes vm-bytes port)
-  (define (flatten-linklet-directory ld rev-name-prefix accum)
+    (write-bytes #"D" port)
-    (define-values (new-accum saw-bundle?)
+    ;; Flatten a directory of bundles into a vector of pairs, where
-      (for/fold ([accum accum] [saw-bundle? #f]) ([(key value) (in-hash (linklet-directory->hash ld))])
+    ;; each pair has the encoded bundle name and the bundle bytes  
-        (cond
+    (define (flatten-linklet-directory ld rev-name-prefix accum)
-          [(eq? key #f)
+      (define-values (new-accum saw-bundle?)
-           (values (cons (cons (encode-name rev-name-prefix)
+        (for/fold ([accum accum] [saw-bundle? #f]) ([(key value) (in-hash (linklet-directory->hash ld))])
-                               (linklet-bundle->bytes value linklet-bundle->hash))
+          (cond
-                         accum)
+            [(eq? key #f)
-                   #t)]
+             (values (cons (cons (encode-name rev-name-prefix)
-          [else
+                                 (linklet-bundle->bytes value as-correlated-linklet? linklet-bundle->hash))
-           (values (flatten-linklet-directory value (cons key rev-name-prefix) accum)
+                           accum)
-                   saw-bundle?)])))
+                     #t)]
-    (cond
+            [else
-      [saw-bundle? new-accum]
+             (values (flatten-linklet-directory value (cons key rev-name-prefix) accum)
-      [else (cons (cons (encode-name rev-name-prefix)
+                     saw-bundle?)])))
-                        #"#f")
+      (cond
-                  new-accum)]))
+        [saw-bundle? new-accum]
-  (define bundles (list->vector
+        [else (cons (cons (encode-name rev-name-prefix)
-                   (sort (flatten-linklet-directory ld '() '())
+                          #"#f")
-                         (lambda (a b) (bytes<? (car a) (car b))))))
+                    new-accum)]))
-  (define len (vector-length bundles))
+    (define bundles (list->vector
-  (define initial-offset (+ 2 ; "#~"
+                     (sort (flatten-linklet-directory ld '() '())
-                            1 ; version length
+                           (lambda (a b) (bytes<? (car a) (car b))))))
-                            (bytes-length version-bytes)
+    (define len (vector-length bundles))
-                            1 ; vm length
+    (define initial-offset (+ 2 ; "#~"
-                            (bytes-length vm-bytes)
+                              1 ; version length
-                            1 ; D
+                              (bytes-length version-bytes)
-                            4)) ; bundle count
+                              1 ; vm length
-  (write-int len port) ; bundle count
+                              (bytes-length vm-bytes)
-  ;; Compute bundle offsets
+                              1 ; D
-  (define btree-size (compute-btree-size bundles len))
+                              4)) ; bundle count
-  (define node-offsets (compute-btree-node-offsets bundles len initial-offset))
+    (write-int len port) ; bundle count
-  (define bundle-offsets (compute-bundle-offsets bundles len (+ initial-offset btree-size)))
+    ;; Compute bundle offsets
-  (write-directory-btree bundles node-offsets bundle-offsets len port)
+    (define btree-size (compute-btree-size bundles len))
-  ;; Write the bundles
+    (define node-offsets (compute-btree-node-offsets bundles len initial-offset))
-  (for ([i (in-range len)])
+    (define bundle-offsets (compute-bundle-offsets bundles len (+ initial-offset btree-size)))
-    (write-bytes (cdr (vector-ref bundles i)) port)))
+    (write-directory-btree bundles node-offsets bundle-offsets len port)
+    ;; Write the bundles
+    (for ([i (in-range len)])
+      (write-bytes (cdr (vector-ref bundles i)) port))))
 
 ;; Encode a bundle name (as a reversed list of symbols) as a single
 ;; byte string

racket/src/expander/eval/main.rkt

@@ -29,7 +29,8 @@
          "reflect.rkt"
          "../expand/log.rkt"
          "../expand/parsed.rkt"
-         "../common/performance.rkt")
+         "../common/performance.rkt"
+         "../compile/correlated-linklet.rkt")
 
 (provide eval
          compile
@@ -71,6 +72,8 @@
 ;; [Don't use keyword arguments here, because the function is
 ;;  exported for use by an embedding runtime system.]
 (define (compile s [ns (current-namespace)] [serializable? #t] [expand expand])
+  (define to-correlated-linklet? (and serializable?
+                                      (compile-machine-independent)))
   ;; The given `s` might be an already-compiled expression because it
   ;; went through some strange path, such as a `load` on a bytecode
   ;; file, which would wrap `#%top-interaction` around the compiled
@@ -85,55 +88,69 @@
       (per-top-level s ns
                      #:single (lambda (s ns as-tail?)
                                 (list (compile-single s ns expand
-                                                      serializable?)))
+                                                      #:serializable? serializable?
+                                                      #:to-correlated-linklet? to-correlated-linklet?)))
                      #:combine append
                      #:observer #f)]))
   (if (and (= 1 (length cs))
            (not (compiled-multiple-top? (car cs))))
       (car cs)
       (compiled-tops->compiled-top cs
+                                   #:to-correlated-linklet? to-correlated-linklet?
                                    #:merge-serialization? serializable?
                                    #:namespace ns)))
 
 ;; To communicate lifts from `expand-single` to `compile-single`:
 (struct lifted-parsed-begin (seq last))
 
-(define (compile-single s ns expand serializable?)
+(define (compile-single s ns expand
-  (define exp-s (expand s ns #f #t serializable?))
+                        #:serializable? serializable?
+                        #:to-correlated-linklet? to-correlated-linklet?)
+  (define exp-s (expand s ns #f #t serializable? to-correlated-linklet?))
   (let loop ([exp-s exp-s])
     (cond
       [(parsed-module? exp-s)
        (compile-module exp-s (make-compile-context #:namespace ns)
-                       #:serializable? serializable?)]
+                       #:serializable? serializable?
+                       #:to-correlated-linklet? to-correlated-linklet?)]
       [(lifted-parsed-begin? exp-s)
        ;; expansion must have captured lifts
        (compiled-tops->compiled-top
+        #:to-correlated-linklet? to-correlated-linklet?
         (for/list ([e (in-list (append (lifted-parsed-begin-seq exp-s)
                                        (list (lifted-parsed-begin-last exp-s))))])
           (loop e)))]
       [else
        (compile-top exp-s (make-compile-context #:namespace ns)
-                    #:serializable? serializable?)])))
+                    #:serializable? serializable?
+                    #:to-correlated-linklet? to-correlated-linklet?)])))
 
 ;; This `expand` is suitable as an expand handler (if such a thing
 ;; existed) to be called by `expand` and `expand-syntax`.
 ;; [Don't use keyword arguments here, because the function is
 ;;  exported for use by an embedding runtime system.]
-(define (expand s [ns (current-namespace)] [observable? #f] [to-parsed? #f] [serializable? #f])
+(define (expand s
+                [ns (current-namespace)] [observable? #f] [to-parsed? #f]
+                [serializable? #f] [to-correlated-linklet? #f])
   (define observer (and observable? (current-expand-observe)))
   (when observer (...log-expand observer ['start-top]))
   (parameterize ([current-expand-observe #f])
     (per-top-level s ns
-                   #:single (lambda (s ns as-tail?) (expand-single s ns observer to-parsed? serializable?))
+                   #:single (lambda (s ns as-tail?) (expand-single s ns observer to-parsed?
+                                                                   #:serializable? serializable?
+                                                                   #:to-correlated-linklet? to-correlated-linklet?))
                    #:combine cons
                    #:wrap re-pair
                    #:observer observer)))
 
-(define (expand-single s ns observer to-parsed? serializable?)
+(define (expand-single s ns observer to-parsed?
+                       #:serializable? serializable?
+                       #:to-correlated-linklet? [to-correlated-linklet? #f])
   (define rebuild-s (keep-properties-only s))
   (define ctx (make-expand-context ns
                                    #:to-parsed? to-parsed?
                                    #:for-serializable? serializable?
+                                   #:to-correlated-linklet? to-correlated-linklet?
                                    #:observer observer))
   (define-values (require-lifts lifts exp-s) (expand-capturing-lifts s ctx))
   (cond
@@ -143,14 +160,16 @@
                                        lifts
                                        exp-s rebuild-s
                                        #:adjust-form (lambda (form)
-                                                       (expand-single form ns observer to-parsed? serializable?)))]
+                                                       (expand-single form ns observer to-parsed?
+                                                                      #:serializable? serializable?)))]
    [else
     (log-top-lift-begin-before ctx require-lifts lifts exp-s ns)
     (define new-s
       (wrap-lifts-as-begin (append require-lifts lifts)
                            #:adjust-form (lambda (form)
                                            (log-expand ctx 'next)
-                                           (expand-single form ns observer to-parsed? serializable?))
+                                           (expand-single form ns observer to-parsed?
+                                                          #:serializable? serializable?))
                            #:adjust-body (lambda (form)
                                            (cond
                                              [to-parsed? form]
@@ -159,7 +178,8 @@
                                               ;; This re-expansion should be unnecessary, but we do it
                                               ;; for a kind of consistentcy with `expand/capture-lifts`
                                               ;; and for expansion observers
-                                              (expand-single form ns observer to-parsed? serializable?)]))
+                                              (expand-single form ns observer to-parsed?
+                                                             #:serializable? serializable?)]))
                            exp-s
                            (namespace-phase ns)))
     (log-top-begin-after ctx new-s)

racket/src/expander/eval/module.rkt

@@ -14,6 +14,7 @@
          "../compile/linklet.rkt"
          "../compile/instance.rkt"
          "../compile/compiled-in-memory.rkt"
+         "../compile/correlated-linklet.rkt"
          "../expand/context.rkt"
          "../expand/root-expand-context.rkt"
          "root-context.rkt"
@@ -49,7 +50,7 @@
          (make-syntax-literal-data-instance-from-compiled-in-memory c)
          (let ([l (hash-ref h 'stx-data #f)])
            (cond
-            [l (instantiate-linklet (eval-linklet l)
+            [l (instantiate-linklet (eval-linklet* l)
                                     (list deserialize-instance
                                           data-instance))]
             [(eq? (hash-ref h 'module->namespace #f) 'empty)
@@ -83,9 +84,9 @@
    (define phases-h (for*/hash ([phase-level (in-range min-phase (add1 max-phase))]
                                 [v (in-value (hash-ref h phase-level #f))]
                                 #:when v)
-                      (values phase-level (eval-linklet v))))
+                      (values phase-level (eval-linklet* v))))
    (define syntax-literals-linklet (let ([l (hash-ref h 'stx #f)])
-                                     (and l (eval-linklet l))))
+                                     (and l (eval-linklet* l))))
 
    (define extra-inspector (and (compiled-in-memory? c)
                                 (compiled-in-memory-compile-time-inspector c)))
@@ -350,14 +351,14 @@
   (define data-instance
     (if (compiled-in-memory? c)
         (make-data-instance-from-compiled-in-memory c)
-        (instantiate-linklet (eval-linklet (hash-ref h 'data))
+        (instantiate-linklet (eval-linklet* (hash-ref h 'data))
                              (list deserialize-instance))))
 
   (define declaration-instance
     (if (and (compiled-in-memory? c)
              (compiled-in-memory-original-self c))
         (make-declaration-instance-from-compiled-in-memory c)
-        (instantiate-linklet (eval-linklet (hash-ref h 'decl))
+        (instantiate-linklet (eval-linklet* (hash-ref h 'decl))
                              (list deserialize-instance
                                    data-instance))))
   
@@ -402,3 +403,8 @@
   (for/hash ([(phase linklet) (in-hash phases-h)])
     (values phase
             (linklet-export-variables linklet))))
+
+;; ----------------------------------------
+
+(define (eval-linklet* l)
+  (eval-linklet (force-compile-linklet l)))

racket/src/expander/eval/top.rkt

@@ -16,6 +16,7 @@
          "../compile/namespace-scope.rkt"
          "../compile/linklet.rkt"
          "../expand/context.rkt"
+         "../compile/correlated-linklet.rkt"
          "top-level-instance.rkt"
          "multi-top.rkt"
          "protect.rkt")
@@ -82,7 +83,7 @@
    (define link-instance
      (if (compiled-in-memory? c)
          (link-instance-from-compiled-in-memory c (and (not single-expression?) ns))
-         (instantiate-linklet (hash-ref h 'link)
+         (instantiate-linklet (force-compile-linklet (hash-ref h 'link))
                               (list deserialize-instance
                                     (make-eager-instance-instance
                                      #:namespace ns
@@ -137,7 +138,7 @@
                                                                           name
                                                                           val)))))
 
-       (define linklet (hash-ref h phase #f))
+       (define linklet (force-compile-linklet (hash-ref h phase #f)))
 
        (cond
         [linklet

racket/src/expander/expand/context.rkt

@@ -68,11 +68,13 @@
           * name       ; #f or identifier to name the expression
           observer   ; logging observer (for the macro debugger)
           for-serializable? ; accumulate submodules as serializable?
+          to-correlated-linklet? ; compile to machine-independent linklets?
           should-not-encounter-macros?)) ; #t when "expanding" to parse
 
 (define (make-expand-context ns
                              #:to-parsed? [to-parsed? #f]
                              #:for-serializable? [for-serializable? #f]
+                             #:to-correlated-linklet? [to-correlated-linklet? #f]
                              #:observer [observer #f])
   (define root-ctx (namespace-get-root-expand-ctx ns))
   (expand-context (root-expand-context-self-mpi root-ctx)
@@ -114,6 +116,7 @@
                   #f   ; name
                   observer
                   for-serializable?
+                  to-correlated-linklet?
                   #f))
 
 (define (copy-root-expand-context ctx root-ctx)

racket/src/expander/expand/module.rkt

@@ -1154,6 +1154,7 @@
                                           #:full-module-name (and enclosing-self
                                                                   (resolved-module-path-name module-name)))
                     #:serializable? (expand-context-for-serializable? ctx)
+                    #:to-correlated-linklet? (expand-context-to-correlated-linklet? ctx)
                     #:modules-being-compiled modules-being-compiled
                     #:need-compiled-submodule-rename? #f))
   (set-box! compiled-module-box compiled-module)
@@ -1363,6 +1364,7 @@
                                           #:full-module-name (resolved-module-path-name module-name))
                     #:force-linklet-directory? #t
                     #:serializable? (expand-context-for-serializable? ctx)
+                    #:to-correlated-linklet? (expand-context-to-correlated-linklet? ctx)
                     #:modules-being-compiled modules-being-compiled
                     #:need-compiled-submodule-rename? #f))
   (hash-set! compiled-submodules name (cons is-star? compiled-submodule))

racket/src/racket/cmdline.inc

@@ -784,6 +784,8 @@ static int run_from_cmd_line(int argc, char *_argv[],
       argv[0] = "-q";
     else if (!strcmp("--no-jit", argv[0]))
       argv[0] = "-j";
+    else if (!strcmp("--compile-mi", argv[0]))
+      argv[0] = "-M";
     else if (!strcmp("--no-delay", argv[0]))
       argv[0] = "-d";
     else if (!strcmp("--repl", argv[0]))
@@ -1064,6 +1066,10 @@ static int run_from_cmd_line(int argc, char *_argv[],
 	  scheme_set_startup_use_jit(0);
           was_config_flag = 1;
 	  break;
+	case 'M':
+	  scheme_set_startup_compile_machine_independent(1);
+          was_config_flag = 1;
+	  break;
 	case 'd':
 	  scheme_set_startup_load_on_demand(0);
           was_config_flag = 1;
@@ -1237,6 +1243,10 @@ static int run_from_cmd_line(int argc, char *_argv[],
     }
   }
 
+  if (getenv("PLT_COMPILE_ANY")) {
+    scheme_set_startup_compile_machine_independent(1);
+  }
+
   scheme_set_logging2_spec(syslog_level, stderr_level, stdout_level);
 
   collects_path = adjust_collects_path(collects_path, &skip_coll_dirs);
@@ -1414,6 +1424,7 @@ static int run_from_cmd_line(int argc, char *_argv[],
 # else
 	 "  -j, --no-jit : No effect, since the just-in-time compiler is unavailable\n"
 # endif
+	 "  -M, --compile-mi : Compile to machine-independent form\n"
          "  -d, --no-delay: Disable on-demand loading of syntax and code\n"
 	 "  -b, --binary : Read stdin and write stdout/stderr in binary mode\n"
 	 "  -W <levels>, --warn <levels> : Set stderr logging to <levels>\n"

racket/src/racket/include/scheme.h

@@ -1357,6 +1357,7 @@ enum {
   MZCONFIG_COMPILE_MODULE_CONSTS,
   MZCONFIG_USE_JIT,
   MZCONFIG_DISALLOW_INLINE,
+  MZCONFIG_COMPILE_MACHINE_INDEPENDENT,
 
   MZCONFIG_CUSTODIAN,
   MZCONFIG_INSPECTOR,
@@ -1835,6 +1836,7 @@ MZ_EXTERN int scheme_hash_percent_syntax_only; /* Defaults to 0 */
 MZ_EXTERN int scheme_hash_percent_globals_only; /* Defaults to 0 */
 MZ_EXTERN int scheme_binary_mode_stdio; /* Windows-specific; Defaults to 0 */
 MZ_EXTERN int scheme_startup_use_jit; /* Defaults to 1 */
+MZ_EXTERN int scheme_startup_compile_machine_independent; /* Defaults to 0 */
 MZ_EXTERN int scheme_ignore_user_paths; /* Defaults to 0 */
 MZ_EXTERN int scheme_ignore_link_paths; /* Defaults to 0 */
 
@@ -1842,6 +1844,7 @@ MZ_EXTERN void scheme_set_case_sensitive(int);
 MZ_EXTERN void scheme_set_allow_set_undefined(int);
 MZ_EXTERN void scheme_set_binary_mode_stdio(int);
 MZ_EXTERN void scheme_set_startup_use_jit(int);
+MZ_EXTERN void scheme_set_startup_compile_machine_independent(int);
 MZ_EXTERN void scheme_set_startup_load_on_demand(int);
 MZ_EXTERN void scheme_set_ignore_user_paths(int);
 MZ_EXTERN void scheme_set_ignore_link_paths(int);

racket/src/racket/src/eval.c

@@ -181,7 +181,11 @@
 
 /* globals */
 SHARED_OK int scheme_startup_use_jit = INIT_JIT_ON;
+SHARED_OK int scheme_startup_compile_machine_independent = 0;
 void scheme_set_startup_use_jit(int v) { scheme_startup_use_jit =  v; }
+void scheme_set_startup_compile_machine_independent(int v) {
+  scheme_startup_compile_machine_independent = v;
+}
 
 /* THREAD LOCAL SHARED */
 THREAD_LOCAL_DECL(volatile int scheme_fuel_counter);
@@ -213,6 +217,7 @@ static Scheme_Object *allow_set_undefined(int argc, Scheme_Object **argv);
 static Scheme_Object *compile_module_constants(int argc, Scheme_Object **argv);
 static Scheme_Object *use_jit(int argc, Scheme_Object **argv);
 static Scheme_Object *disallow_inline(int argc, Scheme_Object **argv);
+static Scheme_Object *compile_machine_independent(int argc, Scheme_Object **argv);
 
 void scheme_escape_to_continuation(Scheme_Object *obj, int num_rands, Scheme_Object **rands, Scheme_Object *alt_full);
 
@@ -262,6 +267,7 @@ scheme_init_eval (Scheme_Startup_Env *env)
   ADD_PARAMETER("compile-enforce-module-constants",  compile_module_constants, MZCONFIG_COMPILE_MODULE_CONSTS, env);
   ADD_PARAMETER("eval-jit-enabled",                  use_jit,                  MZCONFIG_USE_JIT,               env);
   ADD_PARAMETER("compile-context-preservation-enabled", disallow_inline,       MZCONFIG_DISALLOW_INLINE,       env);
+  ADD_PARAMETER("compile-machine-independent",   compile_machine_independent,  MZCONFIG_COMPILE_MACHINE_INDEPENDENT, env);
 }
 
 void scheme_init_eval_places()
@@ -3905,6 +3911,14 @@ static Scheme_Object *disallow_inline(int argc, Scheme_Object **argv)
 			     -1, NULL, NULL, 1);
 }
 
+static Scheme_Object *compile_machine_independent(int argc, Scheme_Object **argv)
+{
+  return scheme_param_config("compile-machine-independent", 
+			     scheme_make_integer(MZCONFIG_COMPILE_MACHINE_INDEPENDENT),
+			     argc, argv,
+			     -1, NULL, NULL, 1);
+}
+
 static Scheme_Object *
 enable_break(int argc, Scheme_Object *argv[])
 {

racket/src/racket/src/schminc.h

@@ -14,7 +14,7 @@
 
 #define USE_COMPILED_STARTUP 1
 
-#define EXPECTED_PRIM_COUNT 1446
+#define EXPECTED_PRIM_COUNT 1447
 
 #ifdef MZSCHEME_SOMETHING_OMITTED
 # undef USE_COMPILED_STARTUP

racket/src/racket/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "7.1.0.4"
+#define MZSCHEME_VERSION "7.1.0.5"
 
 #define MZSCHEME_VERSION_X 7
 #define MZSCHEME_VERSION_Y 1
 #define MZSCHEME_VERSION_Z 0
-#define MZSCHEME_VERSION_W 4
+#define MZSCHEME_VERSION_W 5
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

racket/src/racket/src/thread.c

@@ -7972,6 +7972,7 @@ static void make_initial_config(Scheme_Thread *p)
 
   init_param(cells, paramz, MZCONFIG_COMPILE_MODULE_CONSTS, scheme_true);
   init_param(cells, paramz, MZCONFIG_USE_JIT, scheme_startup_use_jit ? scheme_true : scheme_false);
+  init_param(cells, paramz, MZCONFIG_COMPILE_MACHINE_INDEPENDENT, scheme_startup_compile_machine_independent ? scheme_true : scheme_false);
 
   {
     Scheme_Object *s;