diff --git a/racket/src/cs/c/cross-serve.ss b/racket/src/cs/c/cross-serve.ss index 9eaa8850d5..6a90bd86f3 100644 --- a/racket/src/cs/c/cross-serve.ss +++ b/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))])]) diff --git a/racket/src/cs/linklet.sls b/racket/src/cs/linklet.sls index 87fd89edb1..5c426ffffe 100644 --- a/racket/src/cs/linklet.sls +++ b/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) diff --git a/racket/src/cs/linklet/cross-compile.ss b/racket/src/cs/linklet/cross-compile.ss index f3655d20b4..810adbe241 100644 --- a/racket/src/cs/linklet/cross-compile.ss +++ b/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 ) - (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, diff --git a/racket/src/cs/linklet/write.ss b/racket/src/cs/linklet/write.ss index 075de0f7de..66ae47a06c 100644 --- a/racket/src/cs/linklet/write.ss +++ b/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)