Kludged out the interrupt checks in continuations from primitive

calls: unlike a continuation from calling arbitrary code, the
primitive can't be the procedure we are in, so if this path is on a
loop, the loop is broken elsewhere (in the procedure or continuation
that calls the primitive.)

diff --git a/v8/src/compiler/midend/rtlgen.scm b/v8/src/compiler/midend/rtlgen.scm
index a40ec7bcfd6df7e24659157f3d0db9368d2c1cb9..5ad17baa1662bfa2fdff678ee0f3f5fa39191dec 100644 (file)
--- a/v8/src/compiler/midend/rtlgen.scm
+++ b/v8/src/compiler/midend/rtlgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rtlgen.scm,v 1.40 1995/09/05 19:04:13 adams Exp $
+$Id: rtlgen.scm,v 1.41 1995/09/08 16:49:08 adams Exp $
 
 Copyright (c) 1994-1995 Massachusetts Institute of Technology
 
@@ -44,6 +44,8 @@ MIT in each case. |#
 (define *rtlgen/fold-tag-predicates?* true)
 (define *rtlgen/fold-simple-value-tests?* #T)
 
+(define *rtlgen/quick&dirty-interrupt-check-map*)
+
 ;; Does not currently work if #F:
 (define *rtlgen/pre-load-stack-frame?* #T)
 
@@ -52,7 +54,8 @@ MIT in each case. |#
   (fluid-let ((*rtlgen/object-queue* (queue/make))
              (*rtlgen/delayed-objects* '())
              (*rtlgen/procedures* '())
-             (*rtlgen/continuations* '()))
+             (*rtlgen/continuations* '())
+             (*rtlgen/quick&dirty-interrupt-check-map* (make-form-map)))
     (call-with-values
        (lambda ()
          (if *procedure-result?*
@@ -219,9 +222,12 @@ MIT in each case. |#
                             (rtlgen/debugging-info dbg-form))
                           (MACHINE-CONSTANT ,frame-size)
                           (MACHINE-CONSTANT 1))
-         (rtlgen/wrap-with-interrupt-check/continuation
-          body
-          `(INTERRUPT-CHECK:CONTINUATION ,label (MACHINE-CONSTANT 2))))))
+         ;; Kludge
+         (if (rtlgen/quick&dirty/forbid-interrupt-check? dbg-form)
+             body
+             (rtlgen/wrap-with-interrupt-check/continuation
+              body
+              `(INTERRUPT-CHECK:CONTINUATION ,label (MACHINE-CONSTANT 2)))))))
 
 (define (rtlgen/wrap-closure label dbg-form body lambda-list saved-size)
   saved-size                           ; only continuations have this
@@ -2558,6 +2564,7 @@ MIT in each case. |#
 \f
 (define (rtlgen/expr/make-return-address state rand)
   state                                        ; ignored
+  (rtlgen/quick&dirty/forbid-interrupt-check! rand)
   (rtlgen/continuation-label->object
    (rtlgen/enqueue-object! rand 'CONTINUATION)))  
 
@@ -4422,7 +4429,9 @@ MIT in each case. |#
               ,@rtlgen/?closure-elts*)))
         
 \f
-(define *rtlgen/omit-internal-interrupt-checks?* #F)
+;; Kludges
+
+(define *rtlgen/omit-internal-interrupt-checks?* #T)
 
 (define (rtlgen/omit-interrupt-check? procedure-name)
   (and *rtlgen/omit-internal-interrupt-checks?*
@@ -4439,6 +4448,14 @@ MIT in each case. |#
       (like? 'cons-)
       (like? 'next-)
       (like? 'receiver-)))
+
+(define (rtlgen/quick&dirty/forbid-interrupt-check! form)
+  (form-map/put! *rtlgen/quick&dirty-interrupt-check-map* form #T))
+
+(define (rtlgen/quick&dirty/forbid-interrupt-check? form)
+  (form-map/get *rtlgen/quick&dirty-interrupt-check-map* form #F))
+
+
 \f
 (define (rtlgen/check-declarations declarations)
   (define (check-declaration declaration)