1 ;;;; the instruction set definition for the Sparc
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 ;;;FIXME: the analogue is commented out in alpha/insts.lisp
15 ;;;(def-assembler-params
17 ;;; :max-locations 100)
19 ;;; Constants, types, conversion functions, some disassembler stuff.
20 (defun reg-tn-encoding (tn)
21 (declare (type tn tn))
26 (if (eq (sb-name (sc-sb (tn-sc tn))) 'registers)
28 (error "~S isn't a register." tn)))))
30 (defun fp-reg-tn-encoding (tn)
31 (declare (type tn tn))
32 (unless (eq (sb-name (sc-sb (tn-sc tn))) 'float-registers)
33 (error "~S isn't a floating-point register." tn))
34 (let ((offset (tn-offset tn)))
36 ;; Use the sparc v9 double float register encoding.
37 #!-:sparc-v9 (error ":sparc-v9 should be on the target features")
38 ;; (assert (backend-featurep :sparc-v9))
39 ;; No single register encoding greater than reg 31.
40 (assert (zerop (mod offset 2)))
41 ;; Upper bit of the register number is encoded in the low bit.
46 ;;;(sb!disassem:set-disassem-params :instruction-alignment 32
47 ;;; :opcode-column-width 11)
49 (defvar *disassem-use-lisp-reg-names* t
51 "If non-NIL, print registers using the Lisp register names.
52 Otherwise, use the Sparc register names")
54 (!def-vm-support-routine location-number (loc)
60 (ecase (sb-name (sc-sb (tn-sc loc)))
62 (unless (zerop (tn-offset loc))
67 (+ (tn-offset loc) 32))
69 (let ((offset (tn-offset loc)))
70 (assert (zerop (mod offset 2)))
71 (values (+ offset 32) 2)))
74 (let ((offset (tn-offset loc)))
75 (assert (zerop (mod offset 4)))
76 (values (+ offset 32) 4)))))
88 ;;; symbols used for disassembly printing
89 (defparameter reg-symbols
92 (cond ((null name) nil)
93 (t (make-symbol (concatenate 'string "%" name)))))
95 #!+sb-doc "The Lisp names for the Sparc integer registers")
97 (defparameter sparc-reg-symbols
98 #("%G0" "%G1" "%G2" "%G3" "%G4" "%G5" NIL NIL
99 "%O0" "%O1" "%O2" "%O3" "%O4" "%O5" "%O6" "%O7"
100 "%L0" "%L1" "%L2" "%L3" "%L4" "%L5" "%L6" "%L7"
101 "%I0" "%I1" "%I2" "%I3" "%I4" "%I5" NIL "%I7")
102 #!+sb-doc "The standard names for the Sparc integer registers")
104 (defun get-reg-name (index)
105 (if *disassem-use-lisp-reg-names*
106 (aref reg-symbols index)
107 (aref sparc-reg-symbols index)))
109 (defvar *note-sethi-inst* nil
110 "An alist for the disassembler indicating the target register and
111 value used in a SETHI instruction. This is used to make annotations
112 about function addresses and register values.")
114 (defvar *pseudo-atomic-set* nil)
116 (defun sign-extend-immed-value (val)
117 ;; val is a 13-bit signed number. Extend the sign appropriately.
122 ;;; Oh, come on, this is ridiculous. I'm not going to solve
123 ;;; bootstrapping issues for a disassembly note. Does this make me
124 ;;; lazy? Christophe, 2001-09-02. FIXME
128 (let ((results (mapcar (lambda (n)
129 (let ((nn (intern (concatenate 'string (string n)
133 `(eval-when (:compile-toplevel :load-toplevel :execute)
134 (defconstant header-word-type-alist
136 ;; This is the same list as in objdefs.
141 #!+long-float long-float
145 #!+long-float complex-long-float
151 simple-array-unsigned-byte-2
152 simple-array-unsigned-byte-4
153 simple-array-unsigned-byte-8
154 simple-array-unsigned-byte-16
155 simple-array-unsigned-byte-32
156 simple-array-signed-byte-8
157 simple-array-signed-byte-16
158 simple-array-signed-byte-30
159 simple-array-signed-byte-32
160 simple-array-single-float
161 simple-array-double-float
162 #!+long-float simple-array-long-float
163 simple-array-complex-single-float
164 simple-array-complex-double-float
165 #!+long-float simple-array-complex-long-float
174 funcallable-instance-header
177 closure-function-header
178 #!-gengc return-pc-header
179 #!+gengc forwarding-pointer
188 #!+(or gengc gencgc) scavenger-hook))
190 ;; Look at the current instruction and see if we can't add some notes
191 ;; about what's happening.
193 (defun maybe-add-notes (reg dstate)
194 (let* ((word (sb!disassem::sap-ref-int (sb!disassem::dstate-segment-sap dstate)
195 (sb!disassem::dstate-cur-offs dstate)
197 (sb!disassem::dstate-byte-order dstate)))
198 (format (ldb (byte 2 30) word))
199 (op3 (ldb (byte 6 19) word))
200 (rs1 (ldb (byte 5 14) word))
201 (rd (ldb (byte 5 25) word))
202 (immed-p (not (zerop (ldb (byte 1 13) word))))
203 (immed-val (sign-extend-immed-value (ldb (byte 13 0) word))))
204 ;; Only the value of format and rd are guaranteed to be correct
205 ;; because the disassembler is trying to print out the value of a
206 ;; register. The other values may not be right.
212 (handle-add-inst rs1 immed-val rd dstate)))
215 (handle-jmpl-inst rs1 immed-val rd dstate)))
218 (handle-andcc-inst rs1 immed-val rd dstate)))))
223 (handle-ld/st-inst rs1 immed-val rd dstate))))))
224 ;; If this is not a SETHI instruction, and RD is the same as some
225 ;; register used by SETHI, we delete the entry. (In case we have
226 ;; a SETHI without any additional instruction because the low bits
228 (unless (and (zerop format) (= #b100 (ldb (byte 3 22) word)))
229 (let ((sethi (assoc rd *note-sethi-inst*)))
231 (setf *note-sethi-inst* (delete sethi *note-sethi-inst*)))))))
233 (defun handle-add-inst (rs1 immed-val rd dstate)
234 (let* ((sethi (assoc rs1 *note-sethi-inst*)))
237 ;; RS1 was used in a SETHI instruction. Assume that
238 ;; this is the offset part of the SETHI instruction for
239 ;; a full 32-bit address of something. Make a note
240 ;; about this usage as a Lisp assembly routine or
241 ;; foreign routine, if possible. If not, just note the
243 (let ((addr (+ immed-val (ash (cdr sethi) 10))))
244 (or (sb!disassem::note-code-constant-absolute addr dstate)
245 (sb!disassem:maybe-note-assembler-routine addr t dstate)
246 (sb!disassem:note (format nil "~A = #x~8,'0X"
247 (get-reg-name rd) addr)
249 (setf *note-sethi-inst* (delete sethi *note-sethi-inst*)))
251 ;; We have an ADD %NULL, <n>, RD instruction. This is a
252 ;; reference to a static symbol.
253 (sb!disassem:maybe-note-nil-indexed-object immed-val
255 ((= rs1 alloc-offset)
256 ;; ADD %ALLOC, n. This must be some allocation or
257 ;; pseudo-atomic stuff
258 (cond ((and (= immed-val 4) (= rd alloc-offset)
259 (not *pseudo-atomic-set*))
260 ;; "ADD 4, %ALLOC" sets the flag
261 (sb!disassem::note "Set pseudo-atomic flag" dstate)
262 (setf *pseudo-atomic-set* t))
264 ;; "ADD n, %ALLOC" is reseting the flag, with extra
267 (format nil "Reset pseudo-atomic, allocated ~D bytes"
268 (+ immed-val 4)) dstate)
269 (setf *pseudo-atomic-set* nil))))
270 #+nil ((and (= rs1 zero-offset) *pseudo-atomic-set*)
271 ;; "ADD %ZERO, num, RD" inside a pseudo-atomic is very
272 ;; likely loading up a header word. Make a note to that
274 (let ((type (second (assoc (logand immed-val #xff) header-word-type-alist)))
275 (size (ldb (byte 24 8) immed-val)))
277 (sb!disassem:note (format nil "Header word ~A, size ~D?" type size)
280 (defun handle-jmpl-inst (rs1 immed-val rd dstate)
281 (let* ((sethi (assoc rs1 *note-sethi-inst*)))
283 ;; RS1 was used in a SETHI instruction. Assume that
284 ;; this is the offset part of the SETHI instruction for
285 ;; a full 32-bit address of something. Make a note
286 ;; about this usage as a Lisp assembly routine or
287 ;; foreign routine, if possible. If not, just note the
289 (let ((addr (+ immed-val (ash (cdr sethi) 10))))
290 (sb!disassem:maybe-note-assembler-routine addr t dstate)
291 (setf *note-sethi-inst* (delete sethi *note-sethi-inst*))))))
293 (defun handle-ld/st-inst (rs1 immed-val rd dstate)
294 (declare (ignore rd))
295 ;; Got an LDUW/LD or STW instruction, with immediate offset.
298 ;; A reference to a code constant (reg = %CODE)
299 (sb!disassem:note-code-constant immed-val dstate))
301 ;; A reference to a static symbol or static function (reg =
303 (or (sb!disassem:maybe-note-nil-indexed-symbol-slot-ref immed-val
305 #+nil (sb!disassem::maybe-note-static-function immed-val dstate)))
307 (let ((sethi (assoc rs1 *note-sethi-inst*)))
309 (let ((addr (+ immed-val (ash (cdr sethi) 10))))
310 (sb!disassem:maybe-note-assembler-routine addr nil dstate)
311 (setf *note-sethi-inst* (delete sethi *note-sethi-inst*))))))))
313 (defun handle-andcc-inst (rs1 immed-val rd dstate)
314 ;; ANDCC %ALLOC, 3, %ZERO instruction
315 (when (and (= rs1 alloc-offset) (= rd zero-offset) (= immed-val 3))
316 (sb!disassem:note "pseudo-atomic interrupted?" dstate)))
318 (sb!disassem:define-arg-type reg
319 :printer (lambda (value stream dstate)
320 (declare (stream stream) (fixnum value))
321 (let ((regname (get-reg-name value)))
322 (princ regname stream)
323 (sb!disassem:maybe-note-associated-storage-ref value
327 (maybe-add-notes value dstate))))
329 (defparameter float-reg-symbols
331 (loop for n from 0 to 63 collect (make-symbol (format nil "%F~d" n)))
334 (sb!disassem:define-arg-type fp-reg
335 :printer (lambda (value stream dstate)
336 (declare (stream stream) (fixnum value))
337 (let ((regname (aref float-reg-symbols value)))
338 (princ regname stream)
339 (sb!disassem:maybe-note-associated-storage-ref
345 ;;; The extended 6 bit floating point register encoding for the double
346 ;;; and long instructions of the sparc v9.
347 (sb!disassem:define-arg-type fp-ext-reg
348 :printer (lambda (value stream dstate)
349 (declare (stream stream) (fixnum value))
350 (let* (;; Decode the register number.
351 (value (if (oddp value) (+ value 31) value))
352 (regname (aref float-reg-symbols value)))
353 (princ regname stream)
354 (sb!disassem:maybe-note-associated-storage-ref
360 (sb!disassem:define-arg-type relative-label
362 :use-label (lambda (value dstate)
363 (declare (type (signed-byte 13) value)
364 (type sb!disassem:disassem-state dstate))
365 (+ (ash value 2) (sb!disassem:dstate-cur-addr dstate))))
367 (defconstant-eqx branch-conditions
368 '(:f :eq :le :lt :leu :ltu :n :vs :t :ne :gt :ge :gtu :geu :p :vc)
371 ;;; Note that these aren't the standard names for branch-conditions, I
372 ;;; think they're a bit more readable (e.g., "eq" instead of "e").
373 ;;; You could just put a vector of the normal ones here too.
375 (sb!disassem:define-arg-type branch-condition
376 :printer (coerce branch-conditions 'vector))
378 (deftype branch-condition ()
379 `(member ,@branch-conditions))
381 (defun branch-condition (condition)
382 (or (position condition branch-conditions)
383 (error "Unknown branch condition: ~S~%Must be one of: ~S"
384 condition branch-conditions)))
386 (defconstant branch-cond-true
389 (defconstant-eqx branch-fp-conditions
390 '(:f :ne :lg :ul :l :ug :g :u :t :eq :ue :ge :uge :le :ule :o)
393 (sb!disassem:define-arg-type branch-fp-condition
394 :printer (coerce branch-fp-conditions 'vector))
396 (sb!disassem:define-arg-type call-fixup :use-label t)
398 (deftype fp-branch-condition ()
399 `(member ,@branch-fp-conditions))
401 (defun fp-branch-condition (condition)
402 (or (position condition branch-fp-conditions)
403 (error "Unknown fp-branch condition: ~S~%Must be one of: ~S"
404 condition branch-fp-conditions)))
407 ;;;; dissassem:define-instruction-formats
409 (sb!disassem:define-instruction-format
410 (format-1 32 :default-printer '(:name :tab disp))
411 (op :field (byte 2 30) :value 1)
412 (disp :field (byte 30 0)))
414 (sb!disassem:define-instruction-format
415 (format-2-immed 32 :default-printer '(:name :tab immed ", " rd))
416 (op :field (byte 2 30) :value 0)
417 (rd :field (byte 5 25) :type 'reg)
418 (op2 :field (byte 3 22))
419 (immed :field (byte 22 0)))
423 (sb!disassem:define-instruction-format
424 (format-2-branch 32 :default-printer `(:name (:unless (:constant ,branch-cond-true) cond)
425 (:unless (a :constant 0) "," 'A)
428 (op :field (byte 2 30) :value 0)
429 (a :field (byte 1 29) :value 0)
430 (cond :field (byte 4 25) :type 'branch-condition)
431 (op2 :field (byte 3 22))
432 (disp :field (byte 22 0) :type 'relative-label))
434 ;; Branch with prediction instruction for V9
436 ;; Currently only %icc and %xcc are used of the four possible values
438 (defconstant-eqx integer-condition-registers
439 '(:icc :reserved :xcc :reserved)
442 (defconstant-eqx integer-cond-reg-name-vec
443 (coerce integer-condition-registers 'vector)
446 (deftype integer-condition-register ()
447 `(member ,@(remove :reserved integer-condition-registers)))
449 (defparameter integer-condition-reg-symbols
452 (make-symbol (concatenate 'string "%" (string name))))
453 integer-condition-registers))
455 (sb!disassem:define-arg-type integer-condition-register
456 :printer (lambda (value stream dstate)
457 (declare (stream stream) (fixnum value) (ignore dstate))
458 (let ((regname (aref integer-condition-reg-symbols value)))
459 (princ regname stream))))
461 (defconstant-eqx branch-predictions
465 (sb!disassem:define-arg-type branch-prediction
466 :printer (coerce branch-predictions 'vector))
468 (defun integer-condition (condition-reg)
469 (declare (type (member :icc :xcc) condition-reg))
470 (or (position condition-reg integer-condition-registers)
471 (error "Unknown integer condition register: ~S~%"
474 (defun branch-prediction (pred)
475 (or (position pred branch-predictions)
476 (error "Unknown branch prediction: ~S~%Must be one of: ~S~%"
477 pred branch-predictions)))
479 (defconstant-eqx branch-pred-printer
480 `(:name (:unless (:constant ,branch-cond-true) cond)
481 (:unless (a :constant 0) "," 'A)
482 (:unless (p :constant 1) "," 'pn)
489 (sb!disassem:define-instruction-format
490 (format-2-branch-pred 32 :default-printer branch-pred-printer)
491 (op :field (byte 2 30) :value 0)
492 (a :field (byte 1 29) :value 0)
493 (cond :field (byte 4 25) :type 'branch-condition)
494 (op2 :field (byte 3 22))
495 (cc :field (byte 2 20) :type 'integer-condition-register)
496 (p :field (byte 1 19))
497 (disp :field (byte 19 0) :type 'relative-label))
499 (defconstant-eqx fp-condition-registers
500 '(:fcc0 :fcc1 :fcc2 :fcc3)
503 (defconstant-eqx fp-cond-reg-name-vec
504 (coerce fp-condition-registers 'vector)
507 (defparameter fp-condition-reg-symbols
510 (make-symbol (concatenate 'string "%" (string name))))
511 fp-condition-registers))
513 (sb!disassem:define-arg-type fp-condition-register
514 :printer (lambda (value stream dstate)
515 (declare (stream stream) (fixnum value) (ignore dstate))
516 (let ((regname (aref fp-condition-reg-symbols value)))
517 (princ regname stream))))
519 (sb!disassem:define-arg-type fp-condition-register-shifted
520 :printer (lambda (value stream dstate)
521 (declare (stream stream) (fixnum value) (ignore dstate))
522 (let ((regname (aref fp-condition-reg-symbols (ash value -1))))
523 (princ regname stream))))
525 (defun fp-condition (condition-reg)
526 (or (position condition-reg fp-condition-registers)
527 (error "Unknown integer condition register: ~S~%"
530 (defconstant-eqx fp-branch-pred-printer
531 `(:name (:unless (:constant ,branch-cond-true) cond)
532 (:unless (a :constant 0) "," 'A)
533 (:unless (p :constant 1) "," 'pn)
540 (sb!disassem:define-instruction-format
541 (format-2-fp-branch-pred 32 :default-printer fp-branch-pred-printer)
542 (op :field (byte 2 30) :value 0)
543 (a :field (byte 1 29) :value 0)
544 (cond :field (byte 4 25) :type 'branch-fp-condition)
545 (op2 :field (byte 3 22))
546 (fcc :field (byte 2 20) :type 'fp-condition-register)
547 (p :field (byte 1 19))
548 (disp :field (byte 19 0) :type 'relative-label))
552 (sb!disassem:define-instruction-format
553 (format-2-unimp 32 :default-printer '(:name :tab data))
554 (op :field (byte 2 30) :value 0)
555 (ignore :field (byte 5 25) :value 0)
556 (op2 :field (byte 3 22) :value 0)
557 (data :field (byte 22 0)))
559 (defconstant-eqx f3-printer
561 (:unless (:same-as rd) rs1 ", ")
562 (:choose rs2 immed) ", "
566 (sb!disassem:define-instruction-format
567 (format-3-reg 32 :default-printer f3-printer)
568 (op :field (byte 2 30))
569 (rd :field (byte 5 25) :type 'reg)
570 (op3 :field (byte 6 19))
571 (rs1 :field (byte 5 14) :type 'reg)
572 (i :field (byte 1 13) :value 0)
573 (asi :field (byte 8 5) :value 0)
574 (rs2 :field (byte 5 0) :type 'reg))
576 (sb!disassem:define-instruction-format
577 (format-3-immed 32 :default-printer f3-printer)
578 (op :field (byte 2 30))
579 (rd :field (byte 5 25) :type 'reg)
580 (op3 :field (byte 6 19))
581 (rs1 :field (byte 5 14) :type 'reg)
582 (i :field (byte 1 13) :value 1)
583 (immed :field (byte 13 0) :sign-extend t)) ; usually sign extended
585 (sb!disassem:define-instruction-format
586 (format-binary-fpop 32
587 :default-printer '(:name :tab rs1 ", " rs2 ", " rd))
588 (op :field (byte 2 30))
589 (rd :field (byte 5 25) :type 'fp-reg)
590 (op3 :field (byte 6 19))
591 (rs1 :field (byte 5 14) :type 'fp-reg)
592 (opf :field (byte 9 5))
593 (rs2 :field (byte 5 0) :type 'fp-reg))
595 ;;; Floating point load/save instructions encoding.
596 (sb!disassem:define-instruction-format
597 (format-unary-fpop 32 :default-printer '(:name :tab rs2 ", " rd))
598 (op :field (byte 2 30))
599 (rd :field (byte 5 25) :type 'fp-reg)
600 (op3 :field (byte 6 19))
601 (rs1 :field (byte 5 14) :value 0)
602 (opf :field (byte 9 5))
603 (rs2 :field (byte 5 0) :type 'fp-reg))
605 ;;; Floating point comparison instructions encoding.
607 ;; This is a merge of the instructions for FP comparison and FP
608 ;; conditional moves available in the Sparc V9. The main problem is
609 ;; that the new instructions use part of the opcode space used by the
610 ;; comparison instructions. In particular, the OPF field is arranged
615 ;; FMOVcc 0nn0000xx %fccn
621 ;; So we see that if we break up the OPF field into 4 pieces, opf0,
622 ;; opf1, opf2, and opf3, we can distinguish between these
623 ;; instructions. So bit 9 (opf2) can be used to distinguish between
624 ;; FCMP and the rest. Also note that the nn field overlaps with the
625 ;; ccc. We need to take this into account as well.
627 (sb!disassem:define-instruction-format
629 :default-printer #!-sparc-v9 '(:name :tab rs1 ", " rs2)
630 #!+sparc-v9 '(:name :tab rd ", " rs1 ", " rs2))
631 (op :field (byte 2 30))
632 (rd :field (byte 5 25) :value 0)
633 (op3 :field (byte 6 19))
634 (rs1 :field (byte 5 14))
635 (opf0 :field (byte 1 13))
636 (opf1 :field (byte 3 10))
637 (opf2 :field (byte 1 9))
638 (opf3 :field (byte 4 5))
639 (rs2 :field (byte 5 0) :type 'fp-reg))
641 ;;; Shift instructions
642 (sb!disassem:define-instruction-format
643 (format-3-shift-reg 32 :default-printer f3-printer)
644 (op :field (byte 2 30))
645 (rd :field (byte 5 25) :type 'reg)
646 (op3 :field (byte 6 19))
647 (rs1 :field (byte 5 14) :type 'reg)
648 (i :field (byte 1 13) :value 0)
649 (x :field (byte 1 12))
650 (asi :field (byte 7 5) :value 0)
651 (rs2 :field (byte 5 0) :type 'reg))
653 (sb!disassem:define-instruction-format
654 (format-3-shift-immed 32 :default-printer f3-printer)
655 (op :field (byte 2 30))
656 (rd :field (byte 5 25) :type 'reg)
657 (op3 :field (byte 6 19))
658 (rs1 :field (byte 5 14) :type 'reg)
659 (i :field (byte 1 13) :value 1)
660 (x :field (byte 1 12))
661 (immed :field (byte 12 0) :sign-extend nil))
664 ;;; Conditional moves (only available for Sparc V9 architectures)
666 ;; The names of all of the condition registers on the V9: 4 FP
667 ;; conditions, the original integer condition register and the new
668 ;; extended register. The :reserved register is reserved on the V9.
670 (defconstant-eqx cond-move-condition-registers
671 '(:fcc0 :fcc1 :fcc2 :fcc3 :icc :reserved :xcc :reserved)
674 (defconstant-eqx cond-move-cond-reg-name-vec
675 (coerce cond-move-condition-registers 'vector)
678 (deftype cond-move-condition-register ()
679 `(member ,@(remove :reserved cond-move-condition-registers)))
681 (defparameter cond-move-condition-reg-symbols
684 (make-symbol (concatenate 'string "%" (string name))))
685 cond-move-condition-registers))
687 (sb!disassem:define-arg-type cond-move-condition-register
688 :printer (lambda (value stream dstate)
689 (declare (stream stream) (fixnum value) (ignore dstate))
690 (let ((regname (aref cond-move-condition-reg-symbols value)))
691 (princ regname stream))))
693 ;; From the given condition register, figure out what the cc2, cc1,
694 ;; and cc0 bits should be. Return cc2 and cc1/cc0 concatenated.
695 (defun cond-move-condition-parts (condition-reg)
696 (let ((posn (position condition-reg cond-move-condition-registers)))
699 (error "Unknown conditional move condition register: ~S~%"
702 (defun cond-move-condition (condition-reg)
703 (or (position condition-reg cond-move-condition-registers)
704 (error "Unknown conditional move condition register: ~S~%")))
706 (defconstant-eqx cond-move-printer
708 cc ", " (:choose immed rs2) ", " rd)
711 ;; Conditional move integer register on integer or FP condition code
712 (sb!disassem:define-instruction-format
713 (format-4-cond-move 32 :default-printer cond-move-printer)
714 (op :field (byte 2 30))
715 (rd :field (byte 5 25) :type 'reg)
716 (op3 :field (byte 6 19))
717 (cc2 :field (byte 1 18) :value 1)
718 (cond :field (byte 4 14) :type 'branch-condition)
719 (i :field (byte 1 13) :value 0)
720 (cc :field (byte 2 11) :type 'integer-condition-register)
721 (empty :field (byte 6 5) :value 0)
722 (rs2 :field (byte 5 0) :type 'reg))
724 (sb!disassem:define-instruction-format
725 (format-4-cond-move-immed 32 :default-printer cond-move-printer)
726 (op :field (byte 2 30))
727 (rd :field (byte 5 25) :type 'reg)
728 (op3 :field (byte 6 19))
729 (cc2 :field (byte 1 18) :value 1)
730 (cond :field (byte 4 14) :type 'branch-condition)
731 (i :field (byte 1 13) :value 1)
732 (cc :field (byte 2 11) :type 'integer-condition-register)
733 (immed :field (byte 11 0) :sign-extend t))
735 ;; Floating-point versions of the above integer conditional moves
736 (defconstant-eqx cond-fp-move-printer
737 `(:name rs1 :tab opf1 ", " rs2 ", " rd)
740 ;;; Conditional move on integer register condition (only on Sparc
741 ;;; V9). That is, move an integer register if some other integer
742 ;;; register satisfies some condition.
744 (defconstant-eqx cond-move-integer-conditions
745 '(:reserved :z :lez :lz :reserved :nz :gz :gez)
748 (defconstant-eqx cond-move-integer-condition-vec
749 (coerce cond-move-integer-conditions 'vector)
752 (deftype cond-move-integer-condition ()
753 `(member ,@(remove :reserved cond-move-integer-conditions)))
755 (sb!disassem:define-arg-type register-condition
756 :printer (lambda (value stream dstate)
757 (declare (stream stream) (fixnum value) (ignore dstate))
758 (let ((regname (aref cond-move-integer-condition-vec value)))
759 (princ regname stream))))
761 (defconstant-eqx cond-move-integer-printer
762 `(:name rcond :tab rs1 ", " (:choose immed rs2) ", " rd)
765 (defun register-condition (rcond)
766 (or (position rcond cond-move-integer-conditions)
767 (error "Unknown register condition: ~S~%")))
769 (sb!disassem:define-instruction-format
770 (format-4-cond-move-integer 32 :default-printer cond-move-integer-printer)
771 (op :field (byte 2 30))
772 (rd :field (byte 5 25) :type 'reg)
773 (op3 :field (byte 6 19))
774 (rs1 :field (byte 5 14) :type 'reg)
775 (i :field (byte 1 13) :value 0)
776 (rcond :field (byte 3 10) :type 'register-condition)
777 (opf :field (byte 5 5))
778 (rs2 :field (byte 5 0) :type 'reg))
780 (sb!disassem:define-instruction-format
781 (format-4-cond-move-integer-immed 32 :default-printer cond-move-integer-printer)
782 (op :field (byte 2 30))
783 (rd :field (byte 5 25) :type 'reg)
784 (op3 :field (byte 6 19))
785 (rs1 :field (byte 5 14) :type 'reg)
786 (i :field (byte 1 13) :value 1)
787 (rcond :field (byte 3 10) :type 'register-condition)
788 (immed :field (byte 10 0) :sign-extend t))
790 (defconstant-eqx trap-printer
791 `(:name rd :tab cc ", " immed)
794 (sb!disassem:define-instruction-format
795 (format-4-trap 32 :default-printer trap-printer)
796 (op :field (byte 2 30))
797 (rd :field (byte 5 25) :type 'reg)
798 (op3 :field (byte 6 19))
799 (rs1 :field (byte 5 14) :type 'reg)
800 (i :field (byte 1 13) :value 1)
801 (cc :field (byte 2 11) :type 'integer-condition-register)
802 (immed :field (byte 11 0) :sign-extend t)) ; usually sign extended
805 (defconstant-eqx cond-fp-move-integer-printer
806 `(:name opf1 :tab rs1 ", " rs2 ", " rd)
810 ;;;; Primitive emitters.
812 (define-bitfield-emitter emit-word 32
815 (define-bitfield-emitter emit-short 16
818 (define-bitfield-emitter emit-format-1 32
819 (byte 2 30) (byte 30 0))
821 (define-bitfield-emitter emit-format-2-immed 32
822 (byte 2 30) (byte 5 25) (byte 3 22) (byte 22 0))
824 (define-bitfield-emitter emit-format-2-branch 32
825 (byte 2 30) (byte 1 29) (byte 4 25) (byte 3 22) (byte 22 0))
827 ;; Integer and FP branches with prediction for V9
828 (define-bitfield-emitter emit-format-2-branch-pred 32
829 (byte 2 30) (byte 1 29) (byte 4 25) (byte 3 22) (byte 2 20) (byte 1 19) (byte 19 0))
830 (define-bitfield-emitter emit-format-2-fp-branch-pred 32
831 (byte 2 30) (byte 1 29) (byte 4 25) (byte 3 22) (byte 2 20) (byte 1 19) (byte 19 0))
833 (define-bitfield-emitter emit-format-2-unimp 32
834 (byte 2 30) (byte 5 25) (byte 3 22) (byte 22 0))
836 (define-bitfield-emitter emit-format-3-reg 32
837 (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 1 13) (byte 8 5)
840 (define-bitfield-emitter emit-format-3-immed 32
841 (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 1 13) (byte 13 0))
843 (define-bitfield-emitter emit-format-3-fpop 32
844 (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 9 5) (byte 5 0))
846 (define-bitfield-emitter emit-format-3-fpop2 32
847 (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14)
848 (byte 1 13) (byte 3 10) (byte 1 9) (byte 4 5)
851 ;;; Shift instructions
853 (define-bitfield-emitter emit-format-3-shift-reg 32
854 (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 1 13) (byte 1 12) (byte 7 5)
857 (define-bitfield-emitter emit-format-3-shift-immed 32
858 (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 1 13) (byte 1 12) (byte 12 0))
860 ;;; Conditional moves
862 ;; Conditional move in condition code
863 (define-bitfield-emitter emit-format-4-cond-move 32
864 (byte 2 30) (byte 5 25) (byte 6 19) (byte 1 18) (byte 4 14) (byte 1 13) (byte 2 11)
867 ;; Conditional move on integer condition
868 (define-bitfield-emitter emit-format-4-cond-move-integer 32
869 (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 1 13) (byte 3 10) (byte 5 5)
872 (define-bitfield-emitter emit-format-4-cond-move-integer-immed 32
873 (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 1 13) (byte 3 10)
876 (define-bitfield-emitter emit-format-4-trap 32
877 (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 1 13) (byte 2 11)
881 ;;;; Most of the format-3-instructions.
883 (defun emit-format-3-inst (segment op op3 dst src1 src2
884 &key load-store fixup dest-kind)
886 (cond ((and (typep src1 'tn) load-store)
893 (emit-format-3-reg segment op
895 (fp-reg-tn-encoding dst)
896 (reg-tn-encoding dst))
897 op3 (reg-tn-encoding src1) 0 0 (reg-tn-encoding src2)))
899 (emit-format-3-immed segment op
901 (fp-reg-tn-encoding dst)
902 (reg-tn-encoding dst))
903 op3 (reg-tn-encoding src1) 1 src2))
905 (unless (or load-store fixup)
906 (error "Fixups aren't allowed."))
907 (note-fixup segment :add src2)
908 (emit-format-3-immed segment op
910 (fp-reg-tn-encoding dst)
911 (reg-tn-encoding dst))
912 op3 (reg-tn-encoding src1) 1 0))))
914 ;;; Shift instructions because an extra bit is used in Sparc V9's to
915 ;;; indicate whether the shift is a 32-bit or 64-bit shift.
917 (defun emit-format-3-shift-inst (segment op op3 dst src1 src2 &key extended)
923 (emit-format-3-shift-reg segment op (reg-tn-encoding dst)
924 op3 (reg-tn-encoding src1) 0 (if extended 1 0)
925 0 (reg-tn-encoding src2)))
927 (emit-format-3-shift-immed segment op (reg-tn-encoding dst)
928 op3 (reg-tn-encoding src1) 1
929 (if extended 1 0) src2))))
932 (eval-when (:compile-toplevel :execute)
934 ;;; have to do this because defconstant is evalutated in the null lex env.
935 (defmacro with-ref-format (printer)
937 '(:choose (:plus-integer immed) ("+" rs2)))
939 `("[" rs1 (:unless (:constant 0) ,addend) "]"
940 (:choose (:unless (:constant 0) asi) nil))))
943 (defconstant-eqx load-printer
944 (with-ref-format `(:NAME :TAB ,ref-format ", " rd))
947 (defconstant-eqx store-printer
948 (with-ref-format `(:NAME :TAB rd ", " ,ref-format))
951 ) ; eval-when (compile eval)
953 (macrolet ((define-f3-inst (name op op3 &key fixup load-store (dest-kind 'reg)
954 (printer :default) reads writes flushable print-name)
956 (if (eq printer :default)
959 ((:load t) 'load-printer)
960 (:store 'store-printer))
962 (when (and (atom reads) (not (null reads)))
963 (setf reads (list reads)))
964 (when (and (atom writes) (not (null writes)))
965 (setf writes (list writes)))
966 `(define-instruction ,name (segment dst src1 &optional src2)
967 (:declare (type tn dst)
968 ,(if (or fixup load-store)
969 '(type (or tn (signed-byte 13) null fixup) src1 src2)
970 '(type (or tn (signed-byte 13) null) src1 src2)))
971 (:printer format-3-reg
972 ((op ,op) (op3 ,op3) (rd nil :type ',dest-kind))
974 ,@(when print-name `(:print-name ,print-name)))
975 (:printer format-3-immed
976 ((op ,op) (op3 ,op3) (rd nil :type ',dest-kind))
978 ,@(when print-name `(:print-name ,print-name)))
980 '((:attributes flushable)))
983 ,@(let ((reads-list nil))
985 (push (list 'reads read) reads-list))
987 ,@(cond ((eq load-store :store)
989 (if src2 (reads src2))))
993 (if src2 (reads src2))))
994 ((eq load-store :load)
996 (if src2 (reads src2) (reads dst))))
998 '((if src2 (reads src2) (reads dst)))))
999 ,@(let ((writes-list nil))
1000 (dolist (write writes)
1001 (push (list 'writes write) writes-list))
1003 ,@(cond ((eq load-store :store)
1004 '((writes :memory :partially t)))
1006 '((writes :memory :partially t)
1008 ((eq load-store :load)
1013 (:emitter (emit-format-3-inst segment ,op ,op3 dst src1 src2
1014 :load-store ,load-store
1016 :dest-kind (not (eq ',dest-kind 'reg)))))))
1018 (define-f3-shift-inst (name op op3 &key extended)
1019 `(define-instruction ,name (segment dst src1 &optional src2)
1020 (:declare (type tn dst)
1021 (type (or tn (unsigned-byte 6) null) src1 src2))
1022 (:printer format-3-shift-reg
1023 ((op ,op) (op3 ,op3) (x ,(if extended 1 0)) (i 0)))
1024 (:printer format-3-shift-immed
1025 ((op ,op) (op3 ,op3) (x ,(if extended 1 0)) (i 1)))
1028 (if src2 (reads src2) (reads dst))
1031 (:emitter (emit-format-3-shift-inst segment ,op ,op3 dst src1 src2
1032 :extended ,extended)))))
1034 (define-f3-inst ldsb #b11 #b001001 :load-store :load)
1035 (define-f3-inst ldsh #b11 #b001010 :load-store :load)
1036 (define-f3-inst ldub #b11 #b000001 :load-store :load)
1037 (define-f3-inst lduh #b11 #b000010 :load-store :load)
1039 ;; This instruction is called lduw for V9 , but looks exactly like ld
1040 ;; on previous architectures.
1041 (define-f3-inst ld #b11 #b000000 :load-store :load
1042 #!+sparc-v9 :print-name #!+sparc-v9 'lduw)
1044 (define-f3-inst ldsw #b11 #b001000 :load-store :load) ; v9
1046 ;; ldd is deprecated on the Sparc V9.
1047 (define-f3-inst ldd #b11 #b000011 :load-store :load)
1049 (define-f3-inst ldx #b11 #b001011 :load-store :load) ; v9
1051 (define-f3-inst ldf #b11 #b100000 :dest-kind fp-reg :load-store :load)
1052 (define-f3-inst lddf #b11 #b100011 :dest-kind fp-reg :load-store :load)
1053 (define-f3-inst ldqf #b11 #b100010 :dest-kind fp-reg :load-store :load) ; v9
1054 (define-f3-inst stb #b11 #b000101 :load-store :store)
1055 (define-f3-inst sth #b11 #b000110 :load-store :store)
1056 (define-f3-inst st #b11 #b000100 :load-store :store)
1058 ;; std is deprecated on the Sparc V9.
1059 (define-f3-inst std #b11 #b000111 :load-store :store)
1061 (define-f3-inst stx #b11 #b001110 :load-store :store) ; v9
1063 (define-f3-inst stf #b11 #b100100 :dest-kind fp-reg :load-store :store)
1064 (define-f3-inst stdf #b11 #b100111 :dest-kind fp-reg :load-store :store)
1065 (define-f3-inst stqf #b11 #b100110 :dest-kind fp-reg :load-store :store) ; v9
1066 (define-f3-inst ldstub #b11 #b001101 :load-store t)
1068 ;; swap is deprecated on the Sparc V9
1069 (define-f3-inst swap #b11 #b001111 :load-store t)
1071 (define-f3-inst add #b10 #b000000 :fixup t)
1072 (define-f3-inst addcc #b10 #b010000 :writes :psr)
1073 (define-f3-inst addx #b10 #b001000 :reads :psr)
1074 (define-f3-inst addxcc #b10 #b011000 :reads :psr :writes :psr)
1075 (define-f3-inst taddcc #b10 #b100000 :writes :psr)
1077 ;; taddcctv is deprecated on the Sparc V9. Use taddcc and bpvs or
1078 ;; taddcc and trap to get a similar effect. (Requires changing the C
1080 ;;(define-f3-inst taddcctv #b10 #b100010 :writes :psr)
1082 (define-f3-inst sub #b10 #b000100)
1083 (define-f3-inst subcc #b10 #b010100 :writes :psr)
1084 (define-f3-inst subx #b10 #b001100 :reads :psr)
1085 (define-f3-inst subxcc #b10 #b011100 :reads :psr :writes :psr)
1086 (define-f3-inst tsubcc #b10 #b100001 :writes :psr)
1088 ;; tsubcctv is deprecated on the Sparc V9. Use tsubcc and bpvs or
1089 ;; tsubcc and trap to get a similar effect. (Requires changing the C
1091 ;;(define-f3-inst tsubcctv #b10 #b100011 :writes :psr)
1093 (define-f3-inst mulscc #b10 #b100100 :reads :y :writes (:psr :y))
1094 (define-f3-inst and #b10 #b000001)
1095 (define-f3-inst andcc #b10 #b010001 :writes :psr)
1096 (define-f3-inst andn #b10 #b000101)
1097 (define-f3-inst andncc #b10 #b010101 :writes :psr)
1098 (define-f3-inst or #b10 #b000010)
1099 (define-f3-inst orcc #b10 #b010010 :writes :psr)
1100 (define-f3-inst orn #b10 #b000110)
1101 (define-f3-inst orncc #b10 #b010110 :writes :psr)
1102 (define-f3-inst xor #b10 #b000011)
1103 (define-f3-inst xorcc #b10 #b010011 :writes :psr)
1104 (define-f3-inst xnor #b10 #b000111)
1105 (define-f3-inst xnorcc #b10 #b010111 :writes :psr)
1107 (define-f3-shift-inst sll #b10 #b100101)
1108 (define-f3-shift-inst srl #b10 #b100110)
1109 (define-f3-shift-inst sra #b10 #b100111)
1110 (define-f3-shift-inst sllx #b10 #b100101 :extended t) ; v9
1111 (define-f3-shift-inst srlx #b10 #b100110 :extended t) ; v9
1112 (define-f3-shift-inst srax #b10 #b100111 :extended t) ; v9
1114 (define-f3-inst save #b10 #b111100 :reads :psr :writes :psr)
1115 (define-f3-inst restore #b10 #b111101 :reads :psr :writes :psr)
1117 ;; smul, smulcc, umul, umulcc, sdiv, sdivcc, udiv, and udivcc are
1118 ;; deprecated on the Sparc V9. Use mulx, sdivx, and udivx instead.
1119 (define-f3-inst smul #b10 #b001011 :writes :y) ; v8
1120 (define-f3-inst smulcc #b10 #b011011 :writes (:psr :y)) ; v8
1121 (define-f3-inst umul #b10 #b001010 :writes :y) ; v8
1122 (define-f3-inst umulcc #b10 #b011010 :writes (:psr :y)) ; v8
1123 (define-f3-inst sdiv #b10 #b001111 :reads :y) ; v8
1124 (define-f3-inst sdivcc #b10 #b011111 :reads :y :writes :psr) ; v8
1125 (define-f3-inst udiv #b10 #b001110 :reads :y) ; v8
1126 (define-f3-inst udivcc #b10 #b011110 :reads :y :writes :psr) ; v8
1128 (define-f3-inst mulx #b10 #b001001) ; v9 for both signed and unsigned
1129 (define-f3-inst sdivx #b10 #b101101) ; v9
1130 (define-f3-inst udivx #b10 #b001101) ; v9
1132 (define-f3-inst popc #b10 #b101110) ; v9: count one bits
1137 ;;;; Random instructions.
1139 ;; ldfsr is deprecated on the Sparc V9. Use ldxfsr instead
1140 (define-instruction ldfsr (segment src1 src2)
1141 (:declare (type tn src1) (type (signed-byte 13) src2))
1142 (:printer format-3-immed ((op #b11) (op3 #b100001) (rd 0)))
1145 (:emitter (emit-format-3-immed segment #b11 0 #b100001
1146 (reg-tn-encoding src1) 1 src2)))
1149 (define-instruction ldxfsr (segment src1 src2)
1150 (:declare (type tn src1) (type (signed-byte 13) src2))
1151 (:printer format-3-immed ((op #b11) (op3 #b100001) (rd 1))
1152 '(:name :tab "[" rs1 (:unless (:constant 0) "+" immed) "], %FSR")
1156 (:emitter (emit-format-3-immed segment #b11 1 #b100001
1157 (reg-tn-encoding src1) 1 src2)))
1159 ;; stfsr is deprecated on the Sparc V9. Use stxfsr instead.
1160 (define-instruction stfsr (segment src1 src2)
1161 (:declare (type tn src1) (type (signed-byte 13) src2))
1162 (:printer format-3-immed ((op #b11) (op3 #b100101) (rd 0)))
1165 (:emitter (emit-format-3-immed segment #b11 0 #b100101
1166 (reg-tn-encoding src1) 1 src2)))
1169 (define-instruction stxfsr (segment src1 src2)
1170 (:declare (type tn src1) (type (signed-byte 13) src2))
1171 (:printer format-3-immed ((op #b11) (op3 #b100101) (rd 1))
1172 '(:name :tab "%FSR, [" rs1 "+" (:unless (:constant 0) "+" immed) "]")
1176 (:emitter (emit-format-3-immed segment #b11 1 #b100101
1177 (reg-tn-encoding src1) 1 src2)))
1179 (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
1180 (defun sethi-arg-printer (value stream dstate)
1181 (format stream "%hi(#x~8,'0x)" (ash value 10))
1182 ;; Save the immediate value and the destination register from this
1183 ;; sethi instruction. This is used later to print some possible
1184 ;; notes about the value loaded by sethi.
1185 (let* ((word (sb!disassem::sap-ref-int (sb!disassem::dstate-segment-sap dstate)
1186 (sb!disassem::dstate-cur-offs dstate)
1188 (sb!disassem::dstate-byte-order dstate)))
1189 (imm22 (ldb (byte 22 0) word))
1190 (rd (ldb (byte 5 25) word)))
1191 (push (cons rd imm22) *note-sethi-inst*)))
1195 (define-instruction sethi (segment dst src1)
1196 (:declare (type tn dst)
1197 (type (or (signed-byte 22) (unsigned-byte 22) fixup) src1))
1198 (:printer format-2-immed
1199 ((op2 #b100) (immed nil :printer #'sethi-arg-printer)))
1200 (:dependencies (writes dst))
1205 (emit-format-2-immed segment #b00 (reg-tn-encoding dst) #b100
1208 (note-fixup segment :sethi src1)
1209 (emit-format-2-immed segment #b00 (reg-tn-encoding dst) #b100 0)))))
1211 ;; rdy is deprecated on the Sparc V9. It's not needed with 64-bit
1213 (define-instruction rdy (segment dst)
1214 (:declare (type tn dst))
1215 (:printer format-3-immed ((op #b10) (op3 #b101000) (rs1 0) (immed 0))
1216 '('RD :tab '%Y ", " rd))
1217 (:dependencies (reads :y) (writes dst))
1219 (:emitter (emit-format-3-immed segment #b10 (reg-tn-encoding dst) #b101000
1222 (defconstant-eqx wry-printer
1223 '('WR :tab rs1 (:unless (:constant 0) ", " (:choose immed rs2)) ", " '%Y)
1226 ;; wry is deprecated on the Sparc V9. It's not needed with 64-bit
1228 (define-instruction wry (segment src1 &optional src2)
1229 (:declare (type tn src1) (type (or (signed-byte 13) tn null) src2))
1230 (:printer format-3-reg ((op #b10) (op3 #b110000) (rd 0)) wry-printer)
1231 (:printer format-3-immed ((op #b10) (op3 #b110000) (rd 0)) wry-printer)
1232 (:dependencies (reads src1) (if src2 (reads src2)) (writes :y))
1237 (emit-format-3-reg segment #b10 0 #b110000 (reg-tn-encoding src1) 0 0 0))
1239 (emit-format-3-reg segment #b10 0 #b110000 (reg-tn-encoding src1) 0 0
1240 (reg-tn-encoding src2)))
1242 (emit-format-3-immed segment #b10 0 #b110000 (reg-tn-encoding src1) 1
1245 (defun snarf-error-junk (sap offset &optional length-only)
1246 (let* ((length (sb!sys:sap-ref-8 sap offset))
1247 (vector (make-array length :element-type '(unsigned-byte 8))))
1248 (declare (type sb!sys:system-area-pointer sap)
1249 (type (unsigned-byte 8) length)
1250 (type (simple-array (unsigned-byte 8) (*)) vector))
1252 (values 0 (1+ length) nil nil))
1254 (sb!kernel:copy-from-system-area sap (* n-byte-bits (1+ offset))
1255 vector (* n-word-bits
1257 (* length n-byte-bits))
1258 (collect ((sc-offsets)
1260 (lengths 1) ; the length byte
1262 (error-number (sb!c:read-var-integer vector index)))
1265 (when (>= index length)
1267 (let ((old-index index))
1268 (sc-offsets (sb!c:read-var-integer vector index))
1269 (lengths (- index old-index))))
1270 (values error-number
1275 (defun unimp-control (chunk inst stream dstate)
1276 (declare (ignore inst))
1277 (flet ((nt (x) (if stream (sb!disassem:note x dstate))))
1278 (case (format-2-unimp-data chunk dstate)
1281 (sb!disassem:handle-break-args #'snarf-error-junk stream dstate))
1284 (sb!disassem:handle-break-args #'snarf-error-junk stream dstate))
1285 (#.object-not-list-trap
1286 (nt "Object not list trap"))
1288 (nt "Breakpoint trap"))
1289 (#.pending-interrupt-trap
1290 (nt "Pending interrupt trap"))
1293 (#.fun-end-breakpoint-trap
1294 (nt "Function end breakpoint trap"))
1295 (#.object-not-instance-trap
1296 (nt "Object not instance trap"))
1299 (define-instruction unimp (segment data)
1300 (:declare (type (unsigned-byte 22) data))
1301 (:printer format-2-unimp () :default :control #'unimp-control
1302 :print-name #!-sparc-v9 'unimp #!+sparc-v9 'illtrap)
1304 (:emitter (emit-format-2-unimp segment 0 0 0 data)))
1308 ;;;; Branch instructions.
1310 ;; The branch instruction is deprecated on the Sparc V9. Use the
1311 ;; branch with prediction instructions instead.
1312 (defun emit-relative-branch (segment a op2 cond-or-target target &optional fp)
1313 (emit-back-patch segment 4
1314 (lambda (segment posn)
1316 (setf target cond-or-target)
1317 (setf cond-or-target :t))
1318 (emit-format-2-branch
1321 (fp-branch-condition cond-or-target)
1322 (branch-condition cond-or-target))
1324 (let ((offset (ash (- (label-position target) posn) -2)))
1325 (when (and (= a 1) (> 0 offset))
1326 (error "Offset of BA must be positive"))
1330 (defun emit-relative-branch-integer (segment a op2 cond-or-target target &optional (cc :icc) (pred :pt))
1331 (declare (type integer-condition-register cc))
1332 (emit-back-patch segment 4
1333 (lambda (segment posn)
1335 (setf target cond-or-target)
1336 (setf cond-or-target :t))
1337 (emit-format-2-branch-pred
1339 (branch-condition cond-or-target)
1341 (integer-condition cc)
1342 (branch-prediction pred)
1343 (let ((offset (ash (- (label-position target) posn) -2)))
1344 (when (and (= a 1) (> 0 offset))
1345 (error "Offset of BA must be positive"))
1349 (defun emit-relative-branch-fp (segment a op2 cond-or-target target &optional (cc :fcc0) (pred :pt))
1350 (emit-back-patch segment 4
1351 (lambda (segment posn)
1353 (setf target cond-or-target)
1354 (setf cond-or-target :t))
1355 (emit-format-2-branch-pred
1357 (fp-branch-condition cond-or-target)
1360 (branch-prediction pred)
1361 (let ((offset (ash (- (label-position target) posn) -2)))
1362 (when (and (= a 1) (> 0 offset))
1363 (error "Offset of BA must be positive"))
1366 ;; So that I don't have to go change the syntax of every single use of
1367 ;; branches, I'm keeping the Lisp instruction names the same. They
1368 ;; just get translated to the branch with prediction
1369 ;; instructions. However, the disassembler uses the correct V9
1372 (define-instruction b (segment cond-or-target &optional target)
1373 (:declare (type (or label branch-condition) cond-or-target)
1374 (type (or label null) target))
1375 (:printer format-2-branch ((op #b00) (op2 #b010)))
1376 (:attributes branch)
1377 (:dependencies (reads :psr))
1380 (emit-relative-branch segment 0 #b010 cond-or-target target)))
1383 (define-instruction b (segment cond-or-target &optional target pred cc)
1384 (:declare (type (or label branch-condition) cond-or-target)
1385 (type (or label null) target))
1386 (:printer format-2-branch-pred ((op #b00) (op2 #b001))
1389 (:attributes branch)
1390 (:dependencies (reads :psr))
1393 (emit-relative-branch-integer segment 0 #b001 cond-or-target target (or cc :icc) (or pred :pt))))
1396 (define-instruction ba (segment cond-or-target &optional target)
1397 (:declare (type (or label branch-condition) cond-or-target)
1398 (type (or label null) target))
1399 (:printer format-2-branch ((op #b00) (op2 #b010) (a 1))
1402 (:attributes branch)
1403 (:dependencies (reads :psr))
1406 (emit-relative-branch segment 1 #b010 cond-or-target target)))
1409 (define-instruction ba (segment cond-or-target &optional target pred cc)
1410 (:declare (type (or label branch-condition) cond-or-target)
1411 (type (or label null) target))
1412 (:printer format-2-branch ((op #b00) (op2 #b001) (a 1))
1415 (:attributes branch)
1416 (:dependencies (reads :psr))
1419 (emit-relative-branch-integer segment 1 #b001 cond-or-target target (or cc :icc) (or pred :pt))))
1421 ;; This doesn't cover all of the possible formats for the trap
1422 ;; instruction. We really only want a trap with a immediate trap
1423 ;; value and with RS1 = register 0. Also, the Sparc Compliance
1424 ;; Definition 2.4.1 says only trap numbers 16-31 are allowed for user
1425 ;; code. All other trap numbers have other uses. The restriction on
1426 ;; target will prevent us from using bad trap numbers by mistake.
1428 (define-instruction t (segment condition target)
1429 (:declare (type branch-condition condition)
1432 (type (integer 16 31) target))
1433 (:printer format-3-immed ((op #b10)
1434 (rd nil :type 'branch-condition)
1437 '(:name rd :tab immed))
1438 (:attributes branch)
1439 (:dependencies (reads :psr))
1441 (:emitter (emit-format-3-immed segment #b10 (branch-condition condition)
1442 #b111010 0 1 target)))
1445 (define-instruction t (segment condition target &optional (cc #!-sparc-64 :icc #!+sparc-64 :xcc))
1446 (:declare (type branch-condition condition)
1448 (type (integer 16 31) target)
1449 (type integer-condition-register cc))
1450 (:printer format-4-trap ((op #b10)
1451 (rd nil :type 'branch-condition)
1455 (:attributes branch)
1456 (:dependencies (reads :psr))
1458 (:emitter (emit-format-4-trap segment
1460 (branch-condition condition)
1462 (integer-condition cc)
1465 ;; Same as for the branch instructions. On the Sparc V9, we will use
1466 ;; the FP branch with prediction instructions instead.
1468 (define-instruction fb (segment condition target)
1469 (:declare (type fp-branch-condition condition) (type label target))
1470 (:printer format-2-branch ((op #B00)
1471 (cond nil :type 'branch-fp-condition)
1473 (:attributes branch)
1474 (:dependencies (reads :fsr))
1477 (emit-relative-branch segment 0 #b110 condition target t)))
1480 (define-instruction fb (segment condition target &optional fcc pred)
1481 (:declare (type fp-branch-condition condition) (type label target))
1482 (:printer format-2-fp-branch-pred ((op #b00) (op2 #b101))
1483 fp-branch-pred-printer
1485 (:attributes branch)
1486 (:dependencies (reads :fsr))
1489 (emit-relative-branch-fp segment 0 #b101 condition target (or fcc :fcc0) (or pred :pt))))
1491 (defconstant-eqx jal-printer
1493 (:choose (rs1 (:unless (:constant 0) (:plus-integer immed)))
1494 (:cond ((rs2 :constant 0) rs1)
1495 ((rs1 :constant 0) rs2)
1497 (:unless (:constant 0) ", " rd))
1500 (define-instruction jal (segment dst src1 &optional src2)
1501 (:declare (type tn dst)
1502 (type (or tn integer) src1)
1503 (type (or null fixup tn (signed-byte 13)) src2))
1504 (:printer format-3-reg ((op #b10) (op3 #b111000)) jal-printer)
1505 (:printer format-3-immed ((op #b10) (op3 #b111000)) jal-printer)
1506 (:attributes branch)
1507 (:dependencies (reads src1) (if src2 (reads src2) (reads dst)) (writes dst))
1515 (emit-format-3-reg segment #b10 (reg-tn-encoding dst) #b111000
1518 (reg-tn-encoding src1))
1519 0 0 (reg-tn-encoding src2)))
1521 (emit-format-3-immed segment #b10 (reg-tn-encoding dst) #b111000
1522 (reg-tn-encoding src1) 1 src2))
1524 (note-fixup segment :add src2)
1525 (emit-format-3-immed segment #b10 (reg-tn-encoding dst)
1526 #b111000 (reg-tn-encoding src1) 1 0)))))
1528 (define-instruction j (segment src1 &optional src2)
1529 (:declare (type tn src1) (type (or tn (signed-byte 13) fixup null) src2))
1530 (:printer format-3-reg ((op #b10) (op3 #b111000) (rd 0)) jal-printer)
1531 (:printer format-3-immed ((op #b10) (op3 #b111000) (rd 0)) jal-printer)
1532 (:attributes branch)
1533 (:dependencies (reads src1) (if src2 (reads src2)))
1538 (emit-format-3-reg segment #b10 0 #b111000 (reg-tn-encoding src1) 0 0 0))
1540 (emit-format-3-reg segment #b10 0 #b111000 (reg-tn-encoding src1) 0 0
1541 (reg-tn-encoding src2)))
1543 (emit-format-3-immed segment #b10 0 #b111000 (reg-tn-encoding src1) 1
1546 (note-fixup segment :add src2)
1547 (emit-format-3-immed segment #b10 0 #b111000 (reg-tn-encoding src1) 1
1552 ;;;; Unary and binary fp insts.
1554 (macrolet ((define-unary-fp-inst (name opf &key reads extended)
1555 `(define-instruction ,name (segment dst src)
1556 (:declare (type tn dst src))
1557 (:printer format-unary-fpop
1558 ((op #b10) (op3 #b110100) (opf ,opf)
1560 (rs2 nil :type ',(if extended 'fp-ext-reg 'fp-reg))
1561 (rd nil :type ',(if extended 'fp-ext-reg 'fp-reg))))
1569 (:emitter (emit-format-3-fpop segment #b10 (fp-reg-tn-encoding dst)
1570 #b110100 0 ,opf (fp-reg-tn-encoding src)))))
1572 (define-binary-fp-inst (name opf &key (op3 #b110100)
1573 reads writes delay extended)
1574 `(define-instruction ,name (segment dst src1 src2)
1575 (:declare (type tn dst src1 src2))
1576 (:printer format-binary-fpop
1577 ((op #b10) (op3 ,op3) (opf ,opf)
1578 (rs1 nil :type ',(if extended 'fp-ext-reg 'fp-reg))
1579 (rs2 nil :type ',(if extended 'fp-ext-reg 'fp-reg))
1580 (rd nil :type ',(if extended 'fp-ext-reg 'fp-reg))
1588 `((writes ,writes)))
1593 (:emitter (emit-format-3-fpop segment #b10 (fp-reg-tn-encoding dst)
1594 ,op3 (fp-reg-tn-encoding src1) ,opf
1595 (fp-reg-tn-encoding src2)))))
1597 (define-cmp-fp-inst (name opf &key extended)
1601 `(define-instruction ,name (segment src1 src2 &optional (fcc :fcc0))
1602 (:declare (type tn src1 src2)
1603 (type (member :fcc0 :fcc1 :fcc2 :fcc3) fcc))
1604 (:printer format-fpop2
1611 (rs1 nil :type ',(if extended 'fp-ext-reg 'fp-reg))
1612 (rs2 nil :type ',(if extended 'fp-ext-reg 'fp-reg))
1616 (rd nil :type 'fp-condition-register))
1622 ;; The Sparc V9 doesn't need a delay after a FP compare.
1623 (:delay #!-sparc-v9 1 #!+sparc-v9 0)
1625 (emit-format-3-fpop2 segment #b10
1626 (or (position fcc '(:fcc0 :fcc1 :fcc2 :fcc3))
1629 (fp-reg-tn-encoding src1)
1630 ,opf0 ,opf1 ,opf2 ,opf
1631 (fp-reg-tn-encoding src2)))))))
1633 (define-unary-fp-inst fitos #b011000100 :reads :fsr)
1634 (define-unary-fp-inst fitod #b011001000 :reads :fsr :extended t)
1635 (define-unary-fp-inst fitoq #b011001100 :reads :fsr :extended t) ; v8
1637 (define-unary-fp-inst fxtos #b010000100 :reads :fsr) ; v9
1638 (define-unary-fp-inst fxtod #b010001000 :reads :fsr :extended t) ; v9
1639 (define-unary-fp-inst fxtoq #b010001100 :reads :fsr :extended t) ; v9
1642 ;; I (toy@rtp.ericsson.se) don't think these f{sd}toir instructions
1643 ;; exist on any Ultrasparc, but I only have a V9 manual. The code in
1644 ;; float.lisp seems to indicate that they only existed on non-sun4
1645 ;; machines (sun3 68K machines?).
1646 (define-unary-fp-inst fstoir #b011000001 :reads :fsr)
1647 (define-unary-fp-inst fdtoir #b011000010 :reads :fsr)
1649 (define-unary-fp-inst fstoi #b011010001)
1650 (define-unary-fp-inst fdtoi #b011010010 :extended t)
1651 (define-unary-fp-inst fqtoi #b011010011 :extended t) ; v8
1653 (define-unary-fp-inst fstox #b010000001) ; v9
1654 (define-unary-fp-inst fdtox #b010000010 :extended t) ; v9
1655 (define-unary-fp-inst fqtox #b010000011 :extended t) ; v9
1657 (define-unary-fp-inst fstod #b011001001 :reads :fsr)
1658 (define-unary-fp-inst fstoq #b011001101 :reads :fsr) ; v8
1659 (define-unary-fp-inst fdtos #b011000110 :reads :fsr)
1660 (define-unary-fp-inst fdtoq #b011001110 :reads :fsr) ; v8
1661 (define-unary-fp-inst fqtos #b011000111 :reads :fsr) ; v8
1662 (define-unary-fp-inst fqtod #b011001011 :reads :fsr) ; v8
1664 (define-unary-fp-inst fmovs #b000000001)
1665 (define-unary-fp-inst fmovd #b000000010 :extended t) ; v9
1666 (define-unary-fp-inst fmovq #b000000011 :extended t) ; v9
1668 (define-unary-fp-inst fnegs #b000000101)
1669 (define-unary-fp-inst fnegd #b000000110 :extended t) ; v9
1670 (define-unary-fp-inst fnegq #b000000111 :extended t) ; v9
1672 (define-unary-fp-inst fabss #b000001001)
1673 (define-unary-fp-inst fabsd #b000001010 :extended t) ; v9
1674 (define-unary-fp-inst fabsq #b000001011 :extended t) ; v9
1676 (define-unary-fp-inst fsqrts #b000101001 :reads :fsr) ; V7
1677 (define-unary-fp-inst fsqrtd #b000101010 :reads :fsr :extended t) ; V7
1678 (define-unary-fp-inst fsqrtq #b000101011 :reads :fsr :extended t) ; v8
1680 (define-binary-fp-inst fadds #b001000001)
1681 (define-binary-fp-inst faddd #b001000010 :extended t)
1682 (define-binary-fp-inst faddq #b001000011 :extended t) ; v8
1683 (define-binary-fp-inst fsubs #b001000101)
1684 (define-binary-fp-inst fsubd #b001000110 :extended t)
1685 (define-binary-fp-inst fsubq #b001000111 :extended t) ; v8
1687 (define-binary-fp-inst fmuls #b001001001)
1688 (define-binary-fp-inst fmuld #b001001010 :extended t)
1689 (define-binary-fp-inst fmulq #b001001011 :extended t) ; v8
1690 (define-binary-fp-inst fdivs #b001001101)
1691 (define-binary-fp-inst fdivd #b001001110 :extended t)
1692 (define-binary-fp-inst fdivq #b001001111 :extended t) ; v8
1694 ;;; Float comparison instructions.
1696 (define-cmp-fp-inst fcmps #b0001)
1697 (define-cmp-fp-inst fcmpd #b0010 :extended t)
1698 (define-cmp-fp-inst fcmpq #b0011 :extended t) ;v8
1699 (define-cmp-fp-inst fcmpes #b0101)
1700 (define-cmp-fp-inst fcmped #b0110 :extended t)
1701 (define-cmp-fp-inst fcmpeq #b0111 :extended t) ; v8
1705 ;;;; li, jali, ji, nop, cmp, not, neg, move, and more
1707 (defun %li (reg value)
1710 (inst add reg zero-tn value))
1711 ((or (signed-byte 32) (unsigned-byte 32))
1712 (let ((hi (ldb (byte 22 10) value))
1713 (lo (ldb (byte 10 0) value)))
1716 (inst add reg lo))))
1718 (inst sethi reg value)
1719 (inst add reg value))))
1721 (define-instruction-macro li (reg value)
1724 ;;; Jal to a full 32-bit address. Tmpreg is trashed.
1725 (define-instruction jali (segment link tmpreg value)
1726 (:declare (type tn link tmpreg)
1727 (type (or (signed-byte 13) (signed-byte 32) (unsigned-byte 32)
1729 (:attributes variable-length)
1731 (:attributes branch)
1732 (:dependencies (writes link) (writes tmpreg))
1735 (assemble (segment vop)
1738 (inst jal link zero-tn value))
1739 ((or (signed-byte 32) (unsigned-byte 32))
1740 (let ((hi (ldb (byte 22 10) value))
1741 (lo (ldb (byte 10 0) value)))
1742 (inst sethi tmpreg hi)
1743 (inst jal link tmpreg lo)))
1745 (inst sethi tmpreg value)
1746 (inst jal link tmpreg value))))))
1748 ;;; Jump to a full 32-bit address. Tmpreg is trashed.
1749 (define-instruction ji (segment tmpreg value)
1750 (:declare (type tn tmpreg)
1751 (type (or (signed-byte 13) (signed-byte 32) (unsigned-byte 32)
1753 (:attributes variable-length)
1755 (:attributes branch)
1756 (:dependencies (writes tmpreg))
1759 (assemble (segment vop)
1760 (inst jali zero-tn tmpreg value))))
1762 (define-instruction nop (segment)
1763 (:printer format-2-immed ((rd 0) (op2 #b100) (immed 0)) '(:name))
1764 (:attributes flushable)
1766 (:emitter (emit-format-2-immed segment 0 0 #b100 0)))
1768 (!def-vm-support-routine emit-nop (segment)
1769 (emit-format-2-immed segment 0 0 #b100 0))
1771 (define-instruction cmp (segment src1 &optional src2)
1772 (:declare (type tn src1) (type (or null tn (signed-byte 13)) src2))
1773 (:printer format-3-reg ((op #b10) (op3 #b010100) (rd 0))
1774 '(:name :tab rs1 ", " rs2))
1775 (:printer format-3-immed ((op #b10) (op3 #b010100) (rd 0))
1776 '(:name :tab rs1 ", " immed))
1777 (:dependencies (reads src1) (if src2 (reads src2)) (writes :psr))
1782 (emit-format-3-reg segment #b10 0 #b010100 (reg-tn-encoding src1) 0 0 0))
1784 (emit-format-3-reg segment #b10 0 #b010100 (reg-tn-encoding src1) 0 0
1785 (reg-tn-encoding src2)))
1787 (emit-format-3-immed segment #b10 0 #b010100 (reg-tn-encoding src1) 1
1790 (define-instruction not (segment dst &optional src1)
1791 (:declare (type tn dst) (type (or tn null) src1))
1792 (:printer format-3-reg ((op #b10) (op3 #b000111) (rs2 0))
1793 '(:name :tab (:unless (:same-as rd) rs1 ", " ) rd))
1794 (:dependencies (if src1 (reads src1) (reads dst)) (writes dst))
1799 (emit-format-3-reg segment #b10 (reg-tn-encoding dst) #b000111
1800 (reg-tn-encoding src1) 0 0 0)))
1802 (define-instruction neg (segment dst &optional src1)
1803 (:declare (type tn dst) (type (or tn null) src1))
1804 (:printer format-3-reg ((op #b10) (op3 #b000100) (rs1 0))
1805 '(:name :tab (:unless (:same-as rd) rs2 ", " ) rd))
1806 (:dependencies (if src1 (reads src1) (reads dst)) (writes dst))
1811 (emit-format-3-reg segment #b10 (reg-tn-encoding dst) #b000100
1812 0 0 0 (reg-tn-encoding src1))))
1814 (define-instruction move (segment dst src1)
1815 (:declare (type tn dst src1))
1816 (:printer format-3-reg ((op #b10) (op3 #b000010) (rs1 0))
1817 '(:name :tab rs2 ", " rd)
1819 (:attributes flushable)
1820 (:dependencies (reads src1) (writes dst))
1822 (:emitter (emit-format-3-reg segment #b10 (reg-tn-encoding dst) #b000010
1823 0 0 0 (reg-tn-encoding src1))))
1827 ;;;; Instructions for dumping data and header objects.
1829 (define-instruction word (segment word)
1830 (:declare (type (or (unsigned-byte 32) (signed-byte 32)) word))
1834 (emit-word segment word)))
1836 (define-instruction short (segment short)
1837 (:declare (type (or (unsigned-byte 16) (signed-byte 16)) short))
1841 (emit-short segment short)))
1843 (define-instruction byte (segment byte)
1844 (:declare (type (or (unsigned-byte 8) (signed-byte 8)) byte))
1848 (emit-byte segment byte)))
1850 (define-bitfield-emitter emit-header-object 32
1851 (byte 24 8) (byte 8 0))
1853 (defun emit-header-data (segment type)
1856 (lambda (segment posn)
1859 (ash (+ posn (component-header-length))
1860 (- n-widetag-bits word-shift)))))))
1862 (define-instruction simple-fun-header-word (segment)
1866 (emit-header-data segment simple-fun-header-widetag)))
1868 (define-instruction lra-header-word (segment)
1872 (emit-header-data segment return-pc-header-widetag)))
1875 ;;;; Instructions for converting between code objects, functions, and lras.
1877 (defun emit-compute-inst (segment vop dst src label temp calc)
1879 ;; We emit either 12 or 4 bytes, so we maintain 8 byte alignments.
1881 (lambda (segment posn delta-if-after)
1882 (let ((delta (funcall calc label posn delta-if-after)))
1883 (when (<= (- (ash 1 12)) delta (1- (ash 1 12)))
1884 (emit-back-patch segment 4
1885 (lambda (segment posn)
1886 (assemble (segment vop)
1888 (funcall calc label posn 0)))))
1890 (lambda (segment posn)
1891 (let ((delta (funcall calc label posn 0)))
1892 (assemble (segment vop)
1893 (inst sethi temp (ldb (byte 22 10) delta))
1894 (inst or temp (ldb (byte 10 0) delta))
1895 (inst add dst src temp))))))
1897 ;; code = fn - fn-ptr-type - header - label-offset + other-pointer-tag
1898 (define-instruction compute-code-from-fn (segment dst src label temp)
1899 (:declare (type tn dst src temp) (type label label))
1900 (:attributes variable-length)
1901 (:dependencies (reads src) (writes dst) (writes temp))
1905 (emit-compute-inst segment vop dst src label temp
1906 (lambda (label posn delta-if-after)
1907 (- other-pointer-lowtag
1909 (label-position label posn delta-if-after)
1910 (component-header-length))))))
1912 ;; code = lra - other-pointer-tag - header - label-offset + other-pointer-tag
1913 (define-instruction compute-code-from-lra (segment dst src label temp)
1914 (:declare (type tn dst src temp) (type label label))
1915 (:attributes variable-length)
1916 (:dependencies (reads src) (writes dst) (writes temp))
1920 (emit-compute-inst segment vop dst src label temp
1921 (lambda (label posn delta-if-after)
1922 (- (+ (label-position label posn delta-if-after)
1923 (component-header-length)))))))
1925 ;; lra = code + other-pointer-tag + header + label-offset - other-pointer-tag
1926 (define-instruction compute-lra-from-code (segment dst src label temp)
1927 (:declare (type tn dst src temp) (type label label))
1928 (:attributes variable-length)
1929 (:dependencies (reads src) (writes dst) (writes temp))
1933 (emit-compute-inst segment vop dst src label temp
1934 (lambda (label posn delta-if-after)
1935 (+ (label-position label posn delta-if-after)
1936 (component-header-length))))))
1938 ;;; Sparc V9 additions
1942 ;; Conditional move integer on condition code
1943 (define-instruction cmove (segment condition dst src &optional (ccreg :icc))
1944 (:declare (type (or branch-condition fp-branch-condition) condition)
1945 (type cond-move-condition-register ccreg)
1947 (type (or (signed-byte 13) tn) src))
1948 (:printer format-4-cond-move
1953 (cc nil :type 'integer-condition-register))
1956 (:printer format-4-cond-move-immed
1961 (cc nil :type 'integer-condition-register))
1964 (:printer format-4-cond-move
1968 (cond nil :type 'branch-fp-condition)
1970 (cc nil :type 'fp-condition-register))
1973 (:printer format-4-cond-move-immed
1977 (cond nil :type 'branch-fp-condition)
1979 (cc nil :type 'fp-condition-register))
1984 (if (member ccreg '(:icc :xcc))
1993 (multiple-value-bind (cc2 cc01)
1994 (cond-move-condition-parts ccreg)
1997 (emit-format-4-cond-move segment
1999 (reg-tn-encoding dst)
2002 (if (member ccreg '(:icc :xcc))
2003 (branch-condition condition)
2004 (fp-branch-condition condition))
2007 (reg-tn-encoding src)))
2009 (emit-format-4-cond-move segment
2011 (reg-tn-encoding dst)
2014 (if (member ccreg '(:icc :xcc))
2015 (branch-condition condition)
2016 (fp-branch-condition condition))
2021 ;; Conditional move floating-point on condition codes
2022 (macrolet ((define-cond-fp-move (name print-name op op3 opf_low &key extended)
2023 `(define-instruction ,name (segment condition dst src &optional (ccreg :fcc0))
2024 (:declare (type (or branch-condition fp-branch-condition) condition)
2025 (type cond-move-condition-register ccreg)
2027 (:printer format-fpop2
2031 (opf1 nil :type 'fp-condition-register-shifted)
2034 (rs1 nil :type 'branch-fp-condition)
2035 (rs2 nil :type ',(if extended 'fp-ext-reg 'fp-reg))
2036 (rd nil :type ',(if extended 'fp-ext-reg 'fp-reg)))
2037 cond-fp-move-printer
2038 :print-name ',print-name)
2039 (:printer format-fpop2
2043 (opf1 nil :type 'integer-condition-register)
2045 (rs1 nil :type 'branch-condition)
2047 (rs2 nil :type ',(if extended 'fp-ext-reg 'fp-reg))
2048 (rd nil :type ',(if extended 'fp-ext-reg 'fp-reg)))
2049 cond-fp-move-printer
2050 :print-name ',print-name)
2053 (if (member ccreg '(:icc :xcc))
2060 (multiple-value-bind (opf_cc2 opf_cc01)
2061 (cond-move-condition-parts ccreg)
2062 (emit-format-3-fpop2 segment
2064 (fp-reg-tn-encoding dst)
2066 (if (member ccreg '(:icc :xcc))
2067 (branch-condition condition)
2068 (fp-branch-condition condition))
2073 (fp-reg-tn-encoding src)))))))
2074 (define-cond-fp-move cfmovs fmovs #b10 #b110101 #b0001)
2075 (define-cond-fp-move cfmovd fmovd #b10 #b110101 #b0010 :extended t)
2076 (define-cond-fp-move cfmovq fmovq #b10 #b110101 #b0011 :extended t))
2079 ;; Move on integer register condition
2081 ;; movr dst src reg reg-cond
2083 ;; This means if reg satisfies reg-cond, src is copied to dst. If the
2084 ;; condition is not satisfied, nothing is done.
2086 (define-instruction movr (segment dst src2 src1 reg-condition)
2087 (:declare (type cond-move-integer-condition reg-condition)
2089 (type (or (signed-byte 10) tn) src2))
2090 (:printer format-4-cond-move-integer
2094 (:printer format-4-cond-move-integer-immed
2108 (emit-format-4-cond-move-integer
2109 segment #b10 (reg-tn-encoding dst) #b101111 (reg-tn-encoding src1)
2110 0 (register-condition reg-condition)
2111 0 (reg-tn-encoding src2)))
2113 (emit-format-4-cond-move-integer-immed
2114 segment #b10 (reg-tn-encoding dst) #b101111 (reg-tn-encoding src1)
2115 1 (register-condition reg-condition) src2)))))
2118 ;; Same as MOVR, except we move FP registers depending on the value of
2119 ;; an integer register.
2121 ;; fmovr dst src reg cond
2123 ;; This means if REG satifies COND, SRC is COPIED to DST. Nothing
2124 ;; happens if the condition is not satisfied.
2125 (macrolet ((define-cond-fp-move-integer (name opf_low &key extended)
2126 `(define-instruction ,name (segment dst src2 src1 reg-condition)
2127 (:declare (type cond-move-integer-condition reg-condition)
2128 (type tn dst src1 src2))
2129 (:printer format-fpop2
2131 (rd nil :type ',(if extended 'fp-ext-reg 'fp-reg))
2133 (rs1 nil :type 'reg)
2135 (opf1 nil :type 'register-condition)
2138 (rs2 nil :type ',(if extended 'fp-ext-reg 'fp-reg))
2140 cond-fp-move-integer-printer)
2148 (emit-format-3-fpop2
2151 (fp-reg-tn-encoding dst)
2153 (reg-tn-encoding src1)
2155 (register-condition reg-condition)
2158 (fp-reg-tn-encoding src2))))))
2159 (define-cond-fp-move-integer fmovrs #b0101)
2160 (define-cond-fp-move-integer fmovrd #b0110 :extended t)
2161 (define-cond-fp-move-integer fmovrq #b0111 :extended t))