Make INFO's compiler-macro more forgiving.
[sbcl.git] / tests / assembler.pure.lisp
blobc4cb4caad4ce85c8653c985dcfa071d877150195
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 (symbolicate (car inst) "-INST-EMITTER") 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 (assert (string= (subseq string (1+ (position #\newline string))
33 (1- (length string))) ; chop final newline
34 expect)))))
36 (with-test (:name :assemble-movti-instruction :skipped-on '(not :x86-64))
37 (flet ((test-movnti (dst src expect)
38 (test-assemble `(movnti ,dst ,src) expect)))
39 (test-movnti (make-ea :dword :base rdi-tn :disp 57) eax-tn
40 "; 0FC34739 MOVNTI [RDI+57], EAX")
41 (test-movnti (make-ea :qword :base rax-tn) r12-tn
42 "; 4C0FC320 MOVNTI [RAX], R12")))