Collect the several implementations of protection lists and merge them

together in a single place.

diff --git a/v7/src/runtime/io.scm b/v7/src/runtime/io.scm
index 5c40a28d758bd340f650edd33b579aa752b32e6e..31a36d3e70d8c68ab92b597a9b75c794c3a42dac 100644 (file)
--- a/v7/src/runtime/io.scm
+++ b/v7/src/runtime/io.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: io.scm,v 14.45 1996/02/22 19:02:25 cph Exp $
+$Id: io.scm,v 14.46 1996/04/24 03:48:36 cph Exp $
 
 Copyright (c) 1988-96 Massachusetts Institute of Technology
 
@@ -149,6 +149,7 @@ MIT in each case. |#
 (define (primitive-io/reset!)
   ;; This is invoked after disk-restoring.  It "cleans" the new runtime system.
   (close-all-open-files-internal (lambda (ignore) ignore))
+  (drop-all-protected-objects open-directories-list)
   (set! have-select? ((ucode-primitive have-select? 0)))
   unspecific)
 
@@ -507,7 +508,7 @@ MIT in each case. |#
   ((ucode-primitive new-directory-read-matching 2)
    (directory-channel/descriptor channel)
    prefix))
-
+\f
 ;;;; Protection lists
 
 ;;; These will cause problems on interpreted systems, due to the
@@ -516,15 +517,20 @@ MIT in each case. |#
 (define (make-protection-list)
   (list 'PROTECTION-LIST))
 
+;; This is used after a disk-restore, to remove invalid information.
+
+(define (drop-all-protected-objects list)
+  (set-cdr! list '()))
+
 (define (add-to-protection-list! list scheme-object microcode-object)
-  (with-absolutely-no-interrupts
+  (without-interrupts
    (lambda ()
      (set-cdr! list
               (cons (weak-cons scheme-object microcode-object)
                     (cdr list))))))
 
 (define (remove-from-protection-list! list scheme-object)
-  (with-absolutely-no-interrupts
+  (without-interrupts
    (lambda ()
      (let loop ((associations (cdr list)) (previous list))
        (if (not (null? associations))
@@ -533,6 +539,8 @@ MIT in each case. |#
               (loop (cdr associations) associations)))))))
 
 (define (clean-lost-protected-objects list cleaner)
+  ;; This assumes that interrupts are disabled.  This will normally be
+  ;; true because this should be called from a GC daemon.
   (let loop ((associations (cdr list)) (previous list))
     (if (not (null? associations))
        (if (weak-pair/car? (car associations))
@@ -543,12 +551,28 @@ MIT in each case. |#
                (set-cdr! previous next)
                (loop next previous)))))))
 
-(define (search-protection-list list microcode-object)
-  (let loop ((associations (cdr list)))
-    (and (not (null? associations))
-        (if (eq? microcode-object (system-pair-cdr (car associations)))
-            (system-pair-car (car associations))
-            (loop (cdr associations))))))
+(define (search-protection-list list predicate)
+  (without-interrupts
+   (lambda ()
+     (let loop ((associations (cdr list)))
+       (and (not (null? associations))
+           (let ((scheme-object (weak-car (car associations))))
+             (if (and scheme-object (predicate scheme-object))
+                 scheme-object
+                 (loop (cdr associations)))))))))
+
+(define (protection-list-elements list)
+  (without-interrupts
+   (lambda ()
+     (let loop ((associations (cdr list)))
+       (cond ((null? associations)
+             '())
+            ((weak-car (car associations))
+             => (lambda (scheme-object)
+                  (cons scheme-object
+                        (loop (cdr associations)))))
+            (else
+             (loop (cdr associations))))))))
 \f
 ;;;; Buffered Output
 

diff --git a/v7/src/runtime/os2graph.scm b/v7/src/runtime/os2graph.scm
index dc6c298ed73030c62754edfd602cd84503a9c084..0fe271372d444a447873d74bf1e6caaa196360db 100644 (file)
--- a/v7/src/runtime/os2graph.scm
+++ b/v7/src/runtime/os2graph.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: os2graph.scm,v 1.11 1995/11/04 02:33:56 cph Exp $
+$Id: os2graph.scm,v 1.12 1996/04/24 03:48:24 cph Exp $
 
-Copyright (c) 1995 Massachusetts Institute of Technology
+Copyright (c) 1995-96 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -1184,63 +1184,4 @@ MIT in each case. |#
              (set-struct-size! info size-base)
              (set-n-planes! info n-planes)
              (set-n-bits! info n-bits)
-             info)))))))
-\f
-;;;; Protection lists
-
-(define (make-protection-list)
-  (list 'PROTECTION-LIST))
-
-;; This is used after a disk-restore, to remove invalid information.
-
-(define (drop-all-protected-objects list)
-  (with-absolutely-no-interrupts
-    (lambda ()
-      (set-cdr! list '()))))
-
-(define (add-to-protection-list! list scheme-object microcode-object)
-  (with-absolutely-no-interrupts
-   (lambda ()
-     (set-cdr! list
-              (cons (weak-cons scheme-object microcode-object)
-                    (cdr list))))))
-
-(define (remove-from-protection-list! list scheme-object)
-  (with-absolutely-no-interrupts
-   (lambda ()
-     (let loop ((associations (cdr list)) (previous list))
-       (if (not (null? associations))
-          (if (eq? scheme-object (weak-pair/car? (car associations)))
-              (set-cdr! previous (cdr associations))
-              (loop (cdr associations) associations)))))))
-
-(define (clean-lost-protected-objects list cleaner)
-  (let loop ((associations (cdr list)) (previous list))
-    (if (not (null? associations))
-       (if (weak-pair/car? (car associations))
-           (loop (cdr associations) associations)
-           (begin
-             (cleaner (weak-cdr (car associations)))
-             (let ((next (cdr associations)))
-               (set-cdr! previous next)
-               (loop next previous)))))))
-
-(define (search-protection-list list predicate)
-  (let loop ((associations (cdr list)))
-    (and (not (null? associations))
-        (let ((scheme-object (weak-car (car associations))))
-          (if (and scheme-object (predicate scheme-object))
-              scheme-object
-              (loop (cdr associations)))))))
-
-(define (protection-list-elements list)
-  (with-absolutely-no-interrupts
-   (lambda ()
-     (let loop ((associations (cdr list)))
-       (cond ((null? associations)
-             '())
-            ((weak-pair/car? (car associations))
-             (cons (weak-car (car associations))
-                   (loop (cdr associations))))
-            (else
-             (loop (cdr associations))))))))
\ No newline at end of file
+             info)))))))
\ No newline at end of file

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index a7c177ff11cec0eba1d758b2a64839e98c7d9ee7..eaac1ef3d5bb4befe594279059f5599008aceb9c 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.267 1996/04/24 03:21:08 cph Exp $
+$Id: runtime.pkg,v 14.268 1996/04/24 03:48:50 cph Exp $
 
 Copyright (c) 1988-96 Massachusetts Institute of Technology
 
