Update of /cvsroot/scsh/scsh-0.6/scheme/rts
In directory usw-pr-cvs1:/tmp/cvs-serv28215/scheme/rts
Modified Files:
channel-port.scm port.scm
Log Message:
Adapted some of Richard's changes for char-ready? and output-port-ready?.
Index: channel-port.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scheme/rts/channel-port.scm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** channel-port.scm 1999/09/16 16:09:40 1.2
--- channel-port.scm 2001/03/23 10:59:07 1.3
***************
*** 14,19 ****
; 3) exactly NEEDED characters are required (from READ-BLOCK)
(define input-channel-handler
! (make-port-handler
(lambda (channel-cell)
(list 'input-port (channel-cell-ref channel-cell)))
--- 14,22 ----
; 3) exactly NEEDED characters are required (from READ-BLOCK)
+ (define (channel-port-ready? channel-cell)
+ (channel-ready? (channel-cell-ref channel-cell)))
+
(define input-channel-handler
! (make-buffered-input-port-handler
(lambda (channel-cell)
(list 'input-port (channel-cell-ref channel-cell)))
***************
*** 23,28 ****
(lambda (channel-cell buffer start needed)
(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)
--- 26,32 ----
(lambda (channel-cell buffer start needed)
(channel-read buffer start needed (channel-cell-ref channel-cell)))
+ channel-port-ready?
(lambda (channel-cell owner)
! (steal-channel! (channel-cell-ref channel-cell) owner))))
(define (input-channel->port channel . maybe-buffer-size)
***************
*** 40,51 ****
(if (>= 0 buffer-size)
(call-error "invalid buffer size" input-channel->port channel
buffer-size)
! (make-input-port input-channel-handler
! (make-channel-cell channel closer)
! (make-code-vector buffer-size 0)
! 0
! 0))))
(define output-channel-handler
! (make-port-handler
(lambda (channel-cell)
(list 'output-port (channel-cell-ref channel-cell)))
--- 44,55 ----
(if (>= 0 buffer-size)
(call-error "invalid buffer size" input-channel->port channel
buffer-size)
! (make-buffered-input-port input-channel-handler
! (make-channel-cell channel closer)
! (make-code-vector buffer-size 0)
! 0
! 0))))
(define output-channel-handler
! (make-buffered-output-port-handler
(lambda (channel-cell)
(list 'output-port (channel-cell-ref channel-cell)))
***************
*** 55,58 ****
--- 59,63 ----
(lambda (channel-cell buffer start count)
(channel-write buffer start count (channel-cell-ref channel-cell)))
+ channel-port-ready?
(lambda (channel-cell owner)
(steal-channel! (channel-cell-ref channel-cell) owner))))
***************
*** 71,76 ****
(code-vector-set! buffer 0 (char->ascii char))
(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
--- 76,83 ----
(code-vector-set! buffer 0 (char->ascii char))
(channel-write buffer 0 1 (channel-cell-ref channel-cell)))
! (lambda (channel-cell)
! (channel-ready? (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
***************
*** 97,105 ****
(make-channel-cell channel closer)))
(else
! (let ((port (make-output-port output-channel-handler
! (make-channel-cell channel closer)
! (make-code-vector buffer-size 0)
! 0
! buffer-size)))
(periodically-force-output! port)
((structure-ref primitives add-finalizer!) port
--- 104,113 ----
(make-channel-cell channel closer)))
(else
! (let ((port (make-buffered-output-port
! output-channel-handler
! (make-channel-cell channel closer)
! (make-code-vector buffer-size 0)
! 0
! buffer-size)))
(periodically-force-output! port)
((structure-ref primitives add-finalizer!) port
Index: port.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scheme/rts/port.scm,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -r1.4 -r1.5
*** port.scm 2000/07/27 13:28:40 1.4
--- port.scm 2001/03/23 10:59:07 1.5
***************
*** 10,24 ****
(define-record-type port-handler :port-handler
! (really-make-port-handler discloser close buffer-proc steal)
port-handler?
(discloser port-handler-discloser)
(close port-handler-close)
(buffer-proc port-handler-buffer-proc)
(steal port-handler-steal))
! (define (make-port-handler discloser close buffer-proc . maybe-steal)
(if (pair? maybe-steal)
! (really-make-port-handler discloser close buffer-proc (car maybe-steal))
! (really-make-port-handler discloser close buffer-proc
(lambda (port-data owner) #f))))
--- 10,26 ----
(define-record-type port-handler :port-handler
! (really-make-port-handler discloser close buffer-proc ready? steal)
port-handler?
(discloser port-handler-discloser)
(close port-handler-close)
(buffer-proc port-handler-buffer-proc)
+ (ready? port-handler-ready?)
(steal port-handler-steal))
! (define (make-port-handler discloser close buffer-proc ready? . maybe-steal)
(if (pair? maybe-steal)
! (really-make-port-handler discloser close buffer-proc ready?
! (car maybe-steal))
! (really-make-port-handler discloser close buffer-proc ready?
(lambda (port-data owner) #f))))
***************
*** 223,248 ****
(define (real-char-ready? port)
! (cond ((not (open-input-port? port))
! (call-error "invalid argument" char-ready? port))
! ((not (maybe-obtain-port-lock port))
! #f)
! ((not (open-port? port)) ; have to check again after the lock call
! (release-port-lock port)
! (call-error "invalid argument" char-ready? port))
! ((or (< (port-index port) (port-limit port))
! (port-pending-eof? port))
! (release-port-lock port)
! #t)
! (else
! (let ((got (fill-port-buffer! port 'immediate)))
! (cond ((eof-object? got)
! (set-port-pending-eof?! port #t)
! (release-port-lock port)
! #t)
! (else
! (set-port-index! port 0)
! (set-port-limit! port got)
! (release-port-lock port)
! (> got 0)))))))
;----------------
--- 225,232 ----
(define (real-char-ready? port)
! (if (not (open-input-port? port))
! (call-error "invalid argument" char-ready? port)
! ((port-handler-ready? (port-handler port)) (port-data port))))
!
;----------------
***************
*** 343,346 ****
--- 327,346 ----
(write-block string 0 (string-length string) port))
+ ; CHAR-READY? for output ports.
+
+ (define (output-port-ready? port)
+ (cond ((not (open-output-port? port))
+ (call-error "invalid argument" output-port-ready? port))
+ ((not (maybe-obtain-port-lock port))
+ #f)
+ ((not (open-port? port)) ; have to check again after the lock call
+ (release-port-lock port)
+ (call-error "invalid argument" output-port-ready? port))
+ (else
+ (let ((val ((port-handler-ready? (port-handler port))
+ (port-data port))))
+ (release-port-lock port)
+ val))))
+
; Copy the bytes into the buffer if there is room, otherwise write out
anything
; in the buffer and then write BUFFER.
***************
*** 507,510 ****
--- 507,512 ----
(lambda (channel buffer start need)
(unspecific))
+ (lambda (port) ; ready?
+ #t)
(lambda (ignore1 ignore2)
#f)))
***************
*** 658,661 ****
(if status (make-ready owner))))
!
--- 660,758 ----
(if status (make-ready owner))))
+ ;;;;; We don't have unbuffered input ports for now. It's possible to
+ ;;;;; define them if the handler takes care of the char for peek-char,
+ ;;;;; but there is not much point in having them. A buffered port with
+ ;;;;; buffer size 1 provides the same functionality. See 0.54 for
+ ;;;;; unbuffered input ports
!
! ;;;;; buffered ports
! ;;;;;
! ;;;;; This is only a skeleton. With the switch to 0.54 everything will
! ;;;;; change anyway, but for char-ready? we need some abstraction now
! ;;;;; This code is stolen from 0.54's port-buffer.scm and shortened
!
! (define (make-buffered-input-port handler data buffer index limit)
! (if (and (okay-buffer? buffer index limit)
! (port-handler? handler))
! (make-port handler
! (bitwise-ior input-port-mask open-input-port-mask)
! (make-lock)
! #f ; locked?
! data
! buffer
! index
! limit
! #f) ; pending-eof?
! (call-error "invalid argument"
! make-buffered-input-port handler data buffer index limit)))
!
! (define (make-buffered-output-port handler data buffer index limit)
! (if (and (okay-buffer? buffer index limit)
! (> limit 0)
! (port-handler? handler))
! (make-port handler
! open-output-port-status
! (make-lock)
! #f ; locked?
! data
! buffer
! index
! limit
! #f) ; pending-eof?
! (call-error "invalid argument"
! make-buffered-output-port handler data buffer index limit)))
!
! (define (okay-buffer? buffer index limit)
! (and (code-vector? buffer)
! (let ((length (code-vector-length buffer)))
! (integer? limit)
! (integer? index)
! (exact? limit)
! (exact? index)
! (<= 0 limit length)
! (<= 0 index limit))))
!
!
! (define (make-buffered-input-port-handler discloser
! closer!
! read-block!
! ready?
! . maybe-steal!)
! (apply make-port-handler discloser
! closer!
! read-block!
! (make-char-ready? ready? #t)
! maybe-steal!))
!
! ;----------------
! ; See if there is a character available.
!
! (define (make-char-ready? ready? read?)
! (lambda (port)
! (cond ((not ((if read?
! open-input-port?
! open-output-port?)
! port))
! (call-error "invalid argument" char-ready? port))
! ((or (< (port-index port)
! (port-limit port))
! (and read?
! (port-pending-eof? port)))
! #t)
! (else
! (ready? port)))))
!
!
! (define (make-buffered-output-port-handler discloser
! closer!
! buffer-emptier!
! ready?
! . maybe-steal!)
! (apply make-port-handler discloser
! closer!
! buffer-emptier!
! (make-char-ready? ready? #f)
! maybe-steal!))
!
!
\ No newline at end of file
|