Pass continuation's BLOCK-THREAD-EVENTS? member through the stack
authorChris Hanson <org/chris-hanson/cph>
Wed, 24 Feb 1999 05:59:23 +0000 (05:59 +0000)
committerChris Hanson <org/chris-hanson/cph>
Wed, 24 Feb 1999 05:59:23 +0000 (05:59 +0000)
parser.  This isn't right, but unless we implement
WITH-THREAD-EVENTS-BLOCKED, there's no way to do better.

v7/src/runtime/conpar.scm
v7/src/runtime/runtime.pkg
v8/src/runtime/conpar.scm
v8/src/runtime/runtime.pkg

index 4ed38a3a8ee4be6ffa5e9a11b72f267edab2b344..ce8f2ac0732c240e58724999233eb58c3cb605a7 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: conpar.scm,v 14.36 1999/01/02 06:06:43 cph Exp $
+$Id: conpar.scm,v 14.37 1999/02/24 05:59:01 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -29,27 +29,29 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 (define-structure (stack-frame
                   (constructor make-stack-frame
                                (type elements dynamic-state
+                                     block-thread-events?
                                      interrupt-mask history
                                      previous-history-offset
                                      previous-history-control-point
                                      offset previous-type %next))
                   (conc-name stack-frame/))
-  (type false read-only true)
-  (elements false read-only true)
-  (dynamic-state false read-only true)
-  (interrupt-mask false read-only true)
-  (history false read-only true)
-  (previous-history-offset false read-only true)
-  (previous-history-control-point false read-only true)
-  (offset false read-only true)
+  (type #f read-only #t)
+  (elements #f read-only #t)
+  (dynamic-state #f read-only #t)
+  (block-thread-events? #f read-only #t)
+  (interrupt-mask #f read-only #t)
+  (history #f read-only #t)
+  (previous-history-offset #f read-only #t)
+  (previous-history-control-point #f read-only #t)
+  (offset #f read-only #t)
   ;; PREVIOUS-TYPE is the stack-frame-type of the frame above this one
   ;; on the stack (closer to the stack's top).  In at least two cases
   ;; we need to know this information.
-  (previous-type false read-only true)
+  (previous-type #f read-only #t)
   ;; %NEXT is either a parser-state object or the next frame.  In the
   ;; former case, the parser-state is used to compute the next frame.
   %next
-  (properties (make-1d-table) read-only true))
+  (properties (make-1d-table) read-only #t))
 
 (define (stack-frame/reductions stack-frame)
   (let ((history (stack-frame/history stack-frame)))
@@ -98,12 +100,12 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
 (define-integrable (stack-frame/compiled-code? stack-frame)
   (compiled-return-address? (stack-frame/return-address stack-frame)))
-
+\f
 (define (stack-frame/subproblem? stack-frame)
   (if (stack-frame/stack-marker? stack-frame)
       (stack-marker-frame/repl-eval-boundary? stack-frame)
       (stack-frame-type/subproblem? (stack-frame/type stack-frame))))
-\f
+
 (define (stack-frame/resolve-stack-address frame address)
   (let loop
       ((frame frame)
@@ -151,34 +153,38 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
 (define-structure (parser-state (constructor make-parser-state)
                                (conc-name parser-state/))
-  (dynamic-state false read-only true)
-  (interrupt-mask false read-only true)
-  (history false read-only true)
-  (previous-history-offset false read-only true)
-  (previous-history-control-point false read-only true)
-  (element-stream false read-only true)
-  (n-elements false read-only true)
-  (next-control-point false read-only true)
-  (previous-type false read-only true))
+  (dynamic-state #f read-only #t)
+  (block-thread-events? #f read-only #t)
+  (interrupt-mask #f read-only #t)
+  (history #f read-only #t)
+  (previous-history-offset #f read-only #t)
+  (previous-history-control-point #f read-only #t)
+  (element-stream #f read-only #t)
+  (n-elements #f read-only #t)
+  (next-control-point #f read-only #t)
+  (previous-type #f read-only #t))
 
 (define (continuation->stack-frame continuation)
   (parse-control-point (continuation/control-point continuation)
                       (continuation/dynamic-state continuation)
-                      false))
+                      (continuation/block-thread-events? continuation)
+                      #f))
 
-(define (parse-control-point control-point dynamic-state type)
+(define (parse-control-point control-point dynamic-state block-thread-events?
+                            type)
   (let ((element-stream (control-point/element-stream control-point)))
     (parse-one-frame
      (make-parser-state
       dynamic-state
+      block-thread-events?
       (control-point/interrupt-mask control-point)
-      (let ((history 
+      (let ((history
             (history-transform (control-point/history control-point))))
        (if (and (stream-pair? element-stream)
                 (eq? return-address/reenter-compiled-code
                      (element-stream/head element-stream)))
            history
-           (history-superproblem history)))                
+           (history-superproblem history)))
       (control-point/previous-history-offset control-point)
       (control-point/previous-history-control-point control-point)
       element-stream
@@ -195,7 +201,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
              (and type
                   (1d-table/get (stack-frame-type/properties type)
                                 allow-extended?-tag
-                                false))))))
+                                #f))))))
       (let ((length
             (let ((length (stack-frame-type/length type)))
               (if (exact-nonnegative-integer? length)
@@ -204,9 +210,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
        ((stack-frame-type/parser type)
         type
         (list->vector (stream-head stream length))
-        (make-intermediate-state state
-                                 length
-                                 (stream-tail stream length))))))
+        (make-intermediate-state state length (stream-tail stream length))))))
 
   (let ((the-stream (parser-state/element-stream state)))
     (if (stream-pair? the-stream)
@@ -216,11 +220,11 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
               (if (not (zero? (parser-state/n-elements state)))
                   ;; Construct invisible join-stacklets frame.
                   (handle-ordinary
-                   (stream return-address/join-stacklets
-                           control-point))
+                   (stream return-address/join-stacklets control-point))
                   (parse-control-point
                    control-point
                    (parser-state/dynamic-state state)
+                   (parser-state/block-thread-events? state)
                    (parser-state/previous-type state))))))))
 \f
 ;;; `make-intermediate-state' is used to construct an intermediate
@@ -232,9 +236,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (let ((previous-history-control-point
         (parser-state/previous-history-control-point state))
        (new-length
-        (- (parser-state/n-elements state) length)))    
+        (- (parser-state/n-elements state) length)))
     (make-parser-state
      (parser-state/dynamic-state state)
+     (parser-state/block-thread-events? state)
      (parser-state/interrupt-mask state)
      (parser-state/history state)
      (let ((previous (parser-state/previous-history-offset state)))
@@ -269,6 +274,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
      type
      elements
      (parser-state/dynamic-state state)
+     (parser-state/block-thread-events? state)
      (parser-state/interrupt-mask state)
      (if history?
         history
@@ -278,6 +284,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
      (+ (vector-length elements) n-elements)
      (parser-state/previous-type state)
      (make-parser-state (parser-state/dynamic-state state)
+                       (parser-state/block-thread-events? state)
                        (parser-state/interrupt-mask state)
                        (if (or force-pop? history-subproblem?)
                            (history-superproblem history)
@@ -288,23 +295,22 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                        n-elements
                        (parser-state/next-control-point state)
                        type))))
-\f
+
 (define (parser/standard type elements state)
   (parse/standard-next type elements state
                       (and (stack-frame-type/history-subproblem? type)
                            (stack-frame-type/subproblem? type))
-                      false))
-
+                      #f))
+\f
 (define (parser/standard-compiled type elements state)
   (parse/standard-next
    type elements state
    (let ((stream (parser-state/element-stream state)))
      (and (stream-pair? stream)
-         (eq? (return-address->stack-frame-type
-               (element-stream/head stream)
-               true)
+         (eq? (return-address->stack-frame-type (element-stream/head stream)
+                                                #t)
               stack-frame-type/return-to-interpreter)))
-   false))
+   #f))
 
 (define (parser/apply type elements state)
   (let ((valid-history?
@@ -312,14 +318,14 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                (and (stream-pair? stream)
                     (eq? return-address/reenter-compiled-code
                          (element-stream/head stream)))))))
-    (parse/standard-next type elements state
-                        valid-history? valid-history?)))
+    (parse/standard-next type elements state valid-history? valid-history?)))
 
 (define (parser/restore-interrupt-mask type elements state)
   (parser/standard
    type
    elements
    (make-parser-state (parser-state/dynamic-state state)
+                     (parser-state/block-thread-events? state)
                      (vector-ref elements 1)
                      (parser-state/history state)
                      (parser-state/previous-history-offset state)
@@ -334,6 +340,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
    type
    elements
    (make-parser-state (parser-state/dynamic-state state)
+                     (parser-state/block-thread-events? state)
                      (parser-state/interrupt-mask state)
                      (history-transform (vector-ref elements 1))
                      (vector-ref elements 2)
@@ -355,7 +362,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 (define (parser/special-compiled type elements state)
   (let ((code (vector-ref elements 1)))
     (cond ((fix:= code code/special-compiled/internal-apply)
-          (parse/standard-next type elements state false false))
+          (parse/standard-next type elements state #f #f))
          ((fix:= code code/special-compiled/restore-interrupt-mask)
           (parser/%stack-marker (parser-state/dynamic-state state)
                                 (vector-ref elements 2)
@@ -367,7 +374,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
               (fix:= code code/restore-regs)
               (fix:= code code/apply-compiled)
               (fix:= code code/continue-linking))
-          (parse/standard-next type elements state false false))
+          (parse/standard-next type elements state #f #f))
          (else
           (error "Unknown special compiled frame" code)))))
 \f
@@ -401,6 +408,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
    elements
    (make-parser-state
     dynamic-state
+    (parser-state/block-thread-events? state)
     interrupt-mask
     (parser-state/history state)
     (parser-state/previous-history-offset state)
@@ -445,13 +453,14 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 (define (stack-frame->continuation stack-frame)
   (make-continuation 'REENTRANT
                     (stack-frame->control-point stack-frame)
-                    (stack-frame/dynamic-state stack-frame)))
+                    (stack-frame/dynamic-state stack-frame)
+                    #f))
 
 (define (stack-frame->control-point stack-frame)
   (with-values (lambda () (unparse/stack-frame stack-frame))
     (lambda (element-stream next-control-point)
       (make-control-point
-       false
+       #f
        0
        (stack-frame/interrupt-mask stack-frame)
        (let ((history (stack-frame/history stack-frame)))
@@ -462,7 +471,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
        (stack-frame/previous-history-control-point stack-frame)
        (if (stack-frame/compiled-code? stack-frame)
           (cons-stream return-address/reenter-compiled-code
-                       (cons-stream false element-stream))
+                       (cons-stream #f element-stream))
           element-stream)
        next-control-point))))
 
@@ -479,7 +488,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                     (values (parser-state/element-stream next)
                             (parser-state/next-control-point next)))
                    (else
-                    (values (stream) false)))))
+                    (values (stream) #f)))))
        (lambda (element-stream next-control-point)
          (values
           (let ((elements (stack-frame/elements stack-frame)))
@@ -529,7 +538,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
           4)
          ((fix:= code code/special-compiled/compiled-code-bkpt)
           ;; Very infrequent!
-          (let ((fsize 
+          (let ((fsize
                  (compiled-code-address/frame-size
                   (element-stream/ref stream 2))))
             (if (not fsize)
@@ -564,7 +573,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 (define (length/interrupt-compiled-procedure stream offset)
   offset                               ; ignored
   (1+ (compiled-procedure-frame-size (element-stream/head stream))))
-
+\f
 (define (compiled-code-address/frame-size cc-address)
   (cond ((not (compiled-code-address? cc-address))
         (error "compiled-code-address/frame-size: Unexpected object"
@@ -578,14 +587,14 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
         (fix:+ (compiled-procedure-frame-size cc-address) 1))
        (else
         (error "compiled-code-address/frame-size: Unexpected object"
-               cc-address))))   
-\f
+               cc-address))))
+
 (define (verify paranoia-index stream offset)
   (or (zero? paranoia-index)
       (stream-null? stream)
       (let* ((type
              (return-address->stack-frame-type (element-stream/head stream)
-                                               false))
+                                               #f))
             (length
              (let ((length (stack-frame-type/length type)))
                (if (exact-nonnegative-integer? length)
@@ -611,7 +620,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (map-reference-trap (lambda () (stream-car stream))))
 
 (define-integrable (element-stream/ref stream index)
-  (map-reference-trap (lambda () (stream-ref stream index))))     
+  (map-reference-trap (lambda () (stream-ref stream index))))
 \f
 ;;;; Stack Frame Types
 
@@ -620,12 +629,12 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                                (code subproblem? history-subproblem?
                                      length parser))
                   (conc-name stack-frame-type/))
-  (code false read-only true)
-  (subproblem? false read-only true)
-  (history-subproblem? false read-only true)
-  (properties (make-1d-table) read-only true)
-  (length false read-only true)
-  (parser false read-only true))
+  (code #f read-only #t)
+  (subproblem? #f read-only #t)
+  (history-subproblem? #f read-only #t)
+  (properties (make-1d-table) read-only #t)
+  (length #f read-only #t)
+  (parser #f read-only #t))
 
 (define allow-extended?-tag "stack-frame-type/allow-extended?")
 
@@ -639,7 +648,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
 (define (return-address->stack-frame-type return-address allow-extended?)
   allow-extended?                      ; ignored
-  (let ((allow-extended? true))
+  (let ((allow-extended? #t))
     (cond ((interpreter-return-address? return-address)
           (let ((code (return-address/code return-address)))
             (let ((type (microcode-return/code->type code)))
@@ -647,20 +656,16 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                   (error "return-code has no type" code))
               type)))
          ((compiled-return-address? return-address)
-          (cond ((compiled-continuation/return-to-interpreter?
-                  return-address)
+          (cond ((compiled-continuation/return-to-interpreter? return-address)
                  stack-frame-type/return-to-interpreter)
-                ((compiled-continuation/reflect-to-interface?
-                  return-address)
+                ((compiled-continuation/reflect-to-interface? return-address)
                  stack-frame-type/special-compiled)
-                (else
-                 stack-frame-type/compiled-return-address)))
+                (else stack-frame-type/compiled-return-address)))
          ((and allow-extended? (compiled-procedure? return-address))
           stack-frame-type/interrupt-compiled-procedure)
          ((and allow-extended? (compiled-expression? return-address))
           stack-frame-type/interrupt-compiled-expression)
-         (else
-          (error "illegal return address" return-address)))))
+         (else (error "illegal return address" return-address)))))
 
 (define (initialize-package!)
   (set! return-address/join-stacklets
@@ -673,32 +678,28 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (set! stack-frame-type/stack-marker
        (microcode-return/name->type 'STACK-MARKER))
   (set! stack-frame-type/compiled-return-address
-       (make-stack-frame-type false true false
+       (make-stack-frame-type #f #t #f
                               length/compiled-return-address
                               parser/standard-compiled))
   (set! stack-frame-type/return-to-interpreter
-       (make-stack-frame-type false false true
-                              1
-                              parser/standard))
+       (make-stack-frame-type #f #f #t 1 parser/standard))
   (set! stack-frame-type/special-compiled
-       (make-stack-frame-type false true false
+       (make-stack-frame-type #f #t #f
                               length/special-compiled
                               parser/special-compiled))
   (set! stack-frame-type/interrupt-compiled-procedure
-       (make-stack-frame-type false true false
+       (make-stack-frame-type #f #t #f
                               length/interrupt-compiled-procedure
                               parser/standard))
   (set! stack-frame-type/interrupt-compiled-expression
-       (make-stack-frame-type false true false
-                              1
-                              parser/standard))
+       (make-stack-frame-type #f #t #f 1 parser/standard))
   (set! word-size
        (let ((initial (system-vector-length (make-bit-string 1 #f))))
          (let loop ((size 2))
            (if (= (system-vector-length (make-bit-string size #f)) initial)
-               (loop (1+ size))
-               (-1+ size)))))
-  (set! continuation-return-address false)
+               (loop (+ size 1))
+               (- size 1)))))
+  (set! continuation-return-address #f)
   unspecific)
 \f
 (define stack-frame-types)
@@ -711,7 +712,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 (define stack-frame-type/interrupt-compiled-expression)
 
 (define (make-stack-frame-types)
-  (let ((types (make-vector (microcode-return/code-limit) false)))
+  (let ((types (make-vector (microcode-return/code-limit) #f)))
 
     (define (stack-frame-type name subproblem?
                              history-subproblem?
@@ -725,8 +726,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
     (define (standard-frame name length #!optional parser)
       (stack-frame-type name
-                       false
-                       false
+                       #f
+                       #f
                        length
                        (if (default-object? parser)
                            parser/standard
@@ -734,15 +735,15 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
     (define (standard-subproblem name length)
       (stack-frame-type name
-                       true
-                       true
+                       #t
+                       #t
                        length
                        parser/standard))
 
     (define (non-history-subproblem name length #!optional parser)
       (stack-frame-type name
-                       true
-                       false
+                       #t
+                       #f
                        length
                        (if (default-object? parser)
                            parser/standard
@@ -791,10 +792,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
     (let ((compiler-frame
           (lambda (name length)
-            (stack-frame-type name false true length parser/standard)))
+            (stack-frame-type name #f #t length parser/standard)))
          (compiler-subproblem
           (lambda (name length)
-            (stack-frame-type name true true length parser/standard))))
+            (stack-frame-type name #t #t length parser/standard))))
 
       (let ((length (length/application-frame 4 0)))
        (compiler-subproblem 'COMPILER-LOOKUP-APPLY-TRAP-RESTART length)
@@ -803,7 +804,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
       (let ((type (compiler-frame 'COMPILER-INTERRUPT-RESTART 3)))
        (1d-table/put! (stack-frame-type/properties type)
                       allow-extended?-tag
-                      true))
+                      #t))
 
       (compiler-frame 'COMPILER-LINK-CACHES-RESTART 8)
       (compiler-frame 'REENTER-COMPILED-CODE 2)
@@ -887,7 +888,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (let ((code (stack-frame/ref frame hardware-trap/code-index)))
     (cond ((pair? code) (cdr code))
          ((string? code) code)
-         (else #f))))  
+         (else #f))))
 
 (define (guarantee-hardware-trap-frame frame)
   (if (not (hardware-trap-frame? frame))
@@ -985,14 +986,14 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
             (write block)
             (let loop ((info (compiled-code-block/debugging-info block)))
               (cond ((null? info)
-                     false)
+                     #f)
                     ((string? info)
                      (begin
                        (write-string " (")
                        (write-string info)
                        (write-string ")")))
                     ((not (pair? info))
-                     false)
+                     #f)
                     ((string? (car info))
                      (loop (car info)))
                     (else
index 289982d085269ea629825cff81fa2a3bedf443cd..6a259464df4a8d918cdc46630c36e2be0b944cf3 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.317 1999/02/24 04:41:22 cph Exp $
+$Id: runtime.pkg,v 14.318 1999/02/24 05:59:18 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -396,6 +396,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (parent ())
   (export ()
          call-with-current-continuation
+         continuation/block-thread-events?
          continuation/control-point
          continuation/dynamic-state
          continuation/type
@@ -426,6 +427,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
          stack-frame-type/properties
          stack-frame-type/subproblem?
          stack-frame-type?
+         stack-frame/block-thread-events?
          stack-frame/compiled-code?
          stack-frame/dynamic-state
          stack-frame/elements
index b5290b8e87676980dbfd3eaed460d0a166491403..fd5c2064008ff4a17c518473d1b8896de6a0ebb0 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: conpar.scm,v 14.39 1999/01/02 06:11:34 cph Exp $
+$Id: conpar.scm,v 14.40 1999/02/24 05:59:09 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -31,27 +31,29 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 (define-structure (stack-frame
                   (constructor make-stack-frame
                                (type elements dynamic-state
+                                     block-thread-events?
                                      interrupt-mask history
                                      previous-history-offset
                                      previous-history-control-point
                                      offset previous-type %next))
                   (conc-name stack-frame/))
-  (type false read-only true)
-  (elements false read-only true)
-  (dynamic-state false read-only true)
-  (interrupt-mask false read-only true)
-  (history false read-only true)
-  (previous-history-offset false read-only true)
-  (previous-history-control-point false read-only true)
-  (offset false read-only true)
+  (type #f read-only #t)
+  (elements #f read-only #t)
+  (dynamic-state #f read-only #t)
+  (block-thread-events? #f read-only #t)
+  (interrupt-mask #f read-only #t)
+  (history #f read-only #t)
+  (previous-history-offset #f read-only #t)
+  (previous-history-control-point #f read-only #t)
+  (offset #f read-only #t)
   ;; PREVIOUS-TYPE is the stack-frame-type of the frame above this one
   ;; on the stack (closer to the stack's top).  In at least two cases
   ;; we need to know this information.
-  (previous-type false read-only true)
+  (previous-type #f read-only #t)
   ;; %NEXT is either a parser-state object or the next frame.  In the
   ;; former case, the parser-state is used to compute the next frame.
   %next
-  (properties (make-1d-table) read-only true))
+  (properties (make-1d-table) read-only #t))
 
 (define (stack-frame/reductions stack-frame)
   (let ((history (stack-frame/history stack-frame)))
@@ -100,7 +102,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
 (define-integrable (stack-frame/compiled-code? stack-frame)
   (compiled-return-address? (stack-frame/real-return-address stack-frame)))
-
+\f
 (define (stack-frame/compiled-interrupt? frame)
   ;; returns the interrupted compiled entry or #F
   (let  ((type  (stack-frame/type frame)))
@@ -117,7 +119,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (if (stack-frame/stack-marker? stack-frame)
       (stack-marker-frame/repl-eval-boundary? stack-frame)
       (stack-frame-type/subproblem? (stack-frame/type stack-frame))))
-\f
+
 (define (stack-frame/resolve-stack-address frame address)
   (let loop
       ((frame frame)
@@ -165,34 +167,38 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
 (define-structure (parser-state (constructor make-parser-state)
                                (conc-name parser-state/))
-  (dynamic-state false read-only true)
-  (interrupt-mask false read-only true)
-  (history false read-only true)
-  (previous-history-offset false read-only true)
-  (previous-history-control-point false read-only true)
-  (element-stream false read-only true)
-  (n-elements false read-only true)
-  (next-control-point false read-only true)
-  (previous-type false read-only true))
+  (dynamic-state #f read-only #t)
+  (block-thread-events? #f read-only #t)
+  (interrupt-mask #f read-only #t)
+  (history #f read-only #t)
+  (previous-history-offset #f read-only #t)
+  (previous-history-control-point #f read-only #t)
+  (element-stream #f read-only #t)
+  (n-elements #f read-only #t)
+  (next-control-point #f read-only #t)
+  (previous-type #f read-only #t))
 
 (define (continuation->stack-frame continuation)
   (parse-control-point (continuation/control-point continuation)
                       (continuation/dynamic-state continuation)
-                      false))
+                      (continuation/block-thread-events? continuation)
+                      #f))
 
-(define (parse-control-point control-point dynamic-state type)
+(define (parse-control-point control-point dynamic-state block-thread-events?
+                            type)
   (let ((element-stream (control-point/element-stream control-point)))
     (parse-one-frame
      (make-parser-state
       dynamic-state
+      block-thread-events?
       (control-point/interrupt-mask control-point)
-      (let ((history 
+      (let ((history
             (history-transform (control-point/history control-point))))
        (if (and (stream-pair? element-stream)
                 (eq? return-address/reenter-compiled-code
                      (element-stream/head element-stream)))
            history
-           (history-superproblem history)))                
+           (history-superproblem history)))
       (control-point/previous-history-offset control-point)
       (control-point/previous-history-control-point control-point)
       element-stream
@@ -229,6 +235,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                   (parse-control-point
                    control-point
                    (parser-state/dynamic-state state)
+                   (parser-state/block-thread-events? state)
                    (parser-state/previous-type state))))))))
 \f
 ;;; `make-intermediate-state' is used to construct an intermediate
@@ -240,9 +247,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (let ((previous-history-control-point
         (parser-state/previous-history-control-point state))
        (new-length
-        (- (parser-state/n-elements state) length)))    
+        (- (parser-state/n-elements state) length)))
     (make-parser-state
      (parser-state/dynamic-state state)
+     (parser-state/block-thread-events? state)
      (parser-state/interrupt-mask state)
      (parser-state/history state)
      (let ((previous (parser-state/previous-history-offset state)))
@@ -277,6 +285,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
      type
      elements
      (parser-state/dynamic-state state)
+     (parser-state/block-thread-events? state)
      (parser-state/interrupt-mask state)
      (if history?
         history
@@ -286,6 +295,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
      (+ (vector-length elements) n-elements)
      (parser-state/previous-type state)
      (make-parser-state (parser-state/dynamic-state state)
+                       (parser-state/block-thread-events? state)
                        (parser-state/interrupt-mask state)
                        (if (or force-pop? history-subproblem?)
                            (history-superproblem history)
@@ -301,7 +311,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (parse/standard-next type elements state
                       (and (stack-frame-type/history-subproblem? type)
                            (stack-frame-type/subproblem? type))
-                      false))
+                      #f))
 
 (define (parser/standard-compiled type elements state)
   (parse/standard-next
@@ -310,7 +320,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
      (and (stream-pair? stream)
          (eq? (identify-stack-frame-type stream)
               stack-frame-type/return-to-interpreter)))
-   false))
+   #f))
 
 (define (parser/apply type elements state)
   (let ((valid-history?
@@ -326,6 +336,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
    type
    elements
    (make-parser-state (parser-state/dynamic-state state)
+                     (parser-state/block-thread-events? state)
                      (vector-ref elements 1)
                      (parser-state/history state)
                      (parser-state/previous-history-offset state)
@@ -340,6 +351,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
    type
    elements
    (make-parser-state (parser-state/dynamic-state state)
+                     (parser-state/block-thread-events? state)
                      (parser-state/interrupt-mask state)
                      (history-transform (vector-ref elements 1))
                      (vector-ref elements 2)
@@ -348,7 +360,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                      (parser-state/n-elements state)
                      (parser-state/next-control-point state)
                      (parser-state/previous-type state))))
-
+\f
 (define-integrable code/special-compiled/internal-apply 0)
 (define-integrable code/special-compiled/restore-interrupt-mask 1)
 (define-integrable code/special-compiled/stack-marker 2)
@@ -362,12 +374,12 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (let ((code (vector-ref elements 1)))
     (if (not (and (fix:fixnum? code) (fix:= code code/restore-regs)))
        (error "Unknown special compiled frame" code))
-    (parse/standard-next type elements state false false)))
+    (parse/standard-next type elements state #f #f)))
 
 (define (parser/special-compiled type elements state)
   (let ((code (vector-ref elements 1)))
     (cond ((fix:= code code/special-compiled/internal-apply)
-          (parse/standard-next type elements state false false))
+          (parse/standard-next type elements state #f #f))
          ((fix:= code code/special-compiled/restore-interrupt-mask)
           (parser/%stack-marker (parser-state/dynamic-state state)
                                 (vector-ref elements 2)
@@ -378,10 +390,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
               (fix:= code code/restore-regs)
               (fix:= code code/apply-compiled)
               (fix:= code code/continue-linking))
-          (parse/standard-next type elements state false false))
+          (parse/standard-next type elements state #f #f))
          (else
           (error "Unknown special compiled frame" code)))))
-
+\f
 (define (parser/interrupt-compiled-procedure type elements state)
   ;; At this point the parsing state and frame elements may be incorrect.
   ;; This happens when some of the procedure's parameters are passed
@@ -422,7 +434,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                 (extra-argument (stream-first element-stream))
                 (return-address (vector-ref elements ret-addr-offset)))
            (let ((elements*
-                  (vector-append 
+                  (vector-append
                    (vector-head elements ret-addr-offset)
                    (vector-tail elements (+ ret-addr-offset 1))
                    (vector extra-argument)))
@@ -433,6 +445,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
               elements*
               (make-parser-state
                (parser-state/dynamic-state state)
+               (parser-state/block-thread-events? state)
                (parser-state/interrupt-mask state)
                (parser-state/history state)
                (parser-state/previous-history-offset state)
@@ -444,7 +457,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
 (define (parser/interrupt-compiled-return-address type elements state)
   (parser/standard type elements state))
-
 \f
 (define (parser/stack-marker type elements state)
   (call-with-values
@@ -476,6 +488,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
    elements
    (make-parser-state
     dynamic-state
+    (parser-state/block-thread-events? state)
     interrupt-mask
     (parser-state/history state)
     (parser-state/previous-history-offset state)
@@ -520,13 +533,14 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 (define (stack-frame->continuation stack-frame)
   (make-continuation 'REENTRANT
                     (stack-frame->control-point stack-frame)
-                    (stack-frame/dynamic-state stack-frame)))
+                    (stack-frame/dynamic-state stack-frame)
+                    #f))
 
 (define (stack-frame->control-point stack-frame)
   (with-values (lambda () (unparse/stack-frame stack-frame))
     (lambda (element-stream next-control-point)
       (make-control-point
-       false
+       #f
        0
        (stack-frame/interrupt-mask stack-frame)
        (let ((history (stack-frame/history stack-frame)))
@@ -537,7 +551,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
        (stack-frame/previous-history-control-point stack-frame)
        (if (stack-frame/compiled-code? stack-frame)
           (cons-stream return-address/reenter-compiled-code
-                       (cons-stream false element-stream))
+                       (cons-stream #f element-stream))
           element-stream)
        next-control-point))))
 
@@ -554,7 +568,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                     (values (parser-state/element-stream next)
                             (parser-state/next-control-point next)))
                    (else
-                    (values (stream) false)))))
+                    (values (stream) #f)))))
        (lambda (element-stream next-control-point)
          (values
           ((stack-frame-type/stream (stack-frame/type stack-frame))
@@ -562,7 +576,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
            element-stream)
           next-control-point)))))
 
-
 (define (subvector->stream* elements start end stream-tail)
   (let loop ((index start))
     (if (< index end)
@@ -619,7 +632,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                (loop (+ guess 1)))))
        (error "length/resyspecial-compiled: Unknown code" code))))
 
-
 (define (length/special-compiled stream offset)
   ;; return address is reflect-to-interface
   offset
@@ -638,7 +650,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
           4)
          ((fix:= code code/special-compiled/compiled-code-bkpt)
           ;; Very infrequent!
-          (let ((fsize 
+          (let ((fsize
                  (compiled-code-address/frame-size
                   (element-stream/ref stream 2))))
             (if (not fsize)
@@ -658,8 +670,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
           (fix:- 10 1))
          (else
           (default)))))
-
-
+\f
 (define (length/interrupt-compiled-common stream extra)
   (let ((homes-saved (object-datum (element-stream/ref stream 2)))
        (regs-saved  (object-datum (element-stream/ref stream 3))))
@@ -673,7 +684,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
     (fix:+ (fix:+ fixed-words extra)
           (fix:+ homes-saved regs-saved))))
 
-
 (define (length/interrupt-compiled-return-address stream offset)
   offset
   (let ((entry (stream-ref stream 4)))
@@ -731,7 +741,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (map-reference-trap (lambda () (stream-car stream))))
 
 (define-integrable (element-stream/ref stream index)
-  (map-reference-trap (lambda () (stream-ref stream index))))     
+  (map-reference-trap (lambda () (stream-ref stream index))))
 \f
 ;;;; Stack Frame Types
 
@@ -740,13 +750,13 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                                (code subproblem? history-subproblem?
                                      length parser stream))
                   (conc-name stack-frame-type/))
-  (code false read-only true)
-  (subproblem? false read-only true)
-  (history-subproblem? false read-only true)
-  (properties (make-1d-table) read-only true)
-  (length false read-only true)
-  (parser false read-only true)
-  (stream false read-only true))
+  (code #f read-only #t)
+  (subproblem? #f read-only #t)
+  (history-subproblem? #f read-only #t)
+  (properties (make-1d-table) read-only #t)
+  (length #f read-only #t)
+  (parser #f read-only #t)
+  (stream #f read-only #t))
 
 (define (microcode-return/code->type code)
   (if (not (< code (vector-length stack-frame-types)))
@@ -790,7 +800,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
             stack-frame-type/compiled-return-address)))
      (else
       (error "illegal return address" return-address stream)))))
-
+\f
 (define (initialize-package!)
   (set! return-address/join-stacklets
        (make-return-address (microcode-return 'JOIN-STACKLETS)))
@@ -802,37 +812,37 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (set! stack-frame-type/stack-marker
        (microcode-return/name->type 'STACK-MARKER))
   (set! stack-frame-type/compiled-return-address
-       (make-stack-frame-type false true false
+       (make-stack-frame-type #f #t #f
                               length/compiled-return-address
                               parser/standard-compiled
                               stream/standard))
   (set! stack-frame-type/return-to-interpreter
-       (make-stack-frame-type false false true
+       (make-stack-frame-type #f #f #t
                               1
                               parser/standard
                               stream/standard))
   (set! stack-frame-type/restore-regs
-       (make-stack-frame-type false true false
+       (make-stack-frame-type #f #t #f
                               length/restore-regs
                               parser/restore-regs
                               stream/standard))
   (set! stack-frame-type/special-compiled
-       (make-stack-frame-type false true false
+       (make-stack-frame-type #f #t #f
                               length/special-compiled
                               parser/special-compiled
                               stream/standard))
   (set! stack-frame-type/interrupt-compiled-procedure
-       (make-stack-frame-type false true false
+       (make-stack-frame-type #f #t #f
                               length/interrupt-compiled-procedure
                               parser/interrupt-compiled-procedure
                               stream/interrupt-compiled))
   (set! stack-frame-type/interrupt-compiled-return-address
-       (make-stack-frame-type false true false
+       (make-stack-frame-type #f #t #f
                               length/interrupt-compiled-return-address
                               parser/interrupt-compiled-return-address
                               stream/interrupt-compiled))
   (set! stack-frame-type/interrupt-compiled-expression
-       (make-stack-frame-type false true false
+       (make-stack-frame-type #f #t #f
                               1
                               parser/standard
                               stream/interrupt-compiled))
@@ -842,7 +852,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
            (if (= (system-vector-length (make-bit-string size #f)) initial)
                (loop (1+ size))
                (-1+ size)))))
-  (set! continuation-return-address false)
+  (set! continuation-return-address #f)
   unspecific)
 \f
 (define stack-frame-types)
@@ -856,9 +866,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 (define stack-frame-type/interrupt-compiled-expression)
 (define stack-frame-type/interrupt-compiled-return-address)
 
-
 (define (make-stack-frame-types)
-  (let ((types (make-vector (microcode-return/code-limit) false)))
+  (let ((types (make-vector (microcode-return/code-limit) #f)))
 
     (define (stack-frame-type name subproblem?
                              history-subproblem?
@@ -872,8 +881,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
     (define (standard-frame name length #!optional parser)
       (stack-frame-type name
-                       false
-                       false
+                       #f
+                       #f
                        length
                        (if (default-object? parser)
                            parser/standard
@@ -882,16 +891,16 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
     (define (standard-subproblem name length)
       (stack-frame-type name
-                       true
-                       true
+                       #t
+                       #t
                        length
                        parser/standard
                        stream/standard))
 
     (define (non-history-subproblem name length #!optional parser)
       (stack-frame-type name
-                       true
-                       false
+                       #t
+                       #f
                        length
                        (if (default-object? parser)
                            parser/standard
@@ -941,10 +950,12 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
     (let ((compiler-frame
           (lambda (name length)
-            (stack-frame-type name false true length parser/standard stream/standard)))
+            (stack-frame-type name #f #t length
+                              parser/standard stream/standard)))
          (compiler-subproblem
           (lambda (name length)
-            (stack-frame-type name true true length parser/standard stream/standard))))
+            (stack-frame-type name #t #t length
+                              parser/standard stream/standard))))
 
       (let ((length (length/application-frame 4 0)))
        (compiler-subproblem 'COMPILER-LOOKUP-APPLY-TRAP-RESTART length)
@@ -1033,7 +1044,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (let ((code (stack-frame/ref frame hardware-trap/code-index)))
     (cond ((pair? code) (cdr code))
          ((string? code) code)
-         (else #f))))  
+         (else #f))))
 
 (define (guarantee-hardware-trap-frame frame)
   (if (not (hardware-trap-frame? frame))
index 7bac3ac02aeefcc3b588ba0abe03f48307cd81bc..4783f2884e990b7f3866ae8b7f42b007e00a8702 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.322 1999/02/24 04:41:10 cph Exp $
+$Id: runtime.pkg,v 14.323 1999/02/24 05:59:23 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -395,6 +395,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (parent ())
   (export ()
          call-with-current-continuation
+         continuation/block-thread-events?
          continuation/control-point
          continuation/dynamic-state
          continuation/type
@@ -425,6 +426,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
          stack-frame-type/properties
          stack-frame-type/subproblem?
          stack-frame-type?
+         stack-frame/block-thread-events?
          stack-frame/compiled-code?
          stack-frame/compiled-interrupt?
          stack-frame/dynamic-state