src/compiler/mips/insts.lisp

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