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)))