Fix format word padding and tweak block offsets.

We already arranged for all entries to be 64-bit aligned, so we might
as well take advantage of that in block offsets.

diff --git a/src/compiler/machines/aarch64/assmd.scm b/src/compiler/machines/aarch64/assmd.scm
index c728befd667918feddf26971ea64b8b8629bf21d..cf94f2945bbd9a7c2444fa86ca650749e396d2e6 100644 (file)
--- a/src/compiler/machines/aarch64/assmd.scm
+++ b/src/compiler/machines/aarch64/assmd.scm
@@ -41,13 +41,15 @@ USA.
   16)
 
 (define-integrable maximum-block-offset
-  ;; PC always aligned on 32-bit boundary.  Use the extra bit.
-  (- (expt 2 (1+ block-offset-width)) 4))
+  ;; Starting PC always aligned on 64-bit boundary.
+  ;; - One bit is reserved for the continuation bit.
+  ;; - Three bits are always zero.
+  (- (expt 2 (+ (- 3 1) block-offset-width)) 8))
 
 (define (block-offset->bit-string offset start?)
-  (assert (zero? (remainder offset 4)))
+  (assert (zero? (remainder offset 8)))
   (unsigned-integer->bit-string block-offset-width
-                                (+ (shift-left (quotient offset 4) 1)
+                                (+ (shift-left (quotient offset 8) 1)
                                    (if start? 0 1))))
 
 ;;; Machine dependent instruction order

diff --git a/src/compiler/machines/aarch64/lapgen.scm b/src/compiler/machines/aarch64/lapgen.scm
index 82b330f9caa13c582e173a6cfbb6b533d67e835d..a4defc611d58a0038d6843a70cd3cfe0aaa90431 100644 (file)
--- a/src/compiler/machines/aarch64/lapgen.scm
+++ b/src/compiler/machines/aarch64/lapgen.scm
@@ -446,9 +446,10 @@ USA.
 
 (define (make-external-label type/arity label)
   (set! *external-labels* (cons label *external-labels*))
-  (LAP (PADDING 32 64 ,entry-padding-bit-string)
+  ;; Pad to 4 modulo 8 bytes so the PC offset is 8-byte-aligned.
+  (LAP (PADDING 4 8 ,entry-padding-bit-string)
        (EXTERNAL-LABEL ,type/arity ,label)
-       (DATA 64 U 0)
+       (DATA 64 U 0)                    ;PC offset
        (LABEL ,label)))
 
 (define (make-code-word min max)

diff --git a/src/compiler/machines/aarch64/rules3.scm b/src/compiler/machines/aarch64/rules3.scm
index ac258e3346cfcfda450c4c322adf636a843bd71f..52c0437ae7f82cd9742a5c00090009dcbf53bae3 100644 (file)
--- a/src/compiler/machines/aarch64/rules3.scm
+++ b/src/compiler/machines/aarch64/rules3.scm
@@ -593,10 +593,12 @@ USA.
          (temp (allocate-temporary-register! 'GENERAL))
          (manifest-type type-code:manifest-closure)
          (manifest-size (closure-manifest-size size))
-         (Free regnum:free-pointer))
+         (Free regnum:free-pointer)
+         ;; 1 for manifest, 1 for padding & format word, 1 for PC offset.
+         (offset 3))
     (LAP ,@(load-tagged-immediate manifest-type manifest-size temp)
          (STR X ,temp (POST+ ,Free (& 8)))
-         ,@(generate-closure-entry label 1 min max 1 temp)
+         ,@(generate-closure-entry label 1 min max offset temp)
          ;; Free now points at the entry.  Save it in target.
          ,@(register->register-transfer Free target)
          ;; Bump Free to point at the last component, one word before
@@ -614,8 +616,8 @@ USA.
          (temp (allocate-temporary-register! 'GENERAL))
          (manifest-type type-code:manifest-closure)
          (manifest-size (multiclosure-manifest-size nentries size))
-         ;; 8 for manifest, 8 for padding & format word, 8 for PC offset.
-         (offset0 #x18)
+         ;; 1 for manifest, 1 for padding & format word, 1 for PC offset.
+         (offset0 3)
          (Free regnum:free-pointer))
     (define (generate-primary-entry entry)
       (let ((label (car entry)) (min (cadr entry)) (max (caddr entry)))
@@ -649,25 +651,10 @@ USA.
 \f
 (define (generate-closure-entry label padding min max offset temp)
   (let* ((label* (rtl-procedure/external-label (label->object label)))
-         (code-word (make-procedure-code-word min max))
+         (format (make-closure-padded-format padding min max offset))
          (Free regnum:free-pointer))
-    ;; Could avoid zeroing the padding if we don't need it, but there's
-    ;; no advantage.
-    (define (padded-word)
-      ;; padding(32) || code-word(16) || offset(16)
-      (case endianness
-        ((BIG)
-         (bitwise-ior (shift-left padding 32)
-                      (bitwise-ior (shift-left code-word 16)
-                                   offset)))
-        ((LITTLE)
-         (bitwise-ior padding
-                      (bitwise-ior (shift-left code-word 32)
-                                   (shift-left offset 48))))
-        (else
-         (error "Unknown endianness:" endianness))))
     (assert (not (= temp regnum:scratch-0)))
-    (LAP ,@(load-unsigned-immediate temp (padded-word))
+    (LAP ,@(load-unsigned-immediate temp format)
          (STR X ,temp (POST+ ,Free (& 8)))
          ;; Set temp := label - 8.
          (ADR X ,temp (@PCR (- ,label* 8) ,regnum:scratch-0))
@@ -676,6 +663,21 @@ USA.
          ;; Store the PC offset.
          (STR X ,temp (POST+ ,Free (& 8))))))
 
+(define (make-closure-padded-format padding min max offset)
+  ;; Entries are 64-bit-aligned, so offset is units of Scheme objects,
+  ;; limited to 15 bits.  Low bit of the block offset is 0 because it
+  ;; always refers to the start of the block, not to a continuation
+  ;; offset.
+  (assert (< offset (expt 2 15)) "Your closure has too many entries.")
+  (let ((word
+         (bitwise-ior (shift-left offset (+ 16 1))
+                      (make-procedure-code-word min max))))
+    ;; Padding (or entry count) comes first in memory.
+    (case endianness
+      ((BIG) (bitwise-ior padding (shift-left word 32)))
+      ((LITTLE) (bitwise-ior (shift-left word 32) padding))
+      (else (error "Unknown endianness:" endianness)))))
+
 (define (closure-manifest-size size)
   (multiclosure-manifest-size 1 size))
 

diff --git a/src/microcode/cmpintmd/aarch64.c b/src/microcode/cmpintmd/aarch64.c
index 75cce2d8a3bbc22db3340c6b3d0481e0dca4350e..b6610c10b0846b4ef26c15f42d362d7e0add8d8a 100644 (file)
--- a/src/microcode/cmpintmd/aarch64.c
+++ b/src/microcode/cmpintmd/aarch64.c
@@ -60,9 +60,12 @@ write_cc_entry_type (cc_entry_type_t * cet, insn_t * address)
 bool
 read_cc_entry_offset (cc_entry_offset_t * ceo, insn_t * address)
 {
+  const size_t units = ((sizeof (SCHEME_OBJECT)) / (sizeof (insn_t)));
+  assert (units == 2);
   uint32_t word = (address[-3]);
   uint16_t n = ((word & BLOCK_OFFSET_MASK) >> BLOCK_OFFSET_SHIFT);
-  (ceo->offset) = (n >> 1);
+  /* Block offsets are stored in units of Scheme objects.  */
+  (ceo->offset) = (units * (n >> 1));
   (ceo->continued_p) = ((n & 1) != 0);
   return (false);
 }
@@ -70,11 +73,14 @@ read_cc_entry_offset (cc_entry_offset_t * ceo, insn_t * address)
 bool
 write_cc_entry_offset (cc_entry_offset_t * ceo, insn_t * address)
 {
+  const size_t units = ((sizeof (SCHEME_OBJECT)) / (sizeof (insn_t)));
+  assert (units == 2);
+  assert (((ceo->offset) % units) == 0);
   if (! ((ceo->offset) < 0x4000))
     return (true);
   (address[-3]) &=~ BLOCK_OFFSET_MASK;
   (address[-3]) |=
-    ((((ceo->offset) << 1) | ((ceo->continued_p) ? 1 : 0))
+    (((((ceo->offset) / units) << 1) | ((ceo->continued_p) ? 1 : 0))
      << BLOCK_OFFSET_SHIFT);
   return (false);
 }