From 2e37a0e3f32008bba7c8c0a3ac17220f48301be4 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 7 Oct 1993 06:03:53 +0000
Subject: [PATCH] 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.
---
v7/src/runtime/hashtb.scm | 306 ++++++++++++++++++--------------------
v7/src/runtime/rbtree.scm | 176 +++++++++-------------
2 files changed, 220 insertions(+), 262 deletions(-)
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)
--
2.25.1