From ed807f8584c0f18254a06cfa4e1ab4ba6b059ccf Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 6 Mar 2019 06:25:18 -0700
Subject: [PATCH] cs: use cross-compiler server for fasl

The Chez Scheme fasl format is not machine-independent when record
types are involved, so use the process that serves compilation to also
serve fasl encoding.
---
 racket/src/cs/c/cross-serve.ss         |  3 +++
 racket/src/cs/linklet.sls              |  4 +---
 racket/src/cs/linklet/cross-compile.ss | 10 ++++++++--
 racket/src/cs/linklet/write.ss         |  8 +++++---
 4 files changed, 17 insertions(+), 8 deletions(-)

diff --git a/racket/src/cs/c/cross-serve.ss b/racket/src/cs/c/cross-serve.ss
index df4b8db209..fd1e62fdff 100644
--- a/racket/src/cs/c/cross-serve.ss
+++ b/racket/src/cs/c/cross-serve.ss
@@ -45,6 +45,9 @@
           (case cmd
             [(compile)
              (compile-to-port (list `(lambda () ,(read-fasled))) o)]
+            [(fasl)
+             ;; Reads host fasl format, then writes target fasl format
+             (fasl-write (read-fasled) o)]
             [else
              (error 'serve-cross-compile (format "unrecognized command: ~s" cmd))])
           (let ([result (get)])
diff --git a/racket/src/cs/linklet.sls b/racket/src/cs/linklet.sls
index df4bb6dccb..feda17af62 100644
--- a/racket/src/cs/linklet.sls
+++ b/racket/src/cs/linklet.sls
@@ -253,9 +253,7 @@
   (define (make-cross-compile-to-bytevector machine)
     (lambda (s paths format)
       (let ([bv (cond
-                 [(eq? format 'interpret)
-                  ;; fasl format is not machine-specific:
-                  (compile-to-bytevector s paths format)]
+                 [(eq? format 'interpret) (cross-fasl-to-string machine s)]
                  [else (cross-compile machine s)])])
         (if compress-code?
             (bytevector-compress bv)
diff --git a/racket/src/cs/linklet/cross-compile.ss b/racket/src/cs/linklet/cross-compile.ss
index a588bfa543..5799463390 100644
--- a/racket/src/cs/linklet/cross-compile.ss
+++ b/racket/src/cs/linklet/cross-compile.ss
@@ -52,17 +52,23 @@
    (unsafe-place-local-set! cross-machine-compiler-cache
                             (cons a (unsafe-place-local-ref cross-machine-compiler-cache)))))
 
-(define (cross-compile machine v)
+(define (do-cross cmd machine v)
   (let* ([a (find-cross 'cross-compile machine)]
          [ch (cadr a)]
          [reply-ch (make-channel)])
-    (channel-put ch (list 'compile
+    (channel-put ch (list cmd
                           v
                           reply-ch))
     (begin0
      (channel-get reply-ch)
      (cache-cross-compiler a))))
 
+(define (cross-compile machine v)
+  (do-cross 'compile machine v))
+
+(define (cross-fasl-to-string machine v)
+  (do-cross 'fasl machine 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
diff --git a/racket/src/cs/linklet/write.ss b/racket/src/cs/linklet/write.ss
index 23a8a01c0d..f671987b79 100644
--- a/racket/src/cs/linklet/write.ss
+++ b/racket/src/cs/linklet/write.ss
@@ -5,9 +5,11 @@
 
 (define (write-linklet-bundle-hash ht dest-o)
   (let-values ([(ht cross-machine) (encode-linklet-paths ht)])
-    (let ([bstr (let-values ([(o get) (open-bytevector-output-port)])
-                  (fasl-write* ht o)
-                  (get))])
+    (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)))])
       (write-bytes (integer->integer-bytes (bytes-length bstr) 4 #f #f) dest-o)
       (write-bytes bstr dest-o))))