From: Taylor R Campbell <campbell@mumble.net>
Date: Wed, 16 Jan 2019 04:46:17 +0000 (+0000)
Subject: Fix register block indexing: no hooks in the register block here.
X-Git-Tag: mit-scheme-pucked-10.1.20~11^2~66^2~77
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=909ef339cb9f02711f8d6f542d929a74c0e68ff0;p=mit-scheme.git

Fix register block indexing: no hooks in the register block here.
---

diff --git a/src/compiler/machines/aarch64/lapgen.scm b/src/compiler/machines/aarch64/lapgen.scm
index c7e142761..a016fc79e 100644
--- a/src/compiler/machines/aarch64/lapgen.scm
+++ b/src/compiler/machines/aarch64/lapgen.scm
@@ -143,7 +143,7 @@ USA.
 
 (define (spill-ea index)
   ;; XXX fix register block indexing
-  (regblock-ea (+ 16 80 index)))
+  (regblock-ea (+ 16 index)))
 
 (define (home->register-transfer register alias)
   (load-register alias (spill-ea (register-renumber register))))
diff --git a/src/compiler/machines/aarch64/rules3.scm b/src/compiler/machines/aarch64/rules3.scm
index c8abd3746..8afe6b979 100644
--- a/src/compiler/machines/aarch64/rules3.scm
+++ b/src/compiler/machines/aarch64/rules3.scm
@@ -310,6 +310,7 @@ USA.
          ;; number of iterations.
          (loop-count (- frame-size (remainder frame-size 2))))
     (assert (= loop-count (* (quotient frame-size 2) 2)))
+    (assert (not (= index regnum:scratch-0)))
     (LAP (ADD X ,regnum:stack-pointer ,regnum:stack-pointer
               (&U ,(* 8 frame-size)))
          ,@(if (odd? frame-size)
@@ -524,6 +525,7 @@ USA.
          (checks (get-entry-interrupt-checks))
          (type type-code:compiled-entry))
     (define (label+adjustment)
+      (assert (not (= regnum:applicand regnum:scratch-0)))
       (LAP ,@(make-external-label internal-entry-code-word external-label)
            ;; regnum:applicand holds the untagged entry address.
            ;; Push and tag it.
@@ -664,6 +666,7 @@ USA.
                                    (shift-left offset 48))))
         (else
          (error "Unknown endianness:" endianness))))
+    (assert (not (= temp regnum:scratch-0)))
     (LAP ,@(load-unsigned-immediate temp (padded-word))
          (STR X ,temp (POST+ ,Free (& 8)))
          ;; Set temp := label - 8.
@@ -695,6 +698,8 @@ USA.
 
 (define (generate/quotation-header environment-label free-ref-label n-sections)
   (let ((continuation-label (generate-label 'LINKED)))
+    (assert (not (= r0 regnum:scratch-0)))
+    (assert (not (= r1 regnum:scratch-0)))
     (LAP (LDR X ,r0 ,reg:environment)
          (ADR X ,r1 (@PCR ,environment-label ,regnum:scratch-0))
          (STR X ,r0 ,r1)
@@ -743,6 +748,7 @@ USA.
              (arg2 regnum:utility-arg2)
              (arg3 regnum:utility-arg3)
              (arg4 regnum:utility-arg4))
+        (assert (not (= counter regnum:scratch-0)))
         (LAP ,@(load-unsigned-immediate counter n-blocks)
             (LABEL ,loop-label)
              ,@(load-pc-relative arg2 vector-label)     ;arg2 := vector