Fix `move-to-alias-register!' so that when an alias is reused for a

register that has no other aliases, then that alias is marked as
needing to be saved into its home.  Improve
`reuse-pseudo-register-alias!' so that it doesn't generate a move
instruction from a register to itself.  Fix a bug which prevented the
clear-map instructions from being inserted when the next node had
already been generated.

diff --git a/v7/src/compiler/back/lapgn1.scm b/v7/src/compiler/back/lapgn1.scm
index 5f92d55b294faa13e46ced716a0025f5e58c453d..a49294d091038b7a5f28d145681b8660823a2436 100644 (file)
--- a/v7/src/compiler/back/lapgn1.scm
+++ b/v7/src/compiler/back/lapgn1.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn1.scm,v 1.33 1987/05/18 17:57:18 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn1.scm,v 1.34 1987/05/19 18:04:47 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -96,15 +96,15 @@ MIT in each case. |#
        (if next
            (begin
              (record-rnode-frame-pointer-offset! next offset)
+             (if (node-previous>1? next)
+                 (let ((snode (statement->snode '(NOOP))))
+                   (set-rnode-lap! snode
+                                   (clear-map-instructions
+                                    (rnode-register-map rnode)))
+                   (node-mark! snode)
+                   (edge-insert-snode! edge snode)))
              (if (not (node-marked? next))
-                 (begin (if (node-previous>1? next)
-                            (let ((snode (statement->snode '(NOOP))))
-                              (set-rnode-lap! snode
-                                              (clear-map-instructions
-                                               (rnode-register-map rnode)))
-                              (node-mark! snode)
-                              (edge-insert-snode! edge snode)))
-                        (cgen-rnode next)))))))
+                 (cgen-rnode next))))))
     (if (rtl-snode? rnode)
        (cgen-right-node (snode-next-edge rnode))
        (begin (cgen-right-node (pnode-consequent-edge rnode))
@@ -238,7 +238,7 @@ MIT in each case. |#
 (define (move-to-alias-register! source type target)
   (reuse-pseudo-register-alias! source type
     (lambda (reusable-alias)
-      (add-pseudo-register-alias! target reusable-alias))
+      (add-pseudo-register-alias! target reusable-alias false))
     (lambda ()
       (allocate-alias-register! target type))))
 
@@ -263,14 +263,15 @@ MIT in each case. |#
          (delete-dead-registers!)
          (let ((target (if-not)))
            (prefix-instructions!
-            (if alias
-                (register->register-transfer alias target)
-                (home->register-transfer source target)))
+           (cond ((not alias) (home->register-transfer source target))
+                 ((= alias target) '())
+                 (else (register->register-transfer alias target))))
            (register-reference target))))))
 \f
-(define (add-pseudo-register-alias! register alias)
+(define (add-pseudo-register-alias! register alias saved-into-home?)
   (set! *register-map*
-       (add-pseudo-register-alias *register-map* register alias))
+       (add-pseudo-register-alias *register-map* register alias
+                                  saved-into-home?))
   (need-register! alias))
 
 (define (clear-map!)