smp: without-interrupts: rbtree.scm
authorMatt Birkholz <puck@birchwood-abbey.net>
Tue, 10 Mar 2015 21:43:57 +0000 (14:43 -0700)
committerMatt Birkholz <puck@birchwood-abbey.net>
Tue, 10 Mar 2015 21:43:57 +0000 (14:43 -0700)
README.txt
src/runtime/rbtree.scm

index b87b351f9079ac14d3b2a59d94ff97fc1a2a7f60..0b4bd01fd057c6ff9333c771d77430ff9cb96f40 100644 (file)
@@ -1504,10 +1504,20 @@ The hits with accompanying analysis:
        random-source.
 
   rbtree.scm:131:             (without-interrupts
+       Caller: rb-tree/insert! is exported to ()
   rbtree.scm:180:(define-integrable (without-interrupts thunk)
+       Redundant definition.
   rbtree.scm:181:  (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
+       Caller: without-interrupts
   rbtree.scm:183:    (set-interrupt-enables! interrupt-mask)
+       Caller: without-interrupts
   rbtree.scm:197:  (without-interrupts
+       Caller: delete-node!
+                 rb-tree/delete! is exported to ()
+                 rb-tree/delete-{min,max}{,-datum,-pair}! is exported to ()
+
+       This seems to be about avoid aborts that could break the
+       subtree.  Turned without-interrupts into without-interruption.
 
   rep.scm:141:                (with-interrupt-mask interrupt-mask/all
 
index c10daa52b67b23eb10fa90e0edb77d9533fa5e56..51a7e6593db07e0ca2720396f282b0a24ebde9ed 100644 (file)
@@ -128,7 +128,7 @@ USA.
     (let loop ((x (tree-root tree)) (y #f) (d #f))
       (cond ((not x)
             (let ((z (make-node key datum)))
-              (without-interrupts
+              (without-interruption
                (lambda ()
                  (set-node-up! z y)
                  (cond ((not y) (set-tree-root! tree z))
@@ -176,12 +176,6 @@ USA.
        ((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!)
@@ -194,7 +188,7 @@ USA.
            (else (loop (node-right x)))))))
 
 (define (delete-node! tree z)
-  (without-interrupts
+  (without-interruption
    (lambda ()
      (let ((z
            (if (and (node-left z) (node-right z))