1 ;;; the instruction set definition for MIPS
3 ;;;; This software is part of the SBCL system. See the README file for
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.
14 (setf *assem-scheduler-p
* t
)
15 (setf *assem-max-locations
* 68)
17 ;;;; Constants, types, conversion functions, some disassembler stuff.
19 (defun reg-tn-encoding (tn)
20 (declare (type tn tn
))
25 (if (eq (sb-name (sc-sb (tn-sc tn
))) 'registers
)
27 (error "~S isn't a register." tn
)))))
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
))
35 ;;;(sb!disassem:set-disassem-params :instruction-alignment 32)
37 (defvar *disassem-use-lisp-reg-names
* t
)
39 (!def-vm-support-routine location-number
(loc)
46 (ecase (sb-name (sc-sb (tn-sc loc
)))
48 ;; Can happen if $ZERO or $NULL are passed in.
51 (unless (zerop (tn-offset loc
))
54 (+ (tn-offset loc
) 32))))
64 (defparameter reg-symbols
67 (cond ((null name
) nil
)
68 (t (make-symbol (concatenate 'string
"$" name
)))))
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
82 (defparameter float-reg-symbols
84 (loop for n from
0 to
31 collect
(make-symbol (format nil
"$F~d" n
)))
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
98 (sb!disassem
:define-arg-type control-reg
101 (sb!disassem
:define-arg-type relative-label
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
))))
108 (deftype float-format
()
109 '(member :s
:single
:d
:double
:w
:word
))
111 (defun float-format-value (format)
117 (sb!disassem
:define-arg-type float-format
118 :printer
#'(lambda (value stream dstate
)
119 (declare (ignore dstate
)
129 (defconstant-eqx compare-kinds
130 '(:f
:un
:eq
:ueq
:olt
:ult
:ole
:ule
:sf
:ngle
:seq
:ngl
:lt
:nge
:le
:ngt
)
133 (defconstant-eqx compare-kinds-vec
134 (apply #'vector compare-kinds
)
137 (deftype compare-kind
()
138 `(member ,@compare-kinds
))
140 (defun compare-kind (kind)
141 (or (position kind compare-kinds
)
142 (error "Unknown floating point compare kind: ~S~%Must be one of: ~S"
146 (sb!disassem
:define-arg-type compare-kind
147 :printer compare-kinds-vec
)
149 (defconstant-eqx float-operations
'(+ -
* /) #'equalp
)
151 (deftype float-operation
()
152 `(member ,@float-operations
))
154 (defconstant-eqx float-operation-names
155 ;; this gets used for output only
159 (defun float-operation (op)
160 (or (position op float-operations
)
161 (error "Unknown floating point operation: ~S~%Must be one of: ~S"
165 (sb!disassem
:define-arg-type float-operation
166 :printer float-operation-names
)
170 ;;;; Constants used by instruction emitters.
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
)
181 ;;;; dissassem:define-instruction-formats
183 (defconstant-eqx immed-printer
184 '(:name
:tab rt
(:unless
(:same-as rt
) ", " rs
) ", " immediate
)
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
)
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
))
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
)))))
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
))
211 (defconstant-eqx reg-printer
212 '(:name
:tab rd
(:unless
(:same-as rd
) ", " rs
) ", " rt
)
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)))
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
))
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)))
238 (defconstant-eqx float-fmt-printer
239 '((:unless
:constant funct
)
240 (:choose
(:unless
:constant sub-funct
) nil
)
244 (defconstant-eqx float-printer
245 `(:name
,@float-fmt-printer
248 (:unless
(:same-as fd
) ", " fs
)
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)))
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)))
273 (sb!disassem
:define-instruction-format
277 '('f funct
"." format
280 (:unless
(:same-as fd
) ", " fs
)
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
))
287 ;;;; Primitive emitters.
289 (define-bitfield-emitter emit-word
32
292 (define-bitfield-emitter emit-short
16
295 (define-bitfield-emitter emit-immediate-inst
32
296 (byte 6 26) (byte 5 21) (byte 5 16) (byte 16 0))
298 (define-bitfield-emitter emit-jump-inst
32
299 (byte 6 26) (byte 26 0))
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))
304 (define-bitfield-emitter emit-break-inst
32
305 (byte 6 26) (byte 10 16) (byte 10 6) (byte 6 0))
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))
313 ;;;; Math instructions.
315 (defun emit-math-inst (segment dst src1 src2 reg-opcode immed-opcode
316 &optional allow-fixups
)
322 (emit-register-inst segment special-op
(reg-tn-encoding src1
)
323 (reg-tn-encoding src2
) (reg-tn-encoding dst
)
326 (emit-immediate-inst segment immed-opcode
(reg-tn-encoding src1
)
327 (reg-tn-encoding dst
) src2
))
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))))
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
))
343 (emit-math-inst segment dst src1 src2
#b100000
#b001000
)))
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
))
353 (emit-math-inst segment dst src1 src2
#b100001
#b001001 t
)))
355 (define-instruction sub
(segment dst src1
&optional src2
)
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
))
366 (emit-math-inst segment dst src1
367 (if (integerp src2
) (- src2
) src2
)
370 (define-instruction subu
(segment dst src1
&optional src2
)
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
))
382 (emit-math-inst segment dst src1
383 (if (integerp src2
) (- src2
) src2
)
384 #b100011
#b001001 t
)))
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
))
394 (emit-math-inst segment dst src1 src2
#b100100
#b001100
)))
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
))
404 (emit-math-inst segment dst src1 src2
#b100101
#b001101
)))
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
))
414 (emit-math-inst segment dst src1 src2
#b100110
#b001110
)))
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
))
422 (emit-math-inst segment dst src1 src2
#b100111
#b000000
)))
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
))
432 (emit-math-inst segment dst src1 src2
#b101010
#b001010
)))
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
))
442 (emit-math-inst segment dst src1 src2
#b101011
#b001011
)))
444 (defconstant-eqx divmul-printer
'(:name
:tab rs
", " rt
) #'equalp
)
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
))
452 (emit-register-inst segment special-op
(reg-tn-encoding src1
)
453 (reg-tn-encoding src2
) 0 0 #b011010
)))
455 (define-instruction divu
(segment src1 src2
)
456 (:declare
(type tn src1 src2
))
457 (:printer register
((op special-op
) (rd 0) (funct #b011011
))
459 (:dependencies
(reads src1
) (reads src2
) (writes :hi-reg
) (writes :low-reg
))
462 (emit-register-inst segment special-op
(reg-tn-encoding src1
)
463 (reg-tn-encoding src2
) 0 0 #b011011
)))
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
))
471 (emit-register-inst segment special-op
(reg-tn-encoding src1
)
472 (reg-tn-encoding src2
) 0 0 #b011000
)))
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
))
480 (emit-register-inst segment special-op
(reg-tn-encoding src1
)
481 (reg-tn-encoding src2
) 0 0 #b011001
)))
483 (defun emit-shift-inst (segment opcode dst src1 src2
)
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
)))
493 (emit-register-inst segment special-op
0 (reg-tn-encoding src1
)
494 (reg-tn-encoding dst
) src2 opcode
))))
496 (defconstant-eqx shift-printer
499 (:unless
(:same-as rd
) ", " rt
)
500 ", " (:cond
((rs :constant
0) shamt
)
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
))
509 (:printer register
((op special-op
) (funct #b000100
)) shift-printer
)
510 (:dependencies
(reads src1
) (if src2
(reads src2
) (reads dst
)) (writes dst
))
513 (emit-shift-inst segment
#b00 dst src1 src2
)))
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
))
520 (:printer register
((op special-op
) (funct #b000111
)) shift-printer
)
521 (:dependencies
(reads src1
) (if src2
(reads src2
) (reads dst
)) (writes dst
))
524 (emit-shift-inst segment
#b11 dst src1 src2
)))
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
))
531 (:printer register
((op special-op
) (funct #b000110
)) shift-printer
)
532 (:dependencies
(reads src1
) (if src2
(reads src2
) (reads dst
)) (writes dst
))
535 (emit-shift-inst segment
#b10 dst src1 src2
)))
538 ;;;; Floating point math.
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
))
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
))))
552 (defconstant-eqx float-unop-printer
553 `(:name
,@float-fmt-printer
:tab fd
(:unless
(:same-as fd
) ", " fs
))
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
))
562 (emit-float-inst segment cop1-op
1 (float-format-value format
)
563 0 (fp-reg-tn-encoding src
) (fp-reg-tn-encoding dst
)
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
))
572 (emit-float-inst segment cop1-op
1 (float-format-value format
)
573 0 (fp-reg-tn-encoding src
) (fp-reg-tn-encoding dst
)
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
))
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
)))))
587 (define-instruction fcmp
(segment operation format fs ft
)
588 (:declare
(type compare-kind operation
)
589 (type float-format format
)
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
))
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
)))))
601 ;;;; Branch/Jump instructions.
603 (defun emit-relative-branch (segment opcode r1 r2 target
)
606 #'(lambda (segment posn magic-value
)
607 (declare (ignore magic-value
))
608 (let ((delta (ash (- (label-position target
) (+ posn
4)) -
2)))
609 (when (typep delta
'(signed-byte 16))
610 (emit-back-patch segment
4
611 #'(lambda (segment posn
)
612 (emit-immediate-inst segment
616 (reg-tn-encoding r1
))
619 (reg-tn-encoding r2
))
620 (ash (- (label-position target
)
624 #'(lambda (segment posn
)
625 (declare (ignore posn
))
627 ;; invert branch condition
628 (if (or (= opcode bcond-op
) (= opcode cop1-op
))
629 (setf r2
(logxor r2
#b00001
))
630 (setf opcode
(logxor opcode
#b00001
)))
632 (if (= opcode bcond-op
)
633 (if (logand r2
#b10000
)
634 (progn (setf r2
(logand r2
#b01111
))
636 (emit-immediate-inst segment
638 (if (fixnump r1
) r1
(reg-tn-encoding r1
))
639 (if (fixnump r2
) r2
(reg-tn-encoding r2
))
642 (emit-back-patch segment
8
643 #'(lambda (segment posn
)
644 (declare (ignore posn
))
645 (emit-immediate-inst segment
#b001111
0
646 (reg-tn-encoding lip-tn
)
648 (label-position target
)))
649 (emit-immediate-inst segment
#b001101
0
650 (reg-tn-encoding lip-tn
)
652 (label-position target
)))))
653 (emit-register-inst segment special-op
(reg-tn-encoding lip-tn
)
655 (if linked
#b001001
#b001000
))))))
657 (define-instruction b
(segment target
)
658 (:declare
(type label target
))
659 (:printer immediate
((op #b000100
) (rs 0) (rt 0)
660 (immediate nil
:type
'relative-label
))
661 '(:name
:tab immediate
))
665 (emit-relative-branch segment
#b000100
0 0 target
)))
667 (define-instruction bal
(segment target
)
668 (:declare
(type label target
))
669 (:printer immediate
((op bcond-op
) (rs 0) (rt #b01001
)
670 (immediate nil
:type
'relative-label
))
671 '(:name
:tab immediate
))
673 (:dependencies
(writes :r31
))
676 (emit-relative-branch segment bcond-op
0 #b10001 target
)))
678 (define-instruction beq
(segment r1 r2-or-target
&optional target
)
679 (:declare
(type tn r1
)
680 (type (or tn fixnum label
) r2-or-target
)
681 (type (or label null
) target
))
682 (:printer immediate
((op #b000100
) (immediate nil
:type
'relative-label
)))
684 (:dependencies
(reads r1
) (if target
(reads r2-or-target
)))
688 (setf target r2-or-target
)
689 (setf r2-or-target
0))
690 (emit-relative-branch segment
#b000100 r1 r2-or-target target
)))
692 (define-instruction bne
(segment r1 r2-or-target
&optional target
)
693 (:declare
(type tn r1
)
694 (type (or tn fixnum label
) r2-or-target
)
695 (type (or label null
) target
))
696 (:printer immediate
((op #b000101
) (immediate nil
:type
'relative-label
)))
698 (:dependencies
(reads r1
) (if target
(reads r2-or-target
)))
702 (setf target r2-or-target
)
703 (setf r2-or-target
0))
704 (emit-relative-branch segment
#b000101 r1 r2-or-target target
)))
706 (defconstant-eqx cond-branch-printer
707 '(:name
:tab rs
", " immediate
)
710 (define-instruction blez
(segment reg target
)
711 (:declare
(type label target
) (type tn reg
))
713 immediate
((op #b000110
) (rt 0) (immediate nil
:type
'relative-label
))
716 (:dependencies
(reads reg
))
719 (emit-relative-branch segment
#b000110 reg
0 target
)))
721 (define-instruction bgtz
(segment reg target
)
722 (:declare
(type label target
) (type tn reg
))
724 immediate
((op #b000111
) (rt 0) (immediate nil
:type
'relative-label
))
727 (:dependencies
(reads reg
))
730 (emit-relative-branch segment
#b000111 reg
0 target
)))
732 (define-instruction bltz
(segment reg target
)
733 (:declare
(type label target
) (type tn reg
))
735 immediate
((op bcond-op
) (rt 0) (immediate nil
:type
'relative-label
))
738 (:dependencies
(reads reg
))
741 (emit-relative-branch segment bcond-op reg
#b00000 target
)))
743 (define-instruction bgez
(segment reg target
)
744 (:declare
(type label target
) (type tn reg
))
746 immediate
((op bcond-op
) (rt 1) (immediate nil
:type
'relative-label
))
749 (:dependencies
(reads reg
))
752 (emit-relative-branch segment bcond-op reg
#b00001 target
)))
754 (define-instruction bltzal
(segment reg target
)
755 (:declare
(type label target
) (type tn reg
))
757 immediate
((op bcond-op
) (rt #b01000
) (immediate nil
:type
'relative-label
))
760 (:dependencies
(reads reg
) (writes :r31
))
763 (emit-relative-branch segment bcond-op reg
#b10000 target
)))
765 (define-instruction bgezal
(segment reg target
)
766 (:declare
(type label target
) (type tn reg
))
768 immediate
((op bcond-op
) (rt #b01001
) (immediate nil
:type
'relative-label
))
772 (:dependencies
(reads reg
) (writes :r31
))
774 (emit-relative-branch segment bcond-op reg
#b10001 target
)))
776 (defconstant-eqx j-printer
777 '(:name
:tab
(:choose rs target
))
780 (define-instruction j
(segment target
)
781 (:declare
(type (or tn fixup
) target
))
782 (:printer register
((op special-op
) (rt 0) (rd 0) (funct #b001000
))
784 (:printer jump
((op #b000010
)) j-printer
)
786 (:dependencies
(reads target
))
791 (emit-register-inst segment special-op
(reg-tn-encoding target
)
794 (note-fixup segment
:jump target
)
795 (emit-jump-inst segment
#b000010
0)))))
797 (define-instruction jal
(segment reg-or-target
&optional target
)
798 (:declare
(type (or null tn fixup
) target
)
799 (type (or tn fixup
(integer -
16 31)) reg-or-target
))
800 (:printer register
((op special-op
) (rt 0) (funct #b001001
)) j-printer
)
801 (:printer jump
((op #b000011
)) j-printer
)
803 (:dependencies
(if target
(writes reg-or-target
) (writes :r31
)))
807 (setf target reg-or-target
)
808 (setf reg-or-target
31))
811 (emit-register-inst segment special-op
(reg-tn-encoding target
) 0
812 reg-or-target
0 #b001001
))
814 (note-fixup segment
:jump target
)
815 (emit-jump-inst segment
#b000011
0)))))
817 (define-instruction bc1f
(segment target
)
818 (:declare
(type label target
))
819 (:printer coproc-branch
((op cop1-op
) (funct #x100
)
820 (offset nil
:type
'relative-label
)))
822 (:dependencies
(reads :float-status
))
825 (emit-relative-branch segment cop1-op
#b01000
#b00000 target
)))
827 (define-instruction bc1t
(segment target
)
828 (:declare
(type label target
))
829 (:printer coproc-branch
((op cop1-op
) (funct #x101
)
830 (offset nil
:type
'relative-label
)))
832 (:dependencies
(reads :float-status
))
835 (emit-relative-branch segment cop1-op
#b01000
#b00001 target
)))
839 ;;;; Random movement instructions.
841 (define-instruction lui
(segment reg value
)
842 (:declare
(type tn reg
)
843 (type (or fixup
(signed-byte 16) (unsigned-byte 16)) value
))
844 (:printer immediate
((op #b001111
)
845 (immediate nil
:sign-extend nil
:printer
"#x~4,'0X")))
846 (:dependencies
(writes reg
))
849 (when (fixup-p value
)
850 (note-fixup segment
:lui value
)
852 (emit-immediate-inst segment
#b001111
0 (reg-tn-encoding reg
) value
)))
854 (defconstant-eqx mvsreg-printer
'(:name
:tab rd
)
857 (define-instruction mfhi
(segment reg
)
858 (:declare
(type tn reg
))
859 (:printer register
((op special-op
) (rs 0) (rt 0) (funct #b010000
))
861 (:dependencies
(reads :hi-reg
) (writes reg
))
864 (emit-register-inst segment special-op
0 0 (reg-tn-encoding reg
) 0
867 (define-instruction mthi
(segment reg
)
868 (:declare
(type tn reg
))
869 (:printer register
((op special-op
) (rs 0) (rt 0) (funct #b010001
))
871 (:dependencies
(reads reg
) (writes :hi-reg
))
874 (emit-register-inst segment special-op
0 0 (reg-tn-encoding reg
) 0
877 (define-instruction mflo
(segment reg
)
878 (:declare
(type tn reg
))
879 (:printer register
((op special-op
) (rs 0) (rt 0) (funct #b010010
))
881 (:dependencies
(reads :low-reg
) (writes reg
))
884 (emit-register-inst segment special-op
0 0 (reg-tn-encoding reg
) 0
887 (define-instruction mtlo
(segment reg
)
888 (:declare
(type tn reg
))
889 (:printer register
((op special-op
) (rs 0) (rt 0) (funct #b010011
))
891 (:dependencies
(reads reg
) (writes :low-reg
))
894 (emit-register-inst segment special-op
0 0 (reg-tn-encoding reg
) 0
897 (define-instruction move
(segment dst src
)
898 (:declare
(type tn dst src
))
899 (:printer register
((op special-op
) (rt 0) (funct #b100001
))
900 '(:name
:tab rd
", " rs
))
901 (:attributes flushable
)
902 (:dependencies
(reads src
) (writes dst
))
905 (emit-register-inst segment special-op
(reg-tn-encoding src
) 0
906 (reg-tn-encoding dst
) 0 #b100001
)))
908 (define-instruction fmove
(segment format dst src
)
909 (:declare
(type float-format format
) (type tn dst src
))
910 (:printer float
((funct #b000110
)) '(:name
"." format
:tab fd
", " fs
))
911 (:attributes flushable
)
912 (:dependencies
(reads src
) (writes dst
))
915 (emit-float-inst segment cop1-op
1 (float-format-value format
) 0
916 (fp-reg-tn-encoding src
) (fp-reg-tn-encoding dst
)
919 (defun %li
(reg value
)
922 (inst or reg zero-tn value
))
924 (inst addu reg zero-tn value
))
925 ((or (signed-byte 32) (unsigned-byte 32))
926 (inst lui reg
(ldb (byte 16 16) value
))
927 (inst or reg
(ldb (byte 16 0) value
)))
930 (inst addu reg value
))))
932 (define-instruction-macro li
(reg value
)
935 (defconstant-eqx sub-op-printer
'(:name
:tab rd
", " rt
) #'equalp
)
937 (define-instruction mtc1
(segment to from
)
938 (:declare
(type tn to from
))
939 (:printer register
((op cop1-op
) (rs #b00100
) (funct 0)) sub-op-printer
)
940 (:dependencies
(reads from
) (writes to
))
943 (emit-register-inst segment cop1-op
#b00100
(reg-tn-encoding from
)
944 (fp-reg-tn-encoding to
) 0 0)))
946 (define-instruction mtc1-odd
(segment to from
)
947 (:declare
(type tn to from
))
948 (:dependencies
(reads from
) (writes to
))
951 (emit-register-inst segment cop1-op
#b00100
(reg-tn-encoding from
)
952 (1+ (fp-reg-tn-encoding to
)) 0 0)))
954 (define-instruction mfc1
(segment to from
)
955 (:declare
(type tn to from
))
956 (:printer register
((op cop1-op
) (rs 0) (rd nil
:type
'fp-reg
) (funct 0))
958 (:dependencies
(reads from
) (writes to
))
961 (emit-register-inst segment cop1-op
#b00000
(reg-tn-encoding to
)
962 (fp-reg-tn-encoding from
) 0 0)))
964 (define-instruction mfc1-odd
(segment to from
)
965 (:declare
(type tn to from
))
966 (:dependencies
(reads from
) (writes to
))
969 (emit-register-inst segment cop1-op
#b00000
(reg-tn-encoding to
)
970 (1+ (fp-reg-tn-encoding from
)) 0 0)))
972 (define-instruction mfc1-odd2
(segment to from
)
973 (:declare
(type tn to from
))
974 (:dependencies
(reads from
) (writes to
))
977 (emit-register-inst segment cop1-op
#b00000
(1+ (reg-tn-encoding to
))
978 (fp-reg-tn-encoding from
) 0 0)))
980 (define-instruction mfc1-odd3
(segment to from
)
981 (:declare
(type tn to from
))
982 (:dependencies
(reads from
) (writes to
))
985 (emit-register-inst segment cop1-op
#b00000
(1+ (reg-tn-encoding to
))
986 (1+ (fp-reg-tn-encoding from
)) 0 0)))
988 (define-instruction cfc1
(segment reg cr
)
989 (:declare
(type tn reg
) (type (unsigned-byte 5) cr
))
990 (:printer register
((op cop1-op
) (rs #b00010
) (rd nil
:type
'control-reg
)
991 (funct 0)) sub-op-printer
)
992 (:dependencies
(reads :ctrl-stat-reg
) (writes reg
))
995 (emit-register-inst segment cop1-op
#b00010
(reg-tn-encoding reg
)
998 (define-instruction ctc1
(segment reg cr
)
999 (:declare
(type tn reg
) (type (unsigned-byte 5) cr
))
1000 (:printer register
((op cop1-op
) (rs #b00110
) (rd nil
:type
'control-reg
)
1001 (funct 0)) sub-op-printer
)
1002 (:dependencies
(reads reg
) (writes :ctrl-stat-reg
))
1005 (emit-register-inst segment cop1-op
#b00110
(reg-tn-encoding reg
)
1010 ;;;; Random system hackery and other noise
1012 (define-instruction-macro entry-point
()
1016 (define-bitfield-emitter emit-break-inst
32
1017 (byte 6 26) (byte 10 16) (byte 10 6) (byte 6 0))
1019 (defun snarf-error-junk (sap offset
&optional length-only
)
1020 (let* ((length (sb!sys
:sap-ref-8 sap offset
))
1021 (vector (make-array length
:element-type
'(unsigned-byte 8))))
1022 (declare (type sb
!sys
:system-area-pointer sap
)
1023 (type (unsigned-byte 8) length
)
1024 (type (simple-array (unsigned-byte 8) (*)) vector
))
1026 (values 0 (1+ length
) nil nil
))
1028 (sb!kernel
:copy-ub8-from-system-area sap
(1+ offset
)
1030 (collect ((sc-offsets)
1032 (lengths 1) ; the length byte
1034 (error-number (sb!c
:read-var-integer vector index
)))
1037 (when (>= index length
)
1039 (let ((old-index index
))
1040 (sc-offsets (sb!c
:read-var-integer vector index
))
1041 (lengths (- index old-index
))))
1042 (values error-number
1047 (defmacro break-cases
(breaknum &body cases
)
1048 (let ((bn-temp (gensym)))
1049 (collect ((clauses))
1050 (dolist (case cases
)
1051 (clauses `((= ,bn-temp
,(car case
)) ,@(cdr case
))))
1052 `(let ((,bn-temp
,breaknum
))
1053 (cond ,@(clauses))))))
1055 (defun break-control (chunk inst stream dstate
)
1056 (declare (ignore inst
))
1057 (flet ((nt (x) (if stream
(sb!disassem
:note x dstate
))))
1058 (case (break-code chunk dstate
)
1061 (sb!disassem
:handle-break-args
#'snarf-error-junk stream dstate
))
1064 (sb!disassem
:handle-break-args
#'snarf-error-junk stream dstate
))
1066 (nt "Breakpoint trap"))
1067 (#.pending-interrupt-trap
1068 (nt "Pending interrupt trap"))
1071 (#.fun-end-breakpoint-trap
1072 (nt "Function end breakpoint trap"))
1075 (define-instruction break
(segment code
&optional
(subcode 0))
1076 (:declare
(type (unsigned-byte 10) code subcode
))
1077 (:printer break
((op special-op
) (funct #b001101
))
1078 '(:name
:tab code
(:unless
(:constant
0) subcode
))
1079 :control
#'break-control
)
1084 (emit-break-inst segment special-op code subcode
#b001101
)))
1086 (define-instruction syscall
(segment)
1087 (:printer register
((op special-op
) (rd 0) (rt 0) (rs 0) (funct #b001100
))
1092 (emit-register-inst segment special-op
0 0 0 0 #b001100
)))
1094 (define-instruction nop
(segment)
1095 (:printer register
((op 0) (rd 0) (rd 0) (rs 0) (funct 0)) '(:name
))
1096 (:attributes flushable
)
1099 (emit-word segment
0)))
1101 (!def-vm-support-routine emit-nop
(segment)
1102 (emit-word segment
0))
1104 (define-instruction word
(segment word
)
1105 (:declare
(type (or (unsigned-byte 32) (signed-byte 32)) word
))
1110 (emit-word segment word
)))
1112 (define-instruction short
(segment short
)
1113 (:declare
(type (or (unsigned-byte 16) (signed-byte 16)) short
))
1118 (emit-short segment short
)))
1120 (define-instruction byte
(segment byte
)
1121 (:declare
(type (or (unsigned-byte 8) (signed-byte 8)) byte
))
1126 (emit-byte segment byte
)))
1129 (defun emit-header-data (segment type
)
1132 #'(lambda (segment posn
)
1135 (ash (+ posn
(component-header-length))
1136 (- n-widetag-bits word-shift
)))))))
1138 (define-instruction fun-header-word
(segment)
1143 (emit-header-data segment simple-fun-header-widetag
)))
1145 (define-instruction lra-header-word
(segment)
1150 (emit-header-data segment return-pc-header-widetag
)))
1153 (defun emit-compute-inst (segment vop dst src label temp calc
)
1155 ;; We emit either 12 or 4 bytes, so we maintain 8 byte alignments.
1157 #'(lambda (segment posn delta-if-after
)
1158 (let ((delta (funcall calc label posn delta-if-after
)))
1159 (when (<= (- (ash 1 15)) delta
(1- (ash 1 15)))
1160 (emit-back-patch segment
4
1161 #'(lambda (segment posn
)
1162 (assemble (segment vop
)
1164 (funcall calc label posn
0)))))
1166 #'(lambda (segment posn
)
1167 (let ((delta (funcall calc label posn
0)))
1168 (assemble (segment vop
)
1169 (inst lui temp
(ldb (byte 16 16) delta
))
1170 (inst or temp
(ldb (byte 16 0) delta
))
1171 (inst addu dst src temp
))))))
1173 ;; code = fn - header - label-offset + other-pointer-tag
1174 (define-instruction compute-code-from-fn
(segment dst src label temp
)
1175 (:declare
(type tn dst src temp
) (type label label
))
1176 (:attributes variable-length
)
1177 (:dependencies
(reads src
) (writes dst
) (writes temp
))
1181 (emit-compute-inst segment vop dst src label temp
1182 #'(lambda (label posn delta-if-after
)
1183 (- other-pointer-lowtag
1184 (label-position label posn delta-if-after
)
1185 (component-header-length))))))
1187 ;; code = lra - other-pointer-tag - header - label-offset + other-pointer-tag
1188 ;; = lra - (header + label-offset)
1189 (define-instruction compute-code-from-lra
(segment dst src label temp
)
1190 (:declare
(type tn dst src temp
) (type label label
))
1191 (:attributes variable-length
)
1192 (:dependencies
(reads src
) (writes dst
) (writes temp
))
1196 (emit-compute-inst segment vop dst src label temp
1197 #'(lambda (label posn delta-if-after
)
1198 (- (+ (label-position label posn delta-if-after
)
1199 (component-header-length)))))))
1201 ;; lra = code + other-pointer-tag + header + label-offset - other-pointer-tag
1202 (define-instruction compute-lra-from-code
(segment dst src label temp
)
1203 (:declare
(type tn dst src temp
) (type label label
))
1204 (:attributes variable-length
)
1205 (:dependencies
(reads src
) (writes dst
) (writes temp
))
1209 (emit-compute-inst segment vop dst src label temp
1210 #'(lambda (label posn delta-if-after
)
1211 (+ (label-position label posn delta-if-after
)
1212 (component-header-length))))))
1215 ;;;; Loads and Stores
1217 (defun emit-load/store-inst
(segment opcode reg base index
1218 &optional
(oddhack 0))
1219 (when (fixup-p index
)
1220 (note-fixup segment
:addi index
)
1222 (emit-immediate-inst segment opcode
(reg-tn-encoding reg
)
1223 (+ (reg-tn-encoding base
) oddhack
) index
))
1225 (defconstant-eqx load-store-printer
1229 (:unless
(:constant
0) "[" immediate
"]"))
1232 (define-instruction lb
(segment reg base
&optional
(index 0))
1233 (:declare
(type tn reg base
)
1234 (type (or (signed-byte 16) fixup
) index
))
1235 (:printer immediate
((op #b100000
)) load-store-printer
)
1236 (:dependencies
(reads base
) (reads :memory
) (writes reg
))
1239 (emit-load/store-inst segment
#b100000 base reg index
)))
1241 (define-instruction lh
(segment reg base
&optional
(index 0))
1242 (:declare
(type tn reg base
)
1243 (type (or (signed-byte 16) fixup
) index
))
1244 (:printer immediate
((op #b100001
)) load-store-printer
)
1245 (:dependencies
(reads base
) (reads :memory
) (writes reg
))
1248 (emit-load/store-inst segment
#b100001 base reg index
)))
1250 (define-instruction lwl
(segment reg base
&optional
(index 0))
1251 (:declare
(type tn reg base
)
1252 (type (or (signed-byte 16) fixup
) index
))
1253 (:printer immediate
((op #b100010
)) load-store-printer
)
1254 (:dependencies
(reads base
) (reads :memory
) (writes reg
))
1257 (emit-load/store-inst segment
#b100010 base reg index
)))
1259 (define-instruction lw
(segment reg base
&optional
(index 0))
1260 (:declare
(type tn reg base
)
1261 (type (or (signed-byte 16) fixup
) index
))
1262 (:printer immediate
((op #b100011
)) load-store-printer
)
1263 (:dependencies
(reads base
) (reads :memory
) (writes reg
))
1266 (emit-load/store-inst segment
#b100011 base reg index
)))
1268 ;; next is just for ease of coding double-in-int c-call convention
1269 (define-instruction lw-odd
(segment reg base
&optional
(index 0))
1270 (:declare
(type tn reg base
)
1271 (type (or (signed-byte 16) fixup
) index
))
1272 (:dependencies
(reads base
) (reads :memory
) (writes reg
))
1275 (emit-load/store-inst segment
#b100011 base reg index
1)))
1277 (define-instruction lbu
(segment reg base
&optional
(index 0))
1278 (:declare
(type tn reg base
)
1279 (type (or (signed-byte 16) fixup
) index
))
1280 (:printer immediate
((op #b100100
)) load-store-printer
)
1281 (:dependencies
(reads base
) (reads :memory
) (writes reg
))
1284 (emit-load/store-inst segment
#b100100 base reg index
)))
1286 (define-instruction lhu
(segment reg base
&optional
(index 0))
1287 (:declare
(type tn reg base
)
1288 (type (or (signed-byte 16) fixup
) index
))
1289 (:printer immediate
((op #b100101
)) load-store-printer
)
1290 (:dependencies
(reads base
) (reads :memory
) (writes reg
))
1293 (emit-load/store-inst segment
#b100101 base reg index
)))
1295 (define-instruction lwr
(segment reg base
&optional
(index 0))
1296 (:declare
(type tn reg base
)
1297 (type (or (signed-byte 16) fixup
) index
))
1298 (:printer immediate
((op #b100110
)) load-store-printer
)
1299 (:dependencies
(reads base
) (reads :memory
) (writes reg
))
1302 (emit-load/store-inst segment
#b100110 base reg index
)))
1304 (define-instruction sb
(segment reg base
&optional
(index 0))
1305 (:declare
(type tn reg base
)
1306 (type (or (signed-byte 16) fixup
) index
))
1307 (:printer immediate
((op #b101000
)) load-store-printer
)
1308 (:dependencies
(reads base
) (reads reg
) (writes :memory
))
1311 (emit-load/store-inst segment
#b101000 base reg index
)))
1313 (define-instruction sh
(segment reg base
&optional
(index 0))
1314 (:declare
(type tn reg base
)
1315 (type (or (signed-byte 16) fixup
) index
))
1316 (:printer immediate
((op #b101001
)) load-store-printer
)
1317 (:dependencies
(reads base
) (reads reg
) (writes :memory
))
1320 (emit-load/store-inst segment
#b101001 base reg index
)))
1322 (define-instruction swl
(segment reg base
&optional
(index 0))
1323 (:declare
(type tn reg base
)
1324 (type (or (signed-byte 16) fixup
) index
))
1325 (:printer immediate
((op #b101010
)) load-store-printer
)
1326 (:dependencies
(reads base
) (reads reg
) (writes :memory
))
1329 (emit-load/store-inst segment
#b101010 base reg index
)))
1331 (define-instruction sw
(segment reg base
&optional
(index 0))
1332 (:declare
(type tn reg base
)
1333 (type (or (signed-byte 16) fixup
) index
))
1334 (:printer immediate
((op #b101011
)) load-store-printer
)
1335 (:dependencies
(reads base
) (reads reg
) (writes :memory
))
1338 (emit-load/store-inst segment
#b101011 base reg index
)))
1340 (define-instruction swr
(segment reg base
&optional
(index 0))
1341 (:declare
(type tn reg base
)
1342 (type (or (signed-byte 16) fixup
) index
))
1343 (:printer immediate
((op #b101110
)) load-store-printer
)
1344 (:dependencies
(reads base
) (reads reg
) (writes :memory
))
1347 (emit-load/store-inst segment
#b101110 base reg index
)))
1350 (defun emit-fp-load/store-inst
(segment opcode reg odd base index
)
1351 (when (fixup-p index
)
1352 (note-fixup segment
:addi index
)
1354 (emit-immediate-inst segment opcode
(reg-tn-encoding base
)
1355 (+ (fp-reg-tn-encoding reg
) odd
) index
))
1357 (define-instruction lwc1
(segment reg base
&optional
(index 0))
1358 (:declare
(type tn reg base
)
1359 (type (or (signed-byte 16) fixup
) index
))
1360 (:printer immediate
((op #b110001
) (rt nil
:type
'fp-reg
)) load-store-printer
)
1361 (:dependencies
(reads base
) (reads :memory
) (writes reg
))
1364 (emit-fp-load/store-inst segment
#b110001 reg
0 base index
)))
1366 (define-instruction lwc1-odd
(segment reg base
&optional
(index 0))
1367 (:declare
(type tn reg base
)
1368 (type (or (signed-byte 16) fixup
) index
))
1369 (:dependencies
(reads base
) (reads :memory
) (writes reg
))
1372 (emit-fp-load/store-inst segment
#b110001 reg
1 base index
)))
1374 (define-instruction swc1
(segment reg base
&optional
(index 0))
1375 (:declare
(type tn reg base
)
1376 (type (or (signed-byte 16) fixup
) index
))
1377 (:printer immediate
((op #b111001
) (rt nil
:type
'fp-reg
)) load-store-printer
)
1378 (:dependencies
(reads base
) (reads reg
) (writes :memory
))
1381 (emit-fp-load/store-inst segment
#b111001 reg
0 base index
)))
1383 (define-instruction swc1-odd
(segment reg base
&optional
(index 0))
1384 (:declare
(type tn reg base
)
1385 (type (or (signed-byte 16) fixup
) index
))
1386 (:dependencies
(reads base
) (reads reg
) (writes :memory
))
1389 (emit-fp-load/store-inst segment
#b111001 reg
1 base index
)))