cs: fix cross-compile non-code fasl compression

When cross compiling, use the same fasl compression mode as non-cross
compilation on linklet bundles --- instead of always compressing,
which slows down module loading in most environments.

racket/src/cs/c/cross-serve.ss

@@ -29,7 +29,7 @@
     (let loop ()
       (let ([cmd (get-u8 in)])
         (unless (eof-object? cmd)
-          (let ([compress-code? (eqv? (get-u8 in) (char->integer #\y))])
+          (let ([compress? (eqv? (get-u8 in) (char->integer #\y))])
             (get-u8 in) ; newline
             (let-values ([(o get) (open-bytevector-output-port)])
               (let ([literals
@@ -41,15 +41,15 @@
                            (parameterize ([optimize-level (if (fx= cmd (char->integer #\u))
                                                               3
                                                               (optimize-level))]
-                                          [fasl-compressed compress-code?])
+                                          [fasl-compressed compress?])
                              (compile-to-port (list v) o #f #f #f (string->symbol target) #f pred 'omit-rtds))))]
-                       [(#\f)
+                       [(#\f #\d)
                         ;; Reads host fasl format, then writes target fasl format
                         (call-with-fasled
                          in
                          (lambda (v pred)
                            (parameterize ([#%$target-machine (string->symbol target)]
-                                          [fasl-compressed compress-code?])
+                                          [fasl-compressed compress?])
                              (fasl-write v o pred))))]
                        [else
                         (error 'serve-cross-compile (format "unrecognized command: ~s" cmd))])])

racket/src/cs/linklet.sls

@@ -174,6 +174,17 @@
                             [(getenv "PLT_CS_MAKE_COMPRESSED") #t]
                             [else #f])]))
 
+  ;; Note: compressing data also compresses serialized code, which is
+  ;; a redundant layer of compression if `compress-code?`
+  (define compress-data? (cond
+                           [(getenv "PLT_LINKLET_COMPRESS_DATA") #t]
+                           [(getenv "PLT_LINKLET_NO_COMPRESS_DATA") #f]
+                           [else
+                            ;; Default selected at compile time, as above
+                            (meta-cond
+                             [(getenv "PLT_CS_MAKE_COMPRESSED_DATA") #t]
+                             [else #f])]))
+
   (define gensym-on? (getenv "PLT_LINKLET_SHOW_GENSYM"))
   (define pre-jit-on? (getenv "PLT_LINKLET_SHOW_PRE_JIT"))
   (define lambda-on? (getenv "PLT_LINKLET_SHOW_LAMBDA"))
@@ -235,7 +246,9 @@
   (define (interpret* e) ; result is not safe for space
     (call-with-system-wind (lambda () (interpret e))))
   (define (fasl-write* s o)
-    (call-with-system-wind (lambda () (fasl-write s o))))
+    (call-with-system-wind (lambda ()
+                             (parameterize ([fasl-compressed compress-data?])
+                               (fasl-write s o)))))
   (define (fasl-write/literals* s quoteds o)
     (call-with-system-wind (lambda ()
                              (call-getting-literals
@@ -334,7 +347,7 @@
   ;; returns code bytevector and literals vector
   (define (cross-compile-to-bytevector machine s quoteds format unsafe?)
     (cond
-      [(eq? format 'interpret) (cross-fasl-to-string machine s quoteds)]
+      [(eq? format 'interpret) (cross-fasl-to-string machine s quoteds 'code)]
       [else (cross-compile machine (lambda->linklet-lambda s) quoteds unsafe?)]))
 
   (define (eval-from-bytevector bv literals format)

racket/src/cs/linklet/cross-compile.ss

@@ -67,8 +67,8 @@
 (define (cross-compile machine v quoteds unsafe?)
   (do-cross (if unsafe? 'u 'c) machine v quoteds))
 
-(define (cross-fasl-to-string machine v quoteds)
-  (do-cross 'f machine v quoteds))
+(define (cross-fasl-to-string machine v quoteds mode)
+  (do-cross (if (eq? mode 'code) 'f 'd) machine v quoteds))
 
 ;; Start a compiler as a Racket thread under the root custodian.
 ;; Using Racket's scheduler lets us use the event and I/O system,
@@ -112,9 +112,12 @@
              ;; 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)])
+               (let* ([msg (channel-get msg-ch)]
+                      [compress? (case (car msg)
+                                   [(d) compress-data?]
+                                   [else compress-code?])])
                  ;; msg is (list <command> <value> <quoted> <reply-channel>)
-                 (write-string (#%format "~a~a\n" (car msg) (if compress-code? #\y #\n)) to)
+                 (write-string (#%format "~a~a\n" (car msg) (if compress? #\y #\n)) to)
                  (let-values ([(bv literals) (fasl-to-bytevector (cadr msg) (caddr msg))])
                    ;; We can't send all literals to the cross compiler, but we can send
                    ;; strings and byte stringa, which might affect compilation. Otherwise,

racket/src/cs/linklet/write.ss

@@ -6,7 +6,7 @@
 (define (write-linklet-bundle-hash ht dest-o)
   (let-values ([(ls cross-machine) (encode-linklet-literals ht)])
     (let ([bstr (if cross-machine
-                    (let-values ([(bstr literals) (cross-fasl-to-string cross-machine ls #f)])
+                    (let-values ([(bstr literals) (cross-fasl-to-string cross-machine ls #f 'data)])
                       (unless (equal? literals '#())
                         (#%error 'write-linklet "cross fasl produced additional literals"))
                       bstr)