3 (setf *assem-scheduler-p* t)
4 (setf *assem-max-locations* 68)
8 ;;;; Constants, types, conversion functions, some disassembler stuff.
10 (defun reg-tn-encoding (tn)
11 (declare (type tn tn))
16 (if (eq (sb-name (sc-sb (tn-sc tn))) 'registers)
18 (error "~S isn't a register." tn)))))
20 (defun fp-reg-tn-encoding (tn)
21 (declare (type tn tn))
22 (unless (eq (sb-name (sc-sb (tn-sc tn))) 'float-registers)
23 (error "~S isn't a floating-point register." tn))
26 ;;;(sb!disassem:set-disassem-params :instruction-alignment 32)
28 (defvar *disassem-use-lisp-reg-names* t)
30 (!def-vm-support-routine location-number (loc)
37 (ecase (sb-name (sc-sb (tn-sc loc)))
39 ;; Can happen if $ZERO or $NULL are passed in.
42 (unless (zerop (tn-offset loc))
45 (+ (tn-offset loc) 32))))
55 (defparameter reg-symbols
58 (cond ((null name) nil)
59 (t (make-symbol (concatenate 'string "$" name)))))
62 (sb!disassem:define-arg-type reg
63 :printer #'(lambda (value stream dstate)
64 (declare (stream stream) (fixnum value))
65 (let ((regname (aref reg-symbols value)))
66 (princ regname stream)
67 (sb!disassem:maybe-note-associated-storage-ref
73 (defparameter float-reg-symbols
75 (loop for n from 0 to 31 collect (make-symbol (format nil "$F~d" n)))
78 (sb!disassem:define-arg-type fp-reg
79 :printer #'(lambda (value stream dstate)
80 (declare (stream stream) (fixnum value))
81 (let ((regname (aref float-reg-symbols value)))
82 (princ regname stream)
83 (sb!disassem:maybe-note-associated-storage-ref
89 (sb!disassem:define-arg-type control-reg
92 (sb!disassem:define-arg-type relative-label
94 :use-label #'(lambda (value dstate)
95 (declare (type (signed-byte 16) value)
96 (type sb!disassem:disassem-state dstate))
97 (+ (ash (1+ value) 2) (sb!disassem:dstate-cur-addr dstate))))
99 (deftype float-format ()
100 '(member :s :single :d :double :w :word))
102 (defun float-format-value (format)
108 (sb!disassem:define-arg-type float-format
109 :printer #'(lambda (value stream dstate)
110 (declare (ignore dstate)
120 (defconstant-eqx compare-kinds
121 '(:f :un :eq :ueq :olt :ult :ole :ule :sf :ngle :seq :ngl :lt :nge :le :ngt)
124 (defconstant-eqx compare-kinds-vec
125 (apply #'vector compare-kinds)
128 (deftype compare-kind ()
129 `(member ,@compare-kinds))
131 (defun compare-kind (kind)
132 (or (position kind compare-kinds)
133 (error "Unknown floating point compare kind: ~S~%Must be one of: ~S"
137 (sb!disassem:define-arg-type compare-kind
138 :printer compare-kinds-vec)
140 (defconstant-eqx float-operations '(+ - * /) #'equalp)
142 (deftype float-operation ()
143 `(member ,@float-operations))
145 (defconstant-eqx float-operation-names
146 ;; this gets used for output only
150 (defun float-operation (op)
151 (or (position op float-operations)
152 (error "Unknown floating point operation: ~S~%Must be one of: ~S"
156 (sb!disassem:define-arg-type float-operation
157 :printer float-operation-names)
161 ;;;; Constants used by instruction emitters.
163 (defconstant special-op #b000000)
164 (defconstant bcond-op #b000001)
165 (defconstant cop0-op #b010000)
166 (defconstant cop1-op #b010001)
167 (defconstant cop2-op #b010010)
168 (defconstant cop3-op #b010011)
172 ;;;; dissassem:define-instruction-formats
174 (defconstant-eqx immed-printer
175 '(:name :tab rt (:unless (:same-as rt) ", " rs) ", " immediate)
178 ;;; for things that use rt=0 as a nop
179 (defconstant-eqx immed-zero-printer
180 '(:name :tab rt (:unless (:constant 0) ", " rs) ", " immediate)
183 (sb!disassem:define-instruction-format
184 (immediate 32 :default-printer immed-printer)
185 (op :field (byte 6 26))
186 (rs :field (byte 5 21) :type 'reg)
187 (rt :field (byte 5 16) :type 'reg)
188 (immediate :field (byte 16 0) :sign-extend t))
190 (eval-when (:compile-toplevel :load-toplevel :execute)
191 (defparameter jump-printer
192 #'(lambda (value stream dstate)
193 (let ((addr (ash value 2)))
194 (sb!disassem:maybe-note-assembler-routine addr t dstate)
195 (write addr :base 16 :radix t :stream stream)))))
197 (sb!disassem:define-instruction-format
198 (jump 32 :default-printer '(:name :tab target))
199 (op :field (byte 6 26))
200 (target :field (byte 26 0) :printer jump-printer))
202 (defconstant-eqx reg-printer
203 '(:name :tab rd (:unless (:same-as rd) ", " rs) ", " rt)
206 (sb!disassem:define-instruction-format
207 (register 32 :default-printer reg-printer)
208 (op :field (byte 6 26))
209 (rs :field (byte 5 21) :type 'reg)
210 (rt :field (byte 5 16) :type 'reg)
211 (rd :field (byte 5 11) :type 'reg)
212 (shamt :field (byte 5 6) :value 0)
213 (funct :field (byte 6 0)))
215 (sb!disassem:define-instruction-format
216 (break 32 :default-printer
217 '(:name :tab code (:unless (:constant 0) subcode)))
218 (op :field (byte 6 26) :value special-op)
219 (code :field (byte 10 16))
220 (subcode :field (byte 10 6) :value 0)
221 (funct :field (byte 6 0) :value #b001101))
223 (sb!disassem:define-instruction-format
224 (coproc-branch 32 :default-printer '(:name :tab offset))
225 (op :field (byte 6 26))
226 (funct :field (byte 10 16))
227 (offset :field (byte 16 0)))
229 (defconstant-eqx float-fmt-printer
230 '((:unless :constant funct)
231 (:choose (:unless :constant sub-funct) nil)
235 (defconstant-eqx float-printer
236 `(:name ,@float-fmt-printer
239 (:unless (:same-as fd) ", " fs)
243 (sb!disassem:define-instruction-format
244 (float 32 :default-printer float-printer)
245 (op :field (byte 6 26) :value cop1-op)
246 (filler :field (byte 1 25) :value 1)
247 (format :field (byte 4 21) :type 'float-format)
248 (ft :field (byte 5 16) :value 0)
249 (fs :field (byte 5 11) :type 'fp-reg)
250 (fd :field (byte 5 6) :type 'fp-reg)
251 (funct :field (byte 6 0)))
253 (sb!disassem:define-instruction-format
254 (float-aux 32 :default-printer float-printer)
255 (op :field (byte 6 26) :value cop1-op)
256 (filler-1 :field (byte 1 25) :value 1)
257 (format :field (byte 4 21) :type 'float-format)
258 (ft :field (byte 5 16) :type 'fp-reg)
259 (fs :field (byte 5 11) :type 'fp-reg)
260 (fd :field (byte 5 6) :type 'fp-reg)
261 (funct :field (byte 2 4))
262 (sub-funct :field (byte 4 0)))
264 (sb!disassem:define-instruction-format
268 '('f funct "." format
271 (:unless (:same-as fd) ", " fs)
273 (funct :field (byte 2 0) :type 'float-operation)
274 (funct-filler :field (byte 4 2) :value 0)
275 (ft :value nil :type 'fp-reg))
278 ;;;; Primitive emitters.
280 (define-bitfield-emitter emit-word 32
283 (define-bitfield-emitter emit-short 16
286 (define-bitfield-emitter emit-immediate-inst 32
287 (byte 6 26) (byte 5 21) (byte 5 16) (byte 16 0))
289 (define-bitfield-emitter emit-jump-inst 32
290 (byte 6 26) (byte 26 0))
292 (define-bitfield-emitter emit-register-inst 32
293 (byte 6 26) (byte 5 21) (byte 5 16) (byte 5 11) (byte 5 6) (byte 6 0))
295 (define-bitfield-emitter emit-break-inst 32
296 (byte 6 26) (byte 10 16) (byte 10 6) (byte 6 0))
298 (define-bitfield-emitter emit-float-inst 32
299 (byte 6 26) (byte 1 25) (byte 4 21) (byte 5 16)
300 (byte 5 11) (byte 5 6) (byte 6 0))
304 ;;;; Math instructions.
306 (defun emit-math-inst (segment dst src1 src2 reg-opcode immed-opcode
307 &optional allow-fixups)
313 (emit-register-inst segment special-op (reg-tn-encoding src1)
314 (reg-tn-encoding src2) (reg-tn-encoding dst)
317 (emit-immediate-inst segment immed-opcode (reg-tn-encoding src1)
318 (reg-tn-encoding dst) src2))
321 (error "Fixups aren't allowed."))
322 (note-fixup segment :addi src2)
323 (emit-immediate-inst segment immed-opcode (reg-tn-encoding src1)
324 (reg-tn-encoding dst) 0))))
326 (define-instruction add (segment dst src1 &optional src2)
327 (:declare (type tn dst)
328 (type (or tn (signed-byte 16) null) src1 src2))
329 (:printer register ((op special-op) (funct #b100000)))
330 (:printer immediate ((op #b001000)))
331 (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
334 (emit-math-inst segment dst src1 src2 #b100000 #b001000)))
336 (define-instruction addu (segment dst src1 &optional src2)
337 (:declare (type tn dst)
338 (type (or tn (signed-byte 16) fixup null) src1 src2))
339 (:printer register ((op special-op) (funct #b100001)))
340 (:printer immediate ((op #b001001)))
341 (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
344 (emit-math-inst segment dst src1 src2 #b100001 #b001001 t)))
346 (define-instruction sub (segment dst src1 &optional src2)
349 (type (or tn (integer #.(- 1 (ash 1 15)) #.(ash 1 15)) null) src1 src2))
350 (:printer register ((op special-op) (funct #b100010)))
351 (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
357 (emit-math-inst segment dst src1
358 (if (integerp src2) (- src2) src2)
361 (define-instruction subu (segment dst src1 &optional src2)
365 (or tn (integer #.(- 1 (ash 1 15)) #.(ash 1 15)) fixup null) src1 src2))
366 (:printer register ((op special-op) (funct #b100011)))
367 (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
373 (emit-math-inst segment dst src1
374 (if (integerp src2) (- src2) src2)
375 #b100011 #b001001 t)))
377 (define-instruction and (segment dst src1 &optional src2)
378 (:declare (type tn dst)
379 (type (or tn (unsigned-byte 16) null) src1 src2))
380 (:printer register ((op special-op) (funct #b100100)))
381 (:printer immediate ((op #b001100) (immediate nil :sign-extend nil)))
382 (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
385 (emit-math-inst segment dst src1 src2 #b100100 #b001100)))
387 (define-instruction or (segment dst src1 &optional src2)
388 (:declare (type tn dst)
389 (type (or tn (unsigned-byte 16) null) src1 src2))
390 (:printer register ((op special-op) (funct #b100101)))
391 (:printer immediate ((op #b001101)))
392 (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
395 (emit-math-inst segment dst src1 src2 #b100101 #b001101)))
397 (define-instruction xor (segment dst src1 &optional src2)
398 (:declare (type tn dst)
399 (type (or tn (unsigned-byte 16) null) src1 src2))
400 (:printer register ((op special-op) (funct #b100110)))
401 (:printer immediate ((op #b001110)))
402 (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
405 (emit-math-inst segment dst src1 src2 #b100110 #b001110)))
407 (define-instruction nor (segment dst src1 &optional src2)
408 (:declare (type tn dst src1) (type (or tn null) src2))
409 (:printer register ((op special-op) (funct #b100111)))
410 (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
413 (emit-math-inst segment dst src1 src2 #b100111 #b000000)))
415 (define-instruction slt (segment dst src1 &optional src2)
416 (:declare (type tn dst)
417 (type (or tn (signed-byte 16) null) src1 src2))
418 (:printer register ((op special-op) (funct #b101010)))
419 (:printer immediate ((op #b001010)))
420 (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
423 (emit-math-inst segment dst src1 src2 #b101010 #b001010)))
425 (define-instruction sltu (segment dst src1 &optional src2)
426 (:declare (type tn dst)
427 (type (or tn (signed-byte 16) null) src1 src2))
428 (:printer register ((op special-op) (funct #b101011)))
429 (:printer immediate ((op #b001011)))
430 (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
433 (emit-math-inst segment dst src1 src2 #b101011 #b001011)))
435 (defconstant-eqx divmul-printer '(:name :tab rs ", " rt) #'equalp)
437 (define-instruction div (segment src1 src2)
438 (:declare (type tn src1 src2))
439 (:printer register ((op special-op) (rd 0) (funct #b011010)) divmul-printer)
440 (:dependencies (reads src1) (reads src2) (writes :hi-reg) (writes :low-reg))
443 (emit-register-inst segment special-op (reg-tn-encoding src1)
444 (reg-tn-encoding src2) 0 0 #b011010)))
446 (define-instruction divu (segment src1 src2)
447 (:declare (type tn src1 src2))
448 (:printer register ((op special-op) (rd 0) (funct #b011011))
450 (:dependencies (reads src1) (reads src2) (writes :hi-reg) (writes :low-reg))
453 (emit-register-inst segment special-op (reg-tn-encoding src1)
454 (reg-tn-encoding src2) 0 0 #b011011)))
456 (define-instruction mult (segment src1 src2)
457 (:declare (type tn src1 src2))
458 (:printer register ((op special-op) (rd 0) (funct #b011000)) divmul-printer)
459 (:dependencies (reads src1) (reads src2) (writes :hi-reg) (writes :low-reg))
462 (emit-register-inst segment special-op (reg-tn-encoding src1)
463 (reg-tn-encoding src2) 0 0 #b011000)))
465 (define-instruction multu (segment src1 src2)
466 (:declare (type tn src1 src2))
467 (:printer register ((op special-op) (rd 0) (funct #b011001)))
468 (:dependencies (reads src1) (reads src2) (writes :hi-reg) (writes :low-reg))
471 (emit-register-inst segment special-op (reg-tn-encoding src1)
472 (reg-tn-encoding src2) 0 0 #b011001)))
474 (defun emit-shift-inst (segment opcode dst src1 src2)
480 (emit-register-inst segment special-op (reg-tn-encoding src2)
481 (reg-tn-encoding src1) (reg-tn-encoding dst)
482 0 (logior #b000100 opcode)))
484 (emit-register-inst segment special-op 0 (reg-tn-encoding src1)
485 (reg-tn-encoding dst) src2 opcode))))
487 (defconstant-eqx shift-printer
490 (:unless (:same-as rd) ", " rt)
491 ", " (:cond ((rs :constant 0) shamt)
495 (define-instruction sll (segment dst src1 &optional src2)
496 (:declare (type tn dst)
497 (type (or tn (unsigned-byte 5) null) src1 src2))
498 (:printer register ((op special-op) (rs 0) (shamt nil) (funct #b000000))
500 (:printer register ((op special-op) (funct #b000100)) shift-printer)
501 (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
504 (emit-shift-inst segment #b00 dst src1 src2)))
506 (define-instruction sra (segment dst src1 &optional src2)
507 (:declare (type tn dst)
508 (type (or tn (unsigned-byte 5) null) src1 src2))
509 (:printer register ((op special-op) (rs 0) (shamt nil) (funct #b000011))
511 (:printer register ((op special-op) (funct #b000111)) shift-printer)
512 (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
515 (emit-shift-inst segment #b11 dst src1 src2)))
517 (define-instruction srl (segment dst src1 &optional src2)
518 (:declare (type tn dst)
519 (type (or tn (unsigned-byte 5) null) src1 src2))
520 (:printer register ((op special-op) (rs 0) (shamt nil) (funct #b000010))
522 (:printer register ((op special-op) (funct #b000110)) shift-printer)
523 (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
526 (emit-shift-inst segment #b10 dst src1 src2)))
529 ;;;; Floating point math.
531 (define-instruction float-op (segment operation format dst src1 src2)
532 (:declare (type float-operation operation)
533 (type float-format format)
534 (type tn dst src1 src2))
535 (:printer float-op ())
536 (:dependencies (reads src1) (reads src2) (writes dst))
539 (emit-float-inst segment cop1-op 1 (float-format-value format)
540 (fp-reg-tn-encoding src2) (fp-reg-tn-encoding src1)
541 (fp-reg-tn-encoding dst) (float-operation operation))))
543 (defconstant-eqx float-unop-printer
544 `(:name ,@float-fmt-printer :tab fd (:unless (:same-as fd) ", " fs))
547 (define-instruction fabs (segment format dst &optional (src dst))
548 (:declare (type float-format format) (type tn dst src))
549 (:printer float ((funct #b000101)) float-unop-printer)
550 (:dependencies (reads src) (writes dst))
553 (emit-float-inst segment cop1-op 1 (float-format-value format)
554 0 (fp-reg-tn-encoding src) (fp-reg-tn-encoding dst)
557 (define-instruction fneg (segment format dst &optional (src dst))
558 (:declare (type float-format format) (type tn dst src))
559 (:printer float ((funct #b000111)) float-unop-printer)
560 (:dependencies (reads src) (writes dst))
563 (emit-float-inst segment cop1-op 1 (float-format-value format)
564 0 (fp-reg-tn-encoding src) (fp-reg-tn-encoding dst)
567 (define-instruction fcvt (segment format1 format2 dst src)
568 (:declare (type float-format format1 format2) (type tn dst src))
569 (:printer float-aux ((funct #b10) (sub-funct nil :type 'float-format))
570 `(:name "." sub-funct "." format :tab fd ", " fs))
571 (:dependencies (reads src) (writes dst))
574 (emit-float-inst segment cop1-op 1 (float-format-value format2) 0
575 (fp-reg-tn-encoding src) (fp-reg-tn-encoding dst)
576 (logior #b100000 (float-format-value format1)))))
578 (define-instruction fcmp (segment operation format fs ft)
579 (:declare (type compare-kind operation)
580 (type float-format format)
582 (:printer float-aux ((fd 0) (funct #b11) (sub-funct nil :type 'compare-kind))
583 `(:name "-" sub-funct "." format :tab fs ", " ft))
584 (:dependencies (reads fs) (reads ft) (writes :float-status))
587 (emit-float-inst segment cop1-op 1 (float-format-value format)
588 (fp-reg-tn-encoding ft) (fp-reg-tn-encoding fs) 0
589 (logior #b110000 (compare-kind operation)))))
592 ;;;; Branch/Jump instructions.
594 (defun emit-relative-branch (segment opcode r1 r2 target)
595 (emit-back-patch segment 4
596 #'(lambda (segment posn)
597 (emit-immediate-inst segment
601 (reg-tn-encoding r1))
604 (reg-tn-encoding r2))
605 (ash (- (label-position target)
609 (define-instruction b (segment target)
610 (:declare (type label target))
611 (:printer immediate ((op #b000100) (rs 0) (rt 0)
612 (immediate nil :type 'relative-label))
613 '(:name :tab immediate))
617 (emit-relative-branch segment #b000100 0 0 target)))
619 (define-instruction bal (segment target)
620 (:declare (type label target))
621 (:printer immediate ((op bcond-op) (rs 0) (rt #b01001)
622 (immediate nil :type 'relative-label))
623 '(:name :tab immediate))
627 (emit-relative-branch segment bcond-op 0 #b10001 target)))
630 (define-instruction beq (segment r1 r2-or-target &optional target)
631 (:declare (type tn r1)
632 (type (or tn fixnum label) r2-or-target)
633 (type (or label null) target))
634 (:printer immediate ((op #b000100) (immediate nil :type 'relative-label)))
636 (:dependencies (reads r1) (reads r2-or-target))
640 (setf target r2-or-target)
641 (setf r2-or-target 0))
642 (emit-relative-branch segment #b000100 r1 r2-or-target target)))
644 (define-instruction bne (segment r1 r2-or-target &optional target)
645 (:declare (type tn r1)
646 (type (or tn fixnum label) r2-or-target)
647 (type (or label null) target))
648 (:printer immediate ((op #b000101) (immediate nil :type 'relative-label)))
650 (:dependencies (reads r1) (reads r2-or-target))
654 (setf target r2-or-target)
655 (setf r2-or-target 0))
656 (emit-relative-branch segment #b000101 r1 r2-or-target target)))
658 (defconstant-eqx cond-branch-printer
659 '(:name :tab rs ", " immediate)
662 (define-instruction blez (segment reg target)
663 (:declare (type label target) (type tn reg))
665 immediate ((op #b000110) (rt 0) (immediate nil :type 'relative-label))
668 (:dependencies (reads reg))
671 (emit-relative-branch segment #b000110 reg 0 target)))
673 (define-instruction bgtz (segment reg target)
674 (:declare (type label target) (type tn reg))
676 immediate ((op #b000111) (rt 0) (immediate nil :type 'relative-label))
679 (:dependencies (reads reg))
682 (emit-relative-branch segment #b000111 reg 0 target)))
684 (define-instruction bltz (segment reg target)
685 (:declare (type label target) (type tn reg))
687 immediate ((op bcond-op) (rt 0) (immediate nil :type 'relative-label))
690 (:dependencies (reads reg))
693 (emit-relative-branch segment bcond-op reg #b00000 target)))
695 (define-instruction bgez (segment reg target)
696 (:declare (type label target) (type tn reg))
698 immediate ((op bcond-op) (rt 1) (immediate nil :type 'relative-label))
701 (:dependencies (reads reg))
704 (emit-relative-branch segment bcond-op reg #b00001 target)))
706 (define-instruction bltzal (segment reg target)
707 (:declare (type label target) (type tn reg))
709 immediate ((op bcond-op) (rt #b01000) (immediate nil :type 'relative-label))
712 (:dependencies (reads reg) (writes :r31))
715 (emit-relative-branch segment bcond-op reg #b10000 target)))
717 (define-instruction bgezal (segment reg target)
718 (:declare (type label target) (type tn reg))
720 immediate ((op bcond-op) (rt #b01001) (immediate nil :type 'relative-label))
724 (:dependencies (reads reg) (writes :r31))
726 (emit-relative-branch segment bcond-op reg #b10001 target)))
728 (defconstant-eqx j-printer
729 '(:name :tab (:choose rs target))
732 (define-instruction j (segment target)
733 (:declare (type (or tn fixup) target))
734 (:printer register ((op special-op) (rt 0) (rd 0) (funct #b001000))
736 (:printer jump ((op #b000010)) j-printer)
738 (:dependencies (reads target))
743 (emit-register-inst segment special-op (reg-tn-encoding target)
746 (note-fixup segment :jump target)
747 (emit-jump-inst segment #b000010 0)))))
749 (define-instruction jal (segment reg-or-target &optional target)
750 (:declare (type (or null tn fixup) target)
751 (type (or tn fixup (integer -16 31)) reg-or-target))
752 (:printer register ((op special-op) (rt 0) (funct #b001001)) j-printer)
753 (:printer jump ((op #b000011)) j-printer)
755 (:dependencies (if target (writes reg-or-target) (writes :r31)))
759 (setf target reg-or-target)
760 (setf reg-or-target 31))
763 (emit-register-inst segment special-op (reg-tn-encoding target) 0
764 reg-or-target 0 #b001001))
766 (note-fixup segment :jump target)
767 (emit-jump-inst segment #b000011 0)))))
769 (define-instruction bc1f (segment target)
770 (:declare (type label target))
771 (:printer coproc-branch ((op cop1-op) (funct #x100)
772 (offset nil :type 'relative-label)))
774 (:dependencies (reads :float-status))
777 (emit-relative-branch segment cop1-op #b01000 #b00000 target)))
779 (define-instruction bc1t (segment target)
780 (:declare (type label target))
781 (:printer coproc-branch ((op cop1-op) (funct #x101)
782 (offset nil :type 'relative-label)))
784 (:dependencies (reads :float-status))
787 (emit-relative-branch segment cop1-op #b01000 #b00001 target)))
791 ;;;; Random movement instructions.
793 (define-instruction lui (segment reg value)
794 (:declare (type tn reg)
795 (type (or fixup (signed-byte 16) (unsigned-byte 16)) value))
796 (:printer immediate ((op #b001111)
797 (immediate nil :sign-extend nil :printer "#x~4,'0X")))
798 (:dependencies (writes reg))
801 (when (fixup-p value)
802 (note-fixup segment :lui value)
804 (emit-immediate-inst segment #b001111 0 (reg-tn-encoding reg) value)))
806 (defconstant-eqx mvsreg-printer '(:name :tab rd)
809 (define-instruction mfhi (segment reg)
810 (:declare (type tn reg))
811 (:printer register ((op special-op) (rs 0) (rt 0) (funct #b010000))
813 (:dependencies (reads :hi-reg) (writes reg))
816 (emit-register-inst segment special-op 0 0 (reg-tn-encoding reg) 0
819 (define-instruction mthi (segment reg)
820 (:declare (type tn reg))
821 (:printer register ((op special-op) (rs 0) (rt 0) (funct #b010001))
823 (:dependencies (reads reg) (writes :hi-reg))
826 (emit-register-inst segment special-op 0 0 (reg-tn-encoding reg) 0
829 (define-instruction mflo (segment reg)
830 (:declare (type tn reg))
831 (:printer register ((op special-op) (rs 0) (rt 0) (funct #b010010))
833 (:dependencies (reads :low-reg) (writes reg))
836 (emit-register-inst segment special-op 0 0 (reg-tn-encoding reg) 0
839 (define-instruction mtlo (segment reg)
840 (:declare (type tn reg))
841 (:printer register ((op special-op) (rs 0) (rt 0) (funct #b010011))
843 (:dependencies (reads reg) (writes :low-reg))
846 (emit-register-inst segment special-op 0 0 (reg-tn-encoding reg) 0
849 (define-instruction move (segment dst src)
850 (:declare (type tn dst src))
851 (:printer register ((op special-op) (rt 0) (funct #b100001))
852 '(:name :tab rd ", " rs))
853 (:attributes flushable)
854 (:dependencies (reads src) (writes dst))
857 (emit-register-inst segment special-op (reg-tn-encoding src) 0
858 (reg-tn-encoding dst) 0 #b100001)))
860 (define-instruction fmove (segment format dst src)
861 (:declare (type float-format format) (type tn dst src))
862 (:printer float ((funct #b000110)) '(:name "." format :tab fd ", " fs))
863 (:attributes flushable)
864 (:dependencies (reads src) (writes dst))
867 (emit-float-inst segment cop1-op 1 (float-format-value format) 0
868 (fp-reg-tn-encoding src) (fp-reg-tn-encoding dst)
871 (defun %li (reg value)
874 (inst or reg zero-tn value))
876 (inst addu reg zero-tn value))
877 ((or (signed-byte 32) (unsigned-byte 32))
878 (inst lui reg (ldb (byte 16 16) value))
879 (inst or reg (ldb (byte 16 0) value)))
882 (inst addu reg value))))
884 (define-instruction-macro li (reg value)
887 (defconstant-eqx sub-op-printer '(:name :tab rd ", " rt) #'equalp)
889 (define-instruction mtc1 (segment to from)
890 (:declare (type tn to from))
891 (:printer register ((op cop1-op) (rs #b00100) (funct 0)) sub-op-printer)
892 (:dependencies (reads from) (writes to))
895 (emit-register-inst segment cop1-op #b00100 (reg-tn-encoding from)
896 (fp-reg-tn-encoding to) 0 0)))
898 (define-instruction mtc1-odd (segment to from)
899 (:declare (type tn to from))
900 (:dependencies (reads from) (writes to))
903 (emit-register-inst segment cop1-op #b00100 (reg-tn-encoding from)
904 (1+ (fp-reg-tn-encoding to)) 0 0)))
906 (define-instruction mfc1 (segment to from)
907 (:declare (type tn to from))
908 (:printer register ((op cop1-op) (rs 0) (rd nil :type 'fp-reg) (funct 0))
910 (:dependencies (reads from) (writes to))
913 (emit-register-inst segment cop1-op #b00000 (reg-tn-encoding to)
914 (fp-reg-tn-encoding from) 0 0)))
916 (define-instruction mfc1-odd (segment to from)
917 (:declare (type tn to from))
918 (:dependencies (reads from) (writes to))
921 (emit-register-inst segment cop1-op #b00000 (reg-tn-encoding to)
922 (1+ (fp-reg-tn-encoding from)) 0 0)))
924 (define-instruction mfc1-odd2 (segment to from)
925 (:declare (type tn to from))
926 (:dependencies (reads from) (writes to))
929 (emit-register-inst segment cop1-op #b00000 (1+ (reg-tn-encoding to))
930 (fp-reg-tn-encoding from) 0 0)))
932 (define-instruction mfc1-odd3 (segment to from)
933 (:declare (type tn to from))
934 (:dependencies (reads from) (writes to))
937 (emit-register-inst segment cop1-op #b00000 (1+ (reg-tn-encoding to))
938 (1+ (fp-reg-tn-encoding from)) 0 0)))
940 (define-instruction cfc1 (segment reg cr)
941 (:declare (type tn reg) (type (unsigned-byte 5) cr))
942 (:printer register ((op cop1-op) (rs #b00010) (rd nil :type 'control-reg)
943 (funct 0)) sub-op-printer)
944 (:dependencies (reads :ctrl-stat-reg) (writes reg))
947 (emit-register-inst segment cop1-op #b00010 (reg-tn-encoding reg)
950 (define-instruction ctc1 (segment reg cr)
951 (:declare (type tn reg) (type (unsigned-byte 5) cr))
952 (:printer register ((op cop1-op) (rs #b00110) (rd nil :type 'control-reg)
953 (funct 0)) sub-op-printer)
954 (:dependencies (reads reg) (writes :ctrl-stat-reg))
957 (emit-register-inst segment cop1-op #b00110 (reg-tn-encoding reg)
962 ;;;; Random system hackery and other noise
964 (define-instruction-macro entry-point ()
968 (define-bitfield-emitter emit-break-inst 32
969 (byte 6 26) (byte 10 16) (byte 10 6) (byte 6 0))
971 (defun snarf-error-junk (sap offset &optional length-only)
972 (let* ((length (sb!sys:sap-ref-8 sap offset))
973 (vector (make-array length :element-type '(unsigned-byte 8))))
974 (declare (type sb!sys:system-area-pointer sap)
975 (type (unsigned-byte 8) length)
976 (type (simple-array (unsigned-byte 8) (*)) vector))
978 (values 0 (1+ length) nil nil))
980 (sb!kernel:copy-from-system-area sap (* n-byte-bits (1+ offset))
981 vector (* n-word-bits
983 (* length n-byte-bits))
984 (collect ((sc-offsets)
986 (lengths 1) ; the length byte
988 (error-number (sb!c:read-var-integer vector index)))
991 (when (>= index length)
993 (let ((old-index index))
994 (sc-offsets (sb!c:read-var-integer vector index))
995 (lengths (- index old-index))))
1001 (defmacro break-cases (breaknum &body cases)
1002 (let ((bn-temp (gensym)))
1003 (collect ((clauses))
1004 (dolist (case cases)
1005 (clauses `((= ,bn-temp ,(car case)) ,@(cdr case))))
1006 `(let ((,bn-temp ,breaknum))
1007 (cond ,@(clauses))))))
1009 (defun break-control (chunk inst stream dstate)
1010 (declare (ignore inst))
1011 (flet ((nt (x) (if stream (sb!disassem:note x dstate))))
1012 (case (break-code chunk dstate)
1015 (sb!disassem:handle-break-args #'snarf-error-junk stream dstate))
1018 (sb!disassem:handle-break-args #'snarf-error-junk stream dstate))
1020 (nt "Breakpoint trap"))
1021 (#.pending-interrupt-trap
1022 (nt "Pending interrupt trap"))
1025 (#.fun-end-breakpoint-trap
1026 (nt "Function end breakpoint trap"))
1029 (define-instruction break (segment code &optional (subcode 0))
1030 (:declare (type (unsigned-byte 10) code subcode))
1031 (:printer break ((op special-op) (funct #b001101))
1032 '(:name :tab code (:unless (:constant 0) subcode))
1033 :control #'break-control )
1038 (emit-break-inst segment special-op code subcode #b001101)))
1040 (define-instruction syscall (segment)
1041 (:printer register ((op special-op) (rd 0) (rt 0) (rs 0) (funct #b001100))
1046 (emit-register-inst segment special-op 0 0 0 0 #b001100)))
1048 (define-instruction nop (segment)
1049 (:printer register ((op 0) (rd 0) (rd 0) (rs 0) (funct 0)) '(:name))
1050 (:attributes flushable)
1053 (emit-word segment 0)))
1055 (!def-vm-support-routine emit-nop (segment)
1056 (emit-word segment 0))
1058 (define-instruction word (segment word)
1059 (:declare (type (or (unsigned-byte 32) (signed-byte 32)) word))
1064 (emit-word segment word)))
1066 (define-instruction short (segment short)
1067 (:declare (type (or (unsigned-byte 16) (signed-byte 16)) short))
1072 (emit-short segment short)))
1074 (define-instruction byte (segment byte)
1075 (:declare (type (or (unsigned-byte 8) (signed-byte 8)) byte))
1080 (emit-byte segment byte)))
1083 (defun emit-header-data (segment type)
1086 #'(lambda (segment posn)
1089 (ash (+ posn (component-header-length))
1090 (- n-widetag-bits word-shift)))))))
1092 (define-instruction fun-header-word (segment)
1097 (emit-header-data segment simple-fun-header-widetag)))
1099 (define-instruction lra-header-word (segment)
1104 (emit-header-data segment return-pc-header-widetag)))
1107 (defun emit-compute-inst (segment vop dst src label temp calc)
1109 ;; We emit either 12 or 4 bytes, so we maintain 8 byte alignments.
1111 #'(lambda (segment posn delta-if-after)
1112 (let ((delta (funcall calc label posn delta-if-after)))
1113 (when (<= (- (ash 1 15)) delta (1- (ash 1 15)))
1114 (emit-back-patch segment 4
1115 #'(lambda (segment posn)
1116 (assemble (segment vop)
1118 (funcall calc label posn 0)))))
1120 #'(lambda (segment posn)
1121 (let ((delta (funcall calc label posn 0)))
1122 (assemble (segment vop)
1123 (inst lui temp (ldb (byte 16 16) delta))
1124 (inst or temp (ldb (byte 16 0) delta))
1125 (inst addu dst src temp))))))
1127 ;; code = fn - header - label-offset + other-pointer-tag
1128 (define-instruction compute-code-from-fn (segment dst src label temp)
1129 (:declare (type tn dst src temp) (type label label))
1130 (:attributes variable-length)
1131 (:dependencies (reads src) (writes dst) (writes temp))
1135 (emit-compute-inst segment vop dst src label temp
1136 #'(lambda (label posn delta-if-after)
1137 (- other-pointer-lowtag
1138 (label-position label posn delta-if-after)
1139 (component-header-length))))))
1141 ;; code = lra - other-pointer-tag - header - label-offset + other-pointer-tag
1142 ;; = lra - (header + label-offset)
1143 (define-instruction compute-code-from-lra (segment dst src label temp)
1144 (:declare (type tn dst src temp) (type label label))
1145 (:attributes variable-length)
1146 (:dependencies (reads src) (writes dst) (writes temp))
1150 (emit-compute-inst segment vop dst src label temp
1151 #'(lambda (label posn delta-if-after)
1152 (- (+ (label-position label posn delta-if-after)
1153 (component-header-length)))))))
1155 ;; lra = code + other-pointer-tag + header + label-offset - other-pointer-tag
1156 (define-instruction compute-lra-from-code (segment dst src label temp)
1157 (:declare (type tn dst src temp) (type label label))
1158 (:attributes variable-length)
1159 (:dependencies (reads src) (writes dst) (writes temp))
1163 (emit-compute-inst segment vop dst src label temp
1164 #'(lambda (label posn delta-if-after)
1165 (+ (label-position label posn delta-if-after)
1166 (component-header-length))))))
1169 ;;;; Loads and Stores
1171 (defun emit-load/store-inst (segment opcode reg base index
1172 &optional (oddhack 0))
1173 (when (fixup-p index)
1174 (note-fixup segment :addi index)
1176 (emit-immediate-inst segment opcode (reg-tn-encoding reg)
1177 (+ (reg-tn-encoding base) oddhack) index))
1179 (defconstant-eqx load-store-printer
1183 (:unless (:constant 0) "[" immediate "]"))
1186 (define-instruction lb (segment reg base &optional (index 0))
1187 (:declare (type tn reg base)
1188 (type (or (signed-byte 16) fixup) index))
1189 (:printer immediate ((op #b100000)) load-store-printer)
1190 (:dependencies (reads base) (reads :memory) (writes reg))
1193 (emit-load/store-inst segment #b100000 base reg index)))
1195 (define-instruction lh (segment reg base &optional (index 0))
1196 (:declare (type tn reg base)
1197 (type (or (signed-byte 16) fixup) index))
1198 (:printer immediate ((op #b100001)) load-store-printer)
1199 (:dependencies (reads base) (reads :memory) (writes reg))
1202 (emit-load/store-inst segment #b100001 base reg index)))
1204 (define-instruction lwl (segment reg base &optional (index 0))
1205 (:declare (type tn reg base)
1206 (type (or (signed-byte 16) fixup) index))
1207 (:printer immediate ((op #b100010)) load-store-printer)
1208 (:dependencies (reads base) (reads :memory) (writes reg))
1211 (emit-load/store-inst segment #b100010 base reg index)))
1213 (define-instruction lw (segment reg base &optional (index 0))
1214 (:declare (type tn reg base)
1215 (type (or (signed-byte 16) fixup) index))
1216 (:printer immediate ((op #b100011)) load-store-printer)
1217 (:dependencies (reads base) (reads :memory) (writes reg))
1220 (emit-load/store-inst segment #b100011 base reg index)))
1222 ;; next is just for ease of coding double-in-int c-call convention
1223 (define-instruction lw-odd (segment reg base &optional (index 0))
1224 (:declare (type tn reg base)
1225 (type (or (signed-byte 16) fixup) index))
1226 (:dependencies (reads base) (reads :memory) (writes reg))
1229 (emit-load/store-inst segment #b100011 base reg index 1)))
1231 (define-instruction lbu (segment reg base &optional (index 0))
1232 (:declare (type tn reg base)
1233 (type (or (signed-byte 16) fixup) index))
1234 (:printer immediate ((op #b100100)) load-store-printer)
1235 (:dependencies (reads base) (reads :memory) (writes reg))
1238 (emit-load/store-inst segment #b100100 base reg index)))
1240 (define-instruction lhu (segment reg base &optional (index 0))
1241 (:declare (type tn reg base)
1242 (type (or (signed-byte 16) fixup) index))
1243 (:printer immediate ((op #b100101)) load-store-printer)
1244 (:dependencies (reads base) (reads :memory) (writes reg))
1247 (emit-load/store-inst segment #b100101 base reg index)))
1249 (define-instruction lwr (segment reg base &optional (index 0))
1250 (:declare (type tn reg base)
1251 (type (or (signed-byte 16) fixup) index))
1252 (:printer immediate ((op #b100110)) load-store-printer)
1253 (:dependencies (reads base) (reads :memory) (writes reg))
1256 (emit-load/store-inst segment #b100110 base reg index)))
1258 (define-instruction sb (segment reg base &optional (index 0))
1259 (:declare (type tn reg base)
1260 (type (or (signed-byte 16) fixup) index))
1261 (:printer immediate ((op #b101000)) load-store-printer)
1262 (:dependencies (reads base) (reads reg) (writes :memory))
1265 (emit-load/store-inst segment #b101000 base reg index)))
1267 (define-instruction sh (segment reg base &optional (index 0))
1268 (:declare (type tn reg base)
1269 (type (or (signed-byte 16) fixup) index))
1270 (:printer immediate ((op #b101001)) load-store-printer)
1271 (:dependencies (reads base) (reads reg) (writes :memory))
1274 (emit-load/store-inst segment #b101001 base reg index)))
1276 (define-instruction swl (segment reg base &optional (index 0))
1277 (:declare (type tn reg base)
1278 (type (or (signed-byte 16) fixup) index))
1279 (:printer immediate ((op #b101010)) load-store-printer)
1280 (:dependencies (reads base) (reads reg) (writes :memory))
1283 (emit-load/store-inst segment #b101010 base reg index)))
1285 (define-instruction sw (segment reg base &optional (index 0))
1286 (:declare (type tn reg base)
1287 (type (or (signed-byte 16) fixup) index))
1288 (:printer immediate ((op #b101011)) load-store-printer)
1289 (:dependencies (reads base) (reads reg) (writes :memory))
1292 (emit-load/store-inst segment #b101011 base reg index)))
1294 (define-instruction swr (segment reg base &optional (index 0))
1295 (:declare (type tn reg base)
1296 (type (or (signed-byte 16) fixup) index))
1297 (:printer immediate ((op #b101110)) load-store-printer)
1298 (:dependencies (reads base) (reads reg) (writes :memory))
1301 (emit-load/store-inst segment #b101110 base reg index)))
1304 (defun emit-fp-load/store-inst (segment opcode reg odd base index)
1305 (when (fixup-p index)
1306 (note-fixup segment :addi index)
1308 (emit-immediate-inst segment opcode (reg-tn-encoding base)
1309 (+ (fp-reg-tn-encoding reg) odd) index))
1311 (define-instruction lwc1 (segment reg base &optional (index 0))
1312 (:declare (type tn reg base)
1313 (type (or (signed-byte 16) fixup) index))
1314 (:printer immediate ((op #b110001) (rt nil :type 'fp-reg)) load-store-printer)
1315 (:dependencies (reads base) (reads :memory) (writes reg))
1318 (emit-fp-load/store-inst segment #b110001 reg 0 base index)))
1320 (define-instruction lwc1-odd (segment reg base &optional (index 0))
1321 (:declare (type tn reg base)
1322 (type (or (signed-byte 16) fixup) index))
1323 (:dependencies (reads base) (reads :memory) (writes reg))
1326 (emit-fp-load/store-inst segment #b110001 reg 1 base index)))
1328 (define-instruction swc1 (segment reg base &optional (index 0))
1329 (:declare (type tn reg base)
1330 (type (or (signed-byte 16) fixup) index))
1331 (:printer immediate ((op #b111001) (rt nil :type 'fp-reg)) load-store-printer)
1332 (:dependencies (reads base) (reads reg) (writes :memory))
1335 (emit-fp-load/store-inst segment #b111001 reg 0 base index)))
1337 (define-instruction swc1-odd (segment reg base &optional (index 0))
1338 (:declare (type tn reg base)
1339 (type (or (signed-byte 16) fixup) index))
1340 (:dependencies (reads base) (reads reg) (writes :memory))
1343 (emit-fp-load/store-inst segment #b111001 reg 1 base index)))