From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 20 Jan 1990 07:26:22 +0000 (+0000)
Subject: When forcing something into a specific machine register, as is done
X-Git-Tag: 20090517-FFI~11584
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=05c6d096818e0f47489a71db50fc47d94769c9ee;p=mit-scheme.git

When forcing something into a specific machine register, as is done
for interpreter calls, make sure that anything cached in that register
is saved to a temporary first, if it's not needed.
---

diff --git a/v7/src/compiler/back/lapgn2.scm b/v7/src/compiler/back/lapgn2.scm
index f3f0c2d9e..f5109d8c4 100644
--- a/v7/src/compiler/back/lapgn2.scm
+++ b/v7/src/compiler/back/lapgn2.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn2.scm,v 1.14 1990/01/18 22:42:02 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn2.scm,v 1.15 1990/01/20 07:26:22 cph Exp $
 
 Copyright (c) 1987, 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -334,14 +334,17 @@ MIT in each case. |#
 (define (load-machine-register! source-register machine-register)
   ;; Copy the contents of `source-register' to `machine-register'.
   (if (machine-register? source-register)
-      (if (eqv? source-register machine-register)
-	  (LAP)
-	  (register->register-transfer source-register machine-register))
+      (LAP ,@(clear-registers! machine-register)
+	   (if (eqv? source-register machine-register)
+	       (LAP)
+	       (register->register-transfer source-register machine-register)))
       (if (is-alias-for-register? machine-register source-register)
-	  (LAP)
-	  (reference->register-transfer
-	   (standard-register-reference source-register false true)
-	   machine-register))))
+	  (clear-registers! machine-register)
+	  (let ((source-reference
+		 (standard-register-reference source-register false true)))
+	    (LAP ,@(clear-registers! machine-register)
+		 ,@(reference->register-transfer source-reference
+						 machine-register))))))
 
 (define (move-to-alias-register! source type target)
   ;; Performs an assignment from register `source' to register
diff --git a/v7/src/compiler/machines/bobcat/rules4.scm b/v7/src/compiler/machines/bobcat/rules4.scm
index 84c748b26..1e693db5a 100644
--- a/v7/src/compiler/machines/bobcat/rules4.scm
+++ b/v7/src/compiler/machines/bobcat/rules4.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules4.scm,v 4.10 1990/01/18 22:44:15 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules4.scm,v 4.11 1990/01/20 07:26:13 cph Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -49,25 +49,25 @@ MIT in each case. |#
 
 (define (interpreter-call-argument->machine-register! expression register)
   (let ((target (register-reference register)))
-    (let ((result
-	   (case (car expression)
-	     ((REGISTER)
-	      (load-machine-register! (rtl:register-number expression)
-				      register))
-	     ((CONSTANT)
-	      (LAP ,(load-constant (rtl:constant-value expression) target)))
-	     ((CONS-POINTER)
-	      (LAP ,(load-non-pointer (rtl:machine-constant-value
-				       (rtl:cons-pointer-type expression))
-				      (rtl:machine-constant-value
-				       (rtl:cons-pointer-datum expression))
-				      target)))
-	     ((OFFSET)
-	      (LAP (MOV L ,(offset->indirect-reference! expression) ,target)))
-	     (else
-	      (error "Unknown expression type" (car expression))))))
-      (delete-register! register)
-      result)))
+    (case (car expression)
+      ((REGISTER)
+       (load-machine-register! (rtl:register-number expression) register))
+      ((CONSTANT)
+       (LAP ,@(clear-registers! register)
+	    ,(load-constant (rtl:constant-value expression) target)))
+      ((CONS-POINTER)
+       (LAP ,@(clear-registers! register)
+	    ,(load-non-pointer (rtl:machine-constant-value
+				(rtl:cons-pointer-type expression))
+			       (rtl:machine-constant-value
+				(rtl:cons-pointer-datum expression))
+			       target)))
+      ((OFFSET)
+       (let ((source-reference (offset->indirect-reference! expression)))
+	 (LAP ,@(clear-registers! register)
+	      (MOV L ,source-reference ,target))))
+      (else
+       (error "Unknown expression type" (car expression))))))
 
 (define-rule statement
   (INTERPRETER-CALL:ACCESS (? environment) (? name))