From 5a96e89f95490bc0080274dd857fc5960161b977 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 13 Mar 2019 10:40:10 -0600
Subject: [PATCH] cs: reduce communication for cross compilation

Communicating in terms of S-expression is convenient but wasteful,
so communicate in bytes.
---
 racket/src/cs/c/cross-serve.ss         | 50 ++++++++++++++------------
 racket/src/cs/linklet.sls              |  3 +-
 racket/src/cs/linklet/cross-compile.ss | 17 +++++----
 3 files changed, 40 insertions(+), 30 deletions(-)

diff --git a/racket/src/cs/c/cross-serve.ss b/racket/src/cs/c/cross-serve.ss
index 30a1f1d524..23088c44dc 100644
--- a/racket/src/cs/c/cross-serve.ss
+++ b/racket/src/cs/c/cross-serve.ss
@@ -38,28 +38,34 @@
                    (regexp)
                    (linklet)))
   ;; 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)]
-            [(fasl)
-             ;; Reads host fasl format, then writes target fasl format
-             (let ([v (read-fasled)])
-               (parameterize ([#%$target-machine (string->symbol target)])
-                 (fasl-write v o)))]
-            [else
-             (error 'serve-cross-compile (format "unrecognized command: ~s" cmd))])
-          (let ([result (get)])
-            (write result)
-            (newline)
-            (flush-output-port)))
-        (loop)))))
+  (let ([in (standard-input-port)]
+        [out (standard-output-port)])
+    (let loop ()
+      (let ([cmd (get-u8 in)])
+        (unless (eof-object? cmd)
+          (get-u8 in) ; newline
+          (let-values ([(o get) (open-bytevector-output-port)])
+            (case (integer->char cmd)
+              [(#\c)
+               (compile-to-port (list `(lambda () ,(read-fasled in))) o)]
+              [(#\f)
+               ;; Reads host fasl format, then writes target fasl format
+               (let ([v (read-fasled in)])
+                 (parameterize ([#%$target-machine (string->symbol target)])
+                   (fasl-write v o)))]
+              [else
+               (error 'serve-cross-compile (format "unrecognized command: ~s" cmd))])
+            (let ([result (get)]
+                  [len-bv (make-bytevector 8)])
+              (bytevector-u64-set! len-bv 0 (bytevector-length result) (endianness little))
+              (put-bytevector out len-bv)
+              (put-bytevector out result)
+              (flush-output-port out)))
+          (loop))))))
 
 ;; ----------------------------------------
 
-(define (read-fasled)
-  (let ([bstr (read)])
-    (fasl-read (open-bytevector-input-port bstr))))
+(define (read-fasled in)
+  (let ([len-bv (get-bytevector-n in 8)])
+    (fasl-read (open-bytevector-input-port
+                (get-bytevector-n in (bytevector-u64-ref len-bv 0 (endianness little)))))))
diff --git a/racket/src/cs/linklet.sls b/racket/src/cs/linklet.sls
index 20fbb70a76..b462807183 100644
--- a/racket/src/cs/linklet.sls
+++ b/racket/src/cs/linklet.sls
@@ -91,8 +91,9 @@
                 get-original-error-port
                 subprocess
                 write-string
+                write-bytes
                 flush-output
-                read-line
+                read-bytes
                 split-path
                 path->complete-path
                 file-exists?)
diff --git a/racket/src/cs/linklet/cross-compile.ss b/racket/src/cs/linklet/cross-compile.ss
index 2c7aada3e7..e4401fa28e 100644
--- a/racket/src/cs/linklet/cross-compile.ss
+++ b/racket/src/cs/linklet/cross-compile.ss
@@ -64,10 +64,10 @@
      (cache-cross-compiler a))))
 
 (define (cross-compile machine v)
-  (do-cross 'compile machine v))
+  (do-cross 'c machine v))
 
 (define (cross-fasl-to-string machine v)
-  (do-cross 'fasl machine v))
+  (do-cross 'f 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,
@@ -107,18 +107,21 @@
                                      (symbol->string machine)
                                      (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
              ;; called is interrupted, then shut this compiler down:
              (will-register we msg-ch (lambda (msg-ch) (custodian-shutdown-all c)))
              (let loop ()
                (let ([msg (channel-get msg-ch)])
                  ;; msg is (list <command> <value> <reply-channel>)
-                 (write-string (->string (car msg)) to)
-                 (write-string (->string (fasl-to-bytevector (cadr msg))) to)
+                 (write-string (#%format "~a\n" (car msg)) to)
+                 (let ([bv (fasl-to-bytevector (cadr msg))])
+                   (write-bytes (integer->integer-bytes (bytevector-length bv) 8 #f #f) to)
+                   (write-bytes bv to))
                  (flush-output to)
-                 (channel-put (caddr msg) (string-> (read-line from)))
+                 (let* ([len-bstr (read-bytes 8 from)]
+                        [len (integer-bytes->integer len-bstr #f #f)]
+                        [bv (read-bytes len from)])
+                   (channel-put (caddr msg) bv))
                  (loop)))))))
       (list machine msg-ch))))