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!X86-64-ASM")
  17
  18 ;;; Print to STREAM the name of the general-purpose register encoded by
  19 ;;; VALUE and of size WIDTH. For robustness, the high byte registers
  20 ;;; (AH, BH, CH, DH) are correctly detected, too, although the compiler
  21 ;;; does not use them.
  22 (defun print-reg-with-width (value width stream dstate)
  23   (declare (type full-reg value)
  24            (type stream stream)
  25            (type disassem-state dstate))
  26   (princ (if (and (eq width :byte)
  27                   (<= 4 value 7)
  28                   (not (dstate-get-inst-prop dstate +rex+)))
  29              (aref *high-byte-reg-names* (- value 4))
  30              (aref (ecase width
  31                      (:byte *byte-reg-names*)
  32                      (:word *word-reg-names*)
  33                      (:dword *dword-reg-names*)
  34                      (:qword *qword-reg-names*))
  35                    value))
  36          stream)
  37   ;; XXX plus should do some source-var notes
  38   )
  39
  40 (defun print-reg (value stream dstate)
  41   (declare (type full-reg value)
  42            (type stream stream)
  43            (type disassem-state dstate))
  44   (print-reg-with-width value
  45                         (inst-operand-size dstate)
  46                         stream
  47                         dstate))
  48
  49 (defun print-reg-default-qword (value stream dstate)
  50   (declare (type full-reg value)
  51            (type stream stream)
  52            (type disassem-state dstate))
  53   (print-reg-with-width value
  54                         (inst-operand-size-default-qword dstate)
  55                         stream
  56                         dstate))
  57
  58 ;; Print a reg that can only be a :DWORD or :QWORD.
  59 ;; Avoid use of INST-OPERAND-SIZE because it's wrong for this type of operand.
  60 (defun print-d/q-word-reg (value stream dstate)
  61   (declare (type full-reg value)
  62            (type stream stream)
  63            (type disassem-state dstate))
  64   (print-reg-with-width value
  65                         (if (dstate-get-inst-prop dstate +rex-w+) :qword :dword)
  66                         stream
  67                         dstate))
  68
  69 (defun print-byte-reg (value stream dstate)
  70   (declare (type full-reg value)
  71            (type stream stream)
  72            (type disassem-state dstate))
  73   (print-reg-with-width value :byte stream dstate))
  74
  75 (defun print-addr-reg (value stream dstate)
  76   (declare (type full-reg value)
  77            (type stream stream)
  78            (type disassem-state dstate))
  79   (print-reg-with-width value +default-address-size+ stream dstate))
  80
  81 ;;; Print a register or a memory reference of the given WIDTH.
  82 ;;; If SIZED-P is true, add an explicit size indicator for memory
  83 ;;; references.
  84 (defun print-reg/mem-with-width (value width sized-p stream dstate)
  85   (declare (type (or list full-reg) value)
  86            (type (member :byte :word :dword :qword) width)
  87            (type boolean sized-p)
  88            (type stream stream)
  89            (type disassem-state dstate))
  90   (if (typep value 'full-reg)
  91       (print-reg-with-width value width stream dstate)
  92       (print-mem-ref (if sized-p :sized-ref :ref) value width stream dstate)))
  93
  94 ;;; Print a register or a memory reference. The width is determined by
  95 ;;; calling INST-OPERAND-SIZE.
  96 (defun print-reg/mem (value stream dstate)
  97   (declare (type (or list full-reg) value)
  98            (type stream stream)
  99            (type disassem-state dstate))
 100   (print-reg/mem-with-width
 101    value (inst-operand-size dstate) nil stream dstate))
 102
 103 ;; Same as print-reg/mem, but prints an explicit size indicator for
 104 ;; memory references.
 105 (defun print-sized-reg/mem (value stream dstate)
 106   (declare (type (or list full-reg) value)
 107            (type stream stream)
 108            (type disassem-state dstate))
 109   (print-reg/mem-with-width
 110    value (inst-operand-size dstate) t stream dstate))
 111
 112 ;;; Same as print-sized-reg/mem, but with a default operand size of
 113 ;;; :qword.
 114 (defun print-sized-reg/mem-default-qword (value stream dstate)
 115   (declare (type (or list full-reg) value)
 116            (type stream stream)
 117            (type disassem-state dstate))
 118   (print-reg/mem-with-width
 119    value (inst-operand-size-default-qword dstate) t stream dstate))
 120
 121 (defun print-sized-byte-reg/mem (value stream dstate)
 122   (declare (type (or list full-reg) value)
 123            (type stream stream)
 124            (type disassem-state dstate))
 125   (print-reg/mem-with-width value :byte t stream dstate))
 126
 127 (defun print-sized-word-reg/mem (value stream dstate)
 128   (declare (type (or list full-reg) value)
 129            (type stream stream)
 130            (type disassem-state dstate))
 131   (print-reg/mem-with-width value :word t stream dstate))
 132
 133 (defun print-sized-dword-reg/mem (value stream dstate)
 134   (declare (type (or list full-reg) value)
 135            (type stream stream)
 136            (type disassem-state dstate))
 137   (print-reg/mem-with-width value :dword t stream dstate))
 138
 139 (defun print-label (value stream dstate)
 140   (declare (ignore dstate))
 141   (princ16 value stream))
 142
 143 (defun print-xmmreg (value stream dstate)
 144   (declare (type xmmreg value) (type stream stream) (ignore dstate))
 145   (format stream "XMM~d" value))
 146
 147 (defun print-xmmreg/mem (value stream dstate)
 148   (declare (type (or list xmmreg) value)
 149            (type stream stream)
 150            (type disassem-state dstate))
 151   (if (typep value 'xmmreg)
 152       (print-xmmreg value stream dstate)
 153       (print-mem-ref :ref value nil stream dstate)))
 154
 155 (defun print-imm/asm-routine (value stream dstate)
 156   (maybe-note-assembler-routine value nil dstate)
 157   (maybe-note-static-symbol value dstate)
 158   (princ value stream))
 159
 160 ;;; Prints a memory reference to STREAM. VALUE is a list of
 161 ;;; (BASE-REG OFFSET INDEX-REG INDEX-SCALE), where any component may be
 162 ;;; missing or nil to indicate that it's not used or has the obvious
 163 ;;; default value (e.g., 1 for the index-scale). BASE-REG can be the
 164 ;;; symbol RIP or a full register, INDEX-REG a full register. If WIDTH
 165 ;;; is non-nil it should be one of the symbols :BYTE, :WORD, :DWORD or
 166 ;;; :QWORD; a corresponding size indicator is printed if MODE is :SIZED-REF.
 167 ;;; The rationale for supplying WIDTH while eliding a pointer-size qualifier
 168 ;;; is that proper dereferencing of RIP-relative constants requires a size,
 169 ;;; but in other cases would only add clutter, since a source/destination
 170 ;;; register implies a size.
 171 ;;;
 172 (defun print-mem-ref (mode value width stream dstate)
 173   ;; :COMPUTE is used for the LEA instruction - it informs this function
 174   ;; that the address is not a memory reference below which is confined
 175   ;; the disassembly - the heuristic for detecting the start of unboxed data.
 176   ;; LEA is sometimes used to compute the start of a local function for
 177   ;; allocate-closures, and it points to valid instructions, not data.
 178   (declare (type (member :ref :sized-ref :compute) mode)
 179            (type list value)
 180            (type (member nil :byte :word :dword :qword) width)
 181            (type stream stream)
 182            (type disassem-state dstate))
 183   (when (and width (eq mode :sized-ref))
 184     (princ width stream)
 185     (princ '| PTR | stream))
 186   (write-char #\[ stream)
 187   (let ((firstp t) (rip-p nil))
 188     (macrolet ((pel ((var val) &body body)
 189                  ;; Print an element of the address, maybe with
 190                  ;; a leading separator.
 191                  `(let ((,var ,val))
 192                     ;; Compiler knows that FIRSTP is T in first call to PEL.
 193                     #-sb-xc-host
 194                     (declare (muffle-conditions code-deletion-note))
 195                     (when ,var
 196                       (unless firstp
 197                         (write-char #\+ stream))
 198                       ,@body
 199                       (setq firstp nil)))))
 200       (pel (base-reg (first value))
 201         (cond ((eql 'rip base-reg)
 202                (setf rip-p t)
 203                (princ base-reg stream))
 204               (t
 205                (print-addr-reg base-reg stream dstate))))
 206       (pel (index-reg (third value))
 207         (print-addr-reg index-reg stream dstate)
 208         (let ((index-scale (fourth value)))
 209           (when (and index-scale (not (= index-scale 1)))
 210             (write-char #\* stream)
 211             (princ index-scale stream))))
 212       (let ((offset (second value)))
 213         (when (and offset (or firstp (not (zerop offset))))
 214           (unless (or firstp (minusp offset))
 215             (write-char #\+ stream))
 216           (cond
 217             (rip-p
 218              (princ offset stream)
 219              (unless (eq mode :compute)
 220                (let ((addr (+ offset (dstate-next-addr dstate))))
 221                  ;; The origin is zero when disassembling into a trace-file.
 222                  ;; Don't crash on account of it.
 223                  (when (plusp addr)
 224                    (or (nth-value
 225                         1 (note-code-constant-absolute addr dstate width))
 226                        (maybe-note-assembler-routine addr nil dstate)
 227                        ;; Show the absolute address and maybe the contents.
 228                        (note (format nil "[#x~x]~@[ = ~x~]"
 229                                      addr
 230                                      (case width
 231                                        (:qword
 232                                         (unboxed-constant-ref
 233                                          dstate
 234                                          (+ (dstate-next-offs dstate) offset)))))
 235                              dstate))))))
 236             (firstp
 237                (princ16 offset stream)
 238                (or (minusp offset)
 239                    (nth-value 1 (note-code-constant-absolute offset dstate))
 240                    (maybe-note-assembler-routine offset nil dstate)
 241                    ;; Static symbols coming frorm CELL-REF
 242                    (maybe-note-static-symbol (+ offset (- other-pointer-lowtag
 243                                                           n-word-bytes))
 244                                              dstate)))
 245             (t
 246              (princ offset stream)))))))
 247   (write-char #\] stream)
 248   #!+sb-thread
 249   (let ((disp (second value)))
 250     (when (and (eql (first value) #.(ash (tn-offset sb!vm::thread-base-tn) -1))
 251                (not (third value)) ; no index
 252                (typep disp '(integer 0 *)) ; positive displacement
 253                (seg-code (dstate-segment dstate)))
 254       ;; Try to reverse-engineer which thread-local binding this is
 255       (let* ((code (seg-code (dstate-segment dstate)))
 256              (header-n-words
 257               (ash (sap-ref-word (int-sap (get-lisp-obj-address code))
 258                                  (- other-pointer-lowtag)) -8))
 259              (tls-index (ash disp (- n-fixnum-tag-bits))))
 260         (loop for word-num from code-constants-offset below header-n-words
 261               for obj = (code-header-ref code word-num)
 262               when (and (symbolp obj) (= (symbol-tls-index obj) tls-index))
 263               do (return-from print-mem-ref
 264                    (note (lambda (stream) (format stream "tls: ~S" obj))
 265                          dstate))))
 266       ;; Or maybe we're looking at the 'struct thread' itself
 267       (when (< disp max-interrupts)
 268         (let* ((thread-slots
 269                 (load-time-value
 270                  (primitive-object-slots
 271                   (find 'sb!vm::thread *primitive-objects*
 272                         :key #'primitive-object-name)) t))
 273                (slot (find (ash disp (- word-shift)) thread-slots
 274                            :key #'slot-offset)))
 275           (when slot
 276             (return-from print-mem-ref
 277               (note (lambda (stream)
 278                       (format stream "thread.~(~A~)" (slot-name slot)))
 279                     dstate))))))))
 280
 281 ;; Figure out whether LEA should print its EA with just the stuff in brackets,
 282 ;; or additionally show the EA as either a label or a hex literal.
 283 (defun lea-print-ea (value stream dstate)
 284   (let ((width (inst-operand-size dstate))
 285         (addr nil)
 286         (fmt "= #x~x"))
 287     (etypecase value
 288       (list
 289        ;; Indicate to PRINT-MEM-REF that this is not a memory access.
 290        (print-mem-ref :compute value width stream dstate)
 291        (when (eq (first value) 'rip)
 292          (setq addr (+ (dstate-next-addr dstate) (second value)))))
 293
 294       ;; We're robust in allowing VALUE to be an integer (a register),
 295       ;; though LEA Rx,Ry is an illegal instruction.
 296       ;; Test this before INTEGER since the types overlap.
 297       (full-reg
 298        (print-reg-with-width value width stream dstate))
 299
 300       ((or string integer)
 301        ;; A label for the EA should not print as itself, but as the decomposed
 302        ;; addressing mode so that [ADDR] and [RIP+disp] are unmistakable.
 303        ;; We can see an INTEGER here because LEA-COMPUTE-LABEL is always called
 304        ;; on the operand to LEA, and it will compute an absolute address based
 305        ;; off RIP when possible. If :use-labels NIL was specified, there is
 306        ;; no hashtable of address to string, so we get the address.
 307        ;; But ordinarily we get the string. Either way, the r/m arg reveals the
 308        ;; EA calculation. DCHUNK-ZERO is a meaningless value - any would do -
 309        ;; because the EA was computed in a prefilter.
 310        (print-mem-ref :compute (reg-r/m-inst-r/m-arg dchunk-zero dstate)
 311                       width stream dstate)
 312        (setq addr value)
 313        (when (stringp value) (setq fmt "= ~A"))))
 314     (when addr
 315       (note (lambda (s) (format s fmt addr)) dstate))))
 316
 317 (defun unboxed-constant-ref (dstate segment-offset)
 318   (let* ((seg (dstate-segment dstate))
 319          (code-offset
 320           (sb!disassem::segment-offs-to-code-offs segment-offset seg))
 321          (unboxed-range (sb!disassem::seg-unboxed-data-range seg)))
 322     (and unboxed-range
 323          (<= (car unboxed-range) code-offset (cdr unboxed-range))
 324          (sap-ref-int (dstate-segment-sap dstate)
 325                       segment-offset n-word-bytes
 326                       (dstate-byte-order dstate)))))
 327
 328 ;;;; interrupt instructions
 329
 330 (defun break-control (chunk inst stream dstate)
 331   (declare (ignore inst))
 332   (flet ((nt (x) (if stream (note x dstate))))
 333     (case #!-ud2-breakpoints (byte-imm-code chunk dstate)
 334           #!+ud2-breakpoints (word-imm-code chunk dstate)
 335       (#.error-trap
 336        (nt "error trap")
 337        (handle-break-args #'snarf-error-junk stream dstate))
 338       (#.cerror-trap
 339        (nt "cerror trap")
 340        (handle-break-args #'snarf-error-junk stream dstate))
 341       (#.breakpoint-trap
 342        (nt "breakpoint trap"))
 343       (#.pending-interrupt-trap
 344        (nt "pending interrupt trap"))
 345       (#.halt-trap
 346        (nt "halt trap"))
 347       (#.fun-end-breakpoint-trap
 348        (nt "function end breakpoint trap"))
 349       (#.single-step-around-trap
 350        (nt "single-step trap (around)"))
 351       (#.single-step-before-trap
 352        (nt "single-step trap (before)"))
 353       (#.invalid-arg-count-trap
 354        (nt "Invalid argument count trap")))))