From: Chris Hanson Date: Wed, 24 Feb 1999 21:23:58 +0000 (+0000) Subject: Implement WITH-THREAD-EVENTS-BLOCKED and hook it into the continuation X-Git-Tag: 20090517-FFI~4603 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=13ebf91fef4d3dc5c5552c8722d480891d17d9b1;p=mit-scheme.git 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 ce8f2ac07..bc1252beb 100644 --- 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 6a259464d..13a6a53b8 100644 --- 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 4c0bc38d0..5233e617d 100644 --- 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?)))))) - + (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))) - + (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 fd5c20640..dcdc8024a 100644 --- 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 4783f2884..57751f19d 100644 --- 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)