- Added reset-output-port! which sets the write index to 0 and

unregisters any callbacks associated with the buffer.
- commented out the call for unblocking the stdin for now
  (for reason yet unknown to me, it causes stdout to be unblocked
   as well, making writes to the console to come out in bizarre 
   mixed order)
This commit is contained in:
Abdulaziz Ghuloum 2008-04-06 10:57:56 -04:00
parent afd7592ae1
commit bf6138f86f
2 changed files with 17 additions and 5 deletions

View File

@ -59,6 +59,7 @@
output-port-name output-port-name
port-mode set-port-mode! port-mode set-port-mode!
reset-input-port! reset-input-port!
reset-output-port!
port-id port-id
input-port-byte-position input-port-byte-position
process process
@ -118,6 +119,7 @@
output-port-name output-port-name
port-mode set-port-mode! port-mode set-port-mode!
reset-input-port! reset-input-port!
reset-output-port!
port-id port-id
input-port-byte-position input-port-byte-position
process process
@ -583,6 +585,14 @@
(unregister-callback p)) (unregister-callback p))
(die 'reset-input-port! "not an input port" p))) (die 'reset-input-port! "not an input port" p)))
(define (reset-output-port! p)
(if (output-port? p)
(begin
($set-port-index! p 0)
(unregister-callback p))
(die 'reset-output-port! "not an output port" p)))
(define (port-transcoder p) (define (port-transcoder p)
(if (port? p) (if (port? p)
(let ([tr ($port-transcoder p)]) (let ([tr ($port-transcoder p)])
@ -645,6 +655,7 @@
[(fx= bytes idx) [(fx= bytes idx)
($set-port-index! p 0)] ($set-port-index! p 0)]
[(fx= bytes 0) [(fx= bytes 0)
($mark-port-closed! p)
(die 'flush-output-port "could not write bytes to sink")] (die 'flush-output-port "could not write bytes to sink")]
[else [else
(bytevector-copy! buf bytes buf 0 (fx- idx bytes)) (bytevector-copy! buf bytes buf 0 (fx- idx bytes))
@ -1286,7 +1297,7 @@
;(raise-continuable ;(raise-continuable
; (make-i/o-would-block-condition port)) ; (make-i/o-would-block-condition port))
(call/cc (call/cc
(lambda (k) (lambda (k)
(add-io-event fd k 'w) (add-io-event fd k 'w)
(process-events))) (process-events)))
(refill bv idx cnt)] (refill bv idx cnt)]
@ -2138,9 +2149,9 @@
(set! out-queue (reverse in-queue)) (set! out-queue (reverse in-queue))
(set! in-queue '()) (set! in-queue '())
(process-events))) (process-events)))
(let ([proc (car out-queue)]) (let ([t (car out-queue)])
(set! out-queue (cdr out-queue)) (set! out-queue (cdr out-queue))
(proc) ((t-proc t))
(process-events)))) (process-events))))
(define (add-io-event fd proc event-type) (define (add-io-event fd proc event-type)
@ -2204,7 +2215,7 @@
(set! pending (cons t pending))] (set! pending (cons t pending))]
[else [else
;;; ready ;;; ready
(set! in-queue (cons (t-proc t) in-queue))]))))) (set! in-queue (cons t in-queue))])))))
(let ([ls pending]) (let ([ls pending])
(set! pending '()) (set! pending '())
ls))))) ls)))))
@ -2296,6 +2307,6 @@
[else (die who "invalid argument" what)])) [else (die who "invalid argument" what)]))
(set-fd-nonblocking 0 'init '*stdin*) ;(set-fd-nonblocking 0 'init '*stdin*)
) )

View File

@ -356,6 +356,7 @@
[console-error-port i] [console-error-port i]
[console-output-port i] [console-output-port i]
[reset-input-port! i] [reset-input-port! i]
[reset-output-port! i]
[write-byte i] [write-byte i]
[read-token i] [read-token i]
[printf i] [printf i]