Turn on COMPILER:GENERATE-STACK-CHECKS? by default.

diff --git a/v7/src/compiler/base/switch.scm b/v7/src/compiler/base/switch.scm
index 8bffdfa6cd383c84863e8dab8c2427971a34493d..90e217c1b6435f4d53ffcfee440961029661114a 100644 (file)
--- a/v7/src/compiler/base/switch.scm
+++ b/v7/src/compiler/base/switch.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/switch.scm,v 4.19 1992/07/29 19:56:52 cph Exp $
+$Id: switch.scm,v 4.20 1992/09/30 21:03:19 cph Exp $
 
 Copyright (c) 1988-92 Massachusetts Institute of Technology
 
@@ -60,7 +60,7 @@ MIT in each case. |#
 (define compiler:intersperse-rtl-in-lap? true)
 (define compiler:generate-range-checks? false)
 (define compiler:generate-type-checks? false)
-(define compiler:generate-stack-checks? false)
+(define compiler:generate-stack-checks? true)
 (define compiler:open-code-flonum-checks? false)
 (define compiler:use-multiclosures? true)
 (define compiler:coalescing-constant-warnings? true)

diff --git a/v7/src/compiler/machines/bobcat/rules3.scm b/v7/src/compiler/machines/bobcat/rules3.scm
index 7e4c53669e9bde8266ea9de62050e9813085c54a..d4f45874fcc68d725dd7a34c82f443de8a16086b 100644 (file)
--- a/v7/src/compiler/machines/bobcat/rules3.scm
+++ b/v7/src/compiler/machines/bobcat/rules3.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rules3.scm,v 4.35 1992/09/28 16:38:50 cph Exp $
+$Id: rules3.scm,v 4.36 1992/09/30 21:06:02 cph Exp $
 
 Copyright (c) 1988-92 Massachusetts Institute of Technology
 
@@ -400,10 +400,13 @@ MIT in each case. |#
     (LAP (LABEL ,gc-label)
         (JSR ,entry)
         ,@(make-external-label code-word label)
-        ,@(interrupt-check gc-label -12))))
+        ,@(interrupt-check label gc-label -12))))
 
-(define (interrupt-check gc-label gc-label-offset)
-  (case compiler:generate-stack-checks?
+(define (interrupt-check label gc-label gc-label-offset)
+  (case (let ((object (label->object label)))
+         (and (rtl-procedure? object)
+              (not (rtl-procedure/stack-leaf? object))
+              compiler:generate-stack-checks?))
     ((#F)
      (LAP (CMP L ,reg:compiled-memtop (A 5))
          (B GE B (@PCR ,gc-label))))
@@ -444,7 +447,7 @@ MIT in each case. |#
           (LABEL ,gc-label)
           ,@(invoke-interface-jsr code:compiler-interrupt-ic-procedure)
           ,@(make-external-label expression-code-word internal-label)
-          ,@(interrupt-check gc-label -14)))))
+          ,@(interrupt-check internal-label gc-label -14)))))
 
 (define-rule statement
   (OPEN-PROCEDURE-HEADER (? internal-label))
@@ -533,7 +536,8 @@ long-word aligned and there is no need for shuffling.
                   (ADD UL (& ,(MC68020/make-magic-closure-constant entry))
                        (@A 7))
                   (LABEL ,internal-label)
-                  ,@(interrupt-check gc-label
+                  ,@(interrupt-check internal-label
+                                     gc-label
                                      (- -18 adjustment-size)))))))))
 \f
 (define (MC68020/cons-closure target procedure-label min max size)
@@ -615,7 +619,7 @@ long-word aligned and there is no need for shuffling.
                                      external-label)
               (ADD UL (& ,(MC68040/make-magic-closure-constant entry)) (@A 7))
               (LABEL ,internal-label)
-              ,@(interrupt-check gc-label -18))))))
+              ,@(interrupt-check internal-label gc-label -18))))))
 
 (define (MC68040/cons-closure target procedure-label min max size)
   (MC68040/with-allocated-closure target 1 size

diff --git a/v7/src/compiler/machines/mips/rules3.scm b/v7/src/compiler/machines/mips/rules3.scm
index ef15dfd46e232decce8a091932e880c8a041fe5a..d3182036c6683d846f07e37835c6b7cec7a5b9c6 100644 (file)
--- a/v7/src/compiler/machines/mips/rules3.scm
+++ b/v7/src/compiler/machines/mips/rules3.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rules3.scm,v 1.13 1992/09/26 15:49:20 cph Exp $
+$Id: rules3.scm,v 1.14 1992/09/30 21:05:57 cph Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -416,7 +416,7 @@ MIT in each case. |#
     (LAP (LABEL ,gc-label)
         ,@(link-to-interface code)
         ,@(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)))    
@@ -424,10 +424,13 @@ MIT in each case. |#
         (ADD ,regnum:third-arg 0 ,regnum:dynamic-link)
         ,@(link-to-interface code:compiler-interrupt-dlink)
         ,@(make-external-label code-word label)
-        ,@(interrupt-check gc-label))))
+        ,@(interrupt-check label gc-label))))
 
-(define (interrupt-check gc-label)
-  (if (not compiler:generate-stack-checks?)
+(define (interrupt-check label gc-label)
+  (if (not (let ((object (label->object label)))
+            (and (rtl-procedure? object)
+                 (not (rtl-procedure/stack-leaf? object))
+                 compiler:generate-stack-checks?)))
       (LAP (SLT ,regnum:assembler-temp ,regnum:memtop ,regnum:free)
           (BNE ,regnum:assembler-temp 0 (@PCR ,gc-label))
           (LW ,regnum:memtop ,reg:memtop))
@@ -508,7 +511,7 @@ MIT in each case. |#
           (ADDI ,regnum:stack-pointer ,regnum:stack-pointer -4)
           (SW ,regnum:linkage (OFFSET 0 ,regnum:stack-pointer))
           (LABEL ,internal-label)
-          ,@(interrupt-check gc-label)))))
+          ,@(interrupt-check internal-label gc-label)))))
 
 (define (build-gc-offset-word offset code-word)
   (let ((encoded-offset (quotient offset 2)))