[Scsh-checkins] CVS: scsh-0.6/scheme/vm arch.scm,1.3,1.4 interfaces.scm,1.1.1.1,1.2 prim-io.scm,1.1.1.1,1.2 ps-channel.scm,1.1.1.1,1.2 s48-channel.scm,1.1.1.1,1.2

[Martin Gasbichler <mainzelm@users.sourceforge.net>]

Update of /cvsroot/scsh/scsh-0.6/scheme/vm
In directory usw-pr-cvs1:/tmp/cvs-serv28215/scheme/vm

Modified Files:
        arch.scm interfaces.scm prim-io.scm ps-channel.scm 
        s48-channel.scm 
Log Message:
Adapted some of Richard's changes for char-ready? and output-port-ready?.


Index: arch.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scheme/vm/arch.scm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -r1.3 -r1.4
*** arch.scm    1999/10/22 21:36:35     1.3
--- arch.scm    2001/03/23 10:59:07     1.4
***************
*** 184,187 ****
--- 184,188 ----
    (channel-maybe-read 5)
    (channel-maybe-write 4)
+   (channel-ready? 1)
    (channel-abort 1)             ; stop channel operation
    (open-channels-list)                ; return a list of the open channels

Index: interfaces.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scheme/vm/interfaces.scm,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -C2 -r1.1.1.1 -r1.2
*** interfaces.scm      1999/09/14 12:44:59     1.1.1.1
--- interfaces.scm      2001/03/23 10:59:07     1.2
***************
*** 400,403 ****
--- 400,404 ----
          close-input-channel
          close-output-channel
+         channel-ready?
          channel-read-block
          channel-write-block

Index: prim-io.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scheme/vm/prim-io.scm,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -C2 -r1.1.1.1 -r1.2
*** prim-io.scm 1999/09/14 12:44:59     1.1.1.1
--- prim-io.scm 2001/03/23 10:59:07     1.2
***************
*** 85,88 ****
--- 85,100 ----
        (raise-exception wrong-type-argument 0 channel))))
  
+ (define-consing-primitive channel-ready? (channel->)
+   (lambda (ignore) error-string-size)
+   (lambda (channel key)
+     (if (open? channel)
+       (receive (ready? status)
+           (channel-ready? (extract-channel channel)
+                           (input-channel? channel))
+         (if (error? status)
+             (raise-exception os-error 0 channel (get-error-string status key))
+             (goto return-boolean ready?)))
+       (raise-exception wrong-type-argument 0 channel))))
+ 
  (define (channel-read-or-write read? proc)
    (lambda (thing start count wait? channel key)

Index: ps-channel.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scheme/vm/ps-channel.scm,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -C2 -r1.1.1.1 -r1.2
*** ps-channel.scm      1999/09/14 12:44:59     1.1.1.1
--- ps-channel.scm      2001/03/23 10:59:07     1.2
***************
*** 45,48 ****
--- 45,55 ----
  (define close-output-channel close-channel)
  
+ ; (channel-ready? channel read?)
+ ;       -> ready? status
+ 
+ (define channel-ready?
+   (external "ps_check_fd"
+           (=> (integer boolean) boolean integer)))
+ 
  ; Read and writing blocks of data
  ;

Index: s48-channel.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scheme/vm/s48-channel.scm,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -C2 -r1.1.1.1 -r1.2
*** s48-channel.scm     1999/09/14 12:44:59     1.1.1.1
--- s48-channel.scm     2001/03/23 10:59:07     1.2
***************
*** 77,80 ****
--- 77,86 ----
    ((structure-ref prescheme close-output-port) (channel->port channel)))
  
+ (define (channel-ready? channel read?)
+   (values (if read?
+             (char-ready? (channel->port channel))
+             #t)
+         (enum (structure-ref prescheme errors) no-errors)))
+ 
  ;----------------
  ; Non-blocking I/O (implemented using CHAR-READY?)