Add new procedure ALLOW-THREAD-EVENT-DELIVERY.
authorChris Hanson <org/chris-hanson/cph>
Tue, 27 Jul 1993 00:46:44 +0000 (00:46 +0000)
committerChris Hanson <org/chris-hanson/cph>
Tue, 27 Jul 1993 00:46:44 +0000 (00:46 +0000)
v7/src/runtime/runtime.pkg
v7/src/runtime/thread.scm
v8/src/runtime/runtime.pkg

index c2f483073ce4d0b8af0d133c8ed705813d66822d..5a601ac6d78bed69d58baf7f2a7c8b8daedd1dbe 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.185 1993/07/18 22:25:37 gjr Exp $
+$Id: runtime.pkg,v 14.186 1993/07/27 00:46:44 cph Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -2454,6 +2454,7 @@ MIT in each case. |#
   (files "thread")
   (parent ())
   (export ()
+         allow-thread-event-delivery
          block-thread-events
          condition-type:thread-dead
          condition-type:thread-deadlock
index e6bcd2f0398f5b8eb67b679fdd5880b0b3b61190..0a5aef6cbaa926415aac9daa6f2371e281ccdfc6 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: thread.scm,v 1.16 1993/07/07 20:01:27 gjr Exp $
+$Id: thread.scm,v 1.17 1993/07/27 00:46:36 cph Exp $
 
 Copyright (c) 1991-1993 Massachusetts Institute of Technology
 
@@ -239,6 +239,17 @@ MIT in each case. |#
        (set-thread/block-events?! thread block-events?)
        event))))
 
+(define (allow-thread-event-delivery)
+  (without-interrupts
+   (lambda ()
+     (let ((thread (current-thread)))
+       (let ((block-events? (thread/block-events? thread)))
+        (set-thread/block-events?! thread #f)
+        (deliver-timer-events)
+        (maybe-signal-input-thread-events)
+        (handle-thread-events thread)
+        (set-thread/block-events?! thread block-events?))))))
+
 (define (stop-current-thread)
   (without-interrupts
    (lambda ()
index c2f483073ce4d0b8af0d133c8ed705813d66822d..5a601ac6d78bed69d58baf7f2a7c8b8daedd1dbe 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.185 1993/07/18 22:25:37 gjr Exp $
+$Id: runtime.pkg,v 14.186 1993/07/27 00:46:44 cph Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -2454,6 +2454,7 @@ MIT in each case. |#
   (files "thread")
   (parent ())
   (export ()
+         allow-thread-event-delivery
          block-thread-events
          condition-type:thread-dead
          condition-type:thread-deadlock