src/compiler/arm64/target-insts.lisp

   1 (in-package "SB!ARM64-ASM")
   2
   3 (defun current-instruction (dstate &optional (offset 0))
   4   (sap-ref-int (dstate-segment-sap dstate)
   5                (+ (dstate-cur-offs dstate) offset)
   6                n-word-bytes
   7                (dstate-byte-order dstate)))
   8
   9 (defun 32-bit-register-p (dstate)
  10   (not (logbitp 31 (current-instruction dstate))))
  11
  12 (defun print-lsl-alias-name (value stream dstate)
  13   (declare (ignore dstate))
  14   (destructuring-bind (immr imms) value
  15     (princ (if (and (/= imms 63)
  16                     (= (1+ imms) immr))
  17                'lsl
  18                'ubfm)
  19            stream)))
  20
  21 (defun print-lsl-alias (value stream dstate)
  22   (declare (ignore dstate))
  23   (destructuring-bind (immr imms) value
  24     (if (and (/= imms 63)
  25              (= (1+ imms) immr))
  26         (format stream "#~d" (- 63 imms))
  27         (format stream "#~d, #~d" immr imms))))
  28
  29 (defun print-mem-bar-kind (value stream dstate)
  30   (declare (ignore dstate))
  31   (let ((kind (car (rassoc value **mem-bar-kinds**))))
  32     (if kind
  33         (princ kind stream)
  34         (format stream "#~d" value))))
  35
  36 (defun print-shift (value stream dstate)
  37   (declare (ignore dstate))
  38   (destructuring-bind (kind amount) value
  39     (when (plusp amount)
  40       (princ ", " stream)
  41       (princ (ecase kind
  42                (#b00 "LSL")
  43                (#b01 "LSR")
  44                (#b10 "ASR")
  45                (#b11 "ROR"))
  46              stream)
  47       (format stream " #~d" amount))))
  48
  49 (defun print-wide-shift (value stream dstate)
  50   (declare (ignore dstate))
  51   (when (plusp value)
  52     (format stream ", LSL #~d" (* value 16))))
  53
  54 (defun print-2-bit-shift (value stream dstate)
  55   (declare (ignore dstate))
  56   (when (= value 1)
  57     (princ ", LSL #12" stream)))
  58
  59 (defun print-extend (value stream dstate)
  60   (destructuring-bind (kind amount) value
  61     (let* ((inst (current-instruction dstate))
  62            (rd (ldb (byte 5 0) inst))
  63            (rn (ldb (byte 5 5) inst)))
  64       (princ ", " stream)
  65       (princ (if (and (= kind #b011)
  66                       (or (= rd nsp-offset)
  67                           (= rn nsp-offset)))
  68                  "LSL"
  69                  (ecase kind
  70                    (#b000 "UXTB")
  71                    (#b001 "UXTH")
  72                    (#b010 "UXTW")
  73                    (#b011 "UXTX")
  74                    (#b100 "SXTB")
  75                    (#b101 "SXTH")
  76                    (#b110 "SXTW")
  77                    (#b111 "SXTX")))
  78              stream))
  79     (when (plusp amount)
  80       (format stream " #~d" amount))))
  81
  82 (defun print-ldr-str-extend (value stream dstate)
  83   (declare (ignore dstate))
  84   (destructuring-bind (kind amount) value
  85     (unless (and (= kind #b011)
  86                  (zerop amount))
  87       (princ ", " stream)
  88       (princ (ecase kind
  89                (#b010 "UXTW")
  90                (#b011 "LSL")
  91                (#b110 "SXTW")
  92                (#b111 "SXTX"))
  93              stream))
  94     (when (plusp amount)
  95       (princ " #3" stream))))
  96
  97 (defun print-immediate (value stream dstate)
  98   (declare (ignore dstate))
  99   (format stream "#~D" value))
 100
 101 (defun print-test-branch-immediate (value stream dstate)
 102   (declare (ignore dstate))
 103   (format stream "#~D"
 104           (dpb (car value) (byte 1 5) (car value))))
 105
 106 (defun decode-scaled-immediate (value)
 107   (destructuring-bind (size opc value simd) value
 108     (if (= simd 1)
 109         (ash value (logior (ash opc 2) size))
 110         (ash value size))))
 111
 112 (defun print-scaled-immediate (value stream dstate)
 113   (declare (ignore dstate))
 114   (format stream "#~D" (if (consp value)
 115                            (decode-scaled-immediate value)
 116                            (ash value 3))))
 117
 118 (defun print-logical-immediate (value stream dstate)
 119   (declare (ignore dstate))
 120   (format stream "#~D" (apply #'decode-logical-immediate value)))
 121
 122 (defun print-imm-writeback (value stream dstate)
 123   (declare (ignore dstate))
 124   (destructuring-bind (imm mode) value
 125     (let ((imm (sign-extend imm 9)))
 126       (if (zerop imm)
 127           (princ "]" stream)
 128           (ecase mode
 129             (#b00
 130              (format stream ", #~D]" imm))
 131             (#b01
 132              (format stream "], #~D" imm))
 133             (#b11
 134              (format stream ", #~D]!" imm)))))))
 135
 136 (defun decode-pair-scaled-immediate (opc value simd)
 137   (ash (sign-extend value 7)
 138        (+ 2 (ash opc (- (logxor 1 simd))))))
 139
 140 (defun print-pair-imm-writeback (value stream dstate)
 141   (declare (ignore dstate))
 142   (destructuring-bind (mode &rest imm) value
 143     (let ((imm (apply #'decode-pair-scaled-immediate imm)))
 144       (if (zerop imm)
 145           (princ "]" stream)
 146           (ecase mode
 147             (#b01
 148              (format stream "], #~D" imm))
 149             (#b10
 150              (format stream ", #~D]" imm))
 151             (#b11
 152              (format stream ", #~D]!" imm)))))))
 153
 154 (defun print-w-reg (value stream dstate)
 155   (declare (ignore dstate))
 156   (princ "W" stream)
 157   (princ (aref *register-names* value) stream))
 158
 159 (defun print-x-reg (value stream dstate)
 160   (declare (ignore dstate))
 161   (princ (aref *register-names* value) stream))
 162
 163 (defun print-reg (value stream dstate)
 164   (when (32-bit-register-p dstate)
 165     (princ "W" stream))
 166   (princ (aref *register-names* value) stream))
 167
 168 (defun print-x-reg-sp (value stream dstate)
 169   (declare (ignore dstate))
 170   (if (= value nsp-offset)
 171       (princ "NSP" stream)
 172       (princ (aref *register-names* value) stream)))
 173
 174 (defun print-reg-sp (value stream dstate)
 175   (when (32-bit-register-p dstate)
 176     (princ "W" stream))
 177   (if (= value nsp-offset)
 178       (princ "NSP" stream)
 179       (princ (aref *register-names* value) stream)))
 180
 181 (defun print-reg-float-reg (value stream dstate)
 182   (let* ((inst (current-instruction dstate))
 183          (v (ldb (byte 1 26) inst)))
 184     (if (= (length value) 3)
 185         (destructuring-bind (size opc reg) value
 186           (cond ((zerop v)
 187                  (when (= size #b10)
 188                    (princ "W" stream))
 189                  (princ (svref *register-names* reg) stream))
 190                 (t
 191                  (format stream "~a~d"
 192                          (cond ((and (= size #b10)
 193                                      (= opc #b0))
 194                                 "S")
 195                                ((and (= size #b11)
 196                                      (= opc #b0))
 197                                 "D")
 198                                ((and (= size #b00)
 199                                      (= opc #b1))
 200                                 "Q"))
 201                          reg))))
 202         (destructuring-bind (size reg) value
 203           (cond ((zerop v)
 204                  (when (zerop size)
 205                    (princ "W" stream))
 206                  (princ (svref *register-names* reg) stream))
 207                 (t
 208                  (format stream "~a~d"
 209                          (case size
 210                            (#b00 "S")
 211                            (#b01 "D")
 212                            (#b10 "Q"))
 213                          reg)))))))
 214
 215 (defun print-float-reg (value stream dstate)
 216   (multiple-value-bind (type value)
 217       (if (consp value)
 218           (values (car value) (cadr value))
 219           (values (ldb (byte 1 22) (current-instruction dstate))
 220                   value))
 221     (format stream "~a~d"
 222             (if (= type 1)
 223                 "D"
 224                 "S")
 225             value)))
 226
 227 (defun print-simd-reg (value stream dstate)
 228   (declare (ignore dstate))
 229   (destructuring-bind (size offset) value
 230     (format stream "V~d.~a" offset
 231             (if (zerop size)
 232                 "8B"
 233                 "16B"))))
 234
 235 (defun lowest-set-bit-index (integer-value)
 236   (max 0 (1- (integer-length (logand integer-value (- integer-value))))))
 237
 238 (defun print-simd-copy-reg (value stream dstate)
 239   (declare (ignore dstate))
 240   (destructuring-bind (offset imm5 &optional imm4) value
 241     (let ((index (lowest-set-bit-index imm5)))
 242      (format stream "V~d.~a[~a]" offset
 243              (char "BHSD" index)
 244              (if imm4
 245                  (ash imm4 (- index))
 246                  (ash imm5 (- (1+ index))))))))
 247
 248 (defun print-sys-reg (value stream dstate)
 249   (declare (ignore dstate))
 250   (princ (decode-sys-reg value) stream))
 251
 252 (defun print-cond (value stream dstate)
 253   (declare (ignore dstate))
 254   (princ (svref *condition-name-vec* value) stream))
 255
 256 (defun use-label (value dstate)
 257   (let* ((value (if (consp value)
 258                     (logior (ldb (byte 2 0) (car value))
 259                             (ash (cadr value) 2))
 260                     (ash value 2)))
 261          (address (+ value (dstate-cur-addr dstate))))
 262     ;; LRA pointer
 263     (if (= (logand address lowtag-mask) other-pointer-lowtag)
 264         (- address (- other-pointer-lowtag n-word-bytes))
 265         address)))
 266
 267
 268 (defun annotate-ldr-str (register offset dstate)
 269   (case register
 270     (#.sb!vm::code-offset
 271      (note-code-constant offset dstate))
 272     (#.sb!vm::null-offset
 273      (let ((offset (+ sb!vm::nil-value offset)))
 274        (maybe-note-assembler-routine offset nil dstate)
 275        (maybe-note-static-symbol (logior offset other-pointer-lowtag)
 276                                               dstate)))
 277     #!+sb-thread
 278     (#.sb!vm::thread-offset
 279      (let* ((thread-slots
 280              (load-time-value
 281               (primitive-object-slots
 282                (find 'sb!vm::thread *primitive-objects*
 283                      :key #'primitive-object-name)) t))
 284             (slot (find (ash offset (- word-shift)) thread-slots
 285                         :key #'slot-offset)))
 286        (when slot
 287          (note (lambda (stream)
 288                  (format stream "thread.~(~A~)" (slot-name slot)))
 289                dstate))))))
 290
 291 (defun find-value-from-previos-inst (register dstate)
 292   ;; Needs to be MOVZ REGISTER, imm, LSL #0
 293   ;; Should cover most offsets in sane code
 294   (let ((inst (current-instruction dstate -4)))
 295     (when (and (= (ldb (byte 9 23) inst) #b110100101) ;; MOVZ
 296                (= (ldb (byte 5 0) inst) register)
 297                (= (ldb (byte 2 21) inst) 0)) ;; LSL #0
 298       (ldb (byte 16 5) inst))))
 299
 300 (defun annotate-ldr-str-reg (value stream dstate)
 301   (declare (ignore stream))
 302   (let* ((inst (current-instruction dstate))
 303          (float (ldb-test (byte 1 26) inst)))
 304     (unless float
 305       (let ((value (find-value-from-previos-inst value dstate)))
 306         (when value
 307           (annotate-ldr-str (ldb (byte 5 5) inst) value dstate))))))
 308
 309 (defun annotate-ldr-str-imm (value stream dstate)
 310   (declare (ignore stream))
 311   (let* ((inst (current-instruction dstate))
 312          (float-reg (ldb-test (byte 1 26) inst)))
 313     (unless float-reg
 314       (annotate-ldr-str (ldb (byte 5 5) inst)
 315                         (if (consp value)
 316                             (decode-scaled-immediate value)
 317                             value)
 318                         dstate))))
 319
 320 ;;;; special magic to support decoding internal-error and related traps
 321 (defun snarf-error-junk (sap offset &optional length-only)
 322   (let* ((inst (sap-ref-32 sap (- offset 4)))
 323          (error-number (ldb (byte 8 13) inst))
 324          (length (sb!kernel::error-length error-number))
 325          (index offset))
 326     (declare (type sb!sys:system-area-pointer sap)
 327              (type (unsigned-byte 8) length))
 328     (cond (length-only
 329            (loop repeat length do (sb!c::sap-read-var-integerf sap index))
 330            (values 0 (- index offset) nil nil))
 331           (t
 332            (collect ((sc-offsets)
 333                      (lengths))
 334              (loop repeat length do
 335                   (let ((old-index index))
 336                     (sc-offsets (sb!c::sap-read-var-integerf sap index))
 337                     (lengths (- index old-index))))
 338              (values error-number
 339                      (- index offset)
 340                      (sc-offsets)
 341                      (lengths)))))))
 342
 343 (defun brk-control (chunk inst stream dstate)
 344   (declare (ignore inst chunk))
 345   (let ((code (ldb (byte 8 5) (current-instruction dstate))))
 346     (flet ((nt (x) (if stream (note x dstate))))
 347       (case code
 348         (#.halt-trap
 349          (nt "Halt trap"))
 350         (#.pending-interrupt-trap
 351          (nt "Pending interrupt trap"))
 352         (#.error-trap
 353          (nt "Error trap")
 354          (handle-break-args #'snarf-error-junk stream dstate))
 355         (#.cerror-trap
 356          (nt "Cerror trap")
 357          (handle-break-args #'snarf-error-junk stream dstate))
 358         (#.breakpoint-trap
 359          (nt "Breakpoint trap"))
 360         (#.fun-end-breakpoint-trap
 361          (nt "Function end breakpoint trap"))
 362         (#.single-step-around-trap
 363          (nt "Single step around trap"))
 364         (#.single-step-before-trap
 365          (nt "Single step before trap"))
 366         (#.invalid-arg-count-trap
 367          (nt "Invalid argument count trap"))))))