From: Taylor R Campbell <campbell@mumble.net>
Date: Sun, 25 Aug 2019 15:40:15 +0000 (+0000)
Subject: Let caller specify how to get a temporary in ADD-IMMEDIATE.
X-Git-Tag: mit-scheme-pucked-10.1.20~11^2~66^2~6
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c7ab86d8e78b1e59d85697103ebd50b50dc38846;p=mit-scheme.git

Let caller specify how to get a temporary in ADD-IMMEDIATE.

Fixes

;  Compiling file: "test-hack.bin" => "test-hack.com"...
;Unassigned variable: *needed-registers*

because of attempt to allocate a temporary in ADD-IMMEDIATE during
GENERATE/REMOTE-LINKS.
---

diff --git a/src/compiler/machines/aarch64/lapgen.scm b/src/compiler/machines/aarch64/lapgen.scm
index 6590d91f2..c45811ab8 100644
--- a/src/compiler/machines/aarch64/lapgen.scm
+++ b/src/compiler/machines/aarch64/lapgen.scm
@@ -297,7 +297,7 @@ USA.
 (define (load-displaced-address target base offset scale)
   (standard-unary target base
     (lambda (target base)
-      (add-immediate target base (* offset scale)))))
+      (add-immediate target base (* offset scale) general-temporary!))))
 
 (define (load-indexed-address target base offset scale)
   (standard-binary target base offset
@@ -362,23 +362,23 @@ USA.
 	      (MOVK X ,target (LSL (&U ,(chunk16 32)) 32))
 	      (MOVK X ,target (LSL (&U ,(chunk16 48)) 48))))))
 
-(define (add-immediate target source imm)
+(define (add-immediate target source imm get-temporary)
   (define (add addend) (LAP (ADD X ,target ,source ,addend)))
   (define (sub addend) (LAP (SUB X ,target ,source ,addend)))
-  (immediate-addition imm add sub))
+  (immediate-addition imm add sub get-temporary))
 
-(define (add-immediate-with-flags target source imm)
+(define (add-immediate-with-flags target source imm get-temporary)
   (define (adds addend) (LAP (ADDS X ,target ,source ,addend)))
   (define (subs addend) (LAP (SUBS X ,target ,source ,addend)))
-  (immediate-addition imm adds subs))
+  (immediate-addition imm adds subs get-temporary))
 
-(define (cmp-immediate source imm)
+(define (cmp-immediate source imm get-temporary)
   ;; Same as above but with zero destination.
   (define (cmp operand) (LAP (CMP X ,source ,operand)))
   (define (cmn operand) (LAP (CMN X ,source ,operand)))
-  (immediate-addition imm cmp cmn))
+  (immediate-addition imm cmp cmn get-temporary))
 
-(define (immediate-addition imm add sub)
+(define (immediate-addition imm add sub get-temporary)
   ;; XXX Use INST-EA instead of quasiquote?  Dunno...
   (cond ((fits-in-unsigned-12? imm)
          (add `(&U ,imm)))
diff --git a/src/compiler/machines/aarch64/rules2.scm b/src/compiler/machines/aarch64/rules2.scm
index 1d555f976..bf455ead8 100644
--- a/src/compiler/machines/aarch64/rules2.scm
+++ b/src/compiler/machines/aarch64/rules2.scm
@@ -98,7 +98,7 @@ USA.
       (zero-test! register)
       (begin
         (set-equal-branches!)
-        (cmp-immediate register immediate))))
+        (cmp-immediate register immediate general-temporary!))))
 
 (define (set-always-branches!)
   (set-current-branches!
diff --git a/src/compiler/machines/aarch64/rules3.scm b/src/compiler/machines/aarch64/rules3.scm
index 18a340d49..996be6e45 100644
--- a/src/compiler/machines/aarch64/rules3.scm
+++ b/src/compiler/machines/aarch64/rules3.scm
@@ -583,7 +583,8 @@ USA.
             (STR X ,target ,Free)
             ,@(register->register-transfer Free target)
             ,@(add-immediate Free Free
-                             (* address-units-per-object (+ 1 size))))))
+                             (* address-units-per-object (+ 1 size))
+                             general-temporary!))))
     ((1)
      (let ((entry (vector-ref entries 0)))
        (generate/cons-closure target
@@ -610,7 +611,7 @@ USA.
          ;; the next object.  We do this because we need to set the
          ;; last component here, but we do not have negative load/store
          ;; offsets without pre/post-increment.
-         ,@(add-immediate Free Free (* 8 size))
+         ,@(add-immediate Free Free (* 8 size) general-temporary!)
          ;; Set the last component to be the relocation reference point.
          ,@(affix-type temp type-code:compiled-entry target general-temporary!)
          (STR X ,temp (POST+ ,Free (& 8))))))
@@ -647,7 +648,7 @@ USA.
          ;; the next object.  We do this because we need to set the
          ;; last component here, but we do not have negative load/store
          ;; offsets without pre/post-increment.
-         ,@(add-immediate Free Free (* 8 size))
+         ,@(add-immediate Free Free (* 8 size) general-temporary!)
          ;; Set the last component to be the relocation reference point.
          ,@(affix-type temp type-code:compiled-entry target general-temporary!)
          (STR X ,temp (POST+ ,Free (& 8))))))
@@ -737,7 +738,7 @@ USA.
          ;; Set this block's environment.
          (STR X ,temp (+ ,arg2 (&U (* 8 ,environment-index))))
          ;; arg3 := constants address
-         ,@(add-immediate arg3 arg2 free-ref-offset)
+         ,@(add-immediate arg3 arg2 free-ref-offset (lambda () temp))
          ;; arg4 := n sections
          ,@(load-unsigned-immediate arg4 n-sections)
          ,@(invoke-interface/call code:compiler-link continuation-label)
diff --git a/src/compiler/machines/aarch64/rulfix.scm b/src/compiler/machines/aarch64/rulfix.scm
index 0af7cec4e..6716c977e 100644
--- a/src/compiler/machines/aarch64/rulfix.scm
+++ b/src/compiler/machines/aarch64/rulfix.scm
@@ -106,13 +106,13 @@ USA.
 (define (fixnum-add-constant target source n overflow?)
   (let ((imm (* fixnum-1 n)))
     (cond ((not overflow?)
-           (add-immediate target source imm))
+           (add-immediate target source imm general-temporary!))
           ((zero? n)
            (set-never-branches!)
            (register->register-transfer source target))
           (else
            (set-overflow-branches!)
-           (add-immediate-with-flags target source imm)))))
+           (add-immediate-with-flags target source imm general-temporary!)))))
 
 (define (load-fixnum-constant target n)
   (load-signed-immediate target (* n fixnum-1)))