From 7278902d436f9abf4aa6c400d1442c43419dccad Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Fri, 4 Feb 2022 01:53:53 +0000 Subject: [PATCH 001/132] Add some bitvector functions and assert-msg macro --- plugins/primus_lisp/lisp/init.lisp | 6 +++ plugins/primus_lisp/semantics/bits.lisp | 66 ++++++++++++++++++++++++- 2 files changed, 71 insertions(+), 1 deletion(-) diff --git a/plugins/primus_lisp/lisp/init.lisp b/plugins/primus_lisp/lisp/init.lisp index 6654a233a..7ddc86ea7 100644 --- a/plugins/primus_lisp/lisp/init.lisp +++ b/plugins/primus_lisp/lisp/init.lisp @@ -139,6 +139,12 @@ (msg "Assertion (assert $0) failed" c) (error "Assert_failure"))) +(defmacro assert-msg (c s) + "(assert-msg c s) allows you to assert a condition and print a message on failure" + (when (not c) + (msg s) + (error "Assert_failure"))) + (defmacro is-in (x y) "(is-in X A B C ...) returns true if X is equal A or B or C or ..." (= x y)) diff --git a/plugins/primus_lisp/semantics/bits.lisp b/plugins/primus_lisp/semantics/bits.lisp index fae27f2e9..5be82d6bf 100644 --- a/plugins/primus_lisp/semantics/bits.lisp +++ b/plugins/primus_lisp/semantics/bits.lisp @@ -15,9 +15,73 @@ (logand (msb rm) (lnot (msb rd))) (logand (msb rn) (lnot (msb rd))))) - (defun overflow (rd rn rm) "(overflow RD RN RM) is true if the sum RD = RN + RM results in two's complement overflow." (logor (logand (msb rn) (msb rm) (lnot (msb rd))) (logand (lnot (msb rn)) (lnot (msb rm)) (msb rd)))) + +(defun highest-set-bit (bitv) + "(highest-set-bit bitv) returns the greatest index whose bit is set in bitv. + It requires bitv to be non-zero. + Translated from ARMv8 ISA pseudocode." + (assert-msg (not (is-zero bitv)) "highest-set-bit bitv is zero") ; at least 1 bit must be set + (let ((i (- (word-width bitv) 1))) + (while (and (> i 0) (= (select i bitv) 0)) + (decr i)) + i)) + +(defun replicate (bitv n) + "(replicate bitv n) returns a bitvector with bitv repeated n times. + Translated from ARMv8 ISA pseudocode." + (let ((output 0:0)) + (while (> n 0) + (decr n) + (set output (concat output bitv))) + output)) + +(defun replicate-to-fill (bitv n) + "(replicate-to-fill bitv n) returns the result of repeating bitv + to a total of n bits. Requires that n is a multiple of bitv's length. + Modified from the bits(N) Replicate(bits(M) x) function from + ARMv8 ISA pseudocode." + (let ((bitv-length (word-width bitv))) + (assert-msg (= 0 (mod n bitv-length)) "replicate-to-fill n not multiple of len(bitv)") + (replicate bitv (/ n bitv-length)))) + +(defun zeros (n) + "(zeros n) returns an empty bitvector of length n." + 0:n) + +(defun ones (n) + "(ones n) returns a bitvector of length n with all bits set." + (lnot (zeros n))) + +(defun zero-extend (bitv result-length) + "(zero-extend bitv result-length) returns a bitvector of + length result-length formed by prepending bitv with zeros. + Translated from ARMv8 ISA pseudocode." + (let ((bitv-length (word-width bitv))) + (assert-msg (>= result-length bitv-length) "zero-extend len(bitv) > result-length") + (concat + (zeros (- result-length bitv-length)) + bitv))) + +(defun rotate-right (bitv n) + "(rotate-right bitv n) rotates bitv to the right by n positions. + Carry-out is ignored. + Modified from ARMv8 ISA pseudocode." + (if (= n 0) + bitv + (let ((bitv-length (word-width bitv)) + (m (mod n bitv-length))) + ; need to trim the result of logor. + (extract (- bitv-length 1) 0 + (logor + (rshift bitv m) + (lshift bitv (- bitv-length m))))))) + +(defun rotate-left (bitv n) + "TODO: implement rotate-left" + bitv + ) \ No newline at end of file From 86ed4d4ee4560817e47d317859f1e6877bbc551f Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Fri, 4 Feb 2022 01:58:26 +0000 Subject: [PATCH 002/132] Add immediate decoding and logical immediate insns --- plugins/arm/semantics/aarch64.lisp | 30 ++++++++++++++++--------- plugins/arm/semantics/arm-bits.lisp | 35 +++++++++++++++++++++++++++++ 2 files changed, 54 insertions(+), 11 deletions(-) diff --git a/plugins/arm/semantics/aarch64.lisp b/plugins/arm/semantics/aarch64.lisp index 90978c302..8c0ad37bf 100644 --- a/plugins/arm/semantics/aarch64.lisp +++ b/plugins/arm/semantics/aarch64.lisp @@ -79,19 +79,27 @@ (defun ORNWrs (rd rn rm is) (ORN*rs setw rd rn rm is)) (defun ORNXrs (rd rn rm is) (ORN*rs set$ rd rn rm is)) -(defmacro log*?rs (set op rd rn rm is) +(defmacro log*rs (set op rd rn rm is) (set rd (op rn (shifted rm is)))) -(defun ORRWrs (rd rn rm is) (log*?rs setw logor rd rn rm is)) -(defun EORWrs (rd rn rm is) (log*?rs setw logxor rd rn rm is)) -(defun ANDWrs (rd rn rm is) (log*?rs setw logand rd rn rm is)) -(defun ORRXrs (rd rn rm is) (log*?rs set$ logor rd rn rm is)) -(defun EORXrs (rd rn rm is) (log*?rs set$ logxor rd rn rm is)) -(defun ANDXrs (rd rn rm is) (log*?rs set$ logand rd rn rm is)) - - -(defun ANDWri (dst rn imm) - (setw dst (logand rn imm))) +(defun ORRWrs (rd rn rm is) (log*rs setw logor rd rn rm is)) +(defun EORWrs (rd rn rm is) (log*rs setw logxor rd rn rm is)) +(defun ANDWrs (rd rn rm is) (log*rs setw logand rd rn rm is)) +(defun ORRXrs (rd rn rm is) (log*rs set$ logor rd rn rm is)) +(defun EORXrs (rd rn rm is) (log*rs set$ logxor rd rn rm is)) +(defun ANDXrs (rd rn rm is) (log*rs set$ logand rd rn rm is)) + +(defmacro log*ri (set op rd rn imm) + "(log*ri set op rd rn imm) implements the logical operation instruction + accepting either a W or X register. op is the binary logical operation." + (set rd (op rn (immediate-from-bitmask imm)))) + +(defun ANDWri (rd rn imm) (log*ri setw logand rd rn imm)) +(defun ANDXri (rd rn imm) (log*ri set$ logand rd rn imm)) +(defun EORWri (rd rn imm) (log*ri setw logxor rd rn imm)) +(defun EORXri (rd rn imm) (log*ri set$ logxor rd rn imm)) +(defun ORRWri (rd rn imm) (log*ri setw logor rd rn imm)) +(defun ORRXri (rd rn imm) (log*ri set$ logor rd rn imm)) (defun ADRP (dst imm) diff --git a/plugins/arm/semantics/arm-bits.lisp b/plugins/arm/semantics/arm-bits.lisp index 4a1bcec9d..1c1a3b992 100644 --- a/plugins/arm/semantics/arm-bits.lisp +++ b/plugins/arm/semantics/arm-bits.lisp @@ -68,3 +68,38 @@ (let ((res val)) (clear-base reg) (set$ reg res))) + +(defun decode-bit-masks (immN imms immr immediate) + "(decode-bit-masks immN imms immr immediate) returns the immediate value + corresponding to the immN:immr:imms bit pattern within opcodes of + ARMv8 logical operation instructions like AND, ORR etc. + I'm not sure what the immediate parameter does, but it's nearly always + called with true. + Modified from ARMv8 ISA pseudocode." + (let ((memory-width 64) ; change to 32 if 32-bit system + (len (highest-set-bit (concat immN (lnot imms)))) + (levels (zero-extend (ones len) 6)) + (S (logand imms levels)) + (R (logand immr levels)) + (diff (- S R))) ; assuming "6-bit subtract with borrow" is regular 2'c subtraction + (assert-msg (>= len 1) "decode-bit-masks len < 1") + (assert-msg (not (and immediate (= levels (logand imms levels)))) "decode-bit-masks long condition") + (let ((esize (lshift 1 len)) + (d (extract (- len 1) 0 diff)) + (welem (zero-extend (ones (+ S 1)) esize)) + (telem (zero-extend (ones (+ d 1)) esize)) + (wmask (replicate-to-fill (rotate-right welem R) memory-width)) + (tmask (replicate-to-fill telem memory-width))) + ; it seems like wmask is for logical immediates, and tmask is not used + ; anywhere in the ISA except for the BFM instruction and its aliases. + ; we're just returning wmask here. + ; TODO: can we return tuples in Primus Lisp? + wmask))) + +(defun immediate-from-bitmask (mask) + "(immediate-from-bitmask mask) returns the immediate value corresponding to + the given 13-bit mask in the form of N:immr:imms." + (let ((N (select 12 mask)) + (immr (extract 11 6 mask)) + (imms (extract 5 0 mask))) + (decode-bit-masks N imms immr true))) From 51ad92c3c25630e361334275812c17db1c6bd803 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Fri, 4 Feb 2022 01:59:24 +0000 Subject: [PATCH 003/132] Add barrier instructions via the special primitive --- plugins/arm/semantics/aarch64.lisp | 14 +++++++++++- plugins/arm/semantics/arm-bits.lisp | 35 +++++++++++++++++++++++++++++ 2 files changed, 48 insertions(+), 1 deletion(-) diff --git a/plugins/arm/semantics/aarch64.lisp b/plugins/arm/semantics/aarch64.lisp index 8c0ad37bf..8aacc8242 100644 --- a/plugins/arm/semantics/aarch64.lisp +++ b/plugins/arm/semantics/aarch64.lisp @@ -259,9 +259,21 @@ (when (condition-holds cnd) (relative-jump off))) + +(defun DMB (option) + (special (barrier-option-to-symbol :dmb option))) + +(defun DSB (option) + (special (barrier-option-to-symbol :dsb option))) + +(defun ISB (option) + ;; strictly speaking, only the sy option is valid and is + ;; the default option (it can be omitted from the mnemonic). + ;; still including option here though + (special (barrier-option-to-symbol :dmb option))) + (defun HINT (_) (empty)) - (defun UDF (exn) (special :undefined-instruction)) diff --git a/plugins/arm/semantics/arm-bits.lisp b/plugins/arm/semantics/arm-bits.lisp index 1c1a3b992..6179b86f4 100644 --- a/plugins/arm/semantics/arm-bits.lisp +++ b/plugins/arm/semantics/arm-bits.lisp @@ -103,3 +103,38 @@ (immr (extract 11 6 mask)) (imms (extract 5 0 mask))) (decode-bit-masks N imms immr true))) + +(defun barrier-option-to-symbol (barrier-type option) + (case barrier-type + :dmb + (case option + 0b1111 :barrier-dmb-sy + 0b1110 :barrier-dmb-st + 0b1101 :barrier-dmb-ld + 0b1011 :barrier-dmb-ish + 0b1010 :barrier-dmb-ishst + 0b1001 :barrier-dmb-ishld + 0b0111 :barrier-dmb-nsh + 0b0110 :barrier-dmb-nshst + 0b0101 :barrier-dmb-nshld + 0b0011 :barrier-dmb-osh + 0b0010 :barrier-dmb-oshst + 0b0001 :barrier-dmb-oshld + :barrier-dmb-unknown) + :dsb + (case option + 0b1111 :barrier-dsb-sy + 0b1110 :barrier-dsb-st + 0b1101 :barrier-dsb-ld + 0b1011 :barrier-dsb-ish + 0b1010 :barrier-dsb-ishst + 0b1001 :barrier-dsb-ishld + 0b0111 :barrier-dsb-nsh + 0b0110 :barrier-dsb-nshst + 0b0101 :barrier-dsb-nshld + 0b0011 :barrier-dsb-osh + 0b0010 :barrier-dsb-oshst + 0b0001 :barrier-dsb-oshld + :barrier-dsb-unknown) + :isb + :barrier-isb-sy)) From cf95551784e9c01493fecaf8e09e479cedb0f120 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Fri, 4 Feb 2022 02:03:02 +0000 Subject: [PATCH 004/132] add MADD, MSUB, SDIV, UDIV and conditional select --- plugins/arm/semantics/aarch64.lisp | 46 ++++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) diff --git a/plugins/arm/semantics/aarch64.lisp b/plugins/arm/semantics/aarch64.lisp index 8aacc8242..1ecec76fd 100644 --- a/plugins/arm/semantics/aarch64.lisp +++ b/plugins/arm/semantics/aarch64.lisp @@ -147,6 +147,33 @@ (defun ADDXrs (rd rn rm off) (set$ rd (+ rn (shifted rm off)))) + +(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)))) + +;; MUL*rr is alias of MADD*rrr and gets converted +(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)) +;; MNEG*rr is alias of MSUB*rrr and gets converted +(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)) + + (defun shifted (rm off) (declare (visibility :private)) (let ((typ (extract 7 6 off)) @@ -214,6 +241,25 @@ (set$ rt (load-word (+ rn (lshift rm (* shift 3)))))) +(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) (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 + (defun STRBBui (src reg off) (store-byte (+ reg off) src)) From d2199a846a756c14b61a5f5cdf47a7e768c29ea6 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Fri, 4 Feb 2022 03:24:20 +0000 Subject: [PATCH 005/132] Fix zeros and ones bitvector constructors --- plugins/primus_lisp/semantics/bits.lisp | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/plugins/primus_lisp/semantics/bits.lisp b/plugins/primus_lisp/semantics/bits.lisp index 5be82d6bf..86a5c613c 100644 --- a/plugins/primus_lisp/semantics/bits.lisp +++ b/plugins/primus_lisp/semantics/bits.lisp @@ -50,12 +50,14 @@ (replicate bitv (/ n bitv-length)))) (defun zeros (n) - "(zeros n) returns an empty bitvector of length n." - 0:n) + "(zeros n) returns an empty bitvector of length n. + Modified from ARMv8 ISA pseudocode." + (replicate 0:1 n)) (defun ones (n) - "(ones n) returns a bitvector of length n with all bits set." - (lnot (zeros n))) + "(ones n) returns a bitvector of length n with all bits set. + Modified from ARMv8 ISA pseudocode." + (replicate 1:1 n)) (defun zero-extend (bitv result-length) "(zero-extend bitv result-length) returns a bitvector of From 98b94c73ba77714db0777fac69eed1a567eaaf09 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Tue, 8 Feb 2022 05:22:46 +0000 Subject: [PATCH 006/132] organise instructions into categories --- plugins/arm/semantics/aarch64.lisp | 293 ++++++++++++++-------------- plugins/arm/semantics/arm-bits.lisp | 30 +++ 2 files changed, 172 insertions(+), 151 deletions(-) diff --git a/plugins/arm/semantics/aarch64.lisp b/plugins/arm/semantics/aarch64.lisp index 1ecec76fd..ac4046bc9 100644 --- a/plugins/arm/semantics/aarch64.lisp +++ b/plugins/arm/semantics/aarch64.lisp @@ -10,24 +10,13 @@ (defun word () (word-width)) -(defun MOVZXi (dst imm pos) - (set$ dst (lshift imm pos))) - -(defun MOVZWi (dst imm pos) - (setw dst (lshift imm pos))) - -(defun MOVNWi (dst imm off) - (setw dst (lnot (lshift imm off)))) +;; instructions are sorted by the categories defined here +;; https://github.com/UQ-PAC/bap/wiki/All-aarch64-Instructions-by-Category -(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)) +;;; LOADS, MOVES, STORES -(defun ADDXri (dst src imm off) - (set$ dst (+ src (lshift imm off)))) +;; LD... (defun LDRXui (dst reg off) (set$ dst (load-word (+ reg (lshift off 3))))) @@ -49,29 +38,74 @@ (set$ dst (cast-unsigned (word) (load-byte (+ reg off))))) -(defmacro make-BFM (set cast xd xr ir is) - (let ((rs (word))) - (if (< is ir) - (if (and (/= is (- rs 1)) (= (+ is 1) ir)) - (set xd (lshift xr (- rs ir))) - (set xd (lshift - (cast rs (extract is 0 xr)) - (- rs ir)))) - (if (= is (- rs 1)) - (set xd (rshift xr ir)) - (set xd (cast rs (extract is ir xr))))))) +(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 UBFMXri (xd xr ir is) - (make-BFM set$ cast-unsigned xd xr ir is)) +(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 UBFMWri (xd xr ir is) - (make-BFM setw cast-unsigned xd xr ir is)) +(defun LDRXroX (rt rn rm _ shift) + (set$ rt (load-word (+ rn (lshift rm (* shift 3)))))) -(defun SBFMXri (xd xr ir is) - (make-BFM set$ cast-signed xd xr ir is)) +;; MOV... -(defun SBFMWri (xd xr ir is) - (make-BFM setw cast-signed xd xr ir is)) +(defun MOVZXi (dst imm pos) + (set$ dst (lshift imm pos))) + +(defun MOVZWi (dst imm pos) + (setw dst (lshift imm pos))) + +(defun MOVNWi (dst imm off) + (setw dst (lnot (lshift 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)) + + +;;; LOGICAL/BITFIELD OPERATIONS + +;; Logical + +(defun ADRP (dst imm) + (set$ dst (+ + (logand (get-program-counter) (lshift -1 12)) + (cast-signed (word) (lshift imm 12))))) (defmacro ORN*rs (set rd rn rm is) (set rd (logor rn (lnot (lshift rm is))))) @@ -80,6 +114,8 @@ (defun ORNXrs (rd rn rm is) (ORN*rs set$ rd rn rm is)) (defmacro log*rs (set op rd rn rm is) + "(log*rs set op rd rn is) implements the logical operation (shift) instruction + accepting either a W or X register. op is the binary logical operation." (set rd (op rn (shifted rm is)))) (defun ORRWrs (rd rn rm is) (log*rs setw logor rd rn rm is)) @@ -90,7 +126,7 @@ (defun ANDXrs (rd rn rm is) (log*rs set$ logand rd rn rm is)) (defmacro log*ri (set op rd rn imm) - "(log*ri set op rd rn imm) implements the logical operation instruction + "(log*ri set op rd rn imm) implements the logical operation (immediate) instruction accepting either a W or X register. op is the binary logical operation." (set rd (op rn (immediate-from-bitmask imm)))) @@ -101,66 +137,86 @@ (defun ORRWri (rd rn imm) (log*ri setw logor rd rn imm)) (defun ORRXri (rd rn imm) (log*ri set$ logor rd rn imm)) +;; UBFM and SBFM -(defun ADRP (dst imm) - (set$ dst (+ - (logand (get-program-counter) (lshift -1 12)) - (cast-signed (word) (lshift imm 12))))) +(defmacro make-BFM (set cast xd xr ir is) + (let ((rs (word))) + (if (< is ir) + (if (and (/= is (- rs 1)) (= (+ is 1) ir)) + (set xd (lshift xr (- rs ir))) + (set xd (lshift + (cast rs (extract is 0 xr)) + (- rs ir)))) + (if (= is (- rs 1)) + (set xd (rshift xr ir)) + (set xd (cast rs (extract is ir xr))))))) + +(defun UBFMXri (xd xr ir is) + (make-BFM set$ cast-unsigned xd xr ir is)) + +(defun UBFMWri (xd xr ir is) + (make-BFM setw cast-unsigned xd xr ir is)) + +(defun SBFMXri (xd xr ir is) + (make-BFM set$ cast-signed xd xr ir is)) + +(defun SBFMWri (xd xr ir is) + (make-BFM setw cast-signed xd xr ir is)) + + +;;; INTEGER ARITHMETIC + +(defun ADDWri (dst r1 imm s) + (setw dst (+ r1 (lshift imm s)))) + +(defun ADDXri (dst src imm off) + (set$ dst (+ src (lshift imm off)))) (defun ADDWrs (dst r1 v s) (setw dst (+ r1 (lshift v s)))) +(defun ADDXrs (rd rn rm off) + (set$ rd (+ rn (shifted rm off)))) + (defun SUBWrs (dst r1 v s) (setw dst (- r1 (lshift v s)))) -(defun ADDWri (dst r1 imm s) - (setw dst (+ r1 (lshift imm s)))) +(defun SUBXrs (rd rn rm off) + (set$ rd (- rn (shifted rm off)))) +(defun SUBWri (rd rn imm off) + (setw rd (- rn (lshift imm off)))) + +(defun SUBXri (rd rn imm off) + (set$ rd (- rn (lshift imm off)))) (defun SUBXrx64 (rd rn rm off) (set$ rd (- rn (extended rm off)))) -(defun SUBSXrs (rd rn rm off) - (add-with-carry rd rn (lnot (shifted rm off)) 1)) - (defun SUBSWrs (rd rn rm off) (add-with-carry/clear-base rd rn (lnot (shifted rm off)) 1)) +(defun SUBSXrs (rd rn rm off) + (add-with-carry rd rn (lnot (shifted 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)) -(defun SUBXrs (rd rn rm off) - (set$ rd (- rn (shifted rm off)))) - -(defun SUBXri (rd rn imm off) - (set$ rd (- rn (lshift imm off)))) - -(defun SUBWri (rd rn imm off) - (setw rd (- rn (lshift imm off)))) - -(defun ADDXrs (rd rn rm off) - (set$ rd (+ rn (shifted rm off)))) - - (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)))) -;; MUL*rr is alias of MADD*rrr and gets converted (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)) -;; MNEG*rr is alias of MSUB*rrr and gets converted (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." @@ -174,95 +230,7 @@ (defun UDIVXr (rd rn rm) (*DIV*r set$ / rd rn rm)) -(defun shifted (rm off) - (declare (visibility :private)) - (let ((typ (extract 7 6 off)) - (off (extract 5 0 off))) - (case typ - 0b00 (lshift rm off) - 0b01 (rshift rm off) - 0b10 (arshift rm off)))) - -(defun unsigned-extend (n rm) - (cast-unsigned (word) (cast-low n rm))) - -(defun signed-extend (n rm) - (cast-signed (word) (cast-low n rm))) - -(defun extended (rm bits) - (declare (visibility :private)) - (let ((typ (extract 5 3 bits)) - (off (extract 2 0 bits))) - (lshift (case typ - 0b000 (unsigned-extend 8 rm) - 0b001 (unsigned-extend 16 rm) - 0b010 (unsigned-extend 32 rm) - 0b011 rm - 0b100 (signed-extend 8 rm) - 0b101 (signed-extend 16 rm) - 0b110 (signed-extend 32 rm) - 0b111 rm) - off))) - -(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 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 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)) - -(defun LDRXroX (rt rn rm _ shift) - (set$ rt (load-word (+ rn (lshift rm (* shift 3)))))) - - -(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) (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 - - -(defun STRBBui (src reg off) - (store-byte (+ reg off) src)) +;;; BRANCH INSTRUCTIONS (defun relative-jump (off) (exec-addr (+ (get-program-counter) (lshift off 2)))) @@ -281,7 +249,6 @@ (defun B (off) (relative-jump off)) - (defun RET (dst) (exec-addr dst)) @@ -306,6 +273,30 @@ (relative-jump off))) +;;; OTHER ATOMIC OPERATIONS + +(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 + + +;;; SPECIAL INSTRUCTIONS + (defun DMB (option) (special (barrier-option-to-symbol :dmb option))) diff --git a/plugins/arm/semantics/arm-bits.lisp b/plugins/arm/semantics/arm-bits.lisp index 6179b86f4..1d51f1b73 100644 --- a/plugins/arm/semantics/arm-bits.lisp +++ b/plugins/arm/semantics/arm-bits.lisp @@ -69,6 +69,36 @@ (clear-base reg) (set$ reg res))) +(defun shifted (rm off) + (declare (visibility :private)) + (let ((typ (extract 7 6 off)) + (off (extract 5 0 off))) + (case typ + 0b00 (lshift rm off) + 0b01 (rshift rm off) + 0b10 (arshift rm off)))) + +(defun unsigned-extend (n rm) + (cast-unsigned (word) (cast-low n rm))) + +(defun signed-extend (n rm) + (cast-signed (word) (cast-low n rm))) + +(defun extended (rm bits) + (declare (visibility :private)) + (let ((typ (extract 5 3 bits)) + (off (extract 2 0 bits))) + (lshift (case typ + 0b000 (unsigned-extend 8 rm) + 0b001 (unsigned-extend 16 rm) + 0b010 (unsigned-extend 32 rm) + 0b011 rm + 0b100 (signed-extend 8 rm) + 0b101 (signed-extend 16 rm) + 0b110 (signed-extend 32 rm) + 0b111 rm) + off))) + (defun decode-bit-masks (immN imms immr immediate) "(decode-bit-masks immN imms immr immediate) returns the immediate value corresponding to the immN:immr:imms bit pattern within opcodes of From 7abc695cdc35b67d9426806bf6220a19f325a10d Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Tue, 8 Feb 2022 05:37:52 +0000 Subject: [PATCH 007/132] move ADRP to integer arithmetic category --- plugins/arm/semantics/aarch64.lisp | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/plugins/arm/semantics/aarch64.lisp b/plugins/arm/semantics/aarch64.lisp index ac4046bc9..e91d71641 100644 --- a/plugins/arm/semantics/aarch64.lisp +++ b/plugins/arm/semantics/aarch64.lisp @@ -102,11 +102,6 @@ ;; Logical -(defun ADRP (dst imm) - (set$ dst (+ - (logand (get-program-counter) (lshift -1 12)) - (cast-signed (word) (lshift imm 12))))) - (defmacro ORN*rs (set rd rn rm is) (set rd (logor rn (lnot (lshift rm is))))) @@ -178,6 +173,11 @@ (defun ADDXrs (rd rn rm off) (set$ rd (+ rn (shifted rm off)))) +(defun ADRP (dst imm) + (set$ dst (+ + (logand (get-program-counter) (lshift -1 12)) + (cast-signed (word) (lshift imm 12))))) + (defun SUBWrs (dst r1 v s) (setw dst (- r1 (lshift v s)))) From 5d42b6dfc3d99f6864cb4360d8505796a8edd254 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Tue, 8 Feb 2022 08:48:14 +0000 Subject: [PATCH 008/132] remove private access from arm-bits functions --- plugins/arm/semantics/arm-bits.lisp | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/plugins/arm/semantics/arm-bits.lisp b/plugins/arm/semantics/arm-bits.lisp index 1d51f1b73..2c1e956f7 100644 --- a/plugins/arm/semantics/arm-bits.lisp +++ b/plugins/arm/semantics/arm-bits.lisp @@ -70,22 +70,22 @@ (set$ reg res))) (defun shifted (rm off) - (declare (visibility :private)) (let ((typ (extract 7 6 off)) (off (extract 5 0 off))) (case typ 0b00 (lshift rm off) 0b01 (rshift rm off) - 0b10 (arshift rm off)))) + 0b10 (arshift rm off) + ;; TODO: 0b11 ror? + ))) (defun unsigned-extend (n rm) - (cast-unsigned (word) (cast-low n rm))) + (cast-unsigned (word-width) (cast-low n rm))) (defun signed-extend (n rm) - (cast-signed (word) (cast-low n rm))) + (cast-signed (word-width) (cast-low n rm))) (defun extended (rm bits) - (declare (visibility :private)) (let ((typ (extract 5 3 bits)) (off (extract 2 0 bits))) (lshift (case typ From 7d6df061d4cd27bbb3cebad6b74202538a0b77b3 Mon Sep 17 00:00:00 2001 From: Tom Malcolm Date: Tue, 8 Feb 2022 12:12:54 +0000 Subject: [PATCH 009/132] Added stur instructions and fixed bug in `condition-holds` macro --- plugins/arm/semantics/aarch64.lisp | 11 +++++++++++ plugins/arm/semantics/arm-bits.lisp | 2 +- 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/plugins/arm/semantics/aarch64.lisp b/plugins/arm/semantics/aarch64.lisp index e91d71641..7838647ce 100644 --- a/plugins/arm/semantics/aarch64.lisp +++ b/plugins/arm/semantics/aarch64.lisp @@ -97,6 +97,17 @@ (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 (+ 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 STURHi (src base off) (STUR*i src base off 16)) + +(defun STURBBi (src base off) (STUR*i src base off 8))) ;;; LOGICAL/BITFIELD OPERATIONS diff --git a/plugins/arm/semantics/arm-bits.lisp b/plugins/arm/semantics/arm-bits.lisp index 2c1e956f7..867f5f6eb 100644 --- a/plugins/arm/semantics/arm-bits.lisp +++ b/plugins/arm/semantics/arm-bits.lisp @@ -44,7 +44,7 @@ 0b0000 ZF 0b0001 (lnot ZF) 0b0010 CF - 0b0010 (lnot CF) + 0b0011 (lnot CF) 0b0100 NF 0b0101 (lnot NF) 0b0110 VF From 3286a9d4b07fcdfd4d65898b903ecf469a964184 Mon Sep 17 00:00:00 2001 From: Tom Malcolm Date: Tue, 8 Feb 2022 12:31:54 +0000 Subject: [PATCH 010/132] Bug fixes for STUR insns --- plugins/arm/semantics/aarch64.lisp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/plugins/arm/semantics/aarch64.lisp b/plugins/arm/semantics/aarch64.lisp index 7838647ce..ab5879805 100644 --- a/plugins/arm/semantics/aarch64.lisp +++ b/plugins/arm/semantics/aarch64.lisp @@ -99,15 +99,15 @@ (defmacro STUR*i (src base off size) "Takes `size` bits from src and stores at base + off" - (store-word base (+ base off) (cast-low size src))) + (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 STURHi (src base off) (STUR*i src base off 16)) +(defun STURHHi (src base off) (STUR*i src base off 16)) -(defun STURBBi (src base off) (STUR*i src base off 8))) +(defun STURBBi (src base off) (STUR*i src base off 8)) ;;; LOGICAL/BITFIELD OPERATIONS From 42b9e44eb1b046f3a9085537949724beecaa5520 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Wed, 9 Feb 2022 00:42:52 +0000 Subject: [PATCH 011/132] condense repeated definitions into macros --- plugins/arm/semantics/aarch64.lisp | 101 ++++++++++++++--------------- 1 file changed, 47 insertions(+), 54 deletions(-) diff --git a/plugins/arm/semantics/aarch64.lisp b/plugins/arm/semantics/aarch64.lisp index e91d71641..3d37a42c0 100644 --- a/plugins/arm/semantics/aarch64.lisp +++ b/plugins/arm/semantics/aarch64.lisp @@ -54,14 +54,17 @@ ;; MOV... -(defun MOVZXi (dst imm pos) - (set$ dst (lshift imm pos))) +(defmacro MOVZ*i (set dst imm off) + (set dst (lshift imm off))) -(defun MOVZWi (dst imm pos) - (setw dst (lshift imm pos))) +(defun MOVZWi (dst imm off) (MOVZ*i setw dst imm off)) +(defun MOVZXi (dst imm off) (MOVZ*i set$ dst imm off)) -(defun MOVNWi (dst imm off) - (setw dst (lnot (lshift 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)))) @@ -161,42 +164,38 @@ ;;; INTEGER ARITHMETIC -(defun ADDWri (dst r1 imm s) - (setw dst (+ r1 (lshift imm s)))) - -(defun ADDXri (dst src imm off) - (set$ dst (+ src (lshift imm off)))) - -(defun ADDWrs (dst r1 v s) - (setw dst (+ r1 (lshift v s)))) +(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)))) -(defun ADDXrs (rd rn rm off) - (set$ rd (+ rn (shifted 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)) +;; shifted decodes the shift type and shifts +(defun ADDWrs (rd rn rm off) (ADD*r* setw shifted rd rn rm off)) +(defun ADDXrs (rd rn rm off) (ADD*r* set$ shifted rd rn rm off)) (defun ADRP (dst imm) (set$ dst (+ (logand (get-program-counter) (lshift -1 12)) (cast-signed (word) (lshift imm 12))))) -(defun SUBWrs (dst r1 v s) - (setw dst (- r1 (lshift v s)))) - -(defun SUBXrs (rd rn rm off) - (set$ rd (- rn (shifted rm off)))) - -(defun SUBWri (rd rn imm off) - (setw rd (- rn (lshift imm off)))) +(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)))) -(defun SUBXri (rd rn imm off) - (set$ rd (- rn (lshift imm 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 shifted rd rn rm off)) +(defun SUBXrs (rd rn rm off) (SUB*r* set$ shifted 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 (shifted rm off)) 1)) + (add-with-carry/clear-base rd rn (lnot (shifted rm off)) 1)) (defun SUBSXrs (rd rn rm off) (add-with-carry rd rn (lnot (shifted rm off)) 1)) @@ -235,43 +234,37 @@ (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 BR (reg) - (exec-addr reg)) - (defun BLR (reg) (set LR (+ (get-program-counter) 4)) (exec-addr reg)) -(defun B (off) - (relative-jump off)) - -(defun RET (dst) - (exec-addr dst)) - -(defun CBZX (reg off) - (when (is-zero reg) - (relative-jump off))) - -(defun CBZW (reg off) - (when (is-zero reg) - (relative-jump off))) - -(defun CBNZX (reg off) - (when (/= reg 0) - (relative-jump off))) +(defun BR (reg) + (exec-addr reg)) -(defun CBNZW (reg off) - (when (/= reg 0) +(defmacro CB** (comparison reg off) + "(CB** cnd reg off) implements CBZ and CBNZ by specifying + the comparison (is-zero or non-zero)." + (when (comparison reg) (relative-jump off))) -(defun Bcc (cnd off) - (when (condition-holds cnd) - (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)) ;;; OTHER ATOMIC OPERATIONS From be91fcdbeda92f3ff0abca9b5132fd7e68eb923a Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Wed, 9 Feb 2022 01:14:04 +0000 Subject: [PATCH 012/132] implement TBZ and TBNZ --- plugins/arm/semantics/aarch64.lisp | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/plugins/arm/semantics/aarch64.lisp b/plugins/arm/semantics/aarch64.lisp index f328faf83..45322e9dc 100644 --- a/plugins/arm/semantics/aarch64.lisp +++ b/plugins/arm/semantics/aarch64.lisp @@ -264,7 +264,7 @@ (exec-addr reg)) (defmacro CB** (comparison reg off) - "(CB** cnd reg off) implements CBZ and CBNZ by specifying + "(CB** comparison reg off) implements CBZ and CBNZ by specifying the comparison (is-zero or non-zero)." (when (comparison reg) (relative-jump off))) @@ -277,6 +277,18 @@ (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)) + + ;;; OTHER ATOMIC OPERATIONS (defmacro CSop*r (set op rd rn rm cnd) From 2e379cad15cbad027162f1a1b2faf718a3e36f7e Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Wed, 9 Feb 2022 03:47:48 +0000 Subject: [PATCH 013/132] separated into files --- plugins/arm/semantics/aarch64.lisp | 327 +----------------- plugins/arm/semantics/arithmetic.lisp | 71 ++++ plugins/arm/semantics/atomic.lisp | 24 ++ plugins/arm/semantics/branch.lisp | 51 +++ plugins/arm/semantics/logical.lisp | 65 ++++ plugins/arm/semantics/register-movements.lisp | 102 ++++++ plugins/arm/semantics/special.lisp | 23 ++ 7 files changed, 346 insertions(+), 317 deletions(-) create mode 100644 plugins/arm/semantics/arithmetic.lisp create mode 100644 plugins/arm/semantics/atomic.lisp create mode 100644 plugins/arm/semantics/branch.lisp create mode 100644 plugins/arm/semantics/logical.lisp create mode 100644 plugins/arm/semantics/register-movements.lisp create mode 100644 plugins/arm/semantics/special.lisp diff --git a/plugins/arm/semantics/aarch64.lisp b/plugins/arm/semantics/aarch64.lisp index 45322e9dc..104448523 100644 --- a/plugins/arm/semantics/aarch64.lisp +++ b/plugins/arm/semantics/aarch64.lisp @@ -1,8 +1,18 @@ (declare (context (target arm armv8-a+le))) +;; helper functions (require bits) (require arm-bits) +;; implementations +(require arithmetic) +(require atomic) +(require branch) +(require logical) +(require register-movements) +(require special) + + (defpackage aarch64 (:use core target arm)) (defpackage llvm-aarch64 (:use aarch64)) @@ -13,320 +23,3 @@ ;; instructions are sorted by the categories defined here ;; https://github.com/UQ-PAC/bap/wiki/All-aarch64-Instructions-by-Category - -;;; 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)) - -;;; LOGICAL/BITFIELD OPERATIONS - -;; Logical - -(defmacro ORN*rs (set rd rn rm is) - (set rd (logor rn (lnot (lshift rm is))))) - -(defun ORNWrs (rd rn rm is) (ORN*rs setw rd rn rm is)) -(defun ORNXrs (rd rn rm is) (ORN*rs set$ rd rn rm is)) - -(defmacro log*rs (set op rd rn rm is) - "(log*rs set op rd rn is) implements the logical operation (shift) instruction - accepting either a W or X register. op is the binary logical operation." - (set rd (op rn (shifted rm is)))) - -(defun ORRWrs (rd rn rm is) (log*rs setw logor rd rn rm is)) -(defun EORWrs (rd rn rm is) (log*rs setw logxor rd rn rm is)) -(defun ANDWrs (rd rn rm is) (log*rs setw logand rd rn rm is)) -(defun ORRXrs (rd rn rm is) (log*rs set$ logor rd rn rm is)) -(defun EORXrs (rd rn rm is) (log*rs set$ logxor rd rn rm is)) -(defun ANDXrs (rd rn rm is) (log*rs set$ logand rd rn rm is)) - -(defmacro log*ri (set op rd rn imm) - "(log*ri set op rd rn imm) implements the logical operation (immediate) instruction - accepting either a W or X register. op is the binary logical operation." - (set rd (op rn (immediate-from-bitmask imm)))) - -(defun ANDWri (rd rn imm) (log*ri setw logand rd rn imm)) -(defun ANDXri (rd rn imm) (log*ri set$ logand rd rn imm)) -(defun EORWri (rd rn imm) (log*ri setw logxor rd rn imm)) -(defun EORXri (rd rn imm) (log*ri set$ logxor rd rn imm)) -(defun ORRWri (rd rn imm) (log*ri setw logor rd rn imm)) -(defun ORRXri (rd rn imm) (log*ri set$ logor rd rn imm)) - -;; UBFM and SBFM - -(defmacro make-BFM (set cast xd xr ir is) - (let ((rs (word))) - (if (< is ir) - (if (and (/= is (- rs 1)) (= (+ is 1) ir)) - (set xd (lshift xr (- rs ir))) - (set xd (lshift - (cast rs (extract is 0 xr)) - (- rs ir)))) - (if (= is (- rs 1)) - (set xd (rshift xr ir)) - (set xd (cast rs (extract is ir xr))))))) - -(defun UBFMXri (xd xr ir is) - (make-BFM set$ cast-unsigned xd xr ir is)) - -(defun UBFMWri (xd xr ir is) - (make-BFM setw cast-unsigned xd xr ir is)) - -(defun SBFMXri (xd xr ir is) - (make-BFM set$ cast-signed xd xr ir is)) - -(defun SBFMWri (xd xr ir is) - (make-BFM setw cast-signed xd xr ir is)) - - -;;; INTEGER ARITHMETIC - -(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)) -;; shifted decodes the shift type and shifts -(defun ADDWrs (rd rn rm off) (ADD*r* setw shifted rd rn rm off)) -(defun ADDXrs (rd rn rm off) (ADD*r* set$ shifted 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 shifted rd rn rm off)) -(defun SUBXrs (rd rn rm off) (SUB*r* set$ shifted 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 (shifted rm off)) 1)) - -(defun SUBSXrs (rd rn rm off) - (add-with-carry rd rn (lnot (shifted 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)) - - -;;; 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)) - - -;;; OTHER ATOMIC OPERATIONS - -(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 - - -;;; SPECIAL INSTRUCTIONS - -(defun DMB (option) - (special (barrier-option-to-symbol :dmb option))) - -(defun DSB (option) - (special (barrier-option-to-symbol :dsb option))) - -(defun ISB (option) - ;; strictly speaking, only the sy option is valid and is - ;; the default option (it can be omitted from the mnemonic). - ;; still including option here though - (special (barrier-option-to-symbol :dmb option))) - -(defun HINT (_) - (empty)) - -(defun UDF (exn) - (special :undefined-instruction)) diff --git a/plugins/arm/semantics/arithmetic.lisp b/plugins/arm/semantics/arithmetic.lisp new file mode 100644 index 000000000..d53d587f7 --- /dev/null +++ b/plugins/arm/semantics/arithmetic.lisp @@ -0,0 +1,71 @@ +(in-package aarch64) + +(require arm-bits) + +;;; ARITHMETIC OPERATIONS + +;; Addition + +(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)) +;; shifted decodes the shift type and shifts +(defun ADDWrs (rd rn rm off) (ADD*r* setw shifted rd rn rm off)) +(defun ADDXrs (rd rn rm off) (ADD*r* set$ shifted 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 shifted rd rn rm off)) +(defun SUBXrs (rd rn rm off) (SUB*r* set$ shifted 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 (shifted rm off)) 1)) + +(defun SUBSXrs (rd rn rm off) + (add-with-carry rd rn (lnot (shifted 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)) \ No newline at end of file diff --git a/plugins/arm/semantics/atomic.lisp b/plugins/arm/semantics/atomic.lisp new file mode 100644 index 000000000..0d788078d --- /dev/null +++ b/plugins/arm/semantics/atomic.lisp @@ -0,0 +1,24 @@ +(in-package aarch64) + +(require arm-bits) + +;;; ATOMIC OPERATIONS + +(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 \ No newline at end of file diff --git a/plugins/arm/semantics/branch.lisp b/plugins/arm/semantics/branch.lisp new file mode 100644 index 000000000..68f4ac542 --- /dev/null +++ b/plugins/arm/semantics/branch.lisp @@ -0,0 +1,51 @@ +(in-package aarch64) + +(require arm-bits) + +;;; 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)) \ No newline at end of file diff --git a/plugins/arm/semantics/logical.lisp b/plugins/arm/semantics/logical.lisp new file mode 100644 index 000000000..1c3839373 --- /dev/null +++ b/plugins/arm/semantics/logical.lisp @@ -0,0 +1,65 @@ +(in-package aarch64) + +(require bits) +(require arm-bits) + +;;; LOGICAL/BITFIELD OPERATIONS + +;; Logical + +(defmacro ORN*rs (set rd rn rm is) + (set rd (logor rn (lnot (lshift rm is))))) + +(defun ORNWrs (rd rn rm is) (ORN*rs setw rd rn rm is)) +(defun ORNXrs (rd rn rm is) (ORN*rs set$ rd rn rm is)) + +(defmacro log*rs (set op rd rn rm is) + "(log*rs set op rd rn is) implements the logical operation (shift) instruction + accepting either a W or X register. op is the binary logical operation." + (set rd (op rn (shifted rm is)))) + +(defun ORRWrs (rd rn rm is) (log*rs setw logor rd rn rm is)) +(defun EORWrs (rd rn rm is) (log*rs setw logxor rd rn rm is)) +(defun ANDWrs (rd rn rm is) (log*rs setw logand rd rn rm is)) +(defun ORRXrs (rd rn rm is) (log*rs set$ logor rd rn rm is)) +(defun EORXrs (rd rn rm is) (log*rs set$ logxor rd rn rm is)) +(defun ANDXrs (rd rn rm is) (log*rs set$ logand rd rn rm is)) + +(defmacro log*ri (set op rd rn imm) + "(log*ri set op rd rn imm) implements the logical operation (immediate) instruction + accepting either a W or X register. op is the binary logical operation." + (set rd (op rn (immediate-from-bitmask imm)))) + +(defun ANDWri (rd rn imm) (log*ri setw logand rd rn imm)) +(defun ANDXri (rd rn imm) (log*ri set$ logand rd rn imm)) +(defun EORWri (rd rn imm) (log*ri setw logxor rd rn imm)) +(defun EORXri (rd rn imm) (log*ri set$ logxor rd rn imm)) +(defun ORRWri (rd rn imm) (log*ri setw logor rd rn imm)) +(defun ORRXri (rd rn imm) (log*ri set$ logor rd rn imm)) + +;; UBFM and SBFM +;; (bitfield moves) + +(defmacro make-BFM (set cast xd xr ir is) + (let ((rs (word))) + (if (< is ir) + (if (and (/= is (- rs 1)) (= (+ is 1) ir)) + (set xd (lshift xr (- rs ir))) + (set xd (lshift + (cast rs (extract is 0 xr)) + (- rs ir)))) + (if (= is (- rs 1)) + (set xd (rshift xr ir)) + (set xd (cast rs (extract is ir xr))))))) + +(defun UBFMXri (xd xr ir is) + (make-BFM set$ cast-unsigned xd xr ir is)) + +(defun UBFMWri (xd xr ir is) + (make-BFM setw cast-unsigned xd xr ir is)) + +(defun SBFMXri (xd xr ir is) + (make-BFM set$ cast-signed xd xr ir is)) + +(defun SBFMWri (xd xr ir is) + (make-BFM setw cast-signed xd xr ir is)) \ No newline at end of file diff --git a/plugins/arm/semantics/register-movements.lisp b/plugins/arm/semantics/register-movements.lisp new file mode 100644 index 000000000..8f7ba27ff --- /dev/null +++ b/plugins/arm/semantics/register-movements.lisp @@ -0,0 +1,102 @@ +(in-package aarch64) + +(require bits) +(require arm-bits) + +;;; 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)) diff --git a/plugins/arm/semantics/special.lisp b/plugins/arm/semantics/special.lisp new file mode 100644 index 000000000..7663cf97c --- /dev/null +++ b/plugins/arm/semantics/special.lisp @@ -0,0 +1,23 @@ +(in-package aarch64) + +(require arm-bits) + +;;; SPECIAL INSTRUCTIONS + +(defun DMB (option) + (special (barrier-option-to-symbol :dmb option))) + +(defun DSB (option) + (special (barrier-option-to-symbol :dsb option))) + +(defun ISB (option) + ;; strictly speaking, only the sy option is valid and is + ;; the default option (it can be omitted from the mnemonic). + ;; still including option here though + (special (barrier-option-to-symbol :dmb option))) + +(defun HINT (_) + (empty)) + +(defun UDF (exn) + (special :undefined-instruction)) \ No newline at end of file From 522bb949b4f02808fec8576d863b35bbb82e2223 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Wed, 9 Feb 2022 08:45:21 +0000 Subject: [PATCH 014/132] rename aarch64 files and make aarch64-helper --- ...rithmetic.lisp => aarch64-arithmetic.lisp} | 8 +- .../{atomic.lisp => aarch64-atomic.lisp} | 4 +- .../{branch.lisp => aarch64-branch.lisp} | 4 +- ...ements.lisp => aarch64-data-movement.lisp} | 5 +- plugins/arm/semantics/aarch64-helper.lisp | 116 ++++++++++++++++++ .../{logical.lisp => aarch64-logical.lisp} | 5 +- .../{special.lisp => aarch64-special.lisp} | 4 +- plugins/arm/semantics/aarch64.lisp | 25 ++-- plugins/arm/semantics/arm-bits.lisp | 100 --------------- 9 files changed, 139 insertions(+), 132 deletions(-) rename plugins/arm/semantics/{arithmetic.lisp => aarch64-arithmetic.lisp} (97%) rename plugins/arm/semantics/{atomic.lisp => aarch64-atomic.lisp} (95%) rename plugins/arm/semantics/{branch.lisp => aarch64-branch.lisp} (96%) rename plugins/arm/semantics/{register-movements.lisp => aarch64-data-movement.lisp} (98%) create mode 100644 plugins/arm/semantics/aarch64-helper.lisp rename plugins/arm/semantics/{logical.lisp => aarch64-logical.lisp} (98%) rename plugins/arm/semantics/{special.lisp => aarch64-special.lisp} (92%) diff --git a/plugins/arm/semantics/arithmetic.lisp b/plugins/arm/semantics/aarch64-arithmetic.lisp similarity index 97% rename from plugins/arm/semantics/arithmetic.lisp rename to plugins/arm/semantics/aarch64-arithmetic.lisp index d53d587f7..202c480c5 100644 --- a/plugins/arm/semantics/arithmetic.lisp +++ b/plugins/arm/semantics/aarch64-arithmetic.lisp @@ -1,10 +1,8 @@ -(in-package aarch64) - -(require arm-bits) +(declare (context (target arm armv8-a+le))) -;;; ARITHMETIC OPERATIONS +(in-package aarch64) -;; Addition +;;; 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." diff --git a/plugins/arm/semantics/atomic.lisp b/plugins/arm/semantics/aarch64-atomic.lisp similarity index 95% rename from plugins/arm/semantics/atomic.lisp rename to plugins/arm/semantics/aarch64-atomic.lisp index 0d788078d..f3a6db9e3 100644 --- a/plugins/arm/semantics/atomic.lisp +++ b/plugins/arm/semantics/aarch64-atomic.lisp @@ -1,6 +1,6 @@ -(in-package aarch64) +(declare (context (target arm armv8-a+le))) -(require arm-bits) +(in-package aarch64) ;;; ATOMIC OPERATIONS diff --git a/plugins/arm/semantics/branch.lisp b/plugins/arm/semantics/aarch64-branch.lisp similarity index 96% rename from plugins/arm/semantics/branch.lisp rename to plugins/arm/semantics/aarch64-branch.lisp index 68f4ac542..eb4ec012e 100644 --- a/plugins/arm/semantics/branch.lisp +++ b/plugins/arm/semantics/aarch64-branch.lisp @@ -1,6 +1,6 @@ -(in-package aarch64) +(declare (context (target arm armv8-a+le))) -(require arm-bits) +(in-package aarch64) ;;; BRANCH INSTRUCTIONS diff --git a/plugins/arm/semantics/register-movements.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp similarity index 98% rename from plugins/arm/semantics/register-movements.lisp rename to plugins/arm/semantics/aarch64-data-movement.lisp index 8f7ba27ff..a2555b181 100644 --- a/plugins/arm/semantics/register-movements.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -1,7 +1,6 @@ -(in-package aarch64) +(declare (context (target arm armv8-a+le))) -(require bits) -(require arm-bits) +(in-package aarch64) ;;; LOADS, MOVES, STORES diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp new file mode 100644 index 000000000..fcd4e390e --- /dev/null +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -0,0 +1,116 @@ +;; Helper functions specific to aarch64. + +(declare (context (target arm armv8-a+le))) + +(in-package aarch64) + +(require bits) +(require arm-bits) + +(defun word () (word-width)) + +(defun shifted (rm off) + (let ((typ (extract 7 6 off)) + (off (extract 5 0 off))) + (case typ + 0b00 (lshift rm off) + 0b01 (rshift rm off) + 0b10 (arshift rm off) + ;; TODO: 0b11 ror? + ))) + +(defun unsigned-extend (n rm) + (cast-unsigned (word-width) (cast-low n rm))) + +(defun signed-extend (n rm) + (cast-signed (word-width) (cast-low n rm))) + +(defun extended (rm bits) + (let ((typ (extract 5 3 bits)) + (off (extract 2 0 bits))) + (lshift (case typ + 0b000 (unsigned-extend 8 rm) + 0b001 (unsigned-extend 16 rm) + 0b010 (unsigned-extend 32 rm) + 0b011 rm + 0b100 (signed-extend 8 rm) + 0b101 (signed-extend 16 rm) + 0b110 (signed-extend 32 rm) + 0b111 rm) + off))) + +(defun test () + (assert (= 0 0))) + +(defun beans () + (assert-msg (= 0 0) "meow")) + +(defun decode-bit-masks (immN imms immr immediate) + "(decode-bit-masks immN imms immr immediate) returns the immediate value + corresponding to the immN:immr:imms bit pattern within opcodes of + ARMv8 logical operation instructions like AND, ORR etc. + I'm not sure what the immediate parameter does, but it's nearly always + called with true. + Modified from ARMv8 ISA pseudocode." + (let ((memory-width 64) ; change to 32 if 32-bit system + (len (highest-set-bit (concat immN (lnot imms)))) + (levels (zero-extend (ones len) 6)) + (S (logand imms levels)) + (R (logand immr levels)) + (diff (- S R))) ; assuming "6-bit subtract with borrow" is regular 2'c subtraction + (assert-msg (>= len 1) "decode-bit-masks len < 1") + (assert-msg (not (and immediate (= levels (logand imms levels)))) "decode-bit-masks long condition") + (let ((esize (lshift 1 len)) + (d (extract (- len 1) 0 diff)) + (welem (zero-extend (ones (+ S 1)) esize)) + (telem (zero-extend (ones (+ d 1)) esize)) + (wmask (replicate-to-fill (rotate-right welem R) memory-width)) + (tmask (replicate-to-fill telem memory-width))) + ; it seems like wmask is for logical immediates, and tmask is not used + ; anywhere in the ISA except for the BFM instruction and its aliases. + ; we're just returning wmask here. + ; TODO: can we return tuples in Primus Lisp? + wmask))) + +(defun immediate-from-bitmask (mask) + "(immediate-from-bitmask mask) returns the immediate value corresponding to + the given 13-bit mask in the form of N:immr:imms." + (let ((N (select 12 mask)) + (immr (extract 11 6 mask)) + (imms (extract 5 0 mask))) + (decode-bit-masks N imms immr true))) + +(defun barrier-option-to-symbol (barrier-type option) + (case barrier-type + :dmb + (case option + 0b1111 :barrier-dmb-sy + 0b1110 :barrier-dmb-st + 0b1101 :barrier-dmb-ld + 0b1011 :barrier-dmb-ish + 0b1010 :barrier-dmb-ishst + 0b1001 :barrier-dmb-ishld + 0b0111 :barrier-dmb-nsh + 0b0110 :barrier-dmb-nshst + 0b0101 :barrier-dmb-nshld + 0b0011 :barrier-dmb-osh + 0b0010 :barrier-dmb-oshst + 0b0001 :barrier-dmb-oshld + :barrier-dmb-unknown) + :dsb + (case option + 0b1111 :barrier-dsb-sy + 0b1110 :barrier-dsb-st + 0b1101 :barrier-dsb-ld + 0b1011 :barrier-dsb-ish + 0b1010 :barrier-dsb-ishst + 0b1001 :barrier-dsb-ishld + 0b0111 :barrier-dsb-nsh + 0b0110 :barrier-dsb-nshst + 0b0101 :barrier-dsb-nshld + 0b0011 :barrier-dsb-osh + 0b0010 :barrier-dsb-oshst + 0b0001 :barrier-dsb-oshld + :barrier-dsb-unknown) + :isb + :barrier-isb-sy)) diff --git a/plugins/arm/semantics/logical.lisp b/plugins/arm/semantics/aarch64-logical.lisp similarity index 98% rename from plugins/arm/semantics/logical.lisp rename to plugins/arm/semantics/aarch64-logical.lisp index 1c3839373..3d681ba1f 100644 --- a/plugins/arm/semantics/logical.lisp +++ b/plugins/arm/semantics/aarch64-logical.lisp @@ -1,7 +1,6 @@ -(in-package aarch64) +(declare (context (target arm armv8-a+le))) -(require bits) -(require arm-bits) +(in-package aarch64) ;;; LOGICAL/BITFIELD OPERATIONS diff --git a/plugins/arm/semantics/special.lisp b/plugins/arm/semantics/aarch64-special.lisp similarity index 92% rename from plugins/arm/semantics/special.lisp rename to plugins/arm/semantics/aarch64-special.lisp index 7663cf97c..3a6b82b59 100644 --- a/plugins/arm/semantics/special.lisp +++ b/plugins/arm/semantics/aarch64-special.lisp @@ -1,6 +1,6 @@ -(in-package aarch64) +(declare (context (target arm armv8-a+le))) -(require arm-bits) +(in-package aarch64) ;;; SPECIAL INSTRUCTIONS diff --git a/plugins/arm/semantics/aarch64.lisp b/plugins/arm/semantics/aarch64.lisp index 104448523..42d875479 100644 --- a/plugins/arm/semantics/aarch64.lisp +++ b/plugins/arm/semantics/aarch64.lisp @@ -1,25 +1,20 @@ (declare (context (target arm armv8-a+le))) -;; helper functions -(require bits) -(require arm-bits) - -;; implementations -(require arithmetic) -(require atomic) -(require branch) -(require logical) -(require register-movements) -(require special) - - (defpackage aarch64 (:use core target arm)) (defpackage llvm-aarch64 (:use aarch64)) (in-package aarch64) -(defun word () (word-width)) +;; helper functions +(require bits) +(require arm-bits) +(require aarch64-helper) ;; instructions are sorted by the categories defined here ;; https://github.com/UQ-PAC/bap/wiki/All-aarch64-Instructions-by-Category - +(require aarch64-arithmetic) +(require aarch64-atomic) +(require aarch64-branch) +(require aarch64-logical) +(require aarch64-data-movement) +(require aarch64-special) diff --git a/plugins/arm/semantics/arm-bits.lisp b/plugins/arm/semantics/arm-bits.lisp index 867f5f6eb..77ed2881b 100644 --- a/plugins/arm/semantics/arm-bits.lisp +++ b/plugins/arm/semantics/arm-bits.lisp @@ -68,103 +68,3 @@ (let ((res val)) (clear-base reg) (set$ reg res))) - -(defun shifted (rm off) - (let ((typ (extract 7 6 off)) - (off (extract 5 0 off))) - (case typ - 0b00 (lshift rm off) - 0b01 (rshift rm off) - 0b10 (arshift rm off) - ;; TODO: 0b11 ror? - ))) - -(defun unsigned-extend (n rm) - (cast-unsigned (word-width) (cast-low n rm))) - -(defun signed-extend (n rm) - (cast-signed (word-width) (cast-low n rm))) - -(defun extended (rm bits) - (let ((typ (extract 5 3 bits)) - (off (extract 2 0 bits))) - (lshift (case typ - 0b000 (unsigned-extend 8 rm) - 0b001 (unsigned-extend 16 rm) - 0b010 (unsigned-extend 32 rm) - 0b011 rm - 0b100 (signed-extend 8 rm) - 0b101 (signed-extend 16 rm) - 0b110 (signed-extend 32 rm) - 0b111 rm) - off))) - -(defun decode-bit-masks (immN imms immr immediate) - "(decode-bit-masks immN imms immr immediate) returns the immediate value - corresponding to the immN:immr:imms bit pattern within opcodes of - ARMv8 logical operation instructions like AND, ORR etc. - I'm not sure what the immediate parameter does, but it's nearly always - called with true. - Modified from ARMv8 ISA pseudocode." - (let ((memory-width 64) ; change to 32 if 32-bit system - (len (highest-set-bit (concat immN (lnot imms)))) - (levels (zero-extend (ones len) 6)) - (S (logand imms levels)) - (R (logand immr levels)) - (diff (- S R))) ; assuming "6-bit subtract with borrow" is regular 2'c subtraction - (assert-msg (>= len 1) "decode-bit-masks len < 1") - (assert-msg (not (and immediate (= levels (logand imms levels)))) "decode-bit-masks long condition") - (let ((esize (lshift 1 len)) - (d (extract (- len 1) 0 diff)) - (welem (zero-extend (ones (+ S 1)) esize)) - (telem (zero-extend (ones (+ d 1)) esize)) - (wmask (replicate-to-fill (rotate-right welem R) memory-width)) - (tmask (replicate-to-fill telem memory-width))) - ; it seems like wmask is for logical immediates, and tmask is not used - ; anywhere in the ISA except for the BFM instruction and its aliases. - ; we're just returning wmask here. - ; TODO: can we return tuples in Primus Lisp? - wmask))) - -(defun immediate-from-bitmask (mask) - "(immediate-from-bitmask mask) returns the immediate value corresponding to - the given 13-bit mask in the form of N:immr:imms." - (let ((N (select 12 mask)) - (immr (extract 11 6 mask)) - (imms (extract 5 0 mask))) - (decode-bit-masks N imms immr true))) - -(defun barrier-option-to-symbol (barrier-type option) - (case barrier-type - :dmb - (case option - 0b1111 :barrier-dmb-sy - 0b1110 :barrier-dmb-st - 0b1101 :barrier-dmb-ld - 0b1011 :barrier-dmb-ish - 0b1010 :barrier-dmb-ishst - 0b1001 :barrier-dmb-ishld - 0b0111 :barrier-dmb-nsh - 0b0110 :barrier-dmb-nshst - 0b0101 :barrier-dmb-nshld - 0b0011 :barrier-dmb-osh - 0b0010 :barrier-dmb-oshst - 0b0001 :barrier-dmb-oshld - :barrier-dmb-unknown) - :dsb - (case option - 0b1111 :barrier-dsb-sy - 0b1110 :barrier-dsb-st - 0b1101 :barrier-dsb-ld - 0b1011 :barrier-dsb-ish - 0b1010 :barrier-dsb-ishst - 0b1001 :barrier-dsb-ishld - 0b0111 :barrier-dsb-nsh - 0b0110 :barrier-dsb-nshst - 0b0101 :barrier-dsb-nshld - 0b0011 :barrier-dsb-osh - 0b0010 :barrier-dsb-oshst - 0b0001 :barrier-dsb-oshld - :barrier-dsb-unknown) - :isb - :barrier-isb-sy)) From 6d133e56e991d4ebf303224844454b55fff10e42 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Mon, 28 Mar 2022 03:08:46 +0000 Subject: [PATCH 015/132] 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. --- plugins/arm/semantics/aarch64-pstate.lisp | 69 +++++++++++++++++++++++ plugins/arm/semantics/arm-bits.lisp | 6 ++ 2 files changed, 75 insertions(+) create mode 100644 plugins/arm/semantics/aarch64-pstate.lisp diff --git a/plugins/arm/semantics/aarch64-pstate.lisp b/plugins/arm/semantics/aarch64-pstate.lisp new file mode 100644 index 000000000..1afa93a6b --- /dev/null +++ b/plugins/arm/semantics/aarch64-pstate.lisp @@ -0,0 +1,69 @@ +(declare (context (target arm armv8-a+le))) + +(in-package aarch64) + +;;; SPECIFIC PROCESSOR STATE INSTRUCTIONS + +(defmacro CCMN** (rn rm-or-imm nzcv cnd) + "(CCMN** rn rm-or-imm nzcv cnd) implements either CCMN*i + or CCMN*r. The semantics are the same at the lisp level; + an immediate or register value is given as second argument." + (if (condition-holds cnd) + (set-flags (+ rn rm-or-imm) rn rm-or-imm) + (set-nzcv nzcv))) + +(defun CCMNWi (rn imm nzcv cnd) (CCMN** rn imm nzcv cnd)) +(defun CCMNXi (rn imm nzcv cnd) (CCMN** rn imm nzcv cnd)) +(defun CCMNWr (rn rm nzcv cnd) (CCMN** rn rm nzcv cnd)) +(defun CCMNXr (rn rm nzcv cnd) (CCMN** rn rm nzcv cnd)) + +(defmacro CCMP** (rn rm-or-imm nzcv cnd) + "(CCMP** rn rm-or-imm nzcv cnd) implements either CCMP*i + or CCMP*r. The semantics are the same at the lisp level; + an immediate or register value is given as second argument." + (if (condition-holds cnd) + (let ((rm-or-imm (lnot rm-or-imm))) + (set-flags (+ rn rm-or-imm 1) rn rm-or-imm)) + (set-nzcv nzcv))) + +(defun CCMPWi (rn imm nzcv cnd) (CCMP** rn imm nzcv cnd)) +(defun CCMPXi (rn imm nzcv cnd) (CCMP** rn imm nzcv cnd)) +(defun CCMPWr (rn rm nzcv cnd) (CCMP** rn rm nzcv cnd)) +(defun CCMPXr (rn rm nzcv cnd) (CCMP** rn rm nzcv cnd)) + +;; CFINV gets turned into MSR (register) by LLVM even though they're not aliases. +;; --show-knowledge shows that LLVM returned "MSR 0x200 XZR" for CFINV, but +;; this isn't even a valid opcode? For MSR (register) both arguments need to be registers.. + +;; (defun CFINV () (set CF (lnot CF))) +;; (defun MSR () ) + +;; LLVM can't seem to disassemble the RMIF instruction at all; +;; try `bap-mc --show-bil --arch=aarch64 -- "00 04 00 ba"` +;; which corresponds to "RMIF x0, 0, 0". +;; I also don't know whether "RMIF" is the correct LLVM opcode to +;; use as the function name. +;; It also can't do SETF8 and SETF16, and all three are from ARMv8.4. +;; I suspect ARMv8.4 support has not been implemented yet. +(defun RMIF (rn imm nzcv-mask) + (let ((tmp (extract 3 0 (rotate-right rn imm)))) + (when (= 1 (select 3 nzcv-mask)) + (set NF (select 3 tmp))) + (when (= 1 (select 3 nzcv-mask)) + (set NF (select 3 tmp))) + (when (= 1 (select 3 nzcv-mask)) + (set NF (select 3 tmp))) + (when (= 1 (select 3 nzcv-mask)) + (set NF (select 3 tmp))))) + +;; LLVM can't disassemble SETF8 and SETF16 instructions (same as RMIF instruction). +;; See comment in RMIF function. Again, just guessing the LLVM opcode here. +(defun SETF8W (rn) + (set NF (select 7 rn)) + (set ZF (is_zero (extract 7 0 rn))) + (set VF (logxor (select (+ 7 1) rn) (select 7 rn)))) + +(defun SETF16W (rn) + (set NF (select 15 rn)) + (set ZF (is_zero (extract 15 0 rn))) + (set VF (logxor (select (+ 15 1) rn) (select 15 rn)))) diff --git a/plugins/arm/semantics/arm-bits.lisp b/plugins/arm/semantics/arm-bits.lisp index 77ed2881b..397788c60 100644 --- a/plugins/arm/semantics/arm-bits.lisp +++ b/plugins/arm/semantics/arm-bits.lisp @@ -9,6 +9,12 @@ (set ZF (is-zero r)) (set CF (carry r x y))) +(defun set-nzcv (nzcv) + (set NF (select 3 nzcv)) + (set ZF (select 2 nzcv)) + (set CF (select 1 nzcv)) + (set VF (select 0 nzcv))) + (defun add-with-carry (rd x y c) (let ((r (+ c y x))) (set-flags r x y) From e3a7da879e65ff2896aa1d5229256e2f95e122c4 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Mon, 4 Apr 2022 01:13:10 +0000 Subject: [PATCH 016/132] fix typo in pstate instructions i typed is_zero with underscore instead of primitive is-zero --- plugins/arm/semantics/aarch64-helper.lisp | 6 ------ plugins/arm/semantics/aarch64-pstate.lisp | 4 ++-- 2 files changed, 2 insertions(+), 8 deletions(-) diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index fcd4e390e..ce96e6a46 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -39,12 +39,6 @@ 0b111 rm) off))) -(defun test () - (assert (= 0 0))) - -(defun beans () - (assert-msg (= 0 0) "meow")) - (defun decode-bit-masks (immN imms immr immediate) "(decode-bit-masks immN imms immr immediate) returns the immediate value corresponding to the immN:immr:imms bit pattern within opcodes of diff --git a/plugins/arm/semantics/aarch64-pstate.lisp b/plugins/arm/semantics/aarch64-pstate.lisp index 1afa93a6b..e311e9804 100644 --- a/plugins/arm/semantics/aarch64-pstate.lisp +++ b/plugins/arm/semantics/aarch64-pstate.lisp @@ -60,10 +60,10 @@ ;; See comment in RMIF function. Again, just guessing the LLVM opcode here. (defun SETF8W (rn) (set NF (select 7 rn)) - (set ZF (is_zero (extract 7 0 rn))) + (set ZF (is-zero (extract 7 0 rn))) (set VF (logxor (select (+ 7 1) rn) (select 7 rn)))) (defun SETF16W (rn) (set NF (select 15 rn)) - (set ZF (is_zero (extract 15 0 rn))) + (set ZF (is-zero (extract 15 0 rn))) (set VF (logxor (select (+ 15 1) rn) (select 15 rn)))) From f4fb5885e27d8e6475bb7fbf949614ab93d143bd Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Mon, 4 Apr 2022 03:22:00 +0000 Subject: [PATCH 017/132] implement rotate-left --- plugins/primus_lisp/semantics/bits.lisp | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/plugins/primus_lisp/semantics/bits.lisp b/plugins/primus_lisp/semantics/bits.lisp index 86a5c613c..772519497 100644 --- a/plugins/primus_lisp/semantics/bits.lisp +++ b/plugins/primus_lisp/semantics/bits.lisp @@ -84,6 +84,14 @@ (lshift bitv (- bitv-length m))))))) (defun rotate-left (bitv n) - "TODO: implement rotate-left" - bitv - ) \ No newline at end of file + "(rotate-right bitv n) rotates bitv to the right by n positions. + Carry-out is ignored. + Adapted from rotate-right code in ARMv8 ISA pseudocode." + (if (= n 0) + bitv + (let ((bitv-length (word-width bitv)) + (m (mod n bitv-length))) + (extract (- bitv-length 1) 0 + (logor + (lshift bitv m) + (rshift bitv (- bitv-length m))))))) \ No newline at end of file From 7bd7dbb67d3244058eeae9fee398c91567ef4281 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Mon, 4 Apr 2022 07:30:19 +0000 Subject: [PATCH 018/132] add missing documentation and rename for clarity documentation added for macros and helper functions. --- plugins/arm/semantics/aarch64-arithmetic.lisp | 14 ++++----- plugins/arm/semantics/aarch64-helper.lisp | 16 ++++++++-- plugins/arm/semantics/aarch64-logical.lisp | 6 +++- plugins/arm/semantics/aarch64-pstate.lisp | 4 +-- plugins/arm/semantics/arm-bits.lisp | 30 ++++++++++++++++--- 5 files changed, 54 insertions(+), 16 deletions(-) diff --git a/plugins/arm/semantics/aarch64-arithmetic.lisp b/plugins/arm/semantics/aarch64-arithmetic.lisp index 202c480c5..9983e0e14 100644 --- a/plugins/arm/semantics/aarch64-arithmetic.lisp +++ b/plugins/arm/semantics/aarch64-arithmetic.lisp @@ -12,9 +12,9 @@ ;; 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)) -;; shifted decodes the shift type and shifts -(defun ADDWrs (rd rn rm off) (ADD*r* setw shifted rd rn rm off)) -(defun ADDXrs (rd rn rm off) (ADD*r* set$ shifted rd rn rm 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 (+ @@ -28,17 +28,17 @@ ;; 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 shifted rd rn rm off)) -(defun SUBXrs (rd rn rm off) (SUB*r* set$ shifted 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 (shifted rm off)) 1)) + (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 (shifted rm off)) 1)) + (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)) diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index ce96e6a46..a0802c5b8 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -9,23 +9,31 @@ (defun word () (word-width)) -(defun shifted (rm off) +(defun shift-encoded (rm off) + "(shift-encoded rm off) decodes the 8-bit shift value + into its type and offset, and shifts rm accordingly." (let ((typ (extract 7 6 off)) (off (extract 5 0 off))) (case typ 0b00 (lshift rm off) 0b01 (rshift rm off) 0b10 (arshift rm off) - ;; TODO: 0b11 ror? + 0b11 (rotate-right rm off) ))) (defun unsigned-extend (n rm) + "(unsigned-extend n rm) returns the unsigned extension (prepend with zeros) + of the lowest n bits of rm." (cast-unsigned (word-width) (cast-low n rm))) (defun signed-extend (n rm) + "(signed-extend n rm) returns the signed extension (prepend with rm[n-1]) + of the lowest n bits of rm." (cast-signed (word-width) (cast-low n rm))) (defun extended (rm bits) + "(extended rm bits) decodes the extension type and amount from bits, + and returns the value of the extension on rm." (let ((typ (extract 5 3 bits)) (off (extract 2 0 bits))) (lshift (case typ @@ -75,6 +83,10 @@ (decode-bit-masks N imms immr true))) (defun barrier-option-to-symbol (barrier-type option) + "(barrier-option-to-symbol barrier-type option) converts the + barrier type (:dmb, :dsb, :isb) and 4-bit optional value + to a symbol. + This is to be used with the (special) primitive." (case barrier-type :dmb (case option diff --git a/plugins/arm/semantics/aarch64-logical.lisp b/plugins/arm/semantics/aarch64-logical.lisp index 3d681ba1f..6535840ea 100644 --- a/plugins/arm/semantics/aarch64-logical.lisp +++ b/plugins/arm/semantics/aarch64-logical.lisp @@ -7,6 +7,8 @@ ;; Logical (defmacro ORN*rs (set rd rn rm is) + "(ORN*rs set rd rn rm is) implements the OR NOT instruction + accepting either a W or X register." (set rd (logor rn (lnot (lshift rm is))))) (defun ORNWrs (rd rn rm is) (ORN*rs setw rd rn rm is)) @@ -15,7 +17,7 @@ (defmacro log*rs (set op rd rn rm is) "(log*rs set op rd rn is) implements the logical operation (shift) instruction accepting either a W or X register. op is the binary logical operation." - (set rd (op rn (shifted rm is)))) + (set rd (op rn (shift-encoded rm is)))) (defun ORRWrs (rd rn rm is) (log*rs setw logor rd rn rm is)) (defun EORWrs (rd rn rm is) (log*rs setw logxor rd rn rm is)) @@ -40,6 +42,8 @@ ;; (bitfield moves) (defmacro make-BFM (set cast xd xr ir is) + "(make-BFM set cast xd xr ir is) implements bitfield move instructions + accepting either a W or X register, with cast being an unsigned or signed cast." (let ((rs (word))) (if (< is ir) (if (and (/= is (- rs 1)) (= (+ is 1) ir)) diff --git a/plugins/arm/semantics/aarch64-pstate.lisp b/plugins/arm/semantics/aarch64-pstate.lisp index e311e9804..f91a3d7ca 100644 --- a/plugins/arm/semantics/aarch64-pstate.lisp +++ b/plugins/arm/semantics/aarch64-pstate.lisp @@ -9,7 +9,7 @@ or CCMN*r. The semantics are the same at the lisp level; an immediate or register value is given as second argument." (if (condition-holds cnd) - (set-flags (+ rn rm-or-imm) rn rm-or-imm) + (set-nzcv-from-registers (+ rn rm-or-imm) rn rm-or-imm) (set-nzcv nzcv))) (defun CCMNWi (rn imm nzcv cnd) (CCMN** rn imm nzcv cnd)) @@ -23,7 +23,7 @@ an immediate or register value is given as second argument." (if (condition-holds cnd) (let ((rm-or-imm (lnot rm-or-imm))) - (set-flags (+ rn rm-or-imm 1) rn rm-or-imm)) + (set-nzcv-from-registers (+ rn rm-or-imm 1) rn rm-or-imm)) (set-nzcv nzcv))) (defun CCMPWi (rn imm nzcv cnd) (CCMP** rn imm nzcv cnd)) diff --git a/plugins/arm/semantics/arm-bits.lisp b/plugins/arm/semantics/arm-bits.lisp index 397788c60..3f39bb216 100644 --- a/plugins/arm/semantics/arm-bits.lisp +++ b/plugins/arm/semantics/arm-bits.lisp @@ -3,40 +3,58 @@ (in-package arm) -(defun set-flags (r x y) +(defun set-nzcv-from-registers (r x y) + "(set-nzcv-from-registers r x y) sets the processor state flags + to the result of some arithmetic operation (op x y) with r as the result. + Common examples include: + (set-nzcv-from-registers (+ x y) x y) + or + (set-nzcv-from-registers (+ x y 1) x y) + This function was formerly named set-flags, but was renamed to improve clarity." (set NF (msb r)) (set VF (overflow r x y)) (set ZF (is-zero r)) (set CF (carry r x y))) (defun set-nzcv (nzcv) + "(set-nzcv nzcv) sets the negative, zero, carry and overflow flags to + the bottom 4 bits of nzcv." (set NF (select 3 nzcv)) (set ZF (select 2 nzcv)) (set CF (select 1 nzcv)) (set VF (select 0 nzcv))) (defun add-with-carry (rd x y c) + "(add-with-carry rd x y c) sets rd to the result of adding x and y + with carry bit c, and sets processor flags." (let ((r (+ c y x))) - (set-flags r x y) + (set-nzcv-from-registers r x y) (set$ rd r))) (defun add-with-carry/clear-base (rd x y c) + "(add-with-carry/clear-base rd x y c) sets rd to the result of adding x and y + with carry bit c after clearing the base register rd, and sets processor flags." (let ((r (+ c y x))) - (set-flags r y x) + (set-nzcv-from-registers r y x) (clear-base rd) (set$ rd r))) (defun add-with-carry/it-block (rd x y c cnd) + "(add-with-carry/it-block rd x y c cnd) sets rd to the result of adding x and y + with carry bit c if cnd holds, and sets processor flags if cnd is unconditional." (when (condition-holds cnd) (let ((r (+ c y x))) (when (is-unconditional cnd) - (set-flags r x y)) + (set-nzcv-from-registers r x y)) (set$ rd r)))) (defun logandnot (rd rn) (logand rd (lnot rn))) (defmacro shift-with-carry (shift rd rn rm cnd) + "(shift-with-carry shift rd rn rm cnd) sets rd to the shifted + value of rn and rm, and relevant processor flags, when cnd holds. + The overflow flag is not changed." (when (condition-holds cnd) (let ((r (cast-signed (word-width) rn))) (when (is-unconditional cnd) @@ -46,6 +64,8 @@ (set NF (msb rd)))))) (defun condition-holds (cnd) + "(condition-holds cnd) calculates the result of the given condition cnd + based on the values of processor flags." (case cnd 0b0000 ZF 0b0001 (lnot ZF) @@ -64,9 +84,11 @@ true)) (defun is-unconditional (cnd) + "(is-unconditional cnd) checks whether cnd is unconditional, i.e. 0b1110." (= cnd 0b1110)) (defun clear-base (reg) + "(clear-base reg) clears all of the register reg." (set$ (alias-base-register reg) 0)) (defmacro setw (reg val) From 0231a76e6f004ce2ece8c2b1d93f2f2db2bc11e0 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Mon, 11 Apr 2022 02:38:54 +0000 Subject: [PATCH 019/132] apply upstream changes from #1454 --- plugins/arm/semantics/arm-bits.lisp | 11 ++--------- 1 file changed, 2 insertions(+), 9 deletions(-) diff --git a/plugins/arm/semantics/arm-bits.lisp b/plugins/arm/semantics/arm-bits.lisp index 3f39bb216..884701784 100644 --- a/plugins/arm/semantics/arm-bits.lisp +++ b/plugins/arm/semantics/arm-bits.lisp @@ -36,8 +36,7 @@ with carry bit c after clearing the base register rd, and sets processor flags." (let ((r (+ c y x))) (set-nzcv-from-registers r y x) - (clear-base rd) - (set$ rd r))) + (setw rd r))) (defun add-with-carry/it-block (rd x y c cnd) "(add-with-carry/it-block rd x y c cnd) sets rd to the result of adding x and y @@ -87,12 +86,6 @@ "(is-unconditional cnd) checks whether cnd is unconditional, i.e. 0b1110." (= cnd 0b1110)) -(defun clear-base (reg) - "(clear-base reg) clears all of the register reg." - (set$ (alias-base-register reg) 0)) - (defmacro setw (reg val) "(set Wx V) sets a Wx register clearing the upper 32 bits." - (let ((res val)) - (clear-base reg) - (set$ reg res))) + (set$ (alias-base-register reg) val)) \ No newline at end of file From 28dc108a2be56ffa6c0351da60542fae2acd73b4 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Mon, 11 Apr 2022 03:53:11 +0000 Subject: [PATCH 020/132] implement CAS and friends for X registers llvm mnemonics most likely incorrect, will investigate why bap's llvm doesn't disassemble these insns --- plugins/arm/semantics/aarch64-atomic.lisp | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/plugins/arm/semantics/aarch64-atomic.lisp b/plugins/arm/semantics/aarch64-atomic.lisp index f3a6db9e3..8c6a162bb 100644 --- a/plugins/arm/semantics/aarch64-atomic.lisp +++ b/plugins/arm/semantics/aarch64-atomic.lisp @@ -4,6 +4,27 @@ ;;; ATOMIC OPERATIONS +;; WARNING: these llvm mnemonics are very likely incorrect, +;; need to investigate why bap's llvm can't disassemble any instructions +;; from armv8.1 or later. + +(defmacro CASordXr (rs rt rn acquire-ordering release-ordering) + "(CASord*r set load store rs rt rn acquire-ordering release-ordering) + implements a generic compare-and-swap instruction on a X register. + acquire-ordering and release-ordering are booleans indicating whether + load-acquire and store-release ordering is to be enforced." + (let ((data) (load-word rn)) + (if (acquire-ordering) (special :load-acquire)) + (if (= data rs) + (if (release-odering) (special :store-release)) + (store-word rn rt)) + (set$ rs data))) + +(defun CASXr (rs rt rn) (CASordXr rs rt rn false false)) +(defun CASAXr (rs rt rn) (CASordXr rs rt rn true false)) +(defun CASLXr (rs rt rn) (CASordXr rs rt rn false true)) +(defun CASALXr (rs rt rn) (CASordXr 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 From 469d1349f2d536101c5b45ad4241d8be1f06b40d Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Mon, 11 Apr 2022 04:14:03 +0000 Subject: [PATCH 021/132] 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 --- plugins/arm/semantics/aarch64-atomic.lisp | 22 +++++++++------------- 1 file changed, 9 insertions(+), 13 deletions(-) diff --git a/plugins/arm/semantics/aarch64-atomic.lisp b/plugins/arm/semantics/aarch64-atomic.lisp index 8c6a162bb..b463ecfc6 100644 --- a/plugins/arm/semantics/aarch64-atomic.lisp +++ b/plugins/arm/semantics/aarch64-atomic.lisp @@ -4,26 +4,22 @@ ;;; ATOMIC OPERATIONS -;; WARNING: these llvm mnemonics are very likely incorrect, -;; need to investigate why bap's llvm can't disassemble any instructions -;; from armv8.1 or later. - -(defmacro CASordXr (rs rt rn acquire-ordering release-ordering) +(defmacro CASordX (rs rt rn acquire-ordering release-ordering) "(CASord*r set load store rs rt rn acquire-ordering release-ordering) implements a generic compare-and-swap instruction on a X register. acquire-ordering and release-ordering are booleans indicating whether load-acquire and store-release ordering is to be enforced." - (let ((data) (load-word rn)) - (if (acquire-ordering) (special :load-acquire)) - (if (= data rs) - (if (release-odering) (special :store-release)) + (let ((data (load-word rn))) + (when (acquire-ordering) (special :load-acquire)) + (when (= data rs) + (when (release-odering) (special :store-release)) (store-word rn rt)) (set$ rs data))) -(defun CASXr (rs rt rn) (CASordXr rs rt rn false false)) -(defun CASAXr (rs rt rn) (CASordXr rs rt rn true false)) -(defun CASLXr (rs rt rn) (CASordXr rs rt rn false true)) -(defun CASALXr (rs rt rn) (CASordXr rs rt rn true true)) +(defun CASX (rs rt rn) (CASordXr rs rt rn false false)) +(defun CASAX (rs rt rn) (CASordXr rs rt rn true false)) +(defun CASLX (rs rt rn) (CASordXr rs rt rn false true)) +(defun CASALX (rs rt rn) (CASordXr 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 From 381d62790a4f8c7433f108c211de8a102133806d Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Tue, 12 Apr 2022 01:15:39 +0000 Subject: [PATCH 022/132] fix typos in CAS instruction code --- plugins/arm/semantics/aarch64-atomic.lisp | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/plugins/arm/semantics/aarch64-atomic.lisp b/plugins/arm/semantics/aarch64-atomic.lisp index b463ecfc6..ff0dad840 100644 --- a/plugins/arm/semantics/aarch64-atomic.lisp +++ b/plugins/arm/semantics/aarch64-atomic.lisp @@ -10,16 +10,16 @@ acquire-ordering and release-ordering are booleans indicating whether load-acquire and store-release ordering is to be enforced." (let ((data (load-word rn))) - (when (acquire-ordering) (special :load-acquire)) + (when acquire-ordering (special :load-acquire)) (when (= data rs) - (when (release-odering) (special :store-release)) + (when release-ordering (special :store-release)) (store-word rn rt)) (set$ rs data))) -(defun CASX (rs rt rn) (CASordXr rs rt rn false false)) -(defun CASAX (rs rt rn) (CASordXr rs rt rn true false)) -(defun CASLX (rs rt rn) (CASordXr rs rt rn false true)) -(defun CASALX (rs rt rn) (CASordXr rs rt rn true true)) +(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)) (defmacro CSop*r (set op rd rn rm cnd) "(CSop*r set op rd rn rm cnd) implements the conditional select From ed080e36f475c280b0c4265f5c4f6d73c6f3bc5b Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Tue, 12 Apr 2022 04:38:50 +0000 Subject: [PATCH 023/132] fix CFINV, RMIF, SETF8 and SETF16 using #1461 --- plugins/arm/semantics/aarch64-pstate.lisp | 33 +++++++---------------- 1 file changed, 10 insertions(+), 23 deletions(-) diff --git a/plugins/arm/semantics/aarch64-pstate.lisp b/plugins/arm/semantics/aarch64-pstate.lisp index f91a3d7ca..c58f04f47 100644 --- a/plugins/arm/semantics/aarch64-pstate.lisp +++ b/plugins/arm/semantics/aarch64-pstate.lisp @@ -31,39 +31,26 @@ (defun CCMPWr (rn rm nzcv cnd) (CCMP** rn rm nzcv cnd)) (defun CCMPXr (rn rm nzcv cnd) (CCMP** rn rm nzcv cnd)) -;; CFINV gets turned into MSR (register) by LLVM even though they're not aliases. -;; --show-knowledge shows that LLVM returned "MSR 0x200 XZR" for CFINV, but -;; this isn't even a valid opcode? For MSR (register) both arguments need to be registers.. - -;; (defun CFINV () (set CF (lnot CF))) +(defun CFINV () (set CF (lnot CF))) ;; (defun MSR () ) -;; LLVM can't seem to disassemble the RMIF instruction at all; -;; try `bap-mc --show-bil --arch=aarch64 -- "00 04 00 ba"` -;; which corresponds to "RMIF x0, 0, 0". -;; I also don't know whether "RMIF" is the correct LLVM opcode to -;; use as the function name. -;; It also can't do SETF8 and SETF16, and all three are from ARMv8.4. -;; I suspect ARMv8.4 support has not been implemented yet. (defun RMIF (rn imm nzcv-mask) (let ((tmp (extract 3 0 (rotate-right rn imm)))) (when (= 1 (select 3 nzcv-mask)) (set NF (select 3 tmp))) - (when (= 1 (select 3 nzcv-mask)) - (set NF (select 3 tmp))) - (when (= 1 (select 3 nzcv-mask)) - (set NF (select 3 tmp))) - (when (= 1 (select 3 nzcv-mask)) - (set NF (select 3 tmp))))) - -;; LLVM can't disassemble SETF8 and SETF16 instructions (same as RMIF instruction). -;; See comment in RMIF function. Again, just guessing the LLVM opcode here. -(defun SETF8W (rn) + (when (= 1 (select 2 nzcv-mask)) + (set ZF (select 2 tmp))) + (when (= 1 (select 1 nzcv-mask)) + (set CF (select 1 tmp))) + (when (= 1 (select 0 nzcv-mask)) + (set VF (select 0 tmp))))) + +(defun SETF8 (rn) (set NF (select 7 rn)) (set ZF (is-zero (extract 7 0 rn))) (set VF (logxor (select (+ 7 1) rn) (select 7 rn)))) -(defun SETF16W (rn) +(defun SETF16 (rn) (set NF (select 15 rn)) (set ZF (is-zero (extract 15 0 rn))) (set VF (logxor (select (+ 15 1) rn) (select 15 rn)))) From d8b71af6af835b66af388623e1a4294368f785fc Mon Sep 17 00:00:00 2001 From: Kaitlyn Lake Date: Tue, 12 Apr 2022 04:42:20 +0000 Subject: [PATCH 024/132] Added instructions ANDS, ASRV, BIC to aarch64-logical.lisp --- plugins/arm/semantics/aarch64-logical.lisp | 50 +++++++++++++++++++++- 1 file changed, 49 insertions(+), 1 deletion(-) diff --git a/plugins/arm/semantics/aarch64-logical.lisp b/plugins/arm/semantics/aarch64-logical.lisp index 3d681ba1f..0dfb757b2 100644 --- a/plugins/arm/semantics/aarch64-logical.lisp +++ b/plugins/arm/semantics/aarch64-logical.lisp @@ -36,6 +36,54 @@ (defun ORRWri (rd rn imm) (log*ri setw logor rd rn imm)) (defun ORRXri (rd rn imm) (log*ri set$ logor rd rn imm)) +;; Logical ANDS (flags set) + +(defmacro ANDS*r* (setf rd rn immOp) + "(ANDS*r* set rd rn immOp) implements the logical AND operation on either an X or W register with immediate/shifted immediate and sets the N, V, Z, C flags based on the result." + (let ((result (logand rn immOp))) + (set NF (msb result)) + (set VF 0) + (set ZF (is-zero result)) + (set CF 0) + (setf rd result))) + +(defmacro ANDS*ri (setf rd rn imm) + "(ANDS*ri set rd rn imm) implements the logical AND operation on either an X or W register with immediate and sets the N, V, Z, C flags based on the result." + (let ((immOp (immediate-from-bitmask imm))) + (ANDS*r* setf rd rn immOp))) + +(defun ANDSWri (rd rn imm) (ANDS*ri setw rd rn imm)) +(defun ANDSXri (rd rn imm) (ANDS*ri set$ rd rn imm)) + +(defmacro ANDS*rs (setf rd rn rm is) + "(ANDS*rs set rd rn imm) implements the logical AND operation on either an X or W register with shifted immediate and sets the N, V, Z, C flags based on the result." + (let ((immOp (shifted rm is))) + (ANDS*r* setf rd rn immOp))) + +(defun ANDSWrs (rd rn rm is) (ANDS*rs setw rd rn rm is)) +(defun ANDSXrs (rd rn rm is) (ANDS*rs set$ rd rn rm is)) + +;; ASRV +;; (bitfield moves) + +(defmacro ASRV*r (setr datasize rd rn rm) + (let ((shift (mod rm datasize))) + (setr rd (arshift rn shift)))) + +(defun ASRVWr (rd rn rm) (ASRV*r setw 32 rd rn rm)) +(defun ASRVXr (rd rn rm) (ASRV*r set$ 64 rd rn rm)) + +;; BIC + +;; assumes immediate always provided... must fix... +(defmacro BIC*r (setr rd rn rm is) + (let* ((shift (shifted rm is)) + (comp (lnot shift))) + (setr rd (logand rn comp)))) + +(defun BICWr (rd rn rm is) (BIC*r setw rd rn rm is)) +(defun BICXr (rd rn rm is) (BIC*r set$ rd rn rm is)) + ;; UBFM and SBFM ;; (bitfield moves) @@ -61,4 +109,4 @@ (make-BFM set$ cast-signed xd xr ir is)) (defun SBFMWri (xd xr ir is) - (make-BFM setw cast-signed xd xr ir is)) \ No newline at end of file + (make-BFM setw cast-signed xd xr ir is)) From 108f4c77c3bc3ffcf1878cce68053f5886fa9808 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Tue, 12 Apr 2022 05:39:39 +0000 Subject: [PATCH 025/132] use clz instead of loop for highest-set-bit --- plugins/arm/semantics/aarch64-helper.lisp | 3 +-- plugins/primus_lisp/semantics/bits.lisp | 10 ---------- 2 files changed, 1 insertion(+), 12 deletions(-) diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index a0802c5b8..da2c5870c 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -55,7 +55,7 @@ called with true. Modified from ARMv8 ISA pseudocode." (let ((memory-width 64) ; change to 32 if 32-bit system - (len (highest-set-bit (concat immN (lnot imms)))) + (len (- 64 (clz64 (concat immN (lnot imms))) 1)) (levels (zero-extend (ones len) 6)) (S (logand imms levels)) (R (logand immr levels)) @@ -71,7 +71,6 @@ ; it seems like wmask is for logical immediates, and tmask is not used ; anywhere in the ISA except for the BFM instruction and its aliases. ; we're just returning wmask here. - ; TODO: can we return tuples in Primus Lisp? wmask))) (defun immediate-from-bitmask (mask) diff --git a/plugins/primus_lisp/semantics/bits.lisp b/plugins/primus_lisp/semantics/bits.lisp index 61ae1e32e..8a4660c09 100644 --- a/plugins/primus_lisp/semantics/bits.lisp +++ b/plugins/primus_lisp/semantics/bits.lisp @@ -25,16 +25,6 @@ (logor (logand (msb rn) (msb rm) (lnot (msb rd))) (logand (lnot (msb rn)) (lnot (msb rm)) (msb rd)))) -(defun highest-set-bit (bitv) - "(highest-set-bit bitv) returns the greatest index whose bit is set in bitv. - It requires bitv to be non-zero. - Translated from ARMv8 ISA pseudocode." - (assert-msg (not (is-zero bitv)) "highest-set-bit bitv is zero") ; at least 1 bit must be set - (let ((i (- (word-width bitv) 1))) - (while (and (> i 0) (= (select i bitv) 0)) - (decr i)) - i)) - (defun replicate (bitv n) "(replicate bitv n) returns a bitvector with bitv repeated n times. Translated from ARMv8 ISA pseudocode." From 20bec8dc2ea50dd2e3c3db81ae42f9f22ed58c25 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Tue, 12 Apr 2022 06:12:54 +0000 Subject: [PATCH 026/132] miscellaneous changes to helper functions --- plugins/arm/semantics/aarch64-helper.lisp | 6 ++-- plugins/arm/semantics/arm-bits.lisp | 9 +++++ plugins/primus_lisp/semantics/bits.lisp | 42 +++++------------------ 3 files changed, 21 insertions(+), 36 deletions(-) diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index da2c5870c..75207f59f 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -56,7 +56,7 @@ Modified from ARMv8 ISA pseudocode." (let ((memory-width 64) ; change to 32 if 32-bit system (len (- 64 (clz64 (concat immN (lnot imms))) 1)) - (levels (zero-extend (ones len) 6)) + (levels (cast-unsigned 6 (ones len))) (S (logand imms levels)) (R (logand immr levels)) (diff (- S R))) ; assuming "6-bit subtract with borrow" is regular 2'c subtraction @@ -64,8 +64,8 @@ (assert-msg (not (and immediate (= levels (logand imms levels)))) "decode-bit-masks long condition") (let ((esize (lshift 1 len)) (d (extract (- len 1) 0 diff)) - (welem (zero-extend (ones (+ S 1)) esize)) - (telem (zero-extend (ones (+ d 1)) esize)) + (welem (cast-unsigned esize (ones (+ S 1)))) + (telem (cast-unsigned esize (ones (+ d 1)))) (wmask (replicate-to-fill (rotate-right welem R) memory-width)) (tmask (replicate-to-fill telem memory-width))) ; it seems like wmask is for logical immediates, and tmask is not used diff --git a/plugins/arm/semantics/arm-bits.lisp b/plugins/arm/semantics/arm-bits.lisp index 92f7343f6..71759d7c8 100644 --- a/plugins/arm/semantics/arm-bits.lisp +++ b/plugins/arm/semantics/arm-bits.lisp @@ -86,3 +86,12 @@ (defmacro setw (reg val) "(set Wx V) sets a Wx register clearing the upper 32 bits." (set$ (alias-base-register reg) val)) + +(defun replicate-to-fill (bitv n) + "(replicate-to-fill bitv n) returns the result of repeating bitv + to a total of n bits. Requires that n is a multiple of bitv's length. + Modified from the bits(N) Replicate(bits(M) x) function from + ARMv8 ISA pseudocode." + (let ((bitv-length (word-width bitv))) + (assert-msg (= 0 (mod n bitv-length)) "replicate-to-fill n not multiple of len(bitv)") + (replicate bitv (/ n bitv-length)))) diff --git a/plugins/primus_lisp/semantics/bits.lisp b/plugins/primus_lisp/semantics/bits.lisp index 8a4660c09..8ae17114a 100644 --- a/plugins/primus_lisp/semantics/bits.lisp +++ b/plugins/primus_lisp/semantics/bits.lisp @@ -26,47 +26,24 @@ (logand (lnot (msb rn)) (lnot (msb rm)) (msb rd)))) (defun replicate (bitv n) - "(replicate bitv n) returns a bitvector with bitv repeated n times. - Translated from ARMv8 ISA pseudocode." - (let ((output 0:0)) - (while (> n 0) + "(replicate bitv n) returns a bitvector with bitv repeated n times." + (let ((output bitv)) + (while (> n 1) (decr n) (set output (concat output bitv))) output)) -(defun replicate-to-fill (bitv n) - "(replicate-to-fill bitv n) returns the result of repeating bitv - to a total of n bits. Requires that n is a multiple of bitv's length. - Modified from the bits(N) Replicate(bits(M) x) function from - ARMv8 ISA pseudocode." - (let ((bitv-length (word-width bitv))) - (assert-msg (= 0 (mod n bitv-length)) "replicate-to-fill n not multiple of len(bitv)") - (replicate bitv (/ n bitv-length)))) - (defun zeros (n) - "(zeros n) returns an empty bitvector of length n. - Modified from ARMv8 ISA pseudocode." - (replicate 0:1 n)) + "(zeros n) returns an empty bitvector of length n." + (cast-unsigned n 0:1)) (defun ones (n) - "(ones n) returns a bitvector of length n with all bits set. - Modified from ARMv8 ISA pseudocode." - (replicate 1:1 n)) - -(defun zero-extend (bitv result-length) - "(zero-extend bitv result-length) returns a bitvector of - length result-length formed by prepending bitv with zeros. - Translated from ARMv8 ISA pseudocode." - (let ((bitv-length (word-width bitv))) - (assert-msg (>= result-length bitv-length) "zero-extend len(bitv) > result-length") - (concat - (zeros (- result-length bitv-length)) - bitv))) + "(ones n) returns a bitvector of length n with all bits set." + (lnot (zeros n))) (defun rotate-right (bitv n) "(rotate-right bitv n) rotates bitv to the right by n positions. - Carry-out is ignored. - Modified from ARMv8 ISA pseudocode." + Carry-out is ignored." (if (= n 0) bitv (let ((bitv-length (word-width bitv)) @@ -79,8 +56,7 @@ (defun rotate-left (bitv n) "(rotate-right bitv n) rotates bitv to the right by n positions. - Carry-out is ignored. - Adapted from rotate-right code in ARMv8 ISA pseudocode." + Carry-out is ignored." (if (= n 0) bitv (let ((bitv-length (word-width bitv)) From 647a9e4cabbc0914e341cbaca9e5e84592a05248 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Tue, 12 Apr 2022 06:22:17 +0000 Subject: [PATCH 027/132] update barrier code to use symbol-concat (#1452) --- plugins/arm/semantics/aarch64-helper.lisp | 54 +++++++--------------- plugins/arm/semantics/aarch64-special.lisp | 18 ++++---- 2 files changed, 26 insertions(+), 46 deletions(-) diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index 75207f59f..ac4e062df 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -81,41 +81,21 @@ (imms (extract 5 0 mask))) (decode-bit-masks N imms immr true))) -(defun barrier-option-to-symbol (barrier-type option) - "(barrier-option-to-symbol barrier-type option) converts the - barrier type (:dmb, :dsb, :isb) and 4-bit optional value - to a symbol. +(defun barrier-option-to-symbol (option) + "(barrier-option-to-symbol option) converts the + 4-bit optional value to a symbol. This is to be used with the (special) primitive." - (case barrier-type - :dmb - (case option - 0b1111 :barrier-dmb-sy - 0b1110 :barrier-dmb-st - 0b1101 :barrier-dmb-ld - 0b1011 :barrier-dmb-ish - 0b1010 :barrier-dmb-ishst - 0b1001 :barrier-dmb-ishld - 0b0111 :barrier-dmb-nsh - 0b0110 :barrier-dmb-nshst - 0b0101 :barrier-dmb-nshld - 0b0011 :barrier-dmb-osh - 0b0010 :barrier-dmb-oshst - 0b0001 :barrier-dmb-oshld - :barrier-dmb-unknown) - :dsb - (case option - 0b1111 :barrier-dsb-sy - 0b1110 :barrier-dsb-st - 0b1101 :barrier-dsb-ld - 0b1011 :barrier-dsb-ish - 0b1010 :barrier-dsb-ishst - 0b1001 :barrier-dsb-ishld - 0b0111 :barrier-dsb-nsh - 0b0110 :barrier-dsb-nshst - 0b0101 :barrier-dsb-nshld - 0b0011 :barrier-dsb-osh - 0b0010 :barrier-dsb-oshst - 0b0001 :barrier-dsb-oshld - :barrier-dsb-unknown) - :isb - :barrier-isb-sy)) + (case option + 0b1111 :sy + 0b1110 :st + 0b1101 :ld + 0b1011 :ish + 0b1010 :ishst + 0b1001 :ishld + 0b0111 :nsh + 0b0110 :nshst + 0b0101 :nshld + 0b0011 :osh + 0b0010 :oshst + 0b0001 :oshld + :unknown)) diff --git a/plugins/arm/semantics/aarch64-special.lisp b/plugins/arm/semantics/aarch64-special.lisp index 3a6b82b59..fc5ee553a 100644 --- a/plugins/arm/semantics/aarch64-special.lisp +++ b/plugins/arm/semantics/aarch64-special.lisp @@ -4,17 +4,17 @@ ;;; SPECIAL INSTRUCTIONS -(defun DMB (option) - (special (barrier-option-to-symbol :dmb option))) +(defun make-barrier (barrier-type option) + (special (symbol-concat :barrier barrier-type (barrier-option-to-symbol option)))) -(defun DSB (option) - (special (barrier-option-to-symbol :dsb option))) +(defun DMB (option) (make-barrier :dmb option)) -(defun ISB (option) - ;; strictly speaking, only the sy option is valid and is - ;; the default option (it can be omitted from the mnemonic). - ;; still including option here though - (special (barrier-option-to-symbol :dmb option))) +(defun DSB (option) (make-barrier :dsb option)) + +;; strictly speaking, only the sy option is valid and is +;; the default option (it can be omitted from the mnemonic). +;; still including option here though +(defun ISB (option) (make-barrier :isb option)) (defun HINT (_) (empty)) From dbaf5362c6bf9b593f20c4fc963f7f6188582887 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Tue, 12 Apr 2022 10:52:34 +0000 Subject: [PATCH 028/132] fix CAS and friends for X registers --- plugins/arm/semantics/aarch64-atomic.lisp | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/plugins/arm/semantics/aarch64-atomic.lisp b/plugins/arm/semantics/aarch64-atomic.lisp index ff0dad840..bf07bc715 100644 --- a/plugins/arm/semantics/aarch64-atomic.lisp +++ b/plugins/arm/semantics/aarch64-atomic.lisp @@ -5,7 +5,7 @@ ;;; ATOMIC OPERATIONS (defmacro CASordX (rs rt rn acquire-ordering release-ordering) - "(CASord*r set load store rs rt rn acquire-ordering release-ordering) + "(CASordX rs rt rn acquire-ordering release-ordering) implements a generic compare-and-swap instruction on a X register. acquire-ordering and release-ordering are booleans indicating whether load-acquire and store-release ordering is to be enforced." @@ -16,10 +16,14 @@ (store-word rn rt)) (set$ rs data))) -(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)) +;; 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)) + (defmacro CSop*r (set op rd rn rm cnd) "(CSop*r set op rd rn rm cnd) implements the conditional select From d0016c44eb1d26082a6a551c2b4bddd7b4a83b9d Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Tue, 12 Apr 2022 11:16:35 +0000 Subject: [PATCH 029/132] generalise CAS to W or X registers --- plugins/arm/semantics/aarch64-atomic.lisp | 29 ++++++++++++++++++----- 1 file changed, 23 insertions(+), 6 deletions(-) diff --git a/plugins/arm/semantics/aarch64-atomic.lisp b/plugins/arm/semantics/aarch64-atomic.lisp index bf07bc715..cdbbdae07 100644 --- a/plugins/arm/semantics/aarch64-atomic.lisp +++ b/plugins/arm/semantics/aarch64-atomic.lisp @@ -4,17 +4,29 @@ ;;; ATOMIC OPERATIONS -(defmacro CASordX (rs rt rn acquire-ordering release-ordering) - "(CASordX rs rt rn acquire-ordering release-ordering) - implements a generic compare-and-swap instruction on a X register. +(defmacro CASord* (set load store rs rt rn acquire-ordering release-ordering) + "(CASord* set load store rs rt rn acquire-ordering release-ordering) + 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-ordering and release-ordering are booleans indicating whether load-acquire and store-release ordering is to be enforced." - (let ((data (load-word rn))) + (let ((data (load rn))) (when acquire-ordering (special :load-acquire)) (when (= data rs) (when release-ordering (special :store-release)) - (store-word rn rt)) - (set$ rs data))) + (store rn rt)) + (set rs data))) + +(defmacro CASordX (rs rt rn acquire-ordering release-ordering) + "Specialisation of CASord* for X registers." + (CASord* set$ load-word store-word rs rt rn acquire-ordering release-ordering)) + +(defmacro store-hword (dst src) (store-word dst (cast-low 32 src))) + +(defmacro CASordW (rs rt rn acquire-ordering release-ordering) + "Specialisation of CASord* for W registers." + (CASord* setw load-hword store-hword rs rt rn acquire-ordering release-ordering)) ;; not sure why llvm returns 4 arguments. ;; when i've tested it, the first and second arguments are always the same value @@ -24,6 +36,11 @@ (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)) + (defmacro CSop*r (set op rd rn rm cnd) "(CSop*r set op rd rn rm cnd) implements the conditional select From 1dd5ed41b996024fcde9a9c0562ba4cb3197ff30 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Tue, 12 Apr 2022 11:48:38 +0000 Subject: [PATCH 030/132] generalise CAS and friends to 8-bit and 16-bit --- plugins/arm/semantics/aarch64-atomic.lisp | 28 +++++++++++++++++++---- 1 file changed, 24 insertions(+), 4 deletions(-) diff --git a/plugins/arm/semantics/aarch64-atomic.lisp b/plugins/arm/semantics/aarch64-atomic.lisp index cdbbdae07..30dd81c84 100644 --- a/plugins/arm/semantics/aarch64-atomic.lisp +++ b/plugins/arm/semantics/aarch64-atomic.lisp @@ -18,29 +18,49 @@ (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-ordering release-ordering) "Specialisation of CASord* for X registers." (CASord* set$ load-word store-word rs rt rn acquire-ordering release-ordering)) -(defmacro store-hword (dst src) (store-word dst (cast-low 32 src))) - (defmacro CASordW (rs rt rn acquire-ordering release-ordering) "Specialisation of CASord* for W registers." (CASord* setw load-hword store-hword rs rt rn acquire-ordering release-ordering)) +(defmacro CASordB (rs rt rn acquire-ordering release-ordering) + "Specialisation of CASord* operating on individual bytes." + (CASord* setw memory-read store-byte rs rt rn acquire-ordering release-ordering)) + +(defmacro CASordH (rs rt rn acquire-ordering release-ordering) + "Specialisation of CASord* for 16-bit values." + (CASord* setw load-quarter-word store-quarter-word rs rt rn acquire-ordering release-ordering)) + ;; 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 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 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 From e5be8cb4f009cf64dd2d4c2a1aed702c197d14ab Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Tue, 12 Apr 2022 11:51:38 +0000 Subject: [PATCH 031/132] rename CAS parameter names --- plugins/arm/semantics/aarch64-atomic.lisp | 28 +++++++++++------------ 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/plugins/arm/semantics/aarch64-atomic.lisp b/plugins/arm/semantics/aarch64-atomic.lisp index 30dd81c84..f2f809914 100644 --- a/plugins/arm/semantics/aarch64-atomic.lisp +++ b/plugins/arm/semantics/aarch64-atomic.lisp @@ -4,17 +4,17 @@ ;;; ATOMIC OPERATIONS -(defmacro CASord* (set load store rs rt rn acquire-ordering release-ordering) - "(CASord* set load store rs rt rn acquire-ordering release-ordering) +(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-ordering and release-ordering are booleans indicating whether - load-acquire and store-release ordering is to be enforced." + acquire and release are booleans indicating whether load-acquire and + store-release ordering is to be enforced." (let ((data (load rn))) - (when acquire-ordering (special :load-acquire)) + (when acquire (special :load-acquire)) (when (= data rs) - (when release-ordering (special :store-release)) + (when release (special :store-release)) (store rn rt)) (set rs data))) @@ -22,21 +22,21 @@ (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-ordering release-ordering) +(defmacro CASordX (rs rt rn acquire release) "Specialisation of CASord* for X registers." - (CASord* set$ load-word store-word rs rt rn acquire-ordering release-ordering)) + (CASord* set$ load-word store-word rs rt rn acquire release)) -(defmacro CASordW (rs rt rn acquire-ordering release-ordering) +(defmacro CASordW (rs rt rn acquire release) "Specialisation of CASord* for W registers." - (CASord* setw load-hword store-hword rs rt rn acquire-ordering release-ordering)) + (CASord* setw load-hword store-hword rs rt rn acquire release)) -(defmacro CASordB (rs rt rn acquire-ordering release-ordering) +(defmacro CASordB (rs rt rn acquire release) "Specialisation of CASord* operating on individual bytes." - (CASord* setw memory-read store-byte rs rt rn acquire-ordering release-ordering)) + (CASord* setw memory-read store-byte rs rt rn acquire release)) -(defmacro CASordH (rs rt rn acquire-ordering release-ordering) +(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-ordering release-ordering)) + (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 From ca14999dea642a8334f128265b788e84837d6913 Mon Sep 17 00:00:00 2001 From: ivg Date: Tue, 12 Apr 2022 09:57:31 -0400 Subject: [PATCH 032/132] fixes the cast-signed Primus Lisp primitive --- plugins/primus_lisp/primus_lisp_semantic_primitives.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/plugins/primus_lisp/primus_lisp_semantic_primitives.ml b/plugins/primus_lisp/primus_lisp_semantic_primitives.ml index 0bab7f66d..70763700f 100644 --- a/plugins/primus_lisp/primus_lisp_semantic_primitives.ml +++ b/plugins/primus_lisp/primus_lisp_semantic_primitives.ml @@ -824,8 +824,8 @@ module Primitives(CT : Theory.Core)(T : Target) = struct bitv x >>= fun x -> match const x with | None -> forget@@cast s !!x | Some v -> - let r = Theory.Bitv.size s in - let w = Theory.Bitv.size @@ Theory.Value.sort x in + let r = size s in + let w = size @@ Theory.Value.sort x in forget@@const_int s@@match t with | `hi -> Bitvec.extract ~hi:(w-1) ~lo:(w-r) v | `lo -> Bitvec.extract ~hi:r ~lo:0 v @@ -835,7 +835,7 @@ module Primitives(CT : Theory.Core)(T : Target) = struct let open Bitvec.Make(struct let modulus = Bitvec.modulus r end) in - (ones lsl int Int.(r - w)) lor v + (ones lsl int w) lor v else Bitvec.extract ~hi:r ~lo:0 v let signed = mk_cast `se CT.signed From 05efc67782941f8f889b7d49e6bbdc87e3f4e8bf Mon Sep 17 00:00:00 2001 From: ivg Date: Tue, 12 Apr 2022 17:12:16 -0400 Subject: [PATCH 033/132] 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. --- .../primus_lisp_semantic_primitives.ml | 87 ++++++++++--------- 1 file changed, 47 insertions(+), 40 deletions(-) diff --git a/plugins/primus_lisp/primus_lisp_semantic_primitives.ml b/plugins/primus_lisp/primus_lisp_semantic_primitives.ml index 0bab7f66d..6aac1aa3a 100644 --- a/plugins/primus_lisp/primus_lisp_semantic_primitives.ml +++ b/plugins/primus_lisp/primus_lisp_semantic_primitives.ml @@ -3,6 +3,7 @@ open Bap_core_theory open Bap_primus.Std open KB.Syntax open KB.Let +module Z = Bitvec let export = Primus.Lisp.Type.Spec.[ "+", all any @-> any, @@ -377,18 +378,22 @@ module Primitives(CT : Theory.Core)(T : Target) = struct let nbitv = KB.List.map ~f:bitv - let join_types s xs = + let join s xs = List.max_elt xs ~compare:(fun x y -> let xs = sort x and ys = sort y in Theory.Bitv.(compare_int (size xs) (size ys))) |> function | None -> s | Some v -> sort v - let with_nbitv s xs f = match xs with + let first s = function + | [] -> s + | x::_ -> sort x + + let with_nbitv s cast xs f = match xs with | [] -> f s [] | xs -> nbitv xs >>= fun xs -> - f (join_types s xs) xs + f (cast s xs) xs type 'a bitv = 'a Theory.Bitv.t Theory.Value.sort @@ -398,15 +403,17 @@ module Primitives(CT : Theory.Core)(T : Target) = struct | Some x -> const_int s x | None -> CT.signed s !!x - let monoid s sf df init xs = - with_nbitv s xs @@ fun s xs -> match xs with - | [] -> forget@@const_int s init + let monoid s cast sf df init xs = + with_nbitv s cast xs @@ fun s xs -> + let m = Z.modulus (size s) in + match xs with + | [] -> forget@@const_int s Z.(init mod m) | x :: xs -> let* init = coerce s x in KB.List.fold ~init xs ~f:(fun res x -> match const res, const x with | Some res, Some x -> - const_int s@@sf res x + const_int s Z.(sf res x mod m) | _ -> let* x = coerce s x in df !!res !!x) |> @@ -438,12 +445,13 @@ module Primitives(CT : Theory.Core)(T : Target) = struct let order sf df xs = forget@@is_ordered sf df xs - let all sf df xs = + let all s cast sf df xs = true_ >>= fun init -> + with_nbitv s cast xs @@ fun s xs -> + let m = Z.modulus (size s) in KB.List.fold ~init xs ~f:(fun r x -> - bitv x >>= fun x -> let r' = match const x with - | Some x -> const_bool (sf x) + | Some x -> const_bool Z.(sf x m) | None -> df !!x in r' >>= fun r' -> r &&& r') |> @@ -473,9 +481,16 @@ module Primitives(CT : Theory.Core)(T : Target) = struct let stores = memory Theory.Effect.Sort.wmem let loads = pure - let is_negative x = CT.msb x - let is_positive x = - CT.(and_ (non_zero x) (inv (is_negative x))) + + let d_is_negative x = CT.msb x + let d_is_positive x = + CT.(and_ (non_zero x) (inv (d_is_negative x))) + + let s_is_negative x m = Z.(msb x mod m) + let s_is_positive x m = + not (Z.(s_is_negative x m) && Z.equal x Z.zero) + let s_is_zero x _ = + Z.equal x Z.zero let word_width s xs = nbitv xs >>= fun xs -> @@ -588,13 +603,14 @@ module Primitives(CT : Theory.Core)(T : Target) = struct | Some v -> forget@@const_int (sort x) v let apply_static s x = - let m = Bitvec.modulus (Theory.Bitv.size s) in + let m = Bitvec.modulus (size s) in forget@@const_int s Bitvec.(x mod m) let lnot x = bitv x >>= fun x -> match const x with | None -> forget@@CT.not !!x - | Some v -> apply_static (sort x) (Bitvec.lnot v) + | Some v -> + apply_static (sort x) (Bitvec.lnot v) let one_op_x sop dop x = bitv x >>= fun x -> match const x with @@ -895,15 +911,6 @@ module Primitives(CT : Theory.Core)(T : Target) = struct (CT.extract b1 (int s b) (int s b) !!x)) let bits = Theory.Target.bits target - module Z = struct - include Bitvec.Make(struct - let modulus = Bitvec.modulus bits - end) - let is_zero = Bitvec.equal zero - let is_negative = msb - let is_positive x = - not (is_negative x) && not (is_zero x) - end let s = Theory.Bitv.define bits @@ -928,23 +935,23 @@ module Primitives(CT : Theory.Core)(T : Target) = struct let dispatch lbl name args = let t = target in match name,args with - | "+",_-> pure@@monoid s Z.add CT.add Z.zero args + | "+",_-> pure@@monoid s join Z.add CT.add (Z.int 0) args | "-",[x]|"neg",[x] -> pure@@neg x - | "-",_-> pure@@monoid s Z.sub CT.sub Z.zero args - | "*",_-> pure@@monoid s Z.mul CT.mul Z.one args + | "-",_-> pure@@monoid s join Z.sub CT.sub (Z.int 0) args + | "*",_-> pure@@monoid s join Z.mul CT.mul (Z.int 1) args | "/",[x]-> pure@@reciprocal x - | "/",_-> pure@@monoid s Z.div CT.div Z.one args + | "/",_-> pure@@monoid s join Z.div CT.div (Z.int 1) args | "s/",[x]-> pure@@sreciprocal x - | "s/",_-> pure@@monoid s Z.sdiv CT.sdiv Z.one args - | "mod",_-> pure@@monoid s Z.rem CT.modulo Z.one args + | "s/",_-> pure@@monoid s join Z.sdiv CT.sdiv (Z.int 1) args + | "mod",_-> pure@@monoid s join Z.rem CT.modulo (Z.int 1) args | "lnot",[x] -> pure@@lnot x - | "signed-mod",_-> pure@@monoid s Z.srem CT.smodulo Z.one args - | "lshift",_-> pure@@monoid s Z.lshift CT.lshift Z.one args - | "rshift",_-> pure@@monoid s Z.rshift CT.rshift Z.one args - | "arshift",_-> pure@@monoid s Z.arshift CT.arshift Z.one args - | "logand",_-> pure@@monoid s Z.logand CT.logand Z.ones args - | "logor",_-> pure@@monoid s Z.logor CT.logor Z.zero args - | "logxor",_-> pure@@monoid s Z.logxor CT.logxor Z.zero args + | "signed-mod",_-> pure@@monoid s join Z.srem CT.smodulo (Z.int 1) args + | "lshift",_-> pure@@monoid s first Z.lshift CT.lshift (Z.int 1) args + | "rshift",_-> pure@@monoid s first Z.rshift CT.rshift (Z.int 1) args + | "arshift",_-> pure@@monoid s first Z.arshift CT.arshift (Z.int 1) args + | "logand",_-> pure@@monoid s join Z.logand CT.logand (Z.int 1) args + | "logor",_-> pure@@monoid s join Z.logor CT.logor (Z.int 0) args + | "logxor",_-> pure@@monoid s join Z.logxor CT.logxor (Z.int 0) args | "=",_-> pure@@order Bitvec.(=) CT.eq args | "<",_-> pure@@order Bitvec.(<) CT.ult args | "s<",_ -> pure@@order SBitvec.(<) CT.slt args @@ -955,9 +962,9 @@ module Primitives(CT : Theory.Core)(T : Target) = struct | "s<=",_-> pure@@order SBitvec.(<=) CT.ule args | "s>=",_-> pure@@order SBitvec.(>=) CT.uge args | "/=",_| "distinct",_-> pure@@forget@@distinct args - | "is-zero",_| "not",_-> pure@@all Bitvec.(equal zero) CT.is_zero args - | "is-positive",_-> pure@@all Z.is_positive is_positive args - | "is-negative",_-> pure@@all Z.is_negative is_negative args + | "is-zero",_| "not",_-> pure@@all s join s_is_zero CT.is_zero args + | "is-positive",_-> pure@@all s join s_is_positive d_is_positive args + | "is-negative",_-> pure@@all s join s_is_negative d_is_negative args | "word-width",_-> pure@@word_width s args | "exec-addr",_-> ctrl@@exec_addr args | "goto-subinstruction",_ -> ctrl@@goto_subinstruction lbl args From 9ce14068b39f3c25b9bf28c51a28e31c57d03c7b Mon Sep 17 00:00:00 2001 From: ivg Date: Tue, 12 Apr 2022 17:17:06 -0400 Subject: [PATCH 034/132] adds arbitrary-precision loopless clz and popcount in Primus Lisp --- plugins/arm/semantics/arm.lisp | 2 +- plugins/primus_lisp/semantics/bits.lisp | 113 +++++++++++++++++++----- 2 files changed, 92 insertions(+), 23 deletions(-) diff --git a/plugins/arm/semantics/arm.lisp b/plugins/arm/semantics/arm.lisp index b14e62c49..6e44cf670 100644 --- a/plugins/arm/semantics/arm.lisp +++ b/plugins/arm/semantics/arm.lisp @@ -6,4 +6,4 @@ (defun CLZ (rd rn pre _) (when (condition-holds pre) - (set$ rd (clz32 rn)))) + (set$ rd (clz rn)))) diff --git a/plugins/primus_lisp/semantics/bits.lisp b/plugins/primus_lisp/semantics/bits.lisp index d5c5f3bdc..5dcee002d 100644 --- a/plugins/primus_lisp/semantics/bits.lisp +++ b/plugins/primus_lisp/semantics/bits.lisp @@ -26,35 +26,85 @@ (logor (logand (msb rn) (msb rm) (lnot (msb rd))) (logand (lnot (msb rn)) (lnot (msb rm)) (msb rd)))) -(defmacro popcount/helper (x sh m1 m2 m4 h01) - (prog - (set x (- x (logand (rshift x 1) m1))) - (set x (+ (logand x m2) (logand (rshift x 2) m2))) - (set x (logand (+ x (rshift x 4)) m4)) - (rshift (* x h01) sh))) - -(defmacro popcount16 (x) +(defun clz (x) + "(clz X) counts leading zeros in X. + The returned value is the number of consecutive zeros starting + from the most significant bit. Returns 0 for 0 and works for + inputs of any size, including inputs that are not statically + known. In the latter case, the computation is unfolded into + the loopless code with the size proportional to the size of word + divided by 64." + (case (word-width x) + 8 (clz8 x) + 16 (clz16 x) + 32 (clz32 x) + 64 (clz64 x) + (if (> (word-width x) 64) + (clz/rec x) + (clz/small x)))) + +(defun popcount (x) + "(popcount X) computes the total number of 1 bits in X." + (if (> (word-width x) 64) + (+ (popcount64 (cast-high 64 x)) + (popcount (cast-low (- (word-width x) 64) x))) + (if (= (word-width x) 64) + (popcount64 x) + (popcount64 (cast-unsigned 64 x))))) + +;; private helpers + +(defun popcount/helper (x sh m1 m2 m4 h01) + (declare (visibility :private)) + (let ((x x)) + (set x (- x (logand (rshift x 1) m1))) + (set x (+ (logand x m2) (logand (rshift x 2) m2))) + (set x (logand (+ x (rshift x 4)) m4)) + (rshift (* x h01) sh))) + +(defun popcount8 (x) + (declare (visibility :private)) + (popcount/helper x 0 + 0x55:8 + 0x33:8 + 0x0f:8 + 0x01:8)) + +(defun popcount16 (x) + (declare (visibility :private)) (popcount/helper x 8 - 0x5555 - 0x3333 - 0x0f0f - 0x0101)) + 0x5555:16 + 0x3333:16 + 0x0f0f:16 + 0x0101:16)) -(defmacro popcount32 (x) +(defun popcount32 (x) + (declare (visibility :private)) (popcount/helper x 24 - 0x55555555 - 0x33333333 - 0x0f0f0f0f - 0x01010101)) + 0x55555555:32 + 0x33333333:32 + 0x0f0f0f0f:32 + 0x01010101:32)) -(defmacro popcount64 (x) +(defun popcount64 (x) + (declare (visibility :private)) (popcount/helper x 56 - 0x5555555555555555 - 0x3333333333333333 - 0x0f0f0f0f0f0f0f0f - 0x0101010101010101)) + 0x5555555555555555:64 + 0x3333333333333333:64 + 0x0f0f0f0f0f0f0f0f:64 + 0x0101010101010101:64)) + +(defun clz8 (r) + (declare (visibility :private)) + (let ((x r)) + (set x (logor x (rshift x 1))) + (set x (logor x (rshift x 2))) + (set x (logor x (rshift x 4))) + (set x (lnot x)) + (popcount8 x))) (defun clz16 (r) + (declare (visibility :private)) (let ((x r)) (set x (logor x (rshift x 1))) (set x (logor x (rshift x 2))) @@ -64,6 +114,7 @@ (popcount16 x))) (defun clz32 (x) + (declare (visibility :private)) (let ((x x)) (set x (logor x (rshift x 1))) (set x (logor x (rshift x 2))) @@ -74,6 +125,7 @@ (popcount32 x))) (defun clz64 (x) + (declare (visibility :private)) (let ((x x)) (set x (logor x (rshift x 1))) (set x (logor x (rshift x 2))) @@ -83,3 +135,20 @@ (set x (logor x (rshift x 32))) (set x (lnot x)) (popcount64 x))) + +(defun clz/rec (x) + (declare (visibility :private)) + (if (> (word-width x) 64) + (if (is-zero (cast-high 64 x)) + (+ 64 (clz (cast-low (- (word-width x) 64) x))) + (clz64 (cast-high 64 x))) + (clz x))) + +(defun clz/small (x) + (declare (visibility :private)) + (let ((w (word-width x))) + (if (< w 8) (- (clz8 (cast-unsigned 8 x)) (- 8 w)) + (if (< w 16) (- (clz16 (cast-unsigned 16 x)) (- 16 w)) + (if (< w 32) (- (clz32 (cast-unsigned 32 x)) (- 32 w)) + (if (< w 64) (- (clz64 (cast-unsigned 64 x)) (- 64 w)) + (clz x))))))) From 4e5cd71aea37cb98e78daa0d304ba577c2dcef56 Mon Sep 17 00:00:00 2001 From: ivg Date: Tue, 12 Apr 2022 17:45:29 -0400 Subject: [PATCH 035/132] uses clz instead of clz64 and properly casts the operand --- plugins/arm/semantics/aarch64-helper.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index ac4e062df..4e38ae652 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -55,7 +55,7 @@ called with true. Modified from ARMv8 ISA pseudocode." (let ((memory-width 64) ; change to 32 if 32-bit system - (len (- 64 (clz64 (concat immN (lnot imms))) 1)) + (len (- 64 (clz (cast-unsigned 64 (concat immN (lnot imms)))) 1)) (levels (cast-unsigned 6 (ones len))) (S (logand imms levels)) (R (logand immr levels)) From c642d9b4b5bf30d9e19f7c3f2f6235aea853a441 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Wed, 20 Apr 2022 01:30:55 +0000 Subject: [PATCH 036/132] use fixed cast-signed primitive from #1462 --- plugins/primus_lisp/semantics/bits.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/primus_lisp/semantics/bits.lisp b/plugins/primus_lisp/semantics/bits.lisp index 69926fa2c..d0b9514f6 100644 --- a/plugins/primus_lisp/semantics/bits.lisp +++ b/plugins/primus_lisp/semantics/bits.lisp @@ -39,7 +39,7 @@ (defun ones (n) "(ones n) returns a bitvector of length n with all bits set." - (lnot (zeros n))) + (cast-signed n 1:1)) (defun rotate-right (bitv n) "(rotate-right bitv n) rotates bitv to the right by n positions. From c5a8a64211391e650717ff560324c5f1f20a6c5b Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Wed, 20 Apr 2022 03:31:43 +0000 Subject: [PATCH 037/132] 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. --- plugins/arm/semantics/aarch64-helper.lisp | 21 +++++++++++---------- plugins/arm/semantics/aarch64-logical.lisp | 21 +++++++++++---------- 2 files changed, 22 insertions(+), 20 deletions(-) diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index 4e38ae652..b3f120c67 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -47,15 +47,15 @@ 0b111 rm) off))) -(defun decode-bit-masks (immN imms immr immediate) - "(decode-bit-masks immN imms immr immediate) returns the immediate value +(defun decode-bit-masks (immN imms immr immediate register-width) + "(decode-bit-masks immN imms immr immediate register-width) returns the immediate value corresponding to the immN:immr:imms bit pattern within opcodes of ARMv8 logical operation instructions like AND, ORR etc. + register-width denotes the width of the registers to be acted on (32 or 64). I'm not sure what the immediate parameter does, but it's nearly always called with true. Modified from ARMv8 ISA pseudocode." - (let ((memory-width 64) ; change to 32 if 32-bit system - (len (- 64 (clz (cast-unsigned 64 (concat immN (lnot imms)))) 1)) + (let ((len (- 64 (clz (cast-unsigned 64 (concat immN (lnot imms)))) 1)) (levels (cast-unsigned 6 (ones len))) (S (logand imms levels)) (R (logand immr levels)) @@ -66,20 +66,21 @@ (d (extract (- len 1) 0 diff)) (welem (cast-unsigned esize (ones (+ S 1)))) (telem (cast-unsigned esize (ones (+ d 1)))) - (wmask (replicate-to-fill (rotate-right welem R) memory-width)) - (tmask (replicate-to-fill telem memory-width))) + (wmask (replicate-to-fill (rotate-right welem R) register-width)) + (tmask (replicate-to-fill telem register-width))) ; it seems like wmask is for logical immediates, and tmask is not used ; anywhere in the ISA except for the BFM instruction and its aliases. ; we're just returning wmask here. wmask))) -(defun immediate-from-bitmask (mask) - "(immediate-from-bitmask mask) returns the immediate value corresponding to - the given 13-bit mask in the form of N:immr:imms." +(defun immediate-from-bitmask (mask register-width) + "(immediate-from-bitmask mask register-width) returns the immediate value corresponding to + the given 13-bit mask in the form of N:immr:imms. + register-width denotes the width of the registers to be acted on (32 or 64)." (let ((N (select 12 mask)) (immr (extract 11 6 mask)) (imms (extract 5 0 mask))) - (decode-bit-masks N imms immr true))) + (decode-bit-masks N imms immr true register-width))) (defun barrier-option-to-symbol (option) "(barrier-option-to-symbol option) converts the diff --git a/plugins/arm/semantics/aarch64-logical.lisp b/plugins/arm/semantics/aarch64-logical.lisp index 6535840ea..05e4f1ba9 100644 --- a/plugins/arm/semantics/aarch64-logical.lisp +++ b/plugins/arm/semantics/aarch64-logical.lisp @@ -26,17 +26,18 @@ (defun EORXrs (rd rn rm is) (log*rs set$ logxor rd rn rm is)) (defun ANDXrs (rd rn rm is) (log*rs set$ logand rd rn rm is)) -(defmacro log*ri (set op rd rn imm) - "(log*ri set op rd rn imm) implements the logical operation (immediate) instruction - accepting either a W or X register. op is the binary logical operation." - (set rd (op rn (immediate-from-bitmask imm)))) +(defmacro log*ri (set op rd rn imm register-width) + "(log*ri set op rd rn imm register-width) implements the logical operation (immediate) instruction + accepting either a W or X register. op is the binary logical operation, and register-width + is the width of the given registers." + (set rd (op rn (immediate-from-bitmask imm register-width)))) -(defun ANDWri (rd rn imm) (log*ri setw logand rd rn imm)) -(defun ANDXri (rd rn imm) (log*ri set$ logand rd rn imm)) -(defun EORWri (rd rn imm) (log*ri setw logxor rd rn imm)) -(defun EORXri (rd rn imm) (log*ri set$ logxor rd rn imm)) -(defun ORRWri (rd rn imm) (log*ri setw logor rd rn imm)) -(defun ORRXri (rd rn imm) (log*ri set$ logor rd rn imm)) +(defun ANDWri (rd rn imm) (log*ri setw logand rd rn imm 32)) +(defun ANDXri (rd rn imm) (log*ri set$ logand rd rn imm 64)) +(defun EORWri (rd rn imm) (log*ri setw logxor rd rn imm 32)) +(defun EORXri (rd rn imm) (log*ri set$ logxor rd rn imm 64)) +(defun ORRWri (rd rn imm) (log*ri setw logor rd rn imm 32)) +(defun ORRXri (rd rn imm) (log*ri set$ logor rd rn imm 64)) ;; UBFM and SBFM ;; (bitfield moves) From d6301c9fe23d50035502f9e2e196e737fe4800aa Mon Sep 17 00:00:00 2001 From: Kaitlyn Lake Date: Mon, 25 Apr 2022 06:48:21 +0000 Subject: [PATCH 038/132] Created helper set-nzcv-after-logic-op to arm-bits, implemented REV in aarch64-logical, created helper reverse-bye-order, added docs --- plugins/arm/semantics/aarch64-logical.lisp | 50 +++++++++++++++++----- plugins/arm/semantics/arm-bits.lisp | 7 +++ 2 files changed, 47 insertions(+), 10 deletions(-) diff --git a/plugins/arm/semantics/aarch64-logical.lisp b/plugins/arm/semantics/aarch64-logical.lisp index 8bca78ed6..931c850ec 100644 --- a/plugins/arm/semantics/aarch64-logical.lisp +++ b/plugins/arm/semantics/aarch64-logical.lisp @@ -44,23 +44,20 @@ (defmacro ANDS*r* (setf rd rn immOp) "(ANDS*r* set rd rn immOp) implements the logical AND operation on either an X or W register with immediate/shifted immediate and sets the N, V, Z, C flags based on the result." (let ((result (logand rn immOp))) - (set NF (msb result)) - (set VF 0) - (set ZF (is-zero result)) - (set CF 0) + (set-nzcv-after-logic-op result) (setf rd result))) -(defmacro ANDS*ri (setf rd rn imm) +(defmacro ANDS*ri (setf size rd rn imm) "(ANDS*ri set rd rn imm) implements the logical AND operation on either an X or W register with immediate and sets the N, V, Z, C flags based on the result." - (let ((immOp (immediate-from-bitmask imm))) + (let ((immOp (immediate-from-bitmask imm size))) (ANDS*r* setf rd rn immOp))) -(defun ANDSWri (rd rn imm) (ANDS*ri setw rd rn imm)) -(defun ANDSXri (rd rn imm) (ANDS*ri set$ rd rn imm)) +(defun ANDSWri (rd rn imm) (ANDS*ri setw 32 rd rn imm)) +(defun ANDSXri (rd rn imm) (ANDS*ri set$ 64 rd rn imm)) (defmacro ANDS*rs (setf rd rn rm is) "(ANDS*rs set rd rn imm) implements the logical AND operation on either an X or W register with shifted immediate and sets the N, V, Z, C flags based on the result." - (let ((immOp (shifted rm is))) + (let ((immOp (shift-encoded rm is))) (ANDS*r* setf rd rn immOp))) (defun ANDSWrs (rd rn rm is) (ANDS*rs setw rd rn rm is)) @@ -70,6 +67,7 @@ ;; (bitfield moves) (defmacro ASRV*r (setr datasize rd rn rm) + "(ASRV*r setr datasize rd rn rm) does an arithmetic shift right and stores it in the destination register rd" (let ((shift (mod rm datasize))) (setr rd (arshift rn shift)))) @@ -80,13 +78,45 @@ ;; assumes immediate always provided... must fix... (defmacro BIC*r (setr rd rn rm is) - (let* ((shift (shifted rm is)) + "(BIC*r setr rd rn rm) stores the result of a logical and of rn with the complement of the contents of optionally shifted rm in rd" + (let ((shift (shift-encoded rm is)) (comp (lnot shift))) (setr rd (logand rn comp)))) (defun BICWr (rd rn rm is) (BIC*r setw rd rn rm is)) (defun BICXr (rd rn rm is) (BIC*r set$ rd rn rm is)) +(defmacro BICS*rs (setr rd rn rm is) + "(BICS*r setr rd rn rm) sets appropriate flags and stores the result of a logical and of rn with the complement of the contents of optionally shifted rm in rd" + (let ((shift (shift-encoded rm is)) + (comp (lnot shift)) + (result (logand rn comp))) + (set-nzcv-after-logic-op result) + (setr rd result))) + +(defun BICSWrs (rd rn rm is) (BICS*rs setw rd rn rm is)) +(defun BICSXrs (rd rn rm is) (BICS*rs set$ rd rn rm is)) + +;; REV... + +(defun reverse-byte-order (size rn) + (let ((byte_size 8) + (elements (/ size byte_size)) + (index 0) + (rev_index (+ index (* 8 (- elements 1)))) + (result (extract (+ index 7) index rn))) + (while (< index size) + (set index (+ index 8)) + (set rev_index (- rev_index 8)) + (set result (concat (extract (+ index 7) index rn) result))) + result)) + +(defmacro REV*r (setr size rd rn) + (setr rd (reverse-byte-order size rn))) + +(defun REVWr (rd rn) (REV*r setw 32 rd rn)) +(defun REVXr (rd rn) (REV*r set$ 64 rd rn)) + ;; UBFM and SBFM ;; (bitfield moves) diff --git a/plugins/arm/semantics/arm-bits.lisp b/plugins/arm/semantics/arm-bits.lisp index 71759d7c8..591365a2f 100644 --- a/plugins/arm/semantics/arm-bits.lisp +++ b/plugins/arm/semantics/arm-bits.lisp @@ -24,6 +24,13 @@ (set CF (select 1 nzcv)) (set VF (select 0 nzcv))) +(defun set-nzcv-after-logic-op (result) + "sets the flags after an AND operation i.e. sets the carry and overflow flags to zero and the negative and zero flags based on the result" + (set NF (msb result)) + (set ZF (is-zero result)) + (set CF 0) + (set VF 0)) + (defun add-with-carry (rd x y c) "(add-with-carry rd x y c) sets rd to the result of adding x and y with carry bit c, and sets processor flags." From 63c61c0e75248cd11ee6665039a385936f857bb4 Mon Sep 17 00:00:00 2001 From: Kaitlyn Lake Date: Tue, 3 May 2022 23:45:32 +0000 Subject: [PATCH 039/132] Implemented REV instructionin logical.lisp. Created reverse-byte-order helped in helper.lisp --- plugins/arm/semantics/aarch64-helper.lisp | 14 ++++++++++++++ plugins/arm/semantics/aarch64-logical.lisp | 13 +------------ 2 files changed, 15 insertions(+), 12 deletions(-) diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index b3f120c67..36749b79d 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -100,3 +100,17 @@ 0b0010 :oshst 0b0001 :oshld :unknown)) + +(defun reverse-byte-order (size rn) + "(reverse-byte-order) helper function to reverse the byte order of the contents of register rn of size size" + (let ((byte_size 8) + (elements (/ size byte_size)) + (index 0) + (rev_index (+ index (* 8 (- elements 1)))) + (result (extract (+ index 7) index rn))) + (while (< index size) + (set index (+ index 8)) + (set rev_index (- rev_index 8)) + (set result (concat (extract (+ index 7) index rn) result))) + result)) + diff --git a/plugins/arm/semantics/aarch64-logical.lisp b/plugins/arm/semantics/aarch64-logical.lisp index 931c850ec..d21f43706 100644 --- a/plugins/arm/semantics/aarch64-logical.lisp +++ b/plugins/arm/semantics/aarch64-logical.lisp @@ -99,19 +99,8 @@ ;; REV... -(defun reverse-byte-order (size rn) - (let ((byte_size 8) - (elements (/ size byte_size)) - (index 0) - (rev_index (+ index (* 8 (- elements 1)))) - (result (extract (+ index 7) index rn))) - (while (< index size) - (set index (+ index 8)) - (set rev_index (- rev_index 8)) - (set result (concat (extract (+ index 7) index rn) result))) - result)) - (defmacro REV*r (setr size rd rn) + "(REV*r setr size rd rn) reverses byte order of rn nd stores result in rd" (setr rd (reverse-byte-order size rn))) (defun REVWr (rd rn) (REV*r setw 32 rd rn)) From 1de82057c2efccacb907d099fe3ce4081355f8c5 Mon Sep 17 00:00:00 2001 From: Kaitlyn Lake Date: Tue, 10 May 2022 23:56:17 +0000 Subject: [PATCH 040/132] Added documentation to reverse-byte-order and REV functions, there may be an issue with their encoding --- plugins/arm/semantics/aarch64-helper.lisp | 2 +- plugins/arm/semantics/aarch64-logical.lisp | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index 36749b79d..6c90e1f93 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -102,7 +102,7 @@ :unknown)) (defun reverse-byte-order (size rn) - "(reverse-byte-order) helper function to reverse the byte order of the contents of register rn of size size" + "(reverse-byte-order) helper function to reverse the byte order of the contents of register rn of size size. THIS MAY HAVE ISSUES, it's only called by REV in aarch64-logical.lisp, and BIL output looks a bit funky" (let ((byte_size 8) (elements (/ size byte_size)) (index 0) diff --git a/plugins/arm/semantics/aarch64-logical.lisp b/plugins/arm/semantics/aarch64-logical.lisp index d21f43706..a1ce06978 100644 --- a/plugins/arm/semantics/aarch64-logical.lisp +++ b/plugins/arm/semantics/aarch64-logical.lisp @@ -100,7 +100,7 @@ ;; REV... (defmacro REV*r (setr size rd rn) - "(REV*r setr size rd rn) reverses byte order of rn nd stores result in rd" + "(REV*r setr size rd rn) reverses byte order of rn nd stores result in rd. THIS MAY HAVE ISSUES, see documentation in aarch64-helper.lisp reverse-byte-order, the BIL output looks a bit funky" (setr rd (reverse-byte-order size rn))) (defun REVWr (rd rn) (REV*r setw 32 rd rn)) From 642d53b712d6fbce739570de42c550e74b8bd65d Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Mon, 23 May 2022 03:43:35 +0000 Subject: [PATCH 041/132] fix and finish non-vector REV instructions --- plugins/arm/semantics/aarch64-helper.lisp | 41 ++++++++++++++++------ plugins/arm/semantics/aarch64-logical.lisp | 16 +++++---- 2 files changed, 40 insertions(+), 17 deletions(-) diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index 6c90e1f93..1deb551c3 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -101,16 +101,35 @@ 0b0001 :oshld :unknown)) -(defun reverse-byte-order (size rn) - "(reverse-byte-order) helper function to reverse the byte order of the contents of register rn of size size. THIS MAY HAVE ISSUES, it's only called by REV in aarch64-logical.lisp, and BIL output looks a bit funky" - (let ((byte_size 8) - (elements (/ size byte_size)) - (index 0) - (rev_index (+ index (* 8 (- elements 1)))) - (result (extract (+ index 7) index rn))) - (while (< index size) - (set index (+ index 8)) - (set rev_index (- rev_index 8)) - (set result (concat (extract (+ index 7) index rn) result))) +(defun replace-bit-range (reg hi lo val) + "(replace-bit-range reg hi lo val) returns reg with bits + hi to lo inclusive set to the value stored in val." + (let ((mask (lshift (cast-unsigned (word-width reg) (ones (+ (- hi lo) 1))) lo)) + (cleared (logand reg (lnot mask))) + (result (logor cleared (logand mask (lshift (cast-unsigned (word-width reg) val) lo))))) result)) +(defun reverse-elems-in-one-container (elem-size c) + "(reverse-elems-in-one-container elem-size c) reverses the order + of each group of elem-size bits in c. + For non-vector instructions, elem-size = 8. + If c's width is not a multiple of elem-size, the remaining bits + get appended at the end." + (if (<= (word-width c) elem-size) c + (concat + (cast-low elem-size c) + (reverse-elems-in-one-container elem-size + (cast-high (- (word-width c) elem-size) c))))) + +(defun reverse-elems-in-all-containers (container-size elem-size x) + "(reverse-elems-in-all-containers container-size elem-size x) applies + reverse-elems-in-one-container to each group of container-size bits in x. + In other words, it reverses the order of groups of elem-size bits within + each group of container-size bits. + If x's width is not a multiple of container-size, the remaining bits + get appended at the end." + (if (< (word-width x) container-size) x + (concat + (reverse-elems-in-one-container elem-size (cast-high container-size x)) + (reverse-elems-in-all-containers container-size elem-size + (cast-low (- (word-width x) container-size) x))))) \ No newline at end of file diff --git a/plugins/arm/semantics/aarch64-logical.lisp b/plugins/arm/semantics/aarch64-logical.lisp index a1ce06978..4c732a21e 100644 --- a/plugins/arm/semantics/aarch64-logical.lisp +++ b/plugins/arm/semantics/aarch64-logical.lisp @@ -99,12 +99,16 @@ ;; REV... -(defmacro REV*r (setr size rd rn) - "(REV*r setr size rd rn) reverses byte order of rn nd stores result in rd. THIS MAY HAVE ISSUES, see documentation in aarch64-helper.lisp reverse-byte-order, the BIL output looks a bit funky" - (setr rd (reverse-byte-order size rn))) - -(defun REVWr (rd rn) (REV*r setw 32 rd rn)) -(defun REVXr (rd rn) (REV*r set$ 64 rd rn)) +(defmacro REVn*r (setr container-size rd rn) + "(REVn*r setr container-size rd rn) implements the non-vector REV# + instructions with the given container-size." + (setr rd (reverse-elems-in-all-containers container-size 8 rn))) + +(defun REVWr (rd rn) (REVn*r setw 32 rd rn)) +(defun REVXr (rd rn) (REVn*r set$ 64 rd rn)) +(defun REV16Xr (rd rn) (REVn*r setw 16 rd rn)) +(defun REV16Wr (rd rn) (REVn*r set$ 16 rd rn)) +(defun REV32Xr (rd rn) (REVn*r setw 32 rd rn)) ;; UBFM and SBFM ;; (bitfield moves) From af6fef5dc76e19f9db99e9d12e05237c7dcd47fc Mon Sep 17 00:00:00 2001 From: Kaitlyn Lake Date: Tue, 14 Jun 2022 02:33:52 +0000 Subject: [PATCH 042/132] Added INSvi32gpr + INSvi32lane + helpers. Added pseudocode for LD2T --- plugins/arm/semantics/aarch64-helper.lisp | 19 +++++++- plugins/arm/semantics/aarch64-vector.lisp | 53 +++++++++++++++++++++++ 2 files changed, 71 insertions(+), 1 deletion(-) create mode 100644 plugins/arm/semantics/aarch64-vector.lisp diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index 1deb551c3..b3ebea73e 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -132,4 +132,21 @@ (concat (reverse-elems-in-one-container elem-size (cast-high container-size x)) (reverse-elems-in-all-containers container-size elem-size - (cast-low (- (word-width x) container-size) x))))) \ No newline at end of file + (cast-low (- (word-width x) container-size) x))))) + +(defun get-vector-size (width) + (case width + 0x8 0x0 + 0x10 0x1 + 0x20 0x2 + 0x40 0x3 + 0x4)) + +(defun get-vector-element (index vn) + (case index + 0x0 (extract 31 0 vn) + 0x1 (extract 63 32 vn) + 0x2 (extract 95 64 vn) + 0x3 (extract 127 96 vn) + 0x0)) + diff --git a/plugins/arm/semantics/aarch64-vector.lisp b/plugins/arm/semantics/aarch64-vector.lisp new file mode 100644 index 000000000..bf039efad --- /dev/null +++ b/plugins/arm/semantics/aarch64-vector.lisp @@ -0,0 +1,53 @@ +(declare (context (target armv8-a+le))) + +(in-package aarch64) + +;;; INS +;; with gp register + +;; (defmacro INSvi*gpr () ()) + +(defun INSvi32gpr (vd redundant index gpr) + "(INSvi32gpr vd ts index gpr) inserts an element in the general purpose register gpr into vecter register vd at index. NOTE: does not encode Security state & Exception level" + (let ((element (extract 32 0 gpr)) + (highIndex (* 32 (+ index 1))) + (lowIndex (- (* 32 index) 1)) + (topPart (rshift vd highIndex)) + (mask (replicate-to-fill (extract 0 0 0x1) lowIndex)) + (bottomPart (logand vd mask))) + (msg "width top: $0" (alias-base-register vd)) + (set-symbol-value vd (extract 127 0 (concat topPart element bottomPart))))) + +(defun INSvi32lane (vd redundant index1 vn index2) + "NOTE: does not encode Security state & Exception level" + (let ((selem (get-vector-element index2 vn)) + (highIndex (* 32 (+ index1 1))) + (lowIndex (- (* 32 index1) 1)) + (topPart (rshift vd highIndex)) + (mask (replicate-to-fill (extract 0 0 0x1) lowIndex)) + (bottomPart (logand vd mask))) + (set-symbol-value vd (extract 127 0 (concat topPart selem bottomPart))))) + +;; load (multiple structures) + +;; opcde = 1000, rpt = 1, selem = 2 +;; L = 1, MEMOP_LOAD +;; T = 16B, imm = #32, Q = 1, size = 00 +;; datasize = 128, esize = 8 +;; elements = 16 +;; pseudocode: + +;; for r = 0 to r = 0 +;; for e = 0 to e = 15 +;; tt = (UInt(qa) + 0) MOD 32; +;; for s = 0 to s = 1 +;; rval = V(tt) +;; Elem[rval, e, 8] = Mem[address+offs, 1, AccType_VEC] +;; V[tt] = rval +;; offs = offs + 1 +;; tt = (tt + 1) MOD 32; +;; if xn given, offs = X[n] +;; set if address/X reg given +(defun LD2Twov16b_POST (redundant qa_qb xn imm) + "NOTE: does not encode Security state & Exception level" + (msg "offset: $0" (alias-base-register imm))) From 1fb0669656dc62ee584754e34bb9569289678fe7 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Mon, 20 Jun 2022 06:09:46 +0000 Subject: [PATCH 043/132] test commit for github auth --- test.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 test.txt diff --git a/test.txt b/test.txt new file mode 100644 index 000000000..48f06090c --- /dev/null +++ b/test.txt @@ -0,0 +1 @@ +git auth test \ No newline at end of file From 4a2e594e5d81a4fcf25e12ec8e0a976c7112a252 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Mon, 20 Jun 2022 06:17:38 +0000 Subject: [PATCH 044/132] undo git test commit --- test.txt | 1 - 1 file changed, 1 deletion(-) delete mode 100644 test.txt diff --git a/test.txt b/test.txt deleted file mode 100644 index 48f06090c..000000000 --- a/test.txt +++ /dev/null @@ -1 +0,0 @@ -git auth test \ No newline at end of file From c8dce7100017d4992ec44a97050636c13b86fde6 Mon Sep 17 00:00:00 2001 From: alistair Date: Fri, 24 Jun 2022 00:33:07 +0000 Subject: [PATCH 045/132] implement ADDS, add set argument to add_with_carry --- plugins/arm/semantics/aarch64-arithmetic.lisp | 44 +++++++++++++++++-- plugins/arm/semantics/arm-bits.lisp | 5 ++- 2 files changed, 44 insertions(+), 5 deletions(-) diff --git a/plugins/arm/semantics/aarch64-arithmetic.lisp b/plugins/arm/semantics/aarch64-arithmetic.lisp index 9983e0e14..a7cdbe7c9 100644 --- a/plugins/arm/semantics/aarch64-arithmetic.lisp +++ b/plugins/arm/semantics/aarch64-arithmetic.lisp @@ -16,6 +16,37 @@ (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)) +; adds immediate +(defun ADDSXri (rd rn imm off) + (add-with-carry set$ rd rn (lshift imm off) 0)) + +(defun ADDSWri (rd rn imm off) + (add-with-carry setw rd rn (lshift imm off) 0)) + +; adds shifted +(defun ADDSXrs (rd rn rm shift) + (add-with-carry set$ rd rn (shift-encoded rm shift) 0)) + +(defun ADDSWrs (rd rn rm shift) + (add-with-carry set$ rd rn (shift-encoded rm shift) 0)) + +(defun CMNWri (rn imm shift) + (ADDSWri 0b1111 rn imm shift) + +; add extended +(defun ADDXrx (rd rn rm shift) + (set$ rd (+ rn (extended rm shift)))) + +(defun ADDWrx (rd rn rm shift) + (setw rd (+ rn (extended rm shift)))) + +; add extend SXRX|UXTX +(defun ADDXrx64 (rd rn rm shift) + (set$ rd (+ rn (extended rm shift)))) + +; endTODO + + (defun ADRP (dst imm) (set$ dst (+ (logand (get-program-counter) (lshift -1 12)) @@ -31,6 +62,13 @@ (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 SUBXrx (rd rn rm off) + (set$ rd (- rn (extended rm off)))) + +(defun SUBXrw (rd rn rm off) + (setw rd (- rn (extended rm off)))) + + (defun SUBXrx64 (rd rn rm off) (set$ rd (- rn (extended rm off)))) @@ -38,13 +76,13 @@ (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)) + (add-with-carry set$ 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)) + (add-with-carry set$ 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 @@ -66,4 +104,4 @@ (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)) \ No newline at end of file +(defun UDIVXr (rd rn rm) (*DIV*r set$ / rd rn rm)) diff --git a/plugins/arm/semantics/arm-bits.lisp b/plugins/arm/semantics/arm-bits.lisp index 591365a2f..503a81438 100644 --- a/plugins/arm/semantics/arm-bits.lisp +++ b/plugins/arm/semantics/arm-bits.lisp @@ -31,12 +31,13 @@ (set CF 0) (set VF 0)) -(defun add-with-carry (rd x y c) + +(defmacro add-with-carry (set rd x y c) "(add-with-carry rd x y c) sets rd to the result of adding x and y with carry bit c, and sets processor flags." (let ((r (+ c y x))) (set-nzcv-from-registers r x y) - (set$ rd r))) + (set rd r))) (defun add-with-carry/clear-base (rd x y c) "(add-with-carry/clear-base rd x y c) sets rd to the result of adding x and y From 8295b199fc37875fbfae018cb4f9d000f697a072 Mon Sep 17 00:00:00 2001 From: Kaitlyn Lake Date: Mon, 27 Jun 2022 03:20:02 +0000 Subject: [PATCH 046/132] Implemented LDPWi, LDRBBpost, LDRBBpre, LDRBBrow. Added better vector element insert helper insert-element-into-vector --- .../arm/semantics/aarch64-data-movement.lisp | 21 ++++++++- plugins/arm/semantics/aarch64-helper.lisp | 22 +++++---- plugins/arm/semantics/aarch64-vector.lisp | 47 ++----------------- 3 files changed, 37 insertions(+), 53 deletions(-) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index a2555b181..0da1f33b1 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -18,13 +18,25 @@ (setw dst (cast-unsigned (word) (load-hword (+ reg (lshift off 2)))))) +(defun LDRBBpost (_ dst base simm) + (setw dst (cast-unsigned 32 (load-byte base))) + (set$ base (+ base simm))) + +(defun LDRBBpre (_ dst base simm) + (setw dst (cast-unsigned 32 (load-byte (+ base simm))))) + (defun LDRBBui (dst reg off) (setw dst (cast-unsigned (word) (load-byte (+ reg off))))) +(defun LDRBBroW (dst reg off signed shift) + (if (= signed 1) + (setw dst (cast-unsigned 32 (load-byte (+ reg (cast-signed 64 off))))) + (setw dst (cast-unsigned 32 (load-byte (+ reg (cast-unsigned 64 off))))))) + (defun LDRBBroX (dst reg off _ _) - (set$ dst - (cast-unsigned (word) (load-byte (+ reg off))))) + (setw dst + (cast-unsigned (word) (load-byte (+ reg (cast-signed 64 off)))))) (defun LDPXpost (dst r1 r2 base off) (let ((off (lshift off 3))) @@ -37,6 +49,11 @@ (set$ r1 (load-word (+ base off))) (set$ r2 (load-word (+ base off (sizeof word)))))) +(defun LDPWi (wn wm xn off) + (let ((off (lshift off 2))) + (setw wn (load-hword (+ xn off))) + (setw wm (load-hword (+ xn off 4))))) + (defun LDRXroX (rt rn rm _ shift) (set$ rt (load-word (+ rn (lshift rm (* shift 3)))))) diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index b3ebea73e..5d229a5ba 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -134,15 +134,19 @@ (reverse-elems-in-all-containers container-size elem-size (cast-low (- (word-width x) container-size) x))))) -(defun get-vector-size (width) - (case width - 0x8 0x0 - 0x10 0x1 - 0x20 0x2 - 0x40 0x3 - 0x4)) - -(defun get-vector-element (index vn) +(defun insert-element-into-vector (vd index element size) + "(insert-element-into-vector vd index element size) inserts element into vd[index], where size is in {8,16,32,64}" + (let ((highIndex (* size (+ index 1))) + (lowIndex (- (* size index) 1)) + (topPart (rshift vd highIndex))) + (if (> index 0) + (let ((mask (replicate-to-fill (cast-low 1 0x1) lowIndex)) + (bottomPart (logand vd mask))) + (set-symbol-value vd (extract 127 0 (concat topPart element bottomPart)))) + (set$ vd (extract 127 0 (concat topPart element)))))) + +(defun get-vector-S-element (index vn) + "(get-vector-S-element) returns the 32 bit element from vn[index]" (case index 0x0 (extract 31 0 vn) 0x1 (extract 63 32 vn) diff --git a/plugins/arm/semantics/aarch64-vector.lisp b/plugins/arm/semantics/aarch64-vector.lisp index bf039efad..a2cf8b68f 100644 --- a/plugins/arm/semantics/aarch64-vector.lisp +++ b/plugins/arm/semantics/aarch64-vector.lisp @@ -3,51 +3,14 @@ (in-package aarch64) ;;; INS -;; with gp register - -;; (defmacro INSvi*gpr () ()) (defun INSvi32gpr (vd redundant index gpr) "(INSvi32gpr vd ts index gpr) inserts an element in the general purpose register gpr into vecter register vd at index. NOTE: does not encode Security state & Exception level" - (let ((element (extract 32 0 gpr)) - (highIndex (* 32 (+ index 1))) - (lowIndex (- (* 32 index) 1)) - (topPart (rshift vd highIndex)) - (mask (replicate-to-fill (extract 0 0 0x1) lowIndex)) - (bottomPart (logand vd mask))) - (msg "width top: $0" (alias-base-register vd)) - (set-symbol-value vd (extract 127 0 (concat topPart element bottomPart))))) + (insert-element-into-vector vd index gpr 32)) -(defun INSvi32lane (vd redundant index1 vn index2) +(defun INSvi32lane (vd redundant index vn index2) "NOTE: does not encode Security state & Exception level" - (let ((selem (get-vector-element index2 vn)) - (highIndex (* 32 (+ index1 1))) - (lowIndex (- (* 32 index1) 1)) - (topPart (rshift vd highIndex)) - (mask (replicate-to-fill (extract 0 0 0x1) lowIndex)) - (bottomPart (logand vd mask))) - (set-symbol-value vd (extract 127 0 (concat topPart selem bottomPart))))) - -;; load (multiple structures) + (let ((element (get-vector-S-element index2 vn))) + (insert-element-into-vector vd index element 32))) -;; opcde = 1000, rpt = 1, selem = 2 -;; L = 1, MEMOP_LOAD -;; T = 16B, imm = #32, Q = 1, size = 00 -;; datasize = 128, esize = 8 -;; elements = 16 -;; pseudocode: - -;; for r = 0 to r = 0 -;; for e = 0 to e = 15 -;; tt = (UInt(qa) + 0) MOD 32; -;; for s = 0 to s = 1 -;; rval = V(tt) -;; Elem[rval, e, 8] = Mem[address+offs, 1, AccType_VEC] -;; V[tt] = rval -;; offs = offs + 1 -;; tt = (tt + 1) MOD 32; -;; if xn given, offs = X[n] -;; set if address/X reg given -(defun LD2Twov16b_POST (redundant qa_qb xn imm) - "NOTE: does not encode Security state & Exception level" - (msg "offset: $0" (alias-base-register imm))) +;;; LDs.. From 054c68e0350e25054921be0b1044fa9a17b13258 Mon Sep 17 00:00:00 2001 From: alistair Date: Mon, 27 Jun 2022 04:33:47 +0000 Subject: [PATCH 047/132] add ADR, del redundant alias CMP --- plugins/arm/semantics/aarch64-arithmetic.lisp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/plugins/arm/semantics/aarch64-arithmetic.lisp b/plugins/arm/semantics/aarch64-arithmetic.lisp index a7cdbe7c9..365b2e00a 100644 --- a/plugins/arm/semantics/aarch64-arithmetic.lisp +++ b/plugins/arm/semantics/aarch64-arithmetic.lisp @@ -30,9 +30,6 @@ (defun ADDSWrs (rd rn rm shift) (add-with-carry set$ rd rn (shift-encoded rm shift) 0)) -(defun CMNWri (rn imm shift) - (ADDSWri 0b1111 rn imm shift) - ; add extended (defun ADDXrx (rd rn rm shift) (set$ rd (+ rn (extended rm shift)))) @@ -105,3 +102,6 @@ (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)) + +(defun ADR (rd label) + (store-word rd (+ (get-program-counter) (cast-signed 64 label)))) From 8e9f878adf02777a9a47e95261a14a011308f407 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Tue, 28 Jun 2022 00:45:19 +0000 Subject: [PATCH 048/132] Fix improper usage of intrinsic primitive `dmb ish` now gets lifted to `call(intrinsic:barrier_dmb_ish)` --- plugins/arm/semantics/aarch64-helper.lisp | 30 +++++++++++----------- plugins/arm/semantics/aarch64-special.lisp | 3 ++- 2 files changed, 17 insertions(+), 16 deletions(-) diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index 5d229a5ba..71c6d0acb 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -84,22 +84,22 @@ (defun barrier-option-to-symbol (option) "(barrier-option-to-symbol option) converts the - 4-bit optional value to a symbol. - This is to be used with the (special) primitive." + 4-bit value to a symbol. + This is to be used with the (intrinsic) primitive." (case option - 0b1111 :sy - 0b1110 :st - 0b1101 :ld - 0b1011 :ish - 0b1010 :ishst - 0b1001 :ishld - 0b0111 :nsh - 0b0110 :nshst - 0b0101 :nshld - 0b0011 :osh - 0b0010 :oshst - 0b0001 :oshld - :unknown)) + 0b1111 'sy + 0b1110 'st + 0b1101 'ld + 0b1011 'ish + 0b1010 'ishst + 0b1001 'ishld + 0b0111 'nsh + 0b0110 'nshst + 0b0101 'nshld + 0b0011 'osh + 0b0010 'oshst + 0b0001 'oshld + 'unknown)) (defun replace-bit-range (reg hi lo val) "(replace-bit-range reg hi lo val) returns reg with bits diff --git a/plugins/arm/semantics/aarch64-special.lisp b/plugins/arm/semantics/aarch64-special.lisp index 1e3eabebe..55cb29cbb 100644 --- a/plugins/arm/semantics/aarch64-special.lisp +++ b/plugins/arm/semantics/aarch64-special.lisp @@ -7,7 +7,8 @@ (defun make-barrier (barrier-type option) (intrinsic (symbol-concat 'barrier barrier-type - (barrier-option-to-symbol option)))) + (barrier-option-to-symbol option) + :sep '_))) (defun DMB (option) (make-barrier 'dmb option)) From 4bf776992794ea22f6ab4c5b7104445a88b68aab Mon Sep 17 00:00:00 2001 From: alistair Date: Tue, 28 Jun 2022 02:12:35 +0000 Subject: [PATCH 049/132] Add STUR(D|Q)i --- plugins/arm/semantics/aarch64-data-movement.lisp | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index 0da1f33b1..e80e81bbb 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -105,6 +105,7 @@ (defun STRXroX (rt rn rm _ shift) (store-word (+ rn (lshift rm (* shift 3))) rt)) +; addr + offset indexed STUR (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))) @@ -116,3 +117,11 @@ (defun STURHHi (src base off) (STUR*i src base off 16)) (defun STURBBi (src base off) (STUR*i src base off 8)) + + +(defun STURDi (rn rt imm) (STUR*i rn rt imm 64)) +(defun STURQi (rn rt imm) (STUR*i rn rt imm 128)) + + +; post-indexed and pre-indexed addressing means that the sum of the address and +; the offset is written back to the base register (C1-231). From aad526777d299fd86ec6f5bde9345d75660f6ba6 Mon Sep 17 00:00:00 2001 From: alistair Date: Tue, 28 Jun 2022 04:31:06 +0000 Subject: [PATCH 050/132] add STPQi STPWi, fix STPXi --- .../arm/semantics/aarch64-data-movement.lisp | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index e80e81bbb..dcb39fb63 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -89,10 +89,21 @@ (store-word (+ dst off (sizeof word)) t2) (set$ dst (+ dst off)))) +(defun STPWi (rt rt2 base imm) + (let ((datasize 16) (off (* imm 4))) + (store-word (+ base off) rt) + (store-word (+ base off datasize) rt2))) + (defun STPXi (t1 t2 base off) - (let ((off (lshift off 4))) - (store-word base (+ base off)) - (store-word base (+ base off (sizeof word))))) + (let ((off (* off 8))) + (store-word (+ base off) t1) + (store-word (+ base off (sizeof word)) t2))) + +; signed offset STP (SIMD/FP) +(defun STPQi (rt rt2 base imm) + (let ((datasize 128) (off (* imm 16))) + (store-word (+ base off) rt) + (store-word (+ base off datasize) rt2))) (defun STRXui (src reg off) (let ((off (lshift off 3))) From 453493c553039ac01ae9a0b2600eb4c577a92a20 Mon Sep 17 00:00:00 2001 From: alistair Date: Tue, 28 Jun 2022 07:00:06 +0000 Subject: [PATCH 051/132] add STRBBpost and STRBBroX --- .../arm/semantics/aarch64-data-movement.lisp | 20 ++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index dcb39fb63..c6d1689a5 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -80,9 +80,26 @@ ;; ST... +; STRB (base) (defun STRBBui (src reg off) (store-byte (+ reg off) src)) +; post-indexed STRB +(defun STRBBpost (_ rt base simm) + (store-byte base rt) + (set$ base (+ base simm))) + +(defun STRBBroW (rt rn rm option shift) + (let ((off + (if (= option 1) + (signed-extend 32 rm) ; SXTW + (unsigned-extend 32 rm)))) ; UXTW + (store-byte (+ rn off) rt))) + +(defun STRBBroX (rt rn rm option shift) + (let ((off (signed-extend 64 rm))) ; SXTX + (store-byte (+ rn off) rt))) + (defun STPXpre (dst t1 t2 _ off) (let ((off (lshift off 3))) (store-word (+ dst off) t1) @@ -133,6 +150,3 @@ (defun STURDi (rn rt imm) (STUR*i rn rt imm 64)) (defun STURQi (rn rt imm) (STUR*i rn rt imm 128)) - -; post-indexed and pre-indexed addressing means that the sum of the address and -; the offset is written back to the base register (C1-231). From ee61345250f79ff51aab5a555d99baee48ba6c2b Mon Sep 17 00:00:00 2001 From: Kaitlyn Lake Date: Wed, 29 Jun 2022 01:15:22 +0000 Subject: [PATCH 052/132] Implemented multiple gpr & vector register load instructions --- .../arm/semantics/aarch64-data-movement.lisp | 22 +++++++ plugins/arm/semantics/aarch64-vector.lisp | 62 +++++++++++++++++++ 2 files changed, 84 insertions(+) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index 0da1f33b1..37a4a46fd 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -57,6 +57,28 @@ (defun LDRXroX (rt rn rm _ shift) (set$ rt (load-word (+ rn (lshift rm (* shift 3)))))) +(defmacro LDRHHro*i (wt xn xm extend s) + (if (= extend 1) + (let ((off (cast-signed 64 (lshift xm s)))) + (setw wt (load-bits 16 (+ xn off)))) + (let ((off (cast-unsigned 64 (lshift xm s)))) + (setw wt (load-bits 16 (+ xn off)))))) + +(defun LDRHHroX (wt xn xm extend s) (LDRHHro*i wt xn xm extend s)) + +(defun LDRHHroW (wt xn wm extend s) (LDRHHro*i wt xn wm extend s)) + +(defun LDRHHui (wt xn pimm) + (let ((off (lshift (cast-unsigned 64 pimm) 1))) + (setw wt (load-bits 16 (+ xn off))))) + +(defun LDRSroX (xt base index signed shift) + (if (= signed 1) + (let ((off (cast-signed 64 (lshift index shift)))) + (set$ xt (load-hword (+ base off)))) + (let ((off (cast-signed 64 (lshift index shift)))) + (set$ xt (load-hword (+ base off)))))) + ;; MOV... (defmacro MOVZ*i (set dst imm off) diff --git a/plugins/arm/semantics/aarch64-vector.lisp b/plugins/arm/semantics/aarch64-vector.lisp index a2cf8b68f..1cef0ce04 100644 --- a/plugins/arm/semantics/aarch64-vector.lisp +++ b/plugins/arm/semantics/aarch64-vector.lisp @@ -14,3 +14,65 @@ (insert-element-into-vector vd index element 32))) ;;; LDs.. + +;; opcde = 1000, rpt = 1, selem = 2 +;; L = 1, MEMOP_LOAD +;; T = 16B, imm = #32, Q = 1, size = 00 +;; datasize = 128, esize = 8 +;; elements = 16 +;; address = xn +;; offs = Zeroes(64) +;; pseudocode: + +;; for r = 0 to r = 0 +;; for e = 0 to e = 15 +;; tt = (UInt(Rt) + 0) MOD 32 = a; --- this is getting the vector reg from the instruction Rt field, which in this case will just be a +;; for s = 0 to s = 1 +;; rval = V(tt) = _Z[tt]<127:0> = qa +;; Elem[rval, e, 8] = rval<(e+1)*size-1:e*size> = Mem[address+offs, 1, AccType_VEC] = load-byte (+ xn imm) +;; V[tt] = rval +;; offs = offs + 1 +;; tt = (tt + 1) MOD 32 = (a + 1) MOD 32 = b; +;; if xn given, offs = X[n] +;; set if address/X reg given +(defun LD2Twov16b_POST (redundant qa_qb xn imm) + "(LD2Twov16b_POST redundant qa_qb xn imm) loads multiple 2-element structures from memory at address xn with offset imm and stores it in qa and qb with de-interleaving. NOTE: does not encode Security state & Exception level" + (msg "$0" qa_qb)) + +(defun LDPQi (qn qm base imm) + "" + (let ((off (lshift (cast-signed 128 imm) 4)) + (dbytes (/ 128 8))) + (set$ qn (load-dword (+ base off))) + (set$ qm (load-dword (+ base off dbytes))))) + +(defun LDPSi (qn qm base imm) + "" + (let ((off (lshift (cast-signed 32 imm) 4)) + (dbytes (/ 32 8))) + (set$ qn (load-hword (+ base off))) + (set$ qm (load-hword (+ base off dbytes))))) + +(defun LDRDui (dt base imm) + "" + (let ((off (lshift (cast-unsigned 64 imm) 3))) + (set$ dt (load-word (+ base off))))) + +(defun LDRQui (qt base imm) + "" + (let ((off (lshift (cast-unsigned 64 imm) 4))) + (set$ qt (load-dword (+ base off))))) + +(defun LDRSui (st base imm) + "" + (let ((off (lshift (cast-unsigned 64 imm) 2))) + (set$ st (load-hword (+ base off))))) + +(defun LDRQroX (qt base index signed shift) + "" + (if (= signed 1) + (let ((off (cast-signed 64 (lshift index shift)))) + (set$ qt (load-bits 16 (+ base off)))) + (let ((off (cast-signed 64 (lshift index shift)))) + (set$ qt (load-bits 16 (+ base off)))))) + From eb4e523492de805978766fb8aa97cab343372d63 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Wed, 29 Jun 2022 06:00:36 +0000 Subject: [PATCH 053/132] Implement CASPX and helpers for W and X pairs --- plugins/arm/semantics/aarch64-atomic.lisp | 11 ++- plugins/arm/semantics/aarch64-helper.lisp | 114 +++++++++++++++++++++- 2 files changed, 123 insertions(+), 2 deletions(-) diff --git a/plugins/arm/semantics/aarch64-atomic.lisp b/plugins/arm/semantics/aarch64-atomic.lisp index 3f8e06dac..fe3cf9f3c 100644 --- a/plugins/arm/semantics/aarch64-atomic.lisp +++ b/plugins/arm/semantics/aarch64-atomic.lisp @@ -11,7 +11,7 @@ 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))) + (let ((data (load rn))) (when acquire (intrinsic 'load-acquire)) (when (= data rs) (when release (intrinsic 'store-release)) @@ -61,6 +61,15 @@ (defun CASLH (rs _ rt rn) (CASordH rs rt rn false true)) (defun CASALH (rs _ rt rn) (CASordH rs rt rn true true)) +(defun first (x y) (declare (visibility :private)) x) +(defun second (x y) (declare (visibility :private)) y) + +(defun CASPX (rs_pair _ rt_pair rn) + (let ((data (load-dword rn))) + (when (= data (register-pair-concat rs_pair)) + (store-word rn (register-pair-concat rt_pair))) + (set$ (register-pair-first rs_pair) (endian first (cast-high 64 data) (cast-low 64 data))) + (set$ (register-pair-second rs_pair) (endian second (cast-high 64 data) (cast-low 64 data))))) (defmacro CSop*r (set op rd rn rm cnd) "(CSop*r set op rd rn rm cnd) implements the conditional select diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index 71c6d0acb..49af91c4e 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -146,7 +146,7 @@ (set$ vd (extract 127 0 (concat topPart element)))))) (defun get-vector-S-element (index vn) - "(get-vector-S-element) returns the 32 bit element from vn[index]" + "(get-vector-S-element index vn) returns the 32 bit element from vn[index]" (case index 0x0 (extract 31 0 vn) 0x1 (extract 63 32 vn) @@ -154,3 +154,115 @@ 0x3 (extract 127 96 vn) 0x0)) +;; to generate these functions, +;; do something like the following python code +;; for c in "XW": +;; for i in range(30//2): +;; print(f"'{c}{2*i}_{c}{2*i+1} '{c}{2*i}") +(defun register-pair-first (r_pair) + "(register-pair-first r_pair) returns the first register in the + register pair Xi_X(i+1) or similar, returned by LLVM. + This is used in specific instructions like the CASP family and LD2." + (case (symbol r_pair) + 'X0_X1 'X0 + 'X2_X3 'X2 + 'X4_X5 'X4 + 'X6_X7 'X6 + 'X8_X9 'X8 + 'X10_X11 'X10 + 'X12_X13 'X12 + 'X14_X15 'X14 + 'X16_X17 'X16 + 'X18_X19 'X18 + 'X20_X21 'X20 + 'X22_X23 'X22 + 'X24_X25 'X24 + 'X26_X27 'X26 + 'X28_X29 'X28 + 'W0_W1 'W0 + 'W2_W3 'W2 + 'W4_W5 'W4 + 'W6_W7 'W6 + 'W8_W9 'W8 + 'W10_W11 'W10 + 'W12_W13 'W12 + 'W14_W15 'W14 + 'W16_W17 'W16 + 'W18_W19 'W18 + 'W20_W21 'W20 + 'W22_W23 'W22 + 'W24_W25 'W24 + 'W26_W27 'W26 + 'W28_W29 'W28)) + +(defun register-pair-second (r_pair) + "(register-pair-first r_pair) returns the second register in the + register pair Xi_X(i+1) or similar, returned by LLVM. + This is used in specific instructions like the CASP family and LD2." + (case (symbol r_pair) + 'X0_X1 'X1 + 'X2_X3 'X3 + 'X4_X5 'X5 + 'X6_X7 'X7 + 'X8_X9 'X9 + 'X10_X11 'X11 + 'X12_X13 'X13 + 'X14_X15 'X15 + 'X16_X17 'X17 + 'X18_X19 'X19 + 'X20_X21 'X21 + 'X22_X23 'X23 + 'X24_X25 'X25 + 'X26_X27 'X27 + 'X28_X29 'X29 + 'W0_W1 'W1 + 'W2_W3 'W3 + 'W4_W5 'W5 + 'W6_W7 'W7 + 'W8_W9 'W9 + 'W10_W11 'W11 + 'W12_W13 'W13 + 'W14_W15 'W15 + 'W16_W17 'W17 + 'W18_W19 'W19 + 'W20_W21 'W21 + 'W22_W23 'W23 + 'W24_W25 'W25 + 'W26_W27 'W27 + 'W28_W29 'W29)) + +(defun register-pair-concat (r_pair) + "(register-pair-concat r_pair) returns the concatenated form + of the register pair returned by LLVM, taking into account + the endianness." + (case (symbol r_pair) + 'X0_X1 (endian concat X0 X1) + 'X2_X3 (endian concat X2 X3) + 'X4_X5 (endian concat X4 X5) + 'X6_X7 (endian concat X6 X7) + 'X8_X9 (endian concat X8 X9) + 'X10_X11 (endian concat X10 X11) + 'X12_X13 (endian concat X12 X13) + 'X14_X15 (endian concat X14 X15) + 'X16_X17 (endian concat X16 X17) + 'X18_X19 (endian concat X18 X19) + 'X20_X21 (endian concat X20 X21) + 'X22_X23 (endian concat X22 X23) + 'X24_X25 (endian concat X24 X25) + 'X26_X27 (endian concat X26 X27) + 'X28_X29 (endian concat X28 X29) + 'W0_W1 (endian concat W0 W1) + 'W2_W3 (endian concat W2 W3) + 'W4_W5 (endian concat W4 W5) + 'W6_W7 (endian concat W6 W7) + 'W8_W9 (endian concat W8 W9) + 'W10_W11 (endian concat W10 W11) + 'W12_W13 (endian concat W12 W13) + 'W14_W15 (endian concat W14 W15) + 'W16_W17 (endian concat W16 W17) + 'W18_W19 (endian concat W18 W19) + 'W20_W21 (endian concat W20 W21) + 'W22_W23 (endian concat W22 W23) + 'W24_W25 (endian concat W24 W25) + 'W26_W27 (endian concat W26 W27) + 'W28_W29 (endian concat W28 W29))) From 08e9bd4a4e340667b601c9cd5b7f3e051c2945c3 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Wed, 29 Jun 2022 06:23:23 +0000 Subject: [PATCH 054/132] Generalise CASP over W and X registers --- plugins/arm/semantics/aarch64-atomic.lisp | 22 ++++++++++++++++------ plugins/arm/semantics/aarch64-helper.lisp | 20 ++++++++++---------- 2 files changed, 26 insertions(+), 16 deletions(-) diff --git a/plugins/arm/semantics/aarch64-atomic.lisp b/plugins/arm/semantics/aarch64-atomic.lisp index fe3cf9f3c..ab0c4e1cd 100644 --- a/plugins/arm/semantics/aarch64-atomic.lisp +++ b/plugins/arm/semantics/aarch64-atomic.lisp @@ -64,12 +64,22 @@ (defun first (x y) (declare (visibility :private)) x) (defun second (x y) (declare (visibility :private)) y) -(defun CASPX (rs_pair _ rt_pair rn) - (let ((data (load-dword rn))) - (when (= data (register-pair-concat rs_pair)) - (store-word rn (register-pair-concat rt_pair))) - (set$ (register-pair-first rs_pair) (endian first (cast-high 64 data) (cast-low 64 data))) - (set$ (register-pair-second rs_pair) (endian second (cast-high 64 data) (cast-low 64 data))))) +(defmacro CASP* (set load rs-pair rt-pair rn register-width) + "(CASP* set load store rs-pair rt-pair rn register-width) + implements a compare-and-swap-pair instruction for W and X registers. + set is the functions to set to a register in the pair. + register-width is 64 or 32, depending on the size of register used. + load either loads 128 bits or 64 (the size of the whole pair)." + (let ((data (load rn)) + (lower (cast-low register-width data)) + (upper (cast-high register-width data))) + (when (= data (register-pair-concat rs-pair)) + (store-word rn (register-pair-concat rt-pair))) + (set (register-pair-first rs-pair) (endian first upper lower)) + (set (register-pair-second rs-pair) (endian second upper lower)))) + +(defun CASPX (rs-pair _ rt-pair rn) (CASP* set$ load-dword rs-pair rt-pair rn 64)) +(defun CASPW (rs-pair _ rt-pair rn) (CASP* setw load-word rs-pair rt-pair rn 32)) (defmacro CSop*r (set op rd rn rm cnd) "(CSop*r set op rd rn rm cnd) implements the conditional select diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index 49af91c4e..a980b305b 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -159,11 +159,11 @@ ;; for c in "XW": ;; for i in range(30//2): ;; print(f"'{c}{2*i}_{c}{2*i+1} '{c}{2*i}") -(defun register-pair-first (r_pair) - "(register-pair-first r_pair) returns the first register in the +(defun register-pair-first (r-pair) + "(register-pair-first r-pair) returns the first register in the register pair Xi_X(i+1) or similar, returned by LLVM. This is used in specific instructions like the CASP family and LD2." - (case (symbol r_pair) + (case (symbol r-pair) 'X0_X1 'X0 'X2_X3 'X2 'X4_X5 'X4 @@ -195,11 +195,11 @@ 'W26_W27 'W26 'W28_W29 'W28)) -(defun register-pair-second (r_pair) - "(register-pair-first r_pair) returns the second register in the +(defun register-pair-second (r-pair) + "(register-pair-first r-pair) returns the second register in the register pair Xi_X(i+1) or similar, returned by LLVM. This is used in specific instructions like the CASP family and LD2." - (case (symbol r_pair) + (case (symbol r-pair) 'X0_X1 'X1 'X2_X3 'X3 'X4_X5 'X5 @@ -231,11 +231,11 @@ 'W26_W27 'W27 'W28_W29 'W29)) -(defun register-pair-concat (r_pair) - "(register-pair-concat r_pair) returns the concatenated form - of the register pair returned by LLVM, taking into account +(defun register-pair-concat (r-pair) + "(register-pair-concat r-pair) returns the concatenated values of + the register pair returned by LLVM, taking into account the endianness." - (case (symbol r_pair) + (case (symbol r-pair) 'X0_X1 (endian concat X0 X1) 'X2_X3 (endian concat X2 X3) 'X4_X5 (endian concat X4 X5) From b163841a4ae8e54bee38b7e8ca052f937ec5ac98 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Wed, 29 Jun 2022 06:33:10 +0000 Subject: [PATCH 055/132] Implement CASP family with acquire and release --- plugins/arm/semantics/aarch64-atomic.lisp | 28 +++++++++++++++++++---- 1 file changed, 23 insertions(+), 5 deletions(-) diff --git a/plugins/arm/semantics/aarch64-atomic.lisp b/plugins/arm/semantics/aarch64-atomic.lisp index ab0c4e1cd..71d73c6ad 100644 --- a/plugins/arm/semantics/aarch64-atomic.lisp +++ b/plugins/arm/semantics/aarch64-atomic.lisp @@ -64,22 +64,40 @@ (defun first (x y) (declare (visibility :private)) x) (defun second (x y) (declare (visibility :private)) y) -(defmacro CASP* (set load rs-pair rt-pair rn register-width) - "(CASP* set load store rs-pair rt-pair rn register-width) +(defmacro CASPord* (set load rs-pair rt-pair rn register-width acquire release) + "(CASP* set load store rs-pair rt-pair rn register-width acquire release) implements a compare-and-swap-pair instruction for W and X registers. set is the functions to set to a register in the pair. register-width is 64 or 32, depending on the size of register used. - load either loads 128 bits or 64 (the size of the whole pair)." + load either loads 128 bits or 64 (the size of the whole pair). + acquire and release are as in the CASord* macro." (let ((data (load rn)) (lower (cast-low register-width data)) (upper (cast-high register-width data))) + (when acquire (intrinsic 'load-acquire)) (when (= data (register-pair-concat rs-pair)) + (when release (intrinsic 'store-release)) (store-word rn (register-pair-concat rt-pair))) (set (register-pair-first rs-pair) (endian first upper lower)) (set (register-pair-second rs-pair) (endian second upper lower)))) -(defun CASPX (rs-pair _ rt-pair rn) (CASP* set$ load-dword rs-pair rt-pair rn 64)) -(defun CASPW (rs-pair _ rt-pair rn) (CASP* setw load-word rs-pair rt-pair rn 32)) +(defmacro CASPordX (rs-pair rt-pair rn acquire release) + "Specialisation of CASPord* for X registers." + (CASPord* set$ load-dword rs-pair rt-pair rn 64 acquire release)) + +(defmacro CASPordW (rs-pair rt-pair rn acquire release) + "Specialisation of CASPord* for W registers." + (CASPord* setw load-word rs-pair rt-pair rn 32 acquire release)) + +(defun CASPX (rs-pair _ rt-pair rn) (CASPordX rs-pair rt-pair rn false false)) +(defun CASPAX (rs-pair _ rt-pair rn) (CASPordX rs-pair rt-pair rn true false)) +(defun CASPLX (rs-pair _ rt-pair rn) (CASPordX rs-pair rt-pair rn false true)) +(defun CASPALX (rs-pair _ rt-pair rn) (CASPordX rs-pair rt-pair rn true true)) + +(defun CASPW (rs-pair _ rt-pair rn) (CASPordW rs-pair rt-pair rn false false)) +(defun CASPAW (rs-pair _ rt-pair rn) (CASPordW rs-pair rt-pair rn true false)) +(defun CASPLW (rs-pair _ rt-pair rn) (CASPordW rs-pair rt-pair rn false true)) +(defun CASPALW (rs-pair _ rt-pair rn) (CASPordW rs-pair rt-pair rn true true)) (defmacro CSop*r (set op rd rn rm cnd) "(CSop*r set op rd rn rm cnd) implements the conditional select From ee0ccf844721b081595c89818650a6ecb646acba Mon Sep 17 00:00:00 2001 From: alistair Date: Wed, 29 Jun 2022 06:55:36 +0000 Subject: [PATCH 056/132] implement STR*post STR*roX --- .../arm/semantics/aarch64-data-movement.lisp | 62 +++++++++++++++++-- 1 file changed, 58 insertions(+), 4 deletions(-) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index c6d1689a5..d12ef3113 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -84,6 +84,63 @@ (defun STRBBui (src reg off) (store-byte (+ reg off) src)) +; STR (register) (base): +; doesn't account for signed/unsigned extension +(defun str-reg (rt rn rm signed shift) + (assert (< signed 2)) + (store-word (+ rn + (if (= signed 1) + (cast-signed 64 (lshift rm shift)) + (cast-unsigned 64 (lshift rm shift)))) + rt)) + +; option encodes the extend type which is not relevant here +(defun STRWroX (rt rn rm option shift) + (str-reg rt rn rm option (* shift 2))) + +(defun STRXroX (rt rn rm option shift) + (str-reg rt rn rm option (* shift 3))) + +(defun STRQroX (rt rn rm option shift) + (str-reg rt rn rm option (* shift 4))) + +; STRHHroX +(defun STRHHroX (rt rn rm option shift) + (str-reg rt rn rm option shift)) + +; STR (immediate) (base registers): +(defun str-post (xreg src off) + "stores all of src to xreg, and post-indexes reg (reg += off)." + (store-word xreg src) + (set$ xreg (+ xreg off))) + +(defun STRWpost (_ rt rn simm) + (str-post rn rt simm)) + +(defun STRXpost (_ rt rn simm) + (str-post rn rt simm)) + +; STR (SIMD registers) +(defun STRQpost (_ rt rn simm) + (str-post rn rt simm)) + +(defun STRDpost (_ rt rn simm) + (str-post rn rt simm)) + +(defun STRSpost (_ rt rn simm) + (str-post rn (extract 31 0 rt) simm)) + +(defun STRHpost (_ rt rn simm) + (str-post rn (extract 15 0 rt) simm)) + + +; STRQui +; STRDui + +; STRH (base reg) +; STRHHui + + ; post-indexed STRB (defun STRBBpost (_ rt base simm) (store-byte base rt) @@ -130,9 +187,6 @@ (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)) - ; addr + offset indexed STUR (defmacro STUR*i (src base off size) "Takes `size` bits from src and stores at base + off" @@ -146,7 +200,7 @@ (defun STURBBi (src base off) (STUR*i src base off 8)) - (defun STURDi (rn rt imm) (STUR*i rn rt imm 64)) + (defun STURQi (rn rt imm) (STUR*i rn rt imm 128)) From 1ffed99a730a24ce48d8437bc83848f750169bbf Mon Sep 17 00:00:00 2001 From: alistair Date: Wed, 29 Jun 2022 07:06:34 +0000 Subject: [PATCH 057/132] implement STRHHui --- plugins/arm/semantics/aarch64-data-movement.lisp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index d12ef3113..483bf9321 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -137,9 +137,9 @@ ; STRQui ; STRDui -; STRH (base reg) -; STRHHui - +; STRH (base reg), signed offset variant +(defun STRHHui (rt rn off) + (store-word (+ rn off) (cast-low 16 rt))) ; post-indexed STRB (defun STRBBpost (_ rt base simm) From 3080c0e094ecee855322cd45e2ed33f237f69cc4 Mon Sep 17 00:00:00 2001 From: alistair Date: Thu, 30 Jun 2022 04:34:24 +0000 Subject: [PATCH 058/132] add STR*ui --- .../arm/semantics/aarch64-data-movement.lisp | 45 ++++++++++++++----- 1 file changed, 34 insertions(+), 11 deletions(-) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index 483bf9321..bf7103698 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -134,8 +134,35 @@ (str-post rn (extract 15 0 rt) simm)) -; STRQui -; STRDui +(defun STR*ui (scale src reg off) + "Stores a register of size (8 << scale) to the memory address + (reg + (off << scale))." + (assert-msg (= (word-width src) (lshift 8 scale)) + "(aarch64-data-movement.lisp) scale must match size of register ") + (store-word (+ reg (lshift off scale)) + (cast-unsigned (lshift 8 scale) src))) + +(defun STRQui (src reg off) + (STR*ui 4 src reg off)) + +(defun STRDui (src reg off) + (STR*ui 3 src reg off)) + +(defun STRSui (src reg off) + (STR*ui 2 src reg off)) + +(defun STRHui (src reg off) + (STR*ui 1 src reg off)) + +(defun STRBui (src reg off) + (STR*ui 0 src reg off)) + +(defun STRXui (src reg off) + (STR*ui 3 src reg off)) + +; note this will not work with src = 'W0 since (word-width 'w0) = 64 . +(defun STRWui (src reg off) + (STR*ui 2 src reg off)) ; STRH (base reg), signed offset variant (defun STRHHui (rt rn off) @@ -146,6 +173,7 @@ (store-byte base rt) (set$ base (+ base simm))) + (defun STRBBroW (rt rn rm option shift) (let ((off (if (= option 1) @@ -154,7 +182,10 @@ (store-byte (+ rn off) rt))) (defun STRBBroX (rt rn rm option shift) - (let ((off (signed-extend 64 rm))) ; SXTX + (let ((off + (if (= option 1) + (signed-extend 64 rm) ; SXTX + (unsigned-extend 64 rm)))) ; LSL (store-byte (+ rn off) rt))) (defun STPXpre (dst t1 t2 _ off) @@ -179,14 +210,6 @@ (store-word (+ base off) rt) (store-word (+ base off datasize) rt2))) -(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)))) - ; addr + offset indexed STUR (defmacro STUR*i (src base off size) "Takes `size` bits from src and stores at base + off" From b5a567c2a7bd97080f35ff1c80beefe36daa35ba Mon Sep 17 00:00:00 2001 From: alistair Date: Tue, 28 Jun 2022 02:12:35 +0000 Subject: [PATCH 059/132] Add STUR(D|Q)i --- plugins/arm/semantics/aarch64-data-movement.lisp | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index 0da1f33b1..e80e81bbb 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -105,6 +105,7 @@ (defun STRXroX (rt rn rm _ shift) (store-word (+ rn (lshift rm (* shift 3))) rt)) +; addr + offset indexed STUR (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))) @@ -116,3 +117,11 @@ (defun STURHHi (src base off) (STUR*i src base off 16)) (defun STURBBi (src base off) (STUR*i src base off 8)) + + +(defun STURDi (rn rt imm) (STUR*i rn rt imm 64)) +(defun STURQi (rn rt imm) (STUR*i rn rt imm 128)) + + +; post-indexed and pre-indexed addressing means that the sum of the address and +; the offset is written back to the base register (C1-231). From c353e32ebdfbef1ba14236aa2a208e464a0df984 Mon Sep 17 00:00:00 2001 From: alistair Date: Tue, 28 Jun 2022 04:31:06 +0000 Subject: [PATCH 060/132] add STPQi STPWi, fix STPXi --- .../arm/semantics/aarch64-data-movement.lisp | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index e80e81bbb..dcb39fb63 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -89,10 +89,21 @@ (store-word (+ dst off (sizeof word)) t2) (set$ dst (+ dst off)))) +(defun STPWi (rt rt2 base imm) + (let ((datasize 16) (off (* imm 4))) + (store-word (+ base off) rt) + (store-word (+ base off datasize) rt2))) + (defun STPXi (t1 t2 base off) - (let ((off (lshift off 4))) - (store-word base (+ base off)) - (store-word base (+ base off (sizeof word))))) + (let ((off (* off 8))) + (store-word (+ base off) t1) + (store-word (+ base off (sizeof word)) t2))) + +; signed offset STP (SIMD/FP) +(defun STPQi (rt rt2 base imm) + (let ((datasize 128) (off (* imm 16))) + (store-word (+ base off) rt) + (store-word (+ base off datasize) rt2))) (defun STRXui (src reg off) (let ((off (lshift off 3))) From f54a253255a87bd951854e4f3b4391059005cf7b Mon Sep 17 00:00:00 2001 From: alistair Date: Tue, 28 Jun 2022 07:00:06 +0000 Subject: [PATCH 061/132] add STRBBpost and STRBBroX --- .../arm/semantics/aarch64-data-movement.lisp | 20 ++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index dcb39fb63..c6d1689a5 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -80,9 +80,26 @@ ;; ST... +; STRB (base) (defun STRBBui (src reg off) (store-byte (+ reg off) src)) +; post-indexed STRB +(defun STRBBpost (_ rt base simm) + (store-byte base rt) + (set$ base (+ base simm))) + +(defun STRBBroW (rt rn rm option shift) + (let ((off + (if (= option 1) + (signed-extend 32 rm) ; SXTW + (unsigned-extend 32 rm)))) ; UXTW + (store-byte (+ rn off) rt))) + +(defun STRBBroX (rt rn rm option shift) + (let ((off (signed-extend 64 rm))) ; SXTX + (store-byte (+ rn off) rt))) + (defun STPXpre (dst t1 t2 _ off) (let ((off (lshift off 3))) (store-word (+ dst off) t1) @@ -133,6 +150,3 @@ (defun STURDi (rn rt imm) (STUR*i rn rt imm 64)) (defun STURQi (rn rt imm) (STUR*i rn rt imm 128)) - -; post-indexed and pre-indexed addressing means that the sum of the address and -; the offset is written back to the base register (C1-231). From 1a1636863002e446e0c21fe68b403491c289d419 Mon Sep 17 00:00:00 2001 From: alistair Date: Wed, 29 Jun 2022 06:55:36 +0000 Subject: [PATCH 062/132] implement STR*post STR*roX --- .../arm/semantics/aarch64-data-movement.lisp | 62 +++++++++++++++++-- 1 file changed, 58 insertions(+), 4 deletions(-) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index c6d1689a5..d12ef3113 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -84,6 +84,63 @@ (defun STRBBui (src reg off) (store-byte (+ reg off) src)) +; STR (register) (base): +; doesn't account for signed/unsigned extension +(defun str-reg (rt rn rm signed shift) + (assert (< signed 2)) + (store-word (+ rn + (if (= signed 1) + (cast-signed 64 (lshift rm shift)) + (cast-unsigned 64 (lshift rm shift)))) + rt)) + +; option encodes the extend type which is not relevant here +(defun STRWroX (rt rn rm option shift) + (str-reg rt rn rm option (* shift 2))) + +(defun STRXroX (rt rn rm option shift) + (str-reg rt rn rm option (* shift 3))) + +(defun STRQroX (rt rn rm option shift) + (str-reg rt rn rm option (* shift 4))) + +; STRHHroX +(defun STRHHroX (rt rn rm option shift) + (str-reg rt rn rm option shift)) + +; STR (immediate) (base registers): +(defun str-post (xreg src off) + "stores all of src to xreg, and post-indexes reg (reg += off)." + (store-word xreg src) + (set$ xreg (+ xreg off))) + +(defun STRWpost (_ rt rn simm) + (str-post rn rt simm)) + +(defun STRXpost (_ rt rn simm) + (str-post rn rt simm)) + +; STR (SIMD registers) +(defun STRQpost (_ rt rn simm) + (str-post rn rt simm)) + +(defun STRDpost (_ rt rn simm) + (str-post rn rt simm)) + +(defun STRSpost (_ rt rn simm) + (str-post rn (extract 31 0 rt) simm)) + +(defun STRHpost (_ rt rn simm) + (str-post rn (extract 15 0 rt) simm)) + + +; STRQui +; STRDui + +; STRH (base reg) +; STRHHui + + ; post-indexed STRB (defun STRBBpost (_ rt base simm) (store-byte base rt) @@ -130,9 +187,6 @@ (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)) - ; addr + offset indexed STUR (defmacro STUR*i (src base off size) "Takes `size` bits from src and stores at base + off" @@ -146,7 +200,7 @@ (defun STURBBi (src base off) (STUR*i src base off 8)) - (defun STURDi (rn rt imm) (STUR*i rn rt imm 64)) + (defun STURQi (rn rt imm) (STUR*i rn rt imm 128)) From 2e7f74e94bbcaa6233182551de832cf07ff2ea31 Mon Sep 17 00:00:00 2001 From: alistair Date: Wed, 29 Jun 2022 07:06:34 +0000 Subject: [PATCH 063/132] implement STRHHui --- plugins/arm/semantics/aarch64-data-movement.lisp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index d12ef3113..483bf9321 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -137,9 +137,9 @@ ; STRQui ; STRDui -; STRH (base reg) -; STRHHui - +; STRH (base reg), signed offset variant +(defun STRHHui (rt rn off) + (store-word (+ rn off) (cast-low 16 rt))) ; post-indexed STRB (defun STRBBpost (_ rt base simm) From 52c5a9c10ec9f94a5e41d0e311d1769ceddb7793 Mon Sep 17 00:00:00 2001 From: alistair Date: Thu, 30 Jun 2022 04:34:24 +0000 Subject: [PATCH 064/132] add STR*ui --- .../arm/semantics/aarch64-data-movement.lisp | 45 ++++++++++++++----- 1 file changed, 34 insertions(+), 11 deletions(-) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index 483bf9321..bf7103698 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -134,8 +134,35 @@ (str-post rn (extract 15 0 rt) simm)) -; STRQui -; STRDui +(defun STR*ui (scale src reg off) + "Stores a register of size (8 << scale) to the memory address + (reg + (off << scale))." + (assert-msg (= (word-width src) (lshift 8 scale)) + "(aarch64-data-movement.lisp) scale must match size of register ") + (store-word (+ reg (lshift off scale)) + (cast-unsigned (lshift 8 scale) src))) + +(defun STRQui (src reg off) + (STR*ui 4 src reg off)) + +(defun STRDui (src reg off) + (STR*ui 3 src reg off)) + +(defun STRSui (src reg off) + (STR*ui 2 src reg off)) + +(defun STRHui (src reg off) + (STR*ui 1 src reg off)) + +(defun STRBui (src reg off) + (STR*ui 0 src reg off)) + +(defun STRXui (src reg off) + (STR*ui 3 src reg off)) + +; note this will not work with src = 'W0 since (word-width 'w0) = 64 . +(defun STRWui (src reg off) + (STR*ui 2 src reg off)) ; STRH (base reg), signed offset variant (defun STRHHui (rt rn off) @@ -146,6 +173,7 @@ (store-byte base rt) (set$ base (+ base simm))) + (defun STRBBroW (rt rn rm option shift) (let ((off (if (= option 1) @@ -154,7 +182,10 @@ (store-byte (+ rn off) rt))) (defun STRBBroX (rt rn rm option shift) - (let ((off (signed-extend 64 rm))) ; SXTX + (let ((off + (if (= option 1) + (signed-extend 64 rm) ; SXTX + (unsigned-extend 64 rm)))) ; LSL (store-byte (+ rn off) rt))) (defun STPXpre (dst t1 t2 _ off) @@ -179,14 +210,6 @@ (store-word (+ base off) rt) (store-word (+ base off datasize) rt2))) -(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)))) - ; addr + offset indexed STUR (defmacro STUR*i (src base off size) "Takes `size` bits from src and stores at base + off" From a10c1dec9b18cbdcace84e19a87ddd9b31d67f8d Mon Sep 17 00:00:00 2001 From: alistair Date: Thu, 30 Jun 2022 06:58:40 +0000 Subject: [PATCH 065/132] generalise STP for reg sizes --- .../arm/semantics/aarch64-data-movement.lisp | 103 +++++++++++++----- 1 file changed, 76 insertions(+), 27 deletions(-) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index bf7103698..b2e9ff0e2 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -80,21 +80,19 @@ ;; ST... -; STRB (base) +; STRB (defun STRBBui (src reg off) (store-byte (+ reg off) src)) -; STR (register) (base): -; doesn't account for signed/unsigned extension +; STR (register) (defun str-reg (rt rn rm signed shift) (assert (< signed 2)) (store-word (+ rn (if (= signed 1) - (cast-signed 64 (lshift rm shift)) - (cast-unsigned 64 (lshift rm shift)))) + (signed-extend (word-width rm) (lshift rm shift)) + (unsigned-extend (word-width rm) (lshift rm shift)))) rt)) -; option encodes the extend type which is not relevant here (defun STRWroX (rt rn rm option shift) (str-reg rt rn rm option (* shift 2))) @@ -128,11 +126,13 @@ (str-post rn rt simm)) (defun STRSpost (_ rt rn simm) - (str-post rn (extract 31 0 rt) simm)) + (str-post rn (cast-low 32 rt) simm)) (defun STRHpost (_ rt rn simm) - (str-post rn (extract 15 0 rt) simm)) + (str-post rn (cast-low 16 rt) simm)) +(defun STRBpost (_ rt rn simm) + (str-post rn (cast-low 8 rt) simm)) (defun STR*ui (scale src reg off) "Stores a register of size (8 << scale) to the memory address @@ -160,7 +160,6 @@ (defun STRXui (src reg off) (STR*ui 3 src reg off)) -; note this will not work with src = 'W0 since (word-width 'w0) = 64 . (defun STRWui (src reg off) (STR*ui 2 src reg off)) @@ -168,12 +167,11 @@ (defun STRHHui (rt rn off) (store-word (+ rn off) (cast-low 16 rt))) -; post-indexed STRB +; STRB post-indexed (defun STRBBpost (_ rt base simm) (store-byte base rt) (set$ base (+ base simm))) - (defun STRBBroW (rt rn rm option shift) (let ((off (if (= option 1) @@ -188,27 +186,78 @@ (unsigned-extend 64 rm)))) ; LSL (store-byte (+ rn off) rt))) -(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)))) +; STP +(defun store-pair (scale indexing t1 t2 dst off) + "store the pair t1,t2 of size (8 << scale)at the register dst plus an offset, + using the specified indexing." + (assert-msg (and (= (word-width t1) (lshift 8 scale)) + (= (word-width t2) (lshift 8 scale))) + "(aarch64-data-movement.lisp) scale must match size of register ") + (let ((off (lshift off scale)) (datasize (lshift 8 scale)) + (addr (case indexing + 'post dst + 'pre (+ dst off) + 'offset (+ dst off) + (assert-msg (= 1 0) + "(aarch64-data-movement.lisp) invalid indexing scheme."))) + ) + (store-word addr t1) + (store-word (+ addr datasize) t2) + (case indexing + 'post (set$ dst (+ addr off)) + 'pre (set$ dst addr) + 'offset ) + )) + +; post-indexed +(defun STPWpost (_ t1 t2 dst off) + (store-pair 2 'post t1 t2 dst off)) + +(defun STPXpost (_ t1 t2 dst off) + (store-pair 3 'post t1 t2 dst off)) + +(defun STPSpost (_ t1 t2 dst off) + (store-pair 2 'post t1 t2 dst off)) + +(defun STPDpost (_ t1 t2 dst off) + (store-pair 3 'post t1 t2 dst off)) + +(defun STPQpost (_ t1 t2 dst off) + (store-pair 4 'post t1 t2 dst off)) + +; pre-indexed +(defun STPXpre (_ t1 t2 dst off) + (store-pair 3 'pre t1 t2 dst off)) + +(defun STPWpre (_ t1 t2 dst off) + (store-pair 2 'pre t1 t2 dst off)) + +(defun STPSpre (_ t1 t2 dst off) + (store-pair 2 'pre t1 t2 dst off)) + +(defun STPDpre (_ t1 t2 dst off) + (store-pair 3 'pre t1 t2 dst off)) + +(defun STPQpre (_ t1 t2 dst off) + (store-pair 4 'pre t1 t2 dst off)) + +; signed-offset (defun STPWi (rt rt2 base imm) - (let ((datasize 16) (off (* imm 4))) - (store-word (+ base off) rt) - (store-word (+ base off datasize) rt2))) + (store-pair 2 'offset rt rt2 base imm)) -(defun STPXi (t1 t2 base off) - (let ((off (* off 8))) - (store-word (+ base off) t1) - (store-word (+ base off (sizeof word)) t2))) +(defun STPXi (rt rt2 base imm) + (store-pair 3 'offset rt rt2 base imm)) + +(defun STPSi (rt rt2 base imm) + (store-pair 2 'offset rt rt2 base imm)) + +(defun STPDi (rt rt2 base imm) + (store-pair 3 'offset rt rt2 base imm)) -; signed offset STP (SIMD/FP) (defun STPQi (rt rt2 base imm) - (let ((datasize 128) (off (* imm 16))) - (store-word (+ base off) rt) - (store-word (+ base off datasize) rt2))) + (store-pair 4 'offset rt rt2 base imm)) + ; addr + offset indexed STUR (defmacro STUR*i (src base off size) From dc13820727a37f810a97d278f982cc9919f5fe5b Mon Sep 17 00:00:00 2001 From: alistair Date: Fri, 1 Jul 2022 03:24:57 +0000 Subject: [PATCH 066/132] generalise STR and add STR.roW --- .../arm/semantics/aarch64-data-movement.lisp | 57 ++++++++++++++++--- 1 file changed, 49 insertions(+), 8 deletions(-) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index b2e9ff0e2..e9cdf03d7 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -85,26 +85,67 @@ (store-byte (+ reg off) src)) ; STR (register) -(defun str-reg (rt rn rm signed shift) +(defun str-reg (scale rt rn rm signed shift) + "stores rt to (rn + rm << (shift * scale)) with signed or unsigned extension + of rm, where rt is a register of size (8 << scale). Note that rm can be an X + or W register and it chooses the appropriate extend mode implicitly. rn must + be an X register." (assert (< signed 2)) + (assert-msg (= (word-width rt) (lshift 8 scale)) + "(aarch64-data-movement.lisp:str-reg) scale must match size of rt") (store-word (+ rn (if (= signed 1) - (signed-extend (word-width rm) (lshift rm shift)) - (unsigned-extend (word-width rm) (lshift rm shift)))) + (signed-extend (word-width rm) (lshift rm (* shift scale))) + (unsigned-extend (word-width rm) (lshift rm (* shift scale))))) rt)) +; rm is an X register (defun STRWroX (rt rn rm option shift) - (str-reg rt rn rm option (* shift 2))) + (str-reg 2 rt rn rm option shift)) (defun STRXroX (rt rn rm option shift) - (str-reg rt rn rm option (* shift 3))) + (str-reg 3 rt rn rm option shift)) + +(defun STRBroX (rt rn rm option shift) + (str-reg 0 rt rn rm option shift)) + +(defun STRHroX (rt rn rm option shift) + (str-reg 1 rt rn rm option shift)) + +(defun STRSroX (rt rn rm option shift) + (str-reg 2 rt rn rm option shift)) + +(defun STRDroX (rt rn rm option shift) + (str-reg 3 rt rn rm option shift)) (defun STRQroX (rt rn rm option shift) - (str-reg rt rn rm option (* shift 4))) + (str-reg 4 rt rn rm option shift)) + +; rm is a W register +(defun STRWroW (rt rn rm option shift) + (str-reg 2 rt rn rm option shift)) + +(defun STRXroW (rt rn rm option shift) + (str-reg 3 rt rn rm option shift)) + +(defun STRBroW (rt rn rm option shift) + (str-reg 0 rt rn rm option shift)) + +(defun STRHroW (rt rn rm option shift) + (str-reg 1 rt rn rm option shift)) + +(defun STRSroW (rt rn rm option shift) + (str-reg 2 rt rn rm option shift)) + +(defun STRDroW (rt rn rm option shift) + (str-reg 3 rt rn rm option shift)) + +(defun STRQroW (rt rn rm option shift) + (str-reg 4 rt rn rm option shift)) ; STRHHroX (defun STRHHroX (rt rn rm option shift) - (str-reg rt rn rm option shift)) + (str-reg 0 rt rn rm option shift)) ; STR (immediate) (base registers): (defun str-post (xreg src off) @@ -138,7 +179,7 @@ "Stores a register of size (8 << scale) to the memory address (reg + (off << scale))." (assert-msg (= (word-width src) (lshift 8 scale)) - "(aarch64-data-movement.lisp) scale must match size of register ") + "(aarch64-data-movement.lisp:STR*ui) scale must match size of register") (store-word (+ reg (lshift off scale)) (cast-unsigned (lshift 8 scale) src))) From 6c818f83870098afd5eb26b3b0a02f7410ff8d26 Mon Sep 17 00:00:00 2001 From: alistair Date: Fri, 1 Jul 2022 04:40:38 +0000 Subject: [PATCH 067/132] fix STP 2nd reg ofset --- plugins/arm/semantics/aarch64-data-movement.lisp | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index e9cdf03d7..d8dc5802d 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -229,13 +229,13 @@ ; STP -(defun store-pair (scale indexing t1 t2 dst off) - "store the pair t1,t2 of size (8 << scale)at the register dst plus an offset, +(defun store-pair (scale indexing t1 t2 dst imm) + "store the pair t1,t2 of size (8 << scale) at the register dst plus an offset, using the specified indexing." (assert-msg (and (= (word-width t1) (lshift 8 scale)) (= (word-width t2) (lshift 8 scale))) "(aarch64-data-movement.lisp) scale must match size of register ") - (let ((off (lshift off scale)) (datasize (lshift 8 scale)) + (let ((off (lshift (cast-signed 64 imm) scale)) (datasize (lshift 8 scale)) (addr (case indexing 'post dst 'pre (+ dst off) @@ -244,7 +244,7 @@ "(aarch64-data-movement.lisp) invalid indexing scheme."))) ) (store-word addr t1) - (store-word (+ addr datasize) t2) + (store-word (+ addr (/ datasize 8)) t2) (case indexing 'post (set$ dst (+ addr off)) 'pre (set$ dst addr) From 4f3d4b0d56044ba4a5397bd3f53d19e17904326e Mon Sep 17 00:00:00 2001 From: alistair Date: Fri, 1 Jul 2022 05:31:56 +0000 Subject: [PATCH 068/132] fix STRHHui offset --- plugins/arm/semantics/aarch64-data-movement.lisp | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index d8dc5802d..b2784cd93 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -110,7 +110,7 @@ (str-reg 0 rt rn rm option shift)) (defun STRHroX (rt rn rm option shift) - (str-reg 1 rt rn rm option shift)) + (str-reg 1 (cast-low 16 rt) rn rm option shift)) (defun STRSroX (rt rn rm option shift) (str-reg 2 rt rn rm option shift)) @@ -132,7 +132,7 @@ (str-reg 0 rt rn rm option shift)) (defun STRHroW (rt rn rm option shift) - (str-reg 1 rt rn rm option shift)) + (str-reg 1 (cast-low 16 rt) rn rm option shift)) (defun STRSroW (rt rn rm option shift) (str-reg 2 rt rn rm option shift)) @@ -145,7 +145,7 @@ ; STRHHroX (defun STRHHroX (rt rn rm option shift) - (str-reg 0 rt rn rm option shift)) + (str-reg 1 (cast-low 16 rt) rn rm option shift)) ; STR (immediate) (base registers): (defun str-post (xreg src off) @@ -206,7 +206,7 @@ ; STRH (base reg), signed offset variant (defun STRHHui (rt rn off) - (store-word (+ rn off) (cast-low 16 rt))) + (store-word (+ rn (lshift off 1)) (cast-low 16 rt))) ; STRB post-indexed (defun STRBBpost (_ rt base simm) From b14b391d9c3e1c0b161af7e471980342e0adb8c7 Mon Sep 17 00:00:00 2001 From: Kaitlyn Lake Date: Tue, 5 Jul 2022 05:36:51 +0000 Subject: [PATCH 069/132] Cleaned up aarch64-data-movement.lisp, added helper for getting vector registers from pairs, added macros for LDS --- .../arm/semantics/aarch64-data-movement.lisp | 137 +++++++++++++----- plugins/arm/semantics/aarch64-helper.lisp | 94 +++++++++++- plugins/arm/semantics/aarch64-vector.lisp | 107 ++++++++------ 3 files changed, 250 insertions(+), 88 deletions(-) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index 37a4a46fd..fedef02df 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -6,37 +6,66 @@ ;; LD... +;; LDR (register) + +(defmacro LDR*ro* (rt base index signed s scale setf mem-load) + "(LDR*ro* rt base index signed s scale setf mem-load) loads a register from memory at the address calculated from a base register and optionally shifted and extended offset value. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + (let ((shift (* s scale)) + (off (if (= signed 1) + (cast-signed 64 (lshift index shift)) + (cast-unsigned 64 (lshift index shift))))) + (setf rt (mem-load (+ base off))))) + +(defmacro LDRWro* (wt base index signed s) (LDR*ro* wt base index signed s 2 setw load-hword)) +(defmacro LDRXro* (xt base index signed s) (LDR*ro* xt base index signed s 3 set$ load-word)) + +(defun LDRWroW (wt base index signed s) (LDRWro* wt base index signed s)) +(defun LDRWroX (wt base index signed s) (LDRWro* wt base index signed s)) +(defun LDRXroW (xt base index signed s) (LDRXro* xt base index signed s)) +(defun LDRXroX (xt base index signed s) (LDRXro* xt base index signed s)) + +;; LDR (immediate, unsigned offset) + (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)))))) +;; LDRB (immediate, post-index) + (defun LDRBBpost (_ dst base simm) + "(LDRBBpost _ dst base simm) loads a byte from the base address and stores it in the 32 bit dst register, and increments the base register by simm. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), ConstrainUnpredictable()" (setw dst (cast-unsigned 32 (load-byte base))) (set$ base (+ base simm))) +;; LDRB (immediate, pre-index) + (defun LDRBBpre (_ dst base simm) + "(LDRBBpre _ dst base simm) loads a byte from the base address and an offset simm and stores it in the 32 bit dst register. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), ConstrainUnpredictable()" (setw dst (cast-unsigned 32 (load-byte (+ base simm))))) +;; LDRB (immediate, unsigned offset) + (defun LDRBBui (dst reg off) + "(LDRBBui _ dst base simm) loads a byte from a preindexed base address and an unsigned offset and stores it in the 32 bit dst register. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), ConstrainUnpredictable()" (setw dst - (cast-unsigned (word) (load-byte (+ reg off))))) + (cast-unsigned 32 (load-byte (+ reg off))))) -(defun LDRBBroW (dst reg off signed shift) - (if (= signed 1) - (setw dst (cast-unsigned 32 (load-byte (+ reg (cast-signed 64 off))))) - (setw dst (cast-unsigned 32 (load-byte (+ reg (cast-unsigned 64 off))))))) +;; LDRB (register) -(defun LDRBBroX (dst reg off _ _) - (setw dst - (cast-unsigned (word) (load-byte (+ reg (cast-signed 64 off)))))) +(defmacro LDRBBro* (dst base index signed) + "(LDRBBro* dst base index signed) loads a byte from memory from a base address and index and stores it in a 32 bit destination register. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + (let ((off (if (= signed 1) + (cast-signed 64 index) + (cast-unsigned 64 index)))) + (setw dst (cast-unsigned 32 (load-byte (+ base off)))))) + +(defun LDRBBroW (dst base index signed _) (LDRBBro* dst base index signed)) +(defun LDRBBroX (dst base index signed _) (LDRBBro* dst base index signed)) + +;; LDP (post-index) (defun LDPXpost (dst r1 r2 base off) (let ((off (lshift off 3))) @@ -44,40 +73,70 @@ (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)))))) +;; LDP (signed offset) + +(defmacro LDP*i (r1 r2 base imm scale datasize setf mem-load) + "(LDP*i r1 r2 base imm scale datasize setf mem-load) loads a pair of registers r1 and r2 from the address calculated from a base register value and immediate offset. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + (let ((off (lshift (cast-signed 64 imm) scale))) + (setf r1 (mem-load (+ base off))) + (setf r2 (mem-load (+ base off (/ datasize 8)))))) -(defun LDPWi (wn wm xn off) - (let ((off (lshift off 2))) - (setw wn (load-hword (+ xn off))) - (setw wm (load-hword (+ xn off 4))))) +(defun LDPXi (r1 r2 base imm) (LDP*i r1 r2 base imm 3 64 set$ load-word)) +(defun LDPWi (w1 w2 base imm) (LDP*i w1 w2 base imm 2 32 setw load-hword)) -(defun LDRXroX (rt rn rm _ shift) - (set$ rt (load-word (+ rn (lshift rm (* shift 3)))))) +;; LDRH (register) -(defmacro LDRHHro*i (wt xn xm extend s) - (if (= extend 1) - (let ((off (cast-signed 64 (lshift xm s)))) - (setw wt (load-bits 16 (+ xn off)))) - (let ((off (cast-unsigned 64 (lshift xm s)))) - (setw wt (load-bits 16 (+ xn off)))))) +(defmacro LDRHHro* (wt base index signed s) + "(LDRHHro* wt base index signed s) loads 2 bytes from the address calculated from a base register address and offset. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + (let ((off (if (= signed 1) + (cast-signed 64 (lshift index s)) + (cast-unsigned 64 (lshift index s))))) + (setw wt (load-dbyte (+ base off))))) -(defun LDRHHroX (wt xn xm extend s) (LDRHHro*i wt xn xm extend s)) +(defun LDRHHroX (wt xn xm extend s) (LDRHHro* wt xn xm extend s)) +(defun LDRHHroW (wt xn wm extend s) (LDRHHro* wt xn wm extend s)) -(defun LDRHHroW (wt xn wm extend s) (LDRHHro*i wt xn wm extend s)) +;; LDRH (immediate, unsigned offset) (defun LDRHHui (wt xn pimm) + "(LDRHHui wt xn pimm) loads 2 bytes from the address calculated from a base register and unsigned immediate offset. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" (let ((off (lshift (cast-unsigned 64 pimm) 1))) - (setw wt (load-bits 16 (+ xn off))))) - -(defun LDRSroX (xt base index signed shift) - (if (= signed 1) - (let ((off (cast-signed 64 (lshift index shift)))) - (set$ xt (load-hword (+ base off)))) - (let ((off (cast-signed 64 (lshift index shift)))) - (set$ xt (load-hword (+ base off)))))) + (setw wt (load-dbyte (+ xn off))))) + +;; LDRSW (immediate, unsigned offset) + +(defun LDRSWui (dst base off) + (set$ dst (cast-signed + (word) + (load-hword (+ base (lshift off 2)))))) + +;; LRDSW (register) + +(defmacro LDRSWro* (xt base index signed s) + "(LDRSWro* xt base index signed s) loads 32 bits from memory from a base address and offset and stores it in the destination register xt. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + (let ((shift (* s 2)) + (off (if (= signed 1) + (cast-signed 64 (lshift index shift)) + (cast-unsigned 64 (lshift index shift))))) + (set$ xt (load-hword (+ base off))))) + +(defun LDRSWroX (xt base xm signed s) (LDRSWro* xt base xm signed s)) +(defun LDRSWroW (xt base wm signed s) (LDRSWro* xt base wm signed s)) + +;; LDURB + +(defun LDURBBi (wt base simm) + "(LDURBBi wt base simm) loads a byte from the address calculated from a base register and signed immediate offset and stores it in the 32 bit destination register. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + (setw wt (load-byte (+ base simm)))) + +;; LDUR + +(defmacro LDUR*i (rt base simm setf mem-load) + "(LDUR*i rt base simm setf mem-load) loads a register from the address calculated from a base register and signed immediate offset. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + (setf rt (mem-load (+ base (cast-signed 64 simm))))) + +(defun LDURWi (wt base simm) (LDUR*i wt base simm setw load-hword)) +(defun LDURXi (xt base simm) (LDUR*i xt base simm set$ load-word)) ;; MOV... diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index 71c6d0acb..66e31609e 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -136,14 +136,16 @@ (defun insert-element-into-vector (vd index element size) "(insert-element-into-vector vd index element size) inserts element into vd[index], where size is in {8,16,32,64}" - (let ((highIndex (* size (+ index 1))) - (lowIndex (- (* size index) 1)) - (topPart (rshift vd highIndex))) - (if (> index 0) - (let ((mask (replicate-to-fill (cast-low 1 0x1) lowIndex)) - (bottomPart (logand vd mask))) - (set-symbol-value vd (extract 127 0 (concat topPart element bottomPart)))) - (set$ vd (extract 127 0 (concat topPart element)))))) + (let ((highIndex (- (* size (+ index 1) 1))) + (lowIndex (* size index))) + (set$ vd (replace-bit-range vd highIndex lowIndex element)))) +;; (mask (concat () () ())) +;; (topPart (rshift vd highIndex))) +;; (if (> index 0) +;; (let ((mask (replicate-to-fill (cast-low 1 0x1) lowIndex)) +;; (bottomPart (logand vd mask))) +;; (set$ vd (extract 127 0 (concat topPart element bottomPart)))) +;; (set$ vd (extract 127 0 (concat topPart element)))))) (defun get-vector-S-element (index vn) "(get-vector-S-element) returns the 32 bit element from vn[index]" @@ -154,3 +156,79 @@ 0x3 (extract 127 96 vn) 0x0)) +(defun load-dbyte (address) + "(load-dbyte address) loads two bytes from memory." + (load-bits 16 address)) + +(defun get-first-128b-reg (qa_qb) + "(get-first-128b-reg qa_qb) returns the first register of a pair of vector registers." + (case (symbol qa_qb) + 'Q0_Q1 'Q0 + 'Q1_Q2 'Q1 + 'Q2_Q3 'Q2 + 'Q3_Q4 'Q3 + 'Q4_Q5 'Q4 + 'Q5_Q6 'Q5 + 'Q6_Q7 'Q6 + 'Q7_Q8 'Q7 + 'Q8_Q9 'Q8 + 'Q9_Q10 'Q9 + 'Q10_Q11 'Q10 + 'Q11_Q12 'Q11 + 'Q12_Q13 'Q12 + 'Q13_Q14 'Q13 + 'Q14_Q15 'Q14 + 'Q15_Q16 'Q15 + 'Q16_Q17 'Q16 + 'Q17_Q18 'Q17 + 'Q18_Q19 'Q18 + 'Q19_Q20 'Q19 + 'Q20_Q21 'Q20 + 'Q21_Q22 'Q21 + 'Q22_Q23 'Q22 + 'Q23_Q24 'Q23 + 'Q24_Q25 'Q24 + 'Q25_Q26 'Q25 + 'Q26_Q27 'Q26 + 'Q27_Q28 'Q27 + 'Q28_Q29 'Q28 + 'Q29_Q30 'Q29 + 'Q30_Q31 'Q30 + 'Q0)) + +(defun get-second-128b-reg (qa_qb) + "(get-second-128b-reg qa_qb) returns the first register of a pair of vector registers." + (case (symbol qa_qb) + 'Q0_Q1 'Q1 + 'Q1_Q2 'Q2 + 'Q2_Q3 'Q3 + 'Q3_Q4 'Q4 + 'Q4_Q5 'Q5 + 'Q5_Q6 'Q6 + 'Q6_Q7 'Q7 + 'Q7_Q8 'Q8 + 'Q8_Q9 'Q9 + 'Q9_Q10 'Q10 + 'Q10_Q11 'Q11 + 'Q11_Q12 'Q12 + 'Q12_Q13 'Q13 + 'Q13_Q14 'Q14 + 'Q14_Q15 'Q15 + 'Q15_Q16 'Q16 + 'Q16_Q17 'Q17 + 'Q17_Q18 'Q18 + 'Q18_Q19 'Q19 + 'Q19_Q20 'Q20 + 'Q20_Q21 'Q21 + 'Q21_Q22 'Q22 + 'Q22_Q23 'Q23 + 'Q23_Q24 'Q24 + 'Q24_Q25 'Q25 + 'Q25_Q26 'Q26 + 'Q26_Q27 'Q27 + 'Q27_Q28 'Q28 + 'Q28_Q29 'Q29 + 'Q29_Q30 'Q30 + 'Q30_Q31 'Q31 + 'Q0)) + diff --git a/plugins/arm/semantics/aarch64-vector.lisp b/plugins/arm/semantics/aarch64-vector.lisp index 1cef0ce04..ba104c2aa 100644 --- a/plugins/arm/semantics/aarch64-vector.lisp +++ b/plugins/arm/semantics/aarch64-vector.lisp @@ -4,11 +4,11 @@ ;;; INS -(defun INSvi32gpr (vd redundant index gpr) +(defun INSvi32gpr (vd _ index gpr) "(INSvi32gpr vd ts index gpr) inserts an element in the general purpose register gpr into vecter register vd at index. NOTE: does not encode Security state & Exception level" (insert-element-into-vector vd index gpr 32)) -(defun INSvi32lane (vd redundant index vn index2) +(defun INSvi32lane (vd _ index vn index2) "NOTE: does not encode Security state & Exception level" (let ((element (get-vector-S-element index2 vn))) (insert-element-into-vector vd index element 32))) @@ -23,6 +23,7 @@ ;; address = xn ;; offs = Zeroes(64) ;; pseudocode: +;; offs(64) = 0 ;; for r = 0 to r = 0 ;; for e = 0 to e = 15 @@ -35,44 +36,68 @@ ;; tt = (tt + 1) MOD 32 = (a + 1) MOD 32 = b; ;; if xn given, offs = X[n] ;; set if address/X reg given -(defun LD2Twov16b_POST (redundant qa_qb xn imm) +(defun LD2Twov16b_POST (_ qa_qb xn xm) "(LD2Twov16b_POST redundant qa_qb xn imm) loads multiple 2-element structures from memory at address xn with offset imm and stores it in qa and qb with de-interleaving. NOTE: does not encode Security state & Exception level" - (msg "$0" qa_qb)) - -(defun LDPQi (qn qm base imm) - "" - (let ((off (lshift (cast-signed 128 imm) 4)) - (dbytes (/ 128 8))) - (set$ qn (load-dword (+ base off))) - (set$ qm (load-dword (+ base off dbytes))))) - -(defun LDPSi (qn qm base imm) - "" - (let ((off (lshift (cast-signed 32 imm) 4)) - (dbytes (/ 32 8))) - (set$ qn (load-hword (+ base off))) - (set$ qm (load-hword (+ base off dbytes))))) - -(defun LDRDui (dt base imm) - "" - (let ((off (lshift (cast-unsigned 64 imm) 3))) - (set$ dt (load-word (+ base off))))) - -(defun LDRQui (qt base imm) - "" - (let ((off (lshift (cast-unsigned 64 imm) 4))) - (set$ qt (load-dword (+ base off))))) - -(defun LDRSui (st base imm) - "" - (let ((off (lshift (cast-unsigned 64 imm) 2))) - (set$ st (load-hword (+ base off))))) - -(defun LDRQroX (qt base index signed shift) - "" - (if (= signed 1) - (let ((off (cast-signed 64 (lshift index shift)))) - (set$ qt (load-bits 16 (+ base off)))) - (let ((off (cast-signed 64 (lshift index shift)))) - (set$ qt (load-bits 16 (+ base off)))))) + (let ((qa (get-first-128b-reg qa_qb)) + (qb (get-second-128b-reg qa_qb))) + (insert-a qa qb xn 0) + (set$ xn (+ xn xm)))) +(defun insert-a (qa qb address e) + (msg "insert-a: $0" e) + (when (< e 16) + (insert-element-into-vector qa e (load-byte address) 8) + (insert-b qa qb (+ address 1) e))) + +(defun insert-b (qa qb address e) + (msg "insert-b: $0" e) + (insert-element-into-vector qb e (load-byte address) 8) + (insert-a qa qb (+ address 1) (+ e 1))) + +(defmacro LDPvec*i (vn vm base imm size mem-load scale) + "(LDP*i qn qm imm size mem-load scale) loads a pair of SIMD&FP registers from memory using the address base and an optional signed immediate offset. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" + (let ((off (lshift (cast-signed 64 imm) scale)) + (dbytes (/ size 8))) + (set$ vn (mem-load (+ base off))) + (set$ vm (mem-load (+ base off dbytes))))) + +(defun LDPQi (qn qm base imm) (LDPvec*i qn qm base imm 128 load-dword 4)) +(defun LDPDi (qn qm base imm) (LDPvec*i qn qm base imm 64 load-dword 3)) +(defun LDPSi (qn qm base imm) (LDPvec*i qn qm base imm 32 load-hword 2)) + +(defmacro LDR*ui (vt base imm mem-load scale) + "(LDR*ui vt base imm mem-load scale) loads an element from memory from the base address and unsigned immediate offset imm and stores the result in vt. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" + (let ((off (lshift (cast-unsigned 64 imm) scale))) + (set$ vt (mem-load (+ base off))))) + +(defun LDRBui (bt base imm) (LDR*ui bt base imm load-byte 0)) +(defun LDRHui (ht base imm) (LDR*ui ht base imm load-dbyte 1)) +(defun LDRSui (st base imm) (LDR*ui st base imm load-hword 2)) +(defun LDRDui (dt base imm) (LDR*ui dt base imm load-word 3)) +(defun LDRQui (qt base imm) (LDR*ui qt base imm load-dword 4)) + +(defmacro LDR*roX (vt base index signed s scale mem-load) + "(LDR*roX vt base index signed s scale mem-load) loads a SIMD&FP register from address base and an optionally shifted and extended index. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" + (let ((shift (if (= s 1) + (+ scale 0) + (+ 0 0))) + (off (if (= signed 1) + (cast-signed 64 (lshift index shift)) + (cast-unsigned 64 (lshift index shift))))) + (set$ vt (mem-load (+ base off))))) + +(defun LDRBroX (bt base index signed s) (LDR*roX bt base index signed s 0 load-byte)) +(defun LDRHroX (ht base index signed s) (LDR*roX ht base index signed s 1 load-dbyte)) +(defun LDRSroX (st base index signed s) (LDR*roX st base index signed s 2 load-hword)) +(defun LDRDroX (dt base index signed s) (LDR*roX dt base index signed s 3 load-word)) +(defun LDRQroX (qt base index signed s) (LDR*roX qt base index signed s 4 load-dword)) + +(defmacro LDURvec*i (vt base simm mem-load) + "(LDUR*i vt base simm mem-load) loads a SIMD&FP register from memory at the address calculated from a base register and optional immediate offset. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" + (set$ vt (mem-load (+ base simm)))) + +(defun LDURBi (bt base simm) (LDURvec*i bt base simm load-byte)) +(defun LDURHi (ht base simm) (LDURvec*i ht base simm load-dbyte)) +(defun LDURSi (st base simm) (LDURvec*i st base simm load-hword)) +(defun LDURDi (dt base simm) (LDURvec*i dt base simm load-word)) +(defun LDURQi (qt base simm) (LDURvec*i qt base simm load-dword)) From 7dc8bc4df4a1a5b194ea1216d59049a546c55708 Mon Sep 17 00:00:00 2001 From: Kaitlyn Lake Date: Tue, 5 Jul 2022 06:00:12 +0000 Subject: [PATCH 070/132] Removed debugging code --- plugins/arm/semantics/aarch64-logical.lisp | 14 +++++++++++++ plugins/arm/semantics/aarch64-vector.lisp | 23 ---------------------- 2 files changed, 14 insertions(+), 23 deletions(-) diff --git a/plugins/arm/semantics/aarch64-logical.lisp b/plugins/arm/semantics/aarch64-logical.lisp index 4c732a21e..62c6e382f 100644 --- a/plugins/arm/semantics/aarch64-logical.lisp +++ b/plugins/arm/semantics/aarch64-logical.lisp @@ -110,6 +110,20 @@ (defun REV16Wr (rd rn) (REVn*r set$ 16 rd rn)) (defun REV32Xr (rd rn) (REVn*r setw 32 rd rn)) +(defmacro LSLV*r (dest rn rm size setf) + "(LSLV*r dest rn rm size) logical shift lefts rn by the remainder of rm divided by the datasize and stores the result in the destination register." + (setf dest (lshift rn (mod rm size)))) + +(defun LSLVWr (wd wn wm) (LSLV*r wd wn wm 32 setw)) +(defun LSLVXr (xd xn xm) (LSLV*r xd xn xm 64 set$)) + +(defmacro LSRV*r (dest rn rm size setf) + "(LSRV*r dest rn rm size) logical shift rights rn by the remainder of rm divided by the datasize and stores the result in the destination register." + (setf dest (rshift rn (mod rm size)))) + +(defun LSRVWr (wd wn wm) (LSRV*r wd wn wm 32 setw)) +(defun LSRVXr (xd xn xm) (LSRV*r xd xn xm 64 set$)) + ;; UBFM and SBFM ;; (bitfield moves) diff --git a/plugins/arm/semantics/aarch64-vector.lisp b/plugins/arm/semantics/aarch64-vector.lisp index ba104c2aa..16c6a1bdb 100644 --- a/plugins/arm/semantics/aarch64-vector.lisp +++ b/plugins/arm/semantics/aarch64-vector.lisp @@ -15,27 +15,6 @@ ;;; LDs.. -;; opcde = 1000, rpt = 1, selem = 2 -;; L = 1, MEMOP_LOAD -;; T = 16B, imm = #32, Q = 1, size = 00 -;; datasize = 128, esize = 8 -;; elements = 16 -;; address = xn -;; offs = Zeroes(64) -;; pseudocode: -;; offs(64) = 0 - -;; for r = 0 to r = 0 -;; for e = 0 to e = 15 -;; tt = (UInt(Rt) + 0) MOD 32 = a; --- this is getting the vector reg from the instruction Rt field, which in this case will just be a -;; for s = 0 to s = 1 -;; rval = V(tt) = _Z[tt]<127:0> = qa -;; Elem[rval, e, 8] = rval<(e+1)*size-1:e*size> = Mem[address+offs, 1, AccType_VEC] = load-byte (+ xn imm) -;; V[tt] = rval -;; offs = offs + 1 -;; tt = (tt + 1) MOD 32 = (a + 1) MOD 32 = b; -;; if xn given, offs = X[n] -;; set if address/X reg given (defun LD2Twov16b_POST (_ qa_qb xn xm) "(LD2Twov16b_POST redundant qa_qb xn imm) loads multiple 2-element structures from memory at address xn with offset imm and stores it in qa and qb with de-interleaving. NOTE: does not encode Security state & Exception level" (let ((qa (get-first-128b-reg qa_qb)) @@ -44,13 +23,11 @@ (set$ xn (+ xn xm)))) (defun insert-a (qa qb address e) - (msg "insert-a: $0" e) (when (< e 16) (insert-element-into-vector qa e (load-byte address) 8) (insert-b qa qb (+ address 1) e))) (defun insert-b (qa qb address e) - (msg "insert-b: $0" e) (insert-element-into-vector qb e (load-byte address) 8) (insert-a qa qb (+ address 1) (+ e 1))) From 5675ca0a19148057850821a4ec51c04ee8adf949 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Wed, 6 Jul 2022 01:20:00 +0000 Subject: [PATCH 071/132] change tabs to spaces --- .../arm/semantics/aarch64-data-movement.lisp | 66 +++---- plugins/arm/semantics/aarch64-helper.lisp | 164 +++++++++--------- plugins/arm/semantics/aarch64-logical.lisp | 18 +- plugins/arm/semantics/aarch64-vector.lisp | 58 +++---- 4 files changed, 153 insertions(+), 153 deletions(-) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index fedef02df..ab6ce541e 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -9,12 +9,12 @@ ;; LDR (register) (defmacro LDR*ro* (rt base index signed s scale setf mem-load) - "(LDR*ro* rt base index signed s scale setf mem-load) loads a register from memory at the address calculated from a base register and optionally shifted and extended offset value. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" - (let ((shift (* s scale)) + "(LDR*ro* rt base index signed s scale setf mem-load) loads a register from memory at the address calculated from a base register and optionally shifted and extended offset value. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + (let ((shift (* s scale)) (off (if (= signed 1) - (cast-signed 64 (lshift index shift)) - (cast-unsigned 64 (lshift index shift))))) - (setf rt (mem-load (+ base off))))) + (cast-signed 64 (lshift index shift)) + (cast-unsigned 64 (lshift index shift))))) + (setf rt (mem-load (+ base off))))) (defmacro LDRWro* (wt base index signed s) (LDR*ro* wt base index signed s 2 setw load-hword)) (defmacro LDRXro* (xt base index signed s) (LDR*ro* xt base index signed s 3 set$ load-word)) @@ -36,31 +36,31 @@ ;; LDRB (immediate, post-index) (defun LDRBBpost (_ dst base simm) - "(LDRBBpost _ dst base simm) loads a byte from the base address and stores it in the 32 bit dst register, and increments the base register by simm. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), ConstrainUnpredictable()" - (setw dst (cast-unsigned 32 (load-byte base))) - (set$ base (+ base simm))) + "(LDRBBpost _ dst base simm) loads a byte from the base address and stores it in the 32 bit dst register, and increments the base register by simm. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), ConstrainUnpredictable()" + (setw dst (cast-unsigned 32 (load-byte base))) + (set$ base (+ base simm))) ;; LDRB (immediate, pre-index) (defun LDRBBpre (_ dst base simm) - "(LDRBBpre _ dst base simm) loads a byte from the base address and an offset simm and stores it in the 32 bit dst register. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), ConstrainUnpredictable()" - (setw dst (cast-unsigned 32 (load-byte (+ base simm))))) + "(LDRBBpre _ dst base simm) loads a byte from the base address and an offset simm and stores it in the 32 bit dst register. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), ConstrainUnpredictable()" + (setw dst (cast-unsigned 32 (load-byte (+ base simm))))) ;; LDRB (immediate, unsigned offset) (defun LDRBBui (dst reg off) - "(LDRBBui _ dst base simm) loads a byte from a preindexed base address and an unsigned offset and stores it in the 32 bit dst register. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), ConstrainUnpredictable()" + "(LDRBBui _ dst base simm) loads a byte from a preindexed base address and an unsigned offset and stores it in the 32 bit dst register. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), ConstrainUnpredictable()" (setw dst (cast-unsigned 32 (load-byte (+ reg off))))) ;; LDRB (register) (defmacro LDRBBro* (dst base index signed) - "(LDRBBro* dst base index signed) loads a byte from memory from a base address and index and stores it in a 32 bit destination register. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" - (let ((off (if (= signed 1) - (cast-signed 64 index) - (cast-unsigned 64 index)))) - (setw dst (cast-unsigned 32 (load-byte (+ base off)))))) + "(LDRBBro* dst base index signed) loads a byte from memory from a base address and index and stores it in a 32 bit destination register. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + (let ((off (if (= signed 1) + (cast-signed 64 index) + (cast-unsigned 64 index)))) + (setw dst (cast-unsigned 32 (load-byte (+ base off)))))) (defun LDRBBroW (dst base index signed _) (LDRBBro* dst base index signed)) (defun LDRBBroX (dst base index signed _) (LDRBBro* dst base index signed)) @@ -76,8 +76,8 @@ ;; LDP (signed offset) (defmacro LDP*i (r1 r2 base imm scale datasize setf mem-load) - "(LDP*i r1 r2 base imm scale datasize setf mem-load) loads a pair of registers r1 and r2 from the address calculated from a base register value and immediate offset. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" - (let ((off (lshift (cast-signed 64 imm) scale))) + "(LDP*i r1 r2 base imm scale datasize setf mem-load) loads a pair of registers r1 and r2 from the address calculated from a base register value and immediate offset. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + (let ((off (lshift (cast-signed 64 imm) scale))) (setf r1 (mem-load (+ base off))) (setf r2 (mem-load (+ base off (/ datasize 8)))))) @@ -87,11 +87,11 @@ ;; LDRH (register) (defmacro LDRHHro* (wt base index signed s) - "(LDRHHro* wt base index signed s) loads 2 bytes from the address calculated from a base register address and offset. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" - (let ((off (if (= signed 1) - (cast-signed 64 (lshift index s)) - (cast-unsigned 64 (lshift index s))))) - (setw wt (load-dbyte (+ base off))))) + "(LDRHHro* wt base index signed s) loads 2 bytes from the address calculated from a base register address and offset. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + (let ((off (if (= signed 1) + (cast-signed 64 (lshift index s)) + (cast-unsigned 64 (lshift index s))))) + (setw wt (load-dbyte (+ base off))))) (defun LDRHHroX (wt xn xm extend s) (LDRHHro* wt xn xm extend s)) (defun LDRHHroW (wt xn wm extend s) (LDRHHro* wt xn wm extend s)) @@ -99,9 +99,9 @@ ;; LDRH (immediate, unsigned offset) (defun LDRHHui (wt xn pimm) - "(LDRHHui wt xn pimm) loads 2 bytes from the address calculated from a base register and unsigned immediate offset. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" - (let ((off (lshift (cast-unsigned 64 pimm) 1))) - (setw wt (load-dbyte (+ xn off))))) + "(LDRHHui wt xn pimm) loads 2 bytes from the address calculated from a base register and unsigned immediate offset. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + (let ((off (lshift (cast-unsigned 64 pimm) 1))) + (setw wt (load-dbyte (+ xn off))))) ;; LDRSW (immediate, unsigned offset) @@ -116,9 +116,9 @@ "(LDRSWro* xt base index signed s) loads 32 bits from memory from a base address and offset and stores it in the destination register xt. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" (let ((shift (* s 2)) (off (if (= signed 1) - (cast-signed 64 (lshift index shift)) - (cast-unsigned 64 (lshift index shift))))) - (set$ xt (load-hword (+ base off))))) + (cast-signed 64 (lshift index shift)) + (cast-unsigned 64 (lshift index shift))))) + (set$ xt (load-hword (+ base off))))) (defun LDRSWroX (xt base xm signed s) (LDRSWro* xt base xm signed s)) (defun LDRSWroW (xt base wm signed s) (LDRSWro* xt base wm signed s)) @@ -126,14 +126,14 @@ ;; LDURB (defun LDURBBi (wt base simm) - "(LDURBBi wt base simm) loads a byte from the address calculated from a base register and signed immediate offset and stores it in the 32 bit destination register. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" - (setw wt (load-byte (+ base simm)))) + "(LDURBBi wt base simm) loads a byte from the address calculated from a base register and signed immediate offset and stores it in the 32 bit destination register. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + (setw wt (load-byte (+ base simm)))) ;; LDUR (defmacro LDUR*i (rt base simm setf mem-load) - "(LDUR*i rt base simm setf mem-load) loads a register from the address calculated from a base register and signed immediate offset. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" - (setf rt (mem-load (+ base (cast-signed 64 simm))))) + "(LDUR*i rt base simm setf mem-load) loads a register from the address calculated from a base register and signed immediate offset. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + (setf rt (mem-load (+ base (cast-signed 64 simm))))) (defun LDURWi (wt base simm) (LDUR*i wt base simm setw load-hword)) (defun LDURXi (xt base simm) (LDUR*i xt base simm set$ load-word)) diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index 66e31609e..8dc9cedb4 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -135,20 +135,20 @@ (cast-low (- (word-width x) container-size) x))))) (defun insert-element-into-vector (vd index element size) - "(insert-element-into-vector vd index element size) inserts element into vd[index], where size is in {8,16,32,64}" - (let ((highIndex (- (* size (+ index 1) 1))) - (lowIndex (* size index))) - (set$ vd (replace-bit-range vd highIndex lowIndex element)))) -;; (mask (concat () () ())) -;; (topPart (rshift vd highIndex))) -;; (if (> index 0) -;; (let ((mask (replicate-to-fill (cast-low 1 0x1) lowIndex)) -;; (bottomPart (logand vd mask))) -;; (set$ vd (extract 127 0 (concat topPart element bottomPart)))) -;; (set$ vd (extract 127 0 (concat topPart element)))))) + "(insert-element-into-vector vd index element size) inserts element into vd[index], where size is in {8,16,32,64}" + (let ((highIndex (- (* size (+ index 1) 1))) + (lowIndex (* size index))) + (set$ vd (replace-bit-range vd highIndex lowIndex element)))) +;; (mask (concat () () ())) +;; (topPart (rshift vd highIndex))) +;; (if (> index 0) +;; (let ((mask (replicate-to-fill (cast-low 1 0x1) lowIndex)) +;; (bottomPart (logand vd mask))) +;; (set$ vd (extract 127 0 (concat topPart element bottomPart)))) +;; (set$ vd (extract 127 0 (concat topPart element)))))) (defun get-vector-S-element (index vn) - "(get-vector-S-element) returns the 32 bit element from vn[index]" + "(get-vector-S-element) returns the 32 bit element from vn[index]" (case index 0x0 (extract 31 0 vn) 0x1 (extract 63 32 vn) @@ -157,78 +157,78 @@ 0x0)) (defun load-dbyte (address) - "(load-dbyte address) loads two bytes from memory." - (load-bits 16 address)) + "(load-dbyte address) loads two bytes from memory." + (load-bits 16 address)) (defun get-first-128b-reg (qa_qb) - "(get-first-128b-reg qa_qb) returns the first register of a pair of vector registers." - (case (symbol qa_qb) - 'Q0_Q1 'Q0 - 'Q1_Q2 'Q1 - 'Q2_Q3 'Q2 - 'Q3_Q4 'Q3 - 'Q4_Q5 'Q4 - 'Q5_Q6 'Q5 - 'Q6_Q7 'Q6 - 'Q7_Q8 'Q7 - 'Q8_Q9 'Q8 - 'Q9_Q10 'Q9 - 'Q10_Q11 'Q10 - 'Q11_Q12 'Q11 - 'Q12_Q13 'Q12 - 'Q13_Q14 'Q13 - 'Q14_Q15 'Q14 - 'Q15_Q16 'Q15 - 'Q16_Q17 'Q16 - 'Q17_Q18 'Q17 - 'Q18_Q19 'Q18 - 'Q19_Q20 'Q19 - 'Q20_Q21 'Q20 - 'Q21_Q22 'Q21 - 'Q22_Q23 'Q22 - 'Q23_Q24 'Q23 - 'Q24_Q25 'Q24 - 'Q25_Q26 'Q25 - 'Q26_Q27 'Q26 - 'Q27_Q28 'Q27 - 'Q28_Q29 'Q28 - 'Q29_Q30 'Q29 - 'Q30_Q31 'Q30 - 'Q0)) + "(get-first-128b-reg qa_qb) returns the first register of a pair of vector registers." + (case (symbol qa_qb) + 'Q0_Q1 'Q0 + 'Q1_Q2 'Q1 + 'Q2_Q3 'Q2 + 'Q3_Q4 'Q3 + 'Q4_Q5 'Q4 + 'Q5_Q6 'Q5 + 'Q6_Q7 'Q6 + 'Q7_Q8 'Q7 + 'Q8_Q9 'Q8 + 'Q9_Q10 'Q9 + 'Q10_Q11 'Q10 + 'Q11_Q12 'Q11 + 'Q12_Q13 'Q12 + 'Q13_Q14 'Q13 + 'Q14_Q15 'Q14 + 'Q15_Q16 'Q15 + 'Q16_Q17 'Q16 + 'Q17_Q18 'Q17 + 'Q18_Q19 'Q18 + 'Q19_Q20 'Q19 + 'Q20_Q21 'Q20 + 'Q21_Q22 'Q21 + 'Q22_Q23 'Q22 + 'Q23_Q24 'Q23 + 'Q24_Q25 'Q24 + 'Q25_Q26 'Q25 + 'Q26_Q27 'Q26 + 'Q27_Q28 'Q27 + 'Q28_Q29 'Q28 + 'Q29_Q30 'Q29 + 'Q30_Q31 'Q30 + 'Q0)) (defun get-second-128b-reg (qa_qb) - "(get-second-128b-reg qa_qb) returns the first register of a pair of vector registers." - (case (symbol qa_qb) - 'Q0_Q1 'Q1 - 'Q1_Q2 'Q2 - 'Q2_Q3 'Q3 - 'Q3_Q4 'Q4 - 'Q4_Q5 'Q5 - 'Q5_Q6 'Q6 - 'Q6_Q7 'Q7 - 'Q7_Q8 'Q8 - 'Q8_Q9 'Q9 - 'Q9_Q10 'Q10 - 'Q10_Q11 'Q11 - 'Q11_Q12 'Q12 - 'Q12_Q13 'Q13 - 'Q13_Q14 'Q14 - 'Q14_Q15 'Q15 - 'Q15_Q16 'Q16 - 'Q16_Q17 'Q17 - 'Q17_Q18 'Q18 - 'Q18_Q19 'Q19 - 'Q19_Q20 'Q20 - 'Q20_Q21 'Q21 - 'Q21_Q22 'Q22 - 'Q22_Q23 'Q23 - 'Q23_Q24 'Q24 - 'Q24_Q25 'Q25 - 'Q25_Q26 'Q26 - 'Q26_Q27 'Q27 - 'Q27_Q28 'Q28 - 'Q28_Q29 'Q29 - 'Q29_Q30 'Q30 - 'Q30_Q31 'Q31 - 'Q0)) + "(get-second-128b-reg qa_qb) returns the first register of a pair of vector registers." + (case (symbol qa_qb) + 'Q0_Q1 'Q1 + 'Q1_Q2 'Q2 + 'Q2_Q3 'Q3 + 'Q3_Q4 'Q4 + 'Q4_Q5 'Q5 + 'Q5_Q6 'Q6 + 'Q6_Q7 'Q7 + 'Q7_Q8 'Q8 + 'Q8_Q9 'Q9 + 'Q9_Q10 'Q10 + 'Q10_Q11 'Q11 + 'Q11_Q12 'Q12 + 'Q12_Q13 'Q13 + 'Q13_Q14 'Q14 + 'Q14_Q15 'Q15 + 'Q15_Q16 'Q16 + 'Q16_Q17 'Q17 + 'Q17_Q18 'Q18 + 'Q18_Q19 'Q19 + 'Q19_Q20 'Q20 + 'Q20_Q21 'Q21 + 'Q21_Q22 'Q22 + 'Q22_Q23 'Q23 + 'Q23_Q24 'Q24 + 'Q24_Q25 'Q25 + 'Q25_Q26 'Q26 + 'Q26_Q27 'Q27 + 'Q27_Q28 'Q28 + 'Q28_Q29 'Q29 + 'Q29_Q30 'Q30 + 'Q30_Q31 'Q31 + 'Q0)) diff --git a/plugins/arm/semantics/aarch64-logical.lisp b/plugins/arm/semantics/aarch64-logical.lisp index 62c6e382f..de6df14dc 100644 --- a/plugins/arm/semantics/aarch64-logical.lisp +++ b/plugins/arm/semantics/aarch64-logical.lisp @@ -80,7 +80,7 @@ (defmacro BIC*r (setr rd rn rm is) "(BIC*r setr rd rn rm) stores the result of a logical and of rn with the complement of the contents of optionally shifted rm in rd" (let ((shift (shift-encoded rm is)) - (comp (lnot shift))) + (comp (lnot shift))) (setr rd (logand rn comp)))) (defun BICWr (rd rn rm is) (BIC*r setw rd rn rm is)) @@ -88,11 +88,11 @@ (defmacro BICS*rs (setr rd rn rm is) "(BICS*r setr rd rn rm) sets appropriate flags and stores the result of a logical and of rn with the complement of the contents of optionally shifted rm in rd" - (let ((shift (shift-encoded rm is)) - (comp (lnot shift)) - (result (logand rn comp))) + (let ((shift (shift-encoded rm is)) + (comp (lnot shift)) + (result (logand rn comp))) (set-nzcv-after-logic-op result) - (setr rd result))) + (setr rd result))) (defun BICSWrs (rd rn rm is) (BICS*rs setw rd rn rm is)) (defun BICSXrs (rd rn rm is) (BICS*rs set$ rd rn rm is)) @@ -111,15 +111,15 @@ (defun REV32Xr (rd rn) (REVn*r setw 32 rd rn)) (defmacro LSLV*r (dest rn rm size setf) - "(LSLV*r dest rn rm size) logical shift lefts rn by the remainder of rm divided by the datasize and stores the result in the destination register." - (setf dest (lshift rn (mod rm size)))) + "(LSLV*r dest rn rm size) logical shift lefts rn by the remainder of rm divided by the datasize and stores the result in the destination register." + (setf dest (lshift rn (mod rm size)))) (defun LSLVWr (wd wn wm) (LSLV*r wd wn wm 32 setw)) (defun LSLVXr (xd xn xm) (LSLV*r xd xn xm 64 set$)) (defmacro LSRV*r (dest rn rm size setf) - "(LSRV*r dest rn rm size) logical shift rights rn by the remainder of rm divided by the datasize and stores the result in the destination register." - (setf dest (rshift rn (mod rm size)))) + "(LSRV*r dest rn rm size) logical shift rights rn by the remainder of rm divided by the datasize and stores the result in the destination register." + (setf dest (rshift rn (mod rm size)))) (defun LSRVWr (wd wn wm) (LSRV*r wd wn wm 32 setw)) (defun LSRVXr (xd xn xm) (LSRV*r xd xn xm 64 set$)) diff --git a/plugins/arm/semantics/aarch64-vector.lisp b/plugins/arm/semantics/aarch64-vector.lisp index 16c6a1bdb..7729b78b3 100644 --- a/plugins/arm/semantics/aarch64-vector.lisp +++ b/plugins/arm/semantics/aarch64-vector.lisp @@ -6,46 +6,46 @@ (defun INSvi32gpr (vd _ index gpr) "(INSvi32gpr vd ts index gpr) inserts an element in the general purpose register gpr into vecter register vd at index. NOTE: does not encode Security state & Exception level" - (insert-element-into-vector vd index gpr 32)) + (insert-element-into-vector vd index gpr 32)) (defun INSvi32lane (vd _ index vn index2) "NOTE: does not encode Security state & Exception level" - (let ((element (get-vector-S-element index2 vn))) - (insert-element-into-vector vd index element 32))) + (let ((element (get-vector-S-element index2 vn))) + (insert-element-into-vector vd index element 32))) ;;; LDs.. (defun LD2Twov16b_POST (_ qa_qb xn xm) "(LD2Twov16b_POST redundant qa_qb xn imm) loads multiple 2-element structures from memory at address xn with offset imm and stores it in qa and qb with de-interleaving. NOTE: does not encode Security state & Exception level" - (let ((qa (get-first-128b-reg qa_qb)) - (qb (get-second-128b-reg qa_qb))) - (insert-a qa qb xn 0) - (set$ xn (+ xn xm)))) + (let ((qa (get-first-128b-reg qa_qb)) + (qb (get-second-128b-reg qa_qb))) + (insert-a qa qb xn 0) + (set$ xn (+ xn xm)))) (defun insert-a (qa qb address e) - (when (< e 16) - (insert-element-into-vector qa e (load-byte address) 8) - (insert-b qa qb (+ address 1) e))) + (when (< e 16) + (insert-element-into-vector qa e (load-byte address) 8) + (insert-b qa qb (+ address 1) e))) (defun insert-b (qa qb address e) - (insert-element-into-vector qb e (load-byte address) 8) - (insert-a qa qb (+ address 1) (+ e 1))) + (insert-element-into-vector qb e (load-byte address) 8) + (insert-a qa qb (+ address 1) (+ e 1))) (defmacro LDPvec*i (vn vm base imm size mem-load scale) - "(LDP*i qn qm imm size mem-load scale) loads a pair of SIMD&FP registers from memory using the address base and an optional signed immediate offset. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" - (let ((off (lshift (cast-signed 64 imm) scale)) - (dbytes (/ size 8))) - (set$ vn (mem-load (+ base off))) - (set$ vm (mem-load (+ base off dbytes))))) + "(LDP*i qn qm imm size mem-load scale) loads a pair of SIMD&FP registers from memory using the address base and an optional signed immediate offset. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" + (let ((off (lshift (cast-signed 64 imm) scale)) + (dbytes (/ size 8))) + (set$ vn (mem-load (+ base off))) + (set$ vm (mem-load (+ base off dbytes))))) (defun LDPQi (qn qm base imm) (LDPvec*i qn qm base imm 128 load-dword 4)) (defun LDPDi (qn qm base imm) (LDPvec*i qn qm base imm 64 load-dword 3)) (defun LDPSi (qn qm base imm) (LDPvec*i qn qm base imm 32 load-hword 2)) (defmacro LDR*ui (vt base imm mem-load scale) - "(LDR*ui vt base imm mem-load scale) loads an element from memory from the base address and unsigned immediate offset imm and stores the result in vt. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" - (let ((off (lshift (cast-unsigned 64 imm) scale))) - (set$ vt (mem-load (+ base off))))) + "(LDR*ui vt base imm mem-load scale) loads an element from memory from the base address and unsigned immediate offset imm and stores the result in vt. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" + (let ((off (lshift (cast-unsigned 64 imm) scale))) + (set$ vt (mem-load (+ base off))))) (defun LDRBui (bt base imm) (LDR*ui bt base imm load-byte 0)) (defun LDRHui (ht base imm) (LDR*ui ht base imm load-dbyte 1)) @@ -54,14 +54,14 @@ (defun LDRQui (qt base imm) (LDR*ui qt base imm load-dword 4)) (defmacro LDR*roX (vt base index signed s scale mem-load) - "(LDR*roX vt base index signed s scale mem-load) loads a SIMD&FP register from address base and an optionally shifted and extended index. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" - (let ((shift (if (= s 1) - (+ scale 0) - (+ 0 0))) + "(LDR*roX vt base index signed s scale mem-load) loads a SIMD&FP register from address base and an optionally shifted and extended index. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" + (let ((shift (if (= s 1) + (+ scale 0) + (+ 0 0))) (off (if (= signed 1) - (cast-signed 64 (lshift index shift)) - (cast-unsigned 64 (lshift index shift))))) - (set$ vt (mem-load (+ base off))))) + (cast-signed 64 (lshift index shift)) + (cast-unsigned 64 (lshift index shift))))) + (set$ vt (mem-load (+ base off))))) (defun LDRBroX (bt base index signed s) (LDR*roX bt base index signed s 0 load-byte)) (defun LDRHroX (ht base index signed s) (LDR*roX ht base index signed s 1 load-dbyte)) @@ -70,8 +70,8 @@ (defun LDRQroX (qt base index signed s) (LDR*roX qt base index signed s 4 load-dword)) (defmacro LDURvec*i (vt base simm mem-load) - "(LDUR*i vt base simm mem-load) loads a SIMD&FP register from memory at the address calculated from a base register and optional immediate offset. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" - (set$ vt (mem-load (+ base simm)))) + "(LDUR*i vt base simm mem-load) loads a SIMD&FP register from memory at the address calculated from a base register and optional immediate offset. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" + (set$ vt (mem-load (+ base simm)))) (defun LDURBi (bt base simm) (LDURvec*i bt base simm load-byte)) (defun LDURHi (ht base simm) (LDURvec*i ht base simm load-dbyte)) From bf06e7d01c472cf552d7788b5ef14e502b79e771 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Thu, 7 Jul 2022 04:06:18 +0000 Subject: [PATCH 072/132] Fix LD2, represent memory accesses in order --- plugins/arm/semantics/aarch64-helper.lisp | 9 +-------- plugins/arm/semantics/aarch64-vector.lisp | 23 +++++++++++++---------- 2 files changed, 14 insertions(+), 18 deletions(-) diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index 8dc9cedb4..93bb6a256 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -136,16 +136,9 @@ (defun insert-element-into-vector (vd index element size) "(insert-element-into-vector vd index element size) inserts element into vd[index], where size is in {8,16,32,64}" - (let ((highIndex (- (* size (+ index 1) 1))) + (let ((highIndex (-1 (* size (+ index 1)))) (lowIndex (* size index))) (set$ vd (replace-bit-range vd highIndex lowIndex element)))) -;; (mask (concat () () ())) -;; (topPart (rshift vd highIndex))) -;; (if (> index 0) -;; (let ((mask (replicate-to-fill (cast-low 1 0x1) lowIndex)) -;; (bottomPart (logand vd mask))) -;; (set$ vd (extract 127 0 (concat topPart element bottomPart)))) -;; (set$ vd (extract 127 0 (concat topPart element)))))) (defun get-vector-S-element (index vn) "(get-vector-S-element) returns the 32 bit element from vn[index]" diff --git a/plugins/arm/semantics/aarch64-vector.lisp b/plugins/arm/semantics/aarch64-vector.lisp index 7729b78b3..6696b8f63 100644 --- a/plugins/arm/semantics/aarch64-vector.lisp +++ b/plugins/arm/semantics/aarch64-vector.lisp @@ -16,20 +16,23 @@ ;;; LDs.. (defun LD2Twov16b_POST (_ qa_qb xn xm) - "(LD2Twov16b_POST redundant qa_qb xn imm) loads multiple 2-element structures from memory at address xn with offset imm and stores it in qa and qb with de-interleaving. NOTE: does not encode Security state & Exception level" + "(LD2Twov16b_POST _ qa_qb xn imm) loads multiple 2-element structures from memory at address xn with offset imm and stores it in qa and qb with de-interleaving. NOTE: does not encode Security state & Exception level" (let ((qa (get-first-128b-reg qa_qb)) (qb (get-second-128b-reg qa_qb))) - (insert-a qa qb xn 0) + (insert-a qa qb xn 0 0 0) (set$ xn (+ xn xm)))) -(defun insert-a (qa qb address e) - (when (< e 16) - (insert-element-into-vector qa e (load-byte address) 8) - (insert-b qa qb (+ address 1) e))) - -(defun insert-b (qa qb address e) - (insert-element-into-vector qb e (load-byte address) 8) - (insert-a qa qb (+ address 1) (+ e 1))) +(defun insert-a (qa qb addr e acc-a acc-b) + (if (< e 16) + (let ((temp (load-byte addr))) + (insert-b qa qb (+ addr 1) e (if (= e 0) temp (concat temp acc-a)) acc-b)) + (prog + (set$ qa acc-a) + (set$ qb acc-b)))) + +(defun insert-b (qa qb addr e acc-a acc-b) + (let ((temp (load-byte addr))) + (insert-a qa qb (+ addr 1) (+ e 1) acc-a (if (= e 0) temp (concat temp acc-b))))) (defmacro LDPvec*i (vn vm base imm size mem-load scale) "(LDP*i qn qm imm size mem-load scale) loads a pair of SIMD&FP registers from memory using the address base and an optional signed immediate offset. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" From e0fdc801334944b837165e141a56f003730ed422 Mon Sep 17 00:00:00 2001 From: alistair Date: Thu, 7 Jul 2022 05:59:16 +0000 Subject: [PATCH 073/132] implement movi --- plugins/arm/semantics/aarch64-vector.lisp | 26 +++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/plugins/arm/semantics/aarch64-vector.lisp b/plugins/arm/semantics/aarch64-vector.lisp index 7729b78b3..3ddccaf1c 100644 --- a/plugins/arm/semantics/aarch64-vector.lisp +++ b/plugins/arm/semantics/aarch64-vector.lisp @@ -13,6 +13,32 @@ (let ((element (get-vector-S-element index2 vn))) (insert-element-into-vector vd index element 32))) + +(defun MOVI* (datasize channelsize vd val shift) + "Sets every channel of vd to have value. the size of val should be equal to + the channel width." + (let ((val (cast-low channelsize (lshift val shift))) + (result (replicate-to-fill val datasize))) + (set$ vd result))) + +(defun MOVIv16b_ns (vd imm) + (MOVI* 64 8 vd imm 0)) + +(defun MOVIv8b_ns (vd imm) + (MOVI* 128 8 vd imm 0)) + +(defun MOVIv4i16 (vd imm shift) + (MOVI* 64 16 vd imm shift)) + +(defun MOVIv8i16 (vd imm shift) + (MOVI* 128 16 vd imm shift)) + +(defun MOVIv2i32 (vd imm shift) + (MOVI* 64 32 vd imm shift)) + +(defun MOVIv4i32 (vd imm shift) + (MOVI* 128 32 vd imm shift)) + ;;; LDs.. (defun LD2Twov16b_POST (_ qa_qb xn xm) From 7ca913201342477cb055ff209188b7f3afabba5e Mon Sep 17 00:00:00 2001 From: alistair Date: Thu, 7 Jul 2022 06:07:41 +0000 Subject: [PATCH 074/132] fix 8bns --- plugins/arm/semantics/aarch64-vector.lisp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/plugins/arm/semantics/aarch64-vector.lisp b/plugins/arm/semantics/aarch64-vector.lisp index 3ddccaf1c..c67146d72 100644 --- a/plugins/arm/semantics/aarch64-vector.lisp +++ b/plugins/arm/semantics/aarch64-vector.lisp @@ -21,10 +21,10 @@ (result (replicate-to-fill val datasize))) (set$ vd result))) -(defun MOVIv16b_ns (vd imm) +(defun MOVIv8b_ns (vd imm) (MOVI* 64 8 vd imm 0)) -(defun MOVIv8b_ns (vd imm) +(defun MOVIv16b_ns (vd imm) (MOVI* 128 8 vd imm 0)) (defun MOVIv4i16 (vd imm shift) From 6ba5af1fbb986d8cdf2d76e09ae8a12dff267627 Mon Sep 17 00:00:00 2001 From: Kaitlyn Lake Date: Thu, 7 Jul 2022 06:37:53 +0000 Subject: [PATCH 075/132] Completely implemented LDR imm, mem-read helper from ISA psuedocode, began implementing LD1, LD3, etc. Implemented new get_nth_register. BAP does not compile. Committing & pushing so I can move off server --- .../arm/semantics/aarch64-data-movement.lisp | 100 +++++++----- plugins/arm/semantics/aarch64-helper.lisp | 31 ++-- plugins/arm/semantics/aarch64-vector.lisp | 143 +++++++++++------- .../primus_lisp_semantic_primitives.ml | 24 +++ 4 files changed, 191 insertions(+), 107 deletions(-) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index fedef02df..8def9d986 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -9,12 +9,12 @@ ;; LDR (register) (defmacro LDR*ro* (rt base index signed s scale setf mem-load) - "(LDR*ro* rt base index signed s scale setf mem-load) loads a register from memory at the address calculated from a base register and optionally shifted and extended offset value. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" - (let ((shift (* s scale)) + "(LDR*ro* rt base index signed s scale setf mem-load) loads a register from memory at the address calculated from a base register and optionally shifted and extended offset value. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + (let ((shift (* s scale)) (off (if (= signed 1) - (cast-signed 64 (lshift index shift)) - (cast-unsigned 64 (lshift index shift))))) - (setf rt (mem-load (+ base off))))) + (cast-signed 64 (lshift index shift)) + (cast-unsigned 64 (lshift index shift))))) + (setf rt (mem-load (+ base off))))) (defmacro LDRWro* (wt base index signed s) (LDR*ro* wt base index signed s 2 setw load-hword)) (defmacro LDRXro* (xt base index signed s) (LDR*ro* xt base index signed s 3 set$ load-word)) @@ -24,43 +24,61 @@ (defun LDRXroW (xt base index signed s) (LDRXro* xt base index signed s)) (defun LDRXroX (xt base index signed s) (LDRXro* xt base index signed s)) -;; LDR (immediate, unsigned offset) +;; LDR (immediate, post-index) -(defun LDRXui (dst reg off) - (set$ dst (load-word (+ reg (lshift off 3))))) +(defmacro LDR*post (dst base off setf) + (setf dst (mem-read base (/ (word-width dst) 8))) + (set$ base (+ base (cast-signed 64 off)))) -(defun LDRWui (dst reg off) - (setw dst - (cast-unsigned (word) (load-hword (+ reg (lshift off 2)))))) +(defun LDRWpost (_ dst base off) (LDR*post dst base off setw)) +(defun LDRXpost (_ dst base off) (LDR*post dst base off set$)) + +;; LDR (immediate, pre-index) + +(defmacro LDR*pre (dst base off setf) + (let ((address (+ base (cast-signed 64 off)))) + (setf dst (mem-read address (/ (word-width dst) 8))) + (set$ base address)) + +(defun LDRWpre (_ dst base off) (LDR*pre dst base off setw)) +(defun LDRXpre (_ dst base off) (LDR*pre dst base off set$)) + +;; LDR (immediate, unsigned offset) + +(defmacro LDR*ui (dst reg off setf scale) + (setf dst (mem-read (+ reg (lshift off scale)) (/ (word-width dst) 8)))) + +(defun LDRXui (dst reg off) (dst reg off set$ 3)) +(defun LDRWui (dst reg off) (dst reg off setw 2)) ;; LDRB (immediate, post-index) (defun LDRBBpost (_ dst base simm) - "(LDRBBpost _ dst base simm) loads a byte from the base address and stores it in the 32 bit dst register, and increments the base register by simm. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), ConstrainUnpredictable()" - (setw dst (cast-unsigned 32 (load-byte base))) - (set$ base (+ base simm))) + "(LDRBBpost _ dst base simm) loads a byte from the base address and stores it in the 32 bit dst register, and increments the base register by simm. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), ConstrainUnpredictable()" + (setw dst (cast-unsigned 32 (load-byte base))) + (set$ base (+ base simm))) ;; LDRB (immediate, pre-index) (defun LDRBBpre (_ dst base simm) - "(LDRBBpre _ dst base simm) loads a byte from the base address and an offset simm and stores it in the 32 bit dst register. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), ConstrainUnpredictable()" - (setw dst (cast-unsigned 32 (load-byte (+ base simm))))) + "(LDRBBpre _ dst base simm) loads a byte from the base address and an offset simm and stores it in the 32 bit dst register. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), ConstrainUnpredictable()" + (setw dst (cast-unsigned 32 (load-byte (+ base simm))))) ;; LDRB (immediate, unsigned offset) (defun LDRBBui (dst reg off) - "(LDRBBui _ dst base simm) loads a byte from a preindexed base address and an unsigned offset and stores it in the 32 bit dst register. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), ConstrainUnpredictable()" + "(LDRBBui _ dst base simm) loads a byte from a preindexed base address and an unsigned offset and stores it in the 32 bit dst register. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), ConstrainUnpredictable()" (setw dst (cast-unsigned 32 (load-byte (+ reg off))))) ;; LDRB (register) (defmacro LDRBBro* (dst base index signed) - "(LDRBBro* dst base index signed) loads a byte from memory from a base address and index and stores it in a 32 bit destination register. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" - (let ((off (if (= signed 1) - (cast-signed 64 index) - (cast-unsigned 64 index)))) - (setw dst (cast-unsigned 32 (load-byte (+ base off)))))) + "(LDRBBro* dst base index signed) loads a byte from memory from a base address and index and stores it in a 32 bit destination register. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + (let ((off (if (= signed 1) + (cast-signed 64 index) + (cast-unsigned 64 index)))) + (setw dst (cast-unsigned 32 (load-byte (+ base off)))))) (defun LDRBBroW (dst base index signed _) (LDRBBro* dst base index signed)) (defun LDRBBroX (dst base index signed _) (LDRBBro* dst base index signed)) @@ -76,8 +94,8 @@ ;; LDP (signed offset) (defmacro LDP*i (r1 r2 base imm scale datasize setf mem-load) - "(LDP*i r1 r2 base imm scale datasize setf mem-load) loads a pair of registers r1 and r2 from the address calculated from a base register value and immediate offset. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" - (let ((off (lshift (cast-signed 64 imm) scale))) + "(LDP*i r1 r2 base imm scale datasize setf mem-load) loads a pair of registers r1 and r2 from the address calculated from a base register value and immediate offset. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + (let ((off (lshift (cast-signed 64 imm) scale))) (setf r1 (mem-load (+ base off))) (setf r2 (mem-load (+ base off (/ datasize 8)))))) @@ -87,11 +105,11 @@ ;; LDRH (register) (defmacro LDRHHro* (wt base index signed s) - "(LDRHHro* wt base index signed s) loads 2 bytes from the address calculated from a base register address and offset. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" - (let ((off (if (= signed 1) - (cast-signed 64 (lshift index s)) - (cast-unsigned 64 (lshift index s))))) - (setw wt (load-dbyte (+ base off))))) + "(LDRHHro* wt base index signed s) loads 2 bytes from the address calculated from a base register address and offset. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + (let ((off (if (= signed 1) + (cast-signed 64 (lshift index s)) + (cast-unsigned 64 (lshift index s))))) + (setw wt (load-dbyte (+ base off))))) (defun LDRHHroX (wt xn xm extend s) (LDRHHro* wt xn xm extend s)) (defun LDRHHroW (wt xn wm extend s) (LDRHHro* wt xn wm extend s)) @@ -99,16 +117,14 @@ ;; LDRH (immediate, unsigned offset) (defun LDRHHui (wt xn pimm) - "(LDRHHui wt xn pimm) loads 2 bytes from the address calculated from a base register and unsigned immediate offset. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" - (let ((off (lshift (cast-unsigned 64 pimm) 1))) - (setw wt (load-dbyte (+ xn off))))) + "(LDRHHui wt xn pimm) loads 2 bytes from the address calculated from a base register and unsigned immediate offset. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + (let ((off (lshift (cast-unsigned 64 pimm) 1))) + (setw wt (load-dbyte (+ xn off))))) ;; LDRSW (immediate, unsigned offset) (defun LDRSWui (dst base off) - (set$ dst (cast-signed - (word) - (load-hword (+ base (lshift off 2)))))) + (set$ dst (cast-signed (word) (load-hword (+ base (lshift off 2)))))) ;; LRDSW (register) @@ -116,9 +132,9 @@ "(LDRSWro* xt base index signed s) loads 32 bits from memory from a base address and offset and stores it in the destination register xt. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" (let ((shift (* s 2)) (off (if (= signed 1) - (cast-signed 64 (lshift index shift)) - (cast-unsigned 64 (lshift index shift))))) - (set$ xt (load-hword (+ base off))))) + (cast-signed 64 (lshift index shift)) + (cast-unsigned 64 (lshift index shift))))) + (set$ xt (load-hword (+ base off))))) (defun LDRSWroX (xt base xm signed s) (LDRSWro* xt base xm signed s)) (defun LDRSWroW (xt base wm signed s) (LDRSWro* xt base wm signed s)) @@ -126,14 +142,14 @@ ;; LDURB (defun LDURBBi (wt base simm) - "(LDURBBi wt base simm) loads a byte from the address calculated from a base register and signed immediate offset and stores it in the 32 bit destination register. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" - (setw wt (load-byte (+ base simm)))) + "(LDURBBi wt base simm) loads a byte from the address calculated from a base register and signed immediate offset and stores it in the 32 bit destination register. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + (setw wt (load-byte (+ base simm)))) ;; LDUR (defmacro LDUR*i (rt base simm setf mem-load) - "(LDUR*i rt base simm setf mem-load) loads a register from the address calculated from a base register and signed immediate offset. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" - (setf rt (mem-load (+ base (cast-signed 64 simm))))) + "(LDUR*i rt base simm setf mem-load) loads a register from the address calculated from a base register and signed immediate offset. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + (setf rt (mem-load (+ base (cast-signed 64 simm))))) (defun LDURWi (wt base simm) (LDUR*i wt base simm setw load-hword)) (defun LDURXi (xt base simm) (LDUR*i xt base simm set$ load-word)) diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index 66e31609e..ff2878f32 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -109,6 +109,15 @@ (result (logor cleared (logand mask (lshift (cast-unsigned (word-width reg) val) lo))))) result)) +(defun replace-bit-range-v (reg hi lo val size) + "(replace-bit-range reg hi lo val) returns reg with bits + hi to lo inclusive set to the value stored in val." + (let ((mask (lshift (cast-unsigned size (ones (+ (- hi lo) 1))) lo)) + (cleared (logand reg (lnot mask))) + (result (logor cleared (logand mask (lshift (cast-unsigned (word-width reg) val) lo))))) + result)) + + (defun reverse-elems-in-one-container (elem-size c) "(reverse-elems-in-one-container elem-size c) reverses the order of each group of elem-size bits in c. @@ -136,16 +145,10 @@ (defun insert-element-into-vector (vd index element size) "(insert-element-into-vector vd index element size) inserts element into vd[index], where size is in {8,16,32,64}" - (let ((highIndex (- (* size (+ index 1) 1))) - (lowIndex (* size index))) - (set$ vd (replace-bit-range vd highIndex lowIndex element)))) -;; (mask (concat () () ())) -;; (topPart (rshift vd highIndex))) -;; (if (> index 0) -;; (let ((mask (replicate-to-fill (cast-low 1 0x1) lowIndex)) -;; (bottomPart (logand vd mask))) -;; (set$ vd (extract 127 0 (concat topPart element bottomPart)))) -;; (set$ vd (extract 127 0 (concat topPart element)))))) + (let ((highIndex (- (* size (+ index 1)) 1)) + (lowIndex (* size index)) + (newVal (replace-bit-range-v v highIndex lowIndex element 128))) + (set$ vd newVal))) (defun get-vector-S-element (index vn) "(get-vector-S-element) returns the 32 bit element from vn[index]" @@ -232,3 +235,11 @@ 'Q30_Q31 'Q31 'Q0)) +(defun mem-read (address size) + "(mem-read address size) loads size bytes from memory at address." + (case size + 1 (load-byte address) + 2 (load-dbyte address) + 4 (load-hword address) + 8 (load-word address) + 16 (concat (load-word address) (load-word (+ address 8))))) diff --git a/plugins/arm/semantics/aarch64-vector.lisp b/plugins/arm/semantics/aarch64-vector.lisp index 16c6a1bdb..5caa1f143 100644 --- a/plugins/arm/semantics/aarch64-vector.lisp +++ b/plugins/arm/semantics/aarch64-vector.lisp @@ -6,75 +6,108 @@ (defun INSvi32gpr (vd _ index gpr) "(INSvi32gpr vd ts index gpr) inserts an element in the general purpose register gpr into vecter register vd at index. NOTE: does not encode Security state & Exception level" - (insert-element-into-vector vd index gpr 32)) + (insert-element-into-vector vd index gpr 32)) (defun INSvi32lane (vd _ index vn index2) "NOTE: does not encode Security state & Exception level" - (let ((element (get-vector-S-element index2 vn))) - (insert-element-into-vector vd index element 32))) + (let ((element (get-vector-S-element index2 vn))) + (insert-element-into-vector vd index element 32))) ;;; LDs.. +;; LD2 (multiple structures, no offset) + +(defmacro LD2Twov16b* (qa_qb xn) + "(LD2Twov16b_POST redundant qa_qb xn imm) loads multiple 2-element structures from memory at address xn with offset imm and stores it in qa and qb with de-interleaving. NOTE: does not encode Security state & Exception level" + (let ((qa (get-first-128b-reg qa_qb)) + (qb (get-second-128b-reg qa_qb))) + (insert-a qa qb xn 0))) + +;;(defun LD2Twov8b (da_db xn) ()) +(defun LD2Twov16b (qa_qb xn) (LD2Twov16b* qa_qb xn)) +;;(defun LD2Twov4h (da_db xn) ()) +;;(defun LD2Twov8h (qa_qb xn) ()) +;;(defun LD2Twov2s (da_db xn) ()) +;;(defun LD2Twov4s (qa_qb xn) ()) +;;(defun LD2Twov2d (qa_qb xn) ()) + +;; LD2 (multiple structures, post index) + (defun LD2Twov16b_POST (_ qa_qb xn xm) "(LD2Twov16b_POST redundant qa_qb xn imm) loads multiple 2-element structures from memory at address xn with offset imm and stores it in qa and qb with de-interleaving. NOTE: does not encode Security state & Exception level" - (let ((qa (get-first-128b-reg qa_qb)) - (qb (get-second-128b-reg qa_qb))) - (insert-a qa qb xn 0) - (set$ xn (+ xn xm)))) + (LD2Twov16b* qa_qb xn) + (set$ xn (+ xn xm))) (defun insert-a (qa qb address e) - (when (< e 16) - (insert-element-into-vector qa e (load-byte address) 8) - (insert-b qa qb (+ address 1) e))) + (when (< e 16) + (insert-element-into-vector qa e (load-byte address) 8) + (insert-b qa qb (+ address 1) e))) (defun insert-b (qa qb address e) - (insert-element-into-vector qb e (load-byte address) 8) - (insert-a qa qb (+ address 1) (+ e 1))) - -(defmacro LDPvec*i (vn vm base imm size mem-load scale) - "(LDP*i qn qm imm size mem-load scale) loads a pair of SIMD&FP registers from memory using the address base and an optional signed immediate offset. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" - (let ((off (lshift (cast-signed 64 imm) scale)) - (dbytes (/ size 8))) - (set$ vn (mem-load (+ base off))) - (set$ vm (mem-load (+ base off dbytes))))) - -(defun LDPQi (qn qm base imm) (LDPvec*i qn qm base imm 128 load-dword 4)) -(defun LDPDi (qn qm base imm) (LDPvec*i qn qm base imm 64 load-dword 3)) -(defun LDPSi (qn qm base imm) (LDPvec*i qn qm base imm 32 load-hword 2)) - -(defmacro LDR*ui (vt base imm mem-load scale) - "(LDR*ui vt base imm mem-load scale) loads an element from memory from the base address and unsigned immediate offset imm and stores the result in vt. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" - (let ((off (lshift (cast-unsigned 64 imm) scale))) - (set$ vt (mem-load (+ base off))))) - -(defun LDRBui (bt base imm) (LDR*ui bt base imm load-byte 0)) -(defun LDRHui (ht base imm) (LDR*ui ht base imm load-dbyte 1)) -(defun LDRSui (st base imm) (LDR*ui st base imm load-hword 2)) -(defun LDRDui (dt base imm) (LDR*ui dt base imm load-word 3)) -(defun LDRQui (qt base imm) (LDR*ui qt base imm load-dword 4)) - -(defmacro LDR*roX (vt base index signed s scale mem-load) - "(LDR*roX vt base index signed s scale mem-load) loads a SIMD&FP register from address base and an optionally shifted and extended index. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" - (let ((shift (if (= s 1) - (+ scale 0) - (+ 0 0))) + (insert-element-into-vector qb e (load-byte address) 8) + (insert-a qa qb (+ address 1) (+ e 1))) + +;; LD1 (multiple structures) + +;;(defun LD1Twov16b_POST (_ qa_qb xn xm) +;; "(LD2Twov16b_POST redundant qa_qb xn imm) loads multiple 2-element structures from memory at address xn with offset imm and stores it in qa and qb with de-interleaving. NOTE: does not encode Security state & Exception level" +;; (let ((qa (get-nth-register qa_qb 0)) +;; (qb (get-nth-register qa_qb 1))) +;; (insert-a qa qb xn 0) +;; (set$ xn (+ xn xm)))) + +;; LDP (signed offset) + +(defmacro LDPvec*i (vn vm base imm size scale) + "(LDP*i qn qm imm size mem-load scale) loads a pair of SIMD&FP registers from memory using the address base and an optional signed immediate offset. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" + (let ((off (lshift (cast-signed 64 imm) scale)) + (dbytes (/ size 8))) + (set$ vn (mem-read (+ base off) (/ size 8))) + (set$ vm (mem-read (+ base off dbytes) (/ size 8))))) + +(defun LDPQi (qn qm base imm) (LDPvec*i qn qm base imm 128 4)) +(defun LDPDi (qn qm base imm) (LDPvec*i qn qm base imm 64 3)) +(defun LDPSi (qn qm base imm) (LDPvec*i qn qm base imm 32 2)) + +;; LDR (immediate, unsigned offset) + +(defmacro LDR*ui (vt base imm size scale) + "(LDR*ui vt base imm mem-load scale) loads an element from memory from the base address and unsigned immediate offset imm and stores the result in vt. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" + (let ((off (lshift (cast-unsigned 64 imm) scale))) + (set$ vt (mem-read (+ base off) (/ size 8))))) + +(defun LDRBui (bt base imm) (LDR*ui bt base imm 8 0)) +(defun LDRHui (ht base imm) (LDR*ui ht base imm 16 1)) +(defun LDRSui (st base imm) (LDR*ui st base imm 32 2)) +(defun LDRDui (dt base imm) (LDR*ui dt base imm 64 3)) +(defun LDRQui (qt base imm) (LDR*ui qt base imm 128 4)) + +;; LDR (register) + +(defmacro LDR*roX (vt base index signed s scale size) + "(LDR*roX vt base index signed s scale mem-load) loads a SIMD&FP register from address base and an optionally shifted and extended index. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" + (let ((shift (if (= s 1) + (+ scale 0) + (+ 0 0))) (off (if (= signed 1) - (cast-signed 64 (lshift index shift)) - (cast-unsigned 64 (lshift index shift))))) - (set$ vt (mem-load (+ base off))))) + (cast-signed 64 (lshift index shift)) + (cast-unsigned 64 (lshift index shift))))) + (set$ vt (mem-read (+ base off) (/ size 8))))) + +(defun LDRBroX (bt base index signed s) (LDR*roX bt base index signed s 0 8)) +(defun LDRHroX (ht base index signed s) (LDR*roX ht base index signed s 1 16)) +(defun LDRSroX (st base index signed s) (LDR*roX st base index signed s 2 32)) +(defun LDRDroX (dt base index signed s) (LDR*roX dt base index signed s 3 64)) +(defun LDRQroX (qt base index signed s) (LDR*roX qt base index signed s 4 128)) -(defun LDRBroX (bt base index signed s) (LDR*roX bt base index signed s 0 load-byte)) -(defun LDRHroX (ht base index signed s) (LDR*roX ht base index signed s 1 load-dbyte)) -(defun LDRSroX (st base index signed s) (LDR*roX st base index signed s 2 load-hword)) -(defun LDRDroX (dt base index signed s) (LDR*roX dt base index signed s 3 load-word)) -(defun LDRQroX (qt base index signed s) (LDR*roX qt base index signed s 4 load-dword)) +;; LDUR -(defmacro LDURvec*i (vt base simm mem-load) +(defmacro LDURvec*i (vt base simm size) "(LDUR*i vt base simm mem-load) loads a SIMD&FP register from memory at the address calculated from a base register and optional immediate offset. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" - (set$ vt (mem-load (+ base simm)))) + (set$ vt (mem-read (+ base simm) (/ size 8)))) -(defun LDURBi (bt base simm) (LDURvec*i bt base simm load-byte)) -(defun LDURHi (ht base simm) (LDURvec*i ht base simm load-dbyte)) -(defun LDURSi (st base simm) (LDURvec*i st base simm load-hword)) -(defun LDURDi (dt base simm) (LDURvec*i dt base simm load-word)) -(defun LDURQi (qt base simm) (LDURvec*i qt base simm load-dword)) +(defun LDURBi (bt base simm) (LDURvec*i bt base simm 8)) +(defun LDURHi (ht base simm) (LDURvec*i ht base simm 16)) +(defun LDURSi (st base simm) (LDURvec*i st base simm 32)) +(defun LDURDi (dt base simm) (LDURvec*i dt base simm 64)) +(defun LDURQi (qt base simm) (LDURvec*i qt base simm 128)) diff --git a/plugins/primus_lisp/primus_lisp_semantic_primitives.ml b/plugins/primus_lisp/primus_lisp_semantic_primitives.ml index 0bf5800f7..56c3d1f74 100644 --- a/plugins/primus_lisp/primus_lisp_semantic_primitives.ml +++ b/plugins/primus_lisp/primus_lisp_semantic_primitives.ml @@ -752,6 +752,29 @@ module Primitives(CT : Theory.Core)(T : Target) = struct CT.var reg >>| fun v -> KB.Value.put Primus.Lisp.Semantics.symbol v (Some name) + let get_nth_register target rs n = + match (symbol rs) with + | None -> illformed "wrong" + | Some sym -> + let components = String.split sym ~on:'_' in + match (List.hd components) with + | None -> illformed "wrong" + | Some head -> + let size = (String.make 1 head.[0]) in + match (List.nth components n) with + | None -> illformed "wrong" + | Some nth -> + let reg_num = (String.make 1 nth.[1]) in + let reg = Theory.Origin.reg (size ^ reg_num) in let name = Theory.Var.name reg in + forget @@ + CT.var reg >>| fun v -> + KB.Value.put Primus.Lisp.Semantics.symbol reg (Some name) +(* let reg = Theory.Target.var target (size ^ reg_num) + match Theory.Target.var target v with + | Some v -> !!v + | None -> + alias_base_register target (size ^ reg_num)*) + module Intrinsic = struct type param = | Inputs @@ -1330,6 +1353,7 @@ module Primitives(CT : Theory.Core)(T : Target) = struct | "empty",[] -> nop () | "intrinsic",(dst::args) -> Intrinsic.call t dst args | "invoke-subroutine",[dst] -> ctrl@@invoke_subroutine dst + | "get-nth-register",[rs;n]-> pure@@get_nth_register t rs n | _ -> !!nothing end From 46c82b333ef76f59bcaa9b1f7cdfd6d082923ffd Mon Sep 17 00:00:00 2001 From: alistair Date: Mon, 4 Jul 2022 05:08:32 +0000 Subject: [PATCH 076/132] SUBS --- plugins/arm/semantics/aarch64-arithmetic.lisp | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/plugins/arm/semantics/aarch64-arithmetic.lisp b/plugins/arm/semantics/aarch64-arithmetic.lisp index 365b2e00a..88c88fb33 100644 --- a/plugins/arm/semantics/aarch64-arithmetic.lisp +++ b/plugins/arm/semantics/aarch64-arithmetic.lisp @@ -62,16 +62,21 @@ (defun SUBXrx (rd rn rm off) (set$ rd (- rn (extended rm off)))) -(defun SUBXrw (rd rn rm off) - (setw rd (- rn (extended rm off)))) - - (defun SUBXrx64 (rd rn rm off) (set$ rd (- rn (extended rm off)))) +(defun SUBXrw (rd rn rm off) + (setw 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 SUBSXrx (rd rn rm off) + (add-with-carry set$ rd rn (lnot (shift-encoded rm off)) 1)) + +(defun SUBSXrx64 (rd rn rm off) + (add-with-carry set$ rd rn (lnot (shift-encoded rm off)) 1)) + (defun SUBSXrs (rd rn rm off) (add-with-carry set$ rd rn (lnot (shift-encoded rm off)) 1)) From 25bbb56d5481d85485f3330b662ef22b02e7141f Mon Sep 17 00:00:00 2001 From: alistair Date: Mon, 4 Jul 2022 06:23:49 +0000 Subject: [PATCH 077/132] add LSL,LSR,ROR --- plugins/arm/semantics/aarch64-logical.lisp | 27 ++++++++++++++-------- 1 file changed, 17 insertions(+), 10 deletions(-) diff --git a/plugins/arm/semantics/aarch64-logical.lisp b/plugins/arm/semantics/aarch64-logical.lisp index de6df14dc..1f62756c8 100644 --- a/plugins/arm/semantics/aarch64-logical.lisp +++ b/plugins/arm/semantics/aarch64-logical.lisp @@ -63,16 +63,6 @@ (defun ANDSWrs (rd rn rm is) (ANDS*rs setw rd rn rm is)) (defun ANDSXrs (rd rn rm is) (ANDS*rs set$ rd rn rm is)) -;; ASRV -;; (bitfield moves) - -(defmacro ASRV*r (setr datasize rd rn rm) - "(ASRV*r setr datasize rd rn rm) does an arithmetic shift right and stores it in the destination register rd" - (let ((shift (mod rm datasize))) - (setr rd (arshift rn shift)))) - -(defun ASRVWr (rd rn rm) (ASRV*r setw 32 rd rn rm)) -(defun ASRVXr (rd rn rm) (ASRV*r set$ 64 rd rn rm)) ;; BIC @@ -152,3 +142,20 @@ (defun SBFMWri (xd xr ir is) (make-BFM setw cast-signed xd xr ir is)) + +;; bitfield moves + +(defmacro SHIFT*r (setr shift datasize rd rn rm) + "(ASRV*r setr datasize rd rn rm) does an arithmetic shift right and stores it + in the destination register rd" + (let ((off (mod rm datasize))) + (setr rd (cast-low datasize (shift rn off))))) + +(defun ASRVXr (rd rn rm) (SHIFT*r set$ arshift 64 rd rn rm)) +(defun ASRVWr (rd rn rm) (SHIFT*r setw arshift 32 rd rn rm)) +(defun LSRVXr (rd rn rm) (SHIFT*r set$ rshift 64 rd rn rm)) +(defun LSRVWr (rd rn rm) (SHIFT*r setw rshift 32 rd rn rm)) +(defun LSLVXr (rd rn rm) (SHIFT*r set$ lshift 64 rd rn rm)) +(defun LSLVWr (rd rn rm) (SHIFT*r setw lshift 32 rd rn rm)) +(defun RORVXr (rd rn rm) (SHIFT*r set$ rotate-right 64 rd rn rm)) +(defun RORVWr (rd rn rm) (SHIFT*r setw rotate-right 32 rd rn rm)) From 88901f42ca4136858282b082be16e2ebca44abc8 Mon Sep 17 00:00:00 2001 From: alistair Date: Mon, 4 Jul 2022 06:36:19 +0000 Subject: [PATCH 078/132] fix SUB --- plugins/arm/semantics/aarch64-arithmetic.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/arm/semantics/aarch64-arithmetic.lisp b/plugins/arm/semantics/aarch64-arithmetic.lisp index 88c88fb33..b16bbcf4a 100644 --- a/plugins/arm/semantics/aarch64-arithmetic.lisp +++ b/plugins/arm/semantics/aarch64-arithmetic.lisp @@ -51,7 +51,7 @@ (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)))) + (set rd (cast-low (word-width 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)) From 6e327815a97f118a638f34e6cb71725ef1eeb21c Mon Sep 17 00:00:00 2001 From: alistair Date: Mon, 4 Jul 2022 06:44:05 +0000 Subject: [PATCH 079/132] add UMADDL --- plugins/arm/semantics/aarch64-arithmetic.lisp | 2 ++ 1 file changed, 2 insertions(+) diff --git a/plugins/arm/semantics/aarch64-arithmetic.lisp b/plugins/arm/semantics/aarch64-arithmetic.lisp index b16bbcf4a..cb22e1dc2 100644 --- a/plugins/arm/semantics/aarch64-arithmetic.lisp +++ b/plugins/arm/semantics/aarch64-arithmetic.lisp @@ -96,6 +96,8 @@ (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)) +(defun UMADDLrrr (rd rn rm ra) (set$ rd (cast-low 64 (+ ra (* rn rm))))) + (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." From 94a1a8ccc9bef2c4fcd2ea7633de540ae74df3c4 Mon Sep 17 00:00:00 2001 From: alistair Date: Thu, 7 Jul 2022 02:05:46 +0000 Subject: [PATCH 080/132] add pre variant of STR and STRB --- .../arm/semantics/aarch64-data-movement.lisp | 34 ++++++++++++++++++- 1 file changed, 33 insertions(+), 1 deletion(-) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index 6a2513ada..fa66214ce 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -256,6 +256,33 @@ (defun STRBpost (_ rt rn simm) (str-post rn (cast-low 8 rt) simm)) +(defun str-pre (xreg src off) + "stores all of src to xreg, and pre-indexes reg (reg += off)." + (store-word (+ xreg off) src) + (set$ xreg (+ xreg off))) + +(defun STRWpre (_ rt rn simm) + (str-pre rn rt simm)) + +(defun STRXpre (_ rt rn simm) + (str-pre rn rt simm)) + +; STR (SIMD registers) +(defun STRQpre (_ rt rn simm) + (str-pre rn rt simm)) + +(defun STRDpre (_ rt rn simm) + (str-pre rn rt simm)) + +(defun STRSpre (_ rt rn simm) + (str-pre rn (cast-low 32 rt) simm)) + +(defun STRHpre (_ rt rn simm) + (str-pre rn (cast-low 16 rt) simm)) + +(defun STRBpre (_ rt rn simm) + (str-pre rn (cast-low 8 rt) simm)) + (defun STR*ui (scale src reg off) "Stores a register of size (8 << scale) to the memory address (reg + (off << scale))." @@ -289,11 +316,15 @@ (defun STRHHui (rt rn off) (store-word (+ rn (lshift off 1)) (cast-low 16 rt))) -; STRB post-indexed +; STRB (defun STRBBpost (_ rt base simm) (store-byte base rt) (set$ base (+ base simm))) +(defun STRBBpre (_ rt base simm) + (store-byte (+ base simm) rt) + (set$ base (+ base simm))) + (defun STRBBroW (rt rn rm option shift) (let ((off (if (= option 1) @@ -308,6 +339,7 @@ (unsigned-extend 64 rm)))) ; LSL (store-byte (+ rn off) rt))) + ; STP (defun store-pair (scale indexing t1 t2 dst imm) From fe6c45a38ea35bc721e3426c59c9929f9799efd6 Mon Sep 17 00:00:00 2001 From: alistair Date: Fri, 8 Jul 2022 05:45:46 +0000 Subject: [PATCH 081/132] fix LDRBBpre --- plugins/arm/semantics/aarch64-data-movement.lisp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index fa66214ce..37b67dcb8 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -44,7 +44,8 @@ (defun LDRBBpre (_ dst base simm) "(LDRBBpre _ dst base simm) loads a byte from the base address and an offset simm and stores it in the 32 bit dst register. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), ConstrainUnpredictable()" - (setw dst (cast-unsigned 32 (load-byte (+ base simm))))) + (setw dst (cast-unsigned 32 (load-byte (+ base simm)))) + (set$ base (+ base simm))) ;; LDRB (immediate, unsigned offset) From f7f2c1d8959ae717a11f803e128d587d000f16b5 Mon Sep 17 00:00:00 2001 From: alistair Date: Fri, 8 Jul 2022 05:59:44 +0000 Subject: [PATCH 082/132] add UMULH --- plugins/arm/semantics/aarch64-arithmetic.lisp | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/plugins/arm/semantics/aarch64-arithmetic.lisp b/plugins/arm/semantics/aarch64-arithmetic.lisp index cb22e1dc2..59478ee35 100644 --- a/plugins/arm/semantics/aarch64-arithmetic.lisp +++ b/plugins/arm/semantics/aarch64-arithmetic.lisp @@ -98,6 +98,11 @@ (defun UMADDLrrr (rd rn rm ra) (set$ rd (cast-low 64 (+ ra (* rn rm))))) +(defun UMULHrr (rd rn rm) + "multiplies rn and rm together and stores the high 64 bits of the resulting + 128-bit value to the register rd" + (set$ rd (cast-high 64 (* (cast-unsigned 128 rn) (cast-unsigned 128 rm))))) + (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." From b8755e12f33a3fc6a9f7d2a77547525dcdf9983d Mon Sep 17 00:00:00 2001 From: alistair Date: Fri, 8 Jul 2022 06:22:04 +0000 Subject: [PATCH 083/132] add LDR pre+post variants --- .../arm/semantics/aarch64-data-movement.lisp | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index 37b67dcb8..481e828d2 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -24,15 +24,31 @@ (defun LDRXroW (xt base index signed s) (LDRXro* xt base index signed s)) (defun LDRXroX (xt base index signed s) (LDRXro* xt base index signed s)) -;; LDR (immediate, unsigned offset) +;; LDR (immediate, unsigned offset, post/pre indexed) (defun LDRXui (dst reg off) (set$ dst (load-word (+ reg (lshift off 3))))) +(defun LDRXpost (_ dst reg off) + (set$ dst (load-word reg)) + (set$ reg (+ reg off))) + +(defun LDRXpre (_ dst reg off) + (set$ dst (load-word (+ reg off))) + (set$ reg (+ reg off))) + (defun LDRWui (dst reg off) (setw dst (cast-unsigned (word) (load-hword (+ reg (lshift off 2)))))) +(defun LDRWpost (_ dst reg off) + (setw dst (load-hword reg)) + (set$ reg (+ reg off))) + +(defun LDRWpre (_ dst reg off) + (setw dst (load-hword (+ reg off))) + (set$ reg (+ reg off))) + ;; LDRB (immediate, post-index) (defun LDRBBpost (_ dst base simm) From ba8ade025cf8d2e695e7d3837211d72047a7cf25 Mon Sep 17 00:00:00 2001 From: alistair Date: Fri, 8 Jul 2022 06:53:54 +0000 Subject: [PATCH 084/132] add missing LDP,LDRH,LDR variants --- .../arm/semantics/aarch64-data-movement.lisp | 33 +++++++++++++++++-- 1 file changed, 30 insertions(+), 3 deletions(-) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index 481e828d2..40c9452a1 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -84,11 +84,30 @@ ;; LDP (post-index) -(defun LDPXpost (dst r1 r2 base off) + +(defun LDPXpost (_ 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)))) + (set$ base (+ base off)))) + +(defun LDPXpre (_ r1 r2 base off) + (let ((off (lshift off 3))) + (set$ r1 (load-word (+ base off))) + (set$ r2 (load-word (+ base off (sizeof word)))) + (set$ base (+ base off)))) + +(defun LDPWpost (_ r1 r2 base off) + (let ((off (lshift off 2))) + (setw r1 (load-hword base)) + (setw r2 (load-hword (+ base (sizeof word)))) + (set$ base (+ base off)))) + +(defun LDPWpre (_ r1 r2 base off) + (let ((off (lshift off 2))) + (setw r1 (load-hword base)) + (setw r2 (load-hword (+ base (sizeof word)))) + (set$ base (+ base off)))) ;; LDP (signed offset) @@ -113,13 +132,21 @@ (defun LDRHHroX (wt xn xm extend s) (LDRHHro* wt xn xm extend s)) (defun LDRHHroW (wt xn wm extend s) (LDRHHro* wt xn wm extend s)) -;; LDRH (immediate, unsigned offset) +;; LDRH (immediate, unsigned offset, pre/post indexed) (defun LDRHHui (wt xn pimm) "(LDRHHui wt xn pimm) loads 2 bytes from the address calculated from a base register and unsigned immediate offset. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" (let ((off (lshift (cast-unsigned 64 pimm) 1))) (setw wt (load-dbyte (+ xn off))))) +(defun LDRHHpost (_ rd rn off) + (setw rd (load-dbyte rn)) + (set$ rn (+ rn off))) + +(defun LDRHHpre (_ rd rn off) + (setw rd (load-dbyte (+ rn off))) + (set$ rn (+ rn off))) + ;; LDRSW (immediate, unsigned offset) (defun LDRSWui (dst base off) From 98c3ac41505da3ae7197db91c00b235dc9d23a37 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Mon, 11 Jul 2022 02:18:57 +0000 Subject: [PATCH 085/132] Use extract and concat approach for REVn*r insns The old cast-high cast-low approach produced an invalid low:0 cast which broke the BIL interpreter for bap-veri. --- plugins/arm/semantics/aarch64-helper.lisp | 25 --------------- plugins/arm/semantics/aarch64-logical.lisp | 2 +- plugins/primus_lisp/semantics/bits.lisp | 36 ++++++++++++++++++++++ 3 files changed, 37 insertions(+), 26 deletions(-) diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index 3aced6bcc..7f668e815 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -109,31 +109,6 @@ (result (logor cleared (logand mask (lshift (cast-unsigned (word-width reg) val) lo))))) result)) -(defun reverse-elems-in-one-container (elem-size c) - "(reverse-elems-in-one-container elem-size c) reverses the order - of each group of elem-size bits in c. - For non-vector instructions, elem-size = 8. - If c's width is not a multiple of elem-size, the remaining bits - get appended at the end." - (if (<= (word-width c) elem-size) c - (concat - (cast-low elem-size c) - (reverse-elems-in-one-container elem-size - (cast-high (- (word-width c) elem-size) c))))) - -(defun reverse-elems-in-all-containers (container-size elem-size x) - "(reverse-elems-in-all-containers container-size elem-size x) applies - reverse-elems-in-one-container to each group of container-size bits in x. - In other words, it reverses the order of groups of elem-size bits within - each group of container-size bits. - If x's width is not a multiple of container-size, the remaining bits - get appended at the end." - (if (< (word-width x) container-size) x - (concat - (reverse-elems-in-one-container elem-size (cast-high container-size x)) - (reverse-elems-in-all-containers container-size elem-size - (cast-low (- (word-width x) container-size) x))))) - (defun insert-element-into-vector (vd index element size) "(insert-element-into-vector vd index element size) inserts element into vd[index], where size is in {8,16,32,64}" (let ((highIndex (-1 (* size (+ index 1)))) diff --git a/plugins/arm/semantics/aarch64-logical.lisp b/plugins/arm/semantics/aarch64-logical.lisp index 1f62756c8..10190561b 100644 --- a/plugins/arm/semantics/aarch64-logical.lisp +++ b/plugins/arm/semantics/aarch64-logical.lisp @@ -92,7 +92,7 @@ (defmacro REVn*r (setr container-size rd rn) "(REVn*r setr container-size rd rn) implements the non-vector REV# instructions with the given container-size." - (setr rd (reverse-elems-in-all-containers container-size 8 rn))) + (setr rd (reverse-in-containers container-size 8 rn))) (defun REVWr (rd rn) (REVn*r setw 32 rd rn)) (defun REVXr (rd rn) (REVn*r set$ 64 rd rn)) diff --git a/plugins/primus_lisp/semantics/bits.lisp b/plugins/primus_lisp/semantics/bits.lisp index d0b9514f6..179ce6807 100644 --- a/plugins/primus_lisp/semantics/bits.lisp +++ b/plugins/primus_lisp/semantics/bits.lisp @@ -66,6 +66,42 @@ (lshift bitv m) (rshift bitv (- bitv-length m))))))) +(defun extract-elem (x e esize off) + "(extract-elem x e esize off) extracts the e-th bit range + of size esize of x, after adding the bit offset off." + (extract + (+ off (-1 (* esize (+1 e)))) + (+ off (* esize e)) + x)) + +(defun reverse-in-containers (csize esize x) + "(reverse-in-containers csize esize x) returns the result + of reversing the order of elements of elem-size bits + within each container of container-size bits. + It returns this as a concatenation of extracts of x." + (assert (= 0 (mod csize esize))) + (assert (= 0 (mod (word-width x) csize))) + (reverse-in-containers/helper csize esize x 0)) + +(defun reverse-in-containers/helper-elem (csize esize x off e) + "Returns the result of reversing the elements in one container." + (declare (visibility :private)) + (if (= e (-1 (/ csize esize))) + (extract-elem x e esize off) + (concat + (extract-elem x e esize off) + (reverse-in-containers/helper-elem csize esize x off (+1 e))))) + +(defun reverse-in-containers/helper (csize esize x c) + "Maps reverse-in-containers/helper-elem over all containers + and concatenates the results." + (declare (visibility :private)) + (if (= c (-1 (/ (word-width) csize))) + (reverse-in-containers/helper-elem csize esize x (* csize c) 0) + (concat + (reverse-in-containers/helper csize esize x (+1 c)) + (reverse-in-containers/helper-elem csize esize x (* csize c) 0)))) + (defun clz (x) "(clz X) counts leading zeros in X. The returned value is the number of consecutive zeros starting From d767f7ad3e89b6207be65a16f1c24e3725e427df Mon Sep 17 00:00:00 2001 From: alistair Date: Mon, 11 Jul 2022 06:45:33 +0000 Subject: [PATCH 086/132] add BRK --- plugins/arm/semantics/aarch64-special.lisp | 31 ++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/plugins/arm/semantics/aarch64-special.lisp b/plugins/arm/semantics/aarch64-special.lisp index 55cb29cbb..54d481849 100644 --- a/plugins/arm/semantics/aarch64-special.lisp +++ b/plugins/arm/semantics/aarch64-special.lisp @@ -24,3 +24,34 @@ (defun UDF (exn) (intrinsic 'undefined-instruction)) + + +(defun bvectosymbol (bv sym) + (if (>= (word-width bv) 4) + (bvectosymbol + (cast-low (- (word-width bv) 4) bv) + (symbol-concat + sym + (case (cast-high 4 bv) + 0x0 '0 + 0x1 '1 + 0x2 '2 + 0x3 '3 + 0x4 '4 + 0x5 '5 + 0x6 '6 + 0x7 '7 + 0x8 '8 + 0x9 '9 + 0xa 'a + 0xb 'b + 0xc 'c + 0xd 'd + 0xe 'e + 0xf 'f + 0 'x + ))) + sym)) + +(defun BRK (option) + (intrinsic (symbol-concat 'software-breakpoint-$ (bvectosymbol option '0x)))) From 45522d200e4bb1affa37fe2130af3c4c7ae5c056 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Tue, 12 Jul 2022 03:50:36 +0000 Subject: [PATCH 087/132] implement vector addition instructions --- plugins/arm/semantics/aarch64-vector.lisp | 18 ++++++++++++++++++ plugins/primus_lisp/semantics/bits.lisp | 5 +++++ 2 files changed, 23 insertions(+) diff --git a/plugins/arm/semantics/aarch64-vector.lisp b/plugins/arm/semantics/aarch64-vector.lisp index 4c4e3d324..2e04afb67 100644 --- a/plugins/arm/semantics/aarch64-vector.lisp +++ b/plugins/arm/semantics/aarch64-vector.lisp @@ -2,6 +2,24 @@ (in-package aarch64) +;;; ARITHMETIC + +(defun vector-plus-on-elem (ecount esize va vb e) + (if (>= e (-1 ecount)) + (+ (extract-elem va e esize) (extract-elem vb e esize)) + (concat + (vector-plus-on-elem ecount esize va vb (+1 e)) + (+ (extract-elem va e esize) (extract-elem vb e esize))))) + +(defun ADDv1i64 (vd va vb) (set$ vd (vector-plus-on-elem 1 64 va vb 0))) +(defun ADDv2i64 (vd va vb) (set$ vd (vector-plus-on-elem 2 64 va vb 0))) +(defun ADDv2i32 (vd va vb) (set$ vd (vector-plus-on-elem 2 32 va vb 0))) +(defun ADDv4i32 (vd va vb) (set$ vd (vector-plus-on-elem 4 32 va vb 0))) +(defun ADDv4i16 (vd va vb) (set$ vd (vector-plus-on-elem 4 16 va vb 0))) +(defun ADDv8i16 (vd va vb) (set$ vd (vector-plus-on-elem 8 16 va vb 0))) +(defun ADDv8i8 (vd va vb) (set$ vd (vector-plus-on-elem 8 8 va vb 0))) +(defun ADDv16i8 (vd va vb) (set$ vd (vector-plus-on-elem 16 8 va vb 0))) + ;;; INS (defun INSvi32gpr (vd _ index gpr) diff --git a/plugins/primus_lisp/semantics/bits.lisp b/plugins/primus_lisp/semantics/bits.lisp index 179ce6807..a16e75c25 100644 --- a/plugins/primus_lisp/semantics/bits.lisp +++ b/plugins/primus_lisp/semantics/bits.lisp @@ -74,6 +74,11 @@ (+ off (* esize e)) x)) +(defun extract-elem (x e esize) + "(extract-elem x e esize) extracts the e-th bit range + of size esize of x." + (extract-elem x e esize 0)) + (defun reverse-in-containers (csize esize x) "(reverse-in-containers csize esize x) returns the result of reversing the order of elements of elem-size bits From f19cf454d10731d3bed725a3647c489509d38e28 Mon Sep 17 00:00:00 2001 From: alistair Date: Tue, 12 Jul 2022 05:34:36 +0000 Subject: [PATCH 088/132] remove double LSL/LSR implementation --- plugins/arm/semantics/aarch64-logical.lisp | 19 +++---------------- 1 file changed, 3 insertions(+), 16 deletions(-) diff --git a/plugins/arm/semantics/aarch64-logical.lisp b/plugins/arm/semantics/aarch64-logical.lisp index 1f62756c8..092f85db1 100644 --- a/plugins/arm/semantics/aarch64-logical.lisp +++ b/plugins/arm/semantics/aarch64-logical.lisp @@ -100,20 +100,6 @@ (defun REV16Wr (rd rn) (REVn*r set$ 16 rd rn)) (defun REV32Xr (rd rn) (REVn*r setw 32 rd rn)) -(defmacro LSLV*r (dest rn rm size setf) - "(LSLV*r dest rn rm size) logical shift lefts rn by the remainder of rm divided by the datasize and stores the result in the destination register." - (setf dest (lshift rn (mod rm size)))) - -(defun LSLVWr (wd wn wm) (LSLV*r wd wn wm 32 setw)) -(defun LSLVXr (xd xn xm) (LSLV*r xd xn xm 64 set$)) - -(defmacro LSRV*r (dest rn rm size setf) - "(LSRV*r dest rn rm size) logical shift rights rn by the remainder of rm divided by the datasize and stores the result in the destination register." - (setf dest (rshift rn (mod rm size)))) - -(defun LSRVWr (wd wn wm) (LSRV*r wd wn wm 32 setw)) -(defun LSRVXr (xd xn xm) (LSRV*r xd xn xm 64 set$)) - ;; UBFM and SBFM ;; (bitfield moves) @@ -148,14 +134,15 @@ (defmacro SHIFT*r (setr shift datasize rd rn rm) "(ASRV*r setr datasize rd rn rm) does an arithmetic shift right and stores it in the destination register rd" - (let ((off (mod rm datasize))) - (setr rd (cast-low datasize (shift rn off))))) + (setr rd (cast-low datasize (shift rn (mod rm datasize))))) (defun ASRVXr (rd rn rm) (SHIFT*r set$ arshift 64 rd rn rm)) (defun ASRVWr (rd rn rm) (SHIFT*r setw arshift 32 rd rn rm)) + (defun LSRVXr (rd rn rm) (SHIFT*r set$ rshift 64 rd rn rm)) (defun LSRVWr (rd rn rm) (SHIFT*r setw rshift 32 rd rn rm)) (defun LSLVXr (rd rn rm) (SHIFT*r set$ lshift 64 rd rn rm)) (defun LSLVWr (rd rn rm) (SHIFT*r setw lshift 32 rd rn rm)) + (defun RORVXr (rd rn rm) (SHIFT*r set$ rotate-right 64 rd rn rm)) (defun RORVWr (rd rn rm) (SHIFT*r setw rotate-right 32 rd rn rm)) From 2446001d9263b8b9754a2bbb9313bbc3de928836 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Tue, 12 Jul 2022 06:02:57 +0000 Subject: [PATCH 089/132] add generic vector-binop function, SUB and MUL --- plugins/arm/semantics/aarch64-vector.lisp | 74 +++++++++++++++++++---- 1 file changed, 61 insertions(+), 13 deletions(-) diff --git a/plugins/arm/semantics/aarch64-vector.lisp b/plugins/arm/semantics/aarch64-vector.lisp index 2e04afb67..f092aa174 100644 --- a/plugins/arm/semantics/aarch64-vector.lisp +++ b/plugins/arm/semantics/aarch64-vector.lisp @@ -4,21 +4,69 @@ ;;; ARITHMETIC -(defun vector-plus-on-elem (ecount esize va vb e) +(defun sym-to-binop (binop-sym x y) + (case binop-sym + 'add (+ x y) + 'sub (- x y) + 'mul (* x y) + 'div (/ x y))) + +(defun vector-binop (sym ecount esize vn vm) + "(vector-binop sym ecount esize vn vm e) returns the result + of applying the binary operation specified by sym (see sym-to-binop) + to each of the elements in vn and vm. For example, with addition, + Elem[vn, ecount-1, esize] + Elem[vm, ecount-1, esize] + concat + ... + concat + Elem[vn, 0, esize] + Elem[vm, 0, esize] + ecount and esize are the number and size of the elements." + (vector-binop/helper sym ecount esize vn vm 0)) + +(defun vector-binop/helper (sym ecount esize vn vm e) + ;; i can't make this a macro and take in the binop as + ;; a function, because when i try, BAP gets a stack overflow ._. (if (>= e (-1 ecount)) - (+ (extract-elem va e esize) (extract-elem vb e esize)) + (sym-to-binop sym (extract-elem vn e esize) (extract-elem vm e esize)) (concat - (vector-plus-on-elem ecount esize va vb (+1 e)) - (+ (extract-elem va e esize) (extract-elem vb e esize))))) - -(defun ADDv1i64 (vd va vb) (set$ vd (vector-plus-on-elem 1 64 va vb 0))) -(defun ADDv2i64 (vd va vb) (set$ vd (vector-plus-on-elem 2 64 va vb 0))) -(defun ADDv2i32 (vd va vb) (set$ vd (vector-plus-on-elem 2 32 va vb 0))) -(defun ADDv4i32 (vd va vb) (set$ vd (vector-plus-on-elem 4 32 va vb 0))) -(defun ADDv4i16 (vd va vb) (set$ vd (vector-plus-on-elem 4 16 va vb 0))) -(defun ADDv8i16 (vd va vb) (set$ vd (vector-plus-on-elem 8 16 va vb 0))) -(defun ADDv8i8 (vd va vb) (set$ vd (vector-plus-on-elem 8 8 va vb 0))) -(defun ADDv16i8 (vd va vb) (set$ vd (vector-plus-on-elem 16 8 va vb 0))) + (vector-binop/helper sym ecount esize vn vm (+1 e)) + (sym-to-binop sym (extract-elem vn e esize) (extract-elem vm e esize ))))) + +(defun ADDv*i* (vd vn vm ecount esize) + (set$ vd (vector-binop 'add ecount esize vn vm))) + +(defun ADDv1i64 (vd vn vm) (ADDv*i* vd vn vm 1 64)) +(defun ADDv2i64 (vd vn vm) (ADDv*i* vd vn vm 2 64)) +(defun ADDv2i32 (vd vn vm) (ADDv*i* vd vn vm 2 32)) +(defun ADDv4i32 (vd vn vm) (ADDv*i* vd vn vm 4 32)) +(defun ADDv4i16 (vd vn vm) (ADDv*i* vd vn vm 4 16)) +(defun ADDv8i16 (vd vn vm) (ADDv*i* vd vn vm 8 16)) +(defun ADDv8i8 (vd vn vm) (ADDv*i* vd vn vm 8 8)) +(defun ADDv16i8 (vd vn vm) (ADDv*i* vd vn vm 16 8)) + +(defun SUBv*i* (vd vn vm ecount esize) + (set$ vd (vector-binop 'sub ecount esize vn vm))) + +(defun SUBv1i64 (vd vn vm) (SUBv*i* vd vn vm 1 64)) +(defun SUBv2i64 (vd vn vm) (SUBv*i* vd vn vm 2 64)) +(defun SUBv2i32 (vd vn vm) (SUBv*i* vd vn vm 2 32)) +(defun SUBv4i32 (vd vn vm) (SUBv*i* vd vn vm 4 32)) +(defun SUBv4i16 (vd vn vm) (SUBv*i* vd vn vm 4 16)) +(defun SUBv8i16 (vd vn vm) (SUBv*i* vd vn vm 8 16)) +(defun SUBv8i8 (vd vn vm) (SUBv*i* vd vn vm 8 8)) +(defun SUBv16i8 (vd vn vm) (SUBv*i* vd vn vm 16 8)) + +(defun MULv*i* (vd vn vm ecount esize) + (set$ vd (vector-binop 'mul ecount esize vn vm))) + +(defun MULv1i64 (vd vn vm) (MULv*i* vd vn vm 1 64)) +(defun MULv2i64 (vd vn vm) (MULv*i* vd vn vm 2 64)) +(defun MULv2i32 (vd vn vm) (MULv*i* vd vn vm 2 32)) +(defun MULv4i32 (vd vn vm) (MULv*i* vd vn vm 4 32)) +(defun MULv4i16 (vd vn vm) (MULv*i* vd vn vm 4 16)) +(defun MULv8i16 (vd vn vm) (MULv*i* vd vn vm 8 16)) +(defun MULv8i8 (vd vn vm) (MULv*i* vd vn vm 8 8)) +(defun MULv16i8 (vd vn vm) (MULv*i* vd vn vm 16 8)) ;;; INS From d23ed690c681e35f662810cd19140f097f1ebf1e Mon Sep 17 00:00:00 2001 From: alistair Date: Tue, 12 Jul 2022 06:15:38 +0000 Subject: [PATCH 090/132] make bitvec-to-symbol total --- plugins/arm/semantics/aarch64-helper.lisp | 26 +++++++++++++++++++ plugins/arm/semantics/aarch64-special.lisp | 30 +--------------------- 2 files changed, 27 insertions(+), 29 deletions(-) diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index 5a7e34094..531e4b00b 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -101,6 +101,32 @@ 0b0001 'oshld 'unknown)) +(defun bitvec-to-symbol (bv sym) + (if (> (word-width bv) 0) + (bitvec-to-symbol + (cast-low (- (word-width bv) 4) bv) + (symbol-concat + sym + (case (cast-high 4 bv) + 0x0 '0 + 0x1 '1 + 0x2 '2 + 0x3 '3 + 0x4 '4 + 0x5 '5 + 0x6 '6 + 0x7 '7 + 0x8 '8 + 0x9 '9 + 0xa 'a + 0xb 'b + 0xc 'c + 0xd 'd + 0xe 'e + 0xf 'f))) + sym)) + + (defun replace-bit-range (reg hi lo val) "(replace-bit-range reg hi lo val) returns reg with bits hi to lo inclusive set to the value stored in val." diff --git a/plugins/arm/semantics/aarch64-special.lisp b/plugins/arm/semantics/aarch64-special.lisp index 54d481849..fff10893e 100644 --- a/plugins/arm/semantics/aarch64-special.lisp +++ b/plugins/arm/semantics/aarch64-special.lisp @@ -25,33 +25,5 @@ (defun UDF (exn) (intrinsic 'undefined-instruction)) - -(defun bvectosymbol (bv sym) - (if (>= (word-width bv) 4) - (bvectosymbol - (cast-low (- (word-width bv) 4) bv) - (symbol-concat - sym - (case (cast-high 4 bv) - 0x0 '0 - 0x1 '1 - 0x2 '2 - 0x3 '3 - 0x4 '4 - 0x5 '5 - 0x6 '6 - 0x7 '7 - 0x8 '8 - 0x9 '9 - 0xa 'a - 0xb 'b - 0xc 'c - 0xd 'd - 0xe 'e - 0xf 'f - 0 'x - ))) - sym)) - (defun BRK (option) - (intrinsic (symbol-concat 'software-breakpoint-$ (bvectosymbol option '0x)))) + (intrinsic (symbol-concat 'software-breakpoint- (bitvec-to-symbol option '0x)))) From acd3bf40526e1de095cb60621cff686fdb5a5851 Mon Sep 17 00:00:00 2001 From: alistair Date: Tue, 12 Jul 2022 06:31:52 +0000 Subject: [PATCH 091/132] implement EXTR --- plugins/arm/semantics/aarch64-data-movement.lisp | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index fa66214ce..ba98789e3 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -430,3 +430,14 @@ (defun STURQi (rn rt imm) (STUR*i rn rt imm 128)) + +; EXTR + +(defun EXTRWrri (rd rn rm lsb) + "Extracts a register from a pair of registers, datasize = 32" + (setw rd (extract (+ lsb 31) lsb (concat rn rm)))) + +(defun EXTRXrri (rd rn rm lsb) + "Extracts a register from a pair of registers, datasize = 64" + (set$ rd (extract (+ lsb 63) lsb (concat rn rm)))) + From 8b2a6f19e231eb158e7005bd7e7089295b2cbace Mon Sep 17 00:00:00 2001 From: alistair Date: Tue, 12 Jul 2022 06:59:02 +0000 Subject: [PATCH 092/132] add EXTv --- plugins/arm/semantics/aarch64-vector.lisp | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/plugins/arm/semantics/aarch64-vector.lisp b/plugins/arm/semantics/aarch64-vector.lisp index c67146d72..b4a25c694 100644 --- a/plugins/arm/semantics/aarch64-vector.lisp +++ b/plugins/arm/semantics/aarch64-vector.lisp @@ -104,3 +104,18 @@ (defun LDURSi (st base simm) (LDURvec*i st base simm load-hword)) (defun LDURDi (dt base simm) (LDURvec*i dt base simm load-word)) (defun LDURQi (qt base simm) (LDURvec*i qt base simm load-dword)) + +; EXT + +(defmacro EXTv* (datasize vd vn vm pos) + "Extracts a vector from a pair of vectors. pos is the bit offset that will + become the least significant bit of vd." + (let ((pos (lshift pos 3))) + (set$ vd (extract (+ pos (- datasize 1)) pos (concat vm vn))))) + +(defun EXTv16i8 (vd vn vm pos) + (EXTv* 128 vd vn vm pos)) + +(defun EXTv8i8 (vd vn vm pos) + (EXTv* 64 vd vn vm pos)) + From 403499af7138562c076f68ee11fab9fffa3727fd Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Tue, 12 Jul 2022 07:05:04 +0000 Subject: [PATCH 093/132] implement AND, EOR, NOT, ORR, ORN (vector) --- plugins/arm/semantics/aarch64-vector.lisp | 25 +++++++++++++++++++++-- 1 file changed, 23 insertions(+), 2 deletions(-) diff --git a/plugins/arm/semantics/aarch64-vector.lisp b/plugins/arm/semantics/aarch64-vector.lisp index f092aa174..ddc33642e 100644 --- a/plugins/arm/semantics/aarch64-vector.lisp +++ b/plugins/arm/semantics/aarch64-vector.lisp @@ -8,8 +8,7 @@ (case binop-sym 'add (+ x y) 'sub (- x y) - 'mul (* x y) - 'div (/ x y))) + 'mul (* x y))) (defun vector-binop (sym ecount esize vn vm) "(vector-binop sym ecount esize vn vm e) returns the result @@ -68,6 +67,28 @@ (defun MULv8i8 (vd vn vm) (MULv*i* vd vn vm 8 8)) (defun MULv16i8 (vd vn vm) (MULv*i* vd vn vm 16 8)) +;;; LOGICAL + +(defun ANDv8i8 (vd vn vm) (set$ vd (logand vn vm))) +(defun ANDv16i8 (vd vn vm) (set$ vd (logand vn vm))) + +;; the ISA expresses (logxor vn vm) as +;; (logxor vm (logand (logor (zeros (word-width vn)) vn) (ones (word-width vn)))) +;; I've simplified it to just this. +(defun EORv8i8 (vd vn vm) (set$ vd (logxor vn vm))) +(defun EORv16i8 (vd vn vm) (set$ vd (logxor vn vm))) + +;; the ISA says NOT acts element-wise, but this is +;; equivalent to just (lognot vn). Not sure why it does this. +(defun NOTv8i8 (vd vn) (set$ vd (lognot vn))) +(defun NOTv16i8 (vd vn) (set$ vd (lognot vn))) + +(defun ORRv8i8 (vd vn vm) (set$ vd (logor vn vm))) +(defun ORRv16i8 (vd vn vm) (set$ vd (logor vn vm))) + +(defun ORNv8i8 (vd vn vm) (set$ vd (logor vn (lognot vm)))) +(defun ORNv16i8 (vd vn vm) (set$ vd (logor vn (lognot vm)))) + ;;; INS (defun INSvi32gpr (vd _ index gpr) From e9fc8a59898add2fee70cb2e4d48e281ab9c022b Mon Sep 17 00:00:00 2001 From: Kaitlyn Lake Date: Tue, 12 Jul 2022 14:44:58 +0000 Subject: [PATCH 094/132] temporary commit --- plugins/arm/semantics/aarch64-data-movement.lisp | 12 ++++++++++-- plugins/arm/semantics/aarch64-vector.lisp | 13 ++++++------- 2 files changed, 16 insertions(+), 9 deletions(-) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index 9b84a2a9a..3449ad694 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -27,7 +27,8 @@ ;; LDR (immediate, post-index) (defmacro LDR*post (dst base off setf) - (setf dst (mem-read base (/ (word-width dst) 8))) + "" +;; (setf dst (mem-read base (/ (word-width dst) 8))) (set$ base (+ base (cast-signed 64 off)))) (defun LDRWpost (_ dst base off) (LDR*post dst base off setw)) @@ -38,7 +39,7 @@ (defmacro LDR*pre (dst base off setf) (let ((address (+ base (cast-signed 64 off)))) (setf dst (mem-read address (/ (word-width dst) 8))) - (set$ base address)) + (set$ base address))) (defun LDRWpre (_ dst base off) (LDR*pre dst base off setw)) (defun LDRXpre (_ dst base off) (LDR*pre dst base off set$)) @@ -107,6 +108,13 @@ (defmacro LDRHHro* (wt base index signed s) "(LDRHHro* wt base index signed s) loads 2 bytes from the address calculated from a base register address and offset. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" (let ((off (if (= signed 1) + (cast-signed 64 (lshift index s)) + (cast-unsigned 64 (lshift index s))))) + (setw wt (load-dbyte (+ base off))))) + +(defun LDRHHroX (wt xn xm extend s) (LDRHHro* wt xn xm extend s)) +(defun LDRHHroW (wt xn wm extend s) (LDRHHro* wt xn wm extend s)) + ;; LDRH (immediate, unsigned offset) (defun LDRHHui (wt xn pimm) diff --git a/plugins/arm/semantics/aarch64-vector.lisp b/plugins/arm/semantics/aarch64-vector.lisp index 577385d0b..e4a315c4e 100644 --- a/plugins/arm/semantics/aarch64-vector.lisp +++ b/plugins/arm/semantics/aarch64-vector.lisp @@ -17,14 +17,14 @@ ;; LD2 (multiple structures, no offset) -(defmacro LD2Twov16b* (qa_qb xn) - "(LD2Twov16b_POST redundant qa_qb xn imm) loads multiple 2-element structures from memory at address xn with offset imm and stores it in qa and qb with de-interleaving. NOTE: does not encode Security state & Exception level" - (let ((qa (get-first-128b-reg qa_qb)) - (qb (get-second-128b-reg qa_qb))) - (insert-a qa qb xn 0))) +;;(defmacro LD2Twov16b* (qa_qb xn) +;; "(LD2Twov16b_POST redundant qa_qb xn imm) loads multiple 2-element structures from memory at address xn with offset imm and stores it in qa and qb with de-interleaving. NOTE: does not encode Security state & Exception level" +;; (let ((qa (get-first-128b-reg qa_qb)) +;; (qb (get-second-128b-reg qa_qb))) +;; (insert-a qa qb xn 0))) ;;(defun LD2Twov8b (da_db xn) ()) -(defun LD2Twov16b (qa_qb xn) (LD2Twov16b* qa_qb xn)) +;;(defun LD2Twov16b (qa_qb xn) (LD2Twov16b* qa_qb xn)) ;;(defun LD2Twov4h (da_db xn) ()) ;;(defun LD2Twov8h (qa_qb xn) ()) ;;(defun LD2Twov2s (da_db xn) ()) @@ -104,7 +104,6 @@ (defun LDRSroX (st base index signed s) (LDR*roX st base index signed s 2 32)) (defun LDRDroX (dt base index signed s) (LDR*roX dt base index signed s 3 64)) (defun LDRQroX (qt base index signed s) (LDR*roX qt base index signed s 4 128)) -======= ;; LDUR From 060a46793163de8ec04eae18abff456a4b05f48c Mon Sep 17 00:00:00 2001 From: alistair Date: Wed, 13 Jul 2022 00:47:12 +0000 Subject: [PATCH 095/132] fix lognot --- plugins/arm/semantics/aarch64-vector.lisp | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/plugins/arm/semantics/aarch64-vector.lisp b/plugins/arm/semantics/aarch64-vector.lisp index 4ac16dc38..7e8d512ea 100644 --- a/plugins/arm/semantics/aarch64-vector.lisp +++ b/plugins/arm/semantics/aarch64-vector.lisp @@ -79,15 +79,15 @@ (defun EORv16i8 (vd vn vm) (set$ vd (logxor vn vm))) ;; the ISA says NOT acts element-wise, but this is -;; equivalent to just (lognot vn). Not sure why it does this. -(defun NOTv8i8 (vd vn) (set$ vd (lognot vn))) -(defun NOTv16i8 (vd vn) (set$ vd (lognot vn))) +;; equivalent to just (lnot vn). Not sure why it does this. +(defun NOTv8i8 (vd vn) (set$ vd (lnot vn))) +(defun NOTv16i8 (vd vn) (set$ vd (lnot vn))) (defun ORRv8i8 (vd vn vm) (set$ vd (logor vn vm))) (defun ORRv16i8 (vd vn vm) (set$ vd (logor vn vm))) -(defun ORNv8i8 (vd vn vm) (set$ vd (logor vn (lognot vm)))) -(defun ORNv16i8 (vd vn vm) (set$ vd (logor vn (lognot vm)))) +(defun ORNv8i8 (vd vn vm) (set$ vd (logor vn (lnot vm)))) +(defun ORNv16i8 (vd vn vm) (set$ vd (logor vn (lnot vm)))) ;;; INS From eb41ed29c158cdc8bcdba304948856e7009c8b42 Mon Sep 17 00:00:00 2001 From: alistair Date: Wed, 13 Jul 2022 00:51:30 +0000 Subject: [PATCH 096/132] add SMADDL --- plugins/arm/semantics/aarch64-arithmetic.lisp | 2 ++ 1 file changed, 2 insertions(+) diff --git a/plugins/arm/semantics/aarch64-arithmetic.lisp b/plugins/arm/semantics/aarch64-arithmetic.lisp index 59478ee35..4c1139370 100644 --- a/plugins/arm/semantics/aarch64-arithmetic.lisp +++ b/plugins/arm/semantics/aarch64-arithmetic.lisp @@ -98,6 +98,8 @@ (defun UMADDLrrr (rd rn rm ra) (set$ rd (cast-low 64 (+ ra (* rn rm))))) +(defun SMADDLrrr (rd rn rm ra) (set$ rd (cast-signed 64 (+ ra (* (cast-signed 64 rn) (cast-signed 64 rm)))))) + (defun UMULHrr (rd rn rm) "multiplies rn and rm together and stores the high 64 bits of the resulting 128-bit value to the register rd" From 04785ef99930cd1fb1e0cd8bc3436c555acbea32 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Fri, 15 Jul 2022 01:17:52 +0000 Subject: [PATCH 097/132] tabs to spaces --- plugins/arm/semantics/aarch64-helper.lisp | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index 4d3a8973d..af0a50d4f 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -151,7 +151,7 @@ (set$ vd (replace-bit-range vd highIndex lowIndex element)))) (defun get-vector-S-element (index vn) - "(get-vector-S-element index vn) returns the 32 bit element from vn[index]" + "(get-vector-S-element index vn) returns the 32 bit element from vn[index]" (case index 0x0 (extract 31 0 vn) 0x1 (extract 63 32 vn) @@ -236,13 +236,13 @@ 'Q0)) (defun mem-read (address size) - "(mem-read address size) loads size bytes from memory at address." - (case size - 1 (load-byte address) - 2 (load-dbyte address) - 4 (load-hword address) - 8 (load-word address) - 16 (concat (load-word address) (load-word (+ address 8))))) + "(mem-read address size) loads size bytes from memory at address." + (case size + 1 (load-byte address) + 2 (load-dbyte address) + 4 (load-hword address) + 8 (load-word address) + 16 (concat (load-word address) (load-word (+ address 8))))) ;; to generate these functions, ;; do something like the following python code From d314a24df3c18cd80cf444c91c2131f0c7853339 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Fri, 15 Jul 2022 01:20:30 +0000 Subject: [PATCH 098/132] use full stop for simd macros instead of asterisk there were two LDR*ui macros, one in data-movement for W and X, and one in vector for B, H, S, D, Q --- .../arm/semantics/aarch64-data-movement.lisp | 4 +- plugins/arm/semantics/aarch64-vector.lisp | 60 +++++++++---------- 2 files changed, 32 insertions(+), 32 deletions(-) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index 3449ad694..1046ca38f 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -49,8 +49,8 @@ (defmacro LDR*ui (dst reg off setf scale) (setf dst (mem-read (+ reg (lshift off scale)) (/ (word-width dst) 8)))) -(defun LDRXui (dst reg off) (dst reg off set$ 3)) -(defun LDRWui (dst reg off) (dst reg off setw 2)) +(defun LDRXui (dst reg off) (LDR*ui dst reg off set$ 3)) +(defun LDRWui (dst reg off) (LDR*ui dst reg off setw 2)) ;; LDRB (immediate, post-index) diff --git a/plugins/arm/semantics/aarch64-vector.lisp b/plugins/arm/semantics/aarch64-vector.lisp index e4a315c4e..77c16a7f8 100644 --- a/plugins/arm/semantics/aarch64-vector.lisp +++ b/plugins/arm/semantics/aarch64-vector.lisp @@ -56,41 +56,41 @@ ;;(defun LD1Twov16b_POST (_ qa_qb xn xm) ;; "(LD2Twov16b_POST redundant qa_qb xn imm) loads multiple 2-element structures from memory at address xn with offset imm and stores it in qa and qb with de-interleaving. NOTE: does not encode Security state & Exception level" -;; (let ((qa (get-nth-register qa_qb 0)) -;; (qb (get-nth-register qa_qb 1))) -;; (insert-a qa qb xn 0) -;; (set$ xn (+ xn xm)))) +;; (let ((qa (get-nth-register qa_qb 0)) +;; (qb (get-nth-register qa_qb 1))) +;; (insert-a qa qb xn 0) +;; (set$ xn (+ xn xm)))) ;; LDP (signed offset) -(defmacro LDPvec*i (vn vm base imm size scale) - "(LDP*i qn qm imm size mem-load scale) loads a pair of SIMD&FP registers from memory using the address base and an optional signed immediate offset. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" +(defmacro LDP.i (vn vm base imm size scale) + "(LDP.i qn qm imm size mem-load scale) loads a pair of SIMD&FP registers from memory using the address base and an optional signed immediate offset. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" (let ((off (lshift (cast-signed 64 imm) scale)) (dbytes (/ size 8))) (set$ vn (mem-read (+ base off) (/ size 8))) (set$ vm (mem-read (+ base off dbytes) (/ size 8))))) -(defun LDPQi (qn qm base imm) (LDPvec*i qn qm base imm 128 4)) -(defun LDPDi (qn qm base imm) (LDPvec*i qn qm base imm 64 3)) -(defun LDPSi (qn qm base imm) (LDPvec*i qn qm base imm 32 2)) +(defun LDPQi (qn qm base imm) (LDP.i qn qm base imm 128 4)) +(defun LDPDi (qn qm base imm) (LDP.i qn qm base imm 64 3)) +(defun LDPSi (qn qm base imm) (LDP.i qn qm base imm 32 2)) ;; LDR (immediate, unsigned offset) -(defmacro LDR*ui (vt base imm size scale) - "(LDR*ui vt base imm mem-load scale) loads an element from memory from the base address and unsigned immediate offset imm and stores the result in vt. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" +(defmacro LDR.ui (vt base imm size scale) + "(LDR.ui vt base imm mem-load scale) loads an element from memory from the base address and unsigned immediate offset imm and stores the result in vt. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" (let ((off (lshift (cast-unsigned 64 imm) scale))) (set$ vt (mem-read (+ base off) (/ size 8))))) -(defun LDRBui (bt base imm) (LDR*ui bt base imm 8 0)) -(defun LDRHui (ht base imm) (LDR*ui ht base imm 16 1)) -(defun LDRSui (st base imm) (LDR*ui st base imm 32 2)) -(defun LDRDui (dt base imm) (LDR*ui dt base imm 64 3)) -(defun LDRQui (qt base imm) (LDR*ui qt base imm 128 4)) +(defun LDRBui (bt base imm) (LDR.ui bt base imm 8 0)) +(defun LDRHui (ht base imm) (LDR.ui ht base imm 16 1)) +(defun LDRSui (st base imm) (LDR.ui st base imm 32 2)) +(defun LDRDui (dt base imm) (LDR.ui dt base imm 64 3)) +(defun LDRQui (qt base imm) (LDR.ui qt base imm 128 4)) ;; LDR (register) -(defmacro LDR*roX (vt base index signed s scale size) - "(LDR*roX vt base index signed s scale mem-load) loads a SIMD&FP register from address base and an optionally shifted and extended index. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" +(defmacro LDR.roX (vt base index signed s scale size) + "(LDR.roX vt base index signed s scale mem-load) loads a SIMD&FP register from address base and an optionally shifted and extended index. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" (let ((shift (if (= s 1) (+ scale 0) (+ 0 0))) @@ -99,20 +99,20 @@ (cast-unsigned 64 (lshift index shift))))) (set$ vt (mem-read (+ base off) (/ size 8))))) -(defun LDRBroX (bt base index signed s) (LDR*roX bt base index signed s 0 8)) -(defun LDRHroX (ht base index signed s) (LDR*roX ht base index signed s 1 16)) -(defun LDRSroX (st base index signed s) (LDR*roX st base index signed s 2 32)) -(defun LDRDroX (dt base index signed s) (LDR*roX dt base index signed s 3 64)) -(defun LDRQroX (qt base index signed s) (LDR*roX qt base index signed s 4 128)) +(defun LDRBroX (bt base index signed s) (LDR.roX bt base index signed s 0 8)) +(defun LDRHroX (ht base index signed s) (LDR.roX ht base index signed s 1 16)) +(defun LDRSroX (st base index signed s) (LDR.roX st base index signed s 2 32)) +(defun LDRDroX (dt base index signed s) (LDR.roX dt base index signed s 3 64)) +(defun LDRQroX (qt base index signed s) (LDR.roX qt base index signed s 4 128)) ;; LDUR -(defmacro LDURvec*i (vt base simm size) - "(LDUR*i vt base simm mem-load) loads a SIMD&FP register from memory at the address calculated from a base register and optional immediate offset. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" +(defmacro LDUR.i (vt base simm size) + "(LDUR.i vt base simm mem-load) loads a SIMD&FP register from memory at the address calculated from a base register and optional immediate offset. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" (set$ vt (mem-read (+ base simm) (/ size 8)))) -(defun LDURBi (bt base simm) (LDURvec*i bt base simm 8)) -(defun LDURHi (ht base simm) (LDURvec*i ht base simm 16)) -(defun LDURSi (st base simm) (LDURvec*i st base simm 32)) -(defun LDURDi (dt base simm) (LDURvec*i dt base simm 64)) -(defun LDURQi (qt base simm) (LDURvec*i qt base simm 128)) +(defun LDURBi (bt base simm) (LDUR.i bt base simm 8)) +(defun LDURHi (ht base simm) (LDUR.i ht base simm 16)) +(defun LDURSi (st base simm) (LDUR.i st base simm 32)) +(defun LDURDi (dt base simm) (LDUR.i dt base simm 64)) +(defun LDURQi (qt base simm) (LDUR.i qt base simm 128)) From 9d9b2ab1c51dbf5bcffff62f02e2d4a863e6bae0 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Fri, 15 Jul 2022 01:27:25 +0000 Subject: [PATCH 099/132] implement nth-reg-in-group primitive for LD2 (nth-reg-in-group sym n) returns the nth register in the symbol sym, where sym is a register group returned by LLVM such as 'X0_X1, or 'Q5_Q6_Q7. --- plugins/arm/semantics/aarch64-helper.lisp | 71 ------------------- plugins/arm/semantics/aarch64-vector.lisp | 12 ++-- .../primus_lisp_semantic_primitives.ml | 49 +++++++------ 3 files changed, 32 insertions(+), 100 deletions(-) diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index af0a50d4f..bf70bddcc 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -163,77 +163,6 @@ "(load-dbyte address) loads two bytes from memory." (load-bits 16 address)) -(defun get-first-128b-reg (qa_qb) - "(get-first-128b-reg qa_qb) returns the first register of a pair of vector registers." - (case (symbol qa_qb) - 'Q0_Q1 'Q0 - 'Q1_Q2 'Q1 - 'Q2_Q3 'Q2 - 'Q3_Q4 'Q3 - 'Q4_Q5 'Q4 - 'Q5_Q6 'Q5 - 'Q6_Q7 'Q6 - 'Q7_Q8 'Q7 - 'Q8_Q9 'Q8 - 'Q9_Q10 'Q9 - 'Q10_Q11 'Q10 - 'Q11_Q12 'Q11 - 'Q12_Q13 'Q12 - 'Q13_Q14 'Q13 - 'Q14_Q15 'Q14 - 'Q15_Q16 'Q15 - 'Q16_Q17 'Q16 - 'Q17_Q18 'Q17 - 'Q18_Q19 'Q18 - 'Q19_Q20 'Q19 - 'Q20_Q21 'Q20 - 'Q21_Q22 'Q21 - 'Q22_Q23 'Q22 - 'Q23_Q24 'Q23 - 'Q24_Q25 'Q24 - 'Q25_Q26 'Q25 - 'Q26_Q27 'Q26 - 'Q27_Q28 'Q27 - 'Q28_Q29 'Q28 - 'Q29_Q30 'Q29 - 'Q30_Q31 'Q30 - 'Q0)) - -(defun get-second-128b-reg (qa_qb) - "(get-second-128b-reg qa_qb) returns the first register of a pair of vector registers." - (case (symbol qa_qb) - 'Q0_Q1 'Q1 - 'Q1_Q2 'Q2 - 'Q2_Q3 'Q3 - 'Q3_Q4 'Q4 - 'Q4_Q5 'Q5 - 'Q5_Q6 'Q6 - 'Q6_Q7 'Q7 - 'Q7_Q8 'Q8 - 'Q8_Q9 'Q9 - 'Q9_Q10 'Q10 - 'Q10_Q11 'Q11 - 'Q11_Q12 'Q12 - 'Q12_Q13 'Q13 - 'Q13_Q14 'Q14 - 'Q14_Q15 'Q15 - 'Q15_Q16 'Q16 - 'Q16_Q17 'Q17 - 'Q17_Q18 'Q18 - 'Q18_Q19 'Q19 - 'Q19_Q20 'Q20 - 'Q20_Q21 'Q21 - 'Q21_Q22 'Q22 - 'Q22_Q23 'Q23 - 'Q23_Q24 'Q24 - 'Q24_Q25 'Q25 - 'Q25_Q26 'Q26 - 'Q26_Q27 'Q27 - 'Q27_Q28 'Q28 - 'Q28_Q29 'Q29 - 'Q29_Q30 'Q30 - 'Q30_Q31 'Q31 - 'Q0)) (defun mem-read (address size) "(mem-read address size) loads size bytes from memory at address." diff --git a/plugins/arm/semantics/aarch64-vector.lisp b/plugins/arm/semantics/aarch64-vector.lisp index 77c16a7f8..606538ef8 100644 --- a/plugins/arm/semantics/aarch64-vector.lisp +++ b/plugins/arm/semantics/aarch64-vector.lisp @@ -19,8 +19,8 @@ ;;(defmacro LD2Twov16b* (qa_qb xn) ;; "(LD2Twov16b_POST redundant qa_qb xn imm) loads multiple 2-element structures from memory at address xn with offset imm and stores it in qa and qb with de-interleaving. NOTE: does not encode Security state & Exception level" -;; (let ((qa (get-first-128b-reg qa_qb)) -;; (qb (get-second-128b-reg qa_qb))) +;; (let ((qa (nth-reg-in-group qa_qb 0)) +;; (qb (nth-reg-in-group qa_qb 1))) ;; (insert-a qa qb xn 0))) ;;(defun LD2Twov8b (da_db xn) ()) @@ -35,8 +35,8 @@ (defun LD2Twov16b_POST (_ qa_qb xn xm) "(LD2Twov16b_POST _ qa_qb xn imm) loads multiple 2-element structures from memory at address xn with offset imm and stores it in qa and qb with de-interleaving. NOTE: does not encode Security state & Exception level" - (let ((qa (get-first-128b-reg qa_qb)) - (qb (get-second-128b-reg qa_qb))) + (let ((qa (nth-reg-in-group qa_qb 0)) + (qb (nth-reg-in-group qa_qb 1))) (insert-a qa qb xn 0 0 0) (set$ xn (+ xn xm)))) @@ -56,8 +56,8 @@ ;;(defun LD1Twov16b_POST (_ qa_qb xn xm) ;; "(LD2Twov16b_POST redundant qa_qb xn imm) loads multiple 2-element structures from memory at address xn with offset imm and stores it in qa and qb with de-interleaving. NOTE: does not encode Security state & Exception level" -;; (let ((qa (get-nth-register qa_qb 0)) -;; (qb (get-nth-register qa_qb 1))) +;; (let ((qa (nth-reg-in-group qa_qb 0)) +;; (qb (nth-reg-in-group qa_qb 1))) ;; (insert-a qa qb xn 0) ;; (set$ xn (+ xn xm)))) diff --git a/plugins/primus_lisp/primus_lisp_semantic_primitives.ml b/plugins/primus_lisp/primus_lisp_semantic_primitives.ml index 56c3d1f74..0342db6ea 100644 --- a/plugins/primus_lisp/primus_lisp_semantic_primitives.ml +++ b/plugins/primus_lisp/primus_lisp_semantic_primitives.ml @@ -276,6 +276,12 @@ let export = Primus.Lisp.Type.Spec.[ "(alias-base-register x) if X has a symbolic value that is an aliased register returns the base register"; + "nth-reg-in-group", tuple [sym; int] @-> int, + "(nth-reg-in-group reg-group n) returns the nth register in the + symbolic register group reg-group. For example, + (nth-reg-in-group 'X0_X1 1) returns X1, + (nth-reg-in-group 'Q0_Q1_Q2 0) returns Q0."; + "cast-low", tuple [int; a] @-> b, "(cast-low S X) extracts low S bits from X."; @@ -752,28 +758,25 @@ module Primitives(CT : Theory.Core)(T : Target) = struct CT.var reg >>| fun v -> KB.Value.put Primus.Lisp.Semantics.symbol v (Some name) - let get_nth_register target rs n = - match (symbol rs) with - | None -> illformed "wrong" - | Some sym -> - let components = String.split sym ~on:'_' in - match (List.hd components) with - | None -> illformed "wrong" - | Some head -> - let size = (String.make 1 head.[0]) in - match (List.nth components n) with - | None -> illformed "wrong" - | Some nth -> - let reg_num = (String.make 1 nth.[1]) in - let reg = Theory.Origin.reg (size ^ reg_num) in let name = Theory.Var.name reg in - forget @@ - CT.var reg >>| fun v -> - KB.Value.put Primus.Lisp.Semantics.symbol reg (Some name) -(* let reg = Theory.Target.var target (size ^ reg_num) - match Theory.Target.var target v with - | Some v -> !!v - | None -> - alias_base_register target (size ^ reg_num)*) + let nth_reg_in_group target args = + binary args @@ fun sym n -> + to_int n >>= fun n -> + match n with + | None -> illformed "index must be statically known" + | Some n -> + match symbol sym with + | None -> illformed "sym must be symbol" + | Some sym -> + let components = String.split sym ~on:'_' in + match List.nth components n with + | None -> illformed "symbol does not have component at index %d" n + | Some name -> + match Theory.Target.var target name with + | None -> illformed "%s is not a register" name + | Some var -> + forget @@ + CT.var var >>| fun v -> + KB.Value.put Primus.Lisp.Semantics.symbol v (Some name) module Intrinsic = struct type param = @@ -1343,6 +1346,7 @@ module Primitives(CT : Theory.Core)(T : Target) = struct | "symbol",[x] -> pure@@symbol s x | "is-symbol", [x] -> pure@@is_symbol x | "alias-base-register", [x] -> pure@@alias_base_register t x + | "nth-reg-in-group",_ -> pure@@nth_reg_in_group t args | "cast-low",xs -> pure@@low xs | "cast-high",xs -> pure@@high xs | "cast-signed",xs -> pure@@signed xs @@ -1353,7 +1357,6 @@ module Primitives(CT : Theory.Core)(T : Target) = struct | "empty",[] -> nop () | "intrinsic",(dst::args) -> Intrinsic.call t dst args | "invoke-subroutine",[dst] -> ctrl@@invoke_subroutine dst - | "get-nth-register",[rs;n]-> pure@@get_nth_register t rs n | _ -> !!nothing end From e4eee760ab36adba74d6ca4d98ec88e2e425a628 Mon Sep 17 00:00:00 2001 From: Kaitlyn Lake Date: Fri, 15 Jul 2022 02:14:54 +0000 Subject: [PATCH 100/132] Improved ptimitive, but it does not compile --- .../primus_lisp_semantic_primitives.ml | 24 +++++++++---------- 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/plugins/primus_lisp/primus_lisp_semantic_primitives.ml b/plugins/primus_lisp/primus_lisp_semantic_primitives.ml index 56c3d1f74..8b6f10ee9 100644 --- a/plugins/primus_lisp/primus_lisp_semantic_primitives.ml +++ b/plugins/primus_lisp/primus_lisp_semantic_primitives.ml @@ -757,18 +757,18 @@ module Primitives(CT : Theory.Core)(T : Target) = struct | None -> illformed "wrong" | Some sym -> let components = String.split sym ~on:'_' in - match (List.hd components) with + match (List.nth components n) with | None -> illformed "wrong" - | Some head -> - let size = (String.make 1 head.[0]) in - match (List.nth components n) with - | None -> illformed "wrong" - | Some nth -> - let reg_num = (String.make 1 nth.[1]) in - let reg = Theory.Origin.reg (size ^ reg_num) in let name = Theory.Var.name reg in - forget @@ - CT.var reg >>| fun v -> - KB.Value.put Primus.Lisp.Semantics.symbol reg (Some name) + | Some nth -> + let size = (String.make 1 nth.[0]) in + let reg_num = (String.make 1 nth.[1]) in + let name = size ^ reg_num in + let reg = possibly_register target name +(* let reg = Theory.Origin.reg (size ^ reg_num) in + let name = Theory.Var.name reg in *) + forget @@ + CT.var reg >>| fun v -> + KB.Value.put Primus.Lisp.Semantics.symbol reg (Some name) (* let reg = Theory.Target.var target (size ^ reg_num) match Theory.Target.var target v with | Some v -> !!v @@ -1353,7 +1353,7 @@ module Primitives(CT : Theory.Core)(T : Target) = struct | "empty",[] -> nop () | "intrinsic",(dst::args) -> Intrinsic.call t dst args | "invoke-subroutine",[dst] -> ctrl@@invoke_subroutine dst - | "get-nth-register",[rs;n]-> pure@@get_nth_register t rs n +(* | "get-nth-register",[rs;n]-> pure@@get_nth_register t rs n*) | _ -> !!nothing end From 0038b07203c5e89cb3c13f943af92b194eb1bee0 Mon Sep 17 00:00:00 2001 From: Kaitlyn Lake Date: Wed, 20 Jul 2022 01:43:52 +0000 Subject: [PATCH 101/132] Implemented all LD (multiple structres), LD (single structures), LD.R. Modified de-interleaving insertion algorithm to accomodate up to 4 selems and variable rpt (see ARMv8 ISA LD1 (multiple structures) Operation) --- plugins/arm/semantics/aarch64-helper.lisp | 15 +- .../arm/semantics/aarch64-vector-load.lisp | 563 ++++++++++++++++++ plugins/arm/semantics/aarch64-vector.lisp | 79 --- 3 files changed, 576 insertions(+), 81 deletions(-) create mode 100644 plugins/arm/semantics/aarch64-vector-load.lisp diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index be397434a..4e148b188 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -124,7 +124,7 @@ 0xd 'd 0xe 'e 0xf 'f))) - sym)) + sym)) (defun replace-bit-range (reg hi lo val size) "(replace-bit-range reg hi lo val) returns reg with bits @@ -135,11 +135,22 @@ result)) (defun insert-element-into-vector (vd index element size) - "(insert-element-into-vector vd index element size) inserts element into vd[index], where size is in {8,16,32,64}" + "(insert-element-into-vector vd index element size) inserts element into vd[index], + where size is in {8,16,32,64}" (let ((highIndex (-1 (* size (+ index 1)))) (lowIndex (* size index))) (set$ vd (replace-bit-range vd highIndex lowIndex element 128)))) +(defun replicate-and-insert (vd element esize dsize) + "(replicate-and-insert vd element esize dsize) replicates and concatenates + an element of esize to dsize and sets the vector register vd" + (set$ vd (replicate-and-insert-helper element esize dsize 1))) + +(defun replicate-and-insert-helper (element esize dsize index) + (if (< (* index esize) dsize) + (concat element (replicate-and-insert-helper element esize dsize (+ index 1))) + element)) + (defun get-vector-S-element (index vn) "(get-vector-S-element index vn) returns the 32 bit element from vn[index]" (case index diff --git a/plugins/arm/semantics/aarch64-vector-load.lisp b/plugins/arm/semantics/aarch64-vector-load.lisp new file mode 100644 index 000000000..73b31cd6d --- /dev/null +++ b/plugins/arm/semantics/aarch64-vector-load.lisp @@ -0,0 +1,563 @@ +(declare (context (target armv8-a+le))) + +(in-package aarch64) + +;;; LDs.. + +;; LD1 (multiple structures, post index, four registers) + +(defmacro LD1Fourv._POST (elems bytes va base off) + (LD..v._POST 4 elems 1 bytes va base off)) + +(defun LD1Fourv8b_POST (_ da_db_dc_dd xn xm) (LD1Fourv._POST 8 1 da_db_dc_dd xn xm)) +(defun LD1Fourv16b_POST (_ qa_qb_qc_qd xn xm) (LD1Fourv._POST 16 1 qa_qb_qc_qd xn xm)) +(defun LD1Fourv4h_POST (_ da_db_dc_dd xn xm) (LD1Fourv._POST 4 2 da_db_dc_dd xn xm)) +(defun LD1Fourv8h_POST (_ qa_qb_qc_qd xn xm) (LD1Fourv._POST 8 2 qa_qb_qc_qd xn xm)) +(defun LD1Fourv2s_POST (_ da_db_dc_dd xn xm) (LD1Fourv._POST 2 4 da_db_dc_dd xn xm)) +(defun LD1Fourv4s_POST (_ qa_qb_qc_qd xn xm) (LD1Fourv._POST 4 4 qa_qb_qc_qd xn xm)) +(defun LD1Fourv1d_POST (_ da_db_dc_dd xn xm) (LD1Fourv._POST 1 8 da_db_dc_dd xn xm)) +(defun LD1Fourv2d_POST (_ qa_qb_qc_qd xn xm) (LD1Fourv._POST 2 8 qa_qb_qc_qd xn xm)) + +;; LD1 (multiple structures, post index, three registers) + +(defmacro LD1Threev._POST (elems bytes va base off) + (LD..v._POST 3 elems 1 bytes va base off)) + +(defun LD1Threev8b_POST (_ da_db_dc xn xm) (LD1Threev._POST 8 1 da_db_dc xn xm)) +(defun LD1Threev16b_POST (_ qa_qb_qc xn xm) (LD1Threev._POST 16 1 qa_qb_qc xn xm)) +(defun LD1Threev4h_POST (_ da_db_dc xn xm) (LD1Threev._POST 4 2 da_db_dc xn xm)) +(defun LD1Threev8h_POST (_ qa_qb_qc xn xm) (LD1Threev._POST 8 2 qa_qb_qc xn xm)) +(defun LD1Threev2s_POST (_ da_db_dc xn xm) (LD1Threev._POST 2 4 da_db_dc xn xm)) +(defun LD1Threev4s_POST (_ qa_qb_qc xn xm) (LD1Threev._POST 4 4 qa_qb_qc xn xm)) +(defun LD1Threev1d_POST (_ da_db_dc xn xm) (LD1Threev._POST 1 8 da_db_dc xn xm)) +(defun LD1Threev2d_POST (_ qa_qb_qc xn xm) (LD1Threev._POST 2 8 qa_qb_qc xn xm)) + +;; LD1 (multiple structures, post index, two registers) + +(defmacro LD1Twov._POST (elems bytes va base off) + (LD..v._POST 2 elems 1 bytes va base off)) + +(defun LD1Twov8b_POST (_ da_db xn xm) (LD1Twov._POST 8 1 da_db xn xm)) +(defun LD1Twov16b_POST (_ qa_qb xn xm) (LD1Twov._POST 16 1 qa_qb xn xm)) +(defun LD1Twov4h_POST (_ da_db xn xm) (LD1Twov._POST 4 2 da_db xn xm)) +(defun LD1Twov8h_POST (_ qa_qb xn xm) (LD1Twov._POST 8 2 qa_qb xn xm)) +(defun LD1Twov2s_POST (_ da_db xn xm) (LD1Twov._POST 2 4 da_db xn xm)) +(defun LD1Twov4s_POST (_ qa_qb xn xm) (LD1Twov._POST 4 4 qa_qb xn xm)) +(defun LD1Twov1d_POST (_ da_db xn xm) (LD1Twov._POST 1 8 da_db xn xm)) +(defun LD1Twov2d_POST (_ qa_qb xn xm) (LD1Twov._POST 2 8 qa_qb xn xm)) + +;; LD1 (multiple structures, post index, one register) + +(defmacro LD1Onev._POST (elems bytes va base off) + (LD..v._POST 1 elems 1 bytes va base off)) + +(defun LD1Onev8b_POST (_ da xn xm) (LD1Onev._POST 8 1 da xn xm)) +(defun LD1Onev16b_POST (_ qa xn xm) (LD1Onev._POST 16 1 qa xn xm)) +(defun LD1Onev4h_POST (_ da xn xm) (LD1Onev._POST 4 2 da xn xm)) +(defun LD1Onev8h_POST (_ qa xn xm) (LD1Onev._POST 8 2 qa xn xm)) +(defun LD1Onev2s_POST (_ da xn xm) (LD1Onev._POST 2 4 da xn xm)) +(defun LD1Onev4s_POST (_ qa xn xm) (LD1Onev._POST 4 4 qa xn xm)) +(defun LD1Onev1d_POST (_ da xn xm) (LD1Onev._POST 1 8 da xn xm)) +(defun LD1Onev2d_POST (_ qa xn xm) (LD1Onev._POST 2 8 qa xn xm)) + +;; LD1 (multiple structures, no offset, four registers) + +(defmacro LD1Fourv. (elems bytes va base) + (LD 4 elems 1 base bytes va)) + +(defun LD1Fourv8b (da_db_dc_dd xn) (LD1Fourv. 8 1 da_db_dc_dd xn)) +(defun LD1Fourv16b (qa_qb_qc_qd xn) (LD1Fourv. 16 1 qa_qb_qc_qd xn)) +(defun LD1Fourv4h (da_db_dc_dd xn) (LD1Fourv. 4 2 da_db_dc_dd xn)) +(defun LD1Fourv8h (qa_qb_qc_qd xn) (LD1Fourv. 8 2 qa_qb_qc_qd xn)) +(defun LD1Fourv2s (da_db_dc_dd xn) (LD1Fourv. 2 4 da_db_dc_dd xn)) +(defun LD1Fourv4s (qa_qb_qc_qd xn) (LD1Fourv. 4 4 qa_qb_qc_qd xn)) +(defun LD1Fourv1d (da_db_dc_dd xn) (LD1Fourv. 1 8 da_db_dc_dd xn)) +(defun LD1Fourv2d (qa_qb_qc_qd xn) (LD1Fourv. 2 8 qa_qb_qc_qd xn)) + +;; LD1 (multiple structures, no offset, three registers) + +(defmacro LD1Threev. (elems bytes va base) + (LD 3 elems 1 base bytes va)) + +(defun LD1Threev8b (da_db_dc xn) (LD1Threev. 8 1 da_db_dc xn)) +(defun LD1Threev16b (qa_qb_qc xn) (LD1Threev. 16 1 qa_qb_qc xn)) +(defun LD1Threev4h (da_db_dc xn) (LD1Threev. 4 2 da_db_dc xn)) +(defun LD1Threev8h (qa_qb_qc xn) (LD1Threev. 8 2 qa_qb_qc xn)) +(defun LD1Threev2s (da_db_dc xn) (LD1Threev. 2 4 da_db_dc xn)) +(defun LD1Threev4s (qa_qb_qc xn) (LD1Threev. 4 4 qa_qb_qc xn)) +(defun LD1Threev1d (da_db_dc xn) (LD1Threev. 1 8 da_db_dc xn)) +(defun LD1Threev2d (qa_qb_qc xn) (LD1Threev. 2 8 qa_qb_qc xn)) + +;; LD1 (multiple structures, no offset, two registers) + +(defmacro LD1Twov. (elems bytes va base) + (LD 2 elems 1 base bytes va)) + +(defun LD1Twov8b (da_db xn) (LD1Twov. 8 1 da_db xn)) +(defun LD1Twov16b (qa_qb xn) (LD1Twov. 16 1 qa_qb xn)) +(defun LD1Twov4h (da_db xn) (LD1Twov. 4 2 da_db xn)) +(defun LD1Twov8h (qa_qb xn) (LD1Twov. 8 2 qa_qb xn)) +(defun LD1Twov2s (da_db xn) (LD1Twov. 2 4 da_db xn)) +(defun LD1Twov4s (qa_qb xn) (LD1Twov. 4 4 qa_qb xn)) +(defun LD1Twov1d (da_db xn) (LD1Twov. 1 8 da_db xn)) +(defun LD1Twov2d (qa_qb xn) (LD1Twov. 2 8 qa_qb xn)) + +;; LD1 (multiple structures, no offset, one register) + +(defmacro LD1Onev. (elems bytes va base) + (LD 1 elems 1 base bytes va)) + +(defun LD1Onev8b (da xn) (LD1Onev. 8 1 da xn)) +(defun LD1Onev16b (qa xn) (LD1Onev. 16 1 qa xn)) +(defun LD1Onev4h (da xn) (LD1Onev. 4 2 da xn)) +(defun LD1Onev8h (qa xn) (LD1Onev. 8 2 qa xn)) +(defun LD1Onev2s (da xn) (LD1Onev. 2 4 da xn)) +(defun LD1Onev4s (qa xn) (LD1Onev. 4 4 qa xn)) +(defun LD1Onev1d (da xn) (LD1Onev. 1 8 da xn)) +(defun LD1Onev2d (qa xn) (LD1Onev. 2 8 qa xn)) + +;; LD2 (multiple structures, post index) + +(defun LD2Twov8b_POST (_ da_db xn xm) (LD2Twov._POST da_db xn xm 8 1)) +(defun LD2Twov16b_POST (_ qa_qb xn xm) (LD2Twov._POST qa_qb xn xm 16 1)) +(defun LD2Twov4h_POST (_ da_db xn xm) (LD2Twov._POST da_db xn xm 4 2)) +(defun LD2Twov8h_POST (_ qa_qb xn xm) (LD2Twov._POST qa_qb xn xm 8 2)) +(defun LD2Twov2s_POST (_ da_db xn xm) (LD2Twov._POST da_db xn xm 2 4)) +(defun LD2Twov4s_POST (_ qa_qb xn xm) (LD2Twov._POST qa_qb xn xm 4 4)) +(defun LD2Twov2d_POST (_ qa_qb xn xm) (LD2Twov._POST qa_qb xn xm 2 8)) + +(defmacro LD2Twov._POST (va_vb xn xm elems bytes) + "(LD2Twov._POST va_vb xn elesms bytes) loads multiple 2-element structures from memory at address xn with offset xm and stores it in va and vb with de-interleaving. NOTE: does not encode Security state & Exception level" + (LD..v._POST 1 elems 2 bytes va_vb xn xm)) + +;; LD2 (multiple structures, no offset) + +(defun LD2Twov8b (da_db xn) (LD2Twov. da_db xn 8 1)) +(defun LD2Twov16b (qa_qb xn) (LD2Twov. qa_qb xn 16 1)) +(defun LD2Twov4h (da_db xn) (LD2Twov. da_db xn 4 2)) +(defun LD2Twov8h (qa_qb xn) (LD2Twov. qa_qb xn 8 2)) +(defun LD2Twov2s (da_db xn) (LD2Twov. da_db xn 2 4)) +(defun LD2Twov4s (qa_qb xn) (LD2Twov. qa_qb xn 4 4)) +(defun LD2Twov2d (qa_qb xn) (LD2Twov. qa_qb xn 2 8)) + +(defmacro LD2Twov. (va_vb xn elems bytes) + "(LD2Twov. va_vb xn elesms bytes) loads multiple 2-element structures from memory at address xn and stores it in va and vb with de-interleaving. NOTE: does not encode Security state & Exception level" + (LD 1 elems 2 xn bytes va_vb)) + +;; LD3 (multiple structures, post index) + +(defun LD3Threev8b_POST (_ da_db_dc xn xm) (LD3Threev._POST da_db_dc xn xm 8 1)) +(defun LD3Threev16b_POST (_ qa_qb_qc xn xm) (LD3Threev._POST qa_qb_qc xn xm 16 1)) +(defun LD3Threev4h_POST (_ da_db_dc xn xm) (LD3Threev._POST da_db_dc xn xm 4 2)) +(defun LD3Threev8h_POST (_ qa_qb_qc xn xm) (LD3Threev._POST qa_qb_qc xn xm 8 2)) +(defun LD3Threev2s_POST (_ da_db_dc xn xm) (LD3Threev._POST da_db_dc xn xm 2 4)) +(defun LD3Threev4s_POST (_ qa_qb_qc xn xm) (LD3Threev._POST qa_qb_qc xn xm 4 4)) +(defun LD3Threev2d_POST (_ qa_qb_qc xn xm) (LD3Threev._POST qa_qb_qc xn xm 2 8)) + +(defmacro LD3Threev._POST (va_vb_vc xn xm elems bytes) + "(LD3Threev._POST va_vb_vc xn xm elems bytes) loads multiple 3-element structures from memory at address xn with offset xm and stores it in va, vb and vc with de-interleaving. NOTE: does not encode Security state & Exception level" + (LD..v._POST 1 elems 3 bytes va_vb_vc xn xm)) + +;; LD3 (multiple structures, no offset) + +(defun LD3Threev8b (da_db_dc xn) (LD3Threev. da_db_dc xn 8 1)) +(defun LD3Threev16b (qa_qb_qc xn) (LD3Threev. qa_qb_qc xn 16 1)) +(defun LD3Threev4h (da_db_dc xn) (LD3Threev. da_db_dc xn 4 2)) +(defun LD3Threev8h (qa_qb_qc xn) (LD3Threev. qa_qb_qc xn 8 2)) +(defun LD3Threev2s (da_db_dc xn) (LD3Threev. da_db_dc xn 2 4)) +(defun LD3Threev4s (qa_qb_qc xn) (LD3Threev. qa_qb_qc xn 4 4)) +(defun LD3Threev2d (qa_qb_qc xn) (LD3Threev. qa_qb_qc xn 2 8)) + +(defmacro LD3Threev. (va_vb_vc xn elems bytes) + "(LD3Threev. va_vb_vc xn elems bytes) loads multiple 3-element structures from memory at address xn and stores it in va, vb and vc with de-interleaving. NOTE: does not encode Security state & Exception level" + (LD 1 elems 3 xn bytes va_vb_vc)) + +;; LD4 (multiple structures, post index) + +(defun LD4Fourv8b_POST (_ da_db_dc_dd xn xm) (LD4Fourv._POST da_db_dc_dd xn xm 8 1)) +(defun LD4Fourv16b_POST (_ qa_qb_qc_qd xn xm) (LD4Fourv._POST qa_qb_qc_qd xn xm 16 1)) +(defun LD4Fourv4h_POST (_ da_db_dc_dd xn xm) (LD4Fourv._POST da_db_dc_dd xn xm 4 2)) +(defun LD4Fourv8h_POST (_ qa_qb_qc_qd xn xm) (LD4Fourv._POST qa_qb_qc_qd xn xm 8 2)) +(defun LD4Fourv2s_POST (_ da_db_dc_dd xn xm) (LD4Fourv._POST da_db_dc_dd xn xm 2 4)) +(defun LD4Fourv4s_POST (_ qa_qb_qc_qd xn xm) (LD4Fourv._POST qa_qb_qc_qd xn xm 4 4)) +(defun LD4Fourv2d_POST (_ qa_qb_qc_qd xn xm) (LD4Fourv._POST qa_qb_qc_qd xn xm 2 8)) + +(defmacro LD4Fourv._POST (va_vb_vc xn xm elems bytes) + "(LD4Fourv._POST va_vb_vc xn xm elems bytes) loads multiple 4-element structures from memory at address xn with offset xm and stores it in va, vb, vc and vd with de-interleaving. NOTE: does not encode Security state & Exception level" + (LD..v._POST 1 elems 4 bytes va_vb_vc xn xm)) + +;; LD4 (multiple structures, no offset) + +(defun LD4Fourv8b (da_db_dc_dd xn) (LD4Fourv. da_db_dc_dd xn 8 1)) +(defun LD4Fourv16b (qa_qb_qc_qd xn) (LD4Fourv. qa_qb_qc_qd xn 16 1)) +(defun LD4Fourv4h (da_db_dc_dd xn) (LD4Fourv. da_db_dc_dd xn 4 2)) +(defun LD4Fourv8h (qa_qb_qc_qd xn) (LD4Fourv. qa_qb_qc_qd xn 8 2)) +(defun LD4Fourv2s (da_db_dc_dd xn) (LD4Fourv. da_db_dc_dd xn 2 4)) +(defun LD4Fourv4s (qa_qb_qc_qd xn) (LD4Fourv. qa_qb_qc_qd xn 4 4)) +(defun LD4Fourv2d (qa_qb_qc_qd xn) (LD4Fourv. qa_qb_qc_qd xn 2 8)) + +(defmacro LD4Fourv. (va_vb_vc xn elems bytes) + "(LD4Fourv. va_vb_vc xn elems bytes) loads multiple 4-element structures from memory at address xn and stores it in va, vb, vc and vd with de-interleaving. NOTE: does not encode Security state & Exception level" + (LD 1 elems 4 xn bytes va_vb_vc)) + +;; LD multiple struct algorithm + +(defmacro LD..v._POST (rpt elems selems bytes grp base off) + "(LD..v._POST rpt elems selems bytes grp base off) loads multiple selems-element structs from memory address base with offset off and stores them in the vector list grp." + (prog + (LD rpt elems selems base bytes grp) + (if (= (symbol off) 'XZR) + (set$ base (+ base (* rpt selems elems bytes))) + (set$ base (+ base off))))) + +(defmacro LD (rpt elems selems base bytes grp) + "(LD rpt elems selems base bytes grp) loads multiple selems-element structs from memory address base." + (insert-with-de-interleaving 0 rpt elems selems base bytes grp)) + +(defun insert-with-de-interleaving (r rpt elems selems base bytes grp) + (if (> rpt 1) + (when (< r rpt) + (let ((nth (nth-reg-in-group grp r))) + (prog + (insert-a 1 0 elems base bytes (symbol nth) 0 0 0 0) + (insert-with-de-interleaving + (+ r 1) rpt elems selems (+ base (* elems bytes)) bytes grp)))) + (insert-a selems 0 elems base bytes grp 0 0 0 0))) + +(defun insert-a (selems e elems addr bytes grp acc-a acc-b acc-c acc-d) + (if (< e elems) + (let ((acc-a (if (= e 0) (mem-read addr bytes) (concat acc-a (mem-read addr bytes))))) + (if (> selems 1) + (insert-b selems e elems (+ addr bytes) bytes grp acc-a acc-b acc-c acc-d) + (insert-a selems (+ e 1) elems (+ addr bytes) bytes grp acc-a acc-b acc-c acc-d))) + (prog + (when (<= 1 selems) (set$ (nth-reg-in-group grp 0) acc-a)) + (when (<= 2 selems) (set$ (nth-reg-in-group grp 1) acc-b)) + (when (<= 3 selems) (set$ (nth-reg-in-group grp 2) acc-c)) + (when (<= 4 selems) (set$ (nth-reg-in-group grp 3) acc-d))))) + +(defun insert-b (selems e elems addr bytes grp acc-a acc-b acc-c acc-d) + (let ((acc-b (if (= e 0) (mem-read addr bytes) (concat acc-b (mem-read addr bytes))))) + (if (> selems 2) + (insert-c selems e elems (+ addr bytes) bytes grp acc-a acc-b acc-c acc-d) + (insert-a selems (+ e 1) elems (+ addr bytes) bytes grp acc-a acc-b acc-c acc-d)))) + +(defun insert-c (selems e elems addr bytes grp acc-a acc-b acc-c acc-d) + (let ((acc-c (if (= e 0) (mem-read addr bytes) (concat acc-c (mem-read addr bytes))))) + (if (> selems 3) + (insert-d selems e elems (+ addr bytes) bytes grp acc-a acc-b acc-c acc-d) + (insert-a selems (+ e 1) elems (+ addr bytes) bytes grp acc-a acc-b acc-c acc-d)))) + +(defun insert-d (selems e elems addr bytes grp acc-a acc-b acc-c acc-d) + (let ((acc-d (if (= e 0) (mem-read addr bytes) (concat acc-d (mem-read addr bytes))))) + (insert-a selems (+ e 1) elems (+ addr bytes) bytes grp acc-a acc-b acc-c acc-d))) + +;; LD single struct algorithm + +(defmacro LD.i._POST (selems grp index base size off) + "(LD.i._POST selems grp index base size off) loads multiple single structures from + address base with post index off, and inserts each structure into the index of each + vector register in grp." + (prog + (LD.i. selems grp index base size) + (if (= (symbol off) 'XZR) + (set$ base (+ base (/ size 8))) + (set$ base (+ base off))))) + +(defmacro LD.i. (selems grp index base size) + "(LD.i._POST selems grp index base size off) loads multiple single structures from + address base, and inserts each structure into the index of each vector register in grp." + (insert-single-element 0 selems grp index base size)) + +(defun insert-single-element (s selems grp index base size) + (when (< s selems) + (prog + (insert-element-into-vector (nth-reg-in-group grp s) + index (mem-read base (/ size 8)) size) + (insert-single-element (+ s 1) selems grp index (+ base (/ size 8)) size)))) + +;; LD1 (single struct, no offset) + +(defmacro LD1i. (qa index base size) + (LD.i. 1 qa index base size)) + +(defun LD1i8 (_ qa index xn) (LD1i. qa index xn 8)) +(defun LD1i16 (_ qa index xn) (LD1i. qa index xn 16)) +(defun LD1i32 (_ qa index xn) (LD1i. qa index xn 32)) +(defun LD1i64 (_ qa index xn) (LD1i. qa index xn 64)) + +;; LD1 (single struct, post index) + +(defmacro LD1i._POST (qa index base size off) + (LD.i._POST 1 qa index base size off)) + +(defun LD1i8_POST (_ _ qa index xn xm) (LD1i._POST qa index xn 8 xm)) +(defun LD1i16_POST (_ _ qa index xn xm) (LD1i._POST qa index xn 16 xm)) +(defun LD1i32_POST (_ _ qa index xn xm) (LD1i._POST qa index xn 32 xm)) +(defun LD1i64_POST (_ _ qa index xn xm) (LD1i._POST qa index xn 64 xm)) + +;; LD2 (single struct, no offset) + +(defmacro LD2i. (qa_qb index base size) + (LD.i. 2 qa_qb index base size)) + +(defun LD2i8 (_ qa_qb index xn) (LD2i. qa_qb index xn 8)) +(defun LD2i16 (_ qa_qb index xn) (LD2i. qa_qb index xn 16)) +(defun LD2i32 (_ qa_qb index xn) (LD2i. qa_qb index xn 32)) +(defun LD2i64 (_ qa_qb index xn) (LD2i. qa_qb index xn 64)) + +;; LD2 (single struct, post index) + +(defmacro LD2i._POST (qa_qb index base size off) + (LD.i._POST 2 qa_qb index base size off)) + +(defun LD2i8_POST (_ _ qa_qb index xn xm) (LD2i._POST qa_qb index xn 8 xm)) +(defun LD2i16_POST (_ _ qa_qb index xn xm) (LD2i._POST qa_qb index xn 16 xm)) +(defun LD2i32_POST (_ _ qa_qb index xn xm) (LD2i._POST qa_qb index xn 32 xm)) +(defun LD2i64_POST (_ _ qa_qb index xn xm) (LD2i._POST qa_qb index xn 64 xm)) + +;; LD3 (single struct, no offset) + +(defmacro LD3i. (qa_qb_qc index base size) + (LD.i. 3 qa_qb_qc index base size)) + +(defun LD3i8 (_ qa_qb_qc index xn) (LD3i. qa_qb_qc index xn 8)) +(defun LD3i16 (_ qa_qb_qc index xn) (LD3i. qa_qb_qc index xn 16)) +(defun LD3i32 (_ qa_qb_qc index xn) (LD3i. qa_qb_qc index xn 32)) +(defun LD3i64 (_ qa_qb_qc index xn) (LD3i. qa_qb_qc index xn 64)) + +;; LD3 (single struct, post index) + +(defmacro LD3i._POST (qa_qb_qc index base size off) + (LD.i._POST 3 qa_qb_qc index base size off)) + +(defun LD3i8_POST (_ _ qa_qb_qc index xn xm) (LD3i._POST qa_qb_qc index xn 8 xm)) +(defun LD3i16_POST (_ _ qa_qb_qc index xn xm) (LD3i._POST qa_qb_qc index xn 16 xm)) +(defun LD3i32_POST (_ _ qa_qb_qc index xn xm) (LD3i._POST qa_qb_qc index xn 32 xm)) +(defun LD3i64_POST (_ _ qa_qb_qc index xn xm) (LD3i._POST qa_qb_qc index xn 64 xm)) + +;; LD4 (single struct, no offset) + +(defmacro LD4i. (qa_qb_qc_qd index base size) + (LD.i. 4 qa_qb_qc_qd index base size)) + +(defun LD4i8 (_ qa_qb_qc_qd index xn) (LD4i. qa_qb_qc_qd index xn 8)) +(defun LD4i16 (_ qa_qb_qc_qd index xn) (LD4i. qa_qb_qc_qd index xn 16)) +(defun LD4i32 (_ qa_qb_qc_qd index xn) (LD4i. qa_qb_qc_qd index xn 32)) +(defun LD4i64 (_ qa_qb_qc_qd index xn) (LD4i. qa_qb_qc_qd index xn 64)) + +;; LD4 (single struct, post index) + +(defmacro LD4i._POST (qa_qb_qc_qd index base size off) + (LD.i._POST 4 qa_qb_qc_qd index base size off)) + +(defun LD4i8_POST (_ _ qa_qb_qc_qd index xn xm) (LD4i._POST qa_qb_qc_qd index xn 8 xm)) +(defun LD4i16_POST (_ _ qa_qb_qc_qd index xn xm) (LD4i._POST qa_qb_qc_qd index xn 16 xm)) +(defun LD4i32_POST (_ _ qa_qb_qc_qd index xn xm) (LD4i._POST qa_qb_qc_qd index xn 32 xm)) +(defun LD4i64_POST (_ _ qa_qb_qc_qd index xn xm) (LD4i._POST qa_qb_qc_qd index xn 64 xm)) + +;; LD1R + +(defmacro LD.Rv._POST (grp base esize dsize selems off) + "(LD.Rv._POST grp base esize dsize selems off) loads an multiple element from a + base address and off post index, replicates them to the size of dsize and + inserts them into each vector register in group." + (prog + (LD.Rv. grp base esize dsize selems) + (if (= (symbol off) 'XZR) + (set$ base (+ base (* selems (/ dsize 8)))) + (set$ base (+ base off))))) + +(defmacro LD.Rv. (grp base esize dsize selems) + "(LD.Rv. grp base esize dsize selems) loads an multiple element from a + base address, replicates them to the size of dsize and + inserts them into each vector register in group." + (insert-single-and-replicate grp base esize dsize selems 0)) + +(defun insert-single-and-replicate (grp base esize dsize selems s) + (when (< s selems) + (let ((element (cast-low esize (mem-read base (/ dsize esize))))) + (prog + (replicate-and-insert (nth-reg-in-group grp s) element esize dsize) + (insert-single-and-replicate grp (+ base (/ dsize 8)) esize dsize selems (+ s 1)))))) + +;; LD1R (no offset) + +(defmacro LD1Rv. (va xn esize dsize) + (LD.Rv. (symbol va) xn esize dsize 1)) + +(defun LD1Rv8b (va xn) (LD1Rv. va xn 8 64)) +(defun LD1Rv16b (va xn) (LD1Rv. va xn 8 128)) +(defun LD1Rv4h (va xn) (LD1Rv. va xn 16 64)) +(defun LD1Rv8h (va xn) (LD1Rv. va xn 16 128)) +(defun LD1Rv2s (va xn) (LD1Rv. va xn 32 64)) +(defun LD1Rv4s (va xn) (LD1Rv. va xn 32 128)) +(defun LD1Rv1d (va xn) (LD1Rv. va xn 64 64)) +(defun LD1Rv2d (va xn) (LD1Rv. va xn 64 128)) + +;; LD1R (post index) + +(defmacro LD1Rv._POST (va xn esize dsize off) + (LD.Rv._POST (symbol va) xn esize dsize 1 off)) + +(defun LD1Rv8b_POST (_ va xn xm) (LD1Rv._POST va xn 8 64 xm)) +(defun LD1Rv16b_POST (_ va xn xm) (LD1Rv._POST va xn 8 128 xm)) +(defun LD1Rv4h_POST (_ va xn xm) (LD1Rv._POST va xn 16 64 xm)) +(defun LD1Rv8h_POST (_ va xn xm) (LD1Rv._POST va xn 16 128 xm)) +(defun LD1Rv2s_POST (_ va xn xm) (LD1Rv._POST va xn 32 64 xm)) +(defun LD1Rv4s_POST (_ va xn xm) (LD1Rv._POST va xn 32 128 xm)) +(defun LD1Rv1d_POST (_ va xn xm) (LD1Rv._POST va xn 64 64 xm)) +(defun LD1Rv2d_POST (_ va xn xm) (LD1Rv._POST va xn 64 128 xm)) + +;; LD2R (no offset) + +(defmacro LD2Rv. (va_vb xn esize dsize) + (LD.Rv. va_vb xn esize dsize 2)) + +(defun LD2Rv8b (va_vb xn) (LD2Rv. va_vb xn 8 64)) +(defun LD2Rv16b (va_vb xn) (LD2Rv. va_vb xn 8 128)) +(defun LD2Rv4h (va_vb xn) (LD2Rv. va_vb xn 16 64)) +(defun LD2Rv8h (va_vb xn) (LD2Rv. va_vb xn 16 128)) +(defun LD2Rv2s (va_vb xn) (LD2Rv. va_vb xn 32 64)) +(defun LD2Rv4s (va_vb xn) (LD2Rv. va_vb xn 32 128)) +(defun LD2Rv1d (va_vb xn) (LD2Rv. va_vb xn 64 64)) +(defun LD2Rv2d (va_vb xn) (LD2Rv. va_vb xn 64 128)) + +;; LD2R (post index) + +(defmacro LD2Rv._POST (va_vb xn esize dsize off) + (LD.Rv._POST va_vb xn esize dsize 2 off)) + +(defun LD2Rv8b_POST (_ va_vb xn xm) (LD2Rv._POST va_vb xn 8 64 xm)) +(defun LD2Rv16b_POST (_ va_vb xn xm) (LD2Rv._POST va_vb xn 8 128 xm)) +(defun LD2Rv4h_POST (_ va_vb xn xm) (LD2Rv._POST va_vb xn 16 64 xm)) +(defun LD2Rv8h_POST (_ va_vb xn xm) (LD2Rv._POST va_vb xn 16 128 xm)) +(defun LD2Rv2s_POST (_ va_vb xn xm) (LD2Rv._POST va_vb xn 32 64 xm)) +(defun LD2Rv4s_POST (_ va_vb xn xm) (LD2Rv._POST va_vb xn 32 128 xm)) +(defun LD2Rv1d_POST (_ va_vb xn xm) (LD2Rv._POST va_vb xn 64 64 xm)) +(defun LD2Rv2d_POST (_ va_vb xn xm) (LD2Rv._POST va_vb xn 64 128 xm)) + +;; LD3R (no offset) + +(defmacro LD3Rv. (va_vb_vc xn esize dsize) + (LD.Rv. va_vb_vc xn esize dsize 3)) + +(defun LD3Rv8b (va_vb_vc xn) (LD3Rv. va_vb_vc xn 8 64)) +(defun LD3Rv16b (va_vb_vc xn) (LD3Rv. va_vb_vc xn 8 128)) +(defun LD3Rv4h (va_vb_vc xn) (LD3Rv. va_vb_vc xn 16 64)) +(defun LD3Rv8h (va_vb_vc xn) (LD3Rv. va_vb_vc xn 16 128)) +(defun LD3Rv2s (va_vb_vc xn) (LD3Rv. va_vb_vc xn 32 64)) +(defun LD3Rv4s (va_vb_vc xn) (LD3Rv. va_vb_vc xn 32 128)) +(defun LD3Rv1d (va_vb_vc xn) (LD3Rv. va_vb_vc xn 64 64)) +(defun LD3Rv2d (va_vb_vc xn) (LD3Rv. va_vb_vc xn 64 128)) + +;; LD3R (post index) + +(defmacro LD3Rv._POST (va_vb_vc xn esize dsize off) + (LD.Rv._POST va_vb_vc xn esize dsize 3 off)) + +(defun LD3Rv8b_POST (_ va_vb_vc xn xm) (LD3Rv._POST va_vb_vc xn 8 64 xm)) +(defun LD3Rv16b_POST (_ va_vb_vc xn xm) (LD3Rv._POST va_vb_vc xn 8 128 xm)) +(defun LD3Rv4h_POST (_ va_vb_vc xn xm) (LD3Rv._POST va_vb_vc xn 16 64 xm)) +(defun LD3Rv8h_POST (_ va_vb_vc xn xm) (LD3Rv._POST va_vb_vc xn 16 128 xm)) +(defun LD3Rv2s_POST (_ va_vb_vc xn xm) (LD3Rv._POST va_vb_vc xn 32 64 xm)) +(defun LD3Rv4s_POST (_ va_vb_vc xn xm) (LD3Rv._POST va_vb_vc xn 32 128 xm)) +(defun LD3Rv1d_POST (_ va_vb_vc xn xm) (LD3Rv._POST va_vb_vc xn 64 64 xm)) +(defun LD3Rv2d_POST (_ va_vb_vc xn xm) (LD3Rv._POST va_vb_vc xn 64 128 xm)) + +;; LD4R (no offset) + +(defmacro LD4Rv. (va_vb_vc_vd xn esize dsize) + (LD.Rv. va_vb_vc_vd xn esize dsize 4)) + +(defun LD4Rv8b (va_vb_vc_vd xn) (LD4Rv. va_vb_vc_vd xn 8 64)) +(defun LD4Rv16b (va_vb_vc_vd xn) (LD4Rv. va_vb_vc_vd xn 8 128)) +(defun LD4Rv4h (va_vb_vc_vd xn) (LD4Rv. va_vb_vc_vd xn 16 64)) +(defun LD4Rv8h (va_vb_vc_vd xn) (LD4Rv. va_vb_vc_vd xn 16 128)) +(defun LD4Rv2s (va_vb_vc_vd xn) (LD4Rv. va_vb_vc_vd xn 32 64)) +(defun LD4Rv4s (va_vb_vc_vd xn) (LD4Rv. va_vb_vc_vd xn 32 128)) +(defun LD4Rv1d (va_vb_vc_vd xn) (LD4Rv. va_vb_vc_vd xn 64 64)) +(defun LD4Rv2d (va_vb_vc_vd xn) (LD4Rv. va_vb_vc_vd xn 64 128)) + +;; LD4R (post index) + +(defmacro LD4Rv._POST (va_vb_vc_vd xn esize dsize off) + (LD.Rv._POST va_vb_vc_vd xn esize dsize 4 off)) + +(defun LD4Rv8b_POST (_ va_vb_vc_vd xn xm) (LD4Rv._POST va_vb_vc_vd xn 8 64 xm)) +(defun LD4Rv16b_POST (_ va_vb_vc_vd xn xm) (LD4Rv._POST va_vb_vc_vd xn 8 128 xm)) +(defun LD4Rv4h_POST (_ va_vb_vc_vd xn xm) (LD4Rv._POST va_vb_vc_vd xn 16 64 xm)) +(defun LD4Rv8h_POST (_ va_vb_vc_vd xn xm) (LD4Rv._POST va_vb_vc_vd xn 16 128 xm)) +(defun LD4Rv2s_POST (_ va_vb_vc_vd xn xm) (LD4Rv._POST va_vb_vc_vd xn 32 64 xm)) +(defun LD4Rv4s_POST (_ va_vb_vc_vd xn xm) (LD4Rv._POST va_vb_vc_vd xn 32 128 xm)) +(defun LD4Rv1d_POST (_ va_vb_vc_vd xn xm) (LD4Rv._POST va_vb_vc_vd xn 64 64 xm)) +(defun LD4Rv2d_POST (_ va_vb_vc_vd xn xm) (LD4Rv._POST va_vb_vc_vd xn 64 128 xm)) + +;; LDP (signed offset) + +(defmacro LDP.i (vn vm base imm size scale) + "(LDP.i qn qm imm size mem-load scale) loads a pair of SIMD&FP registers from + memory using the address base and an optional signed immediate offset. NOTE: + does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), + CheckSPAlignment(), Mem[... AccType_VEC]" + (let ((off (lshift (cast-signed 64 imm) scale)) + (dbytes (/ size 8))) + (set$ vn (mem-read (+ base off) (/ size 8))) + (set$ vm (mem-read (+ base off dbytes) (/ size 8))))) + +(defun LDPQi (qn qm base imm) (LDP.i qn qm base imm 128 4)) +(defun LDPDi (qn qm base imm) (LDP.i qn qm base imm 64 3)) +(defun LDPSi (qn qm base imm) (LDP.i qn qm base imm 32 2)) + +;; LDR (immediate, unsigned offset) + +(defmacro LDR.ui (vt base imm size scale) + "(LDR.ui vt base imm mem-load scale) loads an element from memory from + the base address and unsigned immediate offset imm and stores the result + in vt. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), + SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" + (let ((off (lshift (cast-unsigned 64 imm) scale))) + (set$ vt (mem-read (+ base off) (/ size 8))))) + +(defun LDRBui (bt base imm) (LDR.ui bt base imm 8 0)) +(defun LDRHui (ht base imm) (LDR.ui ht base imm 16 1)) +(defun LDRSui (st base imm) (LDR.ui st base imm 32 2)) +(defun LDRDui (dt base imm) (LDR.ui dt base imm 64 3)) +(defun LDRQui (qt base imm) (LDR.ui qt base imm 128 4)) + +;; LDR (register) + +(defmacro LDR.roX (vt base index signed s scale size) + "(LDR.roX vt base index signed s scale mem-load) loads a SIMD&FP register + from address base and an optionally shifted and extended index. NOTE: + does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), + CheckSPAlignment(), Mem[... AccType_VEC]" + (let ((shift (if (= s 1) + (+ scale 0) + (+ 0 0))) + (off (if (= signed 1) + (cast-signed 64 (lshift index shift)) + (cast-unsigned 64 (lshift index shift))))) + (set$ vt (mem-read (+ base off) (/ size 8))))) + +(defun LDRBroX (bt base index signed s) (LDR.roX bt base index signed s 0 8)) +(defun LDRHroX (ht base index signed s) (LDR.roX ht base index signed s 1 16)) +(defun LDRSroX (st base index signed s) (LDR.roX st base index signed s 2 32)) +(defun LDRDroX (dt base index signed s) (LDR.roX dt base index signed s 3 64)) +(defun LDRQroX (qt base index signed s) (LDR.roX qt base index signed s 4 128)) + +;; LDUR + +(defmacro LDUR.i (vt base simm size) + "(LDUR.i vt base simm mem-load) loads a SIMD&FP register from memory at + the address calculated from a base register and optional immediate offset. + NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), + CheckSPAlignment(), Mem[... AccType_VEC]" + (set$ vt (mem-read (+ base simm) (/ size 8)))) + +(defun LDURBi (bt base simm) (LDUR.i bt base simm 8)) +(defun LDURHi (ht base simm) (LDUR.i ht base simm 16)) +(defun LDURSi (st base simm) (LDUR.i st base simm 32)) +(defun LDURDi (dt base simm) (LDUR.i dt base simm 64)) +(defun LDURQi (qt base simm) (LDUR.i qt base simm 128)) + diff --git a/plugins/arm/semantics/aarch64-vector.lisp b/plugins/arm/semantics/aarch64-vector.lisp index 8a075a6be..b47188d7e 100644 --- a/plugins/arm/semantics/aarch64-vector.lisp +++ b/plugins/arm/semantics/aarch64-vector.lisp @@ -126,85 +126,6 @@ (defun MOVIv4i32 (vd imm shift) (MOVI* 128 32 vd imm shift)) -;;; LDs.. - -;; LD2 (multiple structures, post index) - -(defun LD2Twov16b_POST (_ qa_qb xn xm) - "(LD2Twov16b_POST _ qa_qb xn imm) loads multiple 2-element structures from memory at address xn with offset imm and stores it in qa and qb with de-interleaving. NOTE: does not encode Security state & Exception level" - (let ((qa (nth-reg-in-group qa_qb 0)) - (qb (nth-reg-in-group qa_qb 1))) - (insert-a qa qb xn 0 0 0) - (set$ xn (+ xn xm)))) - -(defun insert-a (qa qb addr e acc-a acc-b) - (if (< e 16) - (let ((temp (load-byte addr))) - (insert-b qa qb (+ addr 1) e (if (= e 0) temp (concat temp acc-a)) acc-b)) - (prog - (set$ qa acc-a) - (set$ qb acc-b)))) - -(defun insert-b (qa qb addr e acc-a acc-b) - (let ((temp (load-byte addr))) - (insert-a qa qb (+ addr 1) (+ e 1) acc-a (if (= e 0) temp (concat temp acc-b))))) - -;; LDP (signed offset) - -(defmacro LDP.i (vn vm base imm size scale) - "(LDP.i qn qm imm size mem-load scale) loads a pair of SIMD&FP registers from memory using the address base and an optional signed immediate offset. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" - (let ((off (lshift (cast-signed 64 imm) scale)) - (dbytes (/ size 8))) - (set$ vn (mem-read (+ base off) (/ size 8))) - (set$ vm (mem-read (+ base off dbytes) (/ size 8))))) - -(defun LDPQi (qn qm base imm) (LDP.i qn qm base imm 128 4)) -(defun LDPDi (qn qm base imm) (LDP.i qn qm base imm 64 3)) -(defun LDPSi (qn qm base imm) (LDP.i qn qm base imm 32 2)) - -;; LDR (immediate, unsigned offset) - -(defmacro LDR.ui (vt base imm size scale) - "(LDR.ui vt base imm mem-load scale) loads an element from memory from the base address and unsigned immediate offset imm and stores the result in vt. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" - (let ((off (lshift (cast-unsigned 64 imm) scale))) - (set$ vt (mem-read (+ base off) (/ size 8))))) - -(defun LDRBui (bt base imm) (LDR.ui bt base imm 8 0)) -(defun LDRHui (ht base imm) (LDR.ui ht base imm 16 1)) -(defun LDRSui (st base imm) (LDR.ui st base imm 32 2)) -(defun LDRDui (dt base imm) (LDR.ui dt base imm 64 3)) -(defun LDRQui (qt base imm) (LDR.ui qt base imm 128 4)) - -;; LDR (register) - -(defmacro LDR.roX (vt base index signed s scale size) - "(LDR.roX vt base index signed s scale mem-load) loads a SIMD&FP register from address base and an optionally shifted and extended index. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" - (let ((shift (if (= s 1) - (+ scale 0) - (+ 0 0))) - (off (if (= signed 1) - (cast-signed 64 (lshift index shift)) - (cast-unsigned 64 (lshift index shift))))) - (set$ vt (mem-read (+ base off) (/ size 8))))) - -(defun LDRBroX (bt base index signed s) (LDR.roX bt base index signed s 0 8)) -(defun LDRHroX (ht base index signed s) (LDR.roX ht base index signed s 1 16)) -(defun LDRSroX (st base index signed s) (LDR.roX st base index signed s 2 32)) -(defun LDRDroX (dt base index signed s) (LDR.roX dt base index signed s 3 64)) -(defun LDRQroX (qt base index signed s) (LDR.roX qt base index signed s 4 128)) - -;; LDUR - -(defmacro LDUR.i (vt base simm size) - "(LDUR.i vt base simm mem-load) loads a SIMD&FP register from memory at the address calculated from a base register and optional immediate offset. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" - (set$ vt (mem-read (+ base simm) (/ size 8)))) - -(defun LDURBi (bt base simm) (LDUR.i bt base simm 8)) -(defun LDURHi (ht base simm) (LDUR.i ht base simm 16)) -(defun LDURSi (st base simm) (LDUR.i st base simm 32)) -(defun LDURDi (dt base simm) (LDUR.i dt base simm 64)) -(defun LDURQi (qt base simm) (LDUR.i qt base simm 128)) - ; EXT (defmacro EXTv* (datasize vd vn vm pos) From 9e4c2a68cd2de2853ab9843e57d1d75a68f40996 Mon Sep 17 00:00:00 2001 From: alistair Date: Wed, 13 Jul 2022 00:47:12 +0000 Subject: [PATCH 102/132] fix lognot --- plugins/arm/semantics/aarch64-vector.lisp | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/plugins/arm/semantics/aarch64-vector.lisp b/plugins/arm/semantics/aarch64-vector.lisp index 4ac16dc38..7e8d512ea 100644 --- a/plugins/arm/semantics/aarch64-vector.lisp +++ b/plugins/arm/semantics/aarch64-vector.lisp @@ -79,15 +79,15 @@ (defun EORv16i8 (vd vn vm) (set$ vd (logxor vn vm))) ;; the ISA says NOT acts element-wise, but this is -;; equivalent to just (lognot vn). Not sure why it does this. -(defun NOTv8i8 (vd vn) (set$ vd (lognot vn))) -(defun NOTv16i8 (vd vn) (set$ vd (lognot vn))) +;; equivalent to just (lnot vn). Not sure why it does this. +(defun NOTv8i8 (vd vn) (set$ vd (lnot vn))) +(defun NOTv16i8 (vd vn) (set$ vd (lnot vn))) (defun ORRv8i8 (vd vn vm) (set$ vd (logor vn vm))) (defun ORRv16i8 (vd vn vm) (set$ vd (logor vn vm))) -(defun ORNv8i8 (vd vn vm) (set$ vd (logor vn (lognot vm)))) -(defun ORNv16i8 (vd vn vm) (set$ vd (logor vn (lognot vm)))) +(defun ORNv8i8 (vd vn vm) (set$ vd (logor vn (lnot vm)))) +(defun ORNv16i8 (vd vn vm) (set$ vd (logor vn (lnot vm)))) ;;; INS From 4a64053efbefe4ee3615d99fc1cef69007273828 Mon Sep 17 00:00:00 2001 From: alistair Date: Wed, 13 Jul 2022 00:51:30 +0000 Subject: [PATCH 103/132] add SMADDL --- plugins/arm/semantics/aarch64-arithmetic.lisp | 2 ++ 1 file changed, 2 insertions(+) diff --git a/plugins/arm/semantics/aarch64-arithmetic.lisp b/plugins/arm/semantics/aarch64-arithmetic.lisp index 59478ee35..4c1139370 100644 --- a/plugins/arm/semantics/aarch64-arithmetic.lisp +++ b/plugins/arm/semantics/aarch64-arithmetic.lisp @@ -98,6 +98,8 @@ (defun UMADDLrrr (rd rn rm ra) (set$ rd (cast-low 64 (+ ra (* rn rm))))) +(defun SMADDLrrr (rd rn rm ra) (set$ rd (cast-signed 64 (+ ra (* (cast-signed 64 rn) (cast-signed 64 rm)))))) + (defun UMULHrr (rd rn rm) "multiplies rn and rm together and stores the high 64 bits of the resulting 128-bit value to the register rd" From e5dac8648fb196c65b088476a1b3e782630bf72d Mon Sep 17 00:00:00 2001 From: alistair Date: Wed, 13 Jul 2022 01:39:43 +0000 Subject: [PATCH 104/132] add LDURHH,LDURSB,LDURSH,LDURSW --- .../arm/semantics/aarch64-data-movement.lisp | 31 +++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index dac5aa466..e11734214 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -173,6 +173,37 @@ "(LDURBBi wt base simm) loads a byte from the address calculated from a base register and signed immediate offset and stores it in the 32 bit destination register. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" (setw wt (load-byte (+ base simm)))) +;; LDURH + +(defun LDURHHi (rt rn simm) + (setw rt (cast-unsigned 32 (load-dbyte (+ rn simm))))) + +;; LDURSB + +(defun LDURSBWi (rt rn simm) + "LDURSBWi loads a byte from the address (rn + simm) and sign-extends it to write it to rt" + (setw rt (cast-signed 32 (load-byte (+ rn simm))))) + +(defun LDURSBXi (rt rn simm) + "LDURSBXi loads a byte from the address (rn + simm) and sign-extends it to write it to rt" + (set$ rt (cast-signed 64 (load-byte (+ rn simm))))) + +;; LDURSH + +(defun LDURSHWi (rt rn simm) + "LDURSBWi loads a halfword from the address (rn + simm) and sign-extends it to write it to rt" + (setw rt (cast-signed 32 (load-dbyte (+ rn simm))))) + +(defun LDURSHXi (rt rn simm) + "LDURSBXi loads a halfword from the address (rn + simm) and sign-extends it to write it to rt" + (set$ rt (cast-signed 64 (load-dbyte (+ rn simm))))) + +;; LDURSW + +(defun LDURSWi (rt rn simm) + "LDURSBXi loads a word from the address (rn + simm) and sign-extends it to write it to rt" + (set$ rt (cast-signed 64 (load-hword (+ rn simm))))) + ;; LDUR (defmacro LDUR*i (rt base simm setf mem-load) From a6e5d61b393137152424490676b211f5e20151a5 Mon Sep 17 00:00:00 2001 From: alistair Date: Wed, 13 Jul 2022 01:46:47 +0000 Subject: [PATCH 105/132] redo brk --- plugins/arm/semantics/aarch64-special.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/arm/semantics/aarch64-special.lisp b/plugins/arm/semantics/aarch64-special.lisp index fff10893e..6cae908eb 100644 --- a/plugins/arm/semantics/aarch64-special.lisp +++ b/plugins/arm/semantics/aarch64-special.lisp @@ -26,4 +26,4 @@ (intrinsic 'undefined-instruction)) (defun BRK (option) - (intrinsic (symbol-concat 'software-breakpoint- (bitvec-to-symbol option '0x)))) + (intrinsic 'software-breakpoint option)) From a4247fafb60ffacf4a002464f6d243e248ea6f4d Mon Sep 17 00:00:00 2001 From: alistair Date: Wed, 13 Jul 2022 01:52:43 +0000 Subject: [PATCH 106/132] add UMSUBL --- plugins/arm/semantics/aarch64-arithmetic.lisp | 2 ++ 1 file changed, 2 insertions(+) diff --git a/plugins/arm/semantics/aarch64-arithmetic.lisp b/plugins/arm/semantics/aarch64-arithmetic.lisp index 4c1139370..f8b073202 100644 --- a/plugins/arm/semantics/aarch64-arithmetic.lisp +++ b/plugins/arm/semantics/aarch64-arithmetic.lisp @@ -100,6 +100,8 @@ (defun SMADDLrrr (rd rn rm ra) (set$ rd (cast-signed 64 (+ ra (* (cast-signed 64 rn) (cast-signed 64 rm)))))) +(defun UMSUBLrrr (rd rn rm ra) (set$ rd (cast-low 64 (- ra (* (cast-signed 64 rn) (cast-signed 64 rm)))))) + (defun UMULHrr (rd rn rm) "multiplies rn and rm together and stores the high 64 bits of the resulting 128-bit value to the register rd" From ec0fa99aae9684c44e0328f1b0f57c5622a46e88 Mon Sep 17 00:00:00 2001 From: alistair Date: Wed, 13 Jul 2022 01:54:15 +0000 Subject: [PATCH 107/132] add SMSUBL --- plugins/arm/semantics/aarch64-arithmetic.lisp | 3 +++ 1 file changed, 3 insertions(+) diff --git a/plugins/arm/semantics/aarch64-arithmetic.lisp b/plugins/arm/semantics/aarch64-arithmetic.lisp index f8b073202..634fe82a1 100644 --- a/plugins/arm/semantics/aarch64-arithmetic.lisp +++ b/plugins/arm/semantics/aarch64-arithmetic.lisp @@ -102,6 +102,9 @@ (defun UMSUBLrrr (rd rn rm ra) (set$ rd (cast-low 64 (- ra (* (cast-signed 64 rn) (cast-signed 64 rm)))))) + +(defun SMSUBLrrr (rd rn rm ra) (set$ rd (cast-signed 64 (- ra (* (cast-signed 64 rn) (cast-signed 64 rm)))))) + (defun UMULHrr (rd rn rm) "multiplies rn and rm together and stores the high 64 bits of the resulting 128-bit value to the register rd" From 6bf46bdac6f036578a0fc6e8b26627bc6798249c Mon Sep 17 00:00:00 2001 From: alistair Date: Wed, 13 Jul 2022 03:36:51 +0000 Subject: [PATCH 108/132] add RBIT --- plugins/arm/semantics/aarch64-arithmetic.lisp | 1 - plugins/arm/semantics/aarch64-helper.lisp | 5 +++++ plugins/arm/semantics/aarch64-logical.lisp | 3 +++ 3 files changed, 8 insertions(+), 1 deletion(-) diff --git a/plugins/arm/semantics/aarch64-arithmetic.lisp b/plugins/arm/semantics/aarch64-arithmetic.lisp index 634fe82a1..7632eab0d 100644 --- a/plugins/arm/semantics/aarch64-arithmetic.lisp +++ b/plugins/arm/semantics/aarch64-arithmetic.lisp @@ -102,7 +102,6 @@ (defun UMSUBLrrr (rd rn rm ra) (set$ rd (cast-low 64 (- ra (* (cast-signed 64 rn) (cast-signed 64 rm)))))) - (defun SMSUBLrrr (rd rn rm ra) (set$ rd (cast-signed 64 (- ra (* (cast-signed 64 rn) (cast-signed 64 rm)))))) (defun UMULHrr (rd rn rm) diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index 58736b35d..d4cf40550 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -9,6 +9,11 @@ (defun word () (word-width)) +(defun reverse-bits (bits) + (if (> (word-width bits) 1) + (concat (cast-low 1 bits) (reverse-bits (cast-high (- (word-width bits) 1) bits))) + bits)) + (defun shift-encoded (rm off) "(shift-encoded rm off) decodes the 8-bit shift value into its type and offset, and shifts rm accordingly." diff --git a/plugins/arm/semantics/aarch64-logical.lisp b/plugins/arm/semantics/aarch64-logical.lisp index 094d02221..7969c8552 100644 --- a/plugins/arm/semantics/aarch64-logical.lisp +++ b/plugins/arm/semantics/aarch64-logical.lisp @@ -146,3 +146,6 @@ (defun RORVXr (rd rn rm) (SHIFT*r set$ rotate-right 64 rd rn rm)) (defun RORVWr (rd rn rm) (SHIFT*r setw rotate-right 32 rd rn rm)) + +(defun RBITXr (rd rn) (set$ rd (reverse-bits rn))) +(defun RBITWr (rd rn) (setw rd (reverse-bits rn))) From 5ff9426e4e4d041481c1842956ffb59593a7ee9c Mon Sep 17 00:00:00 2001 From: alistair Date: Wed, 20 Jul 2022 02:31:49 +0000 Subject: [PATCH 109/132] make RBIT bil better --- plugins/arm/semantics/aarch64-helper.lisp | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index d4cf40550..0ef4459f9 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -9,10 +9,13 @@ (defun word () (word-width)) +(defun _reverse-bits (bits i) + (if (> i 0) + (concat (_reverse-bits bits (- i 1)) (select i bits)) + (select i bits))) + (defun reverse-bits (bits) - (if (> (word-width bits) 1) - (concat (cast-low 1 bits) (reverse-bits (cast-high (- (word-width bits) 1) bits))) - bits)) + (_reverse-bits bits (- (word-width bits) 1))) (defun shift-encoded (rm off) "(shift-encoded rm off) decodes the 8-bit shift value From 721917a74157552ac3bca7e745c4ba9b63285b02 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Sat, 23 Jul 2022 01:48:05 +0000 Subject: [PATCH 110/132] extract simd instructions into package --- plugins/arm/semantics/aarch64.lisp | 2 +- .../aarch64-simd-arithmetic.lisp} | 77 +------------------ .../aarch64-simd-load.lisp} | 0 .../semantics/simd/aarch64-simd-logical.lisp | 25 ++++++ .../simd/aarch64-simd-mov-ins-ext.lisp | 55 +++++++++++++ plugins/arm/semantics/simd/aarch64-simd.lisp | 10 +++ 6 files changed, 92 insertions(+), 77 deletions(-) rename plugins/arm/semantics/{aarch64-vector.lisp => simd/aarch64-simd-arithmetic.lisp} (52%) rename plugins/arm/semantics/{aarch64-vector-load.lisp => simd/aarch64-simd-load.lisp} (100%) create mode 100644 plugins/arm/semantics/simd/aarch64-simd-logical.lisp create mode 100644 plugins/arm/semantics/simd/aarch64-simd-mov-ins-ext.lisp create mode 100644 plugins/arm/semantics/simd/aarch64-simd.lisp diff --git a/plugins/arm/semantics/aarch64.lisp b/plugins/arm/semantics/aarch64.lisp index 42d875479..5037c3f20 100644 --- a/plugins/arm/semantics/aarch64.lisp +++ b/plugins/arm/semantics/aarch64.lisp @@ -1,6 +1,6 @@ (declare (context (target arm armv8-a+le))) -(defpackage aarch64 (:use core target arm)) +(defpackage aarch64 (:use core target arm aarch64-simd)) (defpackage llvm-aarch64 (:use aarch64)) (in-package aarch64) diff --git a/plugins/arm/semantics/aarch64-vector.lisp b/plugins/arm/semantics/simd/aarch64-simd-arithmetic.lisp similarity index 52% rename from plugins/arm/semantics/aarch64-vector.lisp rename to plugins/arm/semantics/simd/aarch64-simd-arithmetic.lisp index b47188d7e..b798cdce6 100644 --- a/plugins/arm/semantics/aarch64-vector.lisp +++ b/plugins/arm/semantics/simd/aarch64-simd-arithmetic.lisp @@ -1,8 +1,6 @@ (declare (context (target armv8-a+le))) -(in-package aarch64) - -;;; ARITHMETIC +(in-package aarch64-simd) (defun sym-to-binop (binop-sym x y) (case binop-sym @@ -66,76 +64,3 @@ (defun MULv8i16 (vd vn vm) (MULv*i* vd vn vm 8 16)) (defun MULv8i8 (vd vn vm) (MULv*i* vd vn vm 8 8)) (defun MULv16i8 (vd vn vm) (MULv*i* vd vn vm 16 8)) - -;;; LOGICAL - -(defun ANDv8i8 (vd vn vm) (set$ vd (logand vn vm))) -(defun ANDv16i8 (vd vn vm) (set$ vd (logand vn vm))) - -;; the ISA expresses (logxor vn vm) as -;; (logxor vm (logand (logor (zeros (word-width vn)) vn) (ones (word-width vn)))) -;; I've simplified it to just this. -(defun EORv8i8 (vd vn vm) (set$ vd (logxor vn vm))) -(defun EORv16i8 (vd vn vm) (set$ vd (logxor vn vm))) - -;; the ISA says NOT acts element-wise, but this is -;; equivalent to just (lnot vn). Not sure why it does this. -(defun NOTv8i8 (vd vn) (set$ vd (lnot vn))) -(defun NOTv16i8 (vd vn) (set$ vd (lnot vn))) - -(defun ORRv8i8 (vd vn vm) (set$ vd (logor vn vm))) -(defun ORRv16i8 (vd vn vm) (set$ vd (logor vn vm))) - -(defun ORNv8i8 (vd vn vm) (set$ vd (logor vn (lnot vm)))) -(defun ORNv16i8 (vd vn vm) (set$ vd (logor vn (lnot vm)))) - -;;; INS - -(defun INSvi32gpr (vd _ index gpr) - "(INSvi32gpr vd ts index gpr) inserts an element in the general purpose register gpr into vecter register vd at index. NOTE: does not encode Security state & Exception level" - (insert-element-into-vector vd index gpr 32)) - -(defun INSvi32lane (vd _ index vn index2) - "NOTE: does not encode Security state & Exception level" - (let ((element (get-vector-S-element index2 vn))) - (insert-element-into-vector vd index element 32))) - - -(defun MOVI* (datasize channelsize vd val shift) - "Sets every channel of vd to have value. the size of val should be equal to - the channel width." - (let ((val (cast-low channelsize (lshift val shift))) - (result (replicate-to-fill val datasize))) - (set$ vd result))) - -(defun MOVIv8b_ns (vd imm) - (MOVI* 64 8 vd imm 0)) - -(defun MOVIv16b_ns (vd imm) - (MOVI* 128 8 vd imm 0)) - -(defun MOVIv4i16 (vd imm shift) - (MOVI* 64 16 vd imm shift)) - -(defun MOVIv8i16 (vd imm shift) - (MOVI* 128 16 vd imm shift)) - -(defun MOVIv2i32 (vd imm shift) - (MOVI* 64 32 vd imm shift)) - -(defun MOVIv4i32 (vd imm shift) - (MOVI* 128 32 vd imm shift)) - -; EXT - -(defmacro EXTv* (datasize vd vn vm pos) - "Extracts a vector from a pair of vectors. pos is the bit offset that will - become the least significant bit of vd." - (let ((pos (lshift pos 3))) - (set$ vd (extract (+ pos (- datasize 1)) pos (concat vm vn))))) - -(defun EXTv16i8 (vd vn vm pos) - (EXTv* 128 vd vn vm pos)) - -(defun EXTv8i8 (vd vn vm pos) - (EXTv* 64 vd vn vm pos)) diff --git a/plugins/arm/semantics/aarch64-vector-load.lisp b/plugins/arm/semantics/simd/aarch64-simd-load.lisp similarity index 100% rename from plugins/arm/semantics/aarch64-vector-load.lisp rename to plugins/arm/semantics/simd/aarch64-simd-load.lisp diff --git a/plugins/arm/semantics/simd/aarch64-simd-logical.lisp b/plugins/arm/semantics/simd/aarch64-simd-logical.lisp new file mode 100644 index 000000000..b89e6bd60 --- /dev/null +++ b/plugins/arm/semantics/simd/aarch64-simd-logical.lisp @@ -0,0 +1,25 @@ +(declare (context (target armv8-a+le))) + +(in-package aarch64-simd) + +;;; LOGICAL + +(defun ANDv8i8 (vd vn vm) (set$ vd (logand vn vm))) +(defun ANDv16i8 (vd vn vm) (set$ vd (logand vn vm))) + +;; the ISA expresses (logxor vn vm) as +;; (logxor vm (logand (logor (zeros (word-width vn)) vn) (ones (word-width vn)))) +;; I've simplified it to just this. +(defun EORv8i8 (vd vn vm) (set$ vd (logxor vn vm))) +(defun EORv16i8 (vd vn vm) (set$ vd (logxor vn vm))) + +;; the ISA says NOT acts element-wise, but this is +;; equivalent to just (lnot vn). Not sure why it does this. +(defun NOTv8i8 (vd vn) (set$ vd (lnot vn))) +(defun NOTv16i8 (vd vn) (set$ vd (lnot vn))) + +(defun ORRv8i8 (vd vn vm) (set$ vd (logor vn vm))) +(defun ORRv16i8 (vd vn vm) (set$ vd (logor vn vm))) + +(defun ORNv8i8 (vd vn vm) (set$ vd (logor vn (lnot vm)))) +(defun ORNv16i8 (vd vn vm) (set$ vd (logor vn (lnot vm)))) diff --git a/plugins/arm/semantics/simd/aarch64-simd-mov-ins-ext.lisp b/plugins/arm/semantics/simd/aarch64-simd-mov-ins-ext.lisp new file mode 100644 index 000000000..beff20619 --- /dev/null +++ b/plugins/arm/semantics/simd/aarch64-simd-mov-ins-ext.lisp @@ -0,0 +1,55 @@ +(declare (context (target armv8-a+le))) + +(in-package aarch64-simd) + + +;;; INS + +(defun INSvi32gpr (vd _ index gpr) + "(INSvi32gpr vd ts index gpr) inserts an element in the general purpose register gpr into vecter register vd at index. NOTE: does not encode Security state & Exception level" + (insert-element-into-vector vd index gpr 32)) + +(defun INSvi32lane (vd _ index vn index2) + "NOTE: does not encode Security state & Exception level" + (let ((element (get-vector-S-element index2 vn))) + (insert-element-into-vector vd index element 32))) + + +(defun MOVI* (datasize channelsize vd val shift) + "Sets every channel of vd to have value. the size of val should be equal to + the channel width." + (let ((val (cast-low channelsize (lshift val shift))) + (result (replicate-to-fill val datasize))) + (set$ vd result))) + +(defun MOVIv8b_ns (vd imm) + (MOVI* 64 8 vd imm 0)) + +(defun MOVIv16b_ns (vd imm) + (MOVI* 128 8 vd imm 0)) + +(defun MOVIv4i16 (vd imm shift) + (MOVI* 64 16 vd imm shift)) + +(defun MOVIv8i16 (vd imm shift) + (MOVI* 128 16 vd imm shift)) + +(defun MOVIv2i32 (vd imm shift) + (MOVI* 64 32 vd imm shift)) + +(defun MOVIv4i32 (vd imm shift) + (MOVI* 128 32 vd imm shift)) + +; EXT + +(defmacro EXTv* (datasize vd vn vm pos) + "Extracts a vector from a pair of vectors. pos is the bit offset that will + become the least significant bit of vd." + (let ((pos (lshift pos 3))) + (set$ vd (extract (+ pos (- datasize 1)) pos (concat vm vn))))) + +(defun EXTv16i8 (vd vn vm pos) + (EXTv* 128 vd vn vm pos)) + +(defun EXTv8i8 (vd vn vm pos) + (EXTv* 64 vd vn vm pos)) diff --git a/plugins/arm/semantics/simd/aarch64-simd.lisp b/plugins/arm/semantics/simd/aarch64-simd.lisp new file mode 100644 index 000000000..ffc2c905b --- /dev/null +++ b/plugins/arm/semantics/simd/aarch64-simd.lisp @@ -0,0 +1,10 @@ +(declare (context (target arm armv8-a+le))) + +(defpackage aarch64-simd (:use aarch64)) + +(in-package aarch64-simd) + +(require aarch64-simd-arithmetic) +(require aarch64-simd-load) +(require aarch64-simd-logical) +(require aarch64-simd-mov-ins-ext) \ No newline at end of file From 1f5d65a9427e7d60522c143c419dcac8f71ca396 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Mon, 25 Jul 2022 04:37:56 +0000 Subject: [PATCH 111/132] limit comment length --- .../arm/semantics/aarch64-data-movement.lisp | 53 ++++++++++++++----- plugins/arm/semantics/aarch64-helper.lisp | 5 -- .../arm/semantics/simd/aarch64-simd-load.lisp | 27 +++++++--- .../simd/aarch64-simd-mov-ins-ext.lisp | 5 +- 4 files changed, 62 insertions(+), 28 deletions(-) diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index 2f215a7f7..bf649fced 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -9,7 +9,10 @@ ;; LDR (register) (defmacro LDR*ro* (rt base index signed s scale setf mem-load) - "(LDR*ro* rt base index signed s scale setf mem-load) loads a register from memory at the address calculated from a base register and optionally shifted and extended offset value. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + "(LDR*ro* rt base index signed s scale setf mem-load) loads a register from + memory at the address calculated from a base register and optionally shifted + and extended offset value. + NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" (let ((shift (* s scale)) (off (if (= signed 1) (cast-signed 64 (lshift index shift)) @@ -27,9 +30,7 @@ ;; LDR (immediate, post-index) (defmacro LDR*post (dst base off setf) - "" -;; (setf dst (mem-read base (/ (word-width dst) 8))) - (set$ base (+ base (cast-signed 64 off)))) + (setf dst (mem-read base (/ (word-width dst) 8)))) (defun LDRWpost (_ dst base off) (LDR*post dst base off setw)) (defun LDRXpost (_ dst base off) (LDR*post dst base off set$)) @@ -55,28 +56,39 @@ ;; LDRB (immediate, post-index) (defun LDRBBpost (_ dst base simm) - "(LDRBBpost _ dst base simm) loads a byte from the base address and stores it in the 32 bit dst register, and increments the base register by simm. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), ConstrainUnpredictable()" + "(LDRBBpost _ dst base simm) loads a byte from the base address and stores + it in the 32 bit dst register, and increments the base register by simm. + NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), + ConstrainUnpredictable()" (setw dst (cast-unsigned 32 (load-byte base))) (set$ base (+ base simm))) ;; LDRB (immediate, pre-index) (defun LDRBBpre (_ dst base simm) - "(LDRBBpre _ dst base simm) loads a byte from the base address and an offset simm and stores it in the 32 bit dst register. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), ConstrainUnpredictable()" + "(LDRBBpre _ dst base simm) loads a byte from the base address and an offset + simm and stores it in the 32 bit dst register. + NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), + ConstrainUnpredictable()" (setw dst (cast-unsigned 32 (load-byte (+ base simm)))) (set$ base (+ base simm))) ;; LDRB (immediate, unsigned offset) (defun LDRBBui (dst reg off) - "(LDRBBui _ dst base simm) loads a byte from a preindexed base address and an unsigned offset and stores it in the 32 bit dst register. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), ConstrainUnpredictable()" + "(LDRBBui _ dst base simm) loads a byte from a preindexed base address + and an unsigned offset and stores it in the 32 bit dst register. + NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment(), + ConstrainUnpredictable()" (setw dst (cast-unsigned 32 (load-byte (+ reg off))))) ;; LDRB (register) (defmacro LDRBBro* (dst base index signed) - "(LDRBBro* dst base index signed) loads a byte from memory from a base address and index and stores it in a 32 bit destination register. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + "(LDRBBro* dst base index signed) loads a byte from memory from a base address + and index and stores it in a 32 bit destination register. + NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" (let ((off (if (= signed 1) (cast-signed 64 index) (cast-unsigned 64 index)))) @@ -115,7 +127,9 @@ ;; LDP (signed offset) (defmacro LDP*i (r1 r2 base imm scale datasize setf mem-load) - "(LDP*i r1 r2 base imm scale datasize setf mem-load) loads a pair of registers r1 and r2 from the address calculated from a base register value and immediate offset. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + "(LDP*i r1 r2 base imm scale datasize setf mem-load) loads a pair of registers + r1 and r2 from the address calculated from a base register value and immediate offset. + NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" (let ((off (lshift (cast-signed 64 imm) scale))) (setf r1 (mem-load (+ base off))) (setf r2 (mem-load (+ base off (/ datasize 8)))))) @@ -126,7 +140,9 @@ ;; LDRH (register) (defmacro LDRHHro* (wt base index signed s) - "(LDRHHro* wt base index signed s) loads 2 bytes from the address calculated from a base register address and offset. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + "(LDRHHro* wt base index signed s) loads 2 bytes from the address calculated from + a base register address and offset. + NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" (let ((off (if (= signed 1) (cast-signed 64 (lshift index s)) (cast-unsigned 64 (lshift index s))))) @@ -138,7 +154,9 @@ ;; LDRH (immediate, unsigned offset, pre/post indexed) (defun LDRHHui (wt xn pimm) - "(LDRHHui wt xn pimm) loads 2 bytes from the address calculated from a base register and unsigned immediate offset. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + "(LDRHHui wt xn pimm) loads 2 bytes from the address calculated from + a base register and unsigned immediate offset. + NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" (let ((off (lshift (cast-unsigned 64 pimm) 1))) (setw wt (load-dbyte (+ xn off))))) @@ -158,7 +176,9 @@ ;; LRDSW (register) (defmacro LDRSWro* (xt base index signed s) - "(LDRSWro* xt base index signed s) loads 32 bits from memory from a base address and offset and stores it in the destination register xt. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + "(LDRSWro* xt base index signed s) loads 32 bits from memory from + a base address and offset and stores it in the destination register xt. + NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" (let ((shift (* s 2)) (off (if (= signed 1) (cast-signed 64 (lshift index shift)) @@ -171,7 +191,10 @@ ;; LDURB (defun LDURBBi (wt base simm) - "(LDURBBi wt base simm) loads a byte from the address calculated from a base register and signed immediate offset and stores it in the 32 bit destination register. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + "(LDURBBi wt base simm) loads a byte from the address calculated from + a base register and signed immediate offset and stores it in the + 32 bit destination register. + NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" (setw wt (load-byte (+ base simm)))) ;; LDURH @@ -208,7 +231,9 @@ ;; LDUR (defmacro LDUR*i (rt base simm setf mem-load) - "(LDUR*i rt base simm setf mem-load) loads a register from the address calculated from a base register and signed immediate offset. NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" + "(LDUR*i rt base simm setf mem-load) loads a register from the address + calculated from a base register and signed immediate offset. + NOTE: does not HaveMTE2Ext(), SetTagCheckedInstruction(), CheckSPAlignment()" (setf rt (mem-load (+ base (cast-signed 64 simm))))) (defun LDURWi (wt base simm) (LDUR*i wt base simm setw load-hword)) diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index 546944b21..42443bee6 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -181,11 +181,6 @@ 8 (load-word address) 16 (concat (load-word address) (load-word (+ address 8))))) -;; to generate these functions, -;; do something like the following python code -;; for c in "XW": -;; for i in range(30//2): -;; print(f"'{c}{2*i}_{c}{2*i+1} '{c}{2*i}") (defun register-pair-first (r-pair) "(register-pair-first r-pair) returns the first register in the register pair Xi_X(i+1) or similar, returned by LLVM. diff --git a/plugins/arm/semantics/simd/aarch64-simd-load.lisp b/plugins/arm/semantics/simd/aarch64-simd-load.lisp index 73b31cd6d..4fc5e797f 100644 --- a/plugins/arm/semantics/simd/aarch64-simd-load.lisp +++ b/plugins/arm/semantics/simd/aarch64-simd-load.lisp @@ -127,7 +127,9 @@ (defun LD2Twov2d_POST (_ qa_qb xn xm) (LD2Twov._POST qa_qb xn xm 2 8)) (defmacro LD2Twov._POST (va_vb xn xm elems bytes) - "(LD2Twov._POST va_vb xn elesms bytes) loads multiple 2-element structures from memory at address xn with offset xm and stores it in va and vb with de-interleaving. NOTE: does not encode Security state & Exception level" + "(LD2Twov._POST va_vb xn elesms bytes) loads multiple 2-element structures from + memory at address xn with offset xm and stores it in va and vb with de-interleaving. + NOTE: does not encode Security state & Exception level" (LD..v._POST 1 elems 2 bytes va_vb xn xm)) ;; LD2 (multiple structures, no offset) @@ -141,7 +143,9 @@ (defun LD2Twov2d (qa_qb xn) (LD2Twov. qa_qb xn 2 8)) (defmacro LD2Twov. (va_vb xn elems bytes) - "(LD2Twov. va_vb xn elesms bytes) loads multiple 2-element structures from memory at address xn and stores it in va and vb with de-interleaving. NOTE: does not encode Security state & Exception level" + "(LD2Twov. va_vb xn elesms bytes) loads multiple 2-element structures from + memory at address xn and stores it in va and vb with de-interleaving. + NOTE: does not encode Security state & Exception level" (LD 1 elems 2 xn bytes va_vb)) ;; LD3 (multiple structures, post index) @@ -155,7 +159,9 @@ (defun LD3Threev2d_POST (_ qa_qb_qc xn xm) (LD3Threev._POST qa_qb_qc xn xm 2 8)) (defmacro LD3Threev._POST (va_vb_vc xn xm elems bytes) - "(LD3Threev._POST va_vb_vc xn xm elems bytes) loads multiple 3-element structures from memory at address xn with offset xm and stores it in va, vb and vc with de-interleaving. NOTE: does not encode Security state & Exception level" + "(LD3Threev._POST va_vb_vc xn xm elems bytes) loads multiple 3-element structures + from memory at address xn with offset xm and stores it in va, vb and vc with de-interleaving. + NOTE: does not encode Security state & Exception level" (LD..v._POST 1 elems 3 bytes va_vb_vc xn xm)) ;; LD3 (multiple structures, no offset) @@ -169,7 +175,9 @@ (defun LD3Threev2d (qa_qb_qc xn) (LD3Threev. qa_qb_qc xn 2 8)) (defmacro LD3Threev. (va_vb_vc xn elems bytes) - "(LD3Threev. va_vb_vc xn elems bytes) loads multiple 3-element structures from memory at address xn and stores it in va, vb and vc with de-interleaving. NOTE: does not encode Security state & Exception level" + "(LD3Threev. va_vb_vc xn elems bytes) loads multiple 3-element structures from + memory at address xn and stores it in va, vb and vc with de-interleaving. + NOTE: does not encode Security state & Exception level" (LD 1 elems 3 xn bytes va_vb_vc)) ;; LD4 (multiple structures, post index) @@ -183,7 +191,9 @@ (defun LD4Fourv2d_POST (_ qa_qb_qc_qd xn xm) (LD4Fourv._POST qa_qb_qc_qd xn xm 2 8)) (defmacro LD4Fourv._POST (va_vb_vc xn xm elems bytes) - "(LD4Fourv._POST va_vb_vc xn xm elems bytes) loads multiple 4-element structures from memory at address xn with offset xm and stores it in va, vb, vc and vd with de-interleaving. NOTE: does not encode Security state & Exception level" + "(LD4Fourv._POST va_vb_vc xn xm elems bytes) loads multiple 4-element structures + from memory at address xn with offset xm and stores it in va, vb, vc and vd with de-interleaving. + NOTE: does not encode Security state & Exception level" (LD..v._POST 1 elems 4 bytes va_vb_vc xn xm)) ;; LD4 (multiple structures, no offset) @@ -197,13 +207,16 @@ (defun LD4Fourv2d (qa_qb_qc_qd xn) (LD4Fourv. qa_qb_qc_qd xn 2 8)) (defmacro LD4Fourv. (va_vb_vc xn elems bytes) - "(LD4Fourv. va_vb_vc xn elems bytes) loads multiple 4-element structures from memory at address xn and stores it in va, vb, vc and vd with de-interleaving. NOTE: does not encode Security state & Exception level" + "(LD4Fourv. va_vb_vc xn elems bytes) loads multiple 4-element structures from memory + at address xn and stores it in va, vb, vc and vd with de-interleaving. + NOTE: does not encode Security state & Exception level" (LD 1 elems 4 xn bytes va_vb_vc)) ;; LD multiple struct algorithm (defmacro LD..v._POST (rpt elems selems bytes grp base off) - "(LD..v._POST rpt elems selems bytes grp base off) loads multiple selems-element structs from memory address base with offset off and stores them in the vector list grp." + "(LD..v._POST rpt elems selems bytes grp base off) loads multiple selems-element structs + from memory address base with offset off and stores them in the vector list grp." (prog (LD rpt elems selems base bytes grp) (if (= (symbol off) 'XZR) diff --git a/plugins/arm/semantics/simd/aarch64-simd-mov-ins-ext.lisp b/plugins/arm/semantics/simd/aarch64-simd-mov-ins-ext.lisp index beff20619..52390dbf7 100644 --- a/plugins/arm/semantics/simd/aarch64-simd-mov-ins-ext.lisp +++ b/plugins/arm/semantics/simd/aarch64-simd-mov-ins-ext.lisp @@ -2,11 +2,12 @@ (in-package aarch64-simd) - ;;; INS (defun INSvi32gpr (vd _ index gpr) - "(INSvi32gpr vd ts index gpr) inserts an element in the general purpose register gpr into vecter register vd at index. NOTE: does not encode Security state & Exception level" + "(INSvi32gpr vd ts index gpr) inserts an element in the general purpose register gpr + into vecter register vd at index. + NOTE: does not encode Security state & Exception level" (insert-element-into-vector vd index gpr 32)) (defun INSvi32lane (vd _ index vn index2) From 5dd6371620cd03ff33aa91145336106e33527151 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Wed, 27 Jul 2022 07:14:14 +0000 Subject: [PATCH 112/132] Separate simd data movement instructions --- .../arm/semantics/aarch64-data-movement.lisp | 206 +++--------------- plugins/arm/semantics/aarch64-helper.lisp | 22 ++ .../arm/semantics/simd/aarch64-simd-load.lisp | 2 +- .../semantics/simd/aarch64-simd-store.lisp | 92 ++++++++ plugins/arm/semantics/simd/aarch64-simd.lisp | 3 +- 5 files changed, 142 insertions(+), 183 deletions(-) create mode 100644 plugins/arm/semantics/simd/aarch64-simd-store.lisp diff --git a/plugins/arm/semantics/aarch64-data-movement.lisp b/plugins/arm/semantics/aarch64-data-movement.lisp index bf649fced..7d20764ae 100644 --- a/plugins/arm/semantics/aarch64-data-movement.lisp +++ b/plugins/arm/semantics/aarch64-data-movement.lisp @@ -267,67 +267,28 @@ (store-byte (+ reg off) src)) ; STR (register) -(defun str-reg (scale rt rn rm signed shift) +(defun STR*ro* (scale rt rn rm signed shift) "stores rt to (rn + rm << (shift * scale)) with signed or unsigned extension - of rm, where rt is a register of size (8 << scale). Note that rm can be an X - or W register and it chooses the appropriate extend mode implicitly. rn must - be an X register." + of rm, where rt is a register of size (8 << scale). Note that rm can be an X + or W register and it chooses the appropriate extend mode implicitly. rn must + be an X register." (assert (< signed 2)) (assert-msg (= (word-width rt) (lshift 8 scale)) - "(aarch64-data-movement.lisp:str-reg) scale must match size of rt") - (store-word (+ rn - (if (= signed 1) - (signed-extend (word-width rm) (lshift rm (* shift scale))) - (unsigned-extend (word-width rm) (lshift rm (* shift scale))))) - rt)) + "STR*ro*: scale must match size of rt") + (store-word + (+ rn + (if (= signed 1) + (signed-extend (word-width rm) (lshift rm (* shift scale))) + (unsigned-extend (word-width rm) (lshift rm (* shift scale))))) + rt)) + +(defun STRWroX (rt rn rm option shift) (STR*ro* 2 rt rn rm option shift)) +(defun STRWroW (rt rn rm option shift) (STR*ro* 2 rt rn rm option shift)) +(defun STRXroX (rt rn rm option shift) (STR*ro* 3 rt rn rm option shift)) +(defun STRXroW (rt rn rm option shift) (STR*ro* 3 rt rn rm option shift)) -; rm is an X register -(defun STRWroX (rt rn rm option shift) - (str-reg 2 rt rn rm option shift)) - -(defun STRXroX (rt rn rm option shift) - (str-reg 3 rt rn rm option shift)) - -(defun STRBroX (rt rn rm option shift) - (str-reg 0 rt rn rm option shift)) - -(defun STRHroX (rt rn rm option shift) - (str-reg 1 (cast-low 16 rt) rn rm option shift)) - -(defun STRSroX (rt rn rm option shift) - (str-reg 2 rt rn rm option shift)) - -(defun STRDroX (rt rn rm option shift) - (str-reg 3 rt rn rm option shift)) - -(defun STRQroX (rt rn rm option shift) - (str-reg 4 rt rn rm option shift)) - -; rm is a W register -(defun STRWroW (rt rn rm option shift) - (str-reg 2 rt rn rm option shift)) - -(defun STRXroW (rt rn rm option shift) - (str-reg 3 rt rn rm option shift)) - -(defun STRBroW (rt rn rm option shift) - (str-reg 0 rt rn rm option shift)) - -(defun STRHroW (rt rn rm option shift) - (str-reg 1 (cast-low 16 rt) rn rm option shift)) - -(defun STRSroW (rt rn rm option shift) - (str-reg 2 rt rn rm option shift)) - -(defun STRDroW (rt rn rm option shift) - (str-reg 3 rt rn rm option shift)) - -(defun STRQroW (rt rn rm option shift) - (str-reg 4 rt rn rm option shift)) - -; STRHHroX (defun STRHHroX (rt rn rm option shift) - (str-reg 1 (cast-low 16 rt) rn rm option shift)) + (STR*ro* 1 (cast-low 16 rt) rn rm option shift)) ; STR (immediate) (base registers): (defun str-post (xreg src off) @@ -341,22 +302,6 @@ (defun STRXpost (_ rt rn simm) (str-post rn rt simm)) -; STR (SIMD registers) -(defun STRQpost (_ rt rn simm) - (str-post rn rt simm)) - -(defun STRDpost (_ rt rn simm) - (str-post rn rt simm)) - -(defun STRSpost (_ rt rn simm) - (str-post rn (cast-low 32 rt) simm)) - -(defun STRHpost (_ rt rn simm) - (str-post rn (cast-low 16 rt) simm)) - -(defun STRBpost (_ rt rn simm) - (str-post rn (cast-low 8 rt) simm)) - (defun str-pre (xreg src off) "stores all of src to xreg, and pre-indexes reg (reg += off)." (store-word (+ xreg off) src) @@ -368,45 +313,14 @@ (defun STRXpre (_ rt rn simm) (str-pre rn rt simm)) -; STR (SIMD registers) -(defun STRQpre (_ rt rn simm) - (str-pre rn rt simm)) - -(defun STRDpre (_ rt rn simm) - (str-pre rn rt simm)) - -(defun STRSpre (_ rt rn simm) - (str-pre rn (cast-low 32 rt) simm)) - -(defun STRHpre (_ rt rn simm) - (str-pre rn (cast-low 16 rt) simm)) - -(defun STRBpre (_ rt rn simm) - (str-pre rn (cast-low 8 rt) simm)) - (defun STR*ui (scale src reg off) "Stores a register of size (8 << scale) to the memory address (reg + (off << scale))." (assert-msg (= (word-width src) (lshift 8 scale)) - "(aarch64-data-movement.lisp:STR*ui) scale must match size of register") + "STR*ui: scale must match size of register") (store-word (+ reg (lshift off scale)) (cast-unsigned (lshift 8 scale) src))) -(defun STRQui (src reg off) - (STR*ui 4 src reg off)) - -(defun STRDui (src reg off) - (STR*ui 3 src reg off)) - -(defun STRSui (src reg off) - (STR*ui 2 src reg off)) - -(defun STRHui (src reg off) - (STR*ui 1 src reg off)) - -(defun STRBui (src reg off) - (STR*ui 0 src reg off)) - (defun STRXui (src reg off) (STR*ui 3 src reg off)) @@ -440,79 +354,16 @@ (unsigned-extend 64 rm)))) ; LSL (store-byte (+ rn off) rt))) - ; STP -(defun store-pair (scale indexing t1 t2 dst imm) - "store the pair t1,t2 of size (8 << scale) at the register dst plus an offset, - using the specified indexing." - (assert-msg (and (= (word-width t1) (lshift 8 scale)) - (= (word-width t2) (lshift 8 scale))) - "(aarch64-data-movement.lisp) scale must match size of register ") - (let ((off (lshift (cast-signed 64 imm) scale)) (datasize (lshift 8 scale)) - (addr (case indexing - 'post dst - 'pre (+ dst off) - 'offset (+ dst off) - (assert-msg (= 1 0) - "(aarch64-data-movement.lisp) invalid indexing scheme."))) - ) - (store-word addr t1) - (store-word (+ addr (/ datasize 8)) t2) - (case indexing - 'post (set$ dst (+ addr off)) - 'pre (set$ dst addr) - 'offset ) - )) - -; post-indexed -(defun STPWpost (_ t1 t2 dst off) - (store-pair 2 'post t1 t2 dst off)) - -(defun STPXpost (_ t1 t2 dst off) - (store-pair 3 'post t1 t2 dst off)) - -(defun STPSpost (_ t1 t2 dst off) - (store-pair 2 'post t1 t2 dst off)) - -(defun STPDpost (_ t1 t2 dst off) - (store-pair 3 'post t1 t2 dst off)) - -(defun STPQpost (_ t1 t2 dst off) - (store-pair 4 'post t1 t2 dst off)) - -; pre-indexed -(defun STPXpre (_ t1 t2 dst off) - (store-pair 3 'pre t1 t2 dst off)) +(defun STPWpost (_ t1 t2 dst off) (store-pair 2 'post t1 t2 dst off)) +(defun STPXpost (_ t1 t2 dst off) (store-pair 3 'post t1 t2 dst off)) -(defun STPWpre (_ t1 t2 dst off) - (store-pair 2 'pre t1 t2 dst off)) - -(defun STPSpre (_ t1 t2 dst off) - (store-pair 2 'pre t1 t2 dst off)) - -(defun STPDpre (_ t1 t2 dst off) - (store-pair 3 'pre t1 t2 dst off)) - -(defun STPQpre (_ t1 t2 dst off) - (store-pair 4 'pre t1 t2 dst off)) - -; signed-offset -(defun STPWi (rt rt2 base imm) - (store-pair 2 'offset rt rt2 base imm)) - -(defun STPXi (rt rt2 base imm) - (store-pair 3 'offset rt rt2 base imm)) - -(defun STPSi (rt rt2 base imm) - (store-pair 2 'offset rt rt2 base imm)) - -(defun STPDi (rt rt2 base imm) - (store-pair 3 'offset rt rt2 base imm)) - -(defun STPQi (rt rt2 base imm) - (store-pair 4 'offset rt rt2 base imm)) +(defun STPXpre (_ t1 t2 dst off) (store-pair 3 'pre t1 t2 dst off)) +(defun STPWpre (_ t1 t2 dst off) (store-pair 2 'pre t1 t2 dst off)) +(defun STPWi (rt rt2 base imm) (store-pair 2 'offset rt rt2 base imm)) +(defun STPXi (rt rt2 base imm) (store-pair 3 'offset rt rt2 base imm)) ; addr + offset indexed STUR (defmacro STUR*i (src base off size) @@ -520,17 +371,10 @@ (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 STURHHi (src base off) (STUR*i src base off 16)) (defun STURBBi (src base off) (STUR*i src base off 8)) -(defun STURDi (rn rt imm) (STUR*i rn rt imm 64)) - -(defun STURQi (rn rt imm) (STUR*i rn rt imm 128)) - ; EXTR diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index 42443bee6..27fa576da 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -288,3 +288,25 @@ 'W24_W25 (endian concat W24 W25) 'W26_W27 (endian concat W26 W27) 'W28_W29 (endian concat W28 W29))) + +(defun store-pair (scale indexing t1 t2 dst imm) + "(store-pair scale indexing t1 t2 dst imm) + stores the pair t1,t2 of size (8 << scale) at the register dst plus an offset, + using the specified indexing (either 'post, 'pre or 'offset)." + (assert-msg (= (word-width t1) (word-width t2) (lshift 8 scale)) + "store-pair: scale must match size of register ") + (let ((off (lshift (cast-signed 64 imm) scale)) + (datasize (lshift 8 scale)) + (addr + (case indexing + 'post dst + 'pre (+ dst off) + 'offset (+ dst off) + (assert-msg false "store-pair invalid indexing scheme")))) + (store-word addr t1) + (store-word (+ addr (/ datasize 8)) t2) + (case indexing + 'post (set$ dst (+ addr off)) + 'pre (set$ dst addr) + 'offset ) + )) diff --git a/plugins/arm/semantics/simd/aarch64-simd-load.lisp b/plugins/arm/semantics/simd/aarch64-simd-load.lisp index 4fc5e797f..0a0b0e5c2 100644 --- a/plugins/arm/semantics/simd/aarch64-simd-load.lisp +++ b/plugins/arm/semantics/simd/aarch64-simd-load.lisp @@ -1,6 +1,6 @@ (declare (context (target armv8-a+le))) -(in-package aarch64) +(in-package aarch64-simd) ;;; LDs.. diff --git a/plugins/arm/semantics/simd/aarch64-simd-store.lisp b/plugins/arm/semantics/simd/aarch64-simd-store.lisp new file mode 100644 index 000000000..7c2c3c0f4 --- /dev/null +++ b/plugins/arm/semantics/simd/aarch64-simd-store.lisp @@ -0,0 +1,92 @@ +(declare (context (target armv8-a+le))) + +(in-package aarch64-simd) + +;;; STR + +(defun STR.ro* (scale rt rn rm signed shift) + "stores rt to (rn + rm << (shift * scale)) with signed or unsigned extension + of rm, where rt is a register of size (8 << scale). Note that rm can be an X + or W register and it chooses the appropriate extend mode implicitly. rn must + be an X register." + (assert (< signed 2)) + (assert-msg (= (word-width rt) (lshift 8 scale)) + "STR.ro*: scale must match size of rt") + (store-word + (+ rn + (if (= signed 1) + (signed-extend (word-width rm) (lshift rm (* shift scale))) + (unsigned-extend (word-width rm) (lshift rm (* shift scale))))) + rt)) + +;; no differences in X or W address variants +(defun STRBroX (rt rn rm option shift) (STR.ro* 0 rt rn rm option shift)) +(defun STRBroW (rt rn rm option shift) (STR.ro* 0 rt rn rm option shift)) +(defun STRHroX (rt rn rm option shift) (STR.ro* 1 (cast-low 16 rt) rn rm option shift)) +(defun STRHroW (rt rn rm option shift) (STR.ro* 1 (cast-low 16 rt) rn rm option shift)) +(defun STRSroX (rt rn rm option shift) (STR.ro* 2 rt rn rm option shift)) +(defun STRSroW (rt rn rm option shift) (STR.ro* 2 rt rn rm option shift)) +(defun STRDroX (rt rn rm option shift) (STR.ro* 3 rt rn rm option shift)) +(defun STRDroW (rt rn rm option shift) (STR.ro* 3 rt rn rm option shift)) +(defun STRQroX (rt rn rm option shift) (STR.ro* 4 rt rn rm option shift)) +(defun STRQroW (rt rn rm option shift) (STR.ro* 4 rt rn rm option shift)) + +(defun STR.post (xreg src off) + "stores all of src to xreg, and post-indexes reg (reg += off)." + (store-word xreg src) + (set$ xreg (+ xreg off))) + +(defun STRQpost (_ rt rn simm) (STR.post rn rt simm)) +(defun STRDpost (_ rt rn simm) (STR.post rn rt simm)) +(defun STRSpost (_ rt rn simm) (STR.post rn (cast-low 32 rt) simm)) +(defun STRHpost (_ rt rn simm) (STR.post rn (cast-low 16 rt) simm)) +(defun STRBpost (_ rt rn simm) (STR.post rn (cast-low 8 rt) simm)) + +(defun STR.pre (xreg src off) + "stores all of src to xreg, and pre-indexes reg (reg += off)." + (store-word (+ xreg off) src) + (set$ xreg (+ xreg off))) + +(defun STRQpre (_ rt rn simm) (STR.pre rn rt simm)) +(defun STRDpre (_ rt rn simm) (STR.pre rn rt simm)) +(defun STRSpre (_ rt rn simm) (STR.pre rn (cast-low 32 rt) simm)) +(defun STRHpre (_ rt rn simm) (STR.pre rn (cast-low 16 rt) simm)) +(defun STRBpre (_ rt rn simm) (STR.pre rn (cast-low 8 rt) simm)) + +(defun STR.ui (scale src reg off) + "Stores a register of size (8 << scale) to the memory address + (reg + (off << scale))." + (assert-msg (= (word-width src) (lshift 8 scale)) + "STR.ui: scale must match size of register") + (store-word (+ reg (lshift off scale)) + (cast-unsigned (lshift 8 scale) src))) + +(defun STRQui (src reg off) (STR*ui 4 src reg off)) +(defun STRDui (src reg off) (STR*ui 3 src reg off)) +(defun STRSui (src reg off) (STR*ui 2 src reg off)) +(defun STRHui (src reg off) (STR*ui 1 src reg off)) +(defun STRBui (src reg off) (STR*ui 0 src reg off)) + +;;; STP + +;; these use store-pair from aarch64-helper.lisp + +(defun STPQpost (_ t1 t2 dst off) (store-pair 4 'post t1 t2 dst off)) +(defun STPDpost (_ t1 t2 dst off) (store-pair 3 'post t1 t2 dst off)) +(defun STPSpost (_ t1 t2 dst off) (store-pair 2 'post t1 t2 dst off)) + +(defun STPQpre (_ t1 t2 dst off) (store-pair 4 'pre t1 t2 dst off)) +(defun STPDpre (_ t1 t2 dst off) (store-pair 3 'pre t1 t2 dst off)) +(defun STPSpre (_ t1 t2 dst off) (store-pair 2 'pre t1 t2 dst off)) + +(defun STPQi (rt rt2 base imm) (store-pair 4 'offset rt rt2 base imm)) +(defun STPDi (rt rt2 base imm) (store-pair 3 'offset rt rt2 base imm)) +(defun STPSi (rt rt2 base imm) (store-pair 2 'offset rt rt2 base imm)) + +;;; STUR +(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 STURQi (rn rt imm) (STUR.i rn rt imm 128)) +(defun STURDi (rn rt imm) (STUR.i rn rt imm 64)) \ No newline at end of file diff --git a/plugins/arm/semantics/simd/aarch64-simd.lisp b/plugins/arm/semantics/simd/aarch64-simd.lisp index ffc2c905b..655a78d4e 100644 --- a/plugins/arm/semantics/simd/aarch64-simd.lisp +++ b/plugins/arm/semantics/simd/aarch64-simd.lisp @@ -7,4 +7,5 @@ (require aarch64-simd-arithmetic) (require aarch64-simd-load) (require aarch64-simd-logical) -(require aarch64-simd-mov-ins-ext) \ No newline at end of file +(require aarch64-simd-mov-ins-ext) +(require aarch64-simd-store) \ No newline at end of file From 698d7ebbacdbd03c90801cd24201ed4559f2ee2a Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Wed, 27 Jul 2022 07:18:05 +0000 Subject: [PATCH 113/132] remove simd folder which doesn't get read by bap packages form a flat namespace (and seem to need a flat file hierarchy as well) we'll just use the aarch64-simd- prefix as a replacement for folders --- .../semantics/{simd => }/aarch64-simd-arithmetic.lisp | 2 +- .../arm/semantics/{simd => }/aarch64-simd-load.lisp | 2 +- .../semantics/{simd => }/aarch64-simd-logical.lisp | 2 +- .../{simd => }/aarch64-simd-mov-ins-ext.lisp | 2 +- .../arm/semantics/{simd => }/aarch64-simd-store.lisp | 2 +- plugins/arm/semantics/aarch64.lisp | 11 +++++++++-- plugins/arm/semantics/simd/aarch64-simd.lisp | 11 ----------- 7 files changed, 14 insertions(+), 18 deletions(-) rename plugins/arm/semantics/{simd => }/aarch64-simd-arithmetic.lisp (99%) rename plugins/arm/semantics/{simd => }/aarch64-simd-load.lisp (99%) rename plugins/arm/semantics/{simd => }/aarch64-simd-logical.lisp (97%) rename plugins/arm/semantics/{simd => }/aarch64-simd-mov-ins-ext.lisp (98%) rename plugins/arm/semantics/{simd => }/aarch64-simd-store.lisp (99%) delete mode 100644 plugins/arm/semantics/simd/aarch64-simd.lisp diff --git a/plugins/arm/semantics/simd/aarch64-simd-arithmetic.lisp b/plugins/arm/semantics/aarch64-simd-arithmetic.lisp similarity index 99% rename from plugins/arm/semantics/simd/aarch64-simd-arithmetic.lisp rename to plugins/arm/semantics/aarch64-simd-arithmetic.lisp index b798cdce6..7320c702f 100644 --- a/plugins/arm/semantics/simd/aarch64-simd-arithmetic.lisp +++ b/plugins/arm/semantics/aarch64-simd-arithmetic.lisp @@ -1,6 +1,6 @@ (declare (context (target armv8-a+le))) -(in-package aarch64-simd) +(in-package aarch64) (defun sym-to-binop (binop-sym x y) (case binop-sym diff --git a/plugins/arm/semantics/simd/aarch64-simd-load.lisp b/plugins/arm/semantics/aarch64-simd-load.lisp similarity index 99% rename from plugins/arm/semantics/simd/aarch64-simd-load.lisp rename to plugins/arm/semantics/aarch64-simd-load.lisp index 0a0b0e5c2..4fc5e797f 100644 --- a/plugins/arm/semantics/simd/aarch64-simd-load.lisp +++ b/plugins/arm/semantics/aarch64-simd-load.lisp @@ -1,6 +1,6 @@ (declare (context (target armv8-a+le))) -(in-package aarch64-simd) +(in-package aarch64) ;;; LDs.. diff --git a/plugins/arm/semantics/simd/aarch64-simd-logical.lisp b/plugins/arm/semantics/aarch64-simd-logical.lisp similarity index 97% rename from plugins/arm/semantics/simd/aarch64-simd-logical.lisp rename to plugins/arm/semantics/aarch64-simd-logical.lisp index b89e6bd60..b1905ec0a 100644 --- a/plugins/arm/semantics/simd/aarch64-simd-logical.lisp +++ b/plugins/arm/semantics/aarch64-simd-logical.lisp @@ -1,6 +1,6 @@ (declare (context (target armv8-a+le))) -(in-package aarch64-simd) +(in-package aarch64) ;;; LOGICAL diff --git a/plugins/arm/semantics/simd/aarch64-simd-mov-ins-ext.lisp b/plugins/arm/semantics/aarch64-simd-mov-ins-ext.lisp similarity index 98% rename from plugins/arm/semantics/simd/aarch64-simd-mov-ins-ext.lisp rename to plugins/arm/semantics/aarch64-simd-mov-ins-ext.lisp index 52390dbf7..8d27622d1 100644 --- a/plugins/arm/semantics/simd/aarch64-simd-mov-ins-ext.lisp +++ b/plugins/arm/semantics/aarch64-simd-mov-ins-ext.lisp @@ -1,6 +1,6 @@ (declare (context (target armv8-a+le))) -(in-package aarch64-simd) +(in-package aarch64) ;;; INS diff --git a/plugins/arm/semantics/simd/aarch64-simd-store.lisp b/plugins/arm/semantics/aarch64-simd-store.lisp similarity index 99% rename from plugins/arm/semantics/simd/aarch64-simd-store.lisp rename to plugins/arm/semantics/aarch64-simd-store.lisp index 7c2c3c0f4..4eb08a7fb 100644 --- a/plugins/arm/semantics/simd/aarch64-simd-store.lisp +++ b/plugins/arm/semantics/aarch64-simd-store.lisp @@ -1,6 +1,6 @@ (declare (context (target armv8-a+le))) -(in-package aarch64-simd) +(in-package aarch64) ;;; STR diff --git a/plugins/arm/semantics/aarch64.lisp b/plugins/arm/semantics/aarch64.lisp index 5037c3f20..49882b145 100644 --- a/plugins/arm/semantics/aarch64.lisp +++ b/plugins/arm/semantics/aarch64.lisp @@ -1,6 +1,6 @@ (declare (context (target arm armv8-a+le))) -(defpackage aarch64 (:use core target arm aarch64-simd)) +(defpackage aarch64 (:use core target arm)) (defpackage llvm-aarch64 (:use aarch64)) (in-package aarch64) @@ -15,6 +15,13 @@ (require aarch64-arithmetic) (require aarch64-atomic) (require aarch64-branch) -(require aarch64-logical) (require aarch64-data-movement) +(require aarch64-logical) +(require aarch64-pstate) (require aarch64-special) + +(require aarch64-simd-arithmetic) +(require aarch64-simd-load) +(require aarch64-simd-logical) +(require aarch64-simd-mov-ins-ext) +(require aarch64-simd-store) diff --git a/plugins/arm/semantics/simd/aarch64-simd.lisp b/plugins/arm/semantics/simd/aarch64-simd.lisp deleted file mode 100644 index 655a78d4e..000000000 --- a/plugins/arm/semantics/simd/aarch64-simd.lisp +++ /dev/null @@ -1,11 +0,0 @@ -(declare (context (target arm armv8-a+le))) - -(defpackage aarch64-simd (:use aarch64)) - -(in-package aarch64-simd) - -(require aarch64-simd-arithmetic) -(require aarch64-simd-load) -(require aarch64-simd-logical) -(require aarch64-simd-mov-ins-ext) -(require aarch64-simd-store) \ No newline at end of file From 96dc059152f2efbe7239c60f4e708692f2ab8263 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Wed, 27 Jul 2022 07:23:38 +0000 Subject: [PATCH 114/132] finish STUR.i instructions --- plugins/arm/semantics/aarch64-simd-store.lisp | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/plugins/arm/semantics/aarch64-simd-store.lisp b/plugins/arm/semantics/aarch64-simd-store.lisp index 4eb08a7fb..0396dd291 100644 --- a/plugins/arm/semantics/aarch64-simd-store.lisp +++ b/plugins/arm/semantics/aarch64-simd-store.lisp @@ -84,9 +84,9 @@ (defun STPSi (rt rt2 base imm) (store-pair 2 'offset rt rt2 base imm)) ;;; STUR -(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 STURQi (rn rt imm) (STUR.i rn rt imm 128)) -(defun STURDi (rn rt imm) (STUR.i rn rt imm 64)) \ No newline at end of file +(defun STURQi (rn rt imm) (store-word (+ rt imm) rn)) +(defun STURDi (rn rt imm) (store-word (+ rt imm) rn)) +(defun STURSi (rn rt imm) (store-word (+ rt imm) rn)) +(defun STURHi (rn rt imm) (store-word (+ rt imm) rn)) +(defun STURBi (rn rt imm) (store-word (+ rt imm) rn)) \ No newline at end of file From a324ed426f8f0b129a9227820a376b56c532b9ae Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Wed, 27 Jul 2022 07:27:59 +0000 Subject: [PATCH 115/132] move reverse-bits and helper to bits.lisp --- plugins/arm/semantics/aarch64-helper.lisp | 8 -------- plugins/primus_lisp/semantics/bits.lisp | 9 +++++++++ 2 files changed, 9 insertions(+), 8 deletions(-) diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index 27fa576da..db0d7a72c 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -9,14 +9,6 @@ (defun word () (word-width)) -(defun _reverse-bits (bits i) - (if (> i 0) - (concat (_reverse-bits bits (- i 1)) (select i bits)) - (select i bits))) - -(defun reverse-bits (bits) - (_reverse-bits bits (- (word-width bits) 1))) - (defun shift-encoded (rm off) "(shift-encoded rm off) decodes the 8-bit shift value into its type and offset, and shifts rm accordingly." diff --git a/plugins/primus_lisp/semantics/bits.lisp b/plugins/primus_lisp/semantics/bits.lisp index a16e75c25..77b17e6f3 100644 --- a/plugins/primus_lisp/semantics/bits.lisp +++ b/plugins/primus_lisp/semantics/bits.lisp @@ -107,6 +107,15 @@ (reverse-in-containers/helper csize esize x (+1 c)) (reverse-in-containers/helper-elem csize esize x (* csize c) 0)))) +(defun reverse-bits (x) + "(reverse-bits x) returns a bitvector with the bit order of x reversed." + (reverse-bits/helper x (-1 (word-width x)))) + +(defun reverse-bits/helper (x i) + (if (> i 0) + (concat (reverse-bits/helper x (-1 i)) (select i x)) + (select i x))) + (defun clz (x) "(clz X) counts leading zeros in X. The returned value is the number of consecutive zeros starting From 40841c3474a5ad6122c59115d71bff3f8cbb59df Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Wed, 27 Jul 2022 07:31:46 +0000 Subject: [PATCH 116/132] add comment to bitvec-to-symbol --- plugins/arm/semantics/aarch64-helper.lisp | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index db0d7a72c..55d9dec23 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -101,13 +101,15 @@ 0b0001 'oshld 'unknown)) -(defun bitvec-to-symbol (bv sym) - (if (> (word-width bv) 0) +(defun bitvec-to-symbol (x sym) + "(bitvec-to-symbol x sym) returns the symbol concatenation of + sym and the hexadecimal representation of x." + (if (> (word-width x) 0) (bitvec-to-symbol - (cast-low (- (word-width bv) 4) bv) + (cast-low (- (word-width x) 4) x) (symbol-concat sym - (case (cast-high 4 bv) + (case (cast-high 4 x) 0x0 '0 0x1 '1 0x2 '2 From e5cf0369e8c6476016c35620a22f504eedd8183c Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Thu, 28 Jul 2022 03:33:08 +0000 Subject: [PATCH 117/132] use nth-reg-in-group in CASPord* except concat will need to find out why primitive doesn't work for concat --- plugins/arm/semantics/aarch64-atomic.lisp | 4 +- plugins/arm/semantics/aarch64-helper.lisp | 72 ----------------------- 2 files changed, 2 insertions(+), 74 deletions(-) diff --git a/plugins/arm/semantics/aarch64-atomic.lisp b/plugins/arm/semantics/aarch64-atomic.lisp index 71d73c6ad..058b238df 100644 --- a/plugins/arm/semantics/aarch64-atomic.lisp +++ b/plugins/arm/semantics/aarch64-atomic.lisp @@ -78,8 +78,8 @@ (when (= data (register-pair-concat rs-pair)) (when release (intrinsic 'store-release)) (store-word rn (register-pair-concat rt-pair))) - (set (register-pair-first rs-pair) (endian first upper lower)) - (set (register-pair-second rs-pair) (endian second upper lower)))) + (set$ (nth-reg-in-group rs-pair 0) (endian first upper lower)) + (set$ (nth-reg-in-group rs-pair 1) (endian second upper lower)))) (defmacro CASPordX (rs-pair rt-pair rn acquire release) "Specialisation of CASPord* for X registers." diff --git a/plugins/arm/semantics/aarch64-helper.lisp b/plugins/arm/semantics/aarch64-helper.lisp index 55d9dec23..9ce913013 100644 --- a/plugins/arm/semantics/aarch64-helper.lisp +++ b/plugins/arm/semantics/aarch64-helper.lisp @@ -175,78 +175,6 @@ 8 (load-word address) 16 (concat (load-word address) (load-word (+ address 8))))) -(defun register-pair-first (r-pair) - "(register-pair-first r-pair) returns the first register in the - register pair Xi_X(i+1) or similar, returned by LLVM. - This is used in specific instructions like the CASP family and LD2." - (case (symbol r-pair) - 'X0_X1 'X0 - 'X2_X3 'X2 - 'X4_X5 'X4 - 'X6_X7 'X6 - 'X8_X9 'X8 - 'X10_X11 'X10 - 'X12_X13 'X12 - 'X14_X15 'X14 - 'X16_X17 'X16 - 'X18_X19 'X18 - 'X20_X21 'X20 - 'X22_X23 'X22 - 'X24_X25 'X24 - 'X26_X27 'X26 - 'X28_X29 'X28 - 'W0_W1 'W0 - 'W2_W3 'W2 - 'W4_W5 'W4 - 'W6_W7 'W6 - 'W8_W9 'W8 - 'W10_W11 'W10 - 'W12_W13 'W12 - 'W14_W15 'W14 - 'W16_W17 'W16 - 'W18_W19 'W18 - 'W20_W21 'W20 - 'W22_W23 'W22 - 'W24_W25 'W24 - 'W26_W27 'W26 - 'W28_W29 'W28)) - -(defun register-pair-second (r-pair) - "(register-pair-first r-pair) returns the second register in the - register pair Xi_X(i+1) or similar, returned by LLVM. - This is used in specific instructions like the CASP family and LD2." - (case (symbol r-pair) - 'X0_X1 'X1 - 'X2_X3 'X3 - 'X4_X5 'X5 - 'X6_X7 'X7 - 'X8_X9 'X9 - 'X10_X11 'X11 - 'X12_X13 'X13 - 'X14_X15 'X15 - 'X16_X17 'X17 - 'X18_X19 'X19 - 'X20_X21 'X21 - 'X22_X23 'X23 - 'X24_X25 'X25 - 'X26_X27 'X27 - 'X28_X29 'X29 - 'W0_W1 'W1 - 'W2_W3 'W3 - 'W4_W5 'W5 - 'W6_W7 'W7 - 'W8_W9 'W9 - 'W10_W11 'W11 - 'W12_W13 'W13 - 'W14_W15 'W15 - 'W16_W17 'W17 - 'W18_W19 'W19 - 'W20_W21 'W21 - 'W22_W23 'W23 - 'W24_W25 'W25 - 'W26_W27 'W27 - 'W28_W29 'W29)) - (defun register-pair-concat (r-pair) "(register-pair-concat r-pair) returns the concatenated values of the register pair returned by LLVM, taking into account From 328914e2f5b8b14272b73abd035d6eee37615a87 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Fri, 29 Jul 2022 06:58:03 +0000 Subject: [PATCH 118/132] Fix bug in REVnWr implementation function overloads are not nice sometimes --- plugins/primus_lisp/semantics/bits.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/primus_lisp/semantics/bits.lisp b/plugins/primus_lisp/semantics/bits.lisp index 77b17e6f3..eda8a0135 100644 --- a/plugins/primus_lisp/semantics/bits.lisp +++ b/plugins/primus_lisp/semantics/bits.lisp @@ -101,7 +101,7 @@ "Maps reverse-in-containers/helper-elem over all containers and concatenates the results." (declare (visibility :private)) - (if (= c (-1 (/ (word-width) csize))) + (if (= c (-1 (/ (word-width x) csize))) (reverse-in-containers/helper-elem csize esize x (* csize c) 0) (concat (reverse-in-containers/helper csize esize x (+1 c)) From 3a007ab61a33952250de8031cea0ad4363ada325 Mon Sep 17 00:00:00 2001 From: DukMastaaa <64053792+DukMastaaa@users.noreply.github.com> Date: Fri, 29 Jul 2022 08:20:16 +0000 Subject: [PATCH 119/132] fix comment length and LLVM code for BIC --- plugins/arm/semantics/aarch64-logical.lisp | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/plugins/arm/semantics/aarch64-logical.lisp b/plugins/arm/semantics/aarch64-logical.lisp index 7969c8552..3ab6ed6a2 100644 --- a/plugins/arm/semantics/aarch64-logical.lisp +++ b/plugins/arm/semantics/aarch64-logical.lisp @@ -42,13 +42,15 @@ ;; Logical ANDS (flags set) (defmacro ANDS*r* (setf rd rn immOp) - "(ANDS*r* set rd rn immOp) implements the logical AND operation on either an X or W register with immediate/shifted immediate and sets the N, V, Z, C flags based on the result." + "(ANDS*r* set rd rn immOp) implements the logical AND operation on either an X or W register + with immediate/shifted immediate and sets the N, V, Z, C flags based on the result." (let ((result (logand rn immOp))) (set-nzcv-after-logic-op result) (setf rd result))) (defmacro ANDS*ri (setf size rd rn imm) - "(ANDS*ri set rd rn imm) implements the logical AND operation on either an X or W register with immediate and sets the N, V, Z, C flags based on the result." + "(ANDS*ri set rd rn imm) implements the logical AND operation on either an X or W register + with immediate and sets the N, V, Z, C flags based on the result." (let ((immOp (immediate-from-bitmask imm size))) (ANDS*r* setf rd rn immOp))) @@ -56,7 +58,8 @@ (defun ANDSXri (rd rn imm) (ANDS*ri set$ 64 rd rn imm)) (defmacro ANDS*rs (setf rd rn rm is) - "(ANDS*rs set rd rn imm) implements the logical AND operation on either an X or W register with shifted immediate and sets the N, V, Z, C flags based on the result." + "(ANDS*rs set rd rn imm) implements the logical AND operation on either an X or W register + with shifted immediate and sets the N, V, Z, C flags based on the result." (let ((immOp (shift-encoded rm is))) (ANDS*r* setf rd rn immOp))) @@ -66,18 +69,19 @@ ;; BIC -;; assumes immediate always provided... must fix... -(defmacro BIC*r (setr rd rn rm is) - "(BIC*r setr rd rn rm) stores the result of a logical and of rn with the complement of the contents of optionally shifted rm in rd" +(defmacro BIC*rs (setr rd rn rm is) + "(BIC*r setr rd rn rm) stores the result of a logical and of rn with the complement of + the contents of optionally shifted rm in rd" (let ((shift (shift-encoded rm is)) (comp (lnot shift))) (setr rd (logand rn comp)))) -(defun BICWr (rd rn rm is) (BIC*r setw rd rn rm is)) -(defun BICXr (rd rn rm is) (BIC*r set$ rd rn rm is)) +(defun BICWrs (rd rn rm is) (BIC*rs setw rd rn rm is)) +(defun BICXrs (rd rn rm is) (BIC*rs set$ rd rn rm is)) (defmacro BICS*rs (setr rd rn rm is) - "(BICS*r setr rd rn rm) sets appropriate flags and stores the result of a logical and of rn with the complement of the contents of optionally shifted rm in rd" + "(BICS*r setr rd rn rm) sets appropriate flags and stores the result of a logical and of rn + with the complement of the contents of optionally shifted rm in rd" (let ((shift (shift-encoded rm is)) (comp (lnot shift)) (result (logand rn comp))) From 92c68b0749b4e66d536969f2f81949efbe97563f Mon Sep 17 00:00:00 2001 From: Kaitlyn Lake Date: Mon, 1 Aug 2022 07:10:38 +0000 Subject: [PATCH 120/132] Implemented all SIMD load instructions --- plugins/arm/semantics/aarch64-logical.lisp | 26 +-- plugins/arm/semantics/aarch64-simd-load.lisp | 160 +++++++++++++++---- 2 files changed, 143 insertions(+), 43 deletions(-) diff --git a/plugins/arm/semantics/aarch64-logical.lisp b/plugins/arm/semantics/aarch64-logical.lisp index 7969c8552..031ab9e8e 100644 --- a/plugins/arm/semantics/aarch64-logical.lisp +++ b/plugins/arm/semantics/aarch64-logical.lisp @@ -42,13 +42,17 @@ ;; Logical ANDS (flags set) (defmacro ANDS*r* (setf rd rn immOp) - "(ANDS*r* set rd rn immOp) implements the logical AND operation on either an X or W register with immediate/shifted immediate and sets the N, V, Z, C flags based on the result." + "(ANDS*r* set rd rn immOp) implements the logical AND operation on + either an X or W register with immediate/shifted immediate and + sets the N, V, Z, C flags based on the result." (let ((result (logand rn immOp))) (set-nzcv-after-logic-op result) (setf rd result))) (defmacro ANDS*ri (setf size rd rn imm) - "(ANDS*ri set rd rn imm) implements the logical AND operation on either an X or W register with immediate and sets the N, V, Z, C flags based on the result." + "(ANDS*ri set rd rn imm) implements the logical AND operation on + either an X or W register with immediate and sets the N, V, Z, + C flags based on the result." (let ((immOp (immediate-from-bitmask imm size))) (ANDS*r* setf rd rn immOp))) @@ -56,7 +60,9 @@ (defun ANDSXri (rd rn imm) (ANDS*ri set$ 64 rd rn imm)) (defmacro ANDS*rs (setf rd rn rm is) - "(ANDS*rs set rd rn imm) implements the logical AND operation on either an X or W register with shifted immediate and sets the N, V, Z, C flags based on the result." + "(ANDS*rs set rd rn imm) implements the logical AND operation on + either an X or W register with shifted immediate and sets the + N, V, Z, C flags based on the result." (let ((immOp (shift-encoded rm is))) (ANDS*r* setf rd rn immOp))) @@ -66,18 +72,20 @@ ;; BIC -;; assumes immediate always provided... must fix... -(defmacro BIC*r (setr rd rn rm is) - "(BIC*r setr rd rn rm) stores the result of a logical and of rn with the complement of the contents of optionally shifted rm in rd" +(defmacro BIC*rs (setr rd rn rm is) + "(BIC*r setr rd rn rm) stores the result of a logical and of rn with + the complement of the contents of optionally shifted rm in rd" (let ((shift (shift-encoded rm is)) (comp (lnot shift))) (setr rd (logand rn comp)))) -(defun BICWr (rd rn rm is) (BIC*r setw rd rn rm is)) -(defun BICXr (rd rn rm is) (BIC*r set$ rd rn rm is)) +(defun BICWrs (rd rn rm is) (BIC*rs setw rd rn rm is)) +(defun BICXrs (rd rn rm is) (BIC*rs set$ rd rn rm is)) (defmacro BICS*rs (setr rd rn rm is) - "(BICS*r setr rd rn rm) sets appropriate flags and stores the result of a logical and of rn with the complement of the contents of optionally shifted rm in rd" + "(BICS*r setr rd rn rm) sets appropriate flags and stores the + result of a logical and of rn with the complement of the contents of + optionally shifted rm in rd" (let ((shift (shift-encoded rm is)) (comp (lnot shift)) (result (logand rn comp))) diff --git a/plugins/arm/semantics/aarch64-simd-load.lisp b/plugins/arm/semantics/aarch64-simd-load.lisp index 4fc5e797f..691c10a5b 100644 --- a/plugins/arm/semantics/aarch64-simd-load.lisp +++ b/plugins/arm/semantics/aarch64-simd-load.lisp @@ -3,6 +3,9 @@ (in-package aarch64) ;;; LDs.. +;;; NOTE: +;;; encodings do not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), +;;; SetTagCheckedInstruction(), CheckSPAlignment() ;; LD1 (multiple structures, post index, four registers) @@ -128,8 +131,7 @@ (defmacro LD2Twov._POST (va_vb xn xm elems bytes) "(LD2Twov._POST va_vb xn elesms bytes) loads multiple 2-element structures from - memory at address xn with offset xm and stores it in va and vb with de-interleaving. - NOTE: does not encode Security state & Exception level" + memory at address xn with offset xm and stores it in va and vb with de-interleaving." (LD..v._POST 1 elems 2 bytes va_vb xn xm)) ;; LD2 (multiple structures, no offset) @@ -144,8 +146,7 @@ (defmacro LD2Twov. (va_vb xn elems bytes) "(LD2Twov. va_vb xn elesms bytes) loads multiple 2-element structures from - memory at address xn and stores it in va and vb with de-interleaving. - NOTE: does not encode Security state & Exception level" + memory at address xn and stores it in va and vb with de-interleaving." (LD 1 elems 2 xn bytes va_vb)) ;; LD3 (multiple structures, post index) @@ -160,8 +161,7 @@ (defmacro LD3Threev._POST (va_vb_vc xn xm elems bytes) "(LD3Threev._POST va_vb_vc xn xm elems bytes) loads multiple 3-element structures - from memory at address xn with offset xm and stores it in va, vb and vc with de-interleaving. - NOTE: does not encode Security state & Exception level" + from memory at address xn with offset xm and stores it in va, vb and vc with de-interleaving." (LD..v._POST 1 elems 3 bytes va_vb_vc xn xm)) ;; LD3 (multiple structures, no offset) @@ -176,8 +176,7 @@ (defmacro LD3Threev. (va_vb_vc xn elems bytes) "(LD3Threev. va_vb_vc xn elems bytes) loads multiple 3-element structures from - memory at address xn and stores it in va, vb and vc with de-interleaving. - NOTE: does not encode Security state & Exception level" + memory at address xn and stores it in va, vb and vc with de-interleaving." (LD 1 elems 3 xn bytes va_vb_vc)) ;; LD4 (multiple structures, post index) @@ -192,8 +191,7 @@ (defmacro LD4Fourv._POST (va_vb_vc xn xm elems bytes) "(LD4Fourv._POST va_vb_vc xn xm elems bytes) loads multiple 4-element structures - from memory at address xn with offset xm and stores it in va, vb, vc and vd with de-interleaving. - NOTE: does not encode Security state & Exception level" + from memory at address xn with offset xm and stores it in va, vb, vc and vd with de-interleaving." (LD..v._POST 1 elems 4 bytes va_vb_vc xn xm)) ;; LD4 (multiple structures, no offset) @@ -208,8 +206,7 @@ (defmacro LD4Fourv. (va_vb_vc xn elems bytes) "(LD4Fourv. va_vb_vc xn elems bytes) loads multiple 4-element structures from memory - at address xn and stores it in va, vb, vc and vd with de-interleaving. - NOTE: does not encode Security state & Exception level" + at address xn and stores it in va, vb, vc and vd with de-interleaving." (LD 1 elems 4 xn bytes va_vb_vc)) ;; LD multiple struct algorithm @@ -506,29 +503,110 @@ (defun LD4Rv1d_POST (_ va_vb_vc_vd xn xm) (LD4Rv._POST va_vb_vc_vd xn 64 64 xm)) (defun LD4Rv2d_POST (_ va_vb_vc_vd xn xm) (LD4Rv._POST va_vb_vc_vd xn 64 128 xm)) -;; LDP (signed offset) +;; load register pair -(defmacro LDP.i (vn vm base imm size scale) +(defun load-register-pair (vn vm base imm size scale) + "(load-register-pair vn vm base imm size scale) loads a pair of registers + from memory with an optional offset and immediate decoding." + (let ((off (lshift (cast-signed 64 imm) scale)) + (dbytes (/ size 8))) + (set$ vn (mem-read (+ base off) dbytes)) + (set$ vm (mem-read (+ base off dbytes) dbytes)))) + +;; LDNP + +(defmacro LDNP.i (vn vm base imm size) + "(LDNP.i vn vm base imm) loads a pair of SIMD&FP registers from memory at + at address base with optional offset imm and stores them in vn and vm. + Issues a non-temporal hint." + (prog + (intrinsic 'non-temporal-hint base) + (load-register-pair vn vm base imm size 0))) + +(defun LDNPSi (sn sm base imm) (LDNP.i sn sm base imm 32)) +(defun LDNPDi (dn dm base imm) (LDNP.i dn dm base imm 64)) +(defun LDNPQi (qn qm base imm) (LDNP.i qn qm base imm 128)) + +;; LDP (pre-index) + +(defmacro LDP.pre (vn vm base imm size scale) + "(LDP.i qn qm imm size mem-load scale) loads a pair of SIMD&FP registers from + memory using the address base and an optional signed immediate offset." + (let ((off (lshift (cast-signed 64 imm) scale)) + (dbytes (/ size 8)) + (addr (+ base off))) + (set$ vn (mem-read addr (/ size 8))) + (set$ vm (mem-read (+ addr dbytes) (/ size 8))) + (set$ base addr))) + +(defun LDPQpre (_ qn qm base imm) (LDP.pre qn qm base imm 128 4)) +(defun LDPDpre (_ qn qm base imm) (LDP.pre qn qm base imm 64 3)) +(defun LDPSpre (_ qn qm base imm) (LDP.pre qn qm base imm 32 2)) + +;; LDP (post-index) + +(defmacro LDP.post (vn vm base imm size scale) "(LDP.i qn qm imm size mem-load scale) loads a pair of SIMD&FP registers from - memory using the address base and an optional signed immediate offset. NOTE: - does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), - CheckSPAlignment(), Mem[... AccType_VEC]" + memory using the address base and an optional signed immediate offset." (let ((off (lshift (cast-signed 64 imm) scale)) (dbytes (/ size 8))) - (set$ vn (mem-read (+ base off) (/ size 8))) - (set$ vm (mem-read (+ base off dbytes) (/ size 8))))) + (set$ vn (mem-read base (/ size 8))) + (set$ vm (mem-read (+ base dbytes) (/ size 8))) + (set$ base (+ base off)))) + +(defun LDPQpost (_ qn qm base imm) (LDP.post qn qm base imm 128 4)) +(defun LDPDpost (_ qn qm base imm) (LDP.post qn qm base imm 64 3)) +(defun LDPSpost (_ qn qm base imm) (LDP.post qn qm base imm 32 2)) + +;; LDP (signed offset) + +(defmacro LDP.i (vn vm base imm size scale) + "(LDP.i qn qm imm size mem-load scale) loads a pair of SIMD&FP registers from + memory using the address base and an optional signed immediate offset." + (load-register-pair vn vm base imm size scale)) (defun LDPQi (qn qm base imm) (LDP.i qn qm base imm 128 4)) (defun LDPDi (qn qm base imm) (LDP.i qn qm base imm 64 3)) (defun LDPSi (qn qm base imm) (LDP.i qn qm base imm 32 2)) +;; LDR (immediate, post-index) + +(defmacro LDR.post (vt base off size) + "(LDR.post vt base imm mem-load scale) loads an element from memory from + the post-index base address and unsigned immediate offset off and stores the result + in vt." + (prog + (set$ vt (mem-read base (/ size 8))) + (set$ base (+ base off)))) + +(defun LDRBpost (_ bt base imm) (LDR.post bt base imm 8)) +(defun LDRHpost (_ ht base imm) (LDR.post ht base imm 16)) +(defun LDRSpost (_ st base imm) (LDR.post st base imm 32)) +(defun LDRDpost (_ dt base imm) (LDR.post dt base imm 64)) +(defun LDRQpost (_ qt base imm) (LDR.post qt base imm 128)) + +;; LDR (immediate, pre-index) + +(defmacro LDR.pre (vt base off size) + "(LDR.ui vt base imm mem-load scale) loads an element from memory from + the pre-index base address and unsigned immediate offset off and stores the result + in vt." + (let ((addr (+ base off))) + (set$ vt (mem-read addr (/ size 8))) + (set$ base addr))) + +(defun LDRBpre (_ bt base imm) (LDR.pre bt base imm 8)) +(defun LDRHpre (_ ht base imm) (LDR.pre ht base imm 16)) +(defun LDRSpre (_ st base imm) (LDR.pre st base imm 32)) +(defun LDRDpre (_ dt base imm) (LDR.pre dt base imm 64)) +(defun LDRQpre (_ qt base imm) (LDR.pre qt base imm 128)) + ;; LDR (immediate, unsigned offset) (defmacro LDR.ui (vt base imm size scale) "(LDR.ui vt base imm mem-load scale) loads an element from memory from the base address and unsigned immediate offset imm and stores the result - in vt. NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), - SetTagCheckedInstruction(), CheckSPAlignment(), Mem[... AccType_VEC]" + in vt." (let ((off (lshift (cast-unsigned 64 imm) scale))) (set$ vt (mem-read (+ base off) (/ size 8))))) @@ -538,13 +616,23 @@ (defun LDRDui (dt base imm) (LDR.ui dt base imm 64 3)) (defun LDRQui (qt base imm) (LDR.ui qt base imm 128 4)) +;; LDR (literal) + +(defmacro LDR.l (vn label bytes) + "(LDR.l vn label bytes) loads a register from memory at an address + relative to the program counter and a program label." + (let ((off (cast-signed 64 (lshift label 2)))) + (set$ vn (mem-read (+ off (get-program-counter)) bytes)))) + +(defun LDRSl (sn label) (LDR.l sn label 4)) +(defun LDRDl (dn label) (LDR.l dn label 8)) +(defun LDRQl (qn label) (LDR.l qn label 16)) + ;; LDR (register) -(defmacro LDR.roX (vt base index signed s scale size) - "(LDR.roX vt base index signed s scale mem-load) loads a SIMD&FP register - from address base and an optionally shifted and extended index. NOTE: - does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), - CheckSPAlignment(), Mem[... AccType_VEC]" +(defmacro LDR.ro. (vt base index signed s scale size) + "(LDR.ro. vt base index signed s scale mem-load) loads a SIMD&FP register + from address base and an optionally shifted and extended index." (let ((shift (if (= s 1) (+ scale 0) (+ 0 0))) @@ -553,19 +641,23 @@ (cast-unsigned 64 (lshift index shift))))) (set$ vt (mem-read (+ base off) (/ size 8))))) -(defun LDRBroX (bt base index signed s) (LDR.roX bt base index signed s 0 8)) -(defun LDRHroX (ht base index signed s) (LDR.roX ht base index signed s 1 16)) -(defun LDRSroX (st base index signed s) (LDR.roX st base index signed s 2 32)) -(defun LDRDroX (dt base index signed s) (LDR.roX dt base index signed s 3 64)) -(defun LDRQroX (qt base index signed s) (LDR.roX qt base index signed s 4 128)) +(defun LDRBroX (bt base index signed s) (LDR.ro. bt base index signed s 0 8)) +(defun LDRHroX (ht base index signed s) (LDR.ro. ht base index signed s 1 16)) +(defun LDRSroX (st base index signed s) (LDR.ro. st base index signed s 2 32)) +(defun LDRDroX (dt base index signed s) (LDR.ro. dt base index signed s 3 64)) +(defun LDRQroX (qt base index signed s) (LDR.ro. qt base index signed s 4 128)) + +(defun LDRBroW (bt base index signed s) (LDR.ro. bt base index signed s 0 8)) +(defun LDRHroW (ht base index signed s) (LDR.ro. ht base index signed s 1 16)) +(defun LDRSroW (st base index signed s) (LDR.ro. st base index signed s 2 32)) +(defun LDRDroW (dt base index signed s) (LDR.ro. dt base index signed s 3 64)) +(defun LDRQroW (qt base index signed s) (LDR.ro. qt base index signed s 4 128)) ;; LDUR (defmacro LDUR.i (vt base simm size) "(LDUR.i vt base simm mem-load) loads a SIMD&FP register from memory at - the address calculated from a base register and optional immediate offset. - NOTE: does not CheckFPAdvSIMDEnabled64(), HaveMTE2Ext(), SetTagCheckedInstruction(), - CheckSPAlignment(), Mem[... AccType_VEC]" + the address calculated from a base register and optional immediate offset." (set$ vt (mem-read (+ base simm) (/ size 8)))) (defun LDURBi (bt base simm) (LDUR.i bt base simm 8)) From cdaf4fc8b1d33c96da79e90f7d300bdab4570351 Mon Sep 17 00:00:00 2001 From: Kaitlyn Lake Date: Tue, 2 Aug 2022 01:26:31 +0000 Subject: [PATCH 121/132] Fixed intrinsic usage in LDNP --- plugins/arm/semantics/aarch64-logical.lisp | 11 ------- plugins/arm/semantics/aarch64-simd-load.lisp | 32 +++++++++----------- 2 files changed, 14 insertions(+), 29 deletions(-) diff --git a/plugins/arm/semantics/aarch64-logical.lisp b/plugins/arm/semantics/aarch64-logical.lisp index f5ed10514..3ab6ed6a2 100644 --- a/plugins/arm/semantics/aarch64-logical.lisp +++ b/plugins/arm/semantics/aarch64-logical.lisp @@ -58,14 +58,8 @@ (defun ANDSXri (rd rn imm) (ANDS*ri set$ 64 rd rn imm)) (defmacro ANDS*rs (setf rd rn rm is) -<<<<<<< HEAD - "(ANDS*rs set rd rn imm) implements the logical AND operation on - either an X or W register with shifted immediate and sets the - N, V, Z, C flags based on the result." -======= "(ANDS*rs set rd rn imm) implements the logical AND operation on either an X or W register with shifted immediate and sets the N, V, Z, C flags based on the result." ->>>>>>> 3a007ab61a33952250de8031cea0ad4363ada325 (let ((immOp (shift-encoded rm is))) (ANDS*r* setf rd rn immOp))) @@ -76,13 +70,8 @@ ;; BIC (defmacro BIC*rs (setr rd rn rm is) -<<<<<<< HEAD - "(BIC*r setr rd rn rm) stores the result of a logical and of rn with - the complement of the contents of optionally shifted rm in rd" -======= "(BIC*r setr rd rn rm) stores the result of a logical and of rn with the complement of the contents of optionally shifted rm in rd" ->>>>>>> 3a007ab61a33952250de8031cea0ad4363ada325 (let ((shift (shift-encoded rm is)) (comp (lnot shift))) (setr rd (logand rn comp)))) diff --git a/plugins/arm/semantics/aarch64-simd-load.lisp b/plugins/arm/semantics/aarch64-simd-load.lisp index 691c10a5b..fb93e5e14 100644 --- a/plugins/arm/semantics/aarch64-simd-load.lisp +++ b/plugins/arm/semantics/aarch64-simd-load.lisp @@ -503,29 +503,22 @@ (defun LD4Rv1d_POST (_ va_vb_vc_vd xn xm) (LD4Rv._POST va_vb_vc_vd xn 64 64 xm)) (defun LD4Rv2d_POST (_ va_vb_vc_vd xn xm) (LD4Rv._POST va_vb_vc_vd xn 64 128 xm)) -;; load register pair - -(defun load-register-pair (vn vm base imm size scale) - "(load-register-pair vn vm base imm size scale) loads a pair of registers - from memory with an optional offset and immediate decoding." - (let ((off (lshift (cast-signed 64 imm) scale)) - (dbytes (/ size 8))) - (set$ vn (mem-read (+ base off) dbytes)) - (set$ vm (mem-read (+ base off dbytes) dbytes)))) - ;; LDNP -(defmacro LDNP.i (vn vm base imm size) +(defmacro LDNP.i (vn vm base imm size scale) "(LDNP.i vn vm base imm) loads a pair of SIMD&FP registers from memory at at address base with optional offset imm and stores them in vn and vm. Issues a non-temporal hint." - (prog - (intrinsic 'non-temporal-hint base) - (load-register-pair vn vm base imm size 0))) + (let ((off (lshift (cast-signed 64 imm) scale)) + (dbytes (/ size 8))) + (intrinsic 'non-temporal-hint (+ base off)) + (set$ vn (mem-read (+ base off) dbytes)) + (intrinsic 'non-temporal-hint (+ base off dbytes)) + (set$ vm (mem-read (+ base off dbytes) dbytes)))) -(defun LDNPSi (sn sm base imm) (LDNP.i sn sm base imm 32)) -(defun LDNPDi (dn dm base imm) (LDNP.i dn dm base imm 64)) -(defun LDNPQi (qn qm base imm) (LDNP.i qn qm base imm 128)) +(defun LDNPSi (sn sm base imm) (LDNP.i sn sm base imm 32 2)) +(defun LDNPDi (dn dm base imm) (LDNP.i dn dm base imm 64 3)) +(defun LDNPQi (qn qm base imm) (LDNP.i qn qm base imm 128 4)) ;; LDP (pre-index) @@ -563,7 +556,10 @@ (defmacro LDP.i (vn vm base imm size scale) "(LDP.i qn qm imm size mem-load scale) loads a pair of SIMD&FP registers from memory using the address base and an optional signed immediate offset." - (load-register-pair vn vm base imm size scale)) + (let ((off (lshift (cast-signed 64 imm) scale)) + (dbytes (/ size 8))) + (set$ vn (mem-read (+ base off) dbytes)) + (set$ vm (mem-read (+ base off dbytes) dbytes)))) (defun LDPQi (qn qm base imm) (LDP.i qn qm base imm 128 4)) (defun LDPDi (qn qm base imm) (LDP.i qn qm base imm 64 3)) From be36805c84ce639edbec07c7e4fa98558c3e0c36 Mon Sep 17 00:00:00 2001 From: Kaitlyn Lake Date: Tue, 2 Aug 2022 01:35:56 +0000 Subject: [PATCH 122/132] Minor comment changes --- plugins/arm/semantics/aarch64-simd-load.lisp | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/plugins/arm/semantics/aarch64-simd-load.lisp b/plugins/arm/semantics/aarch64-simd-load.lisp index fb93e5e14..639fa5297 100644 --- a/plugins/arm/semantics/aarch64-simd-load.lisp +++ b/plugins/arm/semantics/aarch64-simd-load.lisp @@ -366,7 +366,7 @@ (defun LD4i32_POST (_ _ qa_qb_qc_qd index xn xm) (LD4i._POST qa_qb_qc_qd index xn 32 xm)) (defun LD4i64_POST (_ _ qa_qb_qc_qd index xn xm) (LD4i._POST qa_qb_qc_qd index xn 64 xm)) -;; LD1R +;; LD.R algorithm (defmacro LD.Rv._POST (grp base esize dsize selems off) "(LD.Rv._POST grp base esize dsize selems off) loads an multiple element from a @@ -506,9 +506,10 @@ ;; LDNP (defmacro LDNP.i (vn vm base imm size scale) - "(LDNP.i vn vm base imm) loads a pair of SIMD&FP registers from memory at + "(LDNP.i vn vm base imm) loads a pair of SIMD registers from memory at at address base with optional offset imm and stores them in vn and vm. - Issues a non-temporal hint." + Issues a non-temporal hint, in the form of an intrinsic for each memory + access." (let ((off (lshift (cast-signed 64 imm) scale)) (dbytes (/ size 8))) (intrinsic 'non-temporal-hint (+ base off)) From a1f0852cf02cdfe00e0cefaa3d98f8057c71448b Mon Sep 17 00:00:00 2001 From: andrewj-brown <92134285+andrewj-brown@users.noreply.github.com> Date: Fri, 12 Aug 2022 11:03:06 +1000 Subject: [PATCH 123/132] add ADC instruction & setup repo --- plugins/arm/semantics/aarch64-arithmetic.lisp | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/plugins/arm/semantics/aarch64-arithmetic.lisp b/plugins/arm/semantics/aarch64-arithmetic.lisp index 365b2e00a..cedc39b6d 100644 --- a/plugins/arm/semantics/aarch64-arithmetic.lisp +++ b/plugins/arm/semantics/aarch64-arithmetic.lisp @@ -16,6 +16,13 @@ (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)) +; adds with carry +(defun ADCXr (rd rn rm) + (add-with-carry set$ rd CF rm rn)) + +(defun ADCWr (rd rn rm) + (add-with-carry setw rd CF rm rn)) + ; adds immediate (defun ADDSXri (rd rn imm off) (add-with-carry set$ rd rn (lshift imm off) 0)) From feb8dc1e18619af51a27b366335b479e39fce240 Mon Sep 17 00:00:00 2001 From: andrewj-brown <92134285+andrewj-brown@users.noreply.github.com> Date: Fri, 12 Aug 2022 11:42:33 +1000 Subject: [PATCH 124/132] fix flag behaviour with adc/adcs --- plugins/arm/semantics/aarch64-arithmetic.lisp | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/plugins/arm/semantics/aarch64-arithmetic.lisp b/plugins/arm/semantics/aarch64-arithmetic.lisp index cedc39b6d..fff9f5f00 100644 --- a/plugins/arm/semantics/aarch64-arithmetic.lisp +++ b/plugins/arm/semantics/aarch64-arithmetic.lisp @@ -16,13 +16,18 @@ (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)) -; adds with carry -(defun ADCXr (rd rn rm) +; ADCS: add with carry, setting flags +(defun ADCSXr (rd rn rm) (add-with-carry set$ rd CF rm rn)) - -(defun ADCWr (rd rn rm) +(defun ADCSWr (rd rn rm) (add-with-carry setw rd CF rm rn)) +; ADC: add with carry, no flags +(defun ADCXr (rd rn rm) + (ADD*R* set$ rd CF rm rn)) +(defun ADCWR (rd rn rm) + (ADD*R* setw rd CF rm rn)) + ; adds immediate (defun ADDSXri (rd rn imm off) (add-with-carry set$ rd rn (lshift imm off) 0)) From 3b7b92888e277490cf1fd662cbcbf5da1f344c6a Mon Sep 17 00:00:00 2001 From: andrewj-brown <92134285+andrewj-brown@users.noreply.github.com> Date: Fri, 12 Aug 2022 12:12:32 +1000 Subject: [PATCH 125/132] switch macros --- plugins/arm/semantics/aarch64-arithmetic.lisp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/plugins/arm/semantics/aarch64-arithmetic.lisp b/plugins/arm/semantics/aarch64-arithmetic.lisp index fff9f5f00..b7d60ef8d 100644 --- a/plugins/arm/semantics/aarch64-arithmetic.lisp +++ b/plugins/arm/semantics/aarch64-arithmetic.lisp @@ -24,9 +24,9 @@ ; ADC: add with carry, no flags (defun ADCXr (rd rn rm) - (ADD*R* set$ rd CF rm rn)) + (set$ rd (+ CF (+ rm (+ rn))))) (defun ADCWR (rd rn rm) - (ADD*R* setw rd CF rm rn)) + (setw rd (+ CF (+ rm (+ rn))))) ; adds immediate (defun ADDSXri (rd rn imm off) From 666d9b5f73fbd8d7d66ea35680be9b8e5b5f2bef Mon Sep 17 00:00:00 2001 From: andrewj-brown <92134285+andrewj-brown@users.noreply.github.com> Date: Fri, 12 Aug 2022 12:22:03 +1000 Subject: [PATCH 126/132] add sbc and sbcs --- plugins/arm/semantics/aarch64-arithmetic.lisp | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/plugins/arm/semantics/aarch64-arithmetic.lisp b/plugins/arm/semantics/aarch64-arithmetic.lisp index b7d60ef8d..d83e40841 100644 --- a/plugins/arm/semantics/aarch64-arithmetic.lisp +++ b/plugins/arm/semantics/aarch64-arithmetic.lisp @@ -25,7 +25,7 @@ ; ADC: add with carry, no flags (defun ADCXr (rd rn rm) (set$ rd (+ CF (+ rm (+ rn))))) -(defun ADCWR (rd rn rm) +(defun ADCWr (rd rn rm) (setw rd (+ CF (+ rm (+ rn))))) ; adds immediate @@ -71,6 +71,18 @@ (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)) +; SBC: sub with carry, setting flags +(defun SBCSXr (rd rn rm) + (add-with-carry set$ rd CF (lnot rm) rn)) +(defun SBCSWr (rd rn rm) + (add-with-carry setw rd CF (lnot rm) rn)) + +; SBCS: sub with carry, no flags +(defun SBCXr (rd rn rm) + (set$ rd (+ CF (+ (lnot rm) (+ rn))))) +(defun SBCWr (rd rn rm) + (setw rd (+ CF (+ (lnot rm) (+ rn))))) + (defun SUBXrx (rd rn rm off) (set$ rd (- rn (extended rm off)))) From 851d126aa05258b76c9867b5e8bc8c9ff63ad7ec Mon Sep 17 00:00:00 2001 From: andrewj-brown <92134285+andrewj-brown@users.noreply.github.com> Date: Fri, 12 Aug 2022 12:25:01 +1000 Subject: [PATCH 127/132] switch SBCS to clear-base as SUBS, use "-" with SBC --- plugins/arm/semantics/aarch64-arithmetic.lisp | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/plugins/arm/semantics/aarch64-arithmetic.lisp b/plugins/arm/semantics/aarch64-arithmetic.lisp index d83e40841..1e0c0474a 100644 --- a/plugins/arm/semantics/aarch64-arithmetic.lisp +++ b/plugins/arm/semantics/aarch64-arithmetic.lisp @@ -73,15 +73,15 @@ ; SBC: sub with carry, setting flags (defun SBCSXr (rd rn rm) - (add-with-carry set$ rd CF (lnot rm) rn)) + (add-with-carry/clear-base set$ rd CF (lnot (shift-encoded rm off)) rn)) (defun SBCSWr (rd rn rm) - (add-with-carry setw rd CF (lnot rm) rn)) + (add-with-carry/clear-base setw rd CF (lnot (shift-encoded rm off)) rn)) ; SBCS: sub with carry, no flags (defun SBCXr (rd rn rm) - (set$ rd (+ CF (+ (lnot rm) (+ rn))))) + (set$ rd (+ CF (- rm) (+ rn))))) (defun SBCWr (rd rn rm) - (setw rd (+ CF (+ (lnot rm) (+ rn))))) + (setw rd (+ CF (- rm) (+ rn))))) (defun SUBXrx (rd rn rm off) (set$ rd (- rn (extended rm off)))) From d1a25f3b97aa1d0b9bbdd49d3b2cb797e6670568 Mon Sep 17 00:00:00 2001 From: andrewj-brown <92134285+andrewj-brown@users.noreply.github.com> Date: Fri, 12 Aug 2022 12:26:41 +1000 Subject: [PATCH 128/132] fix brackets --- plugins/arm/semantics/aarch64-arithmetic.lisp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/plugins/arm/semantics/aarch64-arithmetic.lisp b/plugins/arm/semantics/aarch64-arithmetic.lisp index 1e0c0474a..ac41a1800 100644 --- a/plugins/arm/semantics/aarch64-arithmetic.lisp +++ b/plugins/arm/semantics/aarch64-arithmetic.lisp @@ -79,9 +79,9 @@ ; SBCS: sub with carry, no flags (defun SBCXr (rd rn rm) - (set$ rd (+ CF (- rm) (+ rn))))) + (set$ rd (+ CF (- rm (+ rn))))) (defun SBCWr (rd rn rm) - (setw rd (+ CF (- rm) (+ rn))))) + (setw rd (+ CF (- rm (+ rn))))) (defun SUBXrx (rd rn rm off) (set$ rd (- rn (extended rm off)))) From 7ede5a8884465f1c4dba32973c09380768942911 Mon Sep 17 00:00:00 2001 From: andrewj-brown <92134285+andrewj-brown@users.noreply.github.com> Date: Fri, 12 Aug 2022 12:28:37 +1000 Subject: [PATCH 129/132] switch off clear-base --- plugins/arm/semantics/aarch64-arithmetic.lisp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/plugins/arm/semantics/aarch64-arithmetic.lisp b/plugins/arm/semantics/aarch64-arithmetic.lisp index ac41a1800..1283de990 100644 --- a/plugins/arm/semantics/aarch64-arithmetic.lisp +++ b/plugins/arm/semantics/aarch64-arithmetic.lisp @@ -73,9 +73,9 @@ ; SBC: sub with carry, setting flags (defun SBCSXr (rd rn rm) - (add-with-carry/clear-base set$ rd CF (lnot (shift-encoded rm off)) rn)) + (add-with-carry set$ rd CF (lnot (shift-encoded rm off)) rn)) (defun SBCSWr (rd rn rm) - (add-with-carry/clear-base setw rd CF (lnot (shift-encoded rm off)) rn)) + (add-with-carry setw rd CF (lnot (shift-encoded rm off)) rn)) ; SBCS: sub with carry, no flags (defun SBCXr (rd rn rm) From 4091cfdd38d0c58b22b7c319254b995cb1b26ef8 Mon Sep 17 00:00:00 2001 From: andrewj-brown <92134285+andrewj-brown@users.noreply.github.com> Date: Fri, 12 Aug 2022 12:29:34 +1000 Subject: [PATCH 130/132] fixes --- plugins/arm/semantics/aarch64-arithmetic.lisp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/plugins/arm/semantics/aarch64-arithmetic.lisp b/plugins/arm/semantics/aarch64-arithmetic.lisp index 1283de990..120af545a 100644 --- a/plugins/arm/semantics/aarch64-arithmetic.lisp +++ b/plugins/arm/semantics/aarch64-arithmetic.lisp @@ -73,9 +73,9 @@ ; SBC: sub with carry, setting flags (defun SBCSXr (rd rn rm) - (add-with-carry set$ rd CF (lnot (shift-encoded rm off)) rn)) + (add-with-carry set$ rd CF (lnot rm) rn)) (defun SBCSWr (rd rn rm) - (add-with-carry setw rd CF (lnot (shift-encoded rm off)) rn)) + (add-with-carry setw rd CF (lnot rm) rn)) ; SBCS: sub with carry, no flags (defun SBCXr (rd rn rm) From e8d35c911ebc3a730312ff5d873d47d79480aba2 Mon Sep 17 00:00:00 2001 From: andrewj-brown <92134285+andrewj-brown@users.noreply.github.com> Date: Fri, 19 Aug 2022 11:47:41 +1000 Subject: [PATCH 131/132] add SUBSWrx and finish SBC, SBCS, ADC, ADCS --- plugins/arm/semantics/aarch64-arithmetic.lisp | 29 ++++++++++--------- 1 file changed, 16 insertions(+), 13 deletions(-) diff --git a/plugins/arm/semantics/aarch64-arithmetic.lisp b/plugins/arm/semantics/aarch64-arithmetic.lisp index 120af545a..90f9f6e90 100644 --- a/plugins/arm/semantics/aarch64-arithmetic.lisp +++ b/plugins/arm/semantics/aarch64-arithmetic.lisp @@ -16,6 +16,7 @@ (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)) + ; ADCS: add with carry, setting flags (defun ADCSXr (rd rn rm) (add-with-carry set$ rd CF rm rn)) @@ -24,9 +25,9 @@ ; ADC: add with carry, no flags (defun ADCXr (rd rn rm) - (set$ rd (+ CF (+ rm (+ rn))))) + (set$ rd (+ CF rm rn))) (defun ADCWr (rd rn rm) - (setw rd (+ CF (+ rm (+ rn))))) + (setw rd (+ CF rm rn))) ; adds immediate (defun ADDSXri (rd rn imm off) @@ -71,24 +72,22 @@ (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)) -; SBC: sub with carry, setting flags +(defun SUBXrx (rd rn rm off) + (set$ rd (- rn (extended rm off)))) +(defun SUBXrw (rd rn rm off) + (setw rd (- rn (extended rm off)))) + +; SBCS: sub with carry, setting flags (defun SBCSXr (rd rn rm) (add-with-carry set$ rd CF (lnot rm) rn)) (defun SBCSWr (rd rn rm) (add-with-carry setw rd CF (lnot rm) rn)) -; SBCS: sub with carry, no flags +; SBC: sub with carry, no flags (defun SBCXr (rd rn rm) - (set$ rd (+ CF (- rm (+ rn))))) + (set$ rd (+ CF (lnot rm) rn))) (defun SBCWr (rd rn rm) - (setw rd (+ CF (- rm (+ rn))))) - -(defun SUBXrx (rd rn rm off) - (set$ rd (- rn (extended rm off)))) - -(defun SUBXrw (rd rn rm off) - (setw rd (- rn (extended rm off)))) - + (setw rd (+ CF (lnot rm) rn))) (defun SUBXrx64 (rd rn rm off) (set$ rd (- rn (extended rm off)))) @@ -99,6 +98,10 @@ (defun SUBSXrs (rd rn rm off) (add-with-carry set$ rd rn (lnot (shift-encoded rm off)) 1)) +; seems suspect but probably works +(defun SUBSWrx (rd rn rm off) + (add-with-carry set$ 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)) From abb7f403099f2a1e90ebad021e7aed3e2c563264 Mon Sep 17 00:00:00 2001 From: andrewj-brown <92134285+andrewj-brown@users.noreply.github.com> Date: Fri, 9 Sep 2022 01:47:55 +0000 Subject: [PATCH 132/132] added CLZXr and CLZWr --- plugins/arm/semantics/arm.lisp | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/plugins/arm/semantics/arm.lisp b/plugins/arm/semantics/arm.lisp index 6e44cf670..b49ad7bfa 100644 --- a/plugins/arm/semantics/arm.lisp +++ b/plugins/arm/semantics/arm.lisp @@ -7,3 +7,9 @@ (defun CLZ (rd rn pre _) (when (condition-holds pre) (set$ rd (clz rn)))) + +(defun CLZWr (rd rn) + (setw rd (clz rn))) + +(defun CLZXr (rd rn) + (set$ rd (clz rn))) \ No newline at end of file