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

cs: fix build with non-threaded scheme

Browse Source
This commit is contained in:
Matthew Flatt 2018-10-08 15:27:53 -06:00
parent 076684b123
commit 3acb1a5162
2 changed files with 32 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
racket/src/cs/demo/io.ss
View File

@ -134,37 +134,38 @@
;; ----------------------------------------
(let* ([place-symbols (make-hasheq)]
[register-place-symbol!
(lambda (sym proc)
(hash-set! place-symbols sym proc))])
(set-make-place-ports+fds! make-place-ports+fds)
(set-start-place!
(lambda (pch mod sym in out err cust plumber)
(io-place-init! in out err cust plumber)
(lambda ()
((hash-ref place-symbols sym) pch))))
;; Check file port passed across places
(let ([f (open-input-file "compiled/io.scm")])
(file-stream-buffer-mode f 'none)
(let ([content (read-bytes 5 f)])
(file-position f 0)
(register-place-symbol! 'read-byte
(lambda (pch)
(let ([f (place-channel-get pch)])
(file-stream-buffer-mode f 'none)
(let ([b (read-byte f)])
(close-input-port f)
(place-channel-put pch b)))))
(let-values ([(pl in out err) (dynamic-place 'dummy 'read-byte #f #f #f)])
(test (bytes-ref content 0) (read-byte f))
(place-channel-put pl f)
(test (bytes-ref content 1) (place-channel-get pl))
(test (bytes-ref content 2) (read-byte f))
(close-input-port f)))))
(when (threaded?)
(let* ([place-symbols (make-hasheq)]
[register-place-symbol!
(lambda (sym proc)
(hash-set! place-symbols sym proc))])
(set-make-place-ports+fds! make-place-ports+fds)
(set-start-place!
(lambda (pch mod sym in out err cust plumber)
(io-place-init! in out err cust plumber)
(lambda ()
((hash-ref place-symbols sym) pch))))
;; Check file port passed across places
(let ([f (open-input-file "compiled/io.scm")])
(file-stream-buffer-mode f 'none)
(let ([content (read-bytes 5 f)])
(file-position f 0)
(register-place-symbol! 'read-byte
(lambda (pch)
(let ([f (place-channel-get pch)])
(file-stream-buffer-mode f 'none)
(let ([b (read-byte f)])
(close-input-port f)
(place-channel-put pch b)))))
(let-values ([(pl in out err) (dynamic-place 'dummy 'read-byte #f #f #f)])
(test (bytes-ref content 0) (read-byte f))
(place-channel-put pl f)
(test (bytes-ref content 1) (place-channel-get pl))
(test (bytes-ref content 2) (read-byte f))
(close-input-port f))))))
;; Thread can be GCed if it's block on a place channel with no writer
(let ()

2
racket/src/cs/rumble/lock.ss
View File

@ -47,7 +47,7 @@
;; engine-based concurrency
(define-syntax-rule (with-global-lock e ...)
(with-interrupts-disabled
e))]
e ...))]
[else
;; Using a Chez Scheme build with thread support; make hash-table
;; access thread-safe at that level for `eq?`- and `eqv?`-based