src/compiler/sparc/insts.lisp

   1 ;;;; the instruction set definition for the Sparc
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; This software is derived from the CMU CL system, which was
   7 ;;;; written at Carnegie Mellon University and released into the
   8 ;;;; public domain. The software is in the public domain and is
   9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  10 ;;;; files for more information.
  11
  12 (in-package "SB!VM")
  13
  14 ;;;FIXME: the analogue is commented out in alpha/insts.lisp
  15 ;;;(def-assembler-params
  16 ;;;    :scheduler-p t
  17 ;;;  :max-locations 100)
  18 (eval-when (:compile-toplevel :load-toplevel :execute)
  19   (setf sb!assem:*assem-scheduler-p* t)
  20   (setf sb!assem:*assem-max-locations* 100))
  21 \f
  22 ;;; Constants, types, conversion functions, some disassembler stuff.
  23 (defun reg-tn-encoding (tn)
  24   (declare (type tn tn))
  25   (sc-case tn
  26     (zero zero-offset)
  27     (null null-offset)
  28     (t
  29      (if (eq (sb-name (sc-sb (tn-sc tn))) 'registers)
  30          (tn-offset tn)
  31          (error "~S isn't a register." tn)))))
  32
  33 (defun fp-reg-tn-encoding (tn)
  34   (declare (type tn tn))
  35   (unless (eq (sb-name (sc-sb (tn-sc tn))) 'float-registers)
  36     (error "~S isn't a floating-point register." tn))
  37   (let ((offset (tn-offset tn)))
  38     (cond ((> offset 31)
  39            (assert (member :sparc-v9 *backend-subfeatures*))
  40            ;; No single register encoding greater than reg 31.
  41            (assert (zerop (mod offset 2)))
  42            ;; Upper bit of the register number is encoded in the low bit.
  43            (1+ (- offset 32)))
  44           (t
  45            (tn-offset tn)))))
  46
  47 ;;;(sb!disassem:set-disassem-params :instruction-alignment 32
  48 ;;;                              :opcode-column-width 11)
  49
  50 (defvar *disassem-use-lisp-reg-names* t
  51   #!+sb-doc
  52   "If non-NIL, print registers using the Lisp register names.
  53 Otherwise, use the Sparc register names")
  54
  55 (!def-vm-support-routine location-number (loc)
  56   (etypecase loc
  57     (null)
  58     (number)
  59     (fixup)
  60     (tn
  61      (ecase (sb-name (sc-sb (tn-sc loc)))
  62        (registers
  63         (unless (zerop (tn-offset loc))
  64           (tn-offset loc)))
  65        (float-registers
  66         (sc-case loc
  67           (single-reg
  68            (+ (tn-offset loc) 32))
  69           (double-reg
  70            (let ((offset (tn-offset loc)))
  71              (assert (zerop (mod offset 2)))
  72              (values (+ offset 32) 2)))
  73           #!+long-float
  74           (long-reg
  75            (let ((offset (tn-offset loc)))
  76              (assert (zerop (mod offset 4)))
  77              (values (+ offset 32) 4)))))
  78        (control-registers
  79         96)
  80        (immediate-constant
  81         nil)))
  82     (symbol
  83      (ecase loc
  84        (:memory 0)
  85        (:psr 97)
  86        (:fsr 98)
  87        (:y 99)))))
  88
  89 ;;; symbols used for disassembly printing
  90 (defparameter reg-symbols
  91   (map 'vector
  92        (lambda (name)
  93            (cond ((null name) nil)
  94                  (t (make-symbol (concatenate 'string "%" name)))))
  95        *register-names*)
  96   #!+sb-doc "The Lisp names for the Sparc integer registers")
  97
  98 (defparameter sparc-reg-symbols
  99   #("%G0" "%G1" "%G2" "%G3" "%G4" "%G5" NIL NIL
 100     "%O0" "%O1" "%O2" "%O3" "%O4" "%O5" "%O6" "%O7"
 101     "%L0" "%L1" "%L2" "%L3" "%L4" "%L5" "%L6" "%L7"
 102     "%I0" "%I1" "%I2" "%I3" "%I4" "%I5" NIL "%I7")
 103   #!+sb-doc "The standard names for the Sparc integer registers")
 104
 105 (defun get-reg-name (index)
 106   (if *disassem-use-lisp-reg-names*
 107       (aref reg-symbols index)
 108       (aref sparc-reg-symbols index)))
 109
 110 (defvar *note-sethi-inst* nil
 111   "An alist for the disassembler indicating the target register and
 112 value used in a SETHI instruction.  This is used to make annotations
 113 about function addresses and register values.")
 114
 115 (defvar *pseudo-atomic-set* nil)
 116
 117 (defun sign-extend-immed-value (val)
 118   ;; val is a 13-bit signed number.  Extend the sign appropriately.
 119   (if (logbitp 12 val)
 120       (- val (ash 1 13))
 121       val))
 122
 123 ;;; Oh, come on, this is ridiculous. I'm not going to solve
 124 ;;; bootstrapping issues for a disassembly note. Does this make me
 125 ;;; lazy? Christophe, 2001-09-02. FIXME
 126 #+nil
 127 (macrolet
 128     ((frob (&rest names)
 129        (let ((results (mapcar (lambda (n)
 130                                   (let ((nn (intern (concatenate 'string (string n)
 131                                                                  "-TYPE"))))
 132                                     `(,(eval nn) ,nn)))
 133                               names)))
 134          `(eval-when (:compile-toplevel :load-toplevel :execute)
 135            (def!constant header-word-type-alist
 136              ',results)))))
 137   ;; This is the same list as in objdefs.
 138   (frob bignum
 139         ratio
 140         single-float
 141         double-float
 142         #!+long-float long-float
 143         complex
 144         complex-single-float
 145         complex-double-float
 146         #!+long-float complex-long-float
 147
 148         simple-array
 149         simple-string
 150         simple-bit-vector
 151         simple-vector
 152         simple-array-unsigned-byte-2
 153         simple-array-unsigned-byte-4
 154         simple-array-unsigned-byte-8
 155         simple-array-unsigned-byte-16
 156         simple-array-unsigned-byte-32
 157         simple-array-signed-byte-8
 158         simple-array-signed-byte-16
 159         simple-array-signed-byte-30
 160         simple-array-signed-byte-32
 161         simple-array-single-float
 162         simple-array-double-float
 163         #!+long-float simple-array-long-float
 164         simple-array-complex-single-float
 165         simple-array-complex-double-float
 166         #!+long-float simple-array-complex-long-float
 167         complex-string
 168         complex-bit-vector
 169         complex-vector
 170         complex-array
 171
 172         code-header
 173         function-header
 174         closure-header
 175         funcallable-instance-header
 176         byte-code-function
 177         byte-code-closure
 178         closure-function-header
 179         #!-gengc return-pc-header
 180         #!+gengc forwarding-pointer
 181         value-cell-header
 182         symbol-header
 183         base-char
 184         sap
 185         unbound-marker
 186         weak-pointer
 187         instance-header
 188         fdefn
 189         #!+(or gengc gencgc) scavenger-hook))
 190
 191 ;; Look at the current instruction and see if we can't add some notes
 192 ;; about what's happening.
 193
 194 (defun maybe-add-notes (reg dstate)
 195   (let* ((word (sb!disassem::sap-ref-int (sb!disassem::dstate-segment-sap dstate)
 196                                       (sb!disassem::dstate-cur-offs dstate)
 197                                       n-word-bytes
 198                                       (sb!disassem::dstate-byte-order dstate)))
 199          (format (ldb (byte 2 30) word))
 200          (op3 (ldb (byte 6 19) word))
 201          (rs1 (ldb (byte 5 14) word))
 202          (rd (ldb (byte 5 25) word))
 203          (immed-p (not (zerop (ldb (byte 1 13) word))))
 204          (immed-val (sign-extend-immed-value (ldb (byte 13 0) word))))
 205     ;; Only the value of format and rd are guaranteed to be correct
 206     ;; because the disassembler is trying to print out the value of a
 207     ;; register.  The other values may not be right.
 208     (case format
 209       (2
 210        (case op3
 211          (#b000000
 212           (when (= reg rs1)
 213             (handle-add-inst rs1 immed-val rd dstate)))
 214          (#b111000
 215           (when (= reg rs1)
 216             (handle-jmpl-inst rs1 immed-val rd dstate)))
 217          (#b010001
 218           (when (= reg rs1)
 219             (handle-andcc-inst rs1 immed-val rd dstate)))))
 220       (3
 221        (case op3
 222          ((#b000000 #b000100)
 223           (when (= reg rs1)
 224             (handle-ld/st-inst rs1 immed-val rd dstate))))))
 225     ;; If this is not a SETHI instruction, and RD is the same as some
 226     ;; register used by SETHI, we delete the entry.  (In case we have
 227     ;; a SETHI without any additional instruction because the low bits
 228     ;; were zero.)
 229     (unless (and (zerop format) (= #b100 (ldb (byte 3 22) word)))
 230       (let ((sethi (assoc rd *note-sethi-inst*)))
 231         (when sethi
 232           (setf *note-sethi-inst* (delete sethi *note-sethi-inst*)))))))
 233
 234 (defun handle-add-inst (rs1 immed-val rd dstate)
 235   (let* ((sethi (assoc rs1 *note-sethi-inst*)))
 236     (cond
 237       (sethi
 238        ;; RS1 was used in a SETHI instruction.  Assume that
 239        ;; this is the offset part of the SETHI instruction for
 240        ;; a full 32-bit address of something.  Make a note
 241        ;; about this usage as a Lisp assembly routine or
 242        ;; foreign routine, if possible.  If not, just note the
 243        ;; final value.
 244        (let ((addr (+ immed-val (ash (cdr sethi) 10))))
 245          (or (sb!disassem::note-code-constant-absolute addr dstate)
 246              (sb!disassem:maybe-note-assembler-routine addr t dstate)
 247              (sb!disassem:note (format nil "~A = #x~8,'0X"
 248                                      (get-reg-name rd) addr)
 249                              dstate)))
 250        (setf *note-sethi-inst* (delete sethi *note-sethi-inst*)))
 251       ((= rs1 null-offset)
 252        ;; We have an ADD %NULL, <n>, RD instruction.  This is a
 253        ;; reference to a static symbol.
 254        (sb!disassem:maybe-note-nil-indexed-object immed-val
 255                                                dstate))
 256       ((= rs1 alloc-offset)
 257        ;; ADD %ALLOC, n.  This must be some allocation or
 258        ;; pseudo-atomic stuff
 259        (cond ((and (= immed-val 4) (= rd alloc-offset)
 260                    (not *pseudo-atomic-set*))
 261               ;; "ADD 4, %ALLOC" sets the flag
 262               (sb!disassem::note "Set pseudo-atomic flag" dstate)
 263               (setf *pseudo-atomic-set* t))
 264              ((= rd alloc-offset)
 265               ;; "ADD n, %ALLOC" is reseting the flag, with extra
 266               ;; allocation.
 267               (sb!disassem:note
 268                (format nil "Reset pseudo-atomic, allocated ~D bytes"
 269                        (+ immed-val 4)) dstate)
 270               (setf *pseudo-atomic-set* nil))))
 271       #+nil ((and (= rs1 zero-offset) *pseudo-atomic-set*)
 272        ;; "ADD %ZERO, num, RD" inside a pseudo-atomic is very
 273        ;; likely loading up a header word.  Make a note to that
 274        ;; effect.
 275        (let ((type (second (assoc (logand immed-val #xff) header-word-type-alist)))
 276              (size (ldb (byte 24 8) immed-val)))
 277          (when type
 278            (sb!disassem:note (format nil "Header word ~A, size ~D?" type size)
 279                           dstate)))))))
 280
 281 (defun handle-jmpl-inst (rs1 immed-val rd dstate)
 282   (let* ((sethi (assoc rs1 *note-sethi-inst*)))
 283     (when sethi
 284       ;; RS1 was used in a SETHI instruction.  Assume that
 285       ;; this is the offset part of the SETHI instruction for
 286       ;; a full 32-bit address of something.  Make a note
 287       ;; about this usage as a Lisp assembly routine or
 288       ;; foreign routine, if possible.  If not, just note the
 289       ;; final value.
 290       (let ((addr (+ immed-val (ash (cdr sethi) 10))))
 291         (sb!disassem:maybe-note-assembler-routine addr t dstate)
 292         (setf *note-sethi-inst* (delete sethi *note-sethi-inst*))))))
 293
 294 (defun handle-ld/st-inst (rs1 immed-val rd dstate)
 295   (declare (ignore rd))
 296   ;; Got an LDUW/LD or STW instruction, with immediate offset.
 297   (case rs1
 298     (29
 299      ;; A reference to a code constant (reg = %CODE)
 300      (sb!disassem:note-code-constant immed-val dstate))
 301     (2
 302      ;; A reference to a static symbol or static function (reg =
 303      ;; %NULL)
 304      (or (sb!disassem:maybe-note-nil-indexed-symbol-slot-ref immed-val
 305                                                       dstate)
 306          #+nil (sb!disassem::maybe-note-static-function immed-val dstate)))
 307     (t
 308      (let ((sethi (assoc rs1 *note-sethi-inst*)))
 309        (when sethi
 310          (let ((addr (+ immed-val (ash (cdr sethi) 10))))
 311            (sb!disassem:maybe-note-assembler-routine addr nil dstate)
 312            (setf *note-sethi-inst* (delete sethi *note-sethi-inst*))))))))
 313
 314 (defun handle-andcc-inst (rs1 immed-val rd dstate)
 315   ;; ANDCC %ALLOC, 3, %ZERO instruction
 316   (when (and (= rs1 alloc-offset) (= rd zero-offset) (= immed-val 3))
 317     (sb!disassem:note "pseudo-atomic interrupted?" dstate)))
 318
 319 (sb!disassem:define-arg-type reg
 320   :printer (lambda (value stream dstate)
 321                (declare (stream stream) (fixnum value))
 322                (let ((regname (get-reg-name value)))
 323                  (princ regname stream)
 324                  (sb!disassem:maybe-note-associated-storage-ref value
 325                                                                 'registers
 326                                                                 regname
 327                                                                 dstate)
 328                  (maybe-add-notes value dstate))))
 329
 330 (defparameter float-reg-symbols
 331   (coerce
 332    (loop for n from 0 to 63 collect (make-symbol (format nil "%F~d" n)))
 333    'vector))
 334
 335 (sb!disassem:define-arg-type fp-reg
 336   :printer (lambda (value stream dstate)
 337                (declare (stream stream) (fixnum value))
 338                (let ((regname (aref float-reg-symbols value)))
 339                  (princ regname stream)
 340                  (sb!disassem:maybe-note-associated-storage-ref
 341                   value
 342                   'float-registers
 343                   regname
 344                   dstate))))
 345
 346 ;;; The extended 6 bit floating point register encoding for the double
 347 ;;; and long instructions of the sparc v9.
 348 (sb!disassem:define-arg-type fp-ext-reg
 349   :printer (lambda (value stream dstate)
 350                (declare (stream stream) (fixnum value))
 351                (let* (;; Decode the register number.
 352                       (value (if (oddp value) (+ value 31) value))
 353                       (regname (aref float-reg-symbols value)))
 354                  (princ regname stream)
 355                  (sb!disassem:maybe-note-associated-storage-ref
 356                   value
 357                   'float-registers
 358                   regname
 359                   dstate))))
 360
 361 (sb!disassem:define-arg-type relative-label
 362   :sign-extend t
 363   :use-label (lambda (value dstate)
 364                (declare (type (signed-byte 22) value)
 365                         (type sb!disassem:disassem-state dstate))
 366                (+ (ash value 2) (sb!disassem:dstate-cur-addr dstate))))
 367
 368 (defconstant-eqx branch-conditions
 369   '(:f :eq :le :lt :leu :ltu :n :vs :t :ne :gt :ge :gtu :geu :p :vc)
 370   #'equalp)
 371
 372 ;;; Note that these aren't the standard names for branch-conditions, I
 373 ;;; think they're a bit more readable (e.g., "eq" instead of "e").
 374 ;;; You could just put a vector of the normal ones here too.
 375
 376 (sb!disassem:define-arg-type branch-condition
 377   :printer (coerce branch-conditions 'vector))
 378
 379 (deftype branch-condition ()
 380   `(member ,@branch-conditions))
 381
 382 (defun branch-condition (condition)
 383   (or (position condition branch-conditions)
 384       (error "Unknown branch condition: ~S~%Must be one of: ~S"
 385              condition branch-conditions)))
 386
 387 (def!constant branch-cond-true
 388   #b1000)
 389
 390 (defconstant-eqx branch-fp-conditions
 391   '(:f :ne :lg :ul :l :ug :g :u :t :eq :ue :ge :uge :le :ule :o)
 392   #'equalp)
 393
 394 (sb!disassem:define-arg-type branch-fp-condition
 395   :printer (coerce branch-fp-conditions 'vector))
 396
 397 (sb!disassem:define-arg-type call-fixup :use-label t)
 398
 399 (deftype fp-branch-condition ()
 400   `(member ,@branch-fp-conditions))
 401
 402 (defun fp-branch-condition (condition)
 403   (or (position condition branch-fp-conditions)
 404       (error "Unknown fp-branch condition: ~S~%Must be one of: ~S"
 405              condition branch-fp-conditions)))
 406
 407 \f
 408 ;;;; dissassem:define-instruction-formats
 409
 410 (sb!disassem:define-instruction-format
 411     (format-1 32 :default-printer '(:name :tab disp))
 412   (op   :field (byte 2 30) :value 1)
 413   (disp :field (byte 30 0)))
 414
 415 (sb!disassem:define-instruction-format
 416     (format-2-immed 32 :default-printer '(:name :tab immed ", " rd))
 417   (op    :field (byte 2 30) :value 0)
 418   (rd    :field (byte 5 25) :type 'reg)
 419   (op2   :field (byte 3 22))
 420   (immed :field (byte 22 0)))
 421
 422
 423
 424 (sb!disassem:define-instruction-format
 425     (format-2-branch 32 :default-printer `(:name (:unless (:constant ,branch-cond-true) cond)
 426                                            (:unless (a :constant 0) "," 'A)
 427                                            :tab
 428                                            disp))
 429   (op   :field (byte 2 30) :value 0)
 430   (a    :field (byte 1 29) :value 0)
 431   (cond :field (byte 4 25) :type 'branch-condition)
 432   (op2  :field (byte 3 22))
 433   (disp :field (byte 22 0) :type 'relative-label))
 434
 435 ;; Branch with prediction instruction for V9
 436
 437 ;; Currently only %icc and %xcc are used of the four possible values
 438
 439 (defconstant-eqx integer-condition-registers
 440   '(:icc :reserved :xcc :reserved)
 441   #'equalp)
 442
 443 (defconstant-eqx integer-cond-reg-name-vec
 444   (coerce integer-condition-registers 'vector)
 445   #'equalp)
 446
 447 (deftype integer-condition-register ()
 448   `(member ,@(remove :reserved integer-condition-registers)))
 449
 450 (defparameter integer-condition-reg-symbols
 451   (map 'vector
 452        (lambda (name)
 453            (make-symbol (concatenate 'string "%" (string name))))
 454        integer-condition-registers))
 455
 456 (sb!disassem:define-arg-type integer-condition-register
 457     :printer (lambda (value stream dstate)
 458                  (declare (stream stream) (fixnum value) (ignore dstate))
 459                  (let ((regname (aref integer-condition-reg-symbols value)))
 460                    (princ regname stream))))
 461
 462 (defconstant-eqx branch-predictions
 463   '(:pn :pt)
 464   #'equalp)
 465
 466 (sb!disassem:define-arg-type branch-prediction
 467     :printer (coerce branch-predictions 'vector))
 468
 469 (defun integer-condition (condition-reg)
 470   (declare (type (member :icc :xcc) condition-reg))
 471   (or (position condition-reg integer-condition-registers)
 472       (error "Unknown integer condition register:  ~S~%"
 473              condition-reg)))
 474
 475 (defun branch-prediction (pred)
 476   (or (position pred branch-predictions)
 477       (error "Unknown branch prediction:  ~S~%Must be one of: ~S~%"
 478              pred branch-predictions)))
 479
 480 (defconstant-eqx branch-pred-printer
 481   `(:name (:unless (:constant ,branch-cond-true) cond)
 482           (:unless (a :constant 0) "," 'A)
 483           (:unless (p :constant 1) "," 'pn)
 484           :tab
 485           cc
 486           ", "
 487           disp)
 488   #'equalp)
 489
 490 (sb!disassem:define-instruction-format
 491     (format-2-branch-pred 32 :default-printer branch-pred-printer)
 492   (op   :field (byte 2 30) :value 0)
 493   (a    :field (byte 1 29) :value 0)
 494   (cond :field (byte 4 25) :type 'branch-condition)
 495   (op2  :field (byte 3 22))
 496   (cc   :field (byte 2 20) :type 'integer-condition-register)
 497   (p    :field (byte 1 19))
 498   (disp :field (byte 19 0) :type 'relative-label))
 499
 500 (defconstant-eqx fp-condition-registers
 501   '(:fcc0 :fcc1 :fcc2 :fcc3)
 502   #'equalp)
 503
 504 (defconstant-eqx fp-cond-reg-name-vec
 505   (coerce fp-condition-registers 'vector)
 506   #'equalp)
 507
 508 (defparameter fp-condition-reg-symbols
 509   (map 'vector
 510        (lambda (name)
 511            (make-symbol (concatenate 'string "%" (string name))))
 512        fp-condition-registers))
 513
 514 (sb!disassem:define-arg-type fp-condition-register
 515     :printer (lambda (value stream dstate)
 516                  (declare (stream stream) (fixnum value) (ignore dstate))
 517                  (let ((regname (aref fp-condition-reg-symbols value)))
 518                    (princ regname stream))))
 519
 520 (sb!disassem:define-arg-type fp-condition-register-shifted
 521     :printer (lambda (value stream dstate)
 522                  (declare (stream stream) (fixnum value) (ignore dstate))
 523                  (let ((regname (aref fp-condition-reg-symbols (ash value -1))))
 524                    (princ regname stream))))
 525
 526 (defun fp-condition (condition-reg)
 527   (or (position condition-reg fp-condition-registers)
 528       (error "Unknown integer condition register:  ~S~%"
 529              condition-reg)))
 530
 531 (defconstant-eqx fp-branch-pred-printer
 532   `(:name (:unless (:constant ,branch-cond-true) cond)
 533           (:unless (a :constant 0) "," 'A)
 534           (:unless (p :constant 1) "," 'pn)
 535           :tab
 536           fcc
 537           ", "
 538           disp)
 539   #'equalp)
 540
 541 (sb!disassem:define-instruction-format
 542     (format-2-fp-branch-pred 32 :default-printer fp-branch-pred-printer)
 543   (op   :field (byte 2 30) :value 0)
 544   (a    :field (byte 1 29) :value 0)
 545   (cond :field (byte 4 25) :type 'branch-fp-condition)
 546   (op2  :field (byte 3 22))
 547   (fcc  :field (byte 2 20) :type 'fp-condition-register)
 548   (p    :field (byte 1 19))
 549   (disp :field (byte 19 0) :type 'relative-label))
 550
 551
 552
 553 (sb!disassem:define-instruction-format
 554     (format-2-unimp 32 :default-printer '(:name :tab data))
 555   (op     :field (byte 2 30) :value 0)
 556   (ignore :field (byte 5 25) :value 0)
 557   (op2    :field (byte 3 22) :value 0)
 558   (data   :field (byte 22 0)))
 559
 560 (defconstant-eqx f3-printer
 561   '(:name :tab
 562           (:unless (:same-as rd) rs1 ", ")
 563           (:choose rs2 immed) ", "
 564           rd)
 565   #'equalp)
 566
 567 (sb!disassem:define-instruction-format
 568     (format-3-reg 32 :default-printer f3-printer)
 569   (op  :field (byte 2 30))
 570   (rd  :field (byte 5 25) :type 'reg)
 571   (op3 :field (byte 6 19))
 572   (rs1 :field (byte 5 14) :type 'reg)
 573   (i   :field (byte 1 13) :value 0)
 574   (asi :field (byte 8 5)  :value 0)
 575   (rs2 :field (byte 5 0)  :type 'reg))
 576
 577 (sb!disassem:define-instruction-format
 578     (format-3-immed 32 :default-printer f3-printer)
 579   (op    :field (byte 2 30))
 580   (rd    :field (byte 5 25) :type 'reg)
 581   (op3   :field (byte 6 19))
 582   (rs1   :field (byte 5 14) :type 'reg)
 583   (i     :field (byte 1 13) :value 1)
 584   (immed :field (byte 13 0) :sign-extend t))    ; usually sign extended
 585
 586 (sb!disassem:define-instruction-format
 587     (format-binary-fpop 32
 588      :default-printer '(:name :tab rs1 ", " rs2 ", " rd))
 589   (op   :field (byte 2 30))
 590   (rd   :field (byte 5 25) :type 'fp-reg)
 591   (op3  :field (byte 6 19))
 592   (rs1  :field (byte 5 14) :type 'fp-reg)
 593   (opf  :field (byte 9 5))
 594   (rs2  :field (byte 5 0) :type 'fp-reg))
 595
 596 ;;; Floating point load/save instructions encoding.
 597 (sb!disassem:define-instruction-format
 598     (format-unary-fpop 32 :default-printer '(:name :tab rs2 ", " rd))
 599   (op   :field (byte 2 30))
 600   (rd   :field (byte 5 25) :type 'fp-reg)
 601   (op3  :field (byte 6 19))
 602   (rs1  :field (byte 5 14) :value 0)
 603   (opf  :field (byte 9 5))
 604   (rs2  :field (byte 5 0) :type 'fp-reg))
 605
 606 ;;; Floating point comparison instructions encoding.
 607
 608 ;; This is a merge of the instructions for FP comparison and FP
 609 ;; conditional moves available in the Sparc V9.  The main problem is
 610 ;; that the new instructions use part of the opcode space used by the
 611 ;; comparison instructions.  In particular, the OPF field is arranged
 612 ;; as so:
 613 ;;
 614 ;; Bit          1       0
 615 ;;              3       5
 616 ;; FMOVcc       0nn0000xx       %fccn
 617 ;;              1000000xx       %icc
 618 ;;              1100000xx       %xcc
 619 ;; FMOVR        0ccc001yy
 620 ;; FCMP         001010zzz
 621 ;;
 622 ;; So we see that if we break up the OPF field into 4 pieces, opf0,
 623 ;; opf1, opf2, and opf3, we can distinguish between these
 624 ;; instructions. So bit 9 (opf2) can be used to distinguish between
 625 ;; FCMP and the rest.  Also note that the nn field overlaps with the
 626 ;; ccc.  We need to take this into account as well.
 627 ;;
 628 (sb!disassem:define-instruction-format
 629     (format-fpop2 32
 630                   :default-printer #!-sparc-v9 '(:name :tab rs1 ", " rs2)
 631                                    #!+sparc-v9 '(:name :tab rd ", " rs1 ", " rs2))
 632   (op   :field (byte 2 30))
 633   (rd   :field (byte 5 25) :value 0)
 634   (op3  :field (byte 6 19))
 635   (rs1  :field (byte 5 14))
 636   (opf0 :field (byte 1 13))
 637   (opf1 :field (byte 3 10))
 638   (opf2 :field (byte 1 9))
 639   (opf3 :field (byte 4 5))
 640   (rs2  :field (byte 5 0) :type 'fp-reg))
 641
 642 ;;; Shift instructions
 643 (sb!disassem:define-instruction-format
 644     (format-3-shift-reg 32 :default-printer f3-printer)
 645   (op   :field (byte 2 30))
 646   (rd    :field (byte 5 25) :type 'reg)
 647   (op3  :field (byte 6 19))
 648   (rs1   :field (byte 5 14) :type 'reg)
 649   (i     :field (byte 1 13) :value 0)
 650   (x     :field (byte 1 12))
 651   (asi   :field (byte 7 5) :value 0)
 652   (rs2   :field (byte 5 0) :type 'reg))
 653
 654 (sb!disassem:define-instruction-format
 655     (format-3-shift-immed 32 :default-printer f3-printer)
 656   (op   :field (byte 2 30))
 657   (rd    :field (byte 5 25) :type 'reg)
 658   (op3  :field (byte 6 19))
 659   (rs1   :field (byte 5 14) :type 'reg)
 660   (i     :field (byte 1 13) :value 1)
 661   (x     :field (byte 1 12))
 662   (immed :field (byte 12 0) :sign-extend nil))
 663
 664 \f
 665 ;;; Conditional moves (only available for Sparc V9 architectures)
 666
 667 ;; The names of all of the condition registers on the V9: 4 FP
 668 ;; conditions, the original integer condition register and the new
 669 ;; extended register.  The :reserved register is reserved on the V9.
 670
 671 (defconstant-eqx cond-move-condition-registers
 672   '(:fcc0 :fcc1 :fcc2 :fcc3 :icc :reserved :xcc :reserved)
 673   #'equalp)
 674
 675 (defconstant-eqx cond-move-cond-reg-name-vec
 676   (coerce cond-move-condition-registers 'vector)
 677   #'equalp)
 678
 679 (deftype cond-move-condition-register ()
 680     `(member ,@(remove :reserved cond-move-condition-registers)))
 681
 682 (defparameter cond-move-condition-reg-symbols
 683   (map 'vector
 684        (lambda (name)
 685            (make-symbol (concatenate 'string "%" (string name))))
 686        cond-move-condition-registers))
 687
 688 (sb!disassem:define-arg-type cond-move-condition-register
 689     :printer (lambda (value stream dstate)
 690                  (declare (stream stream) (fixnum value) (ignore dstate))
 691                  (let ((regname (aref cond-move-condition-reg-symbols value)))
 692                    (princ regname stream))))
 693
 694 ;; From the given condition register, figure out what the cc2, cc1,
 695 ;; and cc0 bits should be.  Return cc2 and cc1/cc0 concatenated.
 696 (defun cond-move-condition-parts (condition-reg)
 697   (let ((posn (position condition-reg cond-move-condition-registers)))
 698     (if posn
 699         (truncate posn 4)
 700         (error "Unknown conditional move condition register:  ~S~%"
 701                condition-reg))))
 702
 703 (defun cond-move-condition (condition-reg)
 704   (or (position condition-reg cond-move-condition-registers)
 705       (error "Unknown conditional move condition register:  ~S~%")))
 706
 707 (defconstant-eqx cond-move-printer
 708   `(:name cond :tab
 709           cc ", " (:choose immed rs2) ", " rd)
 710   #'equalp)
 711
 712 ;; Conditional move integer register on integer or FP condition code
 713 (sb!disassem:define-instruction-format
 714     (format-4-cond-move 32 :default-printer cond-move-printer)
 715   (op   :field (byte 2 30))
 716   (rd    :field (byte 5 25) :type 'reg)
 717   (op3  :field (byte 6 19))
 718   (cc2   :field (byte 1 18) :value 1)
 719   (cond  :field (byte 4 14) :type 'branch-condition)
 720   (i     :field (byte 1 13) :value 0)
 721   (cc    :field (byte 2 11) :type 'integer-condition-register)
 722   (empty :field (byte 6 5) :value 0)
 723   (rs2   :field (byte 5 0) :type 'reg))
 724
 725 (sb!disassem:define-instruction-format
 726     (format-4-cond-move-immed 32 :default-printer cond-move-printer)
 727   (op    :field (byte 2 30))
 728   (rd    :field (byte 5 25) :type 'reg)
 729   (op3   :field (byte 6 19))
 730   (cc2   :field (byte 1 18) :value 1)
 731   (cond  :field (byte 4 14) :type 'branch-condition)
 732   (i     :field (byte 1 13) :value 1)
 733   (cc    :field (byte 2 11) :type 'integer-condition-register)
 734   (immed :field (byte 11 0) :sign-extend t))
 735
 736 ;; Floating-point versions of the above integer conditional moves
 737 (defconstant-eqx cond-fp-move-printer
 738   `(:name rs1 :tab opf1 ", " rs2 ", " rd)
 739   #'equalp)
 740
 741 ;;; Conditional move on integer register condition (only on Sparc
 742 ;;; V9). That is, move an integer register if some other integer
 743 ;;; register satisfies some condition.
 744
 745 (defconstant-eqx cond-move-integer-conditions
 746   '(:reserved :z :lez :lz :reserved :nz :gz :gez)
 747   #'equalp)
 748
 749 (defconstant-eqx cond-move-integer-condition-vec
 750   (coerce cond-move-integer-conditions 'vector)
 751   #'equalp)
 752
 753 (deftype cond-move-integer-condition ()
 754   `(member ,@(remove :reserved cond-move-integer-conditions)))
 755
 756 (sb!disassem:define-arg-type register-condition
 757     :printer (lambda (value stream dstate)
 758                  (declare (stream stream) (fixnum value) (ignore dstate))
 759                  (let ((regname (aref cond-move-integer-condition-vec value)))
 760                    (princ regname stream))))
 761
 762 (defconstant-eqx cond-move-integer-printer
 763   `(:name rcond :tab rs1 ", " (:choose immed rs2) ", " rd)
 764   #'equalp)
 765
 766 (defun register-condition (rcond)
 767   (or (position rcond cond-move-integer-conditions)
 768       (error "Unknown register condition:  ~S~%")))
 769
 770 (sb!disassem:define-instruction-format
 771     (format-4-cond-move-integer 32 :default-printer cond-move-integer-printer)
 772   (op    :field (byte 2 30))
 773   (rd    :field (byte 5 25) :type 'reg)
 774   (op3   :field (byte 6 19))
 775   (rs1   :field (byte 5 14) :type 'reg)
 776   (i     :field (byte 1 13) :value 0)
 777   (rcond :field (byte 3 10) :type 'register-condition)
 778   (opf   :field (byte 5 5))
 779   (rs2   :field (byte 5 0) :type 'reg))
 780
 781 (sb!disassem:define-instruction-format
 782     (format-4-cond-move-integer-immed 32 :default-printer cond-move-integer-printer)
 783   (op    :field (byte 2 30))
 784   (rd    :field (byte 5 25) :type 'reg)
 785   (op3   :field (byte 6 19))
 786   (rs1   :field (byte 5 14) :type 'reg)
 787   (i     :field (byte 1 13) :value 1)
 788   (rcond :field (byte 3 10) :type 'register-condition)
 789   (immed :field (byte 10 0) :sign-extend t))
 790
 791 (defconstant-eqx trap-printer
 792   `(:name rd :tab cc ", " immed)
 793   #'equalp)
 794
 795 (sb!disassem:define-instruction-format
 796     (format-4-trap 32 :default-printer trap-printer)
 797   (op    :field (byte 2 30))
 798   (rd    :field (byte 5 25) :type 'reg)
 799   (op3   :field (byte 6 19))
 800   (rs1   :field (byte 5 14) :type 'reg)
 801   (i     :field (byte 1 13) :value 1)
 802   (cc    :field (byte 2 11) :type 'integer-condition-register)
 803   (immed :field (byte 11 0) :sign-extend t))    ; usually sign extended
 804
 805
 806 (defconstant-eqx cond-fp-move-integer-printer
 807   `(:name opf1 :tab rs1 ", " rs2 ", " rd)
 808   #'equalp)
 809
 810 \f
 811 ;;;; Primitive emitters.
 812
 813 (define-bitfield-emitter emit-word 32
 814   (byte 32 0))
 815
 816 (define-bitfield-emitter emit-short 16
 817   (byte 16 0))
 818
 819 (define-bitfield-emitter emit-format-1 32
 820   (byte 2 30) (byte 30 0))
 821
 822 (define-bitfield-emitter emit-format-2-immed 32
 823   (byte 2 30) (byte 5 25) (byte 3 22) (byte 22 0))
 824
 825 (define-bitfield-emitter emit-format-2-branch 32
 826   (byte 2 30) (byte 1 29) (byte 4 25) (byte 3 22) (byte 22 0))
 827
 828 ;; Integer and FP branches with prediction for V9
 829 (define-bitfield-emitter emit-format-2-branch-pred 32
 830   (byte 2 30) (byte 1 29) (byte 4 25) (byte 3 22) (byte 2 20) (byte 1 19) (byte 19 0))
 831 (define-bitfield-emitter emit-format-2-fp-branch-pred 32
 832   (byte 2 30) (byte 1 29) (byte 4 25) (byte 3 22) (byte 2 20) (byte 1 19) (byte 19 0))
 833
 834 (define-bitfield-emitter emit-format-2-unimp 32
 835   (byte 2 30) (byte 5 25) (byte 3 22) (byte 22 0))
 836
 837 (define-bitfield-emitter emit-format-3-reg 32
 838   (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 1 13) (byte 8 5)
 839   (byte 5 0))
 840
 841 (define-bitfield-emitter emit-format-3-immed 32
 842   (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 1 13) (byte 13 0))
 843
 844 (define-bitfield-emitter emit-format-3-fpop 32
 845   (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 9 5) (byte 5 0))
 846
 847 (define-bitfield-emitter emit-format-3-fpop2 32
 848   (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14)
 849   (byte 1 13) (byte 3 10) (byte 1 9) (byte 4 5)
 850   (byte 5 0))
 851
 852 ;;; Shift instructions
 853
 854 (define-bitfield-emitter emit-format-3-shift-reg 32
 855   (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 1 13) (byte 1 12) (byte 7 5)
 856   (byte 5 0))
 857
 858 (define-bitfield-emitter emit-format-3-shift-immed 32
 859   (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 1 13) (byte 1 12) (byte 12 0))
 860
 861 ;;; Conditional moves
 862
 863 ;; Conditional move in condition code
 864 (define-bitfield-emitter emit-format-4-cond-move 32
 865   (byte 2 30) (byte 5 25) (byte 6 19) (byte 1 18) (byte 4 14) (byte 1 13) (byte 2 11)
 866   (byte 11 0))
 867
 868 ;; Conditional move on integer condition
 869 (define-bitfield-emitter emit-format-4-cond-move-integer 32
 870   (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 1 13) (byte 3 10) (byte 5 5)
 871   (byte 5 0))
 872
 873 (define-bitfield-emitter emit-format-4-cond-move-integer-immed 32
 874   (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 1 13) (byte 3 10)
 875   (byte 10 0))
 876
 877 (define-bitfield-emitter emit-format-4-trap 32
 878   (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 1 13) (byte 2 11)
 879   (byte 11 0))
 880
 881 \f
 882 ;;;; Most of the format-3-instructions.
 883
 884 (defun emit-format-3-inst (segment op op3 dst src1 src2
 885                                    &key load-store fixup dest-kind)
 886   (unless src2
 887     (cond ((and (typep src1 'tn) load-store)
 888            (setf src2 0))
 889           (t
 890            (setf src2 src1)
 891            (setf src1 dst))))
 892   (etypecase src2
 893     (tn
 894      (emit-format-3-reg segment op
 895                         (if dest-kind
 896                             (fp-reg-tn-encoding dst)
 897                             (reg-tn-encoding dst))
 898                         op3 (reg-tn-encoding src1) 0 0 (reg-tn-encoding src2)))
 899     (integer
 900      (emit-format-3-immed segment op
 901                           (if dest-kind
 902                               (fp-reg-tn-encoding dst)
 903                               (reg-tn-encoding dst))
 904                           op3 (reg-tn-encoding src1) 1 src2))
 905     (fixup
 906      (unless (or load-store fixup)
 907        (error "Fixups aren't allowed."))
 908      (note-fixup segment :add src2)
 909      (emit-format-3-immed segment op
 910                           (if dest-kind
 911                               (fp-reg-tn-encoding dst)
 912                               (reg-tn-encoding dst))
 913                           op3 (reg-tn-encoding src1) 1 0))))
 914
 915 ;;; Shift instructions because an extra bit is used in Sparc V9's to
 916 ;;; indicate whether the shift is a 32-bit or 64-bit shift.
 917 ;;;
 918 (defun emit-format-3-shift-inst (segment op op3 dst src1 src2 &key extended)
 919   (unless src2
 920     (setf src2 src1)
 921     (setf src1 dst))
 922   (etypecase src2
 923     (tn
 924      (emit-format-3-shift-reg segment op (reg-tn-encoding dst)
 925                               op3 (reg-tn-encoding src1) 0 (if extended 1 0)
 926                               0 (reg-tn-encoding src2)))
 927     (integer
 928      (emit-format-3-shift-immed segment op (reg-tn-encoding dst)
 929                                 op3 (reg-tn-encoding src1) 1
 930                                 (if extended 1 0) src2))))
 931
 932
 933 (eval-when (:compile-toplevel :execute)
 934
 935 ;;; have to do this because def!constant is evalutated in the null lex env.
 936 (defmacro with-ref-format (printer)
 937   `(let* ((addend
 938            '(:choose (:plus-integer immed) ("+" rs2)))
 939           (ref-format
 940            `("[" rs1 (:unless (:constant 0) ,addend) "]"
 941              (:choose (:unless (:constant 0) asi) nil))))
 942      ,printer))
 943
 944 (defconstant-eqx load-printer
 945   (with-ref-format `(:NAME :TAB ,ref-format ", " rd))
 946   #'equalp)
 947
 948 (defconstant-eqx store-printer
 949   (with-ref-format `(:NAME :TAB rd ", " ,ref-format))
 950   #'equalp)
 951
 952 ) ; eval-when (compile eval)
 953
 954 (macrolet ((define-f3-inst (name op op3 &key fixup load-store (dest-kind 'reg)
 955                                  (printer :default) reads writes flushable print-name)
 956   (let ((printer
 957          (if (eq printer :default)
 958              (case load-store
 959                ((nil) :default)
 960                ((:load t) 'load-printer)
 961                (:store 'store-printer))
 962              printer)))
 963     (when (and (atom reads) (not (null reads)))
 964       (setf reads (list reads)))
 965     (when (and (atom writes) (not (null writes)))
 966        (setf writes (list writes)))
 967     `(define-instruction ,name (segment dst src1 &optional src2)
 968        (:declare (type tn dst)
 969                  ,(if (or fixup load-store)
 970                       '(type (or tn (signed-byte 13) null fixup) src1 src2)
 971                       '(type (or tn (signed-byte 13) null) src1 src2)))
 972        (:printer format-3-reg
 973                  ((op ,op) (op3 ,op3) (rd nil :type ',dest-kind))
 974                  ,printer
 975                  ,@(when print-name `(:print-name ,print-name)))
 976        (:printer format-3-immed
 977                  ((op ,op) (op3 ,op3) (rd nil :type ',dest-kind))
 978                  ,printer
 979                  ,@(when print-name `(:print-name ,print-name)))
 980        ,@(when flushable
 981            '((:attributes flushable)))
 982        (:dependencies
 983         (reads src1)
 984         ,@(let ((reads-list nil))
 985             (dolist (read reads)
 986               (push (list 'reads read) reads-list))
 987             reads-list)
 988         ,@(cond ((eq load-store :store)
 989                  '((reads dst)
 990                    (if src2 (reads src2))))
 991                  ((eq load-store t)
 992                   '((reads :memory)
 993                     (reads dst)
 994                     (if src2 (reads src2))))
 995                 ((eq load-store :load)
 996                  '((reads :memory)
 997                    (if src2 (reads src2) (reads dst))))
 998                 (t
 999                  '((if src2 (reads src2) (reads dst)))))
1000         ,@(let ((writes-list nil))
1001             (dolist (write writes)
1002               (push (list 'writes write) writes-list))
1003             writes-list)
1004         ,@(cond ((eq load-store :store)
1005                  '((writes :memory :partially t)))
1006                 ((eq load-store t)
1007                  '((writes :memory :partially t)
1008                    (writes dst)))
1009                 ((eq load-store :load)
1010                  '((writes dst)))
1011                 (t
1012                  '((writes dst)))))
1013        (:delay 0)
1014        (:emitter (emit-format-3-inst segment ,op ,op3 dst src1 src2
1015                                      :load-store ,load-store
1016                                      :fixup ,fixup
1017                                      :dest-kind (not (eq ',dest-kind 'reg)))))))
1018
1019            (define-f3-shift-inst (name op op3 &key extended)
1020                `(define-instruction ,name (segment dst src1 &optional src2)
1021                  (:declare (type tn dst)
1022                   (type (or tn (unsigned-byte 6) null) src1 src2))
1023                  (:printer format-3-shift-reg
1024                   ((op ,op) (op3 ,op3) (x ,(if extended 1 0)) (i 0)))
1025                  (:printer format-3-shift-immed
1026                   ((op ,op) (op3 ,op3) (x ,(if extended 1 0)) (i 1)))
1027                  (:dependencies
1028                   (reads src1)
1029                   (if src2 (reads src2) (reads dst))
1030                   (writes dst))
1031                  (:delay 0)
1032                  (:emitter (emit-format-3-shift-inst segment ,op ,op3 dst src1 src2
1033                             :extended ,extended)))))
1034
1035   (define-f3-inst ldsb #b11 #b001001 :load-store :load)
1036   (define-f3-inst ldsh #b11 #b001010 :load-store :load)
1037   (define-f3-inst ldub #b11 #b000001 :load-store :load)
1038   (define-f3-inst lduh #b11 #b000010 :load-store :load)
1039
1040   ;; This instruction is called lduw for V9 , but looks exactly like ld
1041   ;; on previous architectures.
1042   (define-f3-inst ld #b11 #b000000 :load-store :load
1043                   #!+sparc-v9 :print-name #!+sparc-v9 'lduw)
1044
1045   (define-f3-inst ldsw #b11 #b001000 :load-store :load) ; v9
1046
1047   ;; ldd is deprecated on the Sparc V9.
1048   (define-f3-inst ldd #b11 #b000011 :load-store :load)
1049
1050   (define-f3-inst ldx #b11 #b001011 :load-store :load) ; v9
1051
1052   (define-f3-inst ldf #b11 #b100000 :dest-kind fp-reg :load-store :load)
1053   (define-f3-inst lddf #b11 #b100011 :dest-kind fp-reg :load-store :load)
1054   (define-f3-inst ldqf #b11 #b100010 :dest-kind fp-reg :load-store :load)       ; v9
1055   (define-f3-inst stb #b11 #b000101 :load-store :store)
1056   (define-f3-inst sth #b11 #b000110 :load-store :store)
1057   (define-f3-inst st #b11 #b000100 :load-store :store)
1058
1059   ;; std is deprecated on the Sparc V9.
1060   (define-f3-inst std #b11 #b000111 :load-store :store)
1061
1062   (define-f3-inst stx #b11 #b001110 :load-store :store) ; v9
1063
1064   (define-f3-inst stf #b11 #b100100 :dest-kind fp-reg :load-store :store)
1065   (define-f3-inst stdf #b11 #b100111 :dest-kind fp-reg :load-store :store)
1066   (define-f3-inst stqf #b11 #b100110 :dest-kind fp-reg :load-store :store) ; v9
1067   (define-f3-inst ldstub #b11 #b001101 :load-store t)
1068
1069   ;; swap is deprecated on the Sparc V9
1070   (define-f3-inst swap #b11 #b001111 :load-store t)
1071
1072   (define-f3-inst add #b10 #b000000 :fixup t)
1073   (define-f3-inst addcc #b10 #b010000 :writes :psr)
1074   (define-f3-inst addx #b10 #b001000 :reads :psr)
1075   (define-f3-inst addxcc #b10 #b011000 :reads :psr :writes :psr)
1076   (define-f3-inst taddcc #b10 #b100000 :writes :psr)
1077
1078   ;; taddcctv is deprecated on the Sparc V9.  Use taddcc and bpvs or
1079   ;; taddcc and trap to get a similar effect.  (Requires changing the C
1080   ;; code though!)
1081   ;;(define-f3-inst taddcctv #b10 #b100010 :writes :psr)
1082
1083   (define-f3-inst sub #b10 #b000100)
1084   (define-f3-inst subcc #b10 #b010100 :writes :psr)
1085   (define-f3-inst subx #b10 #b001100 :reads :psr)
1086   (define-f3-inst subxcc #b10 #b011100 :reads :psr :writes :psr)
1087   (define-f3-inst tsubcc #b10 #b100001 :writes :psr)
1088
1089   ;; tsubcctv is deprecated on the Sparc V9.  Use tsubcc and bpvs or
1090   ;; tsubcc and trap to get a similar effect.  (Requires changing the C
1091   ;; code though!)
1092   ;;(define-f3-inst tsubcctv #b10 #b100011 :writes :psr)
1093
1094   (define-f3-inst mulscc #b10 #b100100 :reads :y :writes (:psr :y))
1095   (define-f3-inst and #b10 #b000001)
1096   (define-f3-inst andcc #b10 #b010001 :writes :psr)
1097   (define-f3-inst andn #b10 #b000101)
1098   (define-f3-inst andncc #b10 #b010101 :writes :psr)
1099   (define-f3-inst or #b10 #b000010)
1100   (define-f3-inst orcc #b10 #b010010 :writes :psr)
1101   (define-f3-inst orn #b10 #b000110)
1102   (define-f3-inst orncc #b10 #b010110 :writes :psr)
1103   (define-f3-inst xor #b10 #b000011)
1104   (define-f3-inst xorcc #b10 #b010011 :writes :psr)
1105   (define-f3-inst xnor #b10 #b000111)
1106   (define-f3-inst xnorcc #b10 #b010111 :writes :psr)
1107
1108   (define-f3-shift-inst sll #b10 #b100101)
1109   (define-f3-shift-inst srl #b10 #b100110)
1110   (define-f3-shift-inst sra #b10 #b100111)
1111   (define-f3-shift-inst sllx #b10 #b100101 :extended t) ; v9
1112   (define-f3-shift-inst srlx #b10 #b100110 :extended t) ; v9
1113   (define-f3-shift-inst srax #b10 #b100111 :extended t) ; v9
1114
1115   (define-f3-inst save #b10 #b111100 :reads :psr :writes :psr)
1116   (define-f3-inst restore #b10 #b111101 :reads :psr :writes :psr)
1117
1118   ;; smul, smulcc, umul, umulcc, sdiv, sdivcc, udiv, and udivcc are
1119   ;; deprecated on the Sparc V9.  Use mulx, sdivx, and udivx instead.
1120   (define-f3-inst smul #b10 #b001011 :writes :y)                        ; v8
1121   (define-f3-inst smulcc #b10 #b011011 :writes (:psr :y))               ; v8
1122   (define-f3-inst umul #b10 #b001010 :writes :y)                        ; v8
1123   (define-f3-inst umulcc #b10 #b011010 :writes (:psr :y))               ; v8
1124   (define-f3-inst sdiv #b10 #b001111 :reads :y)                 ; v8
1125   (define-f3-inst sdivcc #b10 #b011111 :reads :y :writes :psr)  ; v8
1126   (define-f3-inst udiv #b10 #b001110 :reads :y)                 ; v8
1127   (define-f3-inst udivcc #b10 #b011110 :reads :y :writes :psr)  ; v8
1128
1129   (define-f3-inst mulx #b10 #b001001)   ; v9 for both signed and unsigned
1130   (define-f3-inst sdivx #b10 #b101101)  ; v9
1131   (define-f3-inst udivx #b10 #b001101)  ; v9
1132
1133   (define-f3-inst popc #b10 #b101110)   ; v9: count one bits
1134
1135 ) ; MACROLET
1136
1137 \f
1138 ;;;; Random instructions.
1139
1140 ;; ldfsr is deprecated on the Sparc V9.  Use ldxfsr instead
1141 (define-instruction ldfsr (segment src1 src2)
1142   (:declare (type tn src1) (type (signed-byte 13) src2))
1143   (:printer format-3-immed ((op #b11) (op3 #b100001) (rd 0)))
1144   :pinned
1145   (:delay 0)
1146   (:emitter (emit-format-3-immed segment #b11 0 #b100001
1147                                  (reg-tn-encoding src1) 1 src2)))
1148
1149 #!+sparc-64
1150 (define-instruction ldxfsr (segment src1 src2)
1151   (:declare (type tn src1) (type (signed-byte 13) src2))
1152   (:printer format-3-immed ((op #b11) (op3 #b100001) (rd 1))
1153             '(:name :tab "[" rs1 (:unless (:constant 0) "+" immed) "], %FSR")
1154             :print-name 'ldx)
1155   :pinned
1156   (:delay 0)
1157   (:emitter (emit-format-3-immed segment #b11 1 #b100001
1158                                  (reg-tn-encoding src1) 1 src2)))
1159
1160 ;; stfsr is deprecated on the Sparc V9.  Use stxfsr instead.
1161 (define-instruction stfsr (segment src1 src2)
1162   (:declare (type tn src1) (type (signed-byte 13) src2))
1163   (:printer format-3-immed ((op #b11) (op3 #b100101) (rd 0)))
1164   :pinned
1165   (:delay 0)
1166   (:emitter (emit-format-3-immed segment #b11 0 #b100101
1167                                  (reg-tn-encoding src1) 1 src2)))
1168
1169 #!+sparc-64
1170 (define-instruction stxfsr (segment src1 src2)
1171   (:declare (type tn src1) (type (signed-byte 13) src2))
1172   (:printer format-3-immed ((op #b11) (op3 #b100101) (rd 1))
1173             '(:name :tab "%FSR, [" rs1 "+" (:unless (:constant 0) "+" immed) "]")
1174             :print-name 'stx)
1175   :pinned
1176   (:delay 0)
1177   (:emitter (emit-format-3-immed segment #b11 1 #b100101
1178                                  (reg-tn-encoding src1) 1 src2)))
1179
1180 (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
1181   (defun sethi-arg-printer (value stream dstate)
1182     (format stream "%hi(#x~8,'0x)" (ash value 10))
1183     ;; Save the immediate value and the destination register from this
1184     ;; sethi instruction.  This is used later to print some possible
1185     ;; notes about the value loaded by sethi.
1186     (let* ((word (sb!disassem::sap-ref-int (sb!disassem::dstate-segment-sap dstate)
1187                                            (sb!disassem::dstate-cur-offs dstate)
1188                                            n-word-bytes
1189                                            (sb!disassem::dstate-byte-order dstate)))
1190            (imm22 (ldb (byte 22 0) word))
1191            (rd (ldb (byte 5 25) word)))
1192       (push (cons rd imm22) *note-sethi-inst*)))
1193 ) ; EVAL-WHEN
1194
1195
1196 (define-instruction sethi (segment dst src1)
1197   (:declare (type tn dst)
1198             (type (or (signed-byte 22) (unsigned-byte 22) fixup) src1))
1199   (:printer format-2-immed
1200             ((op2 #b100) (immed nil :printer #'sethi-arg-printer)))
1201   (:dependencies (writes dst))
1202   (:delay 0)
1203   (:emitter
1204    (etypecase src1
1205      (integer
1206       (emit-format-2-immed segment #b00 (reg-tn-encoding dst) #b100
1207                                  src1))
1208      (fixup
1209       (note-fixup segment :sethi src1)
1210       (emit-format-2-immed segment #b00 (reg-tn-encoding dst) #b100 0)))))
1211
1212 ;; rdy is deprecated on the Sparc V9.  It's not needed with 64-bit
1213 ;; registers.
1214 (define-instruction rdy (segment dst)
1215   (:declare (type tn dst))
1216   (:printer format-3-immed ((op #b10) (op3 #b101000) (rs1 0) (immed 0))
1217             '('RD :tab '%Y ", " rd))
1218   (:dependencies (reads :y) (writes dst))
1219   (:delay 0)
1220   (:emitter (emit-format-3-immed segment #b10 (reg-tn-encoding dst) #b101000
1221                                  0 0 0)))
1222
1223 (defconstant-eqx wry-printer
1224   '('WR :tab rs1 (:unless (:constant 0) ", " (:choose immed rs2)) ", " '%Y)
1225   #'equalp)
1226
1227 ;; wry is deprecated on the Sparc V9.  It's not needed with 64-bit
1228 ;; registers.
1229 (define-instruction wry (segment src1 &optional src2)
1230   (:declare (type tn src1) (type (or (signed-byte 13) tn null) src2))
1231   (:printer format-3-reg ((op #b10) (op3 #b110000) (rd 0)) wry-printer)
1232   (:printer format-3-immed ((op #b10) (op3 #b110000) (rd 0)) wry-printer)
1233   (:dependencies (reads src1) (if src2 (reads src2)) (writes :y))
1234   (:delay 3)
1235   (:emitter
1236    (etypecase src2
1237      (null
1238       (emit-format-3-reg segment #b10 0 #b110000 (reg-tn-encoding src1) 0 0 0))
1239      (tn
1240       (emit-format-3-reg segment #b10 0 #b110000 (reg-tn-encoding src1) 0 0
1241                          (reg-tn-encoding src2)))
1242      (integer
1243       (emit-format-3-immed segment #b10 0 #b110000 (reg-tn-encoding src1) 1
1244                            src2)))))
1245
1246 (defun snarf-error-junk (sap offset &optional length-only)
1247   (let* ((length (sb!sys:sap-ref-8 sap offset))
1248          (vector (make-array length :element-type '(unsigned-byte 8))))
1249     (declare (type sb!sys:system-area-pointer sap)
1250              (type (unsigned-byte 8) length)
1251              (type (simple-array (unsigned-byte 8) (*)) vector))
1252     (cond (length-only
1253            (values 0 (1+ length) nil nil))
1254           (t
1255            (sb!kernel:copy-from-system-area sap (* n-byte-bits (1+ offset))
1256                                          vector (* n-word-bits
1257                                                    vector-data-offset)
1258                                          (* length n-byte-bits))
1259            (collect ((sc-offsets)
1260                      (lengths))
1261              (lengths 1)                ; the length byte
1262              (let* ((index 0)
1263                     (error-number (sb!c:read-var-integer vector index)))
1264                (lengths index)
1265                (loop
1266                  (when (>= index length)
1267                    (return))
1268                  (let ((old-index index))
1269                    (sc-offsets (sb!c:read-var-integer vector index))
1270                    (lengths (- index old-index))))
1271                (values error-number
1272                        (1+ length)
1273                        (sc-offsets)
1274                        (lengths))))))))
1275
1276 (defun unimp-control (chunk inst stream dstate)
1277   (declare (ignore inst))
1278   (flet ((nt (x) (if stream (sb!disassem:note x dstate))))
1279     (case (format-2-unimp-data chunk dstate)
1280       (#.error-trap
1281        (nt "Error trap")
1282        (sb!disassem:handle-break-args #'snarf-error-junk stream dstate))
1283       (#.cerror-trap
1284        (nt "Cerror trap")
1285        (sb!disassem:handle-break-args #'snarf-error-junk stream dstate))
1286       (#.object-not-list-trap
1287        (nt "Object not list trap"))
1288       (#.breakpoint-trap
1289        (nt "Breakpoint trap"))
1290       (#.pending-interrupt-trap
1291        (nt "Pending interrupt trap"))
1292       (#.halt-trap
1293        (nt "Halt trap"))
1294       (#.fun-end-breakpoint-trap
1295        (nt "Function end breakpoint trap"))
1296       (#.object-not-instance-trap
1297        (nt "Object not instance trap"))
1298     )))
1299
1300 (define-instruction unimp (segment data)
1301   (:declare (type (unsigned-byte 22) data))
1302   (:printer format-2-unimp () :default :control #'unimp-control
1303             :print-name #!-sparc-v9 'unimp #!+sparc-v9 'illtrap)
1304   (:delay 0)
1305   (:emitter (emit-format-2-unimp segment 0 0 0 data)))
1306
1307
1308 \f
1309 ;;;; Branch instructions.
1310
1311 ;; The branch instruction is deprecated on the Sparc V9.  Use the
1312 ;; branch with prediction instructions instead.
1313 (defun emit-relative-branch (segment a op2 cond-or-target target &optional fp)
1314   (emit-back-patch segment 4
1315     (lambda (segment posn)
1316         (unless target
1317           (setf target cond-or-target)
1318           (setf cond-or-target :t))
1319         (emit-format-2-branch
1320           segment #b00 a
1321           (if fp
1322               (fp-branch-condition cond-or-target)
1323               (branch-condition cond-or-target))
1324           op2
1325           (let ((offset (ash (- (label-position target) posn) -2)))
1326             (when (and (= a 1) (> 0 offset))
1327               (error "Offset of BA must be positive"))
1328             offset)))))
1329
1330 (defun emit-relative-branch-integer (segment a op2 cond-or-target target &optional (cc :icc) (pred :pt))
1331   (declare (type integer-condition-register cc))
1332   (assert (member :sparc-v9 *backend-subfeatures*))
1333   (emit-back-patch segment 4
1334     (lambda (segment posn)
1335         (unless target
1336           (setf target cond-or-target)
1337           (setf cond-or-target :t))
1338         (emit-format-2-branch-pred
1339           segment #b00 a
1340           (branch-condition cond-or-target)
1341           op2
1342           (integer-condition cc)
1343           (branch-prediction pred)
1344           (let ((offset (ash (- (label-position target) posn) -2)))
1345             (when (and (= a 1) (> 0 offset))
1346               (error "Offset of BA must be positive"))
1347             offset)))))
1348
1349 (defun emit-relative-branch-fp (segment a op2 cond-or-target target &optional (cc :fcc0) (pred :pt))
1350   (assert (member :sparc-v9 *backend-subfeatures*))
1351   (emit-back-patch segment 4
1352     (lambda (segment posn)
1353         (unless target
1354           (setf target cond-or-target)
1355           (setf cond-or-target :t))
1356         (emit-format-2-branch-pred
1357           segment #b00 a
1358           (fp-branch-condition cond-or-target)
1359           op2
1360           (fp-condition cc)
1361           (branch-prediction pred)
1362           (let ((offset (ash (- (label-position target) posn) -2)))
1363             (when (and (= a 1) (> 0 offset))
1364               (error "Offset of BA must be positive"))
1365             offset)))))
1366
1367 ;; So that I don't have to go change the syntax of every single use of
1368 ;; branches, I'm keeping the Lisp instruction names the same.  They
1369 ;; just get translated to the branch with prediction
1370 ;; instructions. However, the disassembler uses the correct V9
1371 ;; mnemonic.
1372 (define-instruction b (segment cond-or-target &rest args)
1373   (:declare (type (or label branch-condition) cond-or-target))
1374   (:printer format-2-branch ((op #b00) (op2 #b010)))
1375   (:attributes branch)
1376   (:dependencies (reads :psr))
1377   (:delay 1)
1378   (:emitter
1379    (cond
1380      ((member :sparc-v9 *backend-subfeatures*)
1381       (destructuring-bind (&optional target pred cc) args
1382         (declare (type (or label null) target))
1383         (emit-relative-branch-integer segment 0 #b001 cond-or-target target (or cc :icc) (or pred :pt))))
1384      (t
1385       (destructuring-bind (&optional target) args
1386         (declare (type (or label null) target))
1387         (emit-relative-branch segment 0 #b010 cond-or-target target))))))
1388
1389 (define-instruction bp (segment cond-or-target &optional target pred cc)
1390   (:declare (type (or label branch-condition) cond-or-target)
1391             (type (or label null) target))
1392   (:printer format-2-branch-pred ((op #b00) (op2 #b001))
1393             branch-pred-printer
1394             :print-name 'bp)
1395   (:attributes branch)
1396   (:dependencies (reads :psr))
1397   (:delay 1)
1398   (:emitter
1399    (emit-relative-branch-integer segment 0 #b001 cond-or-target target (or cc :icc) (or pred :pt))))
1400
1401 (define-instruction ba (segment cond-or-target &rest args)
1402   (:declare (type (or label branch-condition) cond-or-target))
1403   (:printer format-2-branch ((op #b00) (op2 #b010) (a 1))
1404             nil
1405             :print-name 'b)
1406   (:attributes branch)
1407   (:dependencies (reads :psr))
1408   (:delay 0)
1409   (:emitter
1410    (cond
1411      ((member :sparc-v9 *backend-subfeatures*)
1412       (destructuring-bind (&optional target pred cc) args
1413         (declare (type (or label null) target))
1414         (emit-relative-branch-integer segment 1 #b001 cond-or-target target (or cc :icc) (or pred :pt))))
1415      (t
1416       (destructuring-bind (&optional target) args
1417         (declare (type (or label null) target))
1418         (emit-relative-branch segment 1 #b010 cond-or-target target))))))
1419
1420 (define-instruction bpa (segment cond-or-target &optional target pred cc)
1421   (:declare (type (or label branch-condition) cond-or-target)
1422             (type (or label null) target))
1423   (:printer format-2-branch ((op #b00) (op2 #b001) (a 1))
1424             nil
1425             :print-name 'bp)
1426   (:attributes branch)
1427   (:dependencies (reads :psr))
1428   (:delay 0)
1429   (:emitter
1430    (emit-relative-branch-integer segment 1 #b001 cond-or-target target (or cc :icc) (or pred :pt))))
1431
1432 ;; This doesn't cover all of the possible formats for the trap
1433 ;; instruction.  We really only want a trap with a immediate trap
1434 ;; value and with RS1 = register 0.  Also, the Sparc Compliance
1435 ;; Definition 2.4.1 says only trap numbers 16-31 are allowed for user
1436 ;; code.  All other trap numbers have other uses.  The restriction on
1437 ;; target will prevent us from using bad trap numbers by mistake.
1438
1439 (define-instruction t (segment condition target &optional cc)
1440   (:declare (type branch-condition condition)
1441             ;; KLUDGE: see comments in vm.lisp regarding
1442             ;; pseudo-atomic-trap.
1443             #!-linux
1444             (type (integer 16 31) target))
1445   (:printer format-3-immed ((op #b10)
1446                             (rd nil :type 'branch-condition)
1447                             (op3 #b111010)
1448                             (rs1 0))
1449             '(:name rd :tab immed))
1450   (:attributes branch)
1451   (:dependencies (reads :psr))
1452   (:delay 0)
1453   (:emitter
1454    (cond
1455      ((member :sparc-v9 *backend-subfeatures*)
1456       (unless cc
1457         (setf cc :icc))
1458       (emit-format-4-trap segment
1459                           #b10
1460                           (branch-condition condition)
1461                           #b111010 0 1
1462                           (integer-condition cc)
1463                           target))
1464      (t
1465       (assert (null cc))
1466       (emit-format-3-immed segment #b10 (branch-condition condition)
1467                            #b111010 0 1 target)))))
1468
1469 ;;; KLUDGE: we leave this commented out, as these two (T and TCC)
1470 ;;; operations are actually indistinguishable from their bitfields,
1471 ;;; breaking the disassembler if these are left in. The printer isn't
1472 ;;; terribly smart, but the emitted code is right. - CSR, 2002-08-04
1473 #+nil
1474 (define-instruction tcc (segment condition target &optional (cc #!-sparc-64 :icc #!+sparc-64 :xcc))
1475   (:declare (type branch-condition condition)
1476             ;; KLUDGE: see above.
1477             #!-linux
1478             (type (integer 16 31) target)
1479             (type integer-condition-register cc))
1480   (:printer format-4-trap ((op #b10)
1481                             (rd nil :type 'branch-condition)
1482                             (op3 #b111010)
1483                             (rs1 0))
1484             trap-printer)
1485   (:attributes branch)
1486   (:dependencies (reads :psr))
1487   (:delay 0)
1488   (:emitter (emit-format-4-trap segment
1489                                 #b10
1490                                 (branch-condition condition)
1491                                 #b111010 0 1
1492                                 (integer-condition cc)
1493                                 target)))
1494
1495 ;; Same as for the branch instructions.  On the Sparc V9, we will use
1496 ;; the FP branch with prediction instructions instead.
1497
1498 (define-instruction fb (segment condition target &rest args)
1499   (:declare (type fp-branch-condition condition) (type label target))
1500   (:printer format-2-branch ((op #B00)
1501                              (cond nil :type 'branch-fp-condition)
1502                              (op2 #b110)))
1503   (:attributes branch)
1504   (:dependencies (reads :fsr))
1505   (:delay 1)
1506   (:emitter
1507    (cond
1508      ((member :sparc-v9 *backend-subfeatures*)
1509       (destructuring-bind (&optional fcc pred) args
1510         (emit-relative-branch-fp segment 0 #b101 condition target (or fcc :fcc0) (or pred :pt))))
1511      (t
1512       (assert (null args))
1513       (emit-relative-branch segment 0 #b110 condition target t)))))
1514
1515 (define-instruction fbp (segment condition target &optional fcc pred)
1516   (:declare (type fp-branch-condition condition) (type label target))
1517   (:printer format-2-fp-branch-pred ((op #b00) (op2 #b101))
1518             fp-branch-pred-printer
1519             :print-name 'fbp)
1520   (:attributes branch)
1521   (:dependencies (reads :fsr))
1522   (:delay 1)
1523   (:emitter
1524    (emit-relative-branch-fp segment 0 #b101 condition target (or fcc :fcc0) (or pred :pt))))
1525
1526 (defconstant-eqx jal-printer
1527   '(:name :tab
1528           (:choose (rs1 (:unless (:constant 0) (:plus-integer immed)))
1529                    (:cond ((rs2 :constant 0) rs1)
1530                           ((rs1 :constant 0) rs2)
1531                           (t rs1 "+" rs2)))
1532           (:unless (:constant 0) ", " rd))
1533   #'equalp)
1534
1535 (define-instruction jal (segment dst src1 &optional src2)
1536   (:declare (type tn dst)
1537             (type (or tn integer) src1)
1538             (type (or null fixup tn (signed-byte 13)) src2))
1539   (:printer format-3-reg ((op #b10) (op3 #b111000)) jal-printer)
1540   (:printer format-3-immed ((op #b10) (op3 #b111000)) jal-printer)
1541   (:attributes branch)
1542   (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
1543   (:delay 1)
1544   (:emitter
1545    (unless src2
1546      (setf src2 src1)
1547      (setf src1 0))
1548    (etypecase src2
1549      (tn
1550       (emit-format-3-reg segment #b10 (reg-tn-encoding dst) #b111000
1551                          (if (integerp src1)
1552                              src1
1553                              (reg-tn-encoding src1))
1554                          0 0 (reg-tn-encoding src2)))
1555      (integer
1556       (emit-format-3-immed segment #b10 (reg-tn-encoding dst) #b111000
1557                            (reg-tn-encoding src1) 1 src2))
1558      (fixup
1559       (note-fixup segment :add src2)
1560       (emit-format-3-immed segment #b10 (reg-tn-encoding dst)
1561                            #b111000 (reg-tn-encoding src1) 1 0)))))
1562
1563 (define-instruction j (segment src1 &optional src2)
1564   (:declare (type tn src1) (type (or tn (signed-byte 13) fixup null) src2))
1565   (:printer format-3-reg ((op #b10) (op3 #b111000) (rd 0)) jal-printer)
1566   (:printer format-3-immed ((op #b10) (op3 #b111000) (rd 0)) jal-printer)
1567   (:attributes branch)
1568   (:dependencies (reads src1) (if src2 (reads src2)))
1569   (:delay 1)
1570   (:emitter
1571    (etypecase src2
1572      (null
1573       (emit-format-3-reg segment #b10 0 #b111000 (reg-tn-encoding src1) 0 0 0))
1574      (tn
1575       (emit-format-3-reg segment #b10 0 #b111000 (reg-tn-encoding src1) 0 0
1576                          (reg-tn-encoding src2)))
1577      (integer
1578       (emit-format-3-immed segment #b10 0 #b111000 (reg-tn-encoding src1) 1
1579                            src2))
1580      (fixup
1581       (note-fixup segment :add src2)
1582       (emit-format-3-immed segment #b10 0 #b111000 (reg-tn-encoding src1) 1
1583                            0)))))
1584
1585
1586 \f
1587 ;;;; Unary and binary fp insts.
1588
1589 (macrolet ((define-unary-fp-inst (name opf &key reads extended)
1590   `(define-instruction ,name (segment dst src)
1591      (:declare (type tn dst src))
1592      (:printer format-unary-fpop
1593        ((op #b10) (op3 #b110100) (opf ,opf)
1594         (rs1 0)
1595         (rs2 nil :type ',(if extended 'fp-ext-reg 'fp-reg))
1596         (rd nil :type ',(if extended 'fp-ext-reg 'fp-reg))))
1597      (:dependencies
1598       ,@(when reads
1599           `((reads ,reads)))
1600       (reads dst)
1601       (reads src)
1602       (writes dst))
1603      (:delay 0)
1604      (:emitter (emit-format-3-fpop segment #b10 (fp-reg-tn-encoding dst)
1605                 #b110100 0 ,opf (fp-reg-tn-encoding src)))))
1606
1607            (define-binary-fp-inst (name opf &key (op3 #b110100)
1608                                       reads writes delay extended)
1609   `(define-instruction ,name (segment dst src1 src2)
1610      (:declare (type tn dst src1 src2))
1611      (:printer format-binary-fpop
1612       ((op #b10) (op3 ,op3) (opf ,opf)
1613        (rs1 nil :type ',(if extended 'fp-ext-reg 'fp-reg))
1614        (rs2 nil :type ',(if extended 'fp-ext-reg 'fp-reg))
1615        (rd nil :type ',(if extended 'fp-ext-reg 'fp-reg))
1616        ))
1617      (:dependencies
1618       ,@(when reads
1619           `((reads ,reads)))
1620       (reads src1)
1621       (reads src2)
1622       ,@(when writes
1623           `((writes ,writes)))
1624       (writes dst))
1625      ,@(if delay
1626            `((:delay ,delay))
1627            '((:delay 0)))
1628      (:emitter (emit-format-3-fpop segment #b10 (fp-reg-tn-encoding dst)
1629                 ,op3 (fp-reg-tn-encoding src1) ,opf
1630                 (fp-reg-tn-encoding src2)))))
1631
1632            (define-cmp-fp-inst (name opf &key extended)
1633                (let ((opf0 #b0)
1634                      (opf1 #b010)
1635                      (opf2 #b1))
1636                  `(define-instruction ,name (segment src1 src2 &optional (fcc :fcc0))
1637                    (:declare (type tn src1 src2)
1638                     (type (member :fcc0 :fcc1 :fcc2 :fcc3) fcc))
1639        (:printer format-fpop2
1640                  ((op #b10)
1641                   (op3 #b110101)
1642                   (opf0 ,opf0)
1643                   (opf1 ,opf1)
1644                   (opf2 ,opf2)
1645                   (opf3 ,opf)
1646                   (rs1 nil :type ',(if extended 'fp-ext-reg 'fp-reg))
1647                   (rs2 nil :type ',(if extended 'fp-ext-reg 'fp-reg))
1648                   #!-sparc-v9
1649                   (rd 0)
1650                   #!+sparc-v9
1651                   (rd nil :type 'fp-condition-register))
1652         )
1653      (:dependencies
1654       (reads src1)
1655       (reads src2)
1656       (writes :fsr))
1657      ;; The Sparc V9 doesn't need a delay after a FP compare.
1658      ;;
1659      ;; KLUDGE FIXME YAARGH -- how to express that? I guess for now we
1660      ;; do the worst case, and hope to fix it.
1661      ;; (:delay #-sparc-v9 1 #+sparc-v9 0)
1662      (:delay 1)
1663        (:emitter
1664         (emit-format-3-fpop2 segment #b10
1665                              (or (position fcc '(:fcc0 :fcc1 :fcc2 :fcc3))
1666                                  0)
1667                              #b110101
1668                              (fp-reg-tn-encoding src1)
1669                              ,opf0 ,opf1 ,opf2 ,opf
1670                              (fp-reg-tn-encoding src2)))))))
1671
1672   (define-unary-fp-inst fitos #b011000100 :reads :fsr)
1673   (define-unary-fp-inst fitod #b011001000 :reads :fsr :extended t)
1674   (define-unary-fp-inst fitoq #b011001100 :reads :fsr :extended t)      ; v8
1675
1676   (define-unary-fp-inst fxtos #b010000100 :reads :fsr)                    ; v9
1677   (define-unary-fp-inst fxtod #b010001000 :reads :fsr :extended t)        ; v9
1678   (define-unary-fp-inst fxtoq #b010001100 :reads :fsr :extended t)      ; v9
1679
1680
1681   ;; I (Raymond Toy) don't think these f{sd}toir instructions exist on
1682   ;; any Ultrasparc, but I only have a V9 manual. The code in
1683   ;; float.lisp seems to indicate that they only existed on non-sun4
1684   ;; machines (sun3 68K machines?).
1685   (define-unary-fp-inst fstoir #b011000001 :reads :fsr)
1686   (define-unary-fp-inst fdtoir #b011000010 :reads :fsr)
1687
1688   (define-unary-fp-inst fstoi #b011010001)
1689   (define-unary-fp-inst fdtoi #b011010010 :extended t)
1690   (define-unary-fp-inst fqtoi #b011010011 :extended t)  ; v8
1691
1692   (define-unary-fp-inst fstox #b010000001)                ; v9
1693   (define-unary-fp-inst fdtox #b010000010 :extended t)    ; v9
1694   (define-unary-fp-inst fqtox #b010000011 :extended t)  ; v9
1695
1696   (define-unary-fp-inst fstod #b011001001 :reads :fsr)
1697   (define-unary-fp-inst fstoq #b011001101 :reads :fsr)  ; v8
1698   (define-unary-fp-inst fdtos #b011000110 :reads :fsr)
1699   (define-unary-fp-inst fdtoq #b011001110 :reads :fsr)  ; v8
1700   (define-unary-fp-inst fqtos #b011000111 :reads :fsr)  ; v8
1701   (define-unary-fp-inst fqtod #b011001011 :reads :fsr)  ; v8
1702
1703   (define-unary-fp-inst fmovs #b000000001)
1704   (define-unary-fp-inst fmovd #b000000010 :extended t)  ; v9
1705   (define-unary-fp-inst fmovq #b000000011 :extended t)  ; v9
1706
1707   (define-unary-fp-inst fnegs #b000000101)
1708   (define-unary-fp-inst fnegd #b000000110 :extended t)  ; v9
1709   (define-unary-fp-inst fnegq #b000000111 :extended t)  ; v9
1710
1711   (define-unary-fp-inst fabss #b000001001)
1712   (define-unary-fp-inst fabsd #b000001010 :extended t)  ; v9
1713   (define-unary-fp-inst fabsq #b000001011 :extended t)  ; v9
1714
1715   (define-unary-fp-inst fsqrts #b000101001 :reads :fsr)         ; V7
1716   (define-unary-fp-inst fsqrtd #b000101010 :reads :fsr :extended t)     ; V7
1717   (define-unary-fp-inst fsqrtq #b000101011 :reads :fsr :extended t)     ; v8
1718
1719   (define-binary-fp-inst fadds #b001000001)
1720   (define-binary-fp-inst faddd #b001000010 :extended t)
1721   (define-binary-fp-inst faddq #b001000011 :extended t) ; v8
1722   (define-binary-fp-inst fsubs #b001000101)
1723   (define-binary-fp-inst fsubd #b001000110 :extended t)
1724   (define-binary-fp-inst fsubq #b001000111 :extended t) ; v8
1725
1726   (define-binary-fp-inst fmuls #b001001001)
1727   (define-binary-fp-inst fmuld #b001001010 :extended t)
1728   (define-binary-fp-inst fmulq #b001001011 :extended t) ; v8
1729   (define-binary-fp-inst fdivs #b001001101)
1730   (define-binary-fp-inst fdivd #b001001110 :extended t)
1731   (define-binary-fp-inst fdivq #b001001111 :extended t) ; v8
1732
1733 ;;; Float comparison instructions.
1734 ;;;
1735   (define-cmp-fp-inst fcmps #b0001)
1736   (define-cmp-fp-inst fcmpd #b0010 :extended t)
1737   (define-cmp-fp-inst fcmpq #b0011 :extended t) ;v8
1738   (define-cmp-fp-inst fcmpes #b0101)
1739   (define-cmp-fp-inst fcmped #b0110 :extended t)
1740   (define-cmp-fp-inst fcmpeq #b0111 :extended t)        ; v8
1741
1742 ) ; MACROLET
1743 \f
1744 ;;;; li, jali, ji, nop, cmp, not, neg, move, and more
1745
1746 (defun %li (reg value)
1747   (etypecase value
1748     ((signed-byte 13)
1749      (inst add reg zero-tn value))
1750     ((or (signed-byte 32) (unsigned-byte 32))
1751      (let ((hi (ldb (byte 22 10) value))
1752            (lo (ldb (byte 10 0) value)))
1753        (inst sethi reg hi)
1754        (unless (zerop lo)
1755          (inst add reg lo))))
1756     (fixup
1757      (inst sethi reg value)
1758      (inst add reg value))))
1759
1760 (define-instruction-macro li (reg value)
1761   `(%li ,reg ,value))
1762
1763 ;;; Jal to a full 32-bit address.  Tmpreg is trashed.
1764 (define-instruction jali (segment link tmpreg value)
1765   (:declare (type tn link tmpreg)
1766             (type (or (signed-byte 13) (signed-byte 32) (unsigned-byte 32)
1767                       fixup) value))
1768   (:attributes variable-length)
1769   (:vop-var vop)
1770   (:attributes branch)
1771   (:dependencies (writes link) (writes tmpreg))
1772   (:delay 1)
1773   (:emitter
1774    (assemble (segment vop)
1775      (etypecase value
1776        ((signed-byte 13)
1777         (inst jal link zero-tn value))
1778        ((or (signed-byte 32) (unsigned-byte 32))
1779         (let ((hi (ldb (byte 22 10) value))
1780               (lo (ldb (byte 10 0) value)))
1781           (inst sethi tmpreg hi)
1782           (inst jal link tmpreg lo)))
1783        (fixup
1784         (inst sethi tmpreg value)
1785         (inst jal link tmpreg value))))))
1786
1787 ;;; Jump to a full 32-bit address.  Tmpreg is trashed.
1788 (define-instruction ji (segment tmpreg value)
1789   (:declare (type tn tmpreg)
1790             (type (or (signed-byte 13) (signed-byte 32) (unsigned-byte 32)
1791                       fixup) value))
1792   (:attributes variable-length)
1793   (:vop-var vop)
1794   (:attributes branch)
1795   (:dependencies (writes tmpreg))
1796   (:delay 1)
1797   (:emitter
1798    (assemble (segment vop)
1799              (inst jali zero-tn tmpreg value))))
1800
1801 (define-instruction nop (segment)
1802   (:printer format-2-immed ((rd 0) (op2 #b100) (immed 0)) '(:name))
1803   (:attributes flushable)
1804   (:delay 0)
1805   (:emitter (emit-format-2-immed segment 0 0 #b100 0)))
1806
1807 (!def-vm-support-routine emit-nop (segment)
1808   (emit-format-2-immed segment 0 0 #b100 0))
1809
1810 (define-instruction cmp (segment src1 &optional src2)
1811   (:declare (type tn src1) (type (or null tn (signed-byte 13)) src2))
1812   (:printer format-3-reg ((op #b10) (op3 #b010100) (rd 0))
1813             '(:name :tab rs1 ", " rs2))
1814   (:printer format-3-immed ((op #b10) (op3 #b010100) (rd 0))
1815             '(:name :tab rs1 ", " immed))
1816   (:dependencies (reads src1) (if src2 (reads src2)) (writes :psr))
1817   (:delay 0)
1818   (:emitter
1819    (etypecase src2
1820      (null
1821       (emit-format-3-reg segment #b10 0 #b010100 (reg-tn-encoding src1) 0 0 0))
1822      (tn
1823       (emit-format-3-reg segment #b10 0 #b010100 (reg-tn-encoding src1) 0 0
1824                          (reg-tn-encoding src2)))
1825      (integer
1826       (emit-format-3-immed segment #b10 0 #b010100 (reg-tn-encoding src1) 1
1827                            src2)))))
1828
1829 (define-instruction not (segment dst &optional src1)
1830   (:declare (type tn dst) (type (or tn null) src1))
1831   (:printer format-3-reg ((op #b10) (op3 #b000111) (rs2 0))
1832             '(:name :tab (:unless (:same-as rd) rs1 ", " ) rd))
1833   (:dependencies (if src1 (reads src1) (reads dst)) (writes dst))
1834   (:delay 0)
1835   (:emitter
1836    (unless src1
1837      (setf src1 dst))
1838    (emit-format-3-reg segment #b10 (reg-tn-encoding dst) #b000111
1839                       (reg-tn-encoding src1) 0 0 0)))
1840
1841 (define-instruction neg (segment dst &optional src1)
1842   (:declare (type tn dst) (type (or tn null) src1))
1843   (:printer format-3-reg ((op #b10) (op3 #b000100) (rs1 0))
1844             '(:name :tab (:unless (:same-as rd) rs2 ", " ) rd))
1845   (:dependencies (if src1 (reads src1) (reads dst)) (writes dst))
1846   (:delay 0)
1847   (:emitter
1848    (unless src1
1849      (setf src1 dst))
1850    (emit-format-3-reg segment #b10 (reg-tn-encoding dst) #b000100
1851                       0 0 0 (reg-tn-encoding src1))))
1852
1853 (define-instruction move (segment dst src1)
1854   (:declare (type tn dst src1))
1855   (:printer format-3-reg ((op #b10) (op3 #b000010) (rs1 0))
1856             '(:name :tab rs2 ", " rd)
1857             :print-name 'mov)
1858   (:attributes flushable)
1859   (:dependencies (reads src1) (writes dst))
1860   (:delay 0)
1861   (:emitter (emit-format-3-reg segment #b10 (reg-tn-encoding dst) #b000010
1862                                0 0 0 (reg-tn-encoding src1))))
1863
1864
1865 \f
1866 ;;;; Instructions for dumping data and header objects.
1867
1868 (define-instruction word (segment word)
1869   (:declare (type (or (unsigned-byte 32) (signed-byte 32)) word))
1870   :pinned
1871   (:delay 0)
1872   (:emitter
1873    (emit-word segment word)))
1874
1875 (define-instruction short (segment short)
1876   (:declare (type (or (unsigned-byte 16) (signed-byte 16)) short))
1877   :pinned
1878   (:delay 0)
1879   (:emitter
1880    (emit-short segment short)))
1881
1882 (define-instruction byte (segment byte)
1883   (:declare (type (or (unsigned-byte 8) (signed-byte 8)) byte))
1884   :pinned
1885   (:delay 0)
1886   (:emitter
1887    (emit-byte segment byte)))
1888
1889 (define-bitfield-emitter emit-header-object 32
1890   (byte 24 8) (byte 8 0))
1891
1892 (defun emit-header-data (segment type)
1893   (emit-back-patch
1894    segment 4
1895    (lambda (segment posn)
1896        (emit-word segment
1897                   (logior type
1898                           (ash (+ posn (component-header-length))
1899                                (- n-widetag-bits word-shift)))))))
1900
1901 (define-instruction simple-fun-header-word (segment)
1902   :pinned
1903   (:delay 0)
1904   (:emitter
1905    (emit-header-data segment simple-fun-header-widetag)))
1906
1907 (define-instruction lra-header-word (segment)
1908   :pinned
1909   (:delay 0)
1910   (:emitter
1911    (emit-header-data segment return-pc-header-widetag)))
1912
1913 \f
1914 ;;;; Instructions for converting between code objects, functions, and lras.
1915
1916 (defun emit-compute-inst (segment vop dst src label temp calc)
1917   (emit-chooser
1918    ;; We emit either 12 or 4 bytes, so we maintain 8 byte alignments.
1919    segment 12 3
1920    (lambda (segment posn delta-if-after)
1921        (let ((delta (funcall calc label posn delta-if-after)))
1922          (when (<= (- (ash 1 12)) delta (1- (ash 1 12)))
1923            (emit-back-patch segment 4
1924                             (lambda (segment posn)
1925                                 (assemble (segment vop)
1926                                           (inst add dst src
1927                                                 (funcall calc label posn 0)))))
1928            t)))
1929    (lambda (segment posn)
1930        (let ((delta (funcall calc label posn 0)))
1931          (assemble (segment vop)
1932                    (inst sethi temp (ldb (byte 22 10) delta))
1933                    (inst or temp (ldb (byte 10 0) delta))
1934                    (inst add dst src temp))))))
1935
1936 ;; code = fn - fn-ptr-type - header - label-offset + other-pointer-tag
1937 (define-instruction compute-code-from-fn (segment dst src label temp)
1938   (:declare (type tn dst src temp) (type label label))
1939   (:attributes variable-length)
1940   (:dependencies (reads src) (writes dst) (writes temp))
1941   (:delay 0)
1942   (:vop-var vop)
1943   (:emitter
1944    (emit-compute-inst segment vop dst src label temp
1945                       (lambda (label posn delta-if-after)
1946                           (- other-pointer-lowtag
1947                              fun-pointer-lowtag
1948                              (label-position label posn delta-if-after)
1949                              (component-header-length))))))
1950
1951 ;; code = lra - other-pointer-tag - header - label-offset + other-pointer-tag
1952 (define-instruction compute-code-from-lra (segment dst src label temp)
1953   (:declare (type tn dst src temp) (type label label))
1954   (:attributes variable-length)
1955   (:dependencies (reads src) (writes dst) (writes temp))
1956   (:delay 0)
1957   (:vop-var vop)
1958   (:emitter
1959    (emit-compute-inst segment vop dst src label temp
1960                       (lambda (label posn delta-if-after)
1961                           (- (+ (label-position label posn delta-if-after)
1962                                 (component-header-length)))))))
1963
1964 ;; lra = code + other-pointer-tag + header + label-offset - other-pointer-tag
1965 (define-instruction compute-lra-from-code (segment dst src label temp)
1966   (:declare (type tn dst src temp) (type label label))
1967   (:attributes variable-length)
1968   (:dependencies (reads src) (writes dst) (writes temp))
1969   (:delay 0)
1970   (:vop-var vop)
1971   (:emitter
1972    (emit-compute-inst segment vop dst src label temp
1973                       (lambda (label posn delta-if-after)
1974                           (+ (label-position label posn delta-if-after)
1975                              (component-header-length))))))
1976 \f
1977 ;;; Sparc V9 additions
1978
1979
1980
1981 ;; Conditional move integer on condition code
1982 (define-instruction cmove (segment condition dst src &optional (ccreg :icc))
1983   (:declare (type (or branch-condition fp-branch-condition) condition)
1984             (type cond-move-condition-register ccreg)
1985             (type tn dst)
1986             (type (or (signed-byte 13) tn) src))
1987   (:printer format-4-cond-move
1988             ((op #b10)
1989              (op3 #b101100)
1990              (cc2 #b1)
1991              (i 0)
1992              (cc nil :type 'integer-condition-register))
1993              cond-move-printer
1994              :print-name 'mov)
1995   (:printer format-4-cond-move-immed
1996             ((op #b10)
1997              (op3 #b101100)
1998              (cc2 #b1)
1999              (i 1)
2000              (cc nil :type 'integer-condition-register))
2001              cond-move-printer
2002              :print-name 'mov)
2003   (:printer format-4-cond-move
2004             ((op #b10)
2005              (op3 #b101100)
2006              (cc2 #b0)
2007              (cond nil :type 'branch-fp-condition)
2008              (i 0)
2009              (cc nil :type 'fp-condition-register))
2010              cond-move-printer
2011              :print-name 'mov)
2012   (:printer format-4-cond-move-immed
2013             ((op #b10)
2014              (op3 #b101100)
2015              (cc2 #b0)
2016              (cond nil :type 'branch-fp-condition)
2017              (i 1)
2018              (cc nil :type 'fp-condition-register))
2019              cond-move-printer
2020              :print-name 'mov)
2021   (:delay 0)
2022   (:dependencies
2023    (if (member ccreg '(:icc :xcc))
2024        (reads :psr)
2025        (reads :fsr))
2026    (reads src)
2027    (reads dst)
2028    (writes dst))
2029   (:emitter
2030    (let ((op #b10)
2031          (op3 #b101100))
2032      (multiple-value-bind (cc2 cc01)
2033          (cond-move-condition-parts ccreg)
2034        (etypecase src
2035          (tn
2036           (emit-format-4-cond-move segment
2037                                    op
2038                                    (reg-tn-encoding dst)
2039                                    op3
2040                                    cc2
2041                                    (if (member ccreg '(:icc :xcc))
2042                                        (branch-condition condition)
2043                                        (fp-branch-condition condition))
2044                                    0
2045                                    cc01
2046                                    (reg-tn-encoding src)))
2047          (integer
2048           (emit-format-4-cond-move segment
2049                                    op
2050                                    (reg-tn-encoding dst)
2051                                    op3
2052                                    cc2
2053                                    (if (member ccreg '(:icc :xcc))
2054                                        (branch-condition condition)
2055                                        (fp-branch-condition condition))
2056                                    1
2057                                    cc01
2058                                    src)))))))
2059
2060 ;; Conditional move floating-point on condition codes
2061 (macrolet ((define-cond-fp-move (name print-name op op3 opf_low &key extended)
2062   `(define-instruction ,name (segment condition dst src &optional (ccreg :fcc0))
2063      (:declare (type (or branch-condition fp-branch-condition) condition)
2064                (type cond-move-condition-register ccreg)
2065                (type tn dst src))
2066      (:printer format-fpop2
2067                ((op ,op)
2068                 (op3 ,op3)
2069                 (opf0 0)
2070                 (opf1 nil :type 'fp-condition-register-shifted)
2071                 (opf2 0)
2072                 (opf3 ,opf_low)
2073                 (rs1 nil :type 'branch-fp-condition)
2074                 (rs2 nil :type ',(if extended 'fp-ext-reg 'fp-reg))
2075                 (rd nil :type ',(if extended 'fp-ext-reg 'fp-reg)))
2076                 cond-fp-move-printer
2077                 :print-name ',print-name)
2078      (:printer format-fpop2
2079                ((op ,op)
2080                 (op3 ,op3)
2081                 (opf0 1)
2082                 (opf1 nil :type 'integer-condition-register)
2083                 (opf2 0)
2084                 (rs1 nil :type 'branch-condition)
2085                 (opf3 ,opf_low)
2086                 (rs2 nil :type ',(if extended 'fp-ext-reg 'fp-reg))
2087                 (rd nil :type ',(if extended 'fp-ext-reg 'fp-reg)))
2088                cond-fp-move-printer
2089                :print-name ',print-name)
2090      (:delay 0)
2091      (:dependencies
2092       (if (member ccreg '(:icc :xcc))
2093           (reads :psr)
2094           (reads :fsr))
2095       (reads src)
2096       (reads dst)
2097       (writes dst))
2098      (:emitter
2099       (multiple-value-bind (opf_cc2 opf_cc01)
2100           (cond-move-condition-parts ccreg)
2101         (emit-format-3-fpop2 segment
2102                              ,op
2103                              (fp-reg-tn-encoding dst)
2104                              ,op3
2105                              (if (member ccreg '(:icc :xcc))
2106                                  (branch-condition condition)
2107                                  (fp-branch-condition condition))
2108                              opf_cc2
2109                              (ash opf_cc01 1)
2110                              0
2111                              ,opf_low
2112                              (fp-reg-tn-encoding src)))))))
2113   (define-cond-fp-move cfmovs fmovs #b10 #b110101 #b0001)
2114   (define-cond-fp-move cfmovd fmovd #b10 #b110101 #b0010 :extended t)
2115   (define-cond-fp-move cfmovq fmovq #b10 #b110101 #b0011 :extended t))
2116
2117
2118 ;; Move on integer register condition
2119 ;;
2120 ;; movr dst src reg reg-cond
2121 ;;
2122 ;; This means if reg satisfies reg-cond, src is copied to dst.  If the
2123 ;; condition is not satisfied, nothing is done.
2124 ;;
2125 (define-instruction movr (segment dst src2 src1 reg-condition)
2126   (:declare (type cond-move-integer-condition reg-condition)
2127             (type tn dst src1)
2128             (type (or (signed-byte 10) tn) src2))
2129   (:printer format-4-cond-move-integer
2130             ((op #b10)
2131              (op3 #b101111)
2132              (i 0)))
2133   (:printer format-4-cond-move-integer-immed
2134             ((op #b10)
2135              (op3 #b101111)
2136              (i 1)))
2137   (:delay 0)
2138   (:dependencies
2139    (reads :psr)
2140    (reads src2)
2141    (reads src1)
2142    (reads dst)
2143    (writes dst))
2144   (:emitter
2145    (etypecase src2
2146      (tn
2147       (emit-format-4-cond-move-integer
2148        segment #b10 (reg-tn-encoding dst) #b101111 (reg-tn-encoding src1)
2149        0 (register-condition reg-condition)
2150        0 (reg-tn-encoding src2)))
2151      (integer
2152       (emit-format-4-cond-move-integer-immed
2153        segment #b10 (reg-tn-encoding dst) #b101111 (reg-tn-encoding src1)
2154        1 (register-condition reg-condition) src2)))))
2155
2156
2157 ;; Same as MOVR, except we move FP registers depending on the value of
2158 ;; an integer register.
2159 ;;
2160 ;; fmovr dst src reg cond
2161 ;;
2162 ;; This means if REG satifies COND, SRC is COPIED to DST.  Nothing
2163 ;; happens if the condition is not satisfied.
2164 (macrolet ((define-cond-fp-move-integer (name opf_low &key extended)
2165   `(define-instruction ,name (segment dst src2 src1 reg-condition)
2166      (:declare (type cond-move-integer-condition reg-condition)
2167                (type tn dst src1 src2))
2168      (:printer format-fpop2
2169                ((op #b10)
2170                 (rd nil :type ',(if extended 'fp-ext-reg 'fp-reg))
2171                 (op3 #b110101)
2172                 (rs1 nil :type 'reg)
2173                 (opf0 0)
2174                 (opf1 nil :type 'register-condition)
2175                 (opf2 0)
2176                 (opf3 ,opf_low)
2177                 (rs2 nil :type ',(if extended 'fp-ext-reg 'fp-reg))
2178                 )
2179                cond-fp-move-integer-printer)
2180      (:delay 0)
2181      (:dependencies
2182       (reads src2)
2183       (reads src1)
2184       (reads dst)
2185       (writes dst))
2186      (:emitter
2187       (emit-format-3-fpop2
2188        segment
2189        #b10
2190        (fp-reg-tn-encoding dst)
2191        #b110101
2192        (reg-tn-encoding src1)
2193        0
2194        (register-condition reg-condition)
2195        0
2196        ,opf_low
2197        (fp-reg-tn-encoding src2))))))
2198   (define-cond-fp-move-integer fmovrs #b0101)
2199   (define-cond-fp-move-integer fmovrd #b0110 :extended t)
2200   (define-cond-fp-move-integer fmovrq #b0111 :extended t))