From: Taylor R Campbell Date: Sat, 19 Jan 2019 08:02:50 +0000 (+0000) Subject: Fix format word padding and tweak block offsets. X-Git-Tag: mit-scheme-pucked-10.1.20~11^2~66^2~66 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=52d7ed7ffb384b7f8176e2ad3f5357b3b0812e02;p=mit-scheme.git 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 c728befd6..cf94f2945 100644 --- 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 82b330f9c..a4defc611 100644 --- 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 ac258e334..52c0437ae 100644 --- 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. (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 75cce2d8a..b6610c10b 100644 --- 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); }