From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Mon, 15 Feb 1993 04:57:13 +0000 (+0000)
Subject: Do not move instructions that mention *PC*.
X-Git-Tag: 20090517-FFI~8512
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=dc32b90f87c30e75f8d70898fc85ad5c9b759538;p=mit-scheme.git

Do not move instructions that mention *PC*.
---

diff --git a/v7/src/compiler/machines/spectrum/lapopt.scm b/v7/src/compiler/machines/spectrum/lapopt.scm
index d5fe50a3c..5fa13f6b4 100644
--- a/v7/src/compiler/machines/spectrum/lapopt.scm
+++ b/v7/src/compiler/machines/spectrum/lapopt.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: lapopt.scm,v 1.7 1993/02/15 04:01:11 gjr Exp $
+$Id: lapopt.scm,v 1.8 1993/02/15 04:57:13 gjr Exp $
 
 Copyright (c) 1991-1993 Massachusetts Institute of Technology
 
@@ -171,6 +171,12 @@ MIT in each case. |#
     (and (match-internal pattern instance)
 	 dict)))
 
+(define (pc-sensitive? instr)
+  (or (eq? instr '*PC*)
+      (and (pair? instr)
+	   (or (pc-sensitive? (car instr))
+	       (pc-sensitive? (cdr instr))))))
+
 (define (skips? instr)
   ;; Not really true, for example
   ;; (COMBT (<) ...)
@@ -242,13 +248,15 @@ MIT in each case. |#
 	   (frame (cdr (assq 'frame dict2)))
 	   (ret (cdr (assq 'ret dict1))))
       (cond ((or (not next)
+		 (pc-sensitive? (car next))
+		 (memq (caar next)
+		       '(ENTRY-POINT EXTERNAL-LABEL BLOCK-OFFSET))
 		 (and (eq? (caar next) 'LABEL)
 		      (or (not next*)
 			  (not (skips? (car next*))))))
 	     (values (fix-simple-return ret frame junk)
 		     rest))
-	    ((or (memq (caar next)
-		       '(LABEL ENTRY-POINT EXTERNAL-LABEL BLOCK-OFFSET))
+	    ((or (eq? (caar next) 'LABEL)
 		 (skips? (car next)))
 	     (values '() false))
 	    (else
@@ -302,10 +310,12 @@ MIT in each case. |#
 	   (let* ((next (find-or-label (cdr instrs)))
 		  (next* (and next (find-non-label (cdr next)))))
 	     (if (and next
-		      (memq (instruction-type (car next)) '(ALU MEMORY))
-		      (not (skips? (car next)))
-		      (or (not next*)
-			  (not (skips? (car next*)))))
+		      (let ((instr (car next)))
+			(memq (instruction-type instr) '(ALU MEMORY))
+			(not (skips? instr))
+			(not (pc-sensitive? instr))
+			(or (not next*)
+			    (not (skips? (car next*))))))
 		 (fix-sequences (cdr next)
 				`(,@(reverse
 				     (list-difference (cdr instrs) next))