Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Clean up tests, development toward load/store.

Incomplete, fails one test.
  • Loading branch information...
commit ffb0d743ba0703f09cc78ec0a1e06f25a031881e 1 parent 391bce6
@jaoswald authored
Showing with 337 additions and 226 deletions.
  1. +118 −4 arm-opcodes.lisp
  2. +219 −222 arm-tests.lisp
View
122 arm-opcodes.lisp
@@ -25,6 +25,7 @@
"STMDA" "STMED" "STMIA" "STMEA"
"STMDB" "STMFD" "STMIB" "STMFA"
"B" "BL" "BLX" "BX"
+ "LDR"
))
(cl:in-package "ARM")
@@ -47,6 +48,12 @@
(format stream "~A is not a valid condition code."
(condition-code condition)))))
+(define-condition bad-opcode-modifiers (arm-error)
+ ((modifier-list :reader modifier-list :initarg modifier-list))
+ (:report (lambda (condition stream)
+ (format stream "~A is not a valid opcode modifier list."
+ (modifier-list condition)))))
+
(define-condition bad-update (arm-error)
((opcode :reader opcode :initarg opcode))
(:report (lambda (condition stream)
@@ -59,6 +66,12 @@
(format stream "~A is not a valid register."
(register condition)))))
+(define-condition bad-base-register-form (arm-error)
+ ((register :reader register :initarg register))
+ (:report (lambda (condition stream)
+ (format stream "~A is not a valid base register."
+ (register condition)))))
+
(define-condition bad-opcode (arm-error)
((opcode :reader opcode :initarg opcode))
(:report (lambda (condition stream)
@@ -71,6 +84,12 @@
(format stream "~A cannot be encoded as an immediate value."
(immediate condition)))))
+(define-condition bad-shifter-op (arm-error)
+ ((shifter-op :reader shifter-op :initarg shifter-op))
+ (:report (lambda (condition stream)
+ (format stream "~A is not a valid shifter operand."
+ (shifter-op condition)))))
+
(define-condition bad-shift-type (arm-error)
((shift-type :reader shift-type :initarg shift-type))
(:report (lambda (condition stream)
@@ -140,6 +159,43 @@ relative to *this* instruction in 32-bit words.")))
((rn :accessor rn :initarg rn
:documentation "Register containing branch destination.")))
+(defclass load-store (instruction)
+ ((rd :accessor rd :initarg rd
+ :documentation "Register being loaded/stored")
+ (rn :accessor rn :initarg rn
+ :documentation "Register containing base address")
+ (load/store :accessor load/store :initarg load/store
+ :documentation "LOAD or STORE")
+ (size :accessor size :initarg size
+ :documentation "Size: BYTE, WORD, etc.")
+ (offset-sign :accessor offset-sign :initarg offset-sign
+ :initform 1
+ :documentation "U-bit 1 for positive, 0 for negative")))
+
+(defclass load-immediate-offset (load-store)
+ ;; note offset 0 is load/store rd [rn]
+ ((offset-12 :accessor offset-12 :initarg offset-12
+ :initform 0
+ :documentation "Unsigned offset, in bytes")))
+
+(defclass load-register-offset (load-store)
+ ((rm :accessor rm :initarg rm
+ :documentation "Register containing offset, in bytes")
+ ;; note: LSL #0 is encoding for load/store rd [Rn +/- Rm]
+ (shift :accessor shift :initarg shift
+ :initform 0
+ :documentation "shift code: #b00=LSL, etc.")
+ (shift_imm :accessor shift_imm :initarg shift_imm
+ :initform 0
+ :documentation "Amount to shift: 0 to 32")))
+
+(defclass load-immediate-preindex (load-immediate-offset) ())
+(defclass load-register-preindex (load-register-offset) ())
+(defclass load-immediate-postindex (load-immediate-offset) ())
+(defclass load-register-postindex (load-register-offset) ())
+
+(defun condition-p (cond)
+ (member cond '(eq ne cs hs cc lo mi pl vs vc hi ls ge lt gt le al nil)))
(defun encode-condition (cond)
(case cond
@@ -243,6 +299,12 @@ or NIL if VAL cannot be so encoded."
(defun branch-opcode-p (sym)
(member sym '(B BL BX BLX))) ; BXJ
+(defun load-store-opcode-p (sym)
+ (member sym '(LDR))) ; etc.
+
+(defun load-opcode-p (sym)
+ (member sym '(LDR)))
+
(defun encode-data-processing-opcodes (opcode)
"bits 24..21 of a data-processing instruction."
(case opcode
@@ -336,7 +398,7 @@ NIL equivalent to LSL #0, RRX equivalent to ROR #0"
(w (encode-update (update-rn insn)))
(word 0))
(multiple-value-bind (l p u)
- (load/store-bits (opcode insn))
+ (load/store-multiple-bits (opcode insn))
(setf (ldb (byte 4 28) word) cond
(ldb (byte 3 25) word) #b100
(ldb (byte 1 24) word) p
@@ -434,10 +496,35 @@ NIL equivalent to LSL #0, RRX equivalent to ROR #0"
;;; (opcode arm:s <cond>)
;;; where arm:^ can be used as a synonym for arm:s
;;; (The S-bit in LDM with R15/PC in the register list is used to indicate
-;;; loading of CPSR from the SPSR; in priviledged mode
+;;; loading of CPSR from the SPSR; in privileged mode
;;; for LDM without R15/PC or STM, the S-bit set indicates the
;;; load/store affects user-mode registers)
;;;
+;;;
+;;; Load/store instructions
+;;; -----------------------
+;;;
+;;; (opcode <Rd> <Rn>) = opcode <Rd>, [<Rn> , 0]
+;;; (opcode <Rd> <Rn> (arm:# <immediate>))
+;;; = opcode <Rd>, <Rn> #+/-offset_12
+;;; ...or should the (arm:# <immediate>) simply be <immediate>,
+;;; i.e., if not a register symbol
+;;;
+;;; (opcode <Rd> <Rn> (arm:+ <Rm>))
+;;; (opcode <Rd> <Rn> (arm:- <Rm>))
+;;; = opcode <Rd>, [<Rn> +/-<Rm>]
+;;; or should the arm:+/- form enclose both <Rn> and <Rm>?
+;;;
+;;; (opcode <Rd> <Rn> (arm:+ <Rm> arm:LSL <immediate>))
+;;;
+;;; (opcode <Rd> (arm:! <Rn> <offset12>)) <offset12> defaults to 0?
+;;; (opcode <Rd> (arm:! <Rn> (arm:+ <Rm>))
+;;; (opcode <Rd> (arm:! <Rn> (arm:- <Rm>))
+;;; (opcode <Rd> (arm:! <Rn>) <immediate>)
+;;; (opcode <Rd> (arm:! <Rn>) (arm:+ <Rm>))
+;;; (opcode <Rd> (arm:! <Rn>) (arm:- <Rm>))
+;;; (opcode <Rd> (arm:! <Rn>) (arm:+ <Rm> arm:LSL <shift_imm>))
+;;; (opcode <Rd> (arm:! <Rn>) (arm:- <Rm> arm:LSL <shift_imm>))
(defun split-sexp-opcode (opcode-list)
"Splits s-expression form of opcodes.
@@ -526,7 +613,7 @@ TODO: shift-value integers should be checked for magnitude"
;; load/store-multiple bits
-(defun load/store-bits (opcode)
+(defun load/store-multiple-bits (opcode)
"Returns three values: (1/0 respectively)
L (load/store)
P (address included in storage/not-included)
@@ -542,7 +629,24 @@ U (transfer made upwards/downwards)"
((STMDB STMFD) (values 0 1 0))
((STMIB STMFA) (values 0 1 1))
(t (error 'bad-opcode 'opcode opcode))))
-
+
+(defun split-load/store-rn (rn)
+ "Decodes a base-address argument S-expression, returning multiple values
+First value: the base register ARM:R0, R1, etc.
+Second value: non-nil if indexed (i.e., (arm:! <Rn> ...))
+Third value: the offset form."
+ (cond
+ ((symbolp rn)
+ (if (register-p rn)
+ (values rn nil nil)
+ (error 'bad-register 'register rn)))
+ ((consp rn)
+ (unless (and (eq (car rn) 'arm:!)
+ (register-p (second rn)))
+ (error 'bad-base-register-form :register rn))
+ (values (second rn) t (cddr rn)))
+ (t (error 'bad-base-register-form :register rn))))
+
(defun opcode-to-instruction (symbolic-opcode)
(let ((opcode (first symbolic-opcode)))
(multiple-value-bind (op condition update)
@@ -682,5 +786,15 @@ U (transfer made upwards/downwards)"
'condition condition
'update update
'regs (cddr symbolic-opcode))))
+
+ ((load-store-opcode-p op)
+ (let ((load/store (load-opcode-p op))
+ (rd (second symbolic-opcode))
+ (rn (third symbolic-opcode))
+ (post-index-offset (fourth symbolic-opcode)))
+ (multiple-value-bind (rn indexed pre-index-offset)
+ (split-load/store-rn rn)
+
+ (error "Load/store not yet implemented."))))
(t (error "Not yet implemented."))))))
View
441 arm-tests.lisp
@@ -9,36 +9,38 @@
(cl:in-package "ARM-TESTS")
-(deftest and-encode-1
- (arm::encode (arm::opcode-to-instruction '(arm:and arm:r0 arm:r1
- arm:r2)))
- ;;and r0, r1, r2
- ;; e 0 0 1 0 0 0 2
- #b11100000000000010000000000000010)
- ;cond000 AND0nnnndddd00000000mmmm
-
-(deftest and-encode-2
- (arm::encode (arm::opcode-to-instruction '(arm:and arm:r15 arm:r14
- arm:r13)))
- ;;and r15, r14, r13
- ;; e 0 0 e f 0 0 d
- #b11100000000011101111000000001101)
- ;cond000 AND0nnnndddd00000000mmmm
-
-(deftest and-encode-3
- (arm::encode (arm::opcode-to-instruction '((arm:and arm:s) arm:r15 arm:r14
- arm:r13)))
- ;;ands r15, r14, r13
- ;; e 0 1 e f 0 0 d
- #b11100000000111101111000000001101)
- ;cond000 ANDSnnnndddd00000000mmmm
-
-(deftest mvn-encode-1 ;; note: MVN only takes two args
- (arm::encode (arm::opcode-to-instruction '(arm:mvn arm:r3 arm:r4)))
- ;;mvn r3, r4
- ;; e 1 e 0 3 0 0 4
- #b11100001111000000011000000000100)
- ;cond000 MVN00000dddd00000000mmmm
+(defmacro test-encoding (test-name asm-sexp value)
+ `(deftest ,test-name (arm::encode (arm::opcode-to-instruction
+ ,asm-sexp))
+ ,value))
+
+(test-encoding and-encode-1
+ '(arm:and arm:r0 arm:r1 arm:r2) ;;and r0, r1, r2
+ ;; e 0 0 1 0 0 0 2
+ ;;cond000 AND0nnnndddd00000000mmmm
+ #b11100000000000010000000000000010)
+
+(test-encoding and-encode-2
+ '(arm:and arm:r15 arm:r14 arm:r13) ;; and r15, r14, r13
+ ;; e 0 0 e f 0 0 d
+ ;;cond000 AND0nnnndddd00000000mmmm
+ #b11100000000011101111000000001101)
+
+
+(test-encoding and-encode-3
+ '((arm:and arm:s) arm:r15 arm:r14 arm:r13) ;; ands r15, r14, r13
+ ;; e 0 1 e f 0 0 d
+ ;;cond000 ANDSnnnndddd00000000mmmm
+ #b11100000000111101111000000001101)
+
+
+
+(test-encoding mvn-encode-1 ;; note: MVN only takes two args
+ '(arm:mvn arm:r3 arm:r4) ;; mvn r3, r4
+ ;; e 1 e 0 3 0 0 4
+ ;;cond000 MVN00000dddd00000000mmmm
+ #b11100001111000000011000000000100)
+
(deftest imm-32-0 (arm::encode-32-bit-immediate 0)
0 0)
@@ -90,214 +92,202 @@
(deftest imm-32-f000001f (arm::encode-32-bit-immediate #xf000001f)
nil)
-(deftest and-encode-4
- (arm::encode (arm::opcode-to-instruction '((arm:and arm:s) arm:r15 arm:r14
- (arm:\# #xff00))))
- ;;ands r15, r14, #xff00
- ;; e 2 1 e f c f f
- #b11100010000111101111110011111111)
- ;cond00I ANDSnnnnddddrot_IMMEDIAT
-
-(deftest and-encode-5 ; update condition flags with s
- (arm::encode (arm::opcode-to-instruction '((arm:and arm:s) arm:r0 arm:r12
- (arm:\# #x3f0))))
- ;;ands r0, r12, #x3f0
- ;; e 2 1 c 0 e 3 f
- #b11100010000111000000111000111111)
- ;cond00I ANDSnnnnddddrot_IMMEDIAT
-
-(deftest and-encode-6
- (arm::encode (arm::opcode-to-instruction '((arm:and arm:s arm:vs)
- arm:r0 arm:r12
- (arm:\# #xab))))
- ;;andvss r0, r12, #xab
- ;; 6 2 1 c 0 0 a b
- #b01100010000111000000000010101011)
- ;cond00I ANDSnnnnddddrot_IMMEDIAT
-
-(deftest and-encode-7
- (arm::encode (arm::opcode-to-instruction '((arm:and arm:hs)
- arm:r0 arm:r12
- (arm:\# #x3f0))))
- ;;andhs r0, r12, #x3f0
- ;; 2 2 0 c 0 e 3 f
- #b00100010000011000000111000111111)
- ;cond00I ANDSnnnnddddrot_IMMEDIAT
-
-(deftest and-encode-8 ; s can occur after condition
- (arm::encode (arm::opcode-to-instruction '((arm:and arm:hi arm:s)
- arm:r0 arm:r12
- (arm:\# #x3f0))))
- ;;andvss r0, r12, #x3f0
- ;; 8 2 1 c 0 e 3 f
- #b10000010000111000000111000111111)
- ;cond00I ANDSnnnnddddrot_IMMEDIAT
-
-(deftest adc-encode-1 ; LSL immediate
- (arm::encode (arm::opcode-to-instruction '(arm:adc
- arm:r0 arm:r12
- (arm:r2 arm:lsl (arm:\# 1)))))
- ;;adc r0, r12, r2 LSL #1
- ;; e 0 a c 0 0 8 2
- #b11100000101011000000000010000010)
- ;cond000 ADCSnnnnddddSHFIMsh0mmmm
-
-(deftest adc-encode-2 ; LSL register
- (arm::encode (arm::opcode-to-instruction '(arm:adc
- arm:r0 arm:r12
- (arm:r2 arm:lsl arm:r4))))
- ;;adc r0, r12, r2 LSL r4
- ;; 3 0 a c 0 4 1 2
- #b11100000101011000000010000010010)
- ;cond000 ADCSnnnnddddssss0sh1mmmm
-
-(deftest adc-encode-3 ; LSR immediate
- (arm::encode (arm::opcode-to-instruction '(arm:adc
- arm:r0 arm:r12
- (arm:r2 arm:lsr (arm:\# #x1a)))))
- ;;adc r0, r12, r2 LSR #x1a
- ;; e 0 a c 0 d 2 2
- #b11100000101011000000110100100010)
- ;cond000 ADCSnnnnddddSHFIMsh0mmmm
-
-
-(deftest eor-encode-1 ; LSR register
- (arm::encode (arm::opcode-to-instruction '((arm:eor arm:eq)
- arm:r15 arm:r10
- (arm:r1 arm:lsr arm:r2))))
- ;;eoreq r15, r10, r1 LSR r2
- ;; 0 0 2 a f 2 3 1
- #b00000000001010101111001000110001)
- ;cond000 EORSnnnnddddssss0sh1mmmm
-
-(deftest sub-encode-1 ; ASR immediate
- (arm::encode (arm::opcode-to-instruction '((arm:sub arm:ne)
- arm:r1 arm:r11
- (arm:r3 arm:asr (arm:\# 31)))))
- ;;subne r1, r11, r3 ASR #31
- ;; 1 0 4 b 1 f c 3
- #b00010000010010110001111111000011)
- ;cond000 SUBSnnnnddddSHFIMsh0mmmm
-
-(deftest rsb-encode-1 ; ASR register
- (arm::encode (arm::opcode-to-instruction '((arm:rsb arm:lo)
- arm:r3 arm:r8
- (arm:r2 arm:asr arm:r9))))
- ;;rsblo r3, r8, r2 ASR r9
- ;; 3 0 6 8 3 9 5 2
- #b00110000011010000011100101010010)
- ;cond000 RSBSnnnnddddssss0sh1mmmm
-
-(deftest add-encode-1 ; ROR immediate
- (arm::encode (arm::opcode-to-instruction '((arm:add arm:mi arm:s)
- arm:r4 arm:r7
- (arm:r3 arm:ror (arm:\# 19)))))
- ;; addmi r4, r7, r3 ROR #19
- ;; 4 0 9 7 4 9 e 3
- #b01000000100101110100100111100011)
- ;cond000 ADDSnnnnddddSHFIMsh0mmmm
-
-(deftest adc-encode-4 ; ROR register
- (arm::encode (arm::opcode-to-instruction '((arm:adc arm:pl)
- arm:r5 arm:r6
- (arm:r4 arm:ror arm:r7))))
- ;; adcpl r5, r6, r4 ROR r7
- ;; 5 0 a 6 5 7 7 4
- #b01010000101001100101011101110100)
- ;cond000 ADCSnnnnddddssss0sh1mmmm
-
-(deftest sbc-encode-1 ; RRX
- (arm::encode (arm::opcode-to-instruction '((arm:sbc arm:s arm:vc)
- arm:r6 arm:r6
- (arm:r5 arm:rrx))))
- ;; sbcvcs r6, r6, r5 RRX
- ;; 7 0 d 6 6 0 6 5
- #b01110000110101100110000001100101)
- ;cond000 SBCSnnnndddd00000sh0mmmm
+(test-encoding and-encode-4
+ '((arm:and arm:s) arm:r15 arm:r14 (arm:\# #xff00))
+ ;;ands r15, r14, #xff00
+ ;; e 2 1 e f c f f
+ ;;cond00I ANDSnnnnddddrot_IMMEDIAT
+ #b11100010000111101111110011111111)
+
+(test-encoding and-encode-5 ; update condition flags with s
+ '((arm:and arm:s) arm:r0 arm:r12 (arm:\# #x3f0))
+ ;;ands r0, r12, #x3f0
+ ;; e 2 1 c 0 e 3 f
+ ;;cond00I ANDSnnnnddddrot_IMMEDIAT
+ #b11100010000111000000111000111111)
+
+
+(test-encoding and-encode-6
+ '((arm:and arm:s arm:vs) arm:r0 arm:r12 (arm:\# #xab))
+ ;;andvss r0, r12, #xab
+ ;; 6 2 1 c 0 0 a b
+ ;;cond00I ANDSnnnnddddrot_IMMEDIAT
+ #b01100010000111000000000010101011)
+
+
+(test-encoding and-encode-7
+ '((arm:and arm:hs) arm:r0 arm:r12 (arm:\# #x3f0))
+ ;;andhs r0, r12, #x3f0
+ ;; 2 2 0 c 0 e 3 f
+ ;;cond00I ANDSnnnnddddrot_IMMEDIAT
+ #b00100010000011000000111000111111)
+
+
+(test-encoding and-encode-8 ; s can occur after condition
+ '((arm:and arm:hi arm:s) arm:r0 arm:r12 (arm:\# #x3f0))
+ ;;andvss r0, r12, #x3f0
+ ;; 8 2 1 c 0 e 3 f
+ ;;cond00I ANDSnnnnddddrot_IMMEDIAT
+ #b10000010000111000000111000111111)
+
+
+(test-encoding adc-encode-1 ; LSL immediate
+ '(arm:adc arm:r0 arm:r12 (arm:r2 arm:lsl (arm:\# 1)))
+ ;;adc r0, r12, r2 LSL #1
+ ;; e 0 a c 0 0 8 2
+ ;;cond000 ADCSnnnnddddSHFIMsh0mmmm
+ #b11100000101011000000000010000010)
+
+
+(test-encoding adc-encode-2 ; LSL register
+ '(arm:adc arm:r0 arm:r12 (arm:r2 arm:lsl arm:r4))
+ ;;adc r0, r12, r2 LSL r4
+ ;; 3 0 a c 0 4 1 2
+ ;;cond000 ADCSnnnnddddssss0sh1mmmm
+ #b11100000101011000000010000010010)
+
+
+(test-encoding adc-encode-3 ; LSR immediate
+ '(arm:adc arm:r0 arm:r12 (arm:r2 arm:lsr (arm:\# #x1a)))
+ ;;adc r0, r12, r2 LSR #x1a
+ ;; e 0 a c 0 d 2 2
+ ;;cond000 ADCSnnnnddddSHFIMsh0mmmm
+ #b11100000101011000000110100100010)
+
+
+
+(test-encoding eor-encode-1 ; LSR register
+ '((arm:eor arm:eq) arm:r15 arm:r10 (arm:r1 arm:lsr arm:r2))
+ ;;eoreq r15, r10, r1 LSR r2
+ ;; 0 0 2 a f 2 3 1
+ ;;cond000 EORSnnnnddddssss0sh1mmmm
+ #b00000000001010101111001000110001)
+
+
+(test-encoding sub-encode-1 ; ASR immediate
+ '((arm:sub arm:ne) arm:r1 arm:r11 (arm:r3 arm:asr (arm:\# 31)))
+ ;;subne r1, r11, r3 ASR #31
+ ;; 1 0 4 b 1 f c 3
+ ;;cond000 SUBSnnnnddddSHFIMsh0mmmm
+ #b00010000010010110001111111000011)
+
+
+(test-encoding rsb-encode-1 ; ASR register
+ '((arm:rsb arm:lo) arm:r3 arm:r8 (arm:r2 arm:asr arm:r9))
+ ;;rsblo r3, r8, r2 ASR r9
+ ;; 3 0 6 8 3 9 5 2
+ ;;cond000 RSBSnnnnddddssss0sh1mmmm
+ #b00110000011010000011100101010010)
+
+
+(test-encoding add-encode-1 ; ROR immediate
+ '((arm:add arm:mi arm:s)
+ arm:r4
+ arm:r7
+ (arm:r3 arm:ror (arm:\# 19)))
+ ;; addmis r4, r7, r3 ROR #19
+ ;; 4 0 9 7 4 9 e 3
+ ;;cond000 ADDSnnnnddddSHFIMsh0mmmm
+ #b01000000100101110100100111100011)
+
+(test-encoding adc-encode-4 ; ROR register
+ '((arm:adc arm:pl) arm:r5 arm:r6 (arm:r4 arm:ror arm:r7))
+ ;; adcpl r5, r6, r4 ROR r7
+ ;; 5 0 a 6 5 7 7 4
+ ;;cond000 ADCSnnnnddddssss0sh1mmmm
+ #b01010000101001100101011101110100)
+
+
+(test-encoding sbc-encode-1 ; RRX
+ '((arm:sbc arm:s arm:vc) arm:r6 arm:r6 (arm:r5 arm:rrx))
+ ;; sbcvcs r6, r6, r5 RRX
+ ;; 7 0 d 6 6 0 6 5
+ ;;cond000 SBCSnnnndddd00000sh0mmmm
+ #b01110000110101100110000001100101)
;; tests from hello world GCC compiler output + objdump
-(deftest sub-encode-2
- (arm::encode (arm::opcode-to-instruction '(arm:sub arm:fp arm:ip
- (arm:\# 4))))
- #xe24cb004)
+(test-encoding sub-encode-2
+ '(arm:sub arm:fp arm:ip (arm:\# 4))
+ #xe24cb004)
+
+(test-encoding and-encode-9
+ '((arm:and arm:eq) arm:r0 arm:r0 arm:r0)
+ 0)
-(deftest and-encode-9
- (arm::encode (arm::opcode-to-instruction '((arm:and arm:eq)
- arm:r0 arm:r0 arm:r0)))
- 0)
+(test-encoding mov-encode-1
+ '(arm:mov arm:ip arm:sp)
+ #xe1a0c00d)
-(deftest mov-encode-1
- (arm::encode (arm::opcode-to-instruction '(arm:mov arm:ip arm:sp)))
- #xe1a0c00d)
+(test-encoding cmp-encode-1
+ '(arm:cmp arm:r1 (arm:\# #x1f))
+ ;;cond00I CMP1nnnn0000rot_IMMEDIAT
+ #b11100011010100010000000000011111)
-(deftest cmp-encode-1
- (arm::encode (arm::opcode-to-instruction '(arm:cmp arm:r1 (arm:\# #x1f))))
- #b11100011010100010000000000011111)
- ;cond00I CMP1nnnn0000rot_IMMEDIAT
-(deftest cmp-encode-2
- (arm::encode (arm::opcode-to-instruction '(arm:cmp arm:r2 arm:r10)))
- #b11100001010100100000000000001010)
- ;cond000 CMP1nnnn0000SHFIMsh0mmmm
+(test-encoding cmp-encode-2
+ '(arm:cmp arm:r2 arm:r10)
+ ;;cond000 CMP1nnnn0000SHFIMsh0mmmm
+ #b11100001010100100000000000001010)
+
-(deftest cmp-encode-3
- (arm::encode (arm::opcode-to-instruction '(arm:cmp arm:r1 (arm:\# #x1e))))
- #xe351001e)
+(test-encoding cmp-encode-3
+ '(arm:cmp arm:r1 (arm:\# #x1e))
+ #xe351001e)
-(deftest cmp-encode-4
- (arm::encode (arm::opcode-to-instruction '(arm:cmp arm:r0 arm:r1)))
- #xe1500001)
+(test-encoding cmp-encode-4
+ '(arm:cmp arm:r0 arm:r1)
+ #xe1500001)
;; e 1 5 0 0 0 0 1
-;; #b11100001010100000000000000000001)
+;; #b11100001010100000000000000000001
;; cond000 CMP1nnnn0000SHFIMsh0mmmm
-(deftest stmdb-encode-1
- (arm::encode (arm::opcode-to-instruction '(arm:stmdb (arm:sp arm:!)
- arm:fp arm:ip arm:lr arm:pc)))
- #xe92dd800)
-
-(deftest ldmia-encode-1
- (arm::encode (arm::opcode-to-instruction '(arm:ldmia arm:sp
- arm:fp arm:sp arm:pc)))
- #xe89da800)
+(test-encoding stmdb-encode-1
+ '(arm:stmdb (arm:sp arm:!) arm:fp arm:ip arm:lr arm:pc)
+ #xe92dd800)
+(test-encoding ldmia-encode-1
+ '(arm:ldmia arm:sp arm:fp arm:sp arm:pc)
+ #xe89da800)
-(deftest bl-encode-1
- (arm::encode (arm::opcode-to-instruction '(arm:bl 2)))
- #xeb000000)
+(test-encoding bl-encode-1
+ '(arm:bl 2)
+ #xeb000000)
-(deftest bl-encode-2
- (arm::encode (arm::opcode-to-instruction '(arm:bl -1)))
- #xebfffffd)
+(test-encoding bl-encode-2
+ '(arm:bl -1)
+ #xebfffffd)
-(deftest b-encode-1
- (arm::encode (arm::opcode-to-instruction '(arm:b 4)))
- #xea000002)
+(test-encoding b-encode-1
+ '(arm:b 4)
+ #xea000002)
-(deftest b-encode-2
- (arm::encode (arm::opcode-to-instruction '((arm:b arm:gt) -3)))
- #xcafffffb)
+(test-encoding b-encode-2
+ '((arm:b arm:gt) -3)
+ #xcafffffb)
-(deftest bx-encode-1
- (arm::encode (arm::opcode-to-instruction '(arm:bx arm:r4)))
- #xe12fff14)
+(test-encoding bx-encode-1
+ '(arm:bx arm:r4)
+ #xe12fff14)
-(deftest bx-encode-2
- (arm::encode (arm::opcode-to-instruction '((arm:bx arm:le) arm:r14)))
- #xd12fff1e)
+(test-encoding bx-encode-2
+ '((arm:bx arm:le) arm:r14)
+ #xd12fff1e)
-(deftest blx2-encode-1
- ;; BLX(2) uses register, calls ARM or Thumb, can have condition code
- (arm::encode (arm::opcode-to-instruction '((arm:blx arm:lt) arm:r13)))
- #xb12fff3d)
+(test-encoding blx2-encode-1
+ ;; BLX(2) uses register, calls ARM or Thumb,
+ ;; can have condition code
+ '((arm:blx arm:lt) arm:r13)
+ #xb12fff3d)
-(deftest blx1-encode-1
- ;; BLX(1) uses half-word offset, calls Thumb, CANNOT have condition code
- (arm::encode (arm::opcode-to-instruction '(arm:blx 10)))
- #b11111010000000000000000000001000)
- ; 1111101H< signed immed 24>
+(test-encoding blx1-encode-1
+ ;; BLX(1) uses half-word offset, calls Thumb,
+ ;; CANNOT have condition code
+ '(arm:blx 10)
+ ;;1111101H< signed immed 24>
+ #b11111010000000000000000000001000)
+
;; should define some macro to take away the m-v-b, ignore-errors,
;; (not success) and (class-name)
@@ -311,12 +301,19 @@
(arm::opcode cond)))
T arm::bad-opcode (arm:blx arm:lt))
+
#||
-(deftest blx1-encode-2
- ;; BLX(1) uses half-word offset, calls Thumb, CANNOT have condition code
- (arm::encode (arm::opcode-to-instruction (list 'arm:blx (+ 10 1/2))))
- #b11111011000000000000000000001000)
- ; 1111101H< signed immed 24>
+(test-encoding blx1-encode-2
+ ;; BLX(1) uses half-word offset, calls Thumb,
+ ;; CANNOT have condition code
+ (list 'arm:blx (+ 10 1/2))
+ ;;1111101H< signed immed 24>
+ #b11111011000000000000000000001000)
+
;; NOT YET IMPLEMENTED
-||#
+||#
+
+(test-encoding ldr-encode-1
+ '(arm:ldr arm:r1 arm:r0)
+ #xe5901000)
Please sign in to comment.
Something went wrong with that request. Please try again.