1.0.3.5: slightly different SEQUENCE type handling.
[sbcl.git] / src / compiler / x86-64 / target-insts.lisp
1 ;;;; target-only stuff from CMU CL's src/compiler/x86/insts.lisp
2 ;;;;
3 ;;;; i.e. stuff which was in CMU CL's insts.lisp file, but which in
4 ;;;; the SBCL build process can't be compiled into code for the
5 ;;;; cross-compilation host
6
7 ;;;; This software is part of the SBCL system. See the README file for
8 ;;;; more information.
9 ;;;;
10 ;;;; This software is derived from the CMU CL system, which was
11 ;;;; written at Carnegie Mellon University and released into the
12 ;;;; public domain. The software is in the public domain and is
13 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
14 ;;;; files for more information.
15
16 (in-package "SB!VM")
17
18 ;;; Prints a memory reference to STREAM. VALUE is a list of
19 ;;; (BASE-REG OFFSET INDEX-REG INDEX-SCALE), where any component may be
20 ;;; missing or nil to indicate that it's not used or has the obvious
21 ;;; default value (e.g., 1 for the index-scale). BASE-REG can be the
22 ;;; symbol RIP or a full register, INDEX-REG a full register. If WIDTH
23 ;;; is non-nil it should be one of the symbols :BYTE, :WORD, :DWORD or
24 ;;; :QWORD and a corresponding size indicator is printed first.
25 (defun print-mem-access (value width stream dstate)
26   (declare (type list value)
27            (type (member nil :byte :word :dword :qword) width)
28            (type stream stream)
29            (type sb!disassem:disassem-state dstate))
30   (when width
31     (princ width stream)
32     (princ '| PTR | stream))
33   (write-char #\[ stream)
34   (let ((firstp t) (rip-p nil))
35     (macrolet ((pel ((var val) &body body)
36                  ;; Print an element of the address, maybe with
37                  ;; a leading separator.
38                  `(let ((,var ,val))
39                     (when ,var
40                       (unless firstp
41                         (write-char #\+ stream))
42                       ,@body
43                       (setq firstp nil)))))
44       (pel (base-reg (first value))
45         (cond ((eql 'rip base-reg)
46                (setf rip-p t)
47                (princ base-reg stream))
48               (t
49                (print-addr-reg base-reg stream dstate))))
50       (pel (index-reg (third value))
51         (print-addr-reg index-reg stream dstate)
52         (let ((index-scale (fourth value)))
53           (when (and index-scale (not (= index-scale 1)))
54             (write-char #\* stream)
55             (princ index-scale stream))))
56       (let ((offset (second value)))
57         (when (and offset (or firstp (not (zerop offset))))
58           (unless (or firstp (minusp offset))
59             (write-char #\+ stream))
60           (cond
61             (rip-p
62              (princ offset stream)
63              (let ((addr (+ offset (sb!disassem:dstate-next-addr dstate))))
64                (when (plusp addr)
65                  (or (nth-value 1
66                                 (sb!disassem::note-code-constant-absolute
67                                  addr dstate))
68                      (sb!disassem:maybe-note-assembler-routine addr
69                                                                nil
70                                                                dstate)))))
71             (firstp
72              (progn
73                (sb!disassem:princ16 offset stream)
74                (or (minusp offset)
75                    (nth-value 1
76                               (sb!disassem::note-code-constant-absolute offset dstate))
77                    (sb!disassem:maybe-note-assembler-routine offset
78                                                              nil
79                                                              dstate))))
80             (t
81              (princ offset stream)))))))
82   (write-char #\] stream))