From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 7 Oct 1993 06:03:53 +0000 (+0000)
Subject: Limit interrupt locking to minimum needed for single process.  This
X-Git-Tag: 20090517-FFI~7793
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=2e37a0e3f32008bba7c8c0a3ac17220f48301be4;p=mit-scheme.git

Limit interrupt locking to minimum needed for single process.  This
protects against interrupts occurring during a critical section, but
does not prevent concurrent access to the data structures.
---

diff --git a/v7/src/runtime/hashtb.scm b/v7/src/runtime/hashtb.scm
index 2ff08b636..39e99c496 100644
--- a/v7/src/runtime/hashtb.scm
+++ b/v7/src/runtime/hashtb.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: hashtb.scm,v 1.3 1993/10/07 04:30:34 cph Exp $
+$Id: hashtb.scm,v 1.4 1993/10/07 06:03:53 cph Exp $
 
 Copyright (c) 1990-93 Massachusetts Institute of Technology
 
@@ -107,14 +107,9 @@ MIT in each case. |#
 	(clear-table! table)
 	table))))
 
-(define (guarantee-hash-table object procedure)
+(define-integrable (guarantee-hash-table object procedure)
   (if (not (hash-table? object))
       (error:wrong-type-argument object "hash table" procedure)))
-
-(define (check-arg object default predicate description procedure)
-  (cond ((predicate object) object)
-	((not object) default)
-	(else (error:wrong-type-argument object description procedure))))
 
 ;;;; Parameters
 
@@ -150,19 +145,18 @@ MIT in each case. |#
 			   (< 0 x)
 			   (<= x 1)))
 		    "real number between 0 (exclusive) and 1 (inclusive)"
