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-from-system-area sap (* n-byte-bits (1+ offset))
 990                                          vector (* n-word-bits
 991                                                    vector-data-offset)
 992                                          (* length n-byte-bits))
 993            (collect ((sc-offsets)
 994                      (lengths))
 995              (lengths 1)                ; the length byte
 996              (let* ((index 0)
 997                     (error-number (sb!c:read-var-integer vector index)))
 998                (lengths index)
 999                (loop
1000                  (when (>= index length)
1001                    (return))
1002                  (let ((old-index index))
1003                    (sc-offsets (sb!c:read-var-integer vector index))
1004                    (lengths (- index old-index))))
1005                (values error-number
1006                        (1+ length)
1007                        (sc-offsets)
1008                        (lengths))))))))
1009
1010 (defmacro break-cases (breaknum &body cases)
1011   (let ((bn-temp (gensym)))
1012     (collect ((clauses))
1013       (dolist (case cases)
1014         (clauses `((= ,bn-temp ,(car case)) ,@(cdr case))))
1015       `(let ((,bn-temp ,breaknum))
1016          (cond ,@(clauses))))))
1017
1018 (defun break-control (chunk inst stream dstate)
1019   (declare (ignore inst))
1020   (flet ((nt (x) (if stream (sb!disassem:note x dstate))))
1021     (case (break-code chunk dstate)
1022       (#.error-trap
1023        (nt "Error trap")
1024        (sb!disassem:handle-break-args #'snarf-error-junk stream dstate))
1025       (#.cerror-trap
1026        (nt "Cerror trap")
1027        (sb!disassem:handle-break-args #'snarf-error-junk stream dstate))
1028       (#.breakpoint-trap
1029        (nt "Breakpoint trap"))
1030       (#.pending-interrupt-trap
1031        (nt "Pending interrupt trap"))
1032       (#.halt-trap
1033        (nt "Halt trap"))
1034       (#.fun-end-breakpoint-trap
1035        (nt "Function end breakpoint trap"))
1036     )))
1037
1038 (define-instruction break (segment code &optional (subcode 0))
1039   (:declare (type (unsigned-byte 10) code subcode))
1040   (:printer break ((op special-op) (funct #b001101))
1041             '(:name :tab code (:unless (:constant 0) subcode))
1042             :control #'break-control )
1043   :pinned
1044   (:cost 0)
1045   (:delay 0)
1046   (:emitter
1047    (emit-break-inst segment special-op code subcode #b001101)))
1048
1049 (define-instruction syscall (segment)
1050   (:printer register ((op special-op) (rd 0) (rt 0) (rs 0) (funct #b001100))
1051             '(:name))
1052   :pinned
1053   (:delay 0)
1054   (:emitter
1055    (emit-register-inst segment special-op 0 0 0 0 #b001100)))
1056
1057 (define-instruction nop (segment)
1058   (:printer register ((op 0) (rd 0) (rd 0) (rs 0) (funct 0)) '(:name))
1059   (:attributes flushable)
1060   (:delay 0)
1061   (:emitter
1062    (emit-word segment 0)))
1063
1064 (!def-vm-support-routine emit-nop (segment)
1065   (emit-word segment 0))
1066
1067 (define-instruction word (segment word)
1068   (:declare (type (or (unsigned-byte 32) (signed-byte 32)) word))
1069   :pinned
1070   (:cost 0)
1071   (:delay 0)
1072   (:emitter
1073    (emit-word segment word)))
1074
1075 (define-instruction short (segment short)
1076   (:declare (type (or (unsigned-byte 16) (signed-byte 16)) short))
1077   :pinned
1078   (:cost 0)
1079   (:delay 0)
1080   (:emitter
1081    (emit-short segment short)))
1082
1083 (define-instruction byte (segment byte)
1084   (:declare (type (or (unsigned-byte 8) (signed-byte 8)) byte))
1085   :pinned
1086   (:cost 0)
1087   (:delay 0)
1088   (:emitter
1089    (emit-byte segment byte)))
1090
1091
1092 (defun emit-header-data (segment type)
1093   (emit-back-patch
1094    segment 4
1095    #'(lambda (segment posn)
1096        (emit-word segment
1097                   (logior type
1098                           (ash (+ posn (component-header-length))
1099                                (- n-widetag-bits word-shift)))))))
1100
1101 (define-instruction fun-header-word (segment)
1102   :pinned
1103   (:cost 0)
1104   (:delay 0)
1105   (:emitter
1106    (emit-header-data segment simple-fun-header-widetag)))
1107
1108 (define-instruction lra-header-word (segment)
1109   :pinned
1110   (:cost 0)
1111   (:delay 0)
1112   (:emitter
1113    (emit-header-data segment return-pc-header-widetag)))
1114
1115
1116 (defun emit-compute-inst (segment vop dst src label temp calc)
1117   (emit-chooser
1118    ;; We emit either 12 or 4 bytes, so we maintain 8 byte alignments.
1119    segment 12 3
1120    #'(lambda (segment posn delta-if-after)
1121        (let ((delta (funcall calc label posn delta-if-after)))
1122           (when (<= (- (ash 1 15)) delta (1- (ash 1 15)))
1123             (emit-back-patch segment 4
1124                              #'(lambda (segment posn)
1125                                  (assemble (segment vop)
1126                                            (inst addu dst src
1127                                                  (funcall calc label posn 0)))))
1128             t)))
1129    #'(lambda (segment posn)
1130        (let ((delta (funcall calc label posn 0)))
1131          (assemble (segment vop)
1132                    (inst lui temp (ldb (byte 16 16) delta))
1133                    (inst or temp (ldb (byte 16 0) delta))
1134                    (inst addu dst src temp))))))
1135
1136 ;; code = fn - header - label-offset + other-pointer-tag
1137 (define-instruction compute-code-from-fn (segment dst src label temp)
1138   (:declare (type tn dst src temp) (type label label))
1139   (:attributes variable-length)
1140   (:dependencies (reads src) (writes dst) (writes temp))
1141   (:delay 0)
1142   (:vop-var vop)
1143   (:emitter
1144    (emit-compute-inst segment vop dst src label temp
1145                       #'(lambda (label posn delta-if-after)
1146                           (- other-pointer-lowtag
1147                              (label-position label posn delta-if-after)
1148                              (component-header-length))))))
1149
1150 ;; code = lra - other-pointer-tag - header - label-offset + other-pointer-tag
1151 ;;      = lra - (header + label-offset)
1152 (define-instruction compute-code-from-lra (segment dst src label temp)
1153   (:declare (type tn dst src temp) (type label label))
1154   (:attributes variable-length)
1155   (:dependencies (reads src) (writes dst) (writes temp))
1156   (:delay 0)
1157   (:vop-var vop)
1158   (:emitter
1159    (emit-compute-inst segment vop dst src label temp
1160                       #'(lambda (label posn delta-if-after)
1161                           (- (+ (label-position label posn delta-if-after)
1162                                 (component-header-length)))))))
1163
1164 ;; lra = code + other-pointer-tag + header + label-offset - other-pointer-tag
1165 (define-instruction compute-lra-from-code (segment dst src label temp)
1166   (:declare (type tn dst src temp) (type label label))
1167   (:attributes variable-length)
1168   (:dependencies (reads src) (writes dst) (writes temp))
1169   (:delay 0)
1170   (:vop-var vop)
1171   (:emitter
1172    (emit-compute-inst segment vop dst src label temp
1173                       #'(lambda (label posn delta-if-after)
1174                           (+ (label-position label posn delta-if-after)
1175                              (component-header-length))))))
1176
1177 \f
1178 ;;;; Loads and Stores
1179
1180 (defun emit-load/store-inst (segment opcode reg base index
1181                                      &optional (oddhack 0))
1182   (when (fixup-p index)
1183     (note-fixup segment :addi index)
1184     (setf index 0))
1185   (emit-immediate-inst segment opcode (reg-tn-encoding reg)
1186                        (+ (reg-tn-encoding base) oddhack) index))
1187
1188 (defconstant-eqx load-store-printer
1189   '(:name :tab
1190           rt ", "
1191           rs
1192           (:unless (:constant 0) "[" immediate "]"))
1193   #'equalp)
1194
1195 (define-instruction lb (segment reg base &optional (index 0))
1196   (:declare (type tn reg base)
1197             (type (or (signed-byte 16) fixup) index))
1198   (:printer immediate ((op #b100000)) load-store-printer)
1199   (:dependencies (reads base) (reads :memory) (writes reg))
1200   (:delay 1)
1201   (:emitter
1202    (emit-load/store-inst segment #b100000 base reg index)))
1203
1204 (define-instruction lh (segment reg base &optional (index 0))
1205   (:declare (type tn reg base)
1206             (type (or (signed-byte 16) fixup) index))
1207   (:printer immediate ((op #b100001)) load-store-printer)
1208   (:dependencies (reads base) (reads :memory) (writes reg))
1209   (:delay 1)
1210   (:emitter
1211    (emit-load/store-inst segment #b100001 base reg index)))
1212
1213 (define-instruction lwl (segment reg base &optional (index 0))
1214   (:declare (type tn reg base)
1215             (type (or (signed-byte 16) fixup) index))
1216   (:printer immediate ((op #b100010)) load-store-printer)
1217   (:dependencies (reads base) (reads :memory) (writes reg))
1218   (:delay 1)
1219   (:emitter
1220    (emit-load/store-inst segment #b100010 base reg index)))
1221
1222 (define-instruction lw (segment reg base &optional (index 0))
1223   (:declare (type tn reg base)
1224             (type (or (signed-byte 16) fixup) index))
1225   (:printer immediate ((op #b100011)) load-store-printer)
1226   (:dependencies (reads base) (reads :memory) (writes reg))
1227   (:delay 1)
1228   (:emitter
1229    (emit-load/store-inst segment #b100011 base reg index)))
1230
1231 ;; next is just for ease of coding double-in-int c-call convention
1232 (define-instruction lw-odd (segment reg base &optional (index 0))
1233   (:declare (type tn reg base)
1234             (type (or (signed-byte 16) fixup) index))
1235   (:dependencies (reads base) (reads :memory) (writes reg))
1236   (:delay 1)
1237   (:emitter
1238    (emit-load/store-inst segment #b100011 base reg index 1)))
1239
1240 (define-instruction lbu (segment reg base &optional (index 0))
1241   (:declare (type tn reg base)
1242             (type (or (signed-byte 16) fixup) index))
1243   (:printer immediate ((op #b100100)) load-store-printer)
1244   (:dependencies (reads base) (reads :memory) (writes reg))
1245   (:delay 1)
1246   (:emitter
1247    (emit-load/store-inst segment #b100100 base reg index)))
1248
1249 (define-instruction lhu (segment reg base &optional (index 0))
1250   (:declare (type tn reg base)
1251             (type (or (signed-byte 16) fixup) index))
1252   (:printer immediate ((op #b100101)) load-store-printer)
1253   (:dependencies (reads base) (reads :memory) (writes reg))
1254   (:delay 1)
1255   (:emitter
1256    (emit-load/store-inst segment #b100101 base reg index)))
1257
1258 (define-instruction lwr (segment reg base &optional (index 0))
1259   (:declare (type tn reg base)
1260             (type (or (signed-byte 16) fixup) index))
1261   (:printer immediate ((op #b100110)) load-store-printer)
1262   (:dependencies (reads base) (reads :memory) (writes reg))
1263   (:delay 1)
1264   (:emitter
1265    (emit-load/store-inst segment #b100110 base reg index)))
1266
1267 (define-instruction sb (segment reg base &optional (index 0))
1268   (:declare (type tn reg base)
1269             (type (or (signed-byte 16) fixup) index))
1270   (:printer immediate ((op #b101000)) load-store-printer)
1271   (:dependencies (reads base) (reads reg) (writes :memory))
1272   (:delay 0)
1273   (:emitter
1274    (emit-load/store-inst segment #b101000 base reg index)))
1275
1276 (define-instruction sh (segment reg base &optional (index 0))
1277   (:declare (type tn reg base)
1278             (type (or (signed-byte 16) fixup) index))
1279   (:printer immediate ((op #b101001)) load-store-printer)
1280   (:dependencies (reads base) (reads reg) (writes :memory))
1281   (:delay 0)
1282   (:emitter
1283    (emit-load/store-inst segment #b101001 base reg index)))
1284
1285 (define-instruction swl (segment reg base &optional (index 0))
1286   (:declare (type tn reg base)
1287             (type (or (signed-byte 16) fixup) index))
1288   (:printer immediate ((op #b101010)) load-store-printer)
1289   (:dependencies (reads base) (reads reg) (writes :memory))
1290   (:delay 0)
1291   (:emitter
1292    (emit-load/store-inst segment #b101010 base reg index)))
1293
1294 (define-instruction sw (segment reg base &optional (index 0))
1295   (:declare (type tn reg base)
1296             (type (or (signed-byte 16) fixup) index))
1297   (:printer immediate ((op #b101011)) load-store-printer)
1298   (:dependencies (reads base) (reads reg) (writes :memory))
1299   (:delay 0)
1300   (:emitter
1301    (emit-load/store-inst segment #b101011 base reg index)))
1302
1303 (define-instruction swr (segment reg base &optional (index 0))
1304   (:declare (type tn reg base)
1305             (type (or (signed-byte 16) fixup) index))
1306   (:printer immediate ((op #b101110)) load-store-printer)
1307   (:dependencies (reads base) (reads reg) (writes :memory))
1308   (:delay 0)
1309   (:emitter
1310    (emit-load/store-inst segment #b101110 base reg index)))
1311
1312
1313 (defun emit-fp-load/store-inst (segment opcode reg odd base index)
1314   (when (fixup-p index)
1315     (note-fixup segment :addi index)
1316     (setf index 0))
1317   (emit-immediate-inst segment opcode (reg-tn-encoding base)
1318                        (+ (fp-reg-tn-encoding reg) odd) index))
1319
1320 (define-instruction lwc1 (segment reg base &optional (index 0))
1321   (:declare (type tn reg base)
1322             (type (or (signed-byte 16) fixup) index))
1323   (:printer immediate ((op #b110001) (rt nil :type 'fp-reg)) load-store-printer)
1324   (:dependencies (reads base) (reads :memory) (writes reg))
1325   (:delay 1)
1326   (:emitter
1327    (emit-fp-load/store-inst segment #b110001 reg 0 base index)))
1328
1329 (define-instruction lwc1-odd (segment reg base &optional (index 0))
1330   (:declare (type tn reg base)
1331             (type (or (signed-byte 16) fixup) index))
1332   (:dependencies (reads base) (reads :memory) (writes reg))
1333   (:delay 1)
1334   (:emitter
1335    (emit-fp-load/store-inst segment #b110001 reg 1 base index)))
1336
1337 (define-instruction swc1 (segment reg base &optional (index 0))
1338   (:declare (type tn reg base)
1339             (type (or (signed-byte 16) fixup) index))
1340   (:printer immediate ((op #b111001) (rt nil :type 'fp-reg)) load-store-printer)
1341   (:dependencies (reads base) (reads reg) (writes :memory))
1342   (:delay 0)
1343   (:emitter
1344    (emit-fp-load/store-inst segment #b111001 reg 0 base index)))
1345
1346 (define-instruction swc1-odd (segment reg base &optional (index 0))
1347   (:declare (type tn reg base)
1348             (type (or (signed-byte 16) fixup) index))
1349   (:dependencies (reads base) (reads reg) (writes :memory))
1350   (:delay 0)
1351   (:emitter
1352    (emit-fp-load/store-inst segment #b111001 reg 1 base index)))
1353