Implement WITH-THREAD-EVENTS-BLOCKED and hook it into the continuation

parser.

diff --git a/v7/src/runtime/conpar.scm b/v7/src/runtime/conpar.scm
index ce8f2ac0732c240e58724999233eb58c3cb605a7..bc1252bebfaaea599d5a89c40234982fee7bcd63 100644 (file)
--- a/v7/src/runtime/conpar.scm
+++ b/v7/src/runtime/conpar.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: conpar.scm,v 14.37 1999/02/24 05:59:01 cph Exp $
+$Id: conpar.scm,v 14.38 1999/02/24 21:23:46 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -365,6 +365,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
           (parse/standard-next type elements state #f #f))
          ((fix:= code code/special-compiled/restore-interrupt-mask)
           (parser/%stack-marker (parser-state/dynamic-state state)
+                                (parser-state/block-thread-events? state)
                                 (vector-ref elements 2)
                                 type elements state))
          ((fix:= code code/special-compiled/stack-marker)
@@ -386,37 +387,43 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
            (values (vector-ref elements 2) (vector-ref elements 3))))
     (lambda (marker-type marker-instance)
       (let ((continue
-            (lambda (dynamic-state interrupt-mask)
-              (parser/%stack-marker dynamic-state interrupt-mask
-                                    type elements state))))
+            (lambda (dynamic-state block-thread-events? interrupt-mask)
+              (parser/%stack-marker dynamic-state block-thread-events?
+                                    interrupt-mask type elements state))))
        (cond ((eq? marker-type %translate-to-state-point)
               (continue (merge-dynamic-state
                          (parser-state/dynamic-state state)
                          marker-instance)
+                        (parser-state/block-thread-events? state)
                         (parser-state/interrupt-mask state)))
              ((eq? marker-type set-interrupt-enables!)
               (continue (parser-state/dynamic-state state)
+                        (parser-state/block-thread-events? state)
                         marker-instance))
+             ((eq? marker-type with-thread-events-blocked)
+              (continue (parser-state/dynamic-state state)
+                        marker-instance
+                        (parser-state/interrupt-mask state)))
              (else
               (continue (parser-state/dynamic-state state)
+                        (parser-state/block-thread-events? state)
                         (parser-state/interrupt-mask state))))))))
 
