Use a weak integer-table to store the fdports dropping the limit on

the number of ports (fixes #433867).

scsh/newports.scm

@@ -6,36 +6,40 @@
   channel
   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-table-set! table number set-me)
+  (table-set! table number (make-weak-pointer set-me)))
 
-(define (weak-vector-ref vector number)
-  (let ((ref (vector-ref vector number)))
+(define (weak-table-ref table number)
+  (let ((ref (table-ref table 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 (weak-table-walk proc table)
+  (table-walk
+   (lambda (number value)
+     (if (weak-pointer? value) (weak-pointer-ref value) value))
+   table))
 
-(define (weaken-weak-vector-ref vector number)
-  (weak-vector-set! vector number (weak-vector-ref vector number)))
+(define (strengthen-weak-table-ref table number)
+  (table-set! table number (weak-table-ref vector number)))
 
-(define fdports (make-vector max-fdport #f))
+(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)
   (let* ((fdport* (fdport-data fdport))
 	 (ch (fdport-data:channel fdport*))
 	 (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))))
+	(table-set! fdports ch-number fdport)
+	(weak-table-set! fdports ch-number fdport))))
 
 (define (maybe-fdes->port fdes)
-  (weak-vector-ref fdports fdes))
+  (weak-table-ref fdports fdes))
 
 ;Hmm... these shouldn't be necessary.  But still.
 ;Fake defrec routines for backwards compatibility.
@@ -133,7 +137,7 @@
 (define null-func (lambda args #t))
 
 (define (close-fdport* fdport*)
-  (vector-set! fdports (channel-os-index (fdport-data:channel fdport*)) #f)
+  (table-set! fdports (channel-os-index (fdport-data:channel fdport*)) #f)
   (close-channel (fdport-data:channel fdport*)))
 
 ;The handlers drop straight through to the convenient channel routines.
@@ -376,7 +380,7 @@
     (set-fdport-data:revealed data newcount)
     (if (and (zero? count) (> newcount 0))          ; We just became revealed,
 	(begin
-	  (strengthen-weak-vector-ref fdports (fdport-data:fd data))
+	  (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))
 
@@ -392,7 +396,7 @@
 	  (set-fdport-data:revealed data new-rev)
 	  (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))
+		(weaken-weak-table-ref fdports (fdport-data:fd data))
 		(%set-cloexec (fdport-data:fd data) #t))))))
   (release-port-lock port))
 
@@ -520,12 +524,12 @@
 	 (old-fd (channel-os-index ch))
 	 (old-vector-ref (vector-ref fdports old-fd)))
     (set-fdport-data:revealed fdport* new-revealed)
-    (vector-set! fdports old-fd #f)
+    (table-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)
+    (table-set! fdports fd old-vector-ref)
     (%set-cloexec fd (not new-revealed)))
   (release-port-lock port)
   #f)  ; JMG: It used to return #f on succes in 0.5.1, so we do the same
@@ -542,12 +546,10 @@
   (force-output fdport))
 
 (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))))))
+  (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.
 ;;; -----------------------------------------------