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 2ff08b6368e5873e4611520839e5e2866b656c90..39e99c496ebd96c7d94417a51c1fda0f51b86d68 100644 (file)
--- 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))))
 \f
 ;;;; 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))
 \f
 ;;;; 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)))))))))))))
 \f
 ;;;; 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))
 \f
 ;;;; 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))))))))
 \f
 ;;;; Resizing
 

diff --git a/v7/src/runtime/rbtree.scm b/v7/src/runtime/rbtree.scm
index 7ba0d96fa9b0639eeede29648c9cf9c6e2447300..392588ca3da2817d6570b269630ac57dcd447766 100644 (file)
--- 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))
 \f
 (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)