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))