From: Chris Hanson Date: Wed, 24 Apr 1996 03:48:50 +0000 (+0000) Subject: Collect the several implementations of protection lists and merge them X-Git-Tag: 20090517-FFI~5570 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b152f57ec9b7d654cafcdc0f575ad89bc9f74078;p=mit-scheme.git 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 5c40a28d7..31a36d3e7 100644 --- 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)) - + ;;;; 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)))))))) ;;;; Buffered Output diff --git a/v7/src/runtime/os2graph.scm b/v7/src/runtime/os2graph.scm index dc6c298ed..0fe271372 100644 --- 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))))))) - -;;;; 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 a7c177ff1..eaac1ef3d 100644 --- 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 f7f13c469..000f4e7f5 100644 --- 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) -;;;; 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)))))))) - ;;;; X graphics device (define (initialize-package!) diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg index 4b94a1147..cb12ac7b7 100644 --- 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