-		    'SET-HASH-TABLE/REHASH-THRESHOLD!))
-	(interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
-    (set-table-rehash-threshold! table threshold)
-    (let ((size (table-size table)))
-      (let ((shrink-size (compute-shrink-size table size))
-	    (grow-size (compute-grow-size table size)))
-	(set-table-shrink-size! table shrink-size)
-	(set-table-grow-size! table grow-size)
-	(let ((count (table-count table)))
-	  (cond ((< count shrink-size) (shrink-table! table))
-		((> count grow-size) (grow-table! table))))))
-    (set-interrupt-enables! interrupt-mask)
-    unspecific))
+		    'SET-HASH-TABLE/REHASH-THRESHOLD!)))
+    (without-interrupts
+     (lambda ()
+       (set-table-rehash-threshold! table threshold)
+       (let ((size (table-size table)))
+	 (let ((shrink-size (compute-shrink-size table size))
+	       (grow-size (compute-grow-size table size)))
+	   (set-table-shrink-size! table shrink-size)
+	   (set-table-grow-size! table grow-size)
+	   (let ((count (table-count table)))
+	     (cond ((< count shrink-size) (shrink-table! table))
+		   ((> count grow-size) (grow-table! table))))))))))
 
 (define (set-hash-table/rehash-size! table size)
   (guarantee-hash-table table 'SET-HASH-TABLE/REHASH-SIZE!)
@@ -181,39 +175,45 @@ MIT in each case. |#
 (define minimum-size 4)
 (define default-rehash-threshold 1)
 (define default-rehash-size 2.)
+
+(define (check-arg object default predicate description procedure)
+  (cond ((predicate object) object)
+	((not object) default)
+	(else (error:wrong-type-argument object description procedure))))
+
+(define-integrable (without-interrupts thunk)
+  (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
+    (thunk)
+    (set-interrupt-enables! interrupt-mask)
+    unspecific))
 
 ;;;; Accessors
 
 (define (hash-table/get table key default)
   (guarantee-hash-table table 'HASH-TABLE/GET)
-  (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
-    (let ((result
-	   (let ((entries
-		  (let ((buckets (table-buckets table)))
-		    (vector-ref
-		     buckets
-		     ((table-key-hash table) key (vector-length buckets))))))
-	     (if (and key (table-standard-accessors? table))
-		 ;; Optimize standard case: compiler makes this fast.
-		 (let loop ((entries entries))
-		   (cond ((null? entries)
-			  default)
-			 ((eq? (system-pair-car (car entries)) key)
-			  (system-pair-cdr (car entries)))
-			 (else
-			  (loop (cdr entries)))))
-		 (let ((key=? (table-key=? table))
-		       (entry-key (table-entry-key table))
-		       (entry-datum (table-entry-datum table)))
-		   (let loop ((entries entries))
-		     (cond ((null? entries)
-			    default)
-			   ((key=? (entry-key (car entries)) key)
-			    (entry-datum (car entries)))
-			   (else
-			    (loop (cdr entries))))))))))
-      (set-interrupt-enables! interrupt-mask)
-      result)))
+  (let ((entries
+	 (let ((buckets (table-buckets table)))
+	   (vector-ref buckets
+		       ((table-key-hash table) key (vector-length buckets))))))
+    (if (and key (table-standard-accessors? table))
+	;; Optimize standard case: compiler makes this fast.
+	(let loop ((entries entries))
+	  (cond ((null? entries)
+		 default)
+		((eq? (system-pair-car (car entries)) key)
+		 (system-pair-cdr (car entries)))
+		(else
+		 (loop (cdr entries)))))
+	(let ((key=? (table-key=? table))
+	      (entry-key (table-entry-key table))
+	      (entry-datum (table-entry-datum table)))
+	  (let loop ((entries entries))
+	    (cond ((null? entries)
+		   default)
+		  ((key=? (entry-key (car entries)) key)
+		   (entry-datum (car entries)))
+		  (else
+		   (loop (cdr entries)))))))))
 
 (define hash-table/lookup
   (let ((default (list #f)))
@@ -227,45 +227,43 @@ MIT in each case. |#
 
 (define (hash-table/put! table key value)
   (guarantee-hash-table table 'HASH-TABLE/PUT!)
-  (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
-    (let ((buckets (table-buckets table)))
-      (let ((hash ((table-key-hash table) key (vector-length buckets))))
-	(let ((add-bucket!
-	       (lambda ()
-		 (let ((count (fix:+ (table-count table) 1)))
-		   (set-table-count! table count)
-		   (vector-set! buckets
-				hash
-				(cons ((table-make-entry table) key value)
-				      (vector-ref buckets hash)))
-		   (if (> count (table-grow-size table))
-		       (grow-table! table))))))
-	  (if (and key (table-standard-accessors? table))
+  (let ((buckets (table-buckets table)))
+    (let ((hash ((table-key-hash table) key (vector-length buckets))))
+      (let ((add-bucket!
+	     (lambda ()
+	       (without-interrupts
+		(lambda ()
+		  (let ((count (fix:+ (table-count table) 1)))
+		    (set-table-count! table count)
+		    (vector-set! buckets
+				 hash
+				 (cons ((table-make-entry table) key value)
+				       (vector-ref buckets hash)))
+		    (if (> count (table-grow-size table))
+			(grow-table! table))))))))
+	(if (and key (table-standard-accessors? table))
+	    (let loop ((entries (vector-ref buckets hash)))
+	      (cond ((null? entries)
+		     (add-bucket!))
+		    ((eq? (system-pair-car (car entries)) key)
+		     (system-pair-set-cdr! (car entries) value))
+		    (else
+		     (loop (cdr entries)))))
+	    (let ((key=? (table-key=? table))
+		  (entry-key (table-entry-key table))
+		  (set-entry-datum! (table-set-entry-datum! table)))
 	      (let loop ((entries (vector-ref buckets hash)))
 		(cond ((null? entries)
 		       (add-bucket!))
-		      ((eq? (system-pair-car (car entries)) key)
-		       (system-pair-set-cdr! (car entries) value))
+		      ((key=? (entry-key (car entries)) key)
+		       (set-entry-datum! (car entries) value))
 		      (else
-		       (loop (cdr entries)))))
-	      (let ((key=? (table-key=? table))
-		    (entry-key (table-entry-key table))
-		    (set-entry-datum! (table-set-entry-datum! table)))
-		(let loop ((entries (vector-ref buckets hash)))
-		  (cond ((null? entries)
-			 (add-bucket!))
-			((key=? (entry-key (car entries)) key)
-			 (set-entry-datum! (car entries) value))
-			(else
-			 (loop (cdr entries))))))))))
-    (set-interrupt-enables! interrupt-mask)
-    unspecific))
+		       (loop (cdr entries)))))))))))
 
 (define (hash-table/remove! table key)
   (guarantee-hash-table table 'HASH-TABLE/REMOVE!)
   (let ((key=? (table-key=? table))
 	(entry-key (table-entry-key table))
-	(interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok))
 	(decrement-count
 	 (lambda ()
 	   (let ((count (fix:- (table-count table) 1)))
@@ -278,19 +276,19 @@ MIT in each case. |#
 	  (if (not (null? entries))
 	      (let ((next (cdr entries)))
 		(if (key=? (entry-key (car entries)) key)
-		    (begin
-		      (vector-set! buckets hash next)
-		      (decrement-count))
+		    (without-interrupts
+		     (lambda ()
+		       (vector-set! buckets hash next)
+		       (decrement-count)))
 		    (let loop ((previous entries) (entries next))
 		      (if (not (null? entries))
 			  (let ((next (cdr entries)))
 			    (if (key=? (entry-key (car entries)) key)
-				(begin
-				  (set-cdr! previous next)
-				  (decrement-count))
-				(loop entries next)))))))))))
-    (set-interrupt-enables! interrupt-mask)
-    unspecific))
+				(without-interrupts
+				 (lambda ()
+				   (set-cdr! previous next)
+				   (decrement-count)))
+				(loop entries next)))))))))))))
 
 ;;;; Enumerators
 
