From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Sun, 28 Feb 1993 16:50:14 +0000 (+0000)
Subject: Fix bug in fix-complex-return.  The instr moved could be the one
X-Git-Tag: 20090517-FFI~8442
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=9e4c41f55ddadef3939cd282275600a6edf018e4;p=mit-scheme.git

Fix bug in fix-complex-return.  The instr moved could be the one
storing the return address being loaded in the LDW instruction!
---

diff --git a/v7/src/compiler/machines/spectrum/lapopt.scm b/v7/src/compiler/machines/spectrum/lapopt.scm
index 55700df9a..ebde96c32 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.10 1993/02/18 06:43:01 gjr Exp $
+$Id: lapopt.scm,v 1.11 1993/02/28 16:50:14 gjr Exp $
 
 Copyright (c) 1991-1993 Massachusetts Institute of Technology
 
@@ -207,21 +207,34 @@ MIT in each case. |#
 	    (list-difference (cdr whole) suffix))))
 
 (define (fix-complex-return ret frame junk instr avoid)
-  (let ((ret (list-search-positive
-		 (list ret regnum:first-arg regnum:second-arg
-		       regnum:third-arg regnum:fourth-arg)
-	       (lambda (reg)
-		 (not (memq reg avoid))))))
-    `(,@(reverse junk)
-      (LDW () (OFFSET ,frame 0 ,regnum:stack-pointer) ,ret)
-      ,instr
-      (DEP () ,regnum:quad-bitmask
-	   ,(-1+ scheme-type-width)
-	   ,scheme-type-width
-	   ,ret)
-      (BV () 0 ,ret)
-      (LDO () (OFFSET ,(+ frame 4) 0 ,regnum:stack-pointer)
-	   ,regnum:stack-pointer))))
+  (let ((syll `(OFFSET ,frame 0 ,regnum:stack-pointer)))
+    (if (and (eq? (car instr) 'STW)
+	     (equal? (cadddr instr) syll))
+	;; About to store return address.  Forego store completely
+	(let ((ret (caddr instr)))
+	  `(,@(reverse junk)
+	    (DEP () ,regnum:quad-bitmask
+		 ,(-1+ scheme-type-width)
+		 ,scheme-type-width
+		 ,ret)
+	    (BV () 0 ,ret)
+	    (LDO () (OFFSET ,(+ frame 4) 0 ,regnum:stack-pointer)
+		 ,regnum:stack-pointer)))
+	(let ((ret (list-search-positive
+		       (list ret regnum:first-arg regnum:second-arg
+			     regnum:third-arg regnum:fourth-arg)
+		     (lambda (reg)
+		       (not (memq reg avoid))))))
+	  `(,@(reverse junk)
+	    (LDW () ,syll ,ret)
+	    ,instr
+	    (DEP () ,regnum:quad-bitmask
+		 ,(-1+ scheme-type-width)
+		 ,scheme-type-width
+		 ,ret)
+	    (BV () 0 ,ret)
+	    (LDO () (OFFSET ,(+ frame 4) 0 ,regnum:stack-pointer)
+		 ,regnum:stack-pointer))))))
 
 (define (fix-simple-return ret frame junk)
   `(,@(reverse junk)