suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cs: use cross-compiler server for fasl

Browse Source 
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.
This commit is contained in:
Matthew Flatt 2019-03-06 06:25:18 -07:00
parent f68248ee3b
commit ed807f8584
4 changed files with 17 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
racket/src/cs/c/cross-serve.ss
View File

@ -45,6 +45,9 @@
(case cmd (case cmd
[(compile) [(compile)
(compile-to-port (list `(lambda () ,(read-fasled))) o)] (compile-to-port (list `(lambda () ,(read-fasled))) o)]
[(fasl)
;; Reads host fasl format, then writes target fasl format
(fasl-write (read-fasled) o)]
[else [else
(error 'serve-cross-compile (format "unrecognized command: ~s" cmd))]) (error 'serve-cross-compile (format "unrecognized command: ~s" cmd))])
(let ([result (get)]) (let ([result (get)])

4
racket/src/cs/linklet.sls
View File

@ -253,9 +253,7 @@
(define (make-cross-compile-to-bytevector machine) (define (make-cross-compile-to-bytevector machine)
(lambda (s paths format) (lambda (s paths format)
(let ([bv (cond (let ([bv (cond
[(eq? format 'interpret) [(eq? format 'interpret) (cross-fasl-to-string machine s)]
;; fasl format is not machine-specific:
(compile-to-bytevector s paths format)]
[else (cross-compile machine s)])]) [else (cross-compile machine s)])])
(if compress-code? (if compress-code?
(bytevector-compress bv) (bytevector-compress bv)

10
racket/src/cs/linklet/cross-compile.ss
View File

@ -52,17 +52,23 @@
(unsafe-place-local-set! cross-machine-compiler-cache (unsafe-place-local-set! cross-machine-compiler-cache
(cons a (unsafe-place-local-ref 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)] (let* ([a (find-cross 'cross-compile machine)]
[ch (cadr a)] [ch (cadr a)]
[reply-ch (make-channel)]) [reply-ch (make-channel)])
(channel-put ch (list 'compile (channel-put ch (list cmd
v v
reply-ch)) reply-ch))
(begin0 (begin0
(channel-get reply-ch) (channel-get reply-ch)
(cache-cross-compiler a)))) (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. ;; Start a compiler as a Racket thread under the root custodian.
;; Using Racket's scheduler lets us use the event and I/O system, ;; Using Racket's scheduler lets us use the event and I/O system,
;; including support for running a process and managing resources ;; including support for running a process and managing resources

8
racket/src/cs/linklet/write.ss
View File

@ -5,9 +5,11 @@
(define (write-linklet-bundle-hash ht dest-o) (define (write-linklet-bundle-hash ht dest-o)
(let-values ([(ht cross-machine) (encode-linklet-paths ht)]) (let-values ([(ht cross-machine) (encode-linklet-paths ht)])
(let ([bstr (let-values ([(o get) (open-bytevector-output-port)]) (let ([bstr (if cross-machine
(fasl-write* ht o) (cross-fasl-to-string cross-machine ht)
(get))]) (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 (integer->integer-bytes (bytes-length bstr) 4 #f #f) dest-o)
(write-bytes bstr dest-o)))) (write-bytes bstr dest-o))))