From 97e621bf258f1b094e6cb05ea568864532b2a718 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Wed, 30 Sep 1992 21:06:02 +0000 Subject: [PATCH] Turn on COMPILER:GENERATE-STACK-CHECKS? by default. --- v7/src/compiler/base/switch.scm | 4 ++-- v7/src/compiler/machines/bobcat/rules3.scm | 18 +++++++++++------- v7/src/compiler/machines/mips/rules3.scm | 15 +++++++++------ 3 files changed, 22 insertions(+), 15 deletions(-) diff --git a/v7/src/compiler/base/switch.scm b/v7/src/compiler/base/switch.scm index 8bffdfa6c..90e217c1b 100644 --- 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 7e4c53669..d4f45874f 100644 --- 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))))))))) (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 ef15dfd46..d3182036c 100644 --- 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))) -- 2.25.1