Ensure register:value appears first or last in block.

Either it is the first register referenced, or the last register
assigned.  This will enable us to use a machine register that is
normally available for register allocation, without having to worry
that it may be an alias for a live pseudo-register.

- In continuations that receive a value through register:value,
  create a temporary register and make the first instruction be an
  assignment of register:value to the temporary register, before we
  the pop-extra.

  The RTL optimizer avoids propagating this alias so the assignment
  will stay in place, but later on, the LAP generator will take
  advantage of the alias to avoid generating additional unnecessary
  code.

- In returns that store a value in register:value, create a temporary
  register and assign it where we used to assign to register:value,
  and then store the temporary in register:value as the very last
  instruction before pop-return after any frame-popping which might
  involve temporaries.

diff --git a/src/compiler/rtlgen/opncod.scm b/src/compiler/rtlgen/opncod.scm
index deaae4b7776acd4223f2cefcf093dc0dc91ffd5f..c589948a5c507d192c69526f8e3101c496ea29ee 100644 (file)
--- a/src/compiler/rtlgen/opncod.scm
+++ b/src/compiler/rtlgen/opncod.scm
@@ -322,7 +322,12 @@ USA.
                                            expressions setup label)
                        cleanup
                        (if error-finish
-                           (error-finish (rtl:make-fetch register:value))
+                           (let ((temporary (rtl:make-pseudo-register)))
+                             (scfg*scfg->scfg!
+                              (rtl:make-assignment
+                               temporary
+                               (rtl:make-fetch register:value))
+                              (error-finish (rtl:make-fetch temporary))))
                            (make-null-cfg)))
                       #|
                       ;; This code is preferable to the above
@@ -1680,11 +1685,14 @@ USA.
             (generate-primitive generic-op (length expressions)
                                 expressions setup label)
             cleanup
-            (if predicate?
-                (finish (rtl:make-true-test (rtl:make-fetch register:value)))
-                (expression-simplify-for-statement
-                 (rtl:make-fetch register:value)
-                 finish))))))))
+            (let ((temporary (rtl:make-pseudo-register)))
+              (scfg*scfg->scfg!
+               (rtl:make-assignment temporary (rtl:make-fetch register:value))
+               (if predicate?
+                   (finish (rtl:make-true-test (rtl:make-fetch temporary)))
+                   (expression-simplify-for-statement
+                    (rtl:make-fetch temporary)
+                    finish))))))))))
 
 (define (generic->fixnum-op generic-op)
   (case generic-op

diff --git a/src/compiler/rtlgen/rgretn.scm b/src/compiler/rtlgen/rgretn.scm
index d5bfc568008d80f77f1973987bf8aabb95a1f617..53397293273e6c0405c077baca8aae4df9bce900 100644 (file)
--- a/src/compiler/rtlgen/rgretn.scm
+++ b/src/compiler/rtlgen/rgretn.scm
@@ -84,14 +84,21 @@ USA.
              (generate/continuation-entry/pop-extra continuation)))
         operand
         continuation)
-       (scfg-append!
-        (if (and continuation (continuation/effect? continuation))
-            (effect-prefix operand)
-            ((return-operand/value-generator operand)
-             (lambda (expression)
-               (rtl:make-assignment register:value expression))))
-        (return-operator/pop-frames context operator 0)
-        (rtl:make-pop-return)))))
+        (receive (rising-action conclusion)
+                (if (and continuation (continuation/effect? continuation))
+                    (values (effect-prefix operand) (make-null-cfg))
+                    (let ((temporary (rtl:make-pseudo-register)))
+                      (values
+                       ((return-operand/value-generator operand)
+                        (lambda (expression)
+                          (rtl:make-assignment temporary expression)))
+                       (rtl:make-assignment register:value
+                                            (rtl:make-fetch temporary)))))
+         (scfg-append!
+          rising-action
+          (return-operator/pop-frames context operator 0)
+          conclusion
+          (rtl:make-pop-return))))))
 
 (define-integrable (continuation/effect? continuation)
   (eq? continuation-type/effect (continuation/type continuation)))

diff --git a/src/compiler/rtlgen/rtlgen.scm b/src/compiler/rtlgen/rtlgen.scm
index 7488be6e8c1f25161b32968f3950b18e1d45e0c1..d5a4dc5f6af95b6c9f74736ea88ab006f8e4d97b 100644 (file)
--- a/src/compiler/rtlgen/rtlgen.scm
+++ b/src/compiler/rtlgen/rtlgen.scm
@@ -151,28 +151,44 @@ USA.
          (generate/rgraph
           (continuation/entry-node continuation)
           (lambda (node)
-            (scfg-append!
-             (if (continuation/avoid-check? continuation)
-                 (rtl:make-continuation-entry label)
-                 (rtl:make-continuation-header label))
-             (generate/continuation-entry/pop-extra continuation)
-             (enumeration-case continuation-type
-                 (continuation/type continuation)
-               ((PUSH)
-                (rtl:make-push (rtl:make-fetch register:value)))
-               ((REGISTER)
-                (rtl:make-assignment (continuation/register continuation)
-                                     (rtl:make-fetch register:value)))
-               ((VALUE PREDICATE)
-                (if (continuation/ever-known-operator? continuation)
-                    (rtl:make-assignment (continuation/register continuation)
-                                         (rtl:make-fetch register:value))
-                    (make-null-cfg)))
-               ((EFFECT)
-                (make-null-cfg))
-               (else
-                (error "Illegal continuation type" continuation)))
-             (generate/node node)))))
+            (define (with-value generator)
+              (let* ((temporary (rtl:make-pseudo-register))
+                     (prologue
+                      (rtl:make-assignment temporary
+                                           (rtl:make-fetch register:value)))
+                     (intermezzo (generator temporary)))
+                (values prologue intermezzo)))
+            (receive (prologue intermezzo)
+                     (enumeration-case continuation-type
+                         (continuation/type continuation)
+                       ((PUSH)
+                        (with-value rtl:make-push))
+                       ((REGISTER)
+                        (with-value
+                         (lambda (expression)
+                           (rtl:make-assignment
+                            (continuation/register continuation)
+                            expression))))
+                       ((VALUE PREDICATE)
+                        (if (continuation/ever-known-operator? continuation)
+                            (with-value
+                             (lambda (expression)
+                               (rtl:make-assignment
+                                (continuation/register continuation)
+                                expression)))
+                            (values (make-null-cfg) (make-null-cfg))))
+                       ((EFFECT)
+                        (values (make-null-cfg) (make-null-cfg)))
+                       (else
+                        (error "Illegal continuation type" continuation)))
+              (scfg-append!
+               (if (continuation/avoid-check? continuation)
+                   (rtl:make-continuation-entry label)
+                   (rtl:make-continuation-header label))
+               prologue
+               (generate/continuation-entry/pop-extra continuation)
+               intermezzo
+               (generate/node node))))))
       (lambda (rgraph entry-edge)
        (make-rtl-continuation
         rgraph