0.8.17.17:
[sbcl.git] / 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