cs: fix build with non-threaded scheme
This commit is contained in:
parent
076684b123
commit
3acb1a5162
|
@ -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
|
(when (threaded?)
|
||||||
(let ([f (open-input-file "compiled/io.scm")])
|
(let* ([place-symbols (make-hasheq)]
|
||||||
(file-stream-buffer-mode f 'none)
|
[register-place-symbol!
|
||||||
(let ([content (read-bytes 5 f)])
|
(lambda (sym proc)
|
||||||
(file-position f 0)
|
(hash-set! place-symbols sym proc))])
|
||||||
|
(set-make-place-ports+fds! make-place-ports+fds)
|
||||||
(register-place-symbol! 'read-byte
|
(set-start-place!
|
||||||
(lambda (pch)
|
(lambda (pch mod sym in out err cust plumber)
|
||||||
(let ([f (place-channel-get pch)])
|
(io-place-init! in out err cust plumber)
|
||||||
(file-stream-buffer-mode f 'none)
|
(lambda ()
|
||||||
(let ([b (read-byte f)])
|
((hash-ref place-symbols sym) pch))))
|
||||||
(close-input-port f)
|
|
||||||
(place-channel-put pch b)))))
|
;; Check file port passed across places
|
||||||
(let-values ([(pl in out err) (dynamic-place 'dummy 'read-byte #f #f #f)])
|
(let ([f (open-input-file "compiled/io.scm")])
|
||||||
(test (bytes-ref content 0) (read-byte f))
|
(file-stream-buffer-mode f 'none)
|
||||||
(place-channel-put pl f)
|
(let ([content (read-bytes 5 f)])
|
||||||
(test (bytes-ref content 1) (place-channel-get pl))
|
(file-position f 0)
|
||||||
(test (bytes-ref content 2) (read-byte f))
|
|
||||||
(close-input-port f)))))
|
(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
|
;; Thread can be GCed if it's block on a place channel with no writer
|
||||||
(let ()
|
(let ()
|
||||||
|
|
|
@ -47,7 +47,7 @@
|
||||||
;; engine-based concurrency
|
;; engine-based concurrency
|
||||||
(define-syntax-rule (with-global-lock e ...)
|
(define-syntax-rule (with-global-lock e ...)
|
||||||
(with-interrupts-disabled
|
(with-interrupts-disabled
|
||||||
e))]
|
e ...))]
|
||||||
[else
|
[else
|
||||||
;; Using a Chez Scheme build with thread support; make hash-table
|
;; Using a Chez Scheme build with thread support; make hash-table
|
||||||
;; access thread-safe at that level for `eq?`- and `eqv?`-based
|
;; access thread-safe at that level for `eq?`- and `eqv?`-based
|
||||||
|
|
Loading…
Reference in New Issue
Block a user