From: Taylor R Campbell Date: Wed, 23 Jan 2019 05:21:34 +0000 (+0000) Subject: Implement aarch64 logical immediate encoding. X-Git-Tag: mit-scheme-pucked-10.1.20~11^2~66^2~30 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d7e71a952b8e63e3bd078c2f1b7bb074bb1f6063;p=mit-scheme.git Implement aarch64 logical immediate encoding. --- diff --git a/src/compiler/machines/aarch64/coerce.scm b/src/compiler/machines/aarch64/coerce.scm index 399641f53..d86debcc4 100644 --- a/src/compiler/machines/aarch64/coerce.scm +++ b/src/compiler/machines/aarch64/coerce.scm @@ -43,6 +43,7 @@ USA. (define coerce-8-bit-unsigned (make-coercion 'UNSIGNED 8)) (define coerce-12-bit-unsigned (make-coercion 'UNSIGNED 12)) +(define coerce-13-bit-unsigned (make-coercion 'UNSIGNED 13)) (define coerce-14-bit-unsigned (make-coercion 'UNSIGNED 14)) (define coerce-16-bit-unsigned (make-coercion 'UNSIGNED 16)) (define coerce-32-bit-unsigned (make-coercion 'UNSIGNED 32)) diff --git a/src/compiler/machines/aarch64/instr1.scm b/src/compiler/machines/aarch64/instr1.scm index 0ac693a43..7a2cda8f2 100644 --- a/src/compiler/machines/aarch64/instr1.scm +++ b/src/compiler/machines/aarch64/instr1.scm @@ -1315,29 +1315,47 @@ USA. ;; Immediate, 32-bit operand size ((W ,@(if Rd '() `((? Rd ,register-31=dst))) (? Rn register-31=z) - (&U (? imm logical-imm-32))) + (&U (? imm logical-imm-u32))) (BITS (1 0) ;sf=0, 32-bit operand size (2 ,opc) (1 1) (4 #b0010) (1 0) - (1 0) ;N=0 - (6 imm BITMASK32-IMMR) - (6 imm BITMASK32-IMMS) + (13 imm) + (5 Rn) + (5 ,(or Rd 'Rd)))) + ((W ,@(if Rd '() `((? Rd ,register-31=dst))) + (? Rn register-31=z) + (& (? imm logical-imm-s32))) + (BITS (1 0) ;sf=0, 32-bit operand size + (2 ,opc) + (1 1) + (4 #b0010) + (1 0) + (13 imm) (5 Rn) (5 ,(or Rd 'Rd)))) ;; Immediate, 64-bit operand size ((X ,@(if Rd '() '((? Rd register-31=sp))) (? Rn register-31=z) - (&U (? imm logical-imm-64))) + (&U (? imm logical-imm-u64))) + (BITS (1 1) ;sf=1, 64-bit operand size + (2 ,opc) + (1 1) + (4 #b0010) + (1 0) + (13 imm) + (5 Rn) + (5 ,(or Rd 'Rd)))) + ((X ,@(if Rd '() '((? Rd register-31=sp))) + (? Rn register-31=z) + (& (? imm logical-imm-s64))) (BITS (1 1) ;sf=1, 64-bit operand size (2 ,opc) (1 1) (4 #b0010) (1 0) - (1 imm BITMASK64-N) - (6 imm BITMASK64-IMMR) - (6 imm BITMASK64-IMMS) + (13 imm) (5 Rn) (5 ,(or Rd 'Rd)))) ;; Shifted register, no shift amount. diff --git a/src/compiler/machines/aarch64/insutl.scm b/src/compiler/machines/aarch64/insutl.scm index ddc75e82f..1e6b13e21 100644 --- a/src/compiler/machines/aarch64/insutl.scm +++ b/src/compiler/machines/aarch64/insutl.scm @@ -281,15 +281,87 @@ USA. ((ROR) #b11) (else #f))) -(define (logical-imm-32 imm) - ;; XXX - imm - (error "XXX not yet implemented")) - -(define (logical-imm-64 imm) - ;; XXX - imm - (error "XXX not yet implemented")) +(define (logical-immediate-signed imm width) + (let ((magmask (bit-mask (- width 1) 0))) + (and (<= imm magmask) + (<= (bitwise-not magmask) imm) + (logical-immediate-unsigned + (bitwise-and imm (bit-mask width 0)) + width)))) + +(define (logical-immediate-unsigned imm width) + (define (find-smallest-period) + ;; Find the smallest candidate period, at least 2 since we need at + ;; least one 1 and at least one 0. + (let loop ((p width)) + (let* ((h (quotient p 2)) + (mask (bit-mask h 0))) + (if (and (= (bitwise-and imm mask) + (bitwise-and (shift-right imm h) mask)) + (> h 2)) + (loop h) + p)))) + (define (generate period phase count) + ;; Given the phase, period, and count of bits, compute and encode + ;; the n, immr, and imms representation. + (assert (< phase period)) + (let* ((immr (- period phase)) + (nimms (bitwise-ior (shift-left (- period) 1) (- count 1))) + (n (bitwise-xor 1 (bitwise-and 1 (shift-right nimms 6)))) + (imms (bitwise-and nimms #x3f))) + (encode n immr imms))) + (define (encode n immr imms) + ;; Given the n, immr, and imms fields, encode them as: + ;; n(1) || immr(6) || imms(6) + (assert (= n (bitwise-and n 1))) + (assert (= immr (bitwise-and immr #x3f))) + (assert (= imms (bitwise-and imms #x3f))) + (bitwise-ior (shift-left n 12) + (bitwise-ior (shift-left immr 6) imms))) + (define (contiguous-ones? x) + ;; True if the one bits in x are contiguous. E.g., + ;; + ;; 00111000 - 1 = 001101111 + ;; (00111000 - 1) | 0011000 = 00111111 + ;; 00111111 + 1 = 01000000 + ;; (00111111 + 1) & 01000000 = 0 + (let* ((y (bitwise-ior (- x 1) x)) + (z (bitwise-and (+ y 1) x))) + (zero? z))) + (let ((wmask (bit-mask width 0))) + (and (not (= imm 0)) + (not (= imm wmask)) + (= imm (bitwise-and imm wmask)) + (let* ((period (find-smallest-period)) + (pmask (bit-mask period 0)) + (imm+ (bitwise-and imm pmask)) + (imm- (bitwise-orc2 imm pmask))) + (cond ((contiguous-ones? imm+) + ;; E.g.: 00011100 -> phase = 2, count = 3 + (let* ((phase (first-set-bit imm+)) + (count (integer-length (shift-right imm+ phase)))) + (generate period phase count))) + ((contiguous-ones? (bitwise-not imm-)) + ;; E.g.: 11100011 -> phase = -2 = 8 - 2 = 6, count = 5 + (let* ((phase (- width (find-first-set (bitwise-not imm-)))) + (count (- width (bit-count (bitwise-not imm-))))) + (generate period phase count))) + (else + ;; It is not the replication of the rotation of a + ;; contiguous sequence of one bits. + #f)))))) + +(define (logical-imm-s32 imm) + (logical-immediate-signed imm 32)) + +(define (logical-imm-s64 imm) + (logical-immediate-signed imm 64)) + +(define (logical-imm-u32 imm) + (logical-immediate-unsigned imm 32)) + +(define (logical-imm-u64 imm) + (logical-immediate-unsigned imm 64)) (define (hw-shift32 shift) (and (exact-nonnegative-integer? shift) diff --git a/src/compiler/machines/aarch64/lapgen.scm b/src/compiler/machines/aarch64/lapgen.scm index a7da67a02..4e48c6169 100644 --- a/src/compiler/machines/aarch64/lapgen.scm +++ b/src/compiler/machines/aarch64/lapgen.scm @@ -315,6 +315,7 @@ USA. (load-pc-relative target (constant->label object)))) (define (load-signed-immediate target imm) + (assert (<= (bit-antimask 63 0) imm (bit-mask 63 0))) (load-unsigned-immediate target (bitwise-and imm #xffffffffffffffff))) (define (load-unsigned-immediate target imm) @@ -329,6 +330,7 @@ USA. (try-shift imm 48))) (define (chunk16 pos) (bitwise-and (shift-right imm pos) #xffff)) + (assert (<= 0 imm (bit-mask 64 0))) (cond ((find-shift imm) => (lambda (shift) (LAP (MOVZ X ,target @@ -338,7 +340,7 @@ USA. (let ((imm (bitwise-andc1 imm #xffffffffffffffff))) (LAP (MOVN X ,target (LSL (&U ,(shift-right imm shift)) ,shift)))))) - ((logical-immediate? imm) + ((logical-imm-u64 imm) (LAP (ORR X ,target Z (&U ,imm)))) ;; XXX try splitting in halves, quarters #; @@ -354,11 +356,6 @@ USA. (MOVK X ,target (LSL (&U ,(chunk16 16)) 16)) (MOVK X ,target (LSL (&U ,(chunk16 32)) 32)) (MOVK X ,target (LSL (&U ,(chunk16 48)) 48)))))) - -(define (logical-immediate? x) - x - ;; XXX - #f) (define (add-immediate target source imm) (define (add addend) (LAP (ADD X ,target ,source ,addend))) @@ -398,7 +395,7 @@ USA. (assert (<= 48 scheme-datum-width)) (cond ((zero? type) (assign-register->register target datum)) - ((logical-immediate? (make-non-pointer-literal type 0)) + ((logical-imm-u64 (make-non-pointer-literal type 0)) ;; Works for tags with only contiguous one bits, including ;; tags with only one bit set. (LAP (ORR X ,target ,datum (&U ,(make-non-pointer-literal type 0)))))