Update interrupt-check to avoid generating stack checks when entering

continuations and leaf procedures.

diff --git a/v7/src/compiler/machines/i386/rules3.scm b/v7/src/compiler/machines/i386/rules3.scm
index 0e181448d6ed5155542f24af94517ac6e5118324..6202dcd3c6f3a10602c33712d7d89d626ac588f1 100644 (file)
--- a/v7/src/compiler/machines/i386/rules3.scm
+++ b/v7/src/compiler/machines/i386/rules3.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules3.scm,v 1.23 1992/08/05 21:32:27 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules3.scm,v 1.24 1992/10/15 16:28:14 jinx Exp $
 $MC68020-Header: /scheme/compiler/bobcat/RCS/rules3.scm,v 4.31 1991/05/28 19:14:55 jinx Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
@@ -385,10 +385,14 @@ MIT in each case. |#
 ;;; interrupt handler that saves and restores the dynamic link
 ;;; register.
 
-(define (interrupt-check interrupt-label)
+(define (interrupt-check procedure-label interrupt-label)
+  ;; This always does interrupt checks in line.
   (LAP (CMP W (R ,regnum:free-pointer) ,reg:compiled-memtop)
        (JGE (@PCR ,interrupt-label))
-       ,@(if compiler:generate-stack-checks?
+       ,@(if (let ((object (label->object procedure-label)))
+              (and (rtl-procedure? object)
+                   (not (rtl-procedure/stack-leaf? object))
+                   compiler:generate-stack-checks?))
             (LAP (CMP W (R ,regnum:stack-pointer) ,reg:stack-guard)
                  (JL (@PCR ,interrupt-label)))
             (LAP))))
@@ -398,7 +402,7 @@ MIT in each case. |#
     (LAP (LABEL ,gc-label)
         ,@(invoke-hook/call entry)
         ,@(make-external-label code-word label)
-        ,@(interrupt-check gc-label))))
+        ,@(interrupt-check label gc-label))))
 
 (define-rule statement
   (CONTINUATION-ENTRY (? internal-label))
@@ -421,7 +425,7 @@ MIT in each case. |#
           (LABEL ,gc-label)
           ,@(invoke-interface/call code:compiler-interrupt-ic-procedure)
           ,@(make-external-label expression-code-word internal-label)
-          ,@(interrupt-check gc-label)))))
+          ,@(interrupt-check internal-label gc-label)))))
 
 (define-rule statement
   (OPEN-PROCEDURE-HEADER (? internal-label))
@@ -539,7 +543,7 @@ MIT in each case. |#
               (ADD W (@R ,esp)
                    (&U ,(generate/make-magic-closure-constant entry)))
               (LABEL ,internal-label)
-              ,@(interrupt-check gc-label))))))
+              ,@(interrupt-check internal-label gc-label))))))
 
 (define (generate/make-magic-closure-constant entry)
   (- (make-non-pointer-literal (ucode-type compiled-entry) 0)

diff --git a/v7/src/compiler/machines/vax/rules3.scm b/v7/src/compiler/machines/vax/rules3.scm
index 1471281bc77606b1beaab3c14e9e785201c29c81..f1cf40d91a545866b78e8cd277e4c49a0ad70fd6 100644 (file)
--- a/v7/src/compiler/machines/vax/rules3.scm
+++ b/v7/src/compiler/machines/vax/rules3.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/rules3.scm,v 4.10 1992/08/05 21:40:15 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/rules3.scm,v 4.11 1992/10/15 16:31:54 jinx Exp $
 
 Copyright (c) 1987-1992 Massachusetts Institute of Technology
 
@@ -392,10 +392,14 @@ MIT in each case. |#
 ;;; interrupt handler that saves and restores the dynamic link
 ;;; register.
 
-(define (interrupt-check interrupt-label)
+(define (interrupt-check procedure-label interrupt-label)
+  ;; This always does interrupt/stack checks in line.
   (LAP (CMP L (R ,regnum:free-pointer) ,reg:compiled-memtop)
        (B B GEQ (@PCR ,interrupt-label))
-       ,@(if compiler:generate-stack-checks?
+       ,@(if (let ((object (label->object procedure-label)))
+              (and (rtl-procedure? object)
+                   (not (rtl-procedure/stack-leaf? object))
+                   compiler:generate-stack-checks?))
             (LAP (CMP L (R ,regnum:stack-pointer) ,reg:stack-guard)
                  (B B LSS (@PCR ,interrupt-label)))
             (LAP))))
@@ -410,7 +414,7 @@ MIT in each case. |#
         |#
         ,@(invoke-interface-jsb code:compiler-interrupt)
         ,@(make-external-label code-word label)
-        ,@(interrupt-check gc-label))))
+        ,@(interrupt-check label gc-label))))
 
 (define (dlink-procedure-header code-word label)
   (let ((gc-label (generate-label)))    
@@ -422,7 +426,7 @@ MIT in each case. |#
         ,@(invoke-interface-jsb code:compiler-interrupt-dlink)
         ;; 'Til here
         ,@(make-external-label code-word label)
-        ,@(interrupt-check gc-label))))
+        ,@(interrupt-check label gc-label))))
 
 (define-rule statement
   (CONTINUATION-ENTRY (? internal-label))
@@ -503,7 +507,7 @@ MIT in each case. |#
                                      external-label)
               (ADD L (&U ,(make-magic-closure-constant entry)) (@R 14))
               (LABEL ,internal-label)
-              ,@(interrupt-check gc-label))))))
+              ,@(interrupt-check internal-label gc-label))))))
 
 (define-rule statement
   (ASSIGN (REGISTER (? target))