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

cs: reduce communication for cross compilation

Browse Source 
Communicating in terms of S-expression is convenient but wasteful,
so communicate in bytes.
This commit is contained in:
Matthew Flatt 2019-03-13 10:40:10 -06:00
parent 00a50ca772
commit 5a96e89f95
3 changed files with 40 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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)))))))

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

@ -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?)

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

@ -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))))