@@ -1641,6 +1641,7 @@ MIT in each case. |#
   (files "io") 
   (parent ())
   (export ()
+         add-to-protection-list!
          channel-blocking
          channel-blocking?
          channel-close
@@ -1665,18 +1666,22 @@ MIT in each case. |#
          channel-write-char-block
          channel-write-string-block
          channel?
+         clean-lost-protected-objects
          close-all-open-files
          directory-channel-close
          directory-channel-open
          directory-channel-read
          directory-channel-read-matching
          directory-channel?
+         drop-all-protected-objects
          file-open-append-channel
          file-open-input-channel
          file-open-io-channel
          file-open-output-channel
          make-pipe
+         make-protection-list
          open-pty-master
+         protection-list-elements
          pty-master-continue
          pty-master-hangup
          pty-master-interrupt
@@ -1684,6 +1689,8 @@ MIT in each case. |#
          pty-master-quit
          pty-master-send-signal
          pty-master-stop
+         remove-from-protection-list!
+         search-protection-list
          set-terminal-input-baud-rate!
          set-terminal-output-baud-rate!
          terminal-cooked-input

diff --git a/v7/src/runtime/x11graph.scm b/v7/src/runtime/x11graph.scm
index f7f13c46993859b5dd22499810004e05a9cbddfb..000f4e7f5e600620cb93735d1e6d9dee90a225d5 100644 (file)
--- a/v7/src/runtime/x11graph.scm
+++ b/v7/src/runtime/x11graph.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: x11graph.scm,v 1.42 1995/02/21 23:20:11 cph Exp $
+$Id: x11graph.scm,v 1.43 1996/04/24 03:48:01 cph Exp $
 
-Copyright (c) 1989-95 Massachusetts Institute of Technology
+Copyright (c) 1989-96 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -145,65 +145,6 @@ MIT in each case. |#
 ;; This mask contains button-down.
 (define-integrable user-event-mask:default #x0001)
 \f
-;;;; Protection lists
-
-(define (make-protection-list)
-  (list 'PROTECTION-LIST))
-
-;; This is used after a disk-restore, to remove invalid information.
-
-(define (drop-all-protected-objects list)
-  (with-absolutely-no-interrupts
-    (lambda ()
-      (set-cdr! list '()))))
-
-(define (add-to-protection-list! list scheme-object microcode-object)
-  (with-absolutely-no-interrupts
-   (lambda ()
-     (set-cdr! list
-              (cons (weak-cons scheme-object microcode-object)
-                    (cdr list))))))
-
-(define (remove-from-protection-list! list scheme-object)
-  (with-absolutely-no-interrupts
-   (lambda ()
-     (let loop ((associations (cdr list)) (previous list))
-       (if (not (null? associations))
-          (if (eq? scheme-object (weak-pair/car? (car associations)))
-              (set-cdr! previous (cdr associations))
-              (loop (cdr associations) associations)))))))
-
-(define (clean-lost-protected-objects list cleaner)
-  (let loop ((associations (cdr list)) (previous list))
-    (if (not (null? associations))
-       (if (weak-pair/car? (car associations))
-           (loop (cdr associations) associations)
-           (begin
-             (cleaner (weak-cdr (car associations)))
-             (let ((next (cdr associations)))
-               (set-cdr! previous next)
-               (loop next previous)))))))
-
-(define (search-protection-list list predicate)
-  (let loop ((associations (cdr list)))
-    (and (not (null? associations))
-        (let ((scheme-object (weak-car (car associations))))
-          (if (and scheme-object (predicate scheme-object))
-              scheme-object
-              (loop (cdr associations)))))))
-
-(define (protection-list-elements list)
-  (with-absolutely-no-interrupts
-   (lambda ()
-     (let loop ((associations (cdr list)))
-       (cond ((null? associations)
-             '())
-            ((weak-pair/car? (car associations))
-             (cons (weak-car (car associations))
-                   (loop (cdr associations))))
-            (else
-             (loop (cdr associations))))))))
-\f
 ;;;; X graphics device
 
 (define (initialize-package!)

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 4b94a11477a8afb38bbd05db88bf2ae9f3ccd06d..cb12ac7b771721bed52970a3e210982b7504d4a6 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.268 1996/04/24 03:21:18 cph Exp $
+$Id: runtime.pkg,v 14.269 1996/04/24 03:48:09 cph Exp $
 
 Copyright (c) 1988-96 Massachusetts Institute of Technology
 
@@ -1638,6 +1638,7 @@ MIT in each case. |#
   (files "io") 
   (parent ())
   (export ()
+         add-to-protection-list!
          channel-blocking
          channel-blocking?
          channel-close
@@ -1662,18 +1663,22 @@ MIT in each case. |#
          channel-write-char-block
          channel-write-string-block
          channel?
+         clean-lost-protected-objects
          close-all-open-files
          directory-channel-close
          directory-channel-open
          directory-channel-read
          directory-channel-read-matching
          directory-channel?
+         drop-all-protected-objects
          file-open-append-channel
          file-open-input-channel
          file-open-io-channel
          file-open-output-channel
          make-pipe
+         make-protection-list
          open-pty-master
+         protection-list-elements
          pty-master-continue
          pty-master-hangup
          pty-master-interrupt
@@ -1681,6 +1686,8 @@ MIT in each case. |#
          pty-master-quit
          pty-master-send-signal
          pty-master-stop
+         remove-from-protection-list!
+         search-protection-list
          set-terminal-input-baud-rate!
          set-terminal-output-baud-rate!
          terminal-cooked-input