;; 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.
((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)
(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)
(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
(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
#;
(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)))
(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)))))
projects / mit-scheme.git / commitdiff