@@ -307,42 +305,33 @@ MIT in each case. |#
 
 (define (hash-table/entries-list table)
   (guarantee-hash-table table 'HASH-TABLE/ENTRIES-LIST)
-  (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
-    (let ((result
-	   (let ((buckets (table-buckets table)))
-	     (let ((n-buckets (vector-length buckets)))
-	       (let loop ((n 0) (result '()))
-		 (if (fix:< n n-buckets)
-		     (loop (fix:+ n 1) (append (vector-ref buckets n) result))
-		     result))))))
-      (set-interrupt-enables! interrupt-mask)
-      result)))
+  (let ((buckets (table-buckets table)))
+    (let ((n-buckets (vector-length buckets)))
+      (let loop ((n 0) (result '()))
+	(if (fix:< n n-buckets)
+	    (loop (fix:+ n 1) (append (vector-ref buckets n) result))
+	    result)))))
 
 (define (hash-table/entries-vector table)
   (guarantee-hash-table table 'HASH-TABLE/ENTRIES-VECTOR)
-  (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
-    (let ((result (make-vector (table-count table))))
-      (let* ((buckets (table-buckets table))
-	     (n-buckets (vector-length buckets)))
-	(let per-bucket ((n 0) (i 0))
-	  (if (fix:< n n-buckets)
-	      (let per-entry ((entries (vector-ref buckets n)) (i i))
-		(if (null? entries)
-		    (per-bucket (fix:+ n 1) i)
-		    (begin
-		      (vector-set! result i (car entries))
-		      (per-entry (cdr entries) (fix:+ i 1))))))))
-      (set-interrupt-enables! interrupt-mask)
-      result)))
+  (let ((result (make-vector (table-count table))))
+    (let* ((buckets (table-buckets table))
+	   (n-buckets (vector-length buckets)))
+      (let per-bucket ((n 0) (i 0))
+	(if (fix:< n n-buckets)
+	    (let per-entry ((entries (vector-ref buckets n)) (i i))
+	      (if (null? entries)
+		  (per-bucket (fix:+ n 1) i)
+		  (begin
+		    (vector-set! result i (car entries))
+		    (per-entry (cdr entries) (fix:+ i 1))))))))
+    result))
 
 ;;;; Cleansing
 
 (define (hash-table/clear! table)
   (guarantee-hash-table table 'HASH-TABLE/CLEAR!)
-  (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
-    (clear-table! table)
-    (set-interrupt-enables! interrupt-mask)
-    unspecific))
+  (without-interrupts (lambda () (clear-table! table))))
 
 (define (clear-table! table)
   (set-table-count! table 0)
@@ -353,51 +342,50 @@ MIT in each case. |#
   (let ((entry-valid? (table-entry-valid? table)))
     ;; If `entry-valid?' is #t, then entries never become invalid.
     (if (not (eq? entry-valid? #t))
-	(let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
-	  (let ((buckets (table-buckets table))
-		(count (table-count table)))
-	    (let ((n-buckets (vector-length buckets)))
-	      (do ((i 0 (fix:+ i 1)))
-		  ((fix:= i n-buckets))
-		(letrec
-		    ((scan-head
-		      (lambda (entries)
-			(cond ((null? entries)
-			       (vector-set! buckets i entries))
-			      ((entry-valid? (car entries))
-			       (vector-set! buckets i entries)
-			       (scan-tail entries (cdr entries)))
-			      (else
+	(without-interrupts
+	 (lambda ()
+	   (let ((buckets (table-buckets table))
+		 (count (table-count table)))
+	     (let ((n-buckets (vector-length buckets)))
+	       (do ((i 0 (fix:+ i 1)))
+		   ((fix:= i n-buckets))
+		 (letrec
+		     ((scan-head
+		       (lambda (entries)
+			 (cond ((null? entries)
+				(vector-set! buckets i entries))
+			       ((entry-valid? (car entries))
+				(vector-set! buckets i entries)
+				(scan-tail entries (cdr entries)))
+			       (else
+				(set! count (fix:- count 1))
+				(scan-head (cdr entries))))))
+		      (scan-tail
+		       (lambda (previous entries)
+			 (if (not (null? entries))
+			     (if (entry-valid? (car entries))
+				 (scan-tail entries (cdr entries))
+				 (begin
+				   (set! count (fix:- count 1))
+				   (let loop ((entries (cdr entries)))
+				     (cond ((null? entries)
+					    (set-cdr! previous entries))
+					   ((entry-valid? (car entries))
+					    (set-cdr! previous entries)
+					    (scan-tail entries (cdr entries)))
+					   (else
+					    (set! count (fix:- count 1))
+					    (loop (cdr entries)))))))))))
+		   (let ((entries (vector-ref buckets i)))
+		     (if (not (null? entries))
+			 (if (entry-valid? (car entries))
+			     (scan-tail entries (cdr entries))
+			     (begin
 			       (set! count (fix:- count 1))
-			       (scan-head (cdr entries))))))
-		     (scan-tail
-		      (lambda (previous entries)
-			(if (not (null? entries))
-			    (if (entry-valid? (car entries))
-				(scan-tail entries (cdr entries))
-				(begin
-				  (set! count (fix:- count 1))
-				  (let loop ((entries (cdr entries)))
-				    (cond ((null? entries)
-					   (set-cdr! previous entries))
-					  ((entry-valid? (car entries))
-					   (set-cdr! previous entries)
-					   (scan-tail entries (cdr entries)))
-					  (else
-					   (set! count (fix:- count 1))
-					   (loop (cdr entries)))))))))))
-		  (let ((entries (vector-ref buckets i)))
-		    (if (not (null? entries))
-			(if (entry-valid? (car entries))
-			    (scan-tail entries (cdr entries))
-			    (begin
-			      (set! count (fix:- count 1))
-			      (scan-head (cdr entries)))))))))
-	    (set-table-count! table count)
-	    (if (< count (table-shrink-size table))
-		(shrink-table! table)))
-	  (set-interrupt-enables! interrupt-mask)
-	  unspecific))))
+			       (scan-head (cdr entries)))))))))
+	     (set-table-count! table count)
+	     (if (< count (table-shrink-size table))
+		 (shrink-table! table))))))))
 
 ;;;; Resizing
 
diff --git a/v7/src/runtime/rbtree.scm b/v7/src/runtime/rbtree.scm
index 7ba0d96fa..392588ca3 100644
--- a/v7/src/runtime/rbtree.scm
+++ b/v7/src/runtime/rbtree.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rbtree.scm,v 1.2 1993/10/06 21:16:35 cph Exp $
+$Id: rbtree.scm,v 1.3 1993/10/07 06:03:46 cph Exp $
 
 Copyright (c) 1993 Massachusetts Institute of Technology
 
@@ -132,22 +132,21 @@ MIT in each case. |#
 (define (rb-tree/insert! tree key datum)
   (guarantee-rb-tree tree 'RB-TREE/INSERT!)
   (let ((key=? (tree-key=? tree))
-	(key<? (tree-key<? tree))
-	(interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
+	(key<? (tree-key<? tree)))
     (let loop ((x (tree-root tree)) (y #f) (d #f))
       (cond ((not x)
 	     (let ((z (make-node key datum)))
-	       (set-node-up! z y)
-	       (cond ((not y) (set-tree-root! tree z))
-		     ((eq? 'LEFT d) (set-node-left! y z))
-		     (else (set-node-right! y z)))
-	       (set-node-color! z 'RED)
-	       (insert-fixup! tree z)))
+	       (without-interrupts
+		(lambda ()
+		  (set-node-up! z y)
+		  (cond ((not y) (set-tree-root! tree z))
+			((eq? 'LEFT d) (set-node-left! y z))
+			(else (set-node-right! y z)))
+		  (set-node-color! z 'RED)
+		  (insert-fixup! tree z)))))
 	    ((key=? key (node-key x)) (set-node-datum! x datum))
 	    ((key<? key (node-key x)) (loop (node-left x) x 'LEFT))
-	    (else (loop (node-right x) x 'RIGHT))))
-    (set-interrupt-enables! interrupt-mask)
-    unspecific))
+	    (else (loop (node-right x) x 'RIGHT))))))
 
 (define (insert-fixup! tree x)
   ;; Assumptions: X is red, and the only possible violation of the
@@ -185,36 +184,41 @@ MIT in each case. |#
 	((null? alist))
       (rb-tree/insert! tree (caar alist) (cdar alist)))
     tree))
+
+(define-integrable (without-interrupts thunk)
+  (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
+    (thunk)
+    (set-interrupt-enables! interrupt-mask)
+    unspecific))
 
 (define (rb-tree/delete! tree key)
   (guarantee-rb-tree tree 'RB-TREE/DELETE!)
   (let ((key=? (tree-key=? tree))
-	(key<? (tree-key<? tree))
-	(interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
+	(key<? (tree-key<? tree)))
     (let loop ((x (tree-root tree)))
       (cond ((not x) unspecific)
 	    ((key=? key (node-key x)) (delete-node! tree x))
 	    ((key<? key (node-key x)) (loop (node-left x)))
-	    (else (loop (node-right x)))))
-    (set-interrupt-enables! interrupt-mask)
-    unspecific))
+	    (else (loop (node-right x)))))))
 
 (define (delete-node! tree z)
-  (let ((z
-	 (if (and (node-left z) (node-right z))
-	     (let ((y (next-node z)))
-	       (set-node-key! z (node-key y))
-	       (set-node-datum! z (node-datum y))
-	       y)
-	     z)))
-    (let ((x (or (node-left z) (node-right z)))
-	  (u (node-up z)))
-      (if x (set-node-up! x u))
-      (cond ((not u) (set-tree-root! tree x))
-	    ((eq? z (node-left u)) (set-node-left! u x))
-	    (else (set-node-right! u x)))
-      (if (eq? 'BLACK (node-color z))
-	  (delete-fixup! tree x u)))))
+  (without-interrupts
+   (lambda ()
+     (let ((z
+	    (if (and (node-left z) (node-right z))
+		(let ((y (next-node z)))
+		  (set-node-key! z (node-key y))
+		  (set-node-datum! z (node-datum y))
+		  y)
+		z)))
+       (let ((x (or (node-left z) (node-right z)))
+	     (u (node-up z)))
+	 (if x (set-node-up! x u))
+	 (cond ((not u) (set-tree-root! tree x))
+	       ((eq? z (node-left u)) (set-node-left! u x))
+	       (else (set-node-right! u x)))
+	 (if (eq? 'BLACK (node-color z))
+	     (delete-fixup! tree x u)))))))
 
 (define (delete-fixup! tree x u)
   (let loop ((x x) (u u))
@@ -260,21 +264,16 @@ MIT in each case. |#
 (define (rb-tree/lookup tree key default)
   (guarantee-rb-tree tree 'RB-TREE/LOOKUP)
   (let ((key=? (tree-key=? tree))
-	(key<? (tree-key<? tree))
-	(interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
-    (let ((result
-	   (let loop ((x (tree-root tree)))
-	     (cond ((not x) default)
-		   ((key=? key (node-key x)) (node-datum x))
-		   ((key<? key (node-key x)) (loop (node-left x)))
-		   (else (loop (node-right x)))))))
-      (set-interrupt-enables! interrupt-mask)
-      result)))
+	(key<? (tree-key<? tree)))
+    (let loop ((x (tree-root tree)))
+      (cond ((not x) default)
+	    ((key=? key (node-key x)) (node-datum x))
+	    ((key<? key (node-key x)) (loop (node-left x)))
+	    (else (loop (node-right x)))))))
 
 (define (rb-tree/copy tree)
   (guarantee-rb-tree tree 'RB-TREE/COPY)
-  (let ((result (make-rb-tree (tree-key=? tree) (tree-key<? tree)))
-	(interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
+  (let ((result (make-rb-tree (tree-key=? tree) (tree-key<? tree))))
     (set-tree-root!
      result
      (let loop ((node (tree-root tree)) (up #f))
@@ -285,34 +284,21 @@ MIT in each case. |#
 	      (set-node-left! node* (loop (node-left node) node*))
 	      (set-node-right! node* (loop (node-right node) node*))
 	      node*))))
-    (set-interrupt-enables! interrupt-mask)
     result))
 
 (define (rb-tree/height tree)
   (guarantee-rb-tree tree 'RB-TREE/HEIGHT)
-  (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
-    (let ((result
-	   (let loop ((node (tree-root tree)))
-	     (if node
-		 (+ 1
-		    (max (loop (node-left node))
-			 (loop (node-right node))))
-		 0))))
-      (set-interrupt-enables! interrupt-mask)
-      result)))
+  (let loop ((node (tree-root tree)))
+    (if node
+	(+ 1 (max (loop (node-left node)) (loop (node-right node))))
+	0)))
 
 (define (rb-tree/size tree)
   (guarantee-rb-tree tree 'RB-TREE/SIZE)
-  (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
-    (let ((result
-	   (let loop ((node (tree-root tree)))
-	     (if node
-		 (+ 1
-		    (loop (node-left node))
-		    (loop (node-right node)))
-		 0))))
-      (set-interrupt-enables! interrupt-mask)
-      result)))
+  (let loop ((node (tree-root tree)))
+    (if node
+	(+ 1 (loop (node-left node)) (loop (node-right node)))
+	0)))
 
 (define (rb-tree/empty? tree)
   (guarantee-rb-tree tree 'RB-TREE/EMPTY?)
@@ -321,53 +307,37 @@ MIT in each case. |#
 (define (rb-tree/equal? x y datum=?)
   (guarantee-rb-tree x 'RB-TREE/EQUAL?)
   (guarantee-rb-tree y 'RB-TREE/EQUAL?)
-  (let ((key=? (tree-key=? x))
-	(interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
-    (let ((result
-	   (and (eq? key=? (tree-key=? y))
-		(let loop ((nx (first-node x)) (ny (first-node y)))
-		  (if (not nx)
-		      (not ny)
-		      (and ny
-			   (key=? (node-key nx) (node-key ny))
-			   (datum=? (node-datum nx) (node-datum ny))
-			   (loop (next-node nx) (next-node ny))))))))
-      (set-interrupt-enables! interrupt-mask)
-      result)))
+  (let ((key=? (tree-key=? x)))
+    (and (eq? key=? (tree-key=? y))
+	 (let loop ((nx (first-node x)) (ny (first-node y)))
+	   (if (not nx)
+	       (not ny)
+	       (and ny
+		    (key=? (node-key nx) (node-key ny))
+		    (datum=? (node-datum nx) (node-datum ny))
+		    (loop (next-node nx) (next-node ny))))))))
 
 (define (rb-tree->alist tree)
   (guarantee-rb-tree tree 'RB-TREE->ALIST)
-  (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
-    (let ((result
-	   (let loop ((node (first-node tree)))
-	     (if node
-		 (cons (cons (node-key node) (node-datum node))
-		       (loop (next-node node)))
-		 '()))))
-      (set-interrupt-enables! interrupt-mask)
-      result)))
+  (let loop ((node (first-node tree)))
+    (if node
+	(cons (cons (node-key node) (node-datum node))
+	      (loop (next-node node)))
+	'())))
 
 (define (rb-tree/key-list tree)
   (guarantee-rb-tree tree 'RB-TREE/KEY-LIST)
-  (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
-    (let ((result
-	   (let loop ((node (first-node tree)))
-	     (if node
-		 (cons (node-key node) (loop (next-node node)))
-		 '()))))
-      (set-interrupt-enables! interrupt-mask)
-      result)))
+  (let loop ((node (first-node tree)))
+    (if node
+	(cons (node-key node) (loop (next-node node)))
+	'())))
 
 (define (rb-tree/datum-list tree)
   (guarantee-rb-tree tree 'RB-TREE/DATUM-LIST)
-  (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
-    (let ((result
-	   (let loop ((node (first-node tree)))
-	     (if node
-		 (cons (node-datum node) (loop (next-node node)))
-		 '()))))
-      (set-interrupt-enables! interrupt-mask)
-      result)))
+  (let loop ((node (first-node tree)))
+    (if node
+	(cons (node-datum node) (loop (next-node node)))
+	'())))
 
 (define (first-node tree)
   (and (tree-root tree)