From 4351c22d9f7b5af39cf1b2225c0a7affcf38d1e4 Mon Sep 17 00:00:00 2001
From: mainzelm <mainzelm>
Date: Sat, 7 Jul 2001 19:29:29 +0000
Subject: [PATCH] + Added a simple version of weak-tables. Only tail weak for
 now. + Replaced forgotten vector-ref in newports.scm

---
 scsh/newports.scm        | 21 +--------------------
 scsh/procobj.scm         | 12 ------------
 scsh/scsh-interfaces.scm |  4 ++++
 scsh/scsh-package.scm    |  7 ++++++-
 scsh/weaktables.scm      | 24 ++++++++++++++++++++++++
 5 files changed, 35 insertions(+), 33 deletions(-)
 create mode 100644 scsh/weaktables.scm

diff --git a/scsh/newports.scm b/scsh/newports.scm
index 851bffd..1316407 100644
--- a/scsh/newports.scm
+++ b/scsh/newports.scm
@@ -9,25 +9,6 @@
 ; 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)
@@ -522,7 +503,7 @@
   (let* ((fdport* (fdport-data port))
 	 (ch (fdport-data:channel fdport*))
 	 (old-fd (channel-os-index ch))
-	 (old-vector-ref (vector-ref fdports old-fd)))
+	 (old-vector-ref (table-ref fdports old-fd)))
     (set-fdport-data:revealed fdport* new-revealed)
     (table-set! fdports old-fd #f)
     (close-channel ch)
diff --git a/scsh/procobj.scm b/scsh/procobj.scm
index e4409f6..9e9e1bf 100644
--- a/scsh/procobj.scm
+++ b/scsh/procobj.scm
@@ -58,18 +58,6 @@
 (define (process-table-set! n val)
   (weak-table-set! (auto-init-value process-table) n val))
 
-(define (weak-table-ref t n)
-  (let ((r (table-ref t n)))
-    (if (weak-pointer? r)
-	(weak-pointer-ref r)
-	(error "there was a non-weak-pointer" r))))
-
-(define (weak-table-set! t n s)
-  (table-set! t n (make-weak-pointer s)))
-
-;(define (weaken-table-ref! t n)
-;  (weak-table-set! t n (weak-table-ref t n)))
-
 (define (maybe-pid->proc pid)
   (process-table-ref pid))
 
diff --git a/scsh/scsh-interfaces.scm b/scsh/scsh-interfaces.scm
index 8a706b2..9242a93 100644
--- a/scsh/scsh-interfaces.scm
+++ b/scsh/scsh-interfaces.scm
@@ -592,6 +592,10 @@
 	  deposit-bit-field
 	  real->exact-integer))
 
+(define-interface weak-tables-interface
+  (export make-weak-table weak-table-set! weak-table-ref weak-table-walk
+	  strengthen-weak-table-ref weaken-weak-table-ref))
+
 ;;; semi-standard network magic numbers
 ;;; should be available on all platforms
 ;;; if not, tell us, and we'll move it
diff --git a/scsh/scsh-package.scm b/scsh/scsh-package.scm
index aac1bcc..7aec629 100644
--- a/scsh/scsh-package.scm
+++ b/scsh/scsh-package.scm
@@ -38,6 +38,11 @@
 ;  (optimize auto-integrate)
   )
 
+(define-structure weak-tables weak-tables-interface
+  (open scheme
+	weak
+	tables)
+  (files weaktables))
 
 ;;; This guy goes into the FOR-SYNTAX part of scsh's syntax exports.
 (define-structure scsh-syntax-helpers
@@ -158,7 +163,7 @@
 	scsh-utilities
 	handle
 	fluids
-	weak
+	weak-tables
 
 	scsh-char-set-low-level-lib         ; rdelim.scm needs it.
 ;	scsh-regexp-package
diff --git a/scsh/weaktables.scm b/scsh/weaktables.scm
new file mode 100644
index 0000000..9d4d95c
--- /dev/null
+++ b/scsh/weaktables.scm
@@ -0,0 +1,24 @@
+;;; Tail-weak tables. This is for internal use only, for real life
+;;; applications we have to provide a more general interface with the
+;;; 3 combinations of head and tail weakness.
+
+(define make-weak-table make-table)
+
+(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 table number)))
+
+(define (weaken-weak-table-ref table number)
+  (weak-table-set! table number (weak-table-ref table number)))