From: Taylor R Campbell <campbell@mumble.net>
Date: Sun, 25 Aug 2019 15:38:25 +0000 (+0000)
Subject: New GENERAL-TEMPORARY! shorthand.
X-Git-Tag: mit-scheme-pucked-10.1.20~11^2~66^2~7
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=fde570c1db4629ce55b24efc91da9c39cfd325a9;p=mit-scheme.git

New GENERAL-TEMPORARY! shorthand.
---

diff --git a/src/compiler/machines/aarch64/lapgen.scm b/src/compiler/machines/aarch64/lapgen.scm
index 4e48c6169..6590d91f2 100644
--- a/src/compiler/machines/aarch64/lapgen.scm
+++ b/src/compiler/machines/aarch64/lapgen.scm
@@ -183,9 +183,14 @@ USA.
   (delete-dead-registers!)
   (allocate-alias-register! register (register-type register)))
 
+(define (general-temporary!)
+  (allocate-temporary-register! 'GENERAL))
+
 (define (standard-move-to-temporary! source)
   (if (eq? source 'Z)
-      (let ((temp (allocate-temporary-register! 'GENERAL)))
+      ;; XXX What about float?  Should maybe rename this to
+      ;; GENERAL-MOVE-TO-TEMPORARY!.
+      (let ((temp (general-temporary!)))
         (prefix-instructions! (LAP (MOVZ X ,temp (&U 0))))
         temp)
       (move-to-temporary-register! source (register-type source))))
@@ -386,7 +391,7 @@ USA.
               (fits-in-unsigned-12? (shift-right (- imm) 12)))
          (sub `(LSL (&U ,(- imm)) 12)))
         (else
-         (let ((temp (allocate-temporary-register! 'GENERAL)))
+         (let ((temp (get-temporary)))
            (LAP ,@(load-unsigned-immediate temp imm)
                 ,@(add temp))))))
 
diff --git a/src/compiler/machines/aarch64/rules1.scm b/src/compiler/machines/aarch64/rules1.scm
index 77367d6df..814993166 100644
--- a/src/compiler/machines/aarch64/rules1.scm
+++ b/src/compiler/machines/aarch64/rules1.scm
@@ -68,8 +68,7 @@ USA.
                         (REGISTER (? datum))))
   (standard-unary target datum
     (lambda (target datum)
-      (affix-type target type datum
-                  (lambda () (allocate-temporary-register! 'GENERAL))))))
+      (affix-type target type datum general-temporary!))))
 
 (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 37ed22954..18a340d49 100644
--- a/src/compiler/machines/aarch64/rules3.scm
+++ b/src/compiler/machines/aarch64/rules3.scm
@@ -309,7 +309,7 @@ USA.
   (assert (= 8 address-units-per-object))
   (let* ((temp1 regnum:scratch-0)
          (temp2 regnum:scratch-1)
-         (index (allocate-temporary-register! 'GENERAL))
+         (index (general-temporary!))
          (label (generate-label 'MOVE-LOOP))
          ;; Unroll an odd element if there is one; then do an even
          ;; number of iterations.
@@ -339,7 +339,7 @@ USA.
          (let loop ((n frame-size) (temps '()))
            (if (zero? n)
                temps
-               (let ((temp (allocate-temporary-register! 'GENERAL)))
+               (let ((temp (general-temporary!)))
                  (loop (- n 1) (cons temp temps)))))))
     (LAP ,@(let loop ((temps temps))
              ;; (pop2 r1 r2) (pop2 r3 r4) (pop r5)
@@ -595,7 +595,7 @@ USA.
 
 (define (generate/cons-closure target label min max size)
   (let* ((target (standard-target! target))
-         (temp (allocate-temporary-register! 'GENERAL))
+         (temp (general-temporary!))
          (manifest-type type-code:manifest-closure)
          (manifest-size (closure-manifest-size size))
          (Free regnum:free-pointer)
@@ -612,13 +612,12 @@ 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
-                       (lambda () (allocate-temporary-register! 'GENERAL)))
+         ,@(affix-type temp type-code:compiled-entry target general-temporary!)
          (STR X ,temp (POST+ ,Free (& 8))))))
 
 (define (generate/cons-multiclosure target nentries size entries)
   (let* ((target (standard-target! target))
-         (temp (allocate-temporary-register! 'GENERAL))
+         (temp (general-temporary!))
          (manifest-type type-code:manifest-closure)
          (manifest-size (multiclosure-manifest-size nentries size))
          ;; 1 for manifest, 1 for padding & format word, 1 for PC offset.
@@ -650,8 +649,7 @@ 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
-                       (lambda () (allocate-temporary-register! 'GENERAL)))
+         ,@(affix-type temp type-code:compiled-entry target general-temporary!)
          (STR X ,temp (POST+ ,Free (& 8))))))
 
 (define (generate-closure-entry label padding min max offset temp)
diff --git a/src/compiler/machines/aarch64/rulfix.scm b/src/compiler/machines/aarch64/rulfix.scm
index b9e30a595..0af7cec4e 100644
--- a/src/compiler/machines/aarch64/rulfix.scm
+++ b/src/compiler/machines/aarch64/rulfix.scm
@@ -174,7 +174,7 @@ USA.
              (MUL X ,target ,regnum:scratch-0 ,source2))
         (let* ((mask regnum:scratch-0)
                (hi regnum:scratch-1)
-               (temp (allocate-temporary-register! 'GENERAL)))
+               (temp (general-temporary!)))
           ;; We're going to test whether the high 64-bits is equal to
           ;; the -1 or 0 we expect it to be.  Overflow if not equal, no
           ;; overflow if equal.