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 (defun print-mem-access (value stream print-size-p dstate)
  19   (declare (type list value)
  20            (type stream stream)
  21            (type (member t nil) print-size-p)
  22            (type sb!disassem:disassem-state dstate))
  23   (when print-size-p
  24     (princ (sb!disassem:dstate-get-prop dstate 'width) stream)
  25     (princ '| PTR | stream))
  26   (write-char #\[ stream)
  27   (let ((firstp t) (rip-p nil))
  28     (macrolet ((pel ((var val) &body body)
  29                  ;; Print an element of the address, maybe with
  30                  ;; a leading separator.
  31                  `(let ((,var ,val))
  32                     (when ,var
  33                       (unless firstp
  34                         (write-char #\+ stream))
  35                       ,@body
  36                       (setq firstp nil)))))
  37       (pel (base-reg (first value))
  38         (cond ((eql 'rip base-reg)
  39                (setf rip-p t)
  40                (princ base-reg stream))
  41               (t
  42                (print-addr-reg base-reg stream dstate))))
  43       (pel (index-reg (third value))
  44         (print-addr-reg index-reg stream dstate)
  45         (let ((index-scale (fourth value)))
  46           (when (and index-scale (not (= index-scale 1)))
  47             (write-char #\* stream)
  48             (princ index-scale stream))))
  49       (let ((offset (second value)))
  50         (when (and offset (or firstp (not (zerop offset))))
  51           (unless (or firstp (minusp offset))
  52             (write-char #\+ stream))
  53           (cond
  54             (rip-p
  55              (princ offset stream)
  56              (let ((addr (+ offset (sb!disassem:dstate-next-addr dstate))))
  57                (or (nth-value 1
  58                               (sb!disassem::note-code-constant-absolute
  59                                addr dstate))
  60                    (sb!disassem:maybe-note-assembler-routine addr
  61                                                              nil
  62                                                              dstate))))
  63             (firstp
  64              (progn
  65                (sb!disassem:princ16 offset stream)
  66                (or (minusp offset)
  67                    (nth-value 1
  68                               (sb!disassem::note-code-constant-absolute offset dstate))
  69                    (sb!disassem:maybe-note-assembler-routine offset
  70                                                              nil
  71                                                              dstate))))
  72              (t
  73               (princ offset stream)))))))
  74   (write-char #\] stream))