From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Wed, 5 Aug 1992 21:42:20 +0000 (+0000)
Subject: Add stack checks under control of compiler:generate-stack-checks?
X-Git-Tag: 20090517-FFI~9160
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=9d3b622a85aac879384389e6a5226ac884bd8a8d;p=mit-scheme.git

Add stack checks under control of compiler:generate-stack-checks?
---

diff --git a/v7/src/compiler/machines/vax/lapgen.scm b/v7/src/compiler/machines/vax/lapgen.scm
index 8b54d9d84..6936a73f1 100644
--- a/v7/src/compiler/machines/vax/lapgen.scm
+++ b/v7/src/compiler/machines/vax/lapgen.scm
@@ -1,7 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/lapgen.scm,v 4.12 1992/05/14 03:07:25 jinx Exp $
-$MC68020-Header: lapgen.scm,v 4.39 1991/01/30 22:48:01 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/lapgen.scm,v 4.13 1992/08/05 21:42:20 jinx Exp $
 
 Copyright (c) 1987-1992 Massachusetts Institute of Technology
 
@@ -541,10 +540,11 @@ MIT in each case. |#
 
 ;;; Layout of the Scheme register array.
 
-(define-integrable reg:compiled-memtop (INST-EA (@R 10)))
-(define-integrable reg:environment (INST-EA (@RO B 10 #x000C)))
-(define-integrable reg:temp (INST-EA (@RO B 10 #x0010)))
-(define-integrable reg:lexpr-primitive-arity (INST-EA (@RO B 10 #x001C)))
+(define-integrable reg:compiled-memtop		(INST-EA (@R 10)))
+(define-integrable reg:stack-guard		(INST-EA (@RO B 10 #x0004)))
+(define-integrable reg:environment		(INST-EA (@RO B 10 #x000C)))
+(define-integrable reg:temp			(INST-EA (@RO B 10 #x0010)))
+(define-integrable reg:lexpr-primitive-arity	(INST-EA (@RO B 10 #x001C)))
 
 (let-syntax ((define-codes
 	       (macro (start . names)
diff --git a/v7/src/compiler/machines/vax/rules3.scm b/v7/src/compiler/machines/vax/rules3.scm
index 0fdcf8258..1471281bc 100644
--- a/v7/src/compiler/machines/vax/rules3.scm
+++ b/v7/src/compiler/machines/vax/rules3.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/rules3.scm,v 4.9 1991/10/18 09:55:38 cph Exp $
+$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 $
 
-Copyright (c) 1987-91 Massachusetts Institute of Technology
+Copyright (c) 1987-1992 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -392,9 +392,17 @@ MIT in each case. |#
 ;;; interrupt handler that saves and restores the dynamic link
 ;;; register.
 
-(define-integrable (simple-procedure-header code-word label
-					    ;; entry:compiler-interrupt
-					    code:compiler-interrupt)
+(define (interrupt-check interrupt-label)
+  (LAP (CMP L (R ,regnum:free-pointer) ,reg:compiled-memtop)
+       (B B GEQ (@PCR ,interrupt-label))
+       ,@(if compiler:generate-stack-checks?
+	     (LAP (CMP L (R ,regnum:stack-pointer) ,reg:stack-guard)
+		  (B B LSS (@PCR ,interrupt-label)))
+	     (LAP))))
+
+(define (simple-procedure-header code-word label
+				 ;; entry:compiler-interrupt
+				 code:compiler-interrupt)
   (let ((gc-label (generate-label)))
     (LAP (LABEL ,gc-label)
 	 #|
@@ -402,8 +410,7 @@ MIT in each case. |#
 	 |#
 	 ,@(invoke-interface-jsb code:compiler-interrupt)
 	 ,@(make-external-label code-word label)
-	 (CMP L (R 12) ,reg:compiled-memtop)
-	 (B B GEQ (@PCR ,gc-label)))))
+	 ,@(interrupt-check gc-label))))
 
 (define (dlink-procedure-header code-word label)
   (let ((gc-label (generate-label)))    
@@ -415,8 +422,7 @@ MIT in each case. |#
 	 ,@(invoke-interface-jsb code:compiler-interrupt-dlink)
 	 ;; 'Til here
 	 ,@(make-external-label code-word label)
-	 (CMP L (R 12) ,reg:compiled-memtop)
-	 (B B GEQ (@PCR ,gc-label)))))
+	 ,@(interrupt-check gc-label))))
 
 (define-rule statement
   (CONTINUATION-ENTRY (? internal-label))
@@ -497,8 +503,7 @@ MIT in each case. |#
 				      external-label)
 	       (ADD L (&U ,(make-magic-closure-constant entry)) (@R 14))
 	       (LABEL ,internal-label)
-	       (CMP L (R 12) ,reg:compiled-memtop)
-	       (B B GEQ (@PCR ,gc-label)))))))
+	       ,@(interrupt-check gc-label))))))
 
 (define-rule statement
   (ASSIGN (REGISTER (? target))