src/compiler/mips/insts.lisp

   1 ;;; the instruction set definition for MIPS
   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 (setf *assem-scheduler-p* t)
  15 (setf *assem-max-locations* 68)
  16 \f
  17 ;;;; Constants, types, conversion functions, some disassembler stuff.
  18
  19 (defun reg-tn-encoding (tn)
  20   (declare (type tn tn))
  21   (sc-case tn
  22     (zero zero-offset)
  23     (null null-offset)
  24     (t
  25      (if (eq (sb-name (sc-sb (tn-sc tn))) 'registers)
  26          (tn-offset tn)
  27          (error "~S isn't a register." tn)))))
  28
  29 (defun fp-reg-tn-encoding (tn)
  30   (declare (type tn tn))
  31   (unless (eq (sb-name (sc-sb (tn-sc tn))) 'float-registers)
  32     (error "~S isn't a floating-point register." tn))
  33   (tn-offset tn))
  34
  35 ;;;(sb!disassem:set-disassem-params :instruction-alignment 32)
  36
  37 (defvar *disassem-use-lisp-reg-names* t)
  38
  39 (!def-vm-support-routine location-number (loc)
  40   (etypecase loc
  41     (null)
  42     (number)
  43     (label)
  44     (fixup)
  45     (tn
  46      (ecase (sb-name (sc-sb (tn-sc loc)))
  47        (immediate-constant
  48         ;; Can happen if $ZERO or $NULL are passed in.
  49         nil)
  50        (registers
  51         (unless (zerop (tn-offset loc))
  52           (tn-offset loc)))
  53        (float-registers
  54         (+ (tn-offset loc) 32))))
  55     (symbol
  56      (ecase loc
  57        (:memory 0)
  58        (:hi-reg 64)
  59        (:low-reg 65)
  60        (:float-status 66)
  61        (:ctrl-stat-reg 67)
  62        (:r31 31)))))
  63
  64 (defparameter reg-symbols
  65   (map 'vector
  66        #'(lambda (name)
  67            (cond ((null name) nil)
  68                  (t (make-symbol (concatenate 'string "$" name)))))
  69        *register-names*))
  70
  71 (sb!disassem:define-arg-type reg
  72   :printer #'(lambda (value stream dstate)
  73                (declare (stream stream) (fixnum value))
  74                (let ((regname (aref reg-symbols value)))
  75                  (princ regname stream)
  76                  (sb!disassem:maybe-note-associated-storage-ref
  77                   value
  78                   'registers
  79                   regname
  80                   dstate))))
  81
  82 (defparameter float-reg-symbols
  83   #.(coerce
  84      (loop for n from 0 to 31 collect (make-symbol (format nil "$F~d" n)))
  85      'vector))
  86
  87 (sb!disassem:define-arg-type fp-reg
  88   :printer #'(lambda (value stream dstate)
  89                (declare (stream stream) (fixnum value))
  90                (let ((regname (aref float-reg-symbols value)))
  91                  (princ regname stream)
  92                  (sb!disassem:maybe-note-associated-storage-ref
  93                   value
  94                   'float-registers
  95                   regname
  96                   dstate))))
  97
  98 (sb!disassem:define-arg-type control-reg
  99   :printer "(CR:#x~X)")
 100
 101 (sb!disassem:define-arg-type relative-label
 102   :sign-extend t
 103   :use-label #'(lambda (value dstate)
 104                  (declare (type (signed-byte 16) value)
 105                           (type sb!disassem:disassem-state dstate))
 106                  (+ (ash (1+ value) 2) (sb!disassem:dstate-cur-addr dstate))))
 107
 108 (deftype float-format ()
 109   '(member :s :single :d :double :w :word))
 110
 111 (defun float-format-value (format)
 112   (ecase format
 113     ((:s :single) 0)
 114     ((:d :double) 1)
 115     ((:w :word) 4)))
 116
 117 (sb!disassem:define-arg-type float-format
 118   :printer #'(lambda (value stream dstate)
 119                (declare (ignore dstate)
 120                         (stream stream)
 121                         (fixnum value))
 122                (princ (case value
 123                         (0 's)
 124                         (1 'd)
 125                         (4 'w)
 126                         (t '?))
 127                       stream)))
 128
 129 (defconstant-eqx compare-kinds
 130   '(:f :un :eq :ueq :olt :ult :ole :ule :sf :ngle :seq :ngl :lt :nge :le :ngt)
 131   #'equalp)
 132
 133 (defconstant-eqx compare-kinds-vec
 134   (apply #'vector compare-kinds)
 135   #'equalp)
 136
 137 (deftype compare-kind ()
 138   `(member ,@compare-kinds))
 139
 140 (defun compare-kind (kind)
 141   (or (position kind compare-kinds)
 142       (error "Unknown floating point compare kind: ~S~%Must be one of: ~S"
 143              kind
 144              compare-kinds)))
 145
 146 (sb!disassem:define-arg-type compare-kind
 147   :printer compare-kinds-vec)
 148
 149 (defconstant-eqx float-operations '(+ - * /) #'equalp)
 150
 151 (deftype float-operation ()
 152   `(member ,@float-operations))
 153
 154 (defconstant-eqx float-operation-names
 155   ;; this gets used for output only
 156   #(add sub mul div)
 157   #'equalp)
 158
 159 (defun float-operation (op)
 160   (or (position op float-operations)
 161       (error "Unknown floating point operation: ~S~%Must be one of: ~S"
 162              op
 163              float-operations)))
 164
 165 (sb!disassem:define-arg-type float-operation
 166   :printer float-operation-names)
 167
 168
 169 \f
 170 ;;;; Constants used by instruction emitters.
 171
 172 (defconstant special-op #b000000)
 173 (defconstant bcond-op #b000001)
 174 (defconstant cop0-op #b010000)
 175 (defconstant cop1-op #b010001)
 176 (defconstant cop2-op #b010010)
 177 (defconstant cop3-op #b010011)
 178
 179
 180 \f
 181 ;;;; dissassem:define-instruction-formats
 182
 183 (defconstant-eqx immed-printer
 184   '(:name :tab rt (:unless (:same-as rt) ", " rs) ", " immediate)
 185   #'equalp)
 186
 187 ;;; for things that use rt=0 as a nop
 188 (defconstant-eqx immed-zero-printer
 189   '(:name :tab rt (:unless (:constant 0) ", " rs) ", " immediate)
 190   #'equalp)
 191
 192 (sb!disassem:define-instruction-format
 193     (immediate 32 :default-printer immed-printer)
 194   (op :field (byte 6 26))
 195   (rs :field (byte 5 21) :type 'reg)
 196   (rt :field (byte 5 16) :type 'reg)
 197   (immediate :field (byte 16 0) :sign-extend t))
 198
 199 (eval-when (:compile-toplevel :load-toplevel :execute)
 200   (defparameter jump-printer
 201     #'(lambda (value stream dstate)
 202         (let ((addr (ash value 2)))
 203           (sb!disassem:maybe-note-assembler-routine addr t dstate)
 204           (write addr :base 16 :radix t :stream stream)))))
 205
 206 (sb!disassem:define-instruction-format
 207     (jump 32 :default-printer '(:name :tab target))
 208   (op :field (byte 6 26))
 209   (target :field (byte 26 0) :printer jump-printer))
 210
 211 (defconstant-eqx reg-printer
 212   '(:name :tab rd (:unless (:same-as rd) ", " rs) ", " rt)
 213   #'equalp)
 214
 215 (sb!disassem:define-instruction-format
 216     (register 32 :default-printer reg-printer)
 217   (op :field (byte 6 26))
 218   (rs :field (byte 5 21) :type 'reg)
 219   (rt :field (byte 5 16) :type 'reg)
 220   (rd :field (byte 5 11) :type 'reg)
 221   (shamt :field (byte 5 6) :value 0)
 222   (funct :field (byte 6 0)))
 223
 224 (sb!disassem:define-instruction-format
 225     (break 32 :default-printer
 226            '(:name :tab code (:unless (:constant 0) subcode)))
 227   (op :field (byte 6 26) :value special-op)
 228   (code :field (byte 10 16))
 229   (subcode :field (byte 10 6) :value 0)
 230   (funct :field (byte 6 0) :value #b001101))
 231
 232 (sb!disassem:define-instruction-format
 233     (coproc-branch 32 :default-printer '(:name :tab offset))
 234   (op :field (byte 6 26))
 235   (funct :field (byte 10 16))
 236   (offset :field (byte 16 0)))
 237
 238 (defconstant-eqx float-fmt-printer
 239   '((:unless :constant funct)
 240     (:choose (:unless :constant sub-funct) nil)
 241     "." format)
 242   #'equalp)
 243
 244 (defconstant-eqx float-printer
 245   `(:name ,@float-fmt-printer
 246           :tab
 247           fd
 248           (:unless (:same-as fd) ", " fs)
 249           ", " ft)
 250   #'equalp)
 251
 252 (sb!disassem:define-instruction-format
 253     (float 32 :default-printer float-printer)
 254   (op :field (byte 6 26) :value cop1-op)
 255   (filler :field (byte 1 25) :value 1)
 256   (format :field (byte 4 21) :type 'float-format)
 257   (ft :field (byte 5 16) :value 0)
 258   (fs :field (byte 5 11) :type 'fp-reg)
 259   (fd :field (byte 5 6) :type 'fp-reg)
 260   (funct :field (byte 6 0)))
 261
 262 (sb!disassem:define-instruction-format
 263     (float-aux 32 :default-printer float-printer)
 264   (op :field (byte 6 26) :value cop1-op)
 265   (filler-1 :field (byte 1 25) :value 1)
 266   (format :field (byte 4 21) :type 'float-format)
 267   (ft :field (byte 5 16) :type 'fp-reg)
 268   (fs :field (byte 5 11) :type 'fp-reg)
 269   (fd :field (byte 5 6) :type 'fp-reg)
 270   (funct :field (byte 2 4))
 271   (sub-funct :field (byte 4 0)))
 272
 273 (sb!disassem:define-instruction-format
 274     (float-op 32
 275               :include 'float
 276               :default-printer
 277                 '('f funct "." format
 278                   :tab
 279                   fd
 280                   (:unless (:same-as fd) ", " fs)
 281                   ", " ft))
 282   (funct        :field (byte 2 0) :type 'float-operation)
 283   (funct-filler :field (byte 4 2) :value 0)
 284   (ft           :value nil :type 'fp-reg))
 285
 286 \f
 287 ;;;; Primitive emitters.
 288
 289 (define-bitfield-emitter emit-word 32
 290   (byte 32 0))
 291
 292 (define-bitfield-emitter emit-short 16
 293   (byte 16 0))
 294
 295 (define-bitfield-emitter emit-immediate-inst 32
 296   (byte 6 26) (byte 5 21) (byte 5 16) (byte 16 0))
 297
 298 (define-bitfield-emitter emit-jump-inst 32
 299   (byte 6 26) (byte 26 0))
 300
 301 (define-bitfield-emitter emit-register-inst 32
 302   (byte 6 26) (byte 5 21) (byte 5 16) (byte 5 11) (byte 5 6) (byte 6 0))
 303
 304 (define-bitfield-emitter emit-break-inst 32
 305   (byte 6 26) (byte 10 16) (byte 10 6) (byte 6 0))
 306
 307 (define-bitfield-emitter emit-float-inst 32
 308   (byte 6 26) (byte 1 25) (byte 4 21) (byte 5 16)
 309   (byte 5 11) (byte 5 6) (byte 6 0))
 310
 311
 312 \f
 313 ;;;; Math instructions.
 314
 315 (defun emit-math-inst (segment dst src1 src2 reg-opcode immed-opcode
 316                                &optional allow-fixups)
 317   (unless src2
 318     (setf src2 src1)
 319     (setf src1 dst))
 320   (etypecase src2
 321     (tn
 322      (emit-register-inst segment special-op (reg-tn-encoding src1)
 323                          (reg-tn-encoding src2) (reg-tn-encoding dst)
 324                          0 reg-opcode))
 325     (integer
 326      (emit-immediate-inst segment immed-opcode (reg-tn-encoding src1)
 327                           (reg-tn-encoding dst) src2))
 328     (fixup
 329      (unless allow-fixups
 330        (error "Fixups aren't allowed."))
 331      (note-fixup segment :addi src2)
 332      (emit-immediate-inst segment immed-opcode (reg-tn-encoding src1)
 333                           (reg-tn-encoding dst) 0))))
 334
 335 (define-instruction add (segment dst src1 &optional src2)
 336   (:declare (type tn dst)
 337             (type (or tn (signed-byte 16) null) src1 src2))
 338   (:printer register ((op special-op) (funct #b100000)))
 339   (:printer immediate ((op #b001000)))
 340   (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
 341   (:delay 0)
 342   (:emitter
 343    (emit-math-inst segment dst src1 src2 #b100000 #b001000)))
 344
 345 (define-instruction addu (segment dst src1 &optional src2)
 346   (:declare (type tn dst)
 347             (type (or tn (signed-byte 16) fixup null) src1 src2))
 348   (:printer register ((op special-op) (funct #b100001)))
 349   (:printer immediate ((op #b001001)))
 350   (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
 351   (:delay 0)
 352   (:emitter
 353    (emit-math-inst segment dst src1 src2 #b100001 #b001001 t)))
 354
 355 (define-instruction sub (segment dst src1 &optional src2)
 356   (:declare
 357    (type tn dst)
 358    (type (or tn (integer #.(- 1 (ash 1 15)) #.(ash 1 15)) null) src1 src2))
 359   (:printer register ((op special-op) (funct #b100010)))
 360   (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
 361   (:delay 0)
 362   (:emitter
 363    (unless src2
 364      (setf src2 src1)
 365      (setf src1 dst))
 366    (emit-math-inst segment dst src1
 367                    (if (integerp src2) (- src2) src2)
 368                    #b100010 #b001000)))
 369
 370 (define-instruction subu (segment dst src1 &optional src2)
 371   (:declare
 372    (type tn dst)
 373    (type
 374     (or tn (integer #.(- 1 (ash 1 15)) #.(ash 1 15)) fixup null) src1 src2))
 375   (:printer register ((op special-op) (funct #b100011)))
 376   (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
 377   (:delay 0)
 378   (:emitter
 379    (unless src2
 380      (setf src2 src1)
 381      (setf src1 dst))
 382    (emit-math-inst segment dst src1
 383                    (if (integerp src2) (- src2) src2)
 384                    #b100011 #b001001 t)))
 385
 386 (define-instruction and (segment dst src1 &optional src2)
 387   (:declare (type tn dst)
 388             (type (or tn (unsigned-byte 16) null) src1 src2))
 389   (:printer register ((op special-op) (funct #b100100)))
 390   (:printer immediate ((op #b001100) (immediate nil :sign-extend nil)))
 391   (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
 392   (:delay 0)
 393   (:emitter
 394    (emit-math-inst segment dst src1 src2 #b100100 #b001100)))
 395
 396 (define-instruction or (segment dst src1 &optional src2)
 397   (:declare (type tn dst)
 398             (type (or tn (unsigned-byte 16) null) src1 src2))
 399   (:printer register ((op special-op) (funct #b100101)))
 400   (:printer immediate ((op #b001101)))
 401   (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
 402   (:delay 0)
 403   (:emitter
 404    (emit-math-inst segment dst src1 src2 #b100101 #b001101)))
 405
 406 (define-instruction xor (segment dst src1 &optional src2)
 407   (:declare (type tn dst)
 408             (type (or tn (unsigned-byte 16) null) src1 src2))
 409   (:printer register ((op special-op) (funct #b100110)))
 410   (:printer immediate ((op #b001110)))
 411   (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
 412   (:delay 0)
 413   (:emitter
 414    (emit-math-inst segment dst src1 src2 #b100110 #b001110)))
 415
 416 (define-instruction nor (segment dst src1 &optional src2)
 417   (:declare (type tn dst src1) (type (or tn null) src2))
 418   (:printer register ((op special-op) (funct #b100111)))
 419   (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
 420   (:delay 0)
 421   (:emitter
 422    (emit-math-inst segment dst src1 src2 #b100111 #b000000)))
 423
 424 (define-instruction slt (segment dst src1 &optional src2)
 425   (:declare (type tn dst)
 426             (type (or tn (signed-byte 16) null) src1 src2))
 427   (:printer register ((op special-op) (funct #b101010)))
 428   (:printer immediate ((op #b001010)))
 429   (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
 430   (:delay 0)
 431   (:emitter
 432    (emit-math-inst segment dst src1 src2 #b101010 #b001010)))
 433
 434 (define-instruction sltu (segment dst src1 &optional src2)
 435   (:declare (type tn dst)
 436             (type (or tn (signed-byte 16) null) src1 src2))
 437   (:printer register ((op special-op) (funct #b101011)))
 438   (:printer immediate ((op #b001011)))
 439   (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
 440   (:delay 0)
 441   (:emitter
 442    (emit-math-inst segment dst src1 src2 #b101011 #b001011)))
 443
 444 (defconstant-eqx divmul-printer '(:name :tab rs ", " rt) #'equalp)
 445
 446 (define-instruction div (segment src1 src2)
 447   (:declare (type tn src1 src2))
 448   (:printer register ((op special-op) (rd 0) (funct #b011010)) divmul-printer)
 449   (:dependencies (reads src1) (reads src2) (writes :hi-reg) (writes :low-reg))
 450   (:delay 1)
 451   (:emitter
 452    (emit-register-inst segment special-op (reg-tn-encoding src1)
 453                        (reg-tn-encoding src2) 0 0 #b011010)))
 454
 455 (define-instruction divu (segment src1 src2)
 456   (:declare (type tn src1 src2))
 457   (:printer register ((op special-op) (rd 0) (funct #b011011))
 458             divmul-printer)
 459   (:dependencies (reads src1) (reads src2) (writes :hi-reg) (writes :low-reg))
 460   (:delay 1)
 461   (:emitter
 462    (emit-register-inst segment special-op (reg-tn-encoding src1)
 463                        (reg-tn-encoding src2) 0 0 #b011011)))
 464
 465 (define-instruction mult (segment src1 src2)
 466   (:declare (type tn src1 src2))
 467   (:printer register ((op special-op) (rd 0) (funct #b011000)) divmul-printer)
 468   (:dependencies (reads src1) (reads src2) (writes :hi-reg) (writes :low-reg))
 469   (:delay 1)
 470   (:emitter
 471    (emit-register-inst segment special-op (reg-tn-encoding src1)
 472                        (reg-tn-encoding src2) 0 0 #b011000)))
 473
 474 (define-instruction multu (segment src1 src2)
 475   (:declare (type tn src1 src2))
 476   (:printer register ((op special-op) (rd 0) (funct #b011001)))
 477   (:dependencies (reads src1) (reads src2) (writes :hi-reg) (writes :low-reg))
 478   (:delay 1)
 479   (:emitter
 480    (emit-register-inst segment special-op (reg-tn-encoding src1)
 481                        (reg-tn-encoding src2) 0 0 #b011001)))
 482
 483 (defun emit-shift-inst (segment opcode dst src1 src2)
 484   (unless src2
 485     (setf src2 src1)
 486     (setf src1 dst))
 487   (etypecase src2
 488     (tn
 489      (emit-register-inst segment special-op (reg-tn-encoding src2)
 490                          (reg-tn-encoding src1) (reg-tn-encoding dst)
 491                          0 (logior #b000100 opcode)))
 492     ((unsigned-byte 5)
 493      (emit-register-inst segment special-op 0 (reg-tn-encoding src1)
 494                          (reg-tn-encoding dst) src2 opcode))))
 495
 496 (defconstant-eqx shift-printer
 497   '(:name :tab
 498           rd
 499           (:unless (:same-as rd) ", " rt)
 500           ", " (:cond ((rs :constant 0) shamt)
 501                       (t rs)))
 502   #'equalp)
 503
 504 (define-instruction sll (segment dst src1 &optional src2)
 505   (:declare (type tn dst)
 506             (type (or tn (unsigned-byte 5) null) src1 src2))
 507   (:printer register ((op special-op) (rs 0) (shamt nil) (funct #b000000))
 508             shift-printer)
 509   (:printer register ((op special-op) (funct #b000100)) shift-printer)
 510   (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
 511   (:delay 0)
 512   (:emitter
 513    (emit-shift-inst segment #b00 dst src1 src2)))
 514
 515 (define-instruction sra (segment dst src1 &optional src2)
 516   (:declare (type tn dst)
 517             (type (or tn (unsigned-byte 5) null) src1 src2))
 518   (:printer register ((op special-op) (rs 0) (shamt nil) (funct #b000011))
 519             shift-printer)
 520   (:printer register ((op special-op) (funct #b000111)) shift-printer)
 521   (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
 522   (:delay 0)
 523   (:emitter
 524    (emit-shift-inst segment #b11 dst src1 src2)))
 525
 526 (define-instruction srl (segment dst src1 &optional src2)
 527   (:declare (type tn dst)
 528             (type (or tn (unsigned-byte 5) null) src1 src2))
 529   (:printer register ((op special-op) (rs 0) (shamt nil) (funct #b000010))
 530             shift-printer)
 531   (:printer register ((op special-op) (funct #b000110)) shift-printer)
 532   (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
 533   (:delay 0)
 534   (:emitter
 535    (emit-shift-inst segment #b10 dst src1 src2)))
 536
 537 \f
 538 ;;;; Floating point math.
 539
 540 (define-instruction float-op (segment operation format dst src1 src2)
 541   (:declare (type float-operation operation)
 542             (type float-format format)
 543             (type tn dst src1 src2))
 544   (:printer float-op ())
 545   (:dependencies (reads src1) (reads src2) (writes dst))
 546   (:delay 0)
 547   (:emitter
 548    (emit-float-inst segment cop1-op 1 (float-format-value format)
 549                     (fp-reg-tn-encoding src2) (fp-reg-tn-encoding src1)
 550                     (fp-reg-tn-encoding dst) (float-operation operation))))
 551
 552 (defconstant-eqx float-unop-printer
 553   `(:name ,@float-fmt-printer :tab fd (:unless (:same-as fd) ", " fs))
 554   #'equalp)
 555
 556 (define-instruction fabs (segment format dst &optional (src dst))
 557   (:declare (type float-format format) (type tn dst src))
 558   (:printer float ((funct #b000101)) float-unop-printer)
 559   (:dependencies (reads src) (writes dst))
 560   (:delay 0)
 561   (:emitter
 562    (emit-float-inst segment cop1-op 1 (float-format-value format)
 563                     0 (fp-reg-tn-encoding src) (fp-reg-tn-encoding dst)
 564                     #b000101)))
 565
 566 (define-instruction fneg (segment format dst &optional (src dst))
 567   (:declare (type float-format format) (type tn dst src))
 568   (:printer float ((funct #b000111)) float-unop-printer)
 569   (:dependencies (reads src) (writes dst))
 570   (:delay 0)
 571   (:emitter
 572    (emit-float-inst segment cop1-op 1 (float-format-value format)
 573                     0 (fp-reg-tn-encoding src) (fp-reg-tn-encoding dst)
 574                     #b000111)))
 575
 576 (define-instruction fcvt (segment format1 format2 dst src)
 577   (:declare (type float-format format1 format2) (type tn dst src))
 578   (:printer float-aux ((funct #b10) (sub-funct nil :type 'float-format))
 579            `(:name "." sub-funct "." format :tab fd ", " fs))
 580   (:dependencies (reads src) (writes dst))
 581   (:delay 0)
 582   (:emitter
 583    (emit-float-inst segment cop1-op 1 (float-format-value format2) 0
 584                     (fp-reg-tn-encoding src) (fp-reg-tn-encoding dst)
 585                     (logior #b100000 (float-format-value format1)))))
 586
 587 (define-instruction fcmp (segment operation format fs ft)
 588   (:declare (type compare-kind operation)
 589             (type float-format format)
 590             (type tn fs ft))
 591   (:printer float-aux ((fd 0) (funct #b11) (sub-funct nil :type 'compare-kind))
 592             `(:name "-" sub-funct "." format :tab fs ", " ft))
 593   (:dependencies (reads fs) (reads ft) (writes :float-status))
 594   (:delay 1)
 595   (:emitter
 596    (emit-float-inst segment cop1-op 1 (float-format-value format)
 597                     (fp-reg-tn-encoding ft) (fp-reg-tn-encoding fs) 0
 598                     (logior #b110000 (compare-kind operation)))))
 599
 600 \f
 601 ;;;; Branch/Jump instructions.
 602
 603 (defun emit-relative-branch (segment opcode r1 r2 target)
 604   (emit-back-patch segment 4
 605                    #'(lambda (segment posn)
 606                        (emit-immediate-inst segment
 607                                             opcode
 608                                             (if (fixnump r1)
 609                                                 r1
 610                                                 (reg-tn-encoding r1))
 611                                             (if (fixnump r2)
 612                                                 r2
 613                                                 (reg-tn-encoding r2))
 614                                             (ash (- (label-position target)
 615                                                     (+ posn 4))
 616                                                  -2)))))
 617
 618 (define-instruction b (segment target)
 619   (:declare (type label target))
 620   (:printer immediate ((op #b000100) (rs 0) (rt 0)
 621                        (immediate nil :type 'relative-label))
 622             '(:name :tab immediate))
 623   (:attributes branch)
 624   (:delay 1)
 625   (:emitter
 626    (emit-relative-branch segment #b000100 0 0 target)))
 627
 628 (define-instruction bal (segment target)
 629   (:declare (type label target))
 630   (:printer immediate ((op bcond-op) (rs 0) (rt #b01001)
 631                        (immediate nil :type 'relative-label))
 632             '(:name :tab immediate))
 633   (:attributes branch)
 634   (:delay 1)
 635   (:emitter
 636    (emit-relative-branch segment bcond-op 0 #b10001 target)))
 637
 638
 639 (define-instruction beq (segment r1 r2-or-target &optional target)
 640   (:declare (type tn r1)
 641             (type (or tn fixnum label) r2-or-target)
 642             (type (or label null) target))
 643   (:printer immediate ((op #b000100) (immediate nil :type 'relative-label)))
 644   (:attributes branch)
 645   (:dependencies (reads r1) (reads r2-or-target))
 646   (:delay 1)
 647   (:emitter
 648    (unless target
 649      (setf target r2-or-target)
 650      (setf r2-or-target 0))
 651    (emit-relative-branch segment #b000100 r1 r2-or-target target)))
 652
 653 (define-instruction bne (segment r1 r2-or-target &optional target)
 654   (:declare (type tn r1)
 655             (type (or tn fixnum label) r2-or-target)
 656             (type (or label null) target))
 657   (:printer immediate ((op #b000101) (immediate nil :type 'relative-label)))
 658   (:attributes branch)
 659   (:dependencies (reads r1) (reads r2-or-target))
 660   (:delay 1)
 661   (:emitter
 662    (unless target
 663      (setf target r2-or-target)
 664      (setf r2-or-target 0))
 665    (emit-relative-branch segment #b000101 r1 r2-or-target target)))
 666
 667 (defconstant-eqx cond-branch-printer
 668   '(:name :tab rs ", " immediate)
 669   #'equalp)
 670
 671 (define-instruction blez (segment reg target)
 672   (:declare (type label target) (type tn reg))
 673   (:printer
 674    immediate ((op #b000110) (rt 0) (immediate nil :type 'relative-label))
 675             cond-branch-printer)
 676   (:attributes branch)
 677   (:dependencies (reads reg))
 678   (:delay 1)
 679   (:emitter
 680    (emit-relative-branch segment #b000110 reg 0 target)))
 681
 682 (define-instruction bgtz (segment reg target)
 683   (:declare (type label target) (type tn reg))
 684   (:printer
 685    immediate ((op #b000111) (rt 0) (immediate nil :type 'relative-label))
 686             cond-branch-printer)
 687   (:attributes branch)
 688   (:dependencies (reads reg))
 689   (:delay 1)
 690   (:emitter
 691    (emit-relative-branch segment #b000111 reg 0 target)))
 692
 693 (define-instruction bltz (segment reg target)
 694   (:declare (type label target) (type tn reg))
 695   (:printer
 696    immediate ((op bcond-op) (rt 0) (immediate nil :type 'relative-label))
 697             cond-branch-printer)
 698   (:attributes branch)
 699   (:dependencies (reads reg))
 700   (:delay 1)
 701   (:emitter
 702    (emit-relative-branch segment bcond-op reg #b00000 target)))
 703
 704 (define-instruction bgez (segment reg target)
 705   (:declare (type label target) (type tn reg))
 706   (:printer
 707    immediate ((op bcond-op) (rt 1) (immediate nil :type 'relative-label))
 708             cond-branch-printer)
 709   (:attributes branch)
 710   (:dependencies (reads reg))
 711   (:delay 1)
 712   (:emitter
 713    (emit-relative-branch segment bcond-op reg #b00001 target)))
 714
 715 (define-instruction bltzal (segment reg target)
 716   (:declare (type label target) (type tn reg))
 717   (:printer
 718    immediate ((op bcond-op) (rt #b01000) (immediate nil :type 'relative-label))
 719             cond-branch-printer)
 720   (:attributes branch)
 721   (:dependencies (reads reg) (writes :r31))
 722   (:delay 1)
 723   (:emitter
 724    (emit-relative-branch segment bcond-op reg #b10000 target)))
 725
 726 (define-instruction bgezal (segment reg target)
 727   (:declare (type label target) (type tn reg))
 728   (:printer
 729    immediate ((op bcond-op) (rt #b01001) (immediate nil :type 'relative-label))
 730             cond-branch-printer)
 731   (:attributes branch)
 732   (:delay 1)
 733   (:dependencies (reads reg) (writes :r31))
 734   (:emitter
 735    (emit-relative-branch segment bcond-op reg #b10001 target)))
 736
 737 (defconstant-eqx j-printer
 738   '(:name :tab (:choose rs target))
 739   #'equalp)
 740
 741 (define-instruction j (segment target)
 742   (:declare (type (or tn fixup) target))
 743   (:printer register ((op special-op) (rt 0) (rd 0) (funct #b001000))
 744             j-printer)
 745   (:printer jump ((op #b000010)) j-printer)
 746   (:attributes branch)
 747   (:dependencies (reads target))
 748   (:delay 1)
 749   (:emitter
 750    (etypecase target
 751      (tn
 752       (emit-register-inst segment special-op (reg-tn-encoding target)
 753                           0 0 0 #b001000))
 754      (fixup
 755       (note-fixup segment :jump target)
 756       (emit-jump-inst segment #b000010 0)))))
 757
 758 (define-instruction jal (segment reg-or-target &optional target)
 759   (:declare (type (or null tn fixup) target)
 760             (type (or tn fixup (integer -16 31)) reg-or-target))
 761   (:printer register ((op special-op) (rt 0) (funct #b001001)) j-printer)
 762   (:printer jump ((op #b000011)) j-printer)
 763   (:attributes branch)
 764   (:dependencies (if target (writes reg-or-target) (writes :r31)))
 765   (:delay 1)
 766   (:emitter
 767    (unless target
 768      (setf target reg-or-target)
 769      (setf reg-or-target 31))
 770    (etypecase target
 771      (tn
 772       (emit-register-inst segment special-op (reg-tn-encoding target) 0
 773                           reg-or-target 0 #b001001))
 774      (fixup
 775       (note-fixup segment :jump target)
 776       (emit-jump-inst segment #b000011 0)))))
 777
 778 (define-instruction bc1f (segment target)
 779   (:declare (type label target))
 780   (:printer coproc-branch ((op cop1-op) (funct #x100)
 781                            (offset nil :type 'relative-label)))
 782   (:attributes branch)
 783   (:dependencies (reads :float-status))
 784   (:delay 1)
 785   (:emitter
 786    (emit-relative-branch segment cop1-op #b01000 #b00000 target)))
 787
 788 (define-instruction bc1t (segment target)
 789   (:declare (type label target))
 790   (:printer coproc-branch ((op cop1-op) (funct #x101)
 791                            (offset nil :type 'relative-label)))
 792   (:attributes branch)
 793   (:dependencies (reads :float-status))
 794   (:delay 1)
 795   (:emitter
 796    (emit-relative-branch segment cop1-op #b01000 #b00001 target)))
 797
 798
 799 \f
 800 ;;;; Random movement instructions.
 801
 802 (define-instruction lui (segment reg value)
 803   (:declare (type tn reg)
 804             (type (or fixup (signed-byte 16) (unsigned-byte 16)) value))
 805   (:printer immediate ((op #b001111)
 806                        (immediate nil :sign-extend nil :printer "#x~4,'0X")))
 807   (:dependencies (writes reg))
 808   (:delay 0)
 809   (:emitter
 810    (when (fixup-p value)
 811      (note-fixup segment :lui value)
 812      (setf value 0))
 813    (emit-immediate-inst segment #b001111 0 (reg-tn-encoding reg) value)))
 814
 815 (defconstant-eqx mvsreg-printer '(:name :tab rd)
 816   #'equalp)
 817
 818 (define-instruction mfhi (segment reg)
 819   (:declare (type tn reg))
 820   (:printer register ((op special-op) (rs 0) (rt 0) (funct #b010000))
 821             mvsreg-printer)
 822   (:dependencies (reads :hi-reg) (writes reg))
 823   (:delay 2)
 824   (:emitter
 825    (emit-register-inst segment special-op 0 0 (reg-tn-encoding reg) 0
 826                         #b010000)))
 827
 828 (define-instruction mthi (segment reg)
 829   (:declare (type tn reg))
 830   (:printer register ((op special-op) (rs 0) (rt 0) (funct #b010001))
 831             mvsreg-printer)
 832   (:dependencies (reads reg) (writes :hi-reg))
 833   (:delay 0)
 834   (:emitter
 835    (emit-register-inst segment special-op 0 0 (reg-tn-encoding reg) 0
 836                         #b010001)))
 837
 838 (define-instruction mflo (segment reg)
 839   (:declare (type tn reg))
 840   (:printer register ((op special-op) (rs 0) (rt 0) (funct #b010010))
 841             mvsreg-printer)
 842   (:dependencies (reads :low-reg) (writes reg))
 843   (:delay 2)
 844   (:emitter
 845    (emit-register-inst segment special-op 0 0 (reg-tn-encoding reg) 0
 846                         #b010010)))
 847
 848 (define-instruction mtlo (segment reg)
 849   (:declare (type tn reg))
 850   (:printer register ((op special-op) (rs 0) (rt 0) (funct #b010011))
 851             mvsreg-printer)
 852   (:dependencies (reads reg) (writes :low-reg))
 853   (:delay 0)
 854   (:emitter
 855    (emit-register-inst segment special-op 0 0 (reg-tn-encoding reg) 0
 856                         #b010011)))
 857
 858 (define-instruction move (segment dst src)
 859   (:declare (type tn dst src))
 860   (:printer register ((op special-op) (rt 0) (funct #b100001))
 861             '(:name :tab rd ", " rs))
 862   (:attributes flushable)
 863   (:dependencies (reads src) (writes dst))
 864   (:delay 0)
 865   (:emitter
 866    (emit-register-inst segment special-op (reg-tn-encoding src) 0
 867                        (reg-tn-encoding dst) 0 #b100001)))
 868
 869 (define-instruction fmove (segment format dst src)
 870   (:declare (type float-format format) (type tn dst src))
 871   (:printer float ((funct #b000110)) '(:name "." format :tab fd ", " fs))
 872   (:attributes flushable)
 873   (:dependencies (reads src) (writes dst))
 874   (:delay 0)
 875   (:emitter
 876    (emit-float-inst segment cop1-op 1 (float-format-value format) 0
 877                     (fp-reg-tn-encoding src) (fp-reg-tn-encoding dst)
 878                     #b000110)))
 879
 880 (defun %li (reg value)
 881   (etypecase value
 882     ((unsigned-byte 16)
 883      (inst or reg zero-tn value))
 884     ((signed-byte 16)
 885      (inst addu reg zero-tn value))
 886     ((or (signed-byte 32) (unsigned-byte 32))
 887      (inst lui reg (ldb (byte 16 16) value))
 888      (inst or reg (ldb (byte 16 0) value)))
 889     (fixup
 890      (inst lui reg value)
 891      (inst addu reg value))))
 892
 893 (define-instruction-macro li (reg value)
 894   `(%li ,reg ,value))
 895
 896 (defconstant-eqx sub-op-printer '(:name :tab rd ", " rt) #'equalp)
 897
 898 (define-instruction mtc1 (segment to from)
 899   (:declare (type tn to from))
 900   (:printer register ((op cop1-op) (rs #b00100) (funct 0)) sub-op-printer)
 901   (:dependencies (reads from) (writes to))
 902   (:delay 1)
 903   (:emitter
 904    (emit-register-inst segment cop1-op #b00100 (reg-tn-encoding from)
 905                        (fp-reg-tn-encoding to) 0 0)))
 906
 907 (define-instruction mtc1-odd (segment to from)
 908   (:declare (type tn to from))
 909   (:dependencies (reads from) (writes to))
 910   (:delay 1)
 911   (:emitter
 912    (emit-register-inst segment cop1-op #b00100 (reg-tn-encoding from)
 913                        (1+ (fp-reg-tn-encoding to)) 0 0)))
 914
 915 (define-instruction mfc1 (segment to from)
 916   (:declare (type tn to from))
 917   (:printer register ((op cop1-op) (rs 0) (rd nil :type 'fp-reg) (funct 0))
 918             sub-op-printer)
 919   (:dependencies (reads from) (writes to))
 920   (:delay 1)
 921   (:emitter
 922    (emit-register-inst segment cop1-op #b00000 (reg-tn-encoding to)
 923                        (fp-reg-tn-encoding from) 0 0)))
 924
 925 (define-instruction mfc1-odd (segment to from)
 926   (:declare (type tn to from))
 927   (:dependencies (reads from) (writes to))
 928   (:delay 1)
 929   (:emitter
 930    (emit-register-inst segment cop1-op #b00000 (reg-tn-encoding to)
 931                        (1+ (fp-reg-tn-encoding from)) 0 0)))
 932
 933 (define-instruction mfc1-odd2 (segment to from)
 934   (:declare (type tn to from))
 935   (:dependencies (reads from) (writes to))
 936   (:delay 1)
 937   (:emitter
 938    (emit-register-inst segment cop1-op #b00000 (1+ (reg-tn-encoding to))
 939                        (fp-reg-tn-encoding from) 0 0)))
 940
 941 (define-instruction mfc1-odd3 (segment to from)
 942   (:declare (type tn to from))
 943   (:dependencies (reads from) (writes to))
 944   (:delay 1)
 945   (:emitter
 946    (emit-register-inst segment cop1-op #b00000 (1+ (reg-tn-encoding to))
 947                        (1+ (fp-reg-tn-encoding from)) 0 0)))
 948
 949 (define-instruction cfc1 (segment reg cr)
 950   (:declare (type tn reg) (type (unsigned-byte 5) cr))
 951   (:printer register ((op cop1-op) (rs #b00010) (rd nil :type 'control-reg)
 952                       (funct 0)) sub-op-printer)
 953   (:dependencies (reads :ctrl-stat-reg) (writes reg))
 954   (:delay 1)
 955   (:emitter
 956    (emit-register-inst segment cop1-op #b00010 (reg-tn-encoding reg)
 957                        cr 0 0)))
 958
 959 (define-instruction ctc1 (segment reg cr)
 960   (:declare (type tn reg) (type (unsigned-byte 5) cr))
 961   (:printer register ((op cop1-op) (rs #b00110) (rd nil :type 'control-reg)
 962                       (funct 0)) sub-op-printer)
 963   (:dependencies (reads reg) (writes :ctrl-stat-reg))
 964   (:delay 1)
 965   (:emitter
 966    (emit-register-inst segment cop1-op #b00110 (reg-tn-encoding reg)
 967                        cr 0 0)))
 968
 969
 970 \f
 971 ;;;; Random system hackery and other noise
 972
 973 (define-instruction-macro entry-point ()
 974   nil)
 975
 976 #+nil
 977 (define-bitfield-emitter emit-break-inst 32
 978   (byte 6 26) (byte 10 16) (byte 10 6) (byte 6 0))
 979
 980 (defun snarf-error-junk (sap offset &optional length-only)
 981   (let* ((length (sb!sys:sap-ref-8 sap offset))
 982          (vector (make-array length :element-type '(unsigned-byte 8))))
 983     (declare (type sb!sys:system-area-pointer sap)
 984              (type (unsigned-byte 8) length)
 985              (type (simple-array (unsigned-byte 8) (*)) vector))
 986     (cond (length-only
 987            (values 0 (1+ length) nil nil))
 988           (t
 989            (sb!kernel:copy-ub8-from-system-area sap (1+ offset)
 990                                                 vector 0 length)
 991            (collect ((sc-offsets)
 992                      (lengths))
 993              (lengths 1)                ; the length byte
 994              (let* ((index 0)
 995                     (error-number (sb!c:read-var-integer vector index)))
 996                (lengths index)
 997                (loop
 998                  (when (>= index length)
 999                    (return))
1000                  (let ((old-index index))
1001                    (sc-offsets (sb!c:read-var-integer vector index))
1002                    (lengths (- index old-index))))
1003                (values error-number
1004                        (1+ length)
1005                        (sc-offsets)
1006                        (lengths))))))))
1007
1008 (defmacro break-cases (breaknum &body cases)
1009   (let ((bn-temp (gensym)))
1010     (collect ((clauses))
1011       (dolist (case cases)
1012         (clauses `((= ,bn-temp ,(car case)) ,@(cdr case))))
1013       `(let ((,bn-temp ,breaknum))
1014          (cond ,@(clauses))))))
1015
1016 (defun break-control (chunk inst stream dstate)
1017   (declare (ignore inst))
1018   (flet ((nt (x) (if stream (sb!disassem:note x dstate))))
1019     (case (break-code chunk dstate)
1020       (#.error-trap
1021        (nt "Error trap")
1022        (sb!disassem:handle-break-args #'snarf-error-junk stream dstate))
1023       (#.cerror-trap
1024        (nt "Cerror trap")
1025        (sb!disassem:handle-break-args #'snarf-error-junk stream dstate))
1026       (#.breakpoint-trap
1027        (nt "Breakpoint trap"))
1028       (#.pending-interrupt-trap
1029        (nt "Pending interrupt trap"))
1030       (#.halt-trap
1031        (nt "Halt trap"))
1032       (#.fun-end-breakpoint-trap
1033        (nt "Function end breakpoint trap"))
1034     )))
1035
1036 (define-instruction break (segment code &optional (subcode 0))
1037   (:declare (type (unsigned-byte 10) code subcode))
1038   (:printer break ((op special-op) (funct #b001101))
1039             '(:name :tab code (:unless (:constant 0) subcode))
1040             :control #'break-control )
1041   :pinned
1042   (:cost 0)
1043   (:delay 0)
1044   (:emitter
1045    (emit-break-inst segment special-op code subcode #b001101)))
1046
1047 (define-instruction syscall (segment)
1048   (:printer register ((op special-op) (rd 0) (rt 0) (rs 0) (funct #b001100))
1049             '(:name))
1050   :pinned
1051   (:delay 0)
1052   (:emitter
1053    (emit-register-inst segment special-op 0 0 0 0 #b001100)))
1054
1055 (define-instruction nop (segment)
1056   (:printer register ((op 0) (rd 0) (rd 0) (rs 0) (funct 0)) '(:name))
1057   (:attributes flushable)
1058   (:delay 0)
1059   (:emitter
1060    (emit-word segment 0)))
1061
1062 (!def-vm-support-routine emit-nop (segment)
1063   (emit-word segment 0))
1064
1065 (define-instruction word (segment word)
1066   (:declare (type (or (unsigned-byte 32) (signed-byte 32)) word))
1067   :pinned
1068   (:cost 0)
1069   (:delay 0)
1070   (:emitter
1071    (emit-word segment word)))
1072
1073 (define-instruction short (segment short)
1074   (:declare (type (or (unsigned-byte 16) (signed-byte 16)) short))
1075   :pinned
1076   (:cost 0)
1077   (:delay 0)
1078   (:emitter
1079    (emit-short segment short)))
1080
1081 (define-instruction byte (segment byte)
1082   (:declare (type (or (unsigned-byte 8) (signed-byte 8)) byte))
1083   :pinned
1084   (:cost 0)
1085   (:delay 0)
1086   (:emitter
1087    (emit-byte segment byte)))
1088
1089
1090 (defun emit-header-data (segment type)
1091   (emit-back-patch
1092    segment 4
1093    #'(lambda (segment posn)
1094        (emit-word segment
1095                   (logior type
1096                           (ash (+ posn (component-header-length))
1097                                (- n-widetag-bits word-shift)))))))
1098
1099 (define-instruction fun-header-word (segment)
1100   :pinned
1101   (:cost 0)
1102   (:delay 0)
1103   (:emitter
1104    (emit-header-data segment simple-fun-header-widetag)))
1105
1106 (define-instruction lra-header-word (segment)
1107   :pinned
1108   (:cost 0)
1109   (:delay 0)
1110   (:emitter
1111    (emit-header-data segment return-pc-header-widetag)))
1112
1113
1114 (defun emit-compute-inst (segment vop dst src label temp calc)
1115   (emit-chooser
1116    ;; We emit either 12 or 4 bytes, so we maintain 8 byte alignments.
1117    segment 12 3
1118    #'(lambda (segment posn delta-if-after)
1119        (let ((delta (funcall calc label posn delta-if-after)))
1120           (when (<= (- (ash 1 15)) delta (1- (ash 1 15)))
1121             (emit-back-patch segment 4
1122                              #'(lambda (segment posn)
1123                                  (assemble (segment vop)
1124                                            (inst addu dst src
1125                                                  (funcall calc label posn 0)))))
1126             t)))
1127    #'(lambda (segment posn)
1128        (let ((delta (funcall calc label posn 0)))
1129          (assemble (segment vop)
1130                    (inst lui temp (ldb (byte 16 16) delta))
1131                    (inst or temp (ldb (byte 16 0) delta))
1132                    (inst addu dst src temp))))))
1133
1134 ;; code = fn - header - label-offset + other-pointer-tag
1135 (define-instruction compute-code-from-fn (segment dst src label temp)
1136   (:declare (type tn dst src temp) (type label label))
1137   (:attributes variable-length)
1138   (:dependencies (reads src) (writes dst) (writes temp))
1139   (:delay 0)
1140   (:vop-var vop)
1141   (:emitter
1142    (emit-compute-inst segment vop dst src label temp
1143                       #'(lambda (label posn delta-if-after)
1144                           (- other-pointer-lowtag
1145                              (label-position label posn delta-if-after)
1146                              (component-header-length))))))
1147
1148 ;; code = lra - other-pointer-tag - header - label-offset + other-pointer-tag
1149 ;;      = lra - (header + label-offset)
1150 (define-instruction compute-code-from-lra (segment dst src label temp)
1151   (:declare (type tn dst src temp) (type label label))
1152   (:attributes variable-length)
1153   (:dependencies (reads src) (writes dst) (writes temp))
1154   (:delay 0)
1155   (:vop-var vop)
1156   (:emitter
1157    (emit-compute-inst segment vop dst src label temp
1158                       #'(lambda (label posn delta-if-after)
1159                           (- (+ (label-position label posn delta-if-after)
1160                                 (component-header-length)))))))
1161
1162 ;; lra = code + other-pointer-tag + header + label-offset - other-pointer-tag
1163 (define-instruction compute-lra-from-code (segment dst src label temp)
1164   (:declare (type tn dst src temp) (type label label))
1165   (:attributes variable-length)
1166   (:dependencies (reads src) (writes dst) (writes temp))
1167   (:delay 0)
1168   (:vop-var vop)
1169   (:emitter
1170    (emit-compute-inst segment vop dst src label temp
1171                       #'(lambda (label posn delta-if-after)
1172                           (+ (label-position label posn delta-if-after)
1173                              (component-header-length))))))
1174
1175 \f
1176 ;;;; Loads and Stores
1177
1178 (defun emit-load/store-inst (segment opcode reg base index
1179                                      &optional (oddhack 0))
1180   (when (fixup-p index)
1181     (note-fixup segment :addi index)
1182     (setf index 0))
1183   (emit-immediate-inst segment opcode (reg-tn-encoding reg)
1184                        (+ (reg-tn-encoding base) oddhack) index))
1185
1186 (defconstant-eqx load-store-printer
1187   '(:name :tab
1188           rt ", "
1189           rs
1190           (:unless (:constant 0) "[" immediate "]"))
1191   #'equalp)
1192
1193 (define-instruction lb (segment reg base &optional (index 0))
1194   (:declare (type tn reg base)
1195             (type (or (signed-byte 16) fixup) index))
1196   (:printer immediate ((op #b100000)) load-store-printer)
1197   (:dependencies (reads base) (reads :memory) (writes reg))
1198   (:delay 1)
1199   (:emitter
1200    (emit-load/store-inst segment #b100000 base reg index)))
1201
1202 (define-instruction lh (segment reg base &optional (index 0))
1203   (:declare (type tn reg base)
1204             (type (or (signed-byte 16) fixup) index))
1205   (:printer immediate ((op #b100001)) load-store-printer)
1206   (:dependencies (reads base) (reads :memory) (writes reg))
1207   (:delay 1)
1208   (:emitter
1209    (emit-load/store-inst segment #b100001 base reg index)))
1210
1211 (define-instruction lwl (segment reg base &optional (index 0))
1212   (:declare (type tn reg base)
1213             (type (or (signed-byte 16) fixup) index))
1214   (:printer immediate ((op #b100010)) load-store-printer)
1215   (:dependencies (reads base) (reads :memory) (writes reg))
1216   (:delay 1)
1217   (:emitter
1218    (emit-load/store-inst segment #b100010 base reg index)))
1219
1220 (define-instruction lw (segment reg base &optional (index 0))
1221   (:declare (type tn reg base)
1222             (type (or (signed-byte 16) fixup) index))
1223   (:printer immediate ((op #b100011)) load-store-printer)
1224   (:dependencies (reads base) (reads :memory) (writes reg))
1225   (:delay 1)
1226   (:emitter
1227    (emit-load/store-inst segment #b100011 base reg index)))
1228
1229 ;; next is just for ease of coding double-in-int c-call convention
1230 (define-instruction lw-odd (segment reg base &optional (index 0))
1231   (:declare (type tn reg base)
1232             (type (or (signed-byte 16) fixup) index))
1233   (:dependencies (reads base) (reads :memory) (writes reg))
1234   (:delay 1)
1235   (:emitter
1236    (emit-load/store-inst segment #b100011 base reg index 1)))
1237
1238 (define-instruction lbu (segment reg base &optional (index 0))
1239   (:declare (type tn reg base)
1240             (type (or (signed-byte 16) fixup) index))
1241   (:printer immediate ((op #b100100)) load-store-printer)
1242   (:dependencies (reads base) (reads :memory) (writes reg))
1243   (:delay 1)
1244   (:emitter
1245    (emit-load/store-inst segment #b100100 base reg index)))
1246
1247 (define-instruction lhu (segment reg base &optional (index 0))
1248   (:declare (type tn reg base)
1249             (type (or (signed-byte 16) fixup) index))
1250   (:printer immediate ((op #b100101)) load-store-printer)
1251   (:dependencies (reads base) (reads :memory) (writes reg))
1252   (:delay 1)
1253   (:emitter
1254    (emit-load/store-inst segment #b100101 base reg index)))
1255
1256 (define-instruction lwr (segment reg base &optional (index 0))
1257   (:declare (type tn reg base)
1258             (type (or (signed-byte 16) fixup) index))
1259   (:printer immediate ((op #b100110)) load-store-printer)
1260   (:dependencies (reads base) (reads :memory) (writes reg))
1261   (:delay 1)
1262   (:emitter
1263    (emit-load/store-inst segment #b100110 base reg index)))
1264
1265 (define-instruction sb (segment reg base &optional (index 0))
1266   (:declare (type tn reg base)
1267             (type (or (signed-byte 16) fixup) index))
1268   (:printer immediate ((op #b101000)) load-store-printer)
1269   (:dependencies (reads base) (reads reg) (writes :memory))
1270   (:delay 0)
1271   (:emitter
1272    (emit-load/store-inst segment #b101000 base reg index)))
1273
1274 (define-instruction sh (segment reg base &optional (index 0))
1275   (:declare (type tn reg base)
1276             (type (or (signed-byte 16) fixup) index))
1277   (:printer immediate ((op #b101001)) load-store-printer)
1278   (:dependencies (reads base) (reads reg) (writes :memory))
1279   (:delay 0)
1280   (:emitter
1281    (emit-load/store-inst segment #b101001 base reg index)))
1282
1283 (define-instruction swl (segment reg base &optional (index 0))
1284   (:declare (type tn reg base)
1285             (type (or (signed-byte 16) fixup) index))
1286   (:printer immediate ((op #b101010)) load-store-printer)
1287   (:dependencies (reads base) (reads reg) (writes :memory))
1288   (:delay 0)
1289   (:emitter
1290    (emit-load/store-inst segment #b101010 base reg index)))
1291
1292 (define-instruction sw (segment reg base &optional (index 0))
1293   (:declare (type tn reg base)
1294             (type (or (signed-byte 16) fixup) index))
1295   (:printer immediate ((op #b101011)) load-store-printer)
1296   (:dependencies (reads base) (reads reg) (writes :memory))
1297   (:delay 0)
1298   (:emitter
1299    (emit-load/store-inst segment #b101011 base reg index)))
1300
1301 (define-instruction swr (segment reg base &optional (index 0))
1302   (:declare (type tn reg base)
1303             (type (or (signed-byte 16) fixup) index))
1304   (:printer immediate ((op #b101110)) load-store-printer)
1305   (:dependencies (reads base) (reads reg) (writes :memory))
1306   (:delay 0)
1307   (:emitter
1308    (emit-load/store-inst segment #b101110 base reg index)))
1309
1310
1311 (defun emit-fp-load/store-inst (segment opcode reg odd base index)
1312   (when (fixup-p index)
1313     (note-fixup segment :addi index)
1314     (setf index 0))
1315   (emit-immediate-inst segment opcode (reg-tn-encoding base)
1316                        (+ (fp-reg-tn-encoding reg) odd) index))
1317
1318 (define-instruction lwc1 (segment reg base &optional (index 0))
1319   (:declare (type tn reg base)
1320             (type (or (signed-byte 16) fixup) index))
1321   (:printer immediate ((op #b110001) (rt nil :type 'fp-reg)) load-store-printer)
1322   (:dependencies (reads base) (reads :memory) (writes reg))
1323   (:delay 1)
1324   (:emitter
1325    (emit-fp-load/store-inst segment #b110001 reg 0 base index)))
1326
1327 (define-instruction lwc1-odd (segment reg base &optional (index 0))
1328   (:declare (type tn reg base)
1329             (type (or (signed-byte 16) fixup) index))
1330   (:dependencies (reads base) (reads :memory) (writes reg))
1331   (:delay 1)
1332   (:emitter
1333    (emit-fp-load/store-inst segment #b110001 reg 1 base index)))
1334
1335 (define-instruction swc1 (segment reg base &optional (index 0))
1336   (:declare (type tn reg base)
1337             (type (or (signed-byte 16) fixup) index))
1338   (:printer immediate ((op #b111001) (rt nil :type 'fp-reg)) load-store-printer)
1339   (:dependencies (reads base) (reads reg) (writes :memory))
1340   (:delay 0)
1341   (:emitter
1342    (emit-fp-load/store-inst segment #b111001 reg 0 base index)))
1343
1344 (define-instruction swc1-odd (segment reg base &optional (index 0))
1345   (:declare (type tn reg base)
1346             (type (or (signed-byte 16) fixup) index))
1347   (:dependencies (reads base) (reads reg) (writes :memory))
1348   (:delay 0)
1349   (:emitter
1350    (emit-fp-load/store-inst segment #b111001 reg 1 base index)))
1351