asm-test.lisp (7425 bytes)
1 ;;;; asm-test.lisp -- layer 2 tests: every encoder form, byte-identical to arm-none-eabi-as. 2 ;;;; Run: sbcl --script asm-test.lisp (needs arm-none-eabi-as and -objcopy on PATH, or ARM_AS / ARM_OBJCOPY) 3 4 (load (merge-pathnames "asm.lisp" *load-truename*)) 5 (in-package :thumb) 6 7 (defparameter *cases* 8 ;; (lisp form . gas text); (:label NAME) defines a label both sides. 9 '(((nop) . "nop") 10 ((bx :r0) . "bx r0") ((blx :r3) . "blx r3") 11 ((mov :r4 :r1) . "mov r4, r1") ((mov :r8 :r6) . "mov r8, r6") ((mov :r6 :sp) . "mov r6, sp") 12 ((cmp-imm8 :r6 0) . "cmp r6, #0") ((cmp-imm8 :r2 200) . "cmp r2, #200") 13 ((it :eq) . "it eq") ((mov :r4 :r1) . "moveq r4, r1") 14 ((it :ne) . "it ne") ((mov :r4 :r1) . "movne r4, r1") 15 ((it :lt) . "it lt") ((mvn-0 :r6) . "mvnlt.w r6, #0") 16 ((it :eq :e) . "ite eq") ((mov :r0 :r1) . "moveq r0, r1") ((mov :r0 :r2) . "movne r0, r2") 17 ((it :mi :tt) . "ittt mi") ((nop) . "nopmi") ((nop) . "nopmi") ((nop) . "nopmi") 18 ((ldr :r7 :r4 4 :post) . "ldr.w r7, [r4], #4") ((ldr :r0 :r7) . "ldr.w r0, [r7]") 19 ((ldr :r6 :r5 4 :post) . "ldr.w r6, [r5], #4") ((str :r6 :r5 -4 :pre) . "str.w r6, [r5, #-4]!") 20 ((ldr :r1 :r2 100) . "ldr.w r1, [r2, #100]") ((str :r3 :r9 4095) . "str.w r3, [r9, #4095]") 21 ((ldr :r0 :r1 -8) . "ldr.w r0, [r1, #-8]") ((push1 :r4) . "str.w r4, [sp, #-4]!") ((pop1 :r4) . "ldr.w r4, [sp], #4") 22 ((ldrb :r6 :r6) . "ldrb.w r6, [r6]") ((strb :r0 :r6) . "strb.w r0, [r6]") ((ldrb :r1 :r4 1 :post) . "ldrb.w r1, [r4], #1") 23 ((ldrh :r6 :r6) . "ldrh.w r6, [r6]") ((strh :r0 :r6 2) . "strh.w r0, [r6, #2]") 24 ((ldrsb :r1 :r2) . "ldrsb.w r1, [r2]") ((ldrsh :r1 :r2) . "ldrsh.w r1, [r2]") 25 ((add-reg :r6 :r6 :r0) . "add.w r6, r6, r0") ((sub-reg :r6 :r0 :r6) . "sub.w r6, r0, r6") 26 ((rsb-reg :r6 :r6 :r0) . "rsb r6, r6, r0") ((and-reg :r6 :r6 :r0) . "and.w r6, r6, r0") 27 ((orr-reg :r6 :r6 :r0) . "orr.w r6, r6, r0") ((eor-reg :r6 :r6 :r0) . "eor.w r6, r6, r0") 28 ((bic-reg :r6 :r0 :r6) . "bic.w r6, r0, r6") ((orn-reg :r1 :r2 :r3) . "orn r1, r2, r3") 29 ((add-reg :r4 :r4 :r1 :lsl 2) . "add.w r4, r4, r1, lsl #2") 30 ((adc-reg :r1 :r2 :r3) . "adc.w r1, r2, r3") ((sbc-reg :r1 :r2 :r3) . "sbc.w r1, r2, r3") 31 ((adds-reg :r1 :r2 :r3) . "adds.w r1, r2, r3") ((subs-reg :r1 :r2 :r3) . "subs.w r1, r2, r3") 32 ((mov-shift :r6 :r6 :lsl 2) . "lsl.w r6, r6, #2") ((mov-shift :r6 :r6 :asr 1) . "asr.w r6, r6, #1") 33 ((mov-shift :r6 :r6 :lsr 31) . "lsr.w r6, r6, #31") ((mov-shift :r1 :r2 :asr 32) . "asr.w r1, r2, #32") 34 ((mvn-reg :r6 :r6) . "mvn.w r6, r6") ((cmp-reg :r0 :r6) . "cmp.w r0, r6") ((tst-reg :r0 :r6) . "tst.w r0, r6") 35 ((lsl-reg :r6 :r0 :r6) . "lsl.w r6, r0, r6") ((lsr-reg :r6 :r0 :r6) . "lsr.w r6, r0, r6") 36 ((asr-reg :r6 :r0 :r6) . "asr.w r6, r0, r6") 37 ((addw :r6 :r6 1) . "addw r6, r6, #1") ((subw :r6 :r6 4095) . "subw r6, r6, #4095") 38 ((addw :r4 :r7 4) . "addw r4, r7, #4") 39 ((movw :r6 0) . "movw r6, #0") ((movw :r0 #xBEEF) . "movw r0, #0xbeef") ((movt :r0 #x2001) . "movt r0, #0x2001") 40 ((li :r1 #x4000440C) . "movw r1, #0x440c 41 movt r1, #0x4000") 42 ((mul :r6 :r6 :r0) . "mul r6, r6, r0") ((mls :r6 :r0 :r6 :r1) . "mls r6, r0, r6, r1") 43 ((sdiv :r6 :r0 :r6) . "sdiv r6, r0, r6") ((udiv :r6 :r0 :r6) . "udiv r6, r0, r6") 44 ((smull :r0 :r6 :r0 :r6) . "smull r0, r6, r0, r6") ((umull :r0 :r1 :r2 :r3) . "umull r0, r1, r2, r3") 45 ((clz :r0 :r1) . "clz r0, r1") 46 ((vadd :s0 :s0 :s1) . "vadd.f32 s0, s0, s1") ((vadd :s3 :s14 :s31) . "vadd.f32 s3, s14, s31") 47 ((vsub :s0 :s0 :s1) . "vsub.f32 s0, s0, s1") ((vsub :s5 :s2 :s9) . "vsub.f32 s5, s2, s9") 48 ((vmul :s0 :s0 :s1) . "vmul.f32 s0, s0, s1") ((vdiv :s0 :s0 :s1) . "vdiv.f32 s0, s0, s1") 49 ((vdiv :s17 :s8 :s3) . "vdiv.f32 s17, s8, s3") 50 ((vcvt-f32-s32 :s0 :s0) . "vcvt.f32.s32 s0, s0") ((vcvt-f32-s32 :s1 :s2) . "vcvt.f32.s32 s1, s2") 51 ((vcvt-s32-f32 :s0 :s0) . "vcvt.s32.f32 s0, s0") ((vcvt-s32-f32 :s3 :s4) . "vcvt.s32.f32 s3, s4") 52 ((vsqrt :s0 :s0) . "vsqrt.f32 s0, s0") ((vsqrt :s7 :s30) . "vsqrt.f32 s7, s30") 53 ((vcmp :s0 :s1) . "vcmp.f32 s0, s1") ((vcmp :s9 :s2) . "vcmp.f32 s9, s2") ((vmrs-apsr) . "vmrs APSR_nzcv, fpscr") 54 ((vmov-s-r :s0 :r0) . "vmov s0, r0") ((vmov-s-r :s1 :r6) . "vmov s1, r6") ((vmov-s-r :s13 :r2) . "vmov s13, r2") 55 ((vmov-r-s :r6 :s0) . "vmov r6, s0") ((vmov-r-s :r1 :s9) . "vmov r1, s9") 56 ((:label "back") . "back:") 57 ((b "fwd") . "b.w fwd") ((bl "fwd") . "bl fwd") ((bcc :eq "fwd") . "beq.w fwd") ((bcc :ne "back") . "bne.w back") 58 ((b "back") . "b.w back") ((bl "back") . "bl back") ((bcc :ge "back") . "bge.w back") 59 ((nop) . "nop") 60 ((:label "fwd") . "fwd:") 61 ((nop) . "nop"))) 62 63 (defun run-lisp () 64 (new-segment) 65 (let ((labels (make-hash-table :test 'equal)) (ranges '())) 66 (flet ((lab (n) (or (gethash n labels) (setf (gethash n labels) (label))))) 67 (dolist (c *cases*) 68 (let ((f (car c)) (start (here))) 69 (if (eq (car f) :label) 70 (mark (lab (second f))) 71 (apply (car f) (mapcar (lambda (a) (if (stringp a) (lab a) a)) (cdr f)))) 72 (push (list start (here) (cdr c)) ranges)))) 73 (values (segment-bytes) (nreverse ranges)))) 74 75 (defun run-gas () 76 (let ((as (or (sb-ext:posix-getenv "ARM_AS") "arm-none-eabi-as")) 77 (objcopy (or (sb-ext:posix-getenv "ARM_OBJCOPY") "arm-none-eabi-objcopy"))) 78 (with-open-file (s "/tmp/asm-test.s" :direction :output :if-exists :supersede) 79 (format s ".syntax unified~%.thumb~%.cpu cortex-m4~%.fpu fpv4-sp-d16~%") 80 (dolist (c *cases*) (format s " ~a~%" (cdr c)))) 81 (assert (zerop (sb-ext:process-exit-code 82 (sb-ext:run-program as '("/tmp/asm-test.s" "-o" "/tmp/asm-test.o") 83 :search t :output t :error t)))) 84 (sb-ext:run-program objcopy '("-O" "binary" "-j" ".text" "/tmp/asm-test.o" "/tmp/asm-test.bin") 85 :search t :output t :error t) 86 (with-open-file (s "/tmp/asm-test.bin" :element-type '(unsigned-byte 8)) 87 (let ((v (make-array (file-length s) :element-type '(unsigned-byte 8)))) (read-sequence v s) v)))) 88 89 (defun repeated-refs-ok () 90 "Regression: sb-assem emit-back-patch resolved only the first of adjacent references." 91 (new-segment) 92 (let ((a (label))) 93 (abs32 a) (abs32 a) (li :r4 a) (li :r4 a) (b a) (b a) (mark a) (nop)) 94 (let ((v (segment-bytes))) 95 (and (equalp (subseq v 0 4) (subseq v 4 8)) (plusp (aref v 3)) 96 (equalp (subseq v 8 16) (subseq v 16 24)) (plusp (aref v 8)) 97 (= (aref v 27) #xB8) (= (aref v 31) #xB8)))) ; both b.w: hw2 = B8xx (9000 | J1 J2 set) 98 99 (multiple-value-bind (mine ranges) (run-lisp) 100 (let ((gas (run-gas)) (fail 0) (n 0)) 101 (dolist (r ranges) 102 (destructuring-bind (a z text) r 103 (unless (= a z) 104 (incf n) 105 (let ((m (subseq mine a z)) (g (subseq gas a (min z (length gas))))) 106 (unless (equalp m g) 107 (incf fail) 108 (format t "FAIL ~a: mine ~{~2,'0x~^ ~} gas ~{~2,'0x~^ ~}~%" 109 (substitute #\Space #\Newline text) (coerce m 'list) (coerce g 'list))))))) 110 (incf n) 111 (unless (repeated-refs-ok) (incf fail) (format t "FAIL repeated references to one label~%")) 112 (unless (= (length mine) (length gas)) 113 (incf fail) (format t "FAIL total length mine ~d gas ~d~%" (length mine) (length gas))) 114 (format t "asm-test: ~d forms, ~d failed~%" n fail) 115 (sb-ext:exit :code (if (zerop fail) 0 1))))