From 20081c537b870db64318f9c7601a0855add2230f Mon Sep 17 00:00:00 2001 From: marting Date: Thu, 16 Sep 1999 16:09:40 +0000 Subject: [PATCH] added dfishers steal-port stuff --- scheme/rts/channel-port.scm | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/scheme/rts/channel-port.scm b/scheme/rts/channel-port.scm index 35922f0..a9b44f5 100644 --- a/scheme/rts/channel-port.scm +++ b/scheme/rts/channel-port.scm @@ -21,7 +21,9 @@ ((channel-cell-closer channel-cell) (channel-cell-ref channel-cell))) (lambda (channel-cell buffer start needed) - (channel-read buffer start needed (channel-cell-ref channel-cell))))) + (channel-read buffer start needed (channel-cell-ref channel-cell))) + (lambda (channel-cell owner) + (steal-channel! (channel-cell-ref) owner)))) (define (input-channel->port channel . maybe-buffer-size) (real-input-channel->port channel maybe-buffer-size close-input-channel)) @@ -51,7 +53,9 @@ ((channel-cell-closer channel-cell) (channel-cell-ref channel-cell))) (lambda (channel-cell buffer start count) - (channel-write buffer start count (channel-cell-ref channel-cell))))) + (channel-write buffer start count (channel-cell-ref channel-cell))) + (lambda (channel-cell owner) + (steal-channel! (channel-cell-ref channel-cell) owner)))) ; Unbuffered channel output ports. Used for the default error port. @@ -65,7 +69,9 @@ (channel-cell-ref channel-cell))) (lambda (channel-cell char) (code-vector-set! buffer 0 (char->ascii char)) - (channel-write buffer 0 1 (channel-cell-ref channel-cell)))))) + (channel-write buffer 0 1 (channel-cell-ref channel-cell))) + (lambda (channel-cell owner) + (steal-channel! (channel-cell-ref channel-cell) owner))))) ; Dispatch on the buffer size to make the appropriate port. A buffer ; size of zero creates an unbuffered port. Buffered output ports get a