Implement aarch64 logical immediate encoding.
authorTaylor R Campbell <campbell@mumble.net>
Wed, 23 Jan 2019 05:21:34 +0000 (05:21 +0000)
committerTaylor R Campbell <campbell@mumble.net>
Wed, 21 Aug 2019 21:34:05 +0000 (21:34 +0000)
src/compiler/machines/aarch64/coerce.scm
src/compiler/machines/aarch64/instr1.scm
src/compiler/machines/aarch64/insutl.scm
src/compiler/machines/aarch64/lapgen.scm

index 399641f53c93785c3ff494aca8a666f972252b46..d86debcc442da6bd574cb850015f4c6ffea8c2cd 100644 (file)
@@ -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))
index 0ac693a43e7ee0e3a172f62db13a7865df4eb4d1..7a2cda8f24a72b75985d7e7c96c6f418d7b1215c 100644 (file)
@@ -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.
index ddc75e82fd3a86b3dc30fbf0bbc00f41358754af..1e6b13e219b4284a32896225f2f51f947ac0bacb 100644 (file)
@@ -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)
index a7da67a02a84bffacfeae3320e228222dc183170..4e48c6169dd5b8512d71fd6d9e280679172478df 100644 (file)
@@ -315,6 +315,7 @@ USA.
       (load-pc-relative target (constant->label object))))
 \f
 (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)
 \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)))))