Use a temporary if necessary in AFFIX-TYPE.

diff --git a/src/compiler/machines/aarch64/lapgen.scm b/src/compiler/machines/aarch64/lapgen.scm
index c831b08eef7d9f95769420247df7d6c81af14313..8c7354dbd8920489eb038ad911cc7074d80e4c9b 100644 (file)
--- a/src/compiler/machines/aarch64/lapgen.scm
+++ b/src/compiler/machines/aarch64/lapgen.scm
@@ -393,9 +393,7 @@ USA.
            (LAP ,@(load-unsigned-immediate temp imm)
                 ,@(add temp))))))
 \f
-(define (affix-type target type datum)
-  ;; Note: This must NOT use regnum:scratch-0 or regnum:scratch-1!
-  ;; This is used by closure headers to tag the incoming entry.
+(define (affix-type target type datum get-temporary)
   (assert (<= scheme-type-width 16))
   (assert (<= 48 scheme-datum-width))
   (cond ((zero? type)
@@ -410,10 +408,11 @@ USA.
          ;;
          ;; XXX If we know the top few bits of the datum are zero, we
          ;; could use a single MOVK instruction.
-         (let ((imm (shift-left type (- 16 scheme-type-width)))
+         (let ((temp (if (= target datum) (get-temporary) target))
+               (imm (shift-left type (- 16 scheme-type-width)))
                (shift 48))
-           (LAP (MOVZ X ,target (LSL (&U ,imm) ,shift))
-                (ORR X ,target ,target ,datum))))))
+           (LAP (MOVZ X ,temp (LSL (&U ,imm) ,shift))
+                (ORR X ,target ,temp ,datum))))))
 
 (define (object->type target source)
   (let ((lsb scheme-datum-width)

diff --git a/src/compiler/machines/aarch64/rules1.scm b/src/compiler/machines/aarch64/rules1.scm
index a75955d841b4a71e3d18d379fa2c25a572077287..4574854fca25db4b63c47ae3410f930e2fe22bbd 100644 (file)
--- a/src/compiler/machines/aarch64/rules1.scm
+++ b/src/compiler/machines/aarch64/rules1.scm
@@ -68,7 +68,8 @@ USA.
                         (REGISTER (? datum))))
   (standard-unary target datum
     (lambda (target datum)
-      (affix-type target type datum))))
+      (affix-type target type datum
+                  (lambda () (allocate-temporary-register! 'GENERAL))))))
 
 (define-rule statement
   (ASSIGN (REGISTER (? target)) (OBJECT->TYPE (REGISTER (? source))))

diff --git a/src/compiler/machines/aarch64/rules3.scm b/src/compiler/machines/aarch64/rules3.scm
index ec7fbb4a81ec390a9f8c05b0ef599048d5f965a5..c8abd37465b0d9866c6041a2bf15d7b5522b3fd9 100644 (file)
--- a/src/compiler/machines/aarch64/rules3.scm
+++ b/src/compiler/machines/aarch64/rules3.scm
@@ -527,7 +527,8 @@ USA.
       (LAP ,@(make-external-label internal-entry-code-word external-label)
            ;; regnum:applicand holds the untagged entry address.
            ;; Push and tag it.
-           ,@(affix-type regnum:applicand type regnum:applicand)
+           ,@(affix-type regnum:applicand type regnum:applicand
+                         (lambda () regnum:scratch-0))
            ,@(push regnum:applicand)
           (LABEL ,internal-label)))
     (cond ((zero? nentries)
@@ -602,7 +603,8 @@ USA.
          ;; offsets without pre/post-increment.
          ,@(add-immediate Free Free (* 8 size))
          ;; Set the last component to be the relocation reference point.
-         ,@(affix-type temp type-code:compiled-entry target)
+         ,@(affix-type temp type-code:compiled-entry target
+                       (lambda () (allocate-temporary-register! 'GENERAL)))
          (STR X ,temp (POST+ ,Free (& 8))))))
 
 (define (generate/cons-multiclosure target nentries size entries)
@@ -639,7 +641,8 @@ USA.
          ;; offsets without pre/post-increment.
          ,@(add-immediate Free Free (* 8 size))
          ;; Set the last component to be the relocation reference point.
-         ,@(affix-type temp type-code:compiled-entry target)
+         ,@(affix-type temp type-code:compiled-entry target
+                       (lambda () (allocate-temporary-register! 'GENERAL)))
          (STR X ,temp (POST+ ,Free (& 8))))))
 \f
 (define (generate-closure-entry label padding min max offset temp)