x86-64: put vector widetag and maybe length w/byte-sized store
[sbcl.git] / tests / assembler.pure.lisp
blob949eb7a3f226d45ddab57224c035d59cc2c8d286
1 ;;;; tests for assembler/disassembler
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
6 ;;;; While most of SBCL is derived from the CMU CL system, the test
7 ;;;; files (like this one) were written from scratch after the fork
8 ;;;; from CMU CL.
9 ;;;;
10 ;;;; This software is in the public domain and is provided with
11 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
12 ;;;; more information.
14 (in-package sb-vm)
16 (load "test-util.lisp")
17 (use-package :test-util)
19 ;; this is architecture-agnostic
20 (defun test-assemble (inst expect)
21 (let ((segment (sb-assem:make-segment :type :regular)))
22 (apply (sb-assem::inst-emitter-symbol (car inst)) segment nil (cdr inst))
23 (let* ((buf (sb-assem::segment-buffer segment))
24 (string
25 (with-output-to-string (stream)
26 (with-pinned-objects (buf)
27 (let ((sb-disassem:*disassem-location-column-width* 0))
28 (sb-disassem:disassemble-memory
29 (sap-int (vector-sap buf))
30 (sb-assem::segment-current-posn segment)
31 :stream stream)))))
32 (line (string-left-trim'(#\; #\ )
33 (subseq string (1+ (position #\newline string))
34 (1- (length string)))))) ; chop final newline
35 (assert (string= line expect)))))
37 (with-test (:name :assemble-movti-instruction :skipped-on '(not :x86-64))
38 (flet ((test-movnti (dst src expect)
39 (test-assemble `(movnti ,dst ,src) expect)))
40 (test-movnti (make-ea :dword :base rdi-tn :disp 57) eax-tn
41 "0FC34739 MOVNTI [RDI+57], EAX")
42 (test-movnti (make-ea :qword :base rax-tn) r12-tn
43 "4C0FC320 MOVNTI [RAX], R12")))
45 (with-test (:name :assemble-crc32 :skipped-on '(not :x86-64))
46 ;; Destination size = :DWORD
47 (test-assemble `(crc32 ,eax-tn ,(make-ea :byte :base rbp-tn))
48 "F20F38F04500 CRC32 EAX, BYTE PTR [RBP]")
49 (test-assemble `(crc32 ,eax-tn ,(make-ea :word :base rbp-tn))
50 "66F20F38F14500 CRC32 EAX, WORD PTR [RBP]")
51 (test-assemble `(crc32 ,eax-tn ,(make-ea :dword :base rbp-tn))
52 "F20F38F14500 CRC32 EAX, DWORD PTR [RBP]")
53 ;; these check that the presence of REX does not per se change the width.
54 (test-assemble `(crc32 ,r9d-tn ,(make-ea :byte :base r14-tn :index r15-tn))
55 "F2470F38F00C3E CRC32 R9D, BYTE PTR [R14+R15]")
56 (test-assemble `(crc32 ,r9d-tn ,(make-ea :word :base r14-tn :index r15-tn))
57 "66F2470F38F10C3E CRC32 R9D, WORD PTR [R14+R15]")
58 (test-assemble `(crc32 ,r9d-tn ,(make-ea :dword :base r14-tn :index r15-tn))
59 "F2470F38F10C3E CRC32 R9D, DWORD PTR [R14+R15]")
60 ;; Destination size = :QWORD
61 (test-assemble `(crc32 ,rax-tn ,(make-ea :byte :base rbp-tn))
62 "F2480F38F04500 CRC32 RAX, BYTE PTR [RBP]")
63 (test-assemble `(crc32 ,rax-tn ,(make-ea :qword :base rbp-tn))
64 "F2480F38F14500 CRC32 RAX, QWORD PTR [RBP]")
65 ;; now with high regs
66 (test-assemble `(crc32 ,r9-tn ,(make-ea :byte :base r14-tn :index r15-tn))
67 "F24F0F38F00C3E CRC32 R9, BYTE PTR [R14+R15]")
68 (test-assemble `(crc32 ,r9-tn ,(make-ea :qword :base r14-tn :index r15-tn))
69 "F24F0F38F10C3E CRC32 R9, QWORD PTR [R14+R15]"))
71 (with-test (:name :disassemble-arith-insts :skipped-on '(not (or :x86 :x86-64)))
72 (flet ((try (inst expect)
73 (let ((p (search "$fp" expect)))
74 (when p
75 (setq expect
76 (concatenate 'string (subseq expect 0 p)
77 #+x86 "EBP" #+x86-64 "RBP"
78 (subseq expect (+ p 3))))))
79 (test-assemble inst expect))
80 (memref (size) (make-ea size :base #+x86 ebp-tn #+x86-64 rbp-tn)))
81 (try `(bt ,(memref :word) ,ax-tn) "660FA34500 BT WORD PTR [$fp], AX")
82 (try `(bt ,(memref :dword) ,eax-tn) "0FA34500 BT DWORD PTR [$fp], EAX")
83 #+x86-64
84 (try `(bt ,(memref :qword) ,eax-tn) "480FA34500 BT QWORD PTR [$fp], RAX")
85 (try `(bt ,(memref :word) 3) "660FBA650003 BT WORD PTR [$fp], 3")
86 (try `(bt ,(memref :dword) 3) "0FBA650003 BT DWORD PTR [$fp], 3")
87 #+x86-64
88 (try `(bt ,(memref :qword) 3) "480FBA650003 BT QWORD PTR [$fp], 3")
90 (try `(shld ,eax-tn ,ebx-tn :cl) "0FA5D8 SHLD EAX, EBX, CL")
91 (try `(shld ,(memref :word) ,bx-tn 6) "660FA45D0006 SHLD [$fp], BX, 6")
92 (try `(shld ,(memref :dword) ,ebx-tn 6) "0FA45D0006 SHLD [$fp], EBX, 6")
93 #+x86-64
94 (try `(shld ,(memref :qword) ,rbx-tn 6) "480FA45D0006 SHLD [$fp], RBX, 6")
96 (try `(add ,al-tn #x7f) "047F ADD AL, 127")
97 (try `(add ,ax-tn #x7fff) "6605FF7F ADD AX, 32767")
98 (try `(add ,eax-tn #x7fffffff) "05FFFFFF7F ADD EAX, 2147483647")
99 #+x86-64
100 (try `(add ,rax-tn #x7fffffff) "4805FFFFFF7F ADD RAX, 2147483647")
102 (try `(add ,bl-tn #x7f) "80C37F ADD BL, 127")
103 (try `(add ,bx-tn #x7fff) "6681C3FF7F ADD BX, 32767")
104 (try `(add ,ebx-tn #x7fffffff) "81C3FFFFFF7F ADD EBX, 2147483647")
105 #+x86-64
106 (try `(add ,rbx-tn #x7fffffff) "4881C3FFFFFF7F ADD RBX, 2147483647")
108 (try `(add ,ax-tn #x7f) "6683C07F ADD AX, 127")
109 (try `(add ,eax-tn #x7f) "83C07F ADD EAX, 127")
110 #+x86-64
111 (try `(add ,rax-tn #x7f) "4883C07F ADD RAX, 127")
113 (try `(add ,(memref :byte) ,cl-tn) "004D00 ADD [$fp], CL")
114 (try `(add ,(memref :word) ,cx-tn) "66014D00 ADD [$fp], CX")
115 (try `(add ,(memref :dword) ,ecx-tn) "014D00 ADD [$fp], ECX")
116 #+x86-64
117 (try `(add ,(memref :qword) ,rcx-tn) "48014D00 ADD [$fp], RCX")
118 (try `(add ,cl-tn ,(memref :byte)) "024D00 ADD CL, [$fp]")
119 (try `(add ,cx-tn ,(memref :word)) "66034D00 ADD CX, [$fp]")
120 (try `(add ,ecx-tn ,(memref :dword)) "034D00 ADD ECX, [$fp]")
121 #+x86-64
122 (try `(add ,rcx-tn ,(memref :qword)) "48034D00 ADD RCX, [$fp]")