fixes aarch64 bitmask immediate encoding and implements some aarch64 …

…instructions (#1458)

* Add some bitvector functions and assert-msg macro

* Add immediate decoding and logical immediate insns

* Add barrier instructions via the special primitive

* add MADD, MSUB, SDIV, UDIV and conditional select

* Fix zeros and ones bitvector constructors

* organise instructions into categories

* move ADRP to integer arithmetic category

* remove private access from arm-bits functions

* Added stur instructions and fixed bug in `condition-holds` macro

* Bug fixes for STUR insns

* condense repeated definitions into macros

* implement TBZ and TBNZ

* separated into files

* rename aarch64 files and make aarch64-helper

* add some processor state instructions
LLVM can't seem to disassemble ARMv8.4 instructions like RMIF, SETF8
and SETF16. Also, CFINV gets turned into MSR (register) but LLVM
returns ill-formed asm...?
I've commented this in aarch64-pstate.lisp.

* fix typo in pstate instructions
i typed is_zero with underscore instead of primitive is-zero

* implement rotate-left

* add missing documentation and rename for clarity
documentation added for macros and helper functions.

* apply upstream changes from #1454

* implement CAS and friends for X registers
llvm mnemonics most likely incorrect, will investigate
why bap's llvm doesn't disassemble these insns

* correct CAS mnemonic and code
i've used ` bap mc --cpu=cortex-a55 --triple=aarch64`
to get the llvm mnemonic, but will need to talk to ivan
about lisp context and
specifying generic armv8.x instead of a specific cpu

* fix typos in CAS instruction code

* fix CFINV, RMIF, SETF8 and SETF16 using #1461

* use clz instead of loop for highest-set-bit

* miscellaneous changes to helper functions

* update barrier code to use symbol-concat (#1452)

* fix CAS and friends for X registers

* generalise CAS to W or X registers

* generalise CAS and friends to 8-bit and 16-bit

* rename CAS parameter names

* fixes the cast-signed Primus Lisp primitive

* fixes the arithmetic modulus in Primus Lisp primitives

The Primus Lisp semantic primitives were hardcoding 64-bit
arithmetic, which was obviously incorrect. In addition, the
shifting operations were coercing the operands to the same size,
like in arithmetic operations, which contradicts the established
semantics of shifts both in Core Theory and in BIL. Now, the shifting
operators will produce values of the same sort as the sort of the
first operand.

* adds arbitrary-precision loopless clz and popcount in Primus Lisp

* uses clz instead of clz64 and properly casts the operand

* use fixed cast-signed primitive from #1462

* fix bitmask decoding of W registers
the result in decode-bit-masks should only be
replicated to the width of the registers being assigned to.
so, we need to pass in the register width when decoding.

Co-authored-by: Tom Malcolm <ThomasMalcolm01@gmail.com>
Co-authored-by: Tom <52238845+Thomas-Malcolm@users.noreply.github.com>
Co-authored-by: ivg <ivg@ieee.org>

plugins/arm/semantics/aarch64-arithmetic.lisp

@@ -0,0 +1,69 @@
+(declare (context (target arm armv8-a+le)))
+
+(in-package aarch64)
+
+;;; INTEGER ARITHMETIC OPERATIONS
+
+(defmacro ADD*r* (set shift-function rd rn imm-or-rm off)
+  "Implements ADD*ri and ADD*rs by specifying the shift function."
+  (set rd (+ rn (shift-function imm-or-rm off))))
+
+;; ADD*ri only uses lshift since the shift arg only zero-extends
+;; and doesn't actually change from lshift
+(defun ADDWri (rd rn imm off) (ADD*r* setw lshift rd rn imm off))
+(defun ADDXri (rd rn imm off) (ADD*r* set$ lshift rd rn imm off))
+;; shift-encoded decodes the shift type and shifts
+(defun ADDWrs (rd rn rm off) (ADD*r* setw shift-encoded rd rn rm off))
+(defun ADDXrs (rd rn rm off) (ADD*r* set$ shift-encoded rd rn rm off))
+
+(defun ADRP (dst imm)
+  (set$ dst (+
+             (logand (get-program-counter) (lshift -1 12))
+             (cast-signed (word) (lshift imm 12)))))
+
+(defmacro SUB*r* (set shift-function rd rn imm-or-rm off)
+  "Implements SUB*ri and SUB*rs by specifying the shift function."
+  (set rd (- rn (shift-function imm-or-rm off))))
+
+;; see ADD*ri vs ADD*rs
+(defun SUBWri (rd rn rm off) (SUB*r* setw lshift rd rn rm off))
+(defun SUBXri (rd rn rm off) (SUB*r* set$ lshift rd rn rm off))
+(defun SUBWrs (rd rn rm off) (SUB*r* setw shift-encoded rd rn rm off))
+(defun SUBXrs (rd rn rm off) (SUB*r* set$ shift-encoded rd rn rm off))
+
+(defun SUBXrx64 (rd rn rm off)
+  (set$ rd (- rn (extended rm off))))
+
+(defun SUBSWrs (rd rn rm off)
+  (add-with-carry/clear-base rd rn (lnot (shift-encoded rm off)) 1))
+
+(defun SUBSXrs (rd rn rm off)
+  (add-with-carry rd rn (lnot (shift-encoded rm off)) 1))
+
+(defun SUBSWri (rd rn imm off)
+  (add-with-carry/clear-base rd rn (lnot (lshift imm off)) 1))
+
+(defun SUBSXri (rd rn imm off)
+  (add-with-carry rd rn (lnot (lshift imm off)) 1))
+
+(defmacro Mop*rrr (set op rd rn rm ra)
+  "(Mop*rrr set op rd rn rm ra) implements multiply-add, multiply-subtract
+   etc with W or X registers. op is the binary operation used after *."
+  (set rd (op ra (* rn rm))))
+
+(defun MADDWrrr (rd rn rm ra) (Mop*rrr setw + rd rn rm ra))
+(defun MADDXrrr (rd rn rm ra) (Mop*rrr set$ + rd rn rm ra))
+(defun MSUBWrrr (rd rn rm ra) (Mop*rrr setw - rd rn rm ra))
+(defun MSUBXrrr (rd rn rm ra) (Mop*rrr set$ - rd rn rm ra))
+
+(defmacro *DIV*r (set div rd rn rm)
+  "(*DIV*r set div rd rn rm) implements the SDIV or UDIV instructions
+   on W or X registers, with div set to s/ or / respectively."
+  (if (= rm 0)
+    (set rd 0)
+    (set rd (div rn rm))))
+
+(defun SDIVWr (rd rn rm) (*DIV*r setw s/ rd rn rm))
+(defun SDIVXr (rd rn rm) (*DIV*r set$ s/ rd rn rm))
+(defun UDIVWr (rd rn rm) (*DIV*r setw /  rd rn rm))
+(defun UDIVXr (rd rn rm) (*DIV*r set$ /  rd rn rm))

plugins/arm/semantics/aarch64-atomic.lisp

@@ -0,0 +1,82 @@
+(declare (context (target arm armv8-a+le)))
+
+(in-package aarch64)
+
+;;; ATOMIC OPERATIONS
+
+(defmacro CASord* (set load store rs rt rn acquire release)
+  "(CASord* set load store rs rt rn acquire release)
+   implements a generic compare-and-swap instruction on a W or X register.
+   set is the function to assign to the size of rs and rt.
+   load and store are functions to load/store to/from the size of rs and rt.
+   acquire and release are booleans indicating whether load-acquire and
+   store-release ordering is to be enforced."
+   (let ((data (load rn)))
+    (when acquire (special :load-acquire))
+    (when (= data rs)
+      (when release (special :store-release))
+      (store rn rt))
+    (set rs data)))
+
+(defmacro store-hword (dst src) (store-word dst (cast-low 32 src)))
+(defmacro load-quarter-word (addr) (load-bits 16 addr))
+(defmacro store-quarter-word (dst src) (store-word dst (cast-low 16 src)))
+
+(defmacro CASordX (rs rt rn acquire release)
+  "Specialisation of CASord* for X registers."
+  (CASord* set$ load-word store-word rs rt rn acquire release))
+
+(defmacro CASordW (rs rt rn acquire release)
+  "Specialisation of CASord* for W registers."
+  (CASord* setw load-hword store-hword rs rt rn acquire release))
+
+(defmacro CASordB (rs rt rn acquire release)
+  "Specialisation of CASord* operating on individual bytes."
+  (CASord* setw memory-read store-byte rs rt rn acquire release))
+
+(defmacro CASordH (rs rt rn acquire release)
+  "Specialisation of CASord* for 16-bit values."
+  (CASord* setw load-quarter-word store-quarter-word rs rt rn acquire release))
+
+;; not sure why llvm returns 4 arguments.
+;; when i've tested it, the first and second arguments are always the same value
+;; so i'm just assuming they're the same and ignoring the second.
+(defun CASX   (rs _ rt rn) (CASordX rs rt rn false false))
+(defun CASAX  (rs _ rt rn) (CASordX rs rt rn true  false))
+(defun CASLX  (rs _ rt rn) (CASordX rs rt rn false true))
+(defun CASALX (rs _ rt rn) (CASordX rs rt rn true  true))
+
+(defun CASW   (rs _ rt rn) (CASordW rs rt rn false false))
+(defun CASAW  (rs _ rt rn) (CASordW rs rt rn true  false))
+(defun CASLW  (rs _ rt rn) (CASordW rs rt rn false true))
+(defun CASALW (rs _ rt rn) (CASordW rs rt rn true  true))
+
+(defun CASB   (rs _ rt rn) (CASordB rs rt rn false false))
+(defun CASAB  (rs _ rt rn) (CASordB rs rt rn true  false))
+(defun CASLB  (rs _ rt rn) (CASordB rs rt rn false true))
+(defun CASALB (rs _ rt rn) (CASordB rs rt rn true  true))
+
+(defun CASH   (rs _ rt rn) (CASordH rs rt rn false false))
+(defun CASAH  (rs _ rt rn) (CASordH rs rt rn true  false))
+(defun CASLH  (rs _ rt rn) (CASordH rs rt rn false true))
+(defun CASALH (rs _ rt rn) (CASordH rs rt rn true  true))
+
+
+(defmacro CSop*r (set op rd rn rm cnd)
+  "(CSop*r set op rd rn rm cnd) implements the conditional select
+   instruction on W or X registers, with op being applied to rm
+   when cnd is false."
+  (if (condition-holds cnd)
+    (set rd rn)
+    (set rd (op rm))))
+
+(defun id (arg) "identity function" (declare (visibility :private)) arg)
+
+(defun CSELWr  (rd rn rm cnd) (CSop*r setw id   rd rn rm cnd))
+(defun CSELXr  (rd rn rm cnd) (CSop*r set$ id   rd rn rm cnd))
+(defun CSINCWr (rd rn rm cnd) (CSop*r setw +1   rd rn rm cnd))
+(defun CSINCXr (rd rn rm cnd) (CSop*r set$ +1   rd rn rm cnd))
+(defun CSINVWr (rd rn rm cnd) (CSop*r setw lnot rd rn rm cnd))
+(defun CSINVXr (rd rn rm cnd) (CSop*r set$ lnot rd rn rm cnd))
+(defun CSNEGWr (rd rn rm cnd) (CSop*r setw neg  rd rn rm cnd))  ;; 2's complement negation
+(defun CSNEGXr (rd rn rm cnd) (CSop*r set$ neg  rd rn rm cnd))  ;; 2's complement negation

plugins/arm/semantics/aarch64-branch.lisp

@@ -0,0 +1,51 @@
+(declare (context (target arm armv8-a+le)))
+
+(in-package aarch64)
+
+;;; BRANCH INSTRUCTIONS
+
+(defun relative-jump (off)
+  (exec-addr (+ (get-program-counter) (lshift off 2))))
+
+(defun B (off)
+  (relative-jump off))
+
+(defun Bcc (cnd off)
+  (when (condition-holds cnd)
+    (relative-jump off)))
+
+(defun BL (off)
+  (set LR (+ (get-program-counter) 4))
+  (relative-jump off))
+
+(defun BLR (reg)
+  (set LR (+ (get-program-counter) 4))
+  (exec-addr reg))
+
+(defun BR (reg)
+  (exec-addr reg))
+
+(defmacro CB** (comparison reg off)
+  "(CB** comparison reg off) implements CBZ and CBNZ by specifying
+   the comparison (is-zero or non-zero)."
+  (when (comparison reg)
+    (relative-jump off)))
+
+(defun CBZW  (reg off) (CB** is-zero  reg off))
+(defun CBZX  (reg off) (CB** is-zero  reg off))
+(defun CBNZW (reg off) (CB** non-zero reg off))
+(defun CBNZX (reg off) (CB** non-zero reg off))
+
+(defun RET (dst)
+  (exec-addr dst))
+
+(defmacro TB** (comparison reg pos off)
+  "(TB** comparison reg pos off) implements TBZ and TBNZ
+   by specifying the comparison (is-zero or non-zero)."
+  (when (comparison (select pos reg))
+    (relative-jump off)))
+
+(defun TBZW  (reg pos off) (TB** is-zero  reg pos off))
+(defun TBZX  (reg pos off) (TB** is-zero  reg pos off))
+(defun TBNZW (reg pos off) (TB** non-zero reg pos off))
+(defun TBNZX (reg pos off) (TB** non-zero reg pos off))

plugins/arm/semantics/aarch64-data-movement.lisp

@@ -0,0 +1,101 @@
+(declare (context (target arm armv8-a+le)))
+
+(in-package aarch64)
+
+;;; LOADS, MOVES, STORES
+
+;; LD...
+
+(defun LDRXui (dst reg off)
+  (set$ dst (load-word (+ reg (lshift off 3)))))
+
+(defun LDRSWui (dst base off)
+  (set$ dst (cast-signed
+             (word)
+             (load-hword (+ base (lshift off 2))))))
+
+(defun LDRWui (dst reg off)
+  (setw dst
+        (cast-unsigned (word) (load-hword (+ reg (lshift off 2))))))
+
+(defun LDRBBui (dst reg off)
+  (setw dst
+        (cast-unsigned (word) (load-byte (+ reg off)))))
+
+(defun LDRBBroX (dst reg off _ _)
+  (set$ dst
+        (cast-unsigned (word) (load-byte (+ reg off)))))
+
+(defun LDPXpost (dst r1 r2 base off)
+  (let ((off (lshift off 3)))
+    (set$ r1 (load-word base))
+    (set$ r2 (load-word (+ base (sizeof word))))
+    (set$ dst (+ dst off))))
+
+(defun LDPXi (r1 r2 base off)
+  (let ((off (lshift off 3)))
+    (set$ r1 (load-word (+ base off)))
+    (set$ r2 (load-word (+ base off (sizeof word))))))
+
+(defun LDRXroX (rt rn rm _ shift)
+  (set$ rt (load-word (+ rn (lshift rm (* shift 3))))))
+
+;; MOV...
+
+(defmacro MOVZ*i (set dst imm off)
+  (set dst (lshift imm off)))
+
+(defun MOVZWi (dst imm off) (MOVZ*i setw dst imm off))
+(defun MOVZXi (dst imm off) (MOVZ*i set$ dst imm off))
+
+(defmacro MOVN*i (set dst imm off)
+  (set dst (lnot (lshift imm off))))
+
+(defun MOVNWi (dst imm off) (MOVN*i setw dst imm off))
+(defun MOVNXi (dst imm off) (MOVN*i set$ dst imm off))
+
+(defmacro MOVK*i (dst reg imm off)
+  (let ((mask (lnot (lshift (- (lshift 1 16) 1) off))))
+    (set$ dst (logor (logand reg mask) (lshift imm off)))))
+
+(defun MOVKWi (dst reg imm off) (MOVK*i dst reg imm off))
+(defun MOVKXi (dst reg imm off) (MOVK*i dst reg imm off))
+
+;; ST...
+
+(defun STRBBui (src reg off)
+  (store-byte (+ reg off) src))
+
+(defun STPXpre (dst t1 t2 _ off)
+  (let ((off (lshift off 3)))
+    (store-word (+ dst off) t1)
+    (store-word (+ dst off (sizeof word)) t2)
+    (set$ dst (+ dst off))))
+
+(defun STPXi (t1 t2 base off)
+  (let ((off (lshift off 4)))
+    (store-word base (+ base off))
+    (store-word base (+ base off (sizeof word)))))
+
+(defun STRXui (src reg off)
+  (let ((off (lshift off 3)))
+    (store-word (+ reg off) src)))
+
+(defun STRWui (src reg off)
+  (let ((off (lshift off 2)))
+    (store-word (+ reg off) (cast-low 32 src))))
+
+(defun STRXroX (rt rn rm _ shift)
+  (store-word (+ rn (lshift rm (* shift 3))) rt))
+
+(defmacro STUR*i (src base off size)
+  "Takes `size` bits from src and stores at base + off"
+  (store-word (+ base off) (cast-low size src)))
+
+(defun STURXi  (src base off) (STUR*i src base off 64))
+
+(defun STURWi  (src base off) (STUR*i src base off 32))
+
+(defun STURHHi  (src base off) (STUR*i src base off 16))
+
+(defun STURBBi (src base off) (STUR*i src base off 8))