-(define (parser/%stack-marker dynamic-state interrupt-mask
+(define (parser/%stack-marker dynamic-state block-thread-events? interrupt-mask
                              type elements state)
   (parser/standard
    type
    elements
-   (make-parser-state
-    dynamic-state
-    (parser-state/block-thread-events? state)
-    interrupt-mask
-    (parser-state/history state)
-    (parser-state/previous-history-offset state)
-    (parser-state/previous-history-control-point state)
-    (parser-state/element-stream state)
-    (parser-state/n-elements state)
-    (parser-state/next-control-point state)
-    (parser-state/previous-type state))))
+   (make-parser-state dynamic-state
+                     block-thread-events?
+                     interrupt-mask
+                     (parser-state/history state)
+                     (parser-state/previous-history-offset state)
+                     (parser-state/previous-history-control-point state)
+                     (parser-state/element-stream state)
+                     (parser-state/n-elements state)
+                     (parser-state/next-control-point state)
+                     (parser-state/previous-type state))))
 
 (define (stack-frame/stack-marker? stack-frame)
   (or (%stack-frame/stack-marker? stack-frame)

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 6a259464df4a8d918cdc46630c36e2be0b944cf3..13a6a53b84e6e760fb0609e30a77c87e84618e11 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.318 1999/02/24 05:59:18 cph Exp $
+$Id: runtime.pkg,v 14.319 1999/02/24 21:23:58 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -3225,6 +3225,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
          unblock-thread-events
          unlock-thread-mutex
          with-create-thread-continuation
+         with-thread-events-blocked
          with-thread-mutex-locked
          with-thread-timer-stopped
          yield-current-thread)

diff --git a/v7/src/runtime/thread.scm b/v7/src/runtime/thread.scm
index 4c0bc38d001d593039175aa7c01933469b03a8aa..5233e617d13d2d135ac9086b7023715376875ed1 100644 (file)
--- a/v7/src/runtime/thread.scm
+++ b/v7/src/runtime/thread.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: thread.scm,v 1.30 1999/02/24 05:18:12 cph Exp $
+$Id: thread.scm,v 1.31 1999/02/24 21:23:27 cph Exp $
 
 Copyright (c) 1991-1999 Massachusetts Institute of Technology
 
@@ -643,6 +643,30 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
         (handle-thread-events thread)
         (set-thread/block-events?! thread #f))))))
 
+(define (with-thread-events-blocked thunk)
+  (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
+    (let ((thread first-running-thread))
+      (if thread
+         (let ((block-events? (thread/block-events? thread)))
+           (set-thread/block-events?! thread #t)
+           (let ((value
+                  ((ucode-primitive with-stack-marker 3)
+                   (lambda ()
+                     (set-interrupt-enables! interrupt-mask)
+                     (let ((value (thunk)))
+                       (set-interrupt-enables! interrupt-mask/gc-ok)
+                       value))
+                   with-thread-events-blocked
+                   block-events?)))
+             (let ((thread first-running-thread))
+               (if thread
+                   (set-thread/block-events?! thread block-events?)))
+             (set-interrupt-enables! interrupt-mask)
+             value))
+         (begin
+           (set-interrupt-enables! interrupt-mask)
+           (thunk))))))
+
 (define (get-thread-event-block)
   (without-interrupts
    (lambda ()
@@ -657,7 +681,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
      (let ((thread first-running-thread))
        (if thread
           (set-thread/block-events?! thread block?))))))
-
+\f
 (define (signal-thread-event thread event)
   (guarantee-thread thread signal-thread-event)
   (let ((self first-running-thread))
@@ -681,7 +705,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (if (and (not (thread/block-events? thread))
           (eq? 'WAITING (thread/execution-state thread)))
       (%thread-running thread)))
-\f
+
 (define (handle-thread-events thread)
   (let loop ((any-events? #f))
     (let ((event (ring/dequeue (thread/pending-events thread) #t)))

diff --git a/v8/src/runtime/conpar.scm b/v8/src/runtime/conpar.scm
index fd5c2064008ff4a17c518473d1b8896de6a0ebb0..dcdc8024aefe6e5e66e030f5aca70161e48f740f 100644 (file)
--- a/v8/src/runtime/conpar.scm
+++ b/v8/src/runtime/conpar.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: conpar.scm,v 14.40 1999/02/24 05:59:09 cph Exp $
+$Id: conpar.scm,v 14.41 1999/02/24 21:23:31 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -382,6 +382,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
           (parse/standard-next type elements state #f #f))
          ((fix:= code code/special-compiled/restore-interrupt-mask)
           (parser/%stack-marker (parser-state/dynamic-state state)
+                                (parser-state/block-thread-events? state)
                                 (vector-ref elements 2)
                                 type elements state))
          ((fix:= code code/special-compiled/stack-marker)
@@ -466,37 +467,43 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
            (values (vector-ref elements 2) (vector-ref elements 3))))
     (lambda (marker-type marker-instance)
       (let ((continue
-            (lambda (dynamic-state interrupt-mask)
-              (parser/%stack-marker dynamic-state interrupt-mask
-                                    type elements state))))
+            (lambda (dynamic-state block-thread-events? interrupt-mask)
+              (parser/%stack-marker dynamic-state block-thread-events?
+                                    interrupt-mask type elements state))))
        (cond ((eq? marker-type %translate-to-state-point)
               (continue (merge-dynamic-state
                          (parser-state/dynamic-state state)
                          marker-instance)
+                        (parser-state/block-thread-events? state)
                         (parser-state/interrupt-mask state)))
              ((eq? marker-type set-interrupt-enables!)
               (continue (parser-state/dynamic-state state)
+                        (parser-state/block-thread-events? state)
                         marker-instance))
+             ((eq? marker-type with-thread-events-blocked)
+              (continue (parser-state/dynamic-state state)
+                        marker-instance
+                        (parser-state/interrupt-mask state)))
              (else
               (continue (parser-state/dynamic-state state)
+                        (parser-state/block-thread-events? state)
                         (parser-state/interrupt-mask state))))))))
 
-(define (parser/%stack-marker dynamic-state interrupt-mask
+(define (parser/%stack-marker dynamic-state block-thread-events? interrupt-mask
                              type elements state)
   (parser/standard
    type
    elements
-   (make-parser-state
-    dynamic-state
-    (parser-state/block-thread-events? state)
-    interrupt-mask
-    (parser-state/history state)
-    (parser-state/previous-history-offset state)
-    (parser-state/previous-history-control-point state)
-    (parser-state/element-stream state)
-    (parser-state/n-elements state)
-    (parser-state/next-control-point state)
-    (parser-state/previous-type state))))
+   (make-parser-state dynamic-state
+                     block-thread-events?
+                     interrupt-mask
+                     (parser-state/history state)
+                     (parser-state/previous-history-offset state)
+                     (parser-state/previous-history-control-point state)
+                     (parser-state/element-stream state)
+                     (parser-state/n-elements state)
+                     (parser-state/next-control-point state)
+                     (parser-state/previous-type state))))
 
 (define (stack-frame/stack-marker? stack-frame)
   (or (%stack-frame/stack-marker? stack-frame)

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 4783f2884e990b7f3866ae8b7f42b007e00a8702..57751f19da4dc6cbf4ec8afb815df794bc0f3dbc 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.323 1999/02/24 05:59:23 cph Exp $
+$Id: runtime.pkg,v 14.324 1999/02/24 21:23:53 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -3229,6 +3229,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
          unblock-thread-events
          unlock-thread-mutex
          with-create-thread-continuation
+         with-thread-events-blocked
          with-thread-mutex-locked
          with-thread-timer-stopped
          yield-current-thread)