tests/assembler.pure.lisp

   1 ;;;; tests for assembler/disassembler
   2
   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.
  13
  14 (in-package sb-vm)
  15
  16 (load "test-util.lisp")
  17 (use-package :test-util)
  18
  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)))))
  36
  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")))
  44
  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]"))
  70
  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")
  89     ;;
  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")
  95     ;;
  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")
 101     ;;
 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")
 107     ;;
 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")
 112     ;;
 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]")
 123     ))