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 f3f0c2d9e6afa0cb3aecaa9df027186bb814df2b..f5109d8c48962c721583b97f37fbd085cda65d4b 100644 (file)
--- 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))))))
 \f
 (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 84c748b260310092c24deb2190b4ad5f661a321d..1e693db5a8504a50d7f307c096cd1d119320005e 100644 (file)
--- 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))