From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Thu, 19 Feb 1998 21:29:38 +0000 (+0000)
Subject: There was a subtle problem with the interrupt check determining code.
X-Git-Tag: 20090517-FFI~4843
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c1911417d85a88b1610b1b58ac0b01814379551b;p=mit-scheme.git

There was a subtle problem with the interrupt check determining code.

The old code was lazy about searching the rgraph to determine if entry
points and exit points were leaf-like.  It explored the whole tree
when when it found some entry RTL.  This is a problem in the case of
expressions since expressions have no distinguished entry RTL.  Thus
LAP was generated for some expression bblocks before the search took
place.  This is a problem because the LAP instructions replace the RTL
instructions, and the RTL is needed to determine the interrupt checks.

The whole compiler staged only because type-checking is turned off by
default.  The RINST-INSN field is a (vector-ref 0), which, when
unchecked, fortuitously happened to load the CDR of the LAP, which
then proceeded to gracefully fail the RTL predicates.


The solution is to introduce a PRE-LAPGEN-ANALYSIS procedure to to
machine dependent analysis immediately prior to LAP generation.

The analysis for the i386 back end does the original analysis.
The other back ends do nothing.
---

diff --git a/v7/src/compiler/back/lapgn1.scm b/v7/src/compiler/back/lapgn1.scm
index 4fac026e4..8375d4d4e 100644
--- a/v7/src/compiler/back/lapgn1.scm
+++ b/v7/src/compiler/back/lapgn1.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: lapgn1.scm,v 4.16 1993/12/08 17:43:55 gjr Exp $
+$Id: lapgn1.scm,v 4.17 1998/02/19 21:28:24 adams Exp $
 
-Copyright (c) 1987-1993 Massachusetts Institute of Technology
+Copyright (c) 1987-1998 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -42,6 +42,7 @@ MIT in each case. |#
 (define *insert-rtl?*)
 
 (define (generate-lap rgraphs remote-links process-constants-block)
+  (pre-lapgen-analysis rgraphs)
   (fluid-let ((*insert-rtl?*
 	       (and compiler:generate-lap-files?
 		    compiler:intersperse-rtl-in-lap?)))
diff --git a/v7/src/compiler/machines/C/lapgen.scm b/v7/src/compiler/machines/C/lapgen.scm
index d9ca6eea2..c1ece2dc4 100644
--- a/v7/src/compiler/machines/C/lapgen.scm
+++ b/v7/src/compiler/machines/C/lapgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: lapgen.scm,v 1.10 1993/11/13 06:44:26 gjr Exp $
+$Id: lapgen.scm,v 1.11 1998/02/19 21:28:55 adams Exp $
 
 Copyright (c) 1992-1993 Massachusetts Institute of Technology
 
@@ -613,4 +613,9 @@ MIT in each case. |#
     set! define lookup-apply primitive-error
     quotient remainder modulo
     reflect-to-interface interrupt-continuation-2
-    compiled-code-bkpt compiled-closure-bkpt))
\ No newline at end of file
+    compiled-code-bkpt compiled-closure-bkpt))
+
+
+(define (pre-lapgen-analysis rgraphs)
+  rgraphs
+  unspecific)
\ No newline at end of file
diff --git a/v7/src/compiler/machines/alpha/lapgen.scm b/v7/src/compiler/machines/alpha/lapgen.scm
index df3982fd6..7c6a08ba2 100644
--- a/v7/src/compiler/machines/alpha/lapgen.scm
+++ b/v7/src/compiler/machines/alpha/lapgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: lapgen.scm,v 1.4 1993/02/18 01:28:29 gjr Exp $
+$Id: lapgen.scm,v 1.5 1998/02/19 21:29:32 adams Exp $
 
 Copyright (c) 1992-1993 Digital Equipment Corporation (D.E.C.)
 
@@ -930,3 +930,8 @@ case.
       (LAP ,@clear-regs
 	   ,@load-regs
 	   ,@(clear-map!)))))
