[Scsh-checkins] CVS: scsh-0.6/scsh newports.scm,1.9,1.10

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

Update of /cvsroot/scsh/scsh-0.6/scsh
In directory usw-pr-cvs1:/tmp/cvs-serv23499

Modified Files:
        newports.scm 
Log Message:
Use a weak integer-table to store the fdports dropping the limit on
the number of ports (fixes #433867).


Index: newports.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/newports.scm,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -r1.9 -r1.10
*** newports.scm        2001/04/09 07:55:50     1.9
--- newports.scm        2001/06/21 08:30:51     1.10
***************
*** 7,29 ****
    revealed)
  
- (define max-fdport 255)
- 
  ; This stuff is _weak_.
  ; Vector of weak pointers mapping fd -> fdport.
  
! (define (weak-vector-set! vector number set-me)
!   (vector-set! vector number (make-weak-pointer set-me)))
  
! (define (weak-vector-ref vector number)
!   (let ((ref (vector-ref vector number)))
      (if (weak-pointer? ref) (weak-pointer-ref ref) ref)))
  
! (define (strengthen-weak-vector-ref vector number)
!   (vector-set! vector number (weak-vector-ref vector number)))
  
! (define (weaken-weak-vector-ref vector number)
!   (weak-vector-set! vector number (weak-vector-ref vector number)))
  
! (define fdports (make-vector max-fdport #f))
  
  (define (install-fdport fdport)
--- 7,33 ----
    revealed)
  
  ; This stuff is _weak_.
  ; Vector of weak pointers mapping fd -> fdport.
  
! (define (weak-table-set! table number set-me)
!   (table-set! table number (make-weak-pointer set-me)))
  
! (define (weak-table-ref table number)
!   (let ((ref (table-ref table number)))
      (if (weak-pointer? ref) (weak-pointer-ref ref) ref)))
+ 
+ (define (weak-table-walk proc table)
+   (table-walk
+    (lambda (number value)
+      (if (weak-pointer? value) (weak-pointer-ref value) value))
+    table))
  
! (define (strengthen-weak-table-ref table number)
!   (table-set! table number (weak-table-ref vector number)))
  
! (define (weaken-weak-table-ref table number)
!   (weak-table-set! table number (weak-table-ref vector number)))
  
! (define fdports (make-integer-table))
  
  (define (install-fdport fdport)
***************
*** 32,40 ****
         (ch-number  (channel-os-index ch)))
      (if (not (= (fdport-data:revealed fdport*) 0))
!       (vector-set! fdports ch-number fdport)
!       (weak-vector-set! fdports ch-number fdport))))
  
  (define (maybe-fdes->port fdes)
!   (weak-vector-ref fdports fdes))
  
  ;Hmm... these shouldn't be necessary.  But still.
--- 36,44 ----
         (ch-number  (channel-os-index ch)))
      (if (not (= (fdport-data:revealed fdport*) 0))
!       (table-set! fdports ch-number fdport)
!       (weak-table-set! fdports ch-number fdport))))
  
  (define (maybe-fdes->port fdes)
!   (weak-table-ref fdports fdes))
  
  ;Hmm... these shouldn't be necessary.  But still.
***************
*** 134,138 ****
  
  (define (close-fdport* fdport*)
!   (vector-set! fdports (channel-os-index (fdport-data:channel fdport*)) #f)
    (close-channel (fdport-data:channel fdport*)))
  
--- 138,142 ----
  
  (define (close-fdport* fdport*)
!   (table-set! fdports (channel-os-index (fdport-data:channel fdport*)) #f)
    (close-channel (fdport-data:channel fdport*)))
  
***************
*** 377,381 ****
      (if (and (zero? count) (> newcount 0))          ; We just became revealed,
        (begin
!         (strengthen-weak-vector-ref fdports (fdport-data:fd data))
          (%set-cloexec (fdport-data:fd data) #f)))); so don't close on exec().
    (release-port-lock port))
--- 381,385 ----
      (if (and (zero? count) (> newcount 0))          ; We just became revealed,
        (begin
!         (strengthen-weak-table-ref fdports (fdport-data:fd data))
          (%set-cloexec (fdport-data:fd data) #f)))); so don't close on exec().
    (release-port-lock port))
***************
*** 393,397 ****
          (if (zero? new-rev)                   ; We just became unrevealed, so
              (begin                            ; the fd can be closed on exec.
!               (weaken-weak-vector-ref fdports (fdport-data:fd data))
                (%set-cloexec (fdport-data:fd data) #t))))))
    (release-port-lock port))
--- 397,401 ----
          (if (zero? new-rev)                   ; We just became unrevealed, so
              (begin                            ; the fd can be closed on exec.
!               (weaken-weak-table-ref fdports (fdport-data:fd data))
                (%set-cloexec (fdport-data:fd data) #t))))))
    (release-port-lock port))
***************
*** 521,530 ****
         (old-vector-ref (vector-ref fdports old-fd)))
      (set-fdport-data:revealed fdport* new-revealed)
!     (vector-set! fdports old-fd #f)
      (close-channel ch)
      (set-fdport-data:channel 
       fdport*
       (make-fd-channel port fd))
!     (vector-set! fdports fd old-vector-ref)
      (%set-cloexec fd (not new-revealed)))
    (release-port-lock port)
--- 525,534 ----
         (old-vector-ref (vector-ref fdports old-fd)))
      (set-fdport-data:revealed fdport* new-revealed)
!     (table-set! fdports old-fd #f)
      (close-channel ch)
      (set-fdport-data:channel 
       fdport*
       (make-fd-channel port fd))
!     (table-set! fdports fd old-vector-ref)
      (%set-cloexec fd (not new-revealed)))
    (release-port-lock port)
***************
*** 543,552 ****
  
  (define (flush-all-ports)
!   (let loop ((i 0))
!     (if (< i max-fdport)
!       (begin
!         (let ((fdport (weak-vector-ref fdports i)))
!           (if (and fdport (output-port? fdport) ) (flush-fdport fdport)))
!         (loop (+ i 1))))))
  
  ;;; Extend R4RS i/o ops to handle file descriptors.
--- 547,554 ----
  
  (define (flush-all-ports)
!   (weak-table-walk
!    (lambda (i fdport)
!      (if (and fdport (output-port? fdport)) (flush-fdport fdport)))
!    fdports))
  
  ;;; Extend R4RS i/o ops to handle file descriptors.