From: Chris Hanson Date: Wed, 29 Jul 1992 22:10:37 +0000 (+0000) Subject: Add optional stack-overflow checks. By default this is disabled. X-Git-Tag: 20090517-FFI~9176 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=866540df7d8ec5d0751a1646df7290ee21efcd67;p=mit-scheme.git Add optional stack-overflow checks. By default this is disabled. --- diff --git a/v7/src/compiler/machines/bobcat/compiler.pkg b/v7/src/compiler/machines/bobcat/compiler.pkg index ae1244193..256620419 100644 --- a/v7/src/compiler/machines/bobcat/compiler.pkg +++ b/v7/src/compiler/machines/bobcat/compiler.pkg @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/compiler.pkg,v 1.36 1992/05/26 20:22:37 mhwu Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/compiler.pkg,v 1.37 1992/07/29 22:04:11 cph Exp $ -Copyright (c) 1988-1992 Massachusetts Institute of Technology +Copyright (c) 1988-92 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -87,6 +87,7 @@ MIT in each case. |# compiler:generate-lap-files? compiler:generate-range-checks? compiler:generate-rtl-files? + compiler:generate-stack-checks? compiler:generate-type-checks? compiler:implicit-self-static? compiler:intersperse-rtl-in-lap? diff --git a/v7/src/compiler/machines/bobcat/lapgen.scm b/v7/src/compiler/machines/bobcat/lapgen.scm index cdb1ae81f..ff15d54f5 100644 --- a/v7/src/compiler/machines/bobcat/lapgen.scm +++ b/v7/src/compiler/machines/bobcat/lapgen.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/lapgen.scm,v 4.44 1992/07/05 14:20:16 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/lapgen.scm,v 4.45 1992/07/29 22:04:20 cph Exp $ -Copyright (c) 1988-1992 Massachusetts Institute of Technology +Copyright (c) 1988-92 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -1061,6 +1061,7 @@ MIT in each case. |# (define-integrable reg:lexpr-primitive-arity (INST-EA (@AO 6 #x001C))) (define-integrable reg:closure-free (INST-EA (@AO 6 #x0024))) (define-integrable reg:closure-space (INST-EA (@AO 6 #X0028))) +(define-integrable reg:stack-guard (INST-EA (@AO 6 #X002C))) (let-syntax ((define-codes (macro (start . names) diff --git a/v7/src/compiler/machines/bobcat/rules3.scm b/v7/src/compiler/machines/bobcat/rules3.scm index 43b83f48a..e244d4222 100644 --- a/v7/src/compiler/machines/bobcat/rules3.scm +++ b/v7/src/compiler/machines/bobcat/rules3.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules3.scm,v 4.32 1992/07/05 14:20:51 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules3.scm,v 4.33 1992/07/29 22:04:02 cph Exp $ -Copyright (c) 1988-1992 Massachusetts Institute of Technology +Copyright (c) 1988-92 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -400,8 +400,15 @@ MIT in each case. |# (LAP (LABEL ,gc-label) (JSR ,entry) ,@(make-external-label code-word label) - (CMP L ,reg:compiled-memtop (A 5)) - (B GE B (@PCR ,gc-label))))) + ,@(interrupt-check gc-label)))) + +(define (interrupt-check gc-label) + (LAP (CMP L ,reg:compiled-memtop (A 5)) + (B GE B (@PCR ,gc-label)) + ,@(if compiler:generate-stack-checks? + (LAP (CMP L ,reg:stack-guard (A 7)) + (B LE B (@PCR ,gc-label))) + (LAP)))) (define-rule statement (CONTINUATION-ENTRY (? internal-label)) @@ -424,8 +431,7 @@ MIT in each case. |# (LABEL ,gc-label) ,@(invoke-interface-jsr code:compiler-interrupt-ic-procedure) ,@(make-external-label expression-code-word internal-label) - (CMP L ,reg:compiled-memtop (A 5)) - (B GE B (@PCR ,gc-label)))))) + ,@(interrupt-check gc-label))))) (define-rule statement (OPEN-PROCEDURE-HEADER (? internal-label)) @@ -506,8 +512,7 @@ long-word aligned and there is no need for shuffling. external-label) (ADD UL (& ,(MC68020/make-magic-closure-constant entry)) (@A 7)) (LABEL ,internal-label) - (CMP L ,reg:compiled-memtop (A 5)) - (B GE B (@PCR ,gc-label))))))) + ,@(interrupt-check gc-label)))))) (define (MC68020/cons-closure target procedure-label min max size) (let* ((target (reference-target-alias! target 'ADDRESS)) @@ -588,8 +593,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) - (CMP L ,reg:compiled-memtop (A 5)) - (B GE B (@PCR ,gc-label))))))) + ,@(interrupt-check gc-label)))))) (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/compiler.pkg b/v7/src/compiler/machines/mips/compiler.pkg index a081a0dd5..efa4ae64b 100644 --- a/v7/src/compiler/machines/mips/compiler.pkg +++ b/v7/src/compiler/machines/mips/compiler.pkg @@ -1,9 +1,9 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/compiler.pkg,v 1.6 1992/05/26 20:23:11 mhwu Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/compiler.pkg,v 1.7 1992/07/29 22:04:55 cph Exp $ $MC68020-Header: /scheme/compiler/bobcat/RCS/comp.pkg,v 1.32 1991/05/06 23:09:24 jinx Exp $ -Copyright (c) 1988-1992 Massachusetts Institute of Technology +Copyright (c) 1988-92 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -88,6 +88,7 @@ MIT in each case. |# compiler:generate-lap-files? compiler:generate-range-checks? compiler:generate-rtl-files? + compiler:generate-stack-checks? compiler:generate-type-checks? compiler:implicit-self-static? compiler:intersperse-rtl-in-lap? diff --git a/v7/src/compiler/machines/mips/lapgen.scm b/v7/src/compiler/machines/mips/lapgen.scm index 38d9e0a89..a55a7da56 100644 --- a/v7/src/compiler/machines/mips/lapgen.scm +++ b/v7/src/compiler/machines/mips/lapgen.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/lapgen.scm,v 1.9 1992/05/14 03:07:51 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/lapgen.scm,v 1.10 1992/07/29 22:05:50 cph Exp $ -Copyright (c) 1988-1992 Massachusetts Institute of Technology +Copyright (c) 1988-92 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -558,6 +558,9 @@ MIT in each case. |# (define-integrable reg:lexpr-primitive-arity (INST-EA (OFFSET #x001C ,regnum:regs-pointer))) +(define-integrable reg:stack-guard + (INST-EA (OFFSET #x002C ,regnum:regs-pointer))) + (define (lap:make-label-statement label) (LAP (LABEL ,label))) diff --git a/v7/src/compiler/machines/mips/rules3.scm b/v7/src/compiler/machines/mips/rules3.scm index e0d421c04..366d8c085 100644 --- a/v7/src/compiler/machines/mips/rules3.scm +++ b/v7/src/compiler/machines/mips/rules3.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/rules3.scm,v 1.10 1991/10/25 00:13:29 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/rules3.scm,v 1.11 1992/07/29 22:10:37 cph Exp $ -Copyright (c) 1988-91 Massachusetts Institute of Technology +Copyright (c) 1988-92 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -428,7 +428,16 @@ MIT in each case. |# (define (interrupt-check gc-label) (LAP (SLT ,regnum:assembler-temp ,regnum:memtop ,regnum:free) (BNE ,regnum:assembler-temp 0 (@PCR ,gc-label)) - (LW ,regnum:memtop ,reg:memtop))) + (LW ,regnum:memtop ,reg:memtop) + ,@(if compiler:generate-stack-checks? + (LAP (LW ,regnum:assembler-temp ,reg:stack-guard) + (NOP) + (SLT ,regnum:assembler-temp + ,regnum:stack-pointer + ,regnum:assembler-temp) + (BNE ,regnum:assembler-temp 0 (@PCR ,gc-label)) + (NOP)) + (LAP)))) (define-rule statement (CONTINUATION-ENTRY (? internal-label))