+
+
+(define (pre-lapgen-analysis rgraphs)
+  rgraphs
+  unspecific)
\ No newline at end of file
diff --git a/v7/src/compiler/machines/bobcat/lapgen.scm b/v7/src/compiler/machines/bobcat/lapgen.scm
index a7e8f3f5f..a96899fc9 100644
--- a/v7/src/compiler/machines/bobcat/lapgen.scm
+++ b/v7/src/compiler/machines/bobcat/lapgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: lapgen.scm,v 4.49 1993/07/08 01:06:53 gjr Exp $
+$Id: lapgen.scm,v 4.50 1998/02/19 21:29:38 adams Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -1284,4 +1284,9 @@ MIT in each case. |#
 
 (define-integrable (invoke-interface-jsr code)
   (LAP (MOVEQ (& ,code) (D 0))
-       (JSR ,entry:compiler-scheme-to-interface-jsr)))
\ No newline at end of file
+       (JSR ,entry:compiler-scheme-to-interface-jsr)))
+
+
+(define (pre-lapgen-analysis rgraphs)
+  rgraphs
+  unspecific)
\ No newline at end of file
diff --git a/v7/src/compiler/machines/i386/lapgen.scm b/v7/src/compiler/machines/i386/lapgen.scm
index b700e17f5..4504b73be 100644
--- a/v7/src/compiler/machines/i386/lapgen.scm
+++ b/v7/src/compiler/machines/i386/lapgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: lapgen.scm,v 1.25 1998/02/18 07:55:07 adams Exp $
+$Id: lapgen.scm,v 1.26 1998/02/19 21:28:34 adams Exp $
 
 Copyright (c) 1992-1998 Massachusetts Institute of Technology
 
@@ -688,4 +688,11 @@ MIT in each case. |#
 
 (define (lookup-arithmetic-method operator methods)
   (cdr (or (assq operator (cdr methods))
-	   (error "Unknown operator" operator))))
\ No newline at end of file
+	   (error "Unknown operator" operator))))
+
+(define (pre-lapgen-analysis rgraphs)
+  (for-each (lambda (rgraph)
+	      (for-each (lambda (edge)
+			  (determine-interrupt-checks (edge-right-node edge)))
+		(rgraph-entry-edges rgraph)))
+    rgraphs))
diff --git a/v7/src/compiler/machines/i386/rules3.scm b/v7/src/compiler/machines/i386/rules3.scm
index 29c0b89d1..b76a661c1 100644
--- a/v7/src/compiler/machines/i386/rules3.scm
+++ b/v7/src/compiler/machines/i386/rules3.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rules3.scm,v 1.32 1998/02/16 03:55:28 cph Exp $
+$Id: rules3.scm,v 1.33 1998/02/19 21:28:10 adams Exp $
 
 Copyright (c) 1992-1998 Massachusetts Institute of Technology
 
@@ -149,6 +149,7 @@ MIT in each case. |#
   (INVOCATION:CACHE-REFERENCE (? frame-size) (? continuation) (? extension))
   (QUALIFIER (interpreter-call-argument? extension))
   continuation
+  (expect-no-exit-interrupt-checks)
   (let* ((set-extension
 	  (interpreter-call-argument->machine-register! extension ecx))
 	 (set-address
@@ -166,6 +167,7 @@ MIT in each case. |#
   (INVOCATION:LOOKUP (? frame-size) (? continuation) (? environment) (? name))
   (QUALIFIER (interpreter-call-argument? environment))
   continuation
+  (expect-no-entry-interrupt-checks)
   (let* ((set-environment
 	  (interpreter-call-argument->machine-register! environment ecx))
 	 (set-name (object->machine-register! name edx)))
@@ -180,7 +182,6 @@ MIT in each case. |#
   (INVOCATION:PRIMITIVE (? frame-size) (? continuation) (? primitive))
   continuation				; ignored
   ;;
-  ;;(expect-no-exit-interrupt-checks)
   (let-syntax ((invoke
 		#|
 		(macro (code entry)
@@ -239,7 +240,7 @@ MIT in each case. |#
 	     (? continuation)
 	     ,(make-primitive-procedure name true))
 	    frame-size continuation
-	    '(expect-no-exit-interrupt-checks)
+	    (expect-no-exit-interrupt-checks)
 	    (special-primitive-invocation
 	     ,(symbol-append 'CODE:COMPILER- name)))))
 
@@ -251,7 +252,7 @@ MIT in each case. |#
 	     (? continuation)
 	     ,(make-primitive-procedure name true))
 	    frame-size continuation
-	    '(expect-no-exit-interrupt-checks)
+	    (expect-no-exit-interrupt-checks)
 	    (optimized-primitive-invocation
 	     ,(symbol-append 'ENTRY:COMPILER- name))))))
 
@@ -458,6 +459,7 @@ MIT in each case. |#
 
 (define-rule statement
   (IC-PROCEDURE-HEADER (? internal-label))
+  (get-entry-interrupt-checks)		; force search
   (let ((procedure (label->object internal-label)))
     (let ((external-label (rtl-procedure/external-label procedure))
 	  (gc-label (generate-label)))
@@ -498,11 +500,8 @@ MIT in each case. |#
 ;;    HEAP       heap check required here
 ;;    INTERRUPT  check required here to avoid loops without checks.
 ;;
-;; The traversal and decision making is done on the first call and
-;; cached.  It would have been better to have a back-end specific
-;; pre-lapgen pass to do the decision making.  Then the cfg marking
-;; abstraction could have been used, but we can't use it here because
-;; the lapgen control is already using it.
+;; The traversal and decision making is done immediately prior to LAP
+;; generation (from PRE-LAPGEN-ANALYSIS.)
 
 (define (get-entry-interrupt-checks)
   (get-interupt-checks 'ENTRY-INTERRUPT-CHECKS))
@@ -519,14 +518,9 @@ MIT in each case. |#
       (error "No exit interrupt checks expected here" *current-bblock*)))
 
 (define (get-interupt-checks kind)
-  (let retry ((failed? #F))
-    (cond ((cfg-node-get *current-bblock* kind)
-	   => cdr)
-	  (failed?  (error "DETERMINE-INTERRUPT-CHECKS failed" kind) #F)
-	  (else
-	   (determine-interrupt-checks)
-	   (retry #T)))))
-
+  (cond ((cfg-node-get *current-bblock* kind)
+	 => cdr)
+	(else  (error "DETERMINE-INTERRUPT-CHECKS failed" kind))))
 
 ;; This algorithm finds leaf-procedure-like paths in the rtl control
 ;; flow graph.  If a procedure entry point can only reach a return, it
@@ -549,13 +543,13 @@ MIT in each case. |#
 ;; The algorithm has three phases: (1) explore the CFG to find all
 ;; entry and exit points, (2) propagate entry (exit) information so
 ;; that each potential interrupt check point knows what kinds of exits
-;; (entrys) it reaches (is reached from), and (3) decide on the kninds
+;; (entrys) it reaches (is reached from), and (3) decide on the kinds
 ;; of interrupt check that are required at each entry and exit.
 ;;
 ;; [TOFU is just a header node for the list of interrupt checks, to
 ;; distingish () and #F]
 
-(define (determine-interrupt-checks)
+(define (determine-interrupt-checks bblock)
   (let ((entries '())
 	(exits '()))
 
@@ -574,7 +568,10 @@ MIT in each case. |#
 	    (for-each-previous-node bblock explore)
 	    (for-each-subsequent-node bblock explore)
 	    (if (and (snode? bblock)
-		     (not (snode-next bblock)))
+		     (or (not (snode-next bblock))
+			 (let ((last (last-insn bblock)))
+			   (or (rtl:invocation:special-primitive? last)
+			       (rtl:invocation:primitive? last)))))
 		(set! exits (cons bblock exits))))))
 
     (define (for-each-subsequent-node node procedure)
@@ -661,7 +658,7 @@ MIT in each case. |#
 	      (checks! '()))
 	  (checks! '())))
 
-    (explore *current-bblock*)
+    (explore bblock)
 
     (for-each propagate-entry-info entries)
     (for-each propagate-exit-info exits)
diff --git a/v7/src/compiler/machines/mips/lapgen.scm b/v7/src/compiler/machines/mips/lapgen.scm
index 3a5085db2..59feebb4d 100644
--- a/v7/src/compiler/machines/mips/lapgen.scm
+++ b/v7/src/compiler/machines/mips/lapgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: lapgen.scm,v 1.14 1997/03/30 23:33:17 cph Exp $
+$Id: lapgen.scm,v 1.15 1998/02/19 21:29:01 adams Exp $
 
 Copyright (c) 1988-97 Massachusetts Institute of Technology
 
@@ -696,4 +696,9 @@ MIT in each case. |#
       (begin
 	(delete-register! rtl-reg)
 	(flush-register! machine-reg)
-	(add-pseudo-register-alias! rtl-reg machine-reg))))
\ No newline at end of file
+	(add-pseudo-register-alias! rtl-reg machine-reg))))
+
+
+(define (pre-lapgen-analysis rgraphs)
+  rgraphs
+  unspecific)
\ No newline at end of file
diff --git a/v7/src/compiler/machines/sparc/lapgen.scm b/v7/src/compiler/machines/sparc/lapgen.scm
index 891b013c1..55adaff91 100644
--- a/v7/src/compiler/machines/sparc/lapgen.scm
+++ b/v7/src/compiler/machines/sparc/lapgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/sparc/lapgen.scm,v 1.1 1993/06/08 06:11:02 gjr Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/sparc/lapgen.scm,v 1.2 1998/02/19 21:29:18 adams Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -685,4 +685,9 @@ MIT in each case. |#
       (begin
 	(delete-register! rtl-reg)
 	(flush-register! machine-reg)
-	(add-pseudo-register-alias! rtl-reg machine-reg))))
\ No newline at end of file
+	(add-pseudo-register-alias! rtl-reg machine-reg))))
+
+
+(define (pre-lapgen-analysis rgraphs)
+  rgraphs
+  unspecific)
\ No newline at end of file
diff --git a/v7/src/compiler/machines/spectrum/lapgen.scm b/v7/src/compiler/machines/spectrum/lapgen.scm
index da7e70428..cfc5ff706 100644
--- a/v7/src/compiler/machines/spectrum/lapgen.scm
+++ b/v7/src/compiler/machines/spectrum/lapgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: lapgen.scm,v 4.46 1993/12/08 17:48:53 gjr Exp $
+$Id: lapgen.scm,v 4.47 1998/02/19 21:28:43 adams Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -739,4 +739,9 @@ MIT in each case. |#
 		,@(load-reg fourth regnum:fourth-arg))))
       (LAP ,@clear-regs
 	   ,@load-regs
-	   ,@(clear-map!)))))
\ No newline at end of file
+	   ,@(clear-map!)))))
+
+
+(define (pre-lapgen-analysis rgraphs)
+  rgraphs
+  unspecific)
\ No newline at end of file
diff --git a/v7/src/compiler/machines/vax/lapgen.scm b/v7/src/compiler/machines/vax/lapgen.scm
index 01393eb98..9966555b4 100644
--- a/v7/src/compiler/machines/vax/lapgen.scm
+++ b/v7/src/compiler/machines/vax/lapgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/lapgen.scm,v 4.14 1992/08/17 16:36:28 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/lapgen.scm,v 4.15 1998/02/19 21:29:24 adams Exp $
 
 Copyright (c) 1987-1992 Massachusetts Institute of Technology
 
@@ -603,4 +603,9 @@ MIT in each case. |#
 
 (define-integrable (invoke-interface-jsb code)
   (LAP ,@(load-rn code 0)
-       (JSB ,entry:compiler-scheme-to-interface-jsb)))
\ No newline at end of file
+       (JSB ,entry:compiler-scheme-to-interface-jsb)))
+
+
+(define (pre-lapgen-analysis rgraphs)
+  rgraphs
+  unspecific)
\ No newline at end of file