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.
12 (in-package "SB!SPARC-ASM")
14 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
15 ;; Imports from this package into SB-VM
16 (import '(reg-tn-encoding) 'sb
!vm
)
17 ;; Imports from SB-VM into this package
18 (import '(;; SBs and SCs
19 sb
!vm
::zero sb
!vm
::immediate-constant
20 sb
!vm
::registers sb
!vm
::float-registers
21 sb
!vm
::control-registers
22 sb
!vm
::single-reg sb
!vm
::double-reg
25 sb
!vm
::zero-offset sb
!vm
::null-offset sb
!vm
::alloc-offset
)))
27 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
28 (setf *assem-scheduler-p
* t
)
29 (setf *assem-max-locations
* 100))
31 ;;; Constants, types, conversion functions, some disassembler stuff.
32 (defun reg-tn-encoding (tn)
33 (declare (type tn tn
))
38 (if (eq (sb-name (sc-sb (tn-sc tn
))) 'registers
)
40 (error "~S isn't a register." tn
)))))
42 (defun fp-reg-tn-encoding (tn)
43 (declare (type tn tn
))
44 (unless (eq (sb-name (sc-sb (tn-sc tn
))) 'float-registers
)
45 (error "~S isn't a floating-point register." tn
))
46 (let ((offset (tn-offset tn
)))
48 (aver (member :sparc-v9
*backend-subfeatures
*))
49 ;; No single register encoding greater than reg 31.
50 (aver (zerop (mod offset
2)))
51 ;; Upper bit of the register number is encoded in the low bit.
56 (defvar *disassem-use-lisp-reg-names
* t
57 "If non-NIL, print registers using the Lisp register names.
58 Otherwise, use the Sparc register names")
60 (defun location-number (loc)
66 (ecase (sb-name (sc-sb (tn-sc loc
)))
68 (unless (zerop (tn-offset loc
))
73 (+ (tn-offset loc
) 32))
75 (let ((offset (tn-offset loc
)))
76 (aver (zerop (mod offset
2)))
77 (values (+ offset
32) 2)))
80 (let ((offset (tn-offset loc
)))
81 (aver (zerop (mod offset
4)))
82 (values (+ offset
32) 4)))))
94 ;;; symbols used for disassembly printing
95 (defparameter reg-symbols
98 (cond ((null name
) nil
)
99 (t (make-symbol (concatenate 'string
"%" name
)))))
100 sb
!vm
::*register-names
*)
101 "The Lisp names for the Sparc integer registers")
103 (defparameter sparc-reg-symbols
104 #("%G0" "%G1" "%G2" "%G3" "%G4" "%G5" NIL NIL
105 "%O0" "%O1" "%O2" "%O3" "%O4" "%O5" "%O6" "%O7"
106 "%L0" "%L1" "%L2" "%L3" "%L4" "%L5" "%L6" "%L7"
107 "%I0" "%I1" "%I2" "%I3" "%I4" "%I5" NIL
"%I7")
108 "The standard names for the Sparc integer registers")
110 (defun get-reg-name (index)
111 (if *disassem-use-lisp-reg-names
*
112 (aref reg-symbols index
)
113 (aref sparc-reg-symbols index
)))
115 ;; FIXME: pathetic. DSTATE-PROPERTIES is the perfect place for this list.
116 (defvar *note-sethi-inst
* nil
117 "An alist for the disassembler indicating the target register and
118 value used in a SETHI instruction. This is used to make annotations
119 about function addresses and register values.")
121 (defvar *pseudo-atomic-set
* nil
)
123 (defun sign-extend-immed-value (val) ; FIXME: why reinvent SIGN-EXTEND ?
124 ;; val is a 13-bit signed number. Extend the sign appropriately.
130 :printer
(lambda (value stream dstate
)
131 (declare (stream stream
) (fixnum value
))
132 (let ((regname (get-reg-name value
)))
133 (princ regname stream
)
134 (maybe-note-associated-storage-ref
135 value
'registers regname dstate
)
136 (maybe-add-notes value dstate
))))
138 (defparameter float-reg-symbols
140 (loop for n from
0 to
63 collect
(make-symbol (format nil
"%F~d" n
)))
143 (define-arg-type fp-reg
144 :printer
(lambda (value stream dstate
)
145 (declare (stream stream
) (fixnum value
))
146 (let ((regname (aref float-reg-symbols value
)))
147 (princ regname stream
)
148 (maybe-note-associated-storage-ref
149 value
'float-registers regname dstate
))))
151 ;;; The extended 6 bit floating point register encoding for the double
152 ;;; and long instructions of the sparc v9.
153 (define-arg-type fp-ext-reg
154 :printer
(lambda (value stream dstate
)
155 (declare (stream stream
) (fixnum value
))
156 (let* (;; Decode the register number.
157 (value (if (oddp value
) (+ value
31) value
))
158 (regname (aref float-reg-symbols value
)))
159 (princ regname stream
)
160 (maybe-note-associated-storage-ref
161 value
'float-registers regname dstate
))))
163 (define-arg-type relative-label
165 :use-label
(lambda (value dstate
)
166 (declare (type (signed-byte 22) value
)
167 (type disassem-state dstate
))
168 (+ (ash value
2) (dstate-cur-addr dstate
))))
170 (defconstant-eqx branch-conditions
171 '(:f
:eq
:le
:lt
:leu
:ltu
:n
:vs
:t
:ne
:gt
:ge
:gtu
:geu
:p
:vc
)
174 ;;; Note that these aren't the standard names for branch-conditions, I
175 ;;; think they're a bit more readable (e.g., "eq" instead of "e").
176 ;;; You could just put a vector of the normal ones here too.
178 (define-arg-type branch-condition
:printer
(coerce branch-conditions
'vector
))
180 (deftype branch-condition
()
181 `(member ,@branch-conditions
))
183 (defun branch-condition (condition)
184 (or (position condition branch-conditions
)
185 (error "Unknown branch condition: ~S~%Must be one of: ~S"
186 condition branch-conditions
)))
188 (defconstant branch-cond-true
191 (defconstant-eqx branch-fp-conditions
192 '(:f
:ne
:lg
:ul
:l
:ug
:g
:u
:t
:eq
:ue
:ge
:uge
:le
:ule
:o
)
195 (define-arg-type branch-fp-condition
196 :printer
(coerce branch-fp-conditions
'vector
))
198 (define-arg-type call-fixup
:use-label t
)
200 (deftype fp-branch-condition
()
201 `(member ,@branch-fp-conditions
))
203 (defun fp-branch-condition (condition)
204 (or (position condition branch-fp-conditions
)
205 (error "Unknown fp-branch condition: ~S~%Must be one of: ~S"
206 condition branch-fp-conditions
)))
209 ;;;; dissassem:define-instruction-formats
211 (define-instruction-format
212 (format-1 32 :default-printer
'(:name
:tab disp
))
213 (op :field
(byte 2 30) :value
1)
214 (disp :field
(byte 30 0)))
216 (define-instruction-format
217 (format-2-immed 32 :default-printer
'(:name
:tab immed
", " rd
))
218 (op :field
(byte 2 30) :value
0)
219 (rd :field
(byte 5 25) :type
'reg
)
220 (op2 :field
(byte 3 22))
221 (immed :field
(byte 22 0)))
225 (define-instruction-format
226 (format-2-branch 32 :default-printer
`(:name
(:unless
(:constant
,branch-cond-true
) cond
)
227 (:unless
(a :constant
0) "," 'A
)
230 (op :field
(byte 2 30) :value
0)
231 (a :field
(byte 1 29) :value
0)
232 (cond :field
(byte 4 25) :type
'branch-condition
)
233 (op2 :field
(byte 3 22))
234 (disp :field
(byte 22 0) :type
'relative-label
))
236 ;; Branch with prediction instruction for V9
238 ;; Currently only %icc and %xcc are used of the four possible values
240 (defconstant-eqx integer-condition-registers
241 '(:icc
:reserved
:xcc
:reserved
)
244 (defconstant-eqx integer-cond-reg-name-vec
245 (coerce integer-condition-registers
'vector
)
248 (deftype integer-condition-register
()
249 `(member ,@(remove :reserved integer-condition-registers
)))
251 (defparameter integer-condition-reg-symbols
254 (make-symbol (concatenate 'string
"%" (string name
))))
255 integer-condition-registers
))
257 (define-arg-type integer-condition-register
258 :printer
(lambda (value stream dstate
)
259 (declare (stream stream
) (fixnum value
) (ignore dstate
))
260 (let ((regname (aref integer-condition-reg-symbols value
)))
261 (princ regname stream
))))
263 (defconstant-eqx branch-predictions
267 (define-arg-type branch-prediction
268 :printer
(coerce branch-predictions
'vector
))
270 (defun integer-condition (condition-reg)
271 (declare (type (member :icc
:xcc
) condition-reg
))
272 (or (position condition-reg integer-condition-registers
)
273 (error "Unknown integer condition register: ~S~%"
276 (defun branch-prediction (pred)
277 (or (position pred branch-predictions
)
278 (error "Unknown branch prediction: ~S~%Must be one of: ~S~%"
279 pred branch-predictions
)))
281 (defconstant-eqx branch-pred-printer
282 `(:name
(:unless
(:constant
,branch-cond-true
) cond
)
283 (:unless
(a :constant
0) "," 'A
)
284 (:unless
(p :constant
1) "," 'pn
)
291 (define-instruction-format
292 (format-2-branch-pred 32 :default-printer branch-pred-printer
)
293 (op :field
(byte 2 30) :value
0)
294 (a :field
(byte 1 29) :value
0)
295 (cond :field
(byte 4 25) :type
'branch-condition
)
296 (op2 :field
(byte 3 22))
297 (cc :field
(byte 2 20) :type
'integer-condition-register
)
298 (p :field
(byte 1 19))
299 (disp :field
(byte 19 0) :type
'relative-label
))
301 (defconstant-eqx fp-condition-registers
302 '(:fcc0
:fcc1
:fcc2
:fcc3
)
305 (defconstant-eqx fp-cond-reg-name-vec
306 (coerce fp-condition-registers
'vector
)
309 (defparameter fp-condition-reg-symbols
312 (make-symbol (concatenate 'string
"%" (string name
))))
313 fp-condition-registers
))
315 (define-arg-type fp-condition-register
316 :printer
(lambda (value stream dstate
)
317 (declare (stream stream
) (fixnum value
) (ignore dstate
))
318 (let ((regname (aref fp-condition-reg-symbols value
)))
319 (princ regname stream
))))
321 (define-arg-type fp-condition-register-shifted
322 :printer
(lambda (value stream dstate
)
323 (declare (stream stream
) (fixnum value
) (ignore dstate
))
324 (let ((regname (aref fp-condition-reg-symbols
(ash value -
1))))
325 (princ regname stream
))))
327 (defun fp-condition (condition-reg)
328 (or (position condition-reg fp-condition-registers
)
329 (error "Unknown integer condition register: ~S~%"
332 (defconstant-eqx fp-branch-pred-printer
333 `(:name
(:unless
(:constant
,branch-cond-true
) cond
)
334 (:unless
(a :constant
0) "," 'A
)
335 (:unless
(p :constant
1) "," 'pn
)
342 (define-instruction-format
343 (format-2-fp-branch-pred 32 :default-printer fp-branch-pred-printer
)
344 (op :field
(byte 2 30) :value
0)
345 (a :field
(byte 1 29) :value
0)
346 (cond :field
(byte 4 25) :type
'branch-fp-condition
)
347 (op2 :field
(byte 3 22))
348 (fcc :field
(byte 2 20) :type
'fp-condition-register
)
349 (p :field
(byte 1 19))
350 (disp :field
(byte 19 0) :type
'relative-label
))
354 (define-instruction-format
355 (format-2-unimp 32 :default-printer
'(:name
:tab data
))
356 (op :field
(byte 2 30) :value
0)
357 (ignore :field
(byte 5 25) :value
0)
358 (op2 :field
(byte 3 22) :value
0)
359 (data :field
(byte 22 0) :reader format-2-unimp-data
))
361 (defconstant-eqx f3-printer
363 (:unless
(:same-as rd
) rs1
", ")
364 (:choose rs2 immed
) ", "
368 (define-instruction-format
369 (format-3-reg 32 :default-printer f3-printer
)
370 (op :field
(byte 2 30))
371 (rd :field
(byte 5 25) :type
'reg
)
372 (op3 :field
(byte 6 19))
373 (rs1 :field
(byte 5 14) :type
'reg
)
374 (i :field
(byte 1 13) :value
0)
375 (asi :field
(byte 8 5) :value
0)
376 (rs2 :field
(byte 5 0) :type
'reg
))
378 (define-instruction-format
379 (format-3-immed 32 :default-printer f3-printer
)
380 (op :field
(byte 2 30))
381 (rd :field
(byte 5 25) :type
'reg
)
382 (op3 :field
(byte 6 19))
383 (rs1 :field
(byte 5 14) :type
'reg
)
384 (i :field
(byte 1 13) :value
1)
385 (immed :field
(byte 13 0) :sign-extend t
)) ; usually sign extended
387 (define-instruction-format
388 (format-binary-fpop 32
389 :default-printer
'(:name
:tab rs1
", " rs2
", " rd
))
390 (op :field
(byte 2 30))
391 (rd :field
(byte 5 25) :type
'fp-reg
)
392 (op3 :field
(byte 6 19))
393 (rs1 :field
(byte 5 14) :type
'fp-reg
)
394 (opf :field
(byte 9 5))
395 (rs2 :field
(byte 5 0) :type
'fp-reg
))
397 ;;; Floating point load/save instructions encoding.
398 (define-instruction-format
399 (format-unary-fpop 32 :default-printer
'(:name
:tab rs2
", " rd
))
400 (op :field
(byte 2 30))
401 (rd :field
(byte 5 25) :type
'fp-reg
)
402 (op3 :field
(byte 6 19))
403 (rs1 :field
(byte 5 14) :value
0)
404 (opf :field
(byte 9 5))
405 (rs2 :field
(byte 5 0) :type
'fp-reg
))
407 ;;; Floating point comparison instructions encoding.
409 ;; This is a merge of the instructions for FP comparison and FP
410 ;; conditional moves available in the Sparc V9. The main problem is
411 ;; that the new instructions use part of the opcode space used by the
412 ;; comparison instructions. In particular, the OPF field is arranged
417 ;; FMOVcc 0nn0000xx %fccn
423 ;; So we see that if we break up the OPF field into 4 pieces, opf0,
424 ;; opf1, opf2, and opf3, we can distinguish between these
425 ;; instructions. So bit 9 (opf2) can be used to distinguish between
426 ;; FCMP and the rest. Also note that the nn field overlaps with the
427 ;; ccc. We need to take this into account as well.
429 (define-instruction-format
431 :default-printer
#!-sparc-v9
'(:name
:tab rs1
", " rs2
)
432 #!+sparc-v9
'(:name
:tab rd
", " rs1
", " rs2
))
433 (op :field
(byte 2 30))
434 (rd :field
(byte 5 25) :value
0)
435 (op3 :field
(byte 6 19))
436 (rs1 :field
(byte 5 14))
437 (opf0 :field
(byte 1 13))
438 (opf1 :field
(byte 3 10))
439 (opf2 :field
(byte 1 9))
440 (opf3 :field
(byte 4 5))
441 (rs2 :field
(byte 5 0) :type
'fp-reg
))
443 ;;; Shift instructions
444 (define-instruction-format
445 (format-3-shift-reg 32 :default-printer f3-printer
)
446 (op :field
(byte 2 30))
447 (rd :field
(byte 5 25) :type
'reg
)
448 (op3 :field
(byte 6 19))
449 (rs1 :field
(byte 5 14) :type
'reg
)
450 (i :field
(byte 1 13) :value
0)
451 (x :field
(byte 1 12))
452 (asi :field
(byte 7 5) :value
0)
453 (rs2 :field
(byte 5 0) :type
'reg
))
455 (define-instruction-format
456 (format-3-shift-immed 32 :default-printer f3-printer
)
457 (op :field
(byte 2 30))
458 (rd :field
(byte 5 25) :type
'reg
)
459 (op3 :field
(byte 6 19))
460 (rs1 :field
(byte 5 14) :type
'reg
)
461 (i :field
(byte 1 13) :value
1)
462 (x :field
(byte 1 12))
463 (immed :field
(byte 12 0) :sign-extend nil
))
466 ;;; Conditional moves (only available for Sparc V9 architectures)
468 ;; The names of all of the condition registers on the V9: 4 FP
469 ;; conditions, the original integer condition register and the new
470 ;; extended register. The :reserved register is reserved on the V9.
472 (defconstant-eqx cond-move-condition-registers
473 '(:fcc0
:fcc1
:fcc2
:fcc3
:icc
:reserved
:xcc
:reserved
)
476 (defconstant-eqx cond-move-cond-reg-name-vec
477 (coerce cond-move-condition-registers
'vector
)
480 (deftype cond-move-condition-register
()
481 `(member ,@(remove :reserved cond-move-condition-registers
)))
483 (defparameter cond-move-condition-reg-symbols
486 (make-symbol (concatenate 'string
"%" (string name
))))
487 cond-move-condition-registers
))
489 (define-arg-type cond-move-condition-register
490 :printer
(lambda (value stream dstate
)
491 (declare (stream stream
) (fixnum value
) (ignore dstate
))
492 (let ((regname (aref cond-move-condition-reg-symbols value
)))
493 (princ regname stream
))))
495 ;; From the given condition register, figure out what the cc2, cc1,
496 ;; and cc0 bits should be. Return cc2 and cc1/cc0 concatenated.
497 (defun cond-move-condition-parts (condition-reg)
498 (let ((posn (position condition-reg cond-move-condition-registers
)))
501 (error "Unknown conditional move condition register: ~S~%"
504 (defun cond-move-condition (condition-reg)
505 (or (position condition-reg cond-move-condition-registers
)
506 (error "Unknown conditional move condition register: ~S~%"
509 (defconstant-eqx cond-move-printer
511 cc
", " (:choose immed rs2
) ", " rd
)
514 ;; Conditional move integer register on integer or FP condition code
515 (define-instruction-format
516 (format-4-cond-move 32 :default-printer cond-move-printer
)
517 (op :field
(byte 2 30))
518 (rd :field
(byte 5 25) :type
'reg
)
519 (op3 :field
(byte 6 19))
520 (cc2 :field
(byte 1 18) :value
1)
521 (cond :field
(byte 4 14) :type
'branch-condition
)
522 (i :field
(byte 1 13) :value
0)
523 (cc :field
(byte 2 11) :type
'integer-condition-register
)
524 (empty :field
(byte 6 5) :value
0)
525 (rs2 :field
(byte 5 0) :type
'reg
))
527 (define-instruction-format
528 (format-4-cond-move-immed 32 :default-printer cond-move-printer
)
529 (op :field
(byte 2 30))
530 (rd :field
(byte 5 25) :type
'reg
)
531 (op3 :field
(byte 6 19))
532 (cc2 :field
(byte 1 18) :value
1)
533 (cond :field
(byte 4 14) :type
'branch-condition
)
534 (i :field
(byte 1 13) :value
1)
535 (cc :field
(byte 2 11) :type
'integer-condition-register
)
536 (immed :field
(byte 11 0) :sign-extend t
))
538 ;; Floating-point versions of the above integer conditional moves
539 (defconstant-eqx cond-fp-move-printer
540 `(:name rs1
:tab opf1
", " rs2
", " rd
)
543 ;;; Conditional move on integer register condition (only on Sparc
544 ;;; V9). That is, move an integer register if some other integer
545 ;;; register satisfies some condition.
547 (defconstant-eqx cond-move-integer-conditions
548 '(:reserved
:z
:lez
:lz
:reserved
:nz
:gz
:gez
)
551 ;;; Why "#.(coerce)" instead of just coerce: as a consequence of revision
552 ;;; c7791afe76, cross-compiled DEFCONSTANT-EQX requires that the assigned
553 ;;; value be "constant per se" - only an expression for which CONSTANTP
554 ;;; returns T. Uses of the constant symbol in cold-load will read its value
555 ;;; from the cold symbol, therefore a literal value must be dumped for it.
556 ;;; A lambda computing the value is no good - it would be target machine code.
557 (defconstant-eqx cond-move-integer-condition-vec
558 #.
(coerce cond-move-integer-conditions
'vector
)
561 (deftype cond-move-integer-condition
()
562 `(member ,@(remove :reserved cond-move-integer-conditions
)))
564 (define-arg-type register-condition
565 :printer
(lambda (value stream dstate
)
566 (declare (stream stream
) (fixnum value
) (ignore dstate
))
567 (let ((regname (aref cond-move-integer-condition-vec value
)))
568 (princ regname stream
))))
570 (defconstant-eqx cond-move-integer-printer
571 `(:name rcond
:tab rs1
", " (:choose immed rs2
) ", " rd
)
574 (defun register-condition (rcond)
575 (or (position rcond cond-move-integer-conditions
)
576 (error "Unknown register condition: ~S~%" rcond
)))
578 (define-instruction-format
579 (format-4-cond-move-integer 32 :default-printer cond-move-integer-printer
)
580 (op :field
(byte 2 30))
581 (rd :field
(byte 5 25) :type
'reg
)
582 (op3 :field
(byte 6 19))
583 (rs1 :field
(byte 5 14) :type
'reg
)
584 (i :field
(byte 1 13) :value
0)
585 (rcond :field
(byte 3 10) :type
'register-condition
)
586 (opf :field
(byte 5 5))
587 (rs2 :field
(byte 5 0) :type
'reg
))
589 (define-instruction-format
590 (format-4-cond-move-integer-immed 32 :default-printer cond-move-integer-printer
)
591 (op :field
(byte 2 30))
592 (rd :field
(byte 5 25) :type
'reg
)
593 (op3 :field
(byte 6 19))
594 (rs1 :field
(byte 5 14) :type
'reg
)
595 (i :field
(byte 1 13) :value
1)
596 (rcond :field
(byte 3 10) :type
'register-condition
)
597 (immed :field
(byte 10 0) :sign-extend t
))
599 (defconstant-eqx trap-printer
600 `(:name rd
:tab cc
", " immed
)
603 (define-instruction-format
604 (format-4-trap 32 :default-printer trap-printer
)
605 (op :field
(byte 2 30))
606 (rd :field
(byte 5 25) :type
'reg
)
607 (op3 :field
(byte 6 19))
608 (rs1 :field
(byte 5 14) :type
'reg
)
609 (i :field
(byte 1 13) :value
1)
610 (cc :field
(byte 2 11) :type
'integer-condition-register
)
611 (immed :field
(byte 11 0) :sign-extend t
)) ; usually sign extended
614 (defconstant-eqx cond-fp-move-integer-printer
615 `(:name opf1
:tab rs1
", " rs2
", " rd
)
619 ;;;; Primitive emitters.
621 (define-bitfield-emitter emit-word
32
624 (define-bitfield-emitter emit-short
16
627 (define-bitfield-emitter emit-format-1
32
628 (byte 2 30) (byte 30 0))
630 (define-bitfield-emitter emit-format-2-immed
32
631 (byte 2 30) (byte 5 25) (byte 3 22) (byte 22 0))
633 (define-bitfield-emitter emit-format-2-branch
32
634 (byte 2 30) (byte 1 29) (byte 4 25) (byte 3 22) (byte 22 0))
636 ;; Integer and FP branches with prediction for V9
637 (define-bitfield-emitter emit-format-2-branch-pred
32
638 (byte 2 30) (byte 1 29) (byte 4 25) (byte 3 22) (byte 2 20) (byte 1 19) (byte 19 0))
639 (define-bitfield-emitter emit-format-2-fp-branch-pred
32
640 (byte 2 30) (byte 1 29) (byte 4 25) (byte 3 22) (byte 2 20) (byte 1 19) (byte 19 0))
642 (define-bitfield-emitter emit-format-2-unimp
32
643 (byte 2 30) (byte 5 25) (byte 3 22) (byte 22 0))
645 (define-bitfield-emitter emit-format-3-reg
32
646 (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 1 13) (byte 8 5)
649 (define-bitfield-emitter emit-format-3-immed
32
650 (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 1 13) (byte 13 0))
652 (define-bitfield-emitter emit-format-3-fpop
32
653 (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 9 5) (byte 5 0))
655 (define-bitfield-emitter emit-format-3-fpop2
32
656 (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14)
657 (byte 1 13) (byte 3 10) (byte 1 9) (byte 4 5)
660 ;;; Shift instructions
662 (define-bitfield-emitter emit-format-3-shift-reg
32
663 (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 1 13) (byte 1 12) (byte 7 5)
666 (define-bitfield-emitter emit-format-3-shift-immed
32
667 (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 1 13) (byte 1 12) (byte 12 0))
669 ;;; Conditional moves
671 ;; Conditional move in condition code
672 (define-bitfield-emitter emit-format-4-cond-move
32
673 (byte 2 30) (byte 5 25) (byte 6 19) (byte 1 18) (byte 4 14) (byte 1 13) (byte 2 11)
676 ;; Conditional move on integer condition
677 (define-bitfield-emitter emit-format-4-cond-move-integer
32
678 (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 1 13) (byte 3 10) (byte 5 5)
681 (define-bitfield-emitter emit-format-4-cond-move-integer-immed
32
682 (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 1 13) (byte 3 10)
685 (define-bitfield-emitter emit-format-4-trap
32
686 (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 1 13) (byte 2 11)
690 ;;;; Most of the format-3-instructions.
692 (defun emit-format-3-inst (segment op op3 dst src1 src2
693 &key load-store fixup dest-kind
)
695 (cond ((and (typep src1
'tn
) load-store
)
702 (emit-format-3-reg segment op
704 (fp-reg-tn-encoding dst
)
705 (reg-tn-encoding dst
))
706 op3
(reg-tn-encoding src1
) 0 0 (reg-tn-encoding src2
)))
708 (emit-format-3-immed segment op
710 (fp-reg-tn-encoding dst
)
711 (reg-tn-encoding dst
))
712 op3
(reg-tn-encoding src1
) 1 src2
))
714 (unless (or load-store fixup
)
715 (error "Fixups aren't allowed."))
716 (note-fixup segment
:add src2
)
717 (emit-format-3-immed segment op
719 (fp-reg-tn-encoding dst
)
720 (reg-tn-encoding dst
))
721 op3
(reg-tn-encoding src1
) 1 0))))
723 ;;; Shift instructions because an extra bit is used in Sparc V9's to
724 ;;; indicate whether the shift is a 32-bit or 64-bit shift.
726 (defun emit-format-3-shift-inst (segment op op3 dst src1 src2
&key extended
)
732 (emit-format-3-shift-reg segment op
(reg-tn-encoding dst
)
733 op3
(reg-tn-encoding src1
) 0 (if extended
1 0)
734 0 (reg-tn-encoding src2
)))
736 (emit-format-3-shift-immed segment op
(reg-tn-encoding dst
)
737 op3
(reg-tn-encoding src1
) 1
738 (if extended
1 0) src2
))))
740 (defmacro with-ref-format
(printer)
742 '(:choose
(:plus-integer immed
) ("+" rs2
)))
744 `("[" rs1
(:unless
(:constant
0) ,addend
) "]"
745 (:choose
(:unless
(:constant
0) asi
) nil
))))
748 (defconstant-eqx load-printer
749 '#.
(with-ref-format `(:NAME
:TAB
,ref-format
", " rd
))
752 (defconstant-eqx store-printer
753 '#.
(with-ref-format `(:NAME
:TAB rd
", " ,ref-format
))
756 (macrolet ((define-f3-inst (name op op3
&key fixup load-store
(dest-kind 'reg
)
757 (printer :default
) reads writes flushable print-name
)
759 (if (eq printer
:default
)
762 ((:load t
) 'load-printer
)
763 (:store
'store-printer
))
765 (when (and (atom reads
) (not (null reads
)))
766 (setf reads
(list reads
)))
767 (when (and (atom writes
) (not (null writes
)))
768 (setf writes
(list writes
)))
769 `(define-instruction ,name
(segment dst src1
&optional src2
)
770 (:declare
(type tn dst
)
771 ,(if (or fixup load-store
)
772 '(type (or tn
(signed-byte 13) null fixup
) src1 src2
)
773 '(type (or tn
(signed-byte 13) null
) src1 src2
)))
774 (:printer format-3-reg
775 ((op ,op
) (op3 ,op3
) (rd nil
:type
',dest-kind
))
777 ,@(when print-name
`(:print-name
,print-name
)))
778 (:printer format-3-immed
779 ((op ,op
) (op3 ,op3
) (rd nil
:type
',dest-kind
))
781 ,@(when print-name
`(:print-name
,print-name
)))
783 '((:attributes flushable
)))
786 ,@(let ((reads-list nil
))
788 (push (list 'reads read
) reads-list
))
790 ,@(cond ((eq load-store
:store
)
792 (if src2
(reads src2
))))
796 (if src2
(reads src2
))))
797 ((eq load-store
:load
)
799 (if src2
(reads src2
) (reads dst
))))
801 '((if src2
(reads src2
) (reads dst
)))))
802 ,@(let ((writes-list nil
))
803 (dolist (write writes
)
804 (push (list 'writes write
) writes-list
))
806 ,@(cond ((eq load-store
:store
)
807 '((writes :memory
:partially t
)))
809 '((writes :memory
:partially t
)
811 ((eq load-store
:load
)
816 (:emitter
(emit-format-3-inst segment
,op
,op3 dst src1 src2
817 :load-store
,load-store
819 :dest-kind
(not (eq ',dest-kind
'reg
)))))))
821 (define-f3-shift-inst (name op op3
&key extended
)
822 `(define-instruction ,name
(segment dst src1
&optional src2
)
823 (:declare
(type tn dst
)
824 (type (or tn
(unsigned-byte 6) null
) src1 src2
))
825 (:printer format-3-shift-reg
826 ((op ,op
) (op3 ,op3
) (x ,(if extended
1 0)) (i 0)))
827 (:printer format-3-shift-immed
828 ((op ,op
) (op3 ,op3
) (x ,(if extended
1 0)) (i 1)))
831 (if src2
(reads src2
) (reads dst
))
834 (:emitter
(emit-format-3-shift-inst segment
,op
,op3 dst src1 src2
835 :extended
,extended
)))))
837 (define-f3-inst ldsb
#b11
#b001001
:load-store
:load
)
838 (define-f3-inst ldsh
#b11
#b001010
:load-store
:load
)
839 (define-f3-inst ldub
#b11
#b000001
:load-store
:load
)
840 (define-f3-inst lduh
#b11
#b000010
:load-store
:load
)
842 ;; This instruction is called lduw for V9 , but looks exactly like ld
843 ;; on previous architectures.
844 (define-f3-inst ld
#b11
#b000000
:load-store
:load
845 #!+sparc-v9
:print-name
#!+sparc-v9
'lduw
)
847 (define-f3-inst ldsw
#b11
#b001000
:load-store
:load
) ; v9
849 ;; ldd is deprecated on the Sparc V9.
850 (define-f3-inst ldd
#b11
#b000011
:load-store
:load
)
852 (define-f3-inst ldx
#b11
#b001011
:load-store
:load
) ; v9
854 (define-f3-inst ldf
#b11
#b100000
:dest-kind fp-reg
:load-store
:load
)
855 (define-f3-inst lddf
#b11
#b100011
:dest-kind fp-reg
:load-store
:load
)
856 (define-f3-inst ldqf
#b11
#b100010
:dest-kind fp-reg
:load-store
:load
) ; v9
857 (define-f3-inst stb
#b11
#b000101
:load-store
:store
)
858 (define-f3-inst sth
#b11
#b000110
:load-store
:store
)
859 (define-f3-inst st
#b11
#b000100
:load-store
:store
)
861 ;; std is deprecated on the Sparc V9.
862 (define-f3-inst std
#b11
#b000111
:load-store
:store
)
864 (define-f3-inst stx
#b11
#b001110
:load-store
:store
) ; v9
866 (define-f3-inst stf
#b11
#b100100
:dest-kind fp-reg
:load-store
:store
)
867 (define-f3-inst stdf
#b11
#b100111
:dest-kind fp-reg
:load-store
:store
)
868 (define-f3-inst stqf
#b11
#b100110
:dest-kind fp-reg
:load-store
:store
) ; v9
869 (define-f3-inst ldstub
#b11
#b001101
:load-store t
)
871 ;; swap is deprecated on the Sparc V9
872 (define-f3-inst swap
#b11
#b001111
:load-store t
)
874 (define-f3-inst add
#b10
#b000000
:fixup t
)
875 (define-f3-inst addcc
#b10
#b010000
:writes
:psr
)
876 (define-f3-inst addx
#b10
#b001000
:reads
:psr
)
877 (define-f3-inst addxcc
#b10
#b011000
:reads
:psr
:writes
:psr
)
878 (define-f3-inst taddcc
#b10
#b100000
:writes
:psr
)
880 ;; taddcctv is deprecated on the Sparc V9. Use taddcc and bpvs or
881 ;; taddcc and trap to get a similar effect.
882 ;;(define-f3-inst taddcctv #b10 #b100010 :writes :psr)
884 (define-f3-inst sub
#b10
#b000100
)
885 (define-f3-inst subcc
#b10
#b010100
:writes
:psr
)
886 (define-f3-inst subx
#b10
#b001100
:reads
:psr
)
887 (define-f3-inst subxcc
#b10
#b011100
:reads
:psr
:writes
:psr
)
888 (define-f3-inst tsubcc
#b10
#b100001
:writes
:psr
)
890 ;; tsubcctv is deprecated on the Sparc V9. Use tsubcc and bpvs or
891 ;; tsubcc and trap to get a similar effect.
892 ;;(define-f3-inst tsubcctv #b10 #b100011 :writes :psr)
894 (define-f3-inst mulscc
#b10
#b100100
:reads
:y
:writes
(:psr
:y
))
895 (define-f3-inst and
#b10
#b000001
)
896 (define-f3-inst andcc
#b10
#b010001
:writes
:psr
)
897 (define-f3-inst andn
#b10
#b000101
)
898 (define-f3-inst andncc
#b10
#b010101
:writes
:psr
)
899 (define-f3-inst or
#b10
#b000010
)
900 (define-f3-inst orcc
#b10
#b010010
:writes
:psr
)
901 (define-f3-inst orn
#b10
#b000110
)
902 (define-f3-inst orncc
#b10
#b010110
:writes
:psr
)
903 (define-f3-inst xor
#b10
#b000011
)
904 (define-f3-inst xorcc
#b10
#b010011
:writes
:psr
)
905 (define-f3-inst xnor
#b10
#b000111
)
906 (define-f3-inst xnorcc
#b10
#b010111
:writes
:psr
)
908 (define-f3-shift-inst sll
#b10
#b100101
)
909 (define-f3-shift-inst srl
#b10
#b100110
)
910 (define-f3-shift-inst sra
#b10
#b100111
)
911 (define-f3-shift-inst sllx
#b10
#b100101
:extended t
) ; v9
912 (define-f3-shift-inst srlx
#b10
#b100110
:extended t
) ; v9
913 (define-f3-shift-inst srax
#b10
#b100111
:extended t
) ; v9
915 (define-f3-inst save
#b10
#b111100
:reads
:psr
:writes
:psr
)
916 (define-f3-inst restore
#b10
#b111101
:reads
:psr
:writes
:psr
)
918 ;; smul, smulcc, umul, umulcc, sdiv, sdivcc, udiv, and udivcc are
919 ;; deprecated on the Sparc V9. Use mulx, sdivx, and udivx instead.
920 (define-f3-inst smul
#b10
#b001011
:writes
:y
) ; v8
921 (define-f3-inst smulcc
#b10
#b011011
:writes
(:psr
:y
)) ; v8
922 (define-f3-inst umul
#b10
#b001010
:writes
:y
) ; v8
923 (define-f3-inst umulcc
#b10
#b011010
:writes
(:psr
:y
)) ; v8
924 (define-f3-inst sdiv
#b10
#b001111
:reads
:y
) ; v8
925 (define-f3-inst sdivcc
#b10
#b011111
:reads
:y
:writes
:psr
) ; v8
926 (define-f3-inst udiv
#b10
#b001110
:reads
:y
) ; v8
927 (define-f3-inst udivcc
#b10
#b011110
:reads
:y
:writes
:psr
) ; v8
929 (define-f3-inst mulx
#b10
#b001001
) ; v9 for both signed and unsigned
930 (define-f3-inst sdivx
#b10
#b101101
) ; v9
931 (define-f3-inst udivx
#b10
#b001101
) ; v9
933 (define-f3-inst popc
#b10
#b101110
) ; v9: count one bits
938 ;;;; Random instructions.
940 ;; ldfsr is deprecated on the Sparc V9. Use ldxfsr instead
941 (define-instruction ldfsr
(segment src1 src2
)
942 (:declare
(type tn src1
) (type (signed-byte 13) src2
))
943 (:printer format-3-immed
((op #b11
) (op3 #b100001
) (rd 0)))
946 (:emitter
(emit-format-3-immed segment
#b11
0 #b100001
947 (reg-tn-encoding src1
) 1 src2
)))
950 (define-instruction ldxfsr
(segment src1 src2
)
951 (:declare
(type tn src1
) (type (signed-byte 13) src2
))
952 (:printer format-3-immed
((op #b11
) (op3 #b100001
) (rd 1))
953 '(:name
:tab
"[" rs1
(:unless
(:constant
0) "+" immed
) "], %FSR")
957 (:emitter
(emit-format-3-immed segment
#b11
1 #b100001
958 (reg-tn-encoding src1
) 1 src2
)))
960 ;; stfsr is deprecated on the Sparc V9. Use stxfsr instead.
961 (define-instruction stfsr
(segment src1 src2
)
962 (:declare
(type tn src1
) (type (signed-byte 13) src2
))
963 (:printer format-3-immed
((op #b11
) (op3 #b100101
) (rd 0)))
966 (:emitter
(emit-format-3-immed segment
#b11
0 #b100101
967 (reg-tn-encoding src1
) 1 src2
)))
970 (define-instruction stxfsr
(segment src1 src2
)
971 (:declare
(type tn src1
) (type (signed-byte 13) src2
))
972 (:printer format-3-immed
((op #b11
) (op3 #b100101
) (rd 1))
973 '(:name
:tab
"%FSR, [" rs1
"+" (:unless
(:constant
0) "+" immed
) "]")
977 (:emitter
(emit-format-3-immed segment
#b11
1 #b100101
978 (reg-tn-encoding src1
) 1 src2
)))
980 (define-instruction sethi
(segment dst src1
)
981 (:declare
(type tn dst
)
982 (type (or (signed-byte 22) (unsigned-byte 22) fixup
) src1
))
983 (:printer format-2-immed
984 ((op2 #b100
) (immed nil
:printer
#'sethi-arg-printer
)))
985 (:dependencies
(writes dst
))
990 (emit-format-2-immed segment
#b00
(reg-tn-encoding dst
) #b100
993 (note-fixup segment
:sethi src1
)
994 (emit-format-2-immed segment
#b00
(reg-tn-encoding dst
) #b100
0)))))
996 ;; rdy is deprecated on the Sparc V9. It's not needed with 64-bit
998 (define-instruction rdy
(segment dst
)
999 (:declare
(type tn dst
))
1000 (:printer format-3-reg
((op #b10
) (op3 #b101000
) (rs1 0) (immed 0))
1001 '('RD
:tab
'%Y
", " rd
))
1002 (:dependencies
(reads :y
) (writes dst
))
1004 (:emitter
(emit-format-3-reg segment
#b10
(reg-tn-encoding dst
) #b101000
1007 (defconstant-eqx wry-printer
1008 '('WR
:tab rs1
(:unless
(:constant
0) ", " (:choose immed rs2
)) ", " '%Y
)
1011 ;; wry is deprecated on the Sparc V9. It's not needed with 64-bit
1013 (define-instruction wry
(segment src1
&optional src2
)
1014 (:declare
(type tn src1
) (type (or (signed-byte 13) tn null
) src2
))
1015 (:printer format-3-reg
((op #b10
) (op3 #b110000
) (rd 0)) wry-printer
)
1016 (:printer format-3-immed
((op #b10
) (op3 #b110000
) (rd 0)) wry-printer
)
1017 (:dependencies
(reads src1
) (if src2
(reads src2
)) (writes :y
))
1022 (emit-format-3-reg segment
#b10
0 #b110000
(reg-tn-encoding src1
) 0 0 0))
1024 (emit-format-3-reg segment
#b10
0 #b110000
(reg-tn-encoding src1
) 0 0
1025 (reg-tn-encoding src2
)))
1027 (emit-format-3-immed segment
#b10
0 #b110000
(reg-tn-encoding src1
) 1
1030 (define-instruction unimp
(segment data
)
1031 (:declare
(type (unsigned-byte 22) data
))
1032 (:printer format-2-unimp
() :default
:control
#'unimp-control
1033 :print-name
#!-sparc-v9
'unimp
#!+sparc-v9
'illtrap
)
1035 (:emitter
(emit-format-2-unimp segment
0 0 0 data
)))
1039 ;;;; Branch instructions.
1041 ;; The branch instruction is deprecated on the Sparc V9. Use the
1042 ;; branch with prediction instructions instead.
1043 (defun emit-relative-branch (segment a op2 cond-or-target target
&optional fp
)
1044 (emit-back-patch segment
4
1045 (lambda (segment posn
)
1047 (setf target cond-or-target
)
1048 (setf cond-or-target
:t
))
1049 (emit-format-2-branch
1052 (fp-branch-condition cond-or-target
)
1053 (branch-condition cond-or-target
))
1055 (let ((offset (ash (- (label-position target
) posn
) -
2)))
1056 (when (and (= a
1) (> 0 offset
))
1057 (error "Offset of BA must be positive"))
1060 (defun emit-relative-branch-integer (segment a op2 cond-or-target target
&optional
(cc :icc
) (pred :pt
))
1061 (declare (type integer-condition-register cc
))
1062 (aver (member :sparc-v9
*backend-subfeatures
*))
1063 (emit-back-patch segment
4
1064 (lambda (segment posn
)
1066 (setf target cond-or-target
)
1067 (setf cond-or-target
:t
))
1068 (emit-format-2-branch-pred
1070 (branch-condition cond-or-target
)
1072 (integer-condition cc
)
1073 (branch-prediction pred
)
1074 (let ((offset (ash (- (label-position target
) posn
) -
2)))
1075 (when (and (= a
1) (> 0 offset
))
1076 (error "Offset of BA must be positive"))
1079 (defun emit-relative-branch-fp (segment a op2 cond-or-target target
&optional
(cc :fcc0
) (pred :pt
))
1080 (aver (member :sparc-v9
*backend-subfeatures
*))
1081 (emit-back-patch segment
4
1082 (lambda (segment posn
)
1084 (setf target cond-or-target
)
1085 (setf cond-or-target
:t
))
1086 (emit-format-2-branch-pred
1088 (fp-branch-condition cond-or-target
)
1091 (branch-prediction pred
)
1092 (let ((offset (ash (- (label-position target
) posn
) -
2)))
1093 (when (and (= a
1) (> 0 offset
))
1094 (error "Offset of BA must be positive"))
1097 ;; So that I don't have to go change the syntax of every single use of
1098 ;; branches, I'm keeping the Lisp instruction names the same. They
1099 ;; just get translated to the branch with prediction
1100 ;; instructions. However, the disassembler uses the correct V9
1102 (define-instruction b
(segment cond-or-target
&rest args
)
1103 (:declare
(type (or label branch-condition
) cond-or-target
))
1104 (:printer format-2-branch
((op #b00
) (op2 #b010
)))
1105 (:attributes branch
)
1106 (:dependencies
(reads :psr
))
1110 ((member :sparc-v9
*backend-subfeatures
*)
1111 (destructuring-bind (&optional target pred cc
) args
1112 (declare (type (or label null
) target
))
1113 (emit-relative-branch-integer segment
0 #b001 cond-or-target target
(or cc
:icc
) (or pred
:pt
))))
1115 (destructuring-bind (&optional target
) args
1116 (declare (type (or label null
) target
))
1117 (emit-relative-branch segment
0 #b010 cond-or-target target
))))))
1119 (define-instruction bp
(segment cond-or-target
&optional target pred cc
)
1120 (:declare
(type (or label branch-condition
) cond-or-target
)
1121 (type (or label null
) target
))
1122 (:printer format-2-branch-pred
((op #b00
) (op2 #b001
))
1125 (:attributes branch
)
1126 (:dependencies
(reads :psr
))
1129 (emit-relative-branch-integer segment
0 #b001 cond-or-target target
(or cc
:icc
) (or pred
:pt
))))
1131 (define-instruction ba
(segment cond-or-target
&rest args
)
1132 (:declare
(type (or label branch-condition
) cond-or-target
))
1133 (:printer format-2-branch
((op #b00
) (op2 #b010
) (a 1))
1136 (:attributes branch
)
1137 (:dependencies
(reads :psr
))
1141 ((member :sparc-v9
*backend-subfeatures
*)
1142 (destructuring-bind (&optional target pred cc
) args
1143 (declare (type (or label null
) target
))
1144 (emit-relative-branch-integer segment
1 #b001 cond-or-target target
(or cc
:icc
) (or pred
:pt
))))
1146 (destructuring-bind (&optional target
) args
1147 (declare (type (or label null
) target
))
1148 (emit-relative-branch segment
1 #b010 cond-or-target target
))))))
1150 (define-instruction bpa
(segment cond-or-target
&optional target pred cc
)
1151 (:declare
(type (or label branch-condition
) cond-or-target
)
1152 (type (or label null
) target
))
1153 (:printer format-2-branch
((op #b00
) (op2 #b001
) (a 1))
1156 (:attributes branch
)
1157 (:dependencies
(reads :psr
))
1160 (emit-relative-branch-integer segment
1 #b001 cond-or-target target
(or cc
:icc
) (or pred
:pt
))))
1162 ;; This doesn't cover all of the possible formats for the trap
1163 ;; instruction. We really only want a trap with a immediate trap
1164 ;; value and with RS1 = register 0. Also, the Sparc Compliance
1165 ;; Definition 2.4.1 says only trap numbers 16-31 are allowed for user
1166 ;; code. All other trap numbers have other uses. The restriction on
1167 ;; target will prevent us from using bad trap numbers by mistake.
1169 (define-instruction t
(segment condition target
&optional cc
)
1170 (:declare
(type branch-condition condition
)
1171 ;; KLUDGE: see comments in vm.lisp regarding
1172 ;; pseudo-atomic-trap.
1174 (type (integer 16 31) target
))
1175 (:printer format-3-immed
((op #b10
)
1176 (rd nil
:type
'branch-condition
)
1179 '(:name rd
:tab immed
))
1180 (:attributes branch
)
1181 (:dependencies
(reads :psr
))
1185 ((member :sparc-v9
*backend-subfeatures
*)
1188 (emit-format-4-trap segment
1190 (branch-condition condition
)
1192 (integer-condition cc
)
1196 (emit-format-3-immed segment
#b10
(branch-condition condition
)
1197 #b111010
0 1 target
)))))
1199 ;;; KLUDGE: we leave this commented out, as these two (T and TCC)
1200 ;;; operations are actually indistinguishable from their bitfields,
1201 ;;; breaking the disassembler if these are left in. The printer isn't
1202 ;;; terribly smart, but the emitted code is right. - CSR, 2002-08-04
1204 (define-instruction tcc
(segment condition target
&optional
(cc #!-sparc-64
:icc
#!+sparc-64
:xcc
))
1205 (:declare
(type branch-condition condition
)
1206 ;; KLUDGE: see above.
1208 (type (integer 16 31) target
)
1209 (type integer-condition-register cc
))
1210 (:printer format-4-trap
((op #b10
)
1211 (rd nil
:type
'branch-condition
)
1215 (:attributes branch
)
1216 (:dependencies
(reads :psr
))
1218 (:emitter
(emit-format-4-trap segment
1220 (branch-condition condition
)
1222 (integer-condition cc
)
1225 ;; Same as for the branch instructions. On the Sparc V9, we will use
1226 ;; the FP branch with prediction instructions instead.
1228 (define-instruction fb
(segment condition target
&rest args
)
1229 (:declare
(type fp-branch-condition condition
) (type label target
))
1230 (:printer format-2-branch
((op #B00
)
1231 (cond nil
:type
'branch-fp-condition
)
1233 (:attributes branch
)
1234 (:dependencies
(reads :fsr
))
1238 ((member :sparc-v9
*backend-subfeatures
*)
1239 (destructuring-bind (&optional fcc pred
) args
1240 (emit-relative-branch-fp segment
0 #b101 condition target
(or fcc
:fcc0
) (or pred
:pt
))))
1243 (emit-relative-branch segment
0 #b110 condition target t
)))))
1245 (define-instruction fbp
(segment condition target
&optional fcc pred
)
1246 (:declare
(type fp-branch-condition condition
) (type label target
))
1247 (:printer format-2-fp-branch-pred
((op #b00
) (op2 #b101
))
1248 fp-branch-pred-printer
1250 (:attributes branch
)
1251 (:dependencies
(reads :fsr
))
1254 (emit-relative-branch-fp segment
0 #b101 condition target
(or fcc
:fcc0
) (or pred
:pt
))))
1256 (defconstant-eqx jal-printer
1258 (:choose
(rs1 (:unless
(:constant
0) (:plus-integer immed
)))
1259 (:cond
((rs2 :constant
0) rs1
)
1260 ((rs1 :constant
0) rs2
)
1262 (:unless
(:constant
0) ", " rd
))
1265 (define-instruction jal
(segment dst src1
&optional src2
)
1266 (:declare
(type tn dst
)
1267 (type (or tn integer
) src1
)
1268 (type (or null fixup tn
(signed-byte 13)) src2
))
1269 (:printer format-3-reg
((op #b10
) (op3 #b111000
)) jal-printer
)
1270 (:printer format-3-immed
((op #b10
) (op3 #b111000
)) jal-printer
)
1271 (:attributes branch
)
1272 (:dependencies
(reads src1
) (if src2
(reads src2
) (reads dst
)) (writes dst
))
1280 (emit-format-3-reg segment
#b10
(reg-tn-encoding dst
) #b111000
1283 (reg-tn-encoding src1
))
1284 0 0 (reg-tn-encoding src2
)))
1286 (emit-format-3-immed segment
#b10
(reg-tn-encoding dst
) #b111000
1287 (reg-tn-encoding src1
) 1 src2
))
1289 (note-fixup segment
:add src2
)
1290 (emit-format-3-immed segment
#b10
(reg-tn-encoding dst
)
1291 #b111000
(reg-tn-encoding src1
) 1 0)))))
1293 (define-instruction j
(segment src1
&optional src2
)
1294 (:declare
(type tn src1
) (type (or tn
(signed-byte 13) fixup null
) src2
))
1295 (:printer format-3-reg
((op #b10
) (op3 #b111000
) (rd 0)) jal-printer
)
1296 (:printer format-3-immed
((op #b10
) (op3 #b111000
) (rd 0)) jal-printer
)
1297 (:attributes branch
)
1298 (:dependencies
(reads src1
) (if src2
(reads src2
)))
1303 (emit-format-3-reg segment
#b10
0 #b111000
(reg-tn-encoding src1
) 0 0 0))
1305 (emit-format-3-reg segment
#b10
0 #b111000
(reg-tn-encoding src1
) 0 0
1306 (reg-tn-encoding src2
)))
1308 (emit-format-3-immed segment
#b10
0 #b111000
(reg-tn-encoding src1
) 1
1311 (note-fixup segment
:add src2
)
1312 (emit-format-3-immed segment
#b10
0 #b111000
(reg-tn-encoding src1
) 1
1317 ;;;; Unary and binary fp insts.
1319 (macrolet ((define-unary-fp-inst (name opf
&key reads extended
)
1320 `(define-instruction ,name
(segment dst src
)
1321 (:declare
(type tn dst src
))
1322 (:printer format-unary-fpop
1323 ((op #b10
) (op3 #b110100
) (opf ,opf
)
1325 (rs2 nil
:type
',(if extended
'fp-ext-reg
'fp-reg
))
1326 (rd nil
:type
',(if extended
'fp-ext-reg
'fp-reg
))))
1334 (:emitter
(emit-format-3-fpop segment
#b10
(fp-reg-tn-encoding dst
)
1335 #b110100
0 ,opf
(fp-reg-tn-encoding src
)))))
1337 (define-binary-fp-inst (name opf
&key
(op3 #b110100
)
1338 reads writes delay extended
)
1339 `(define-instruction ,name
(segment dst src1 src2
)
1340 (:declare
(type tn dst src1 src2
))
1341 (:printer format-binary-fpop
1342 ((op #b10
) (op3 ,op3
) (opf ,opf
)
1343 (rs1 nil
:type
',(if extended
'fp-ext-reg
'fp-reg
))
1344 (rs2 nil
:type
',(if extended
'fp-ext-reg
'fp-reg
))
1345 (rd nil
:type
',(if extended
'fp-ext-reg
'fp-reg
))
1353 `((writes ,writes
)))
1358 (:emitter
(emit-format-3-fpop segment
#b10
(fp-reg-tn-encoding dst
)
1359 ,op3
(fp-reg-tn-encoding src1
) ,opf
1360 (fp-reg-tn-encoding src2
)))))
1362 (define-cmp-fp-inst (name opf
&key extended
)
1366 `(define-instruction ,name
(segment src1 src2
&optional
(fcc :fcc0
))
1367 (:declare
(type tn src1 src2
)
1368 (type (member :fcc0
:fcc1
:fcc2
:fcc3
) fcc
))
1369 (:printer format-fpop2
1376 (rs1 nil
:type
',(if extended
'fp-ext-reg
'fp-reg
))
1377 (rs2 nil
:type
',(if extended
'fp-ext-reg
'fp-reg
))
1381 (rd nil
:type
'fp-condition-register
))
1387 ;; The Sparc V9 doesn't need a delay after a FP compare.
1389 ;; KLUDGE FIXME YAARGH -- how to express that? I guess for now we
1390 ;; do the worst case, and hope to fix it.
1391 ;; (:delay #-sparc-v9 1 #+sparc-v9 0)
1394 (emit-format-3-fpop2 segment
#b10
1395 (or (position fcc
'(:fcc0
:fcc1
:fcc2
:fcc3
))
1398 (fp-reg-tn-encoding src1
)
1399 ,opf0
,opf1
,opf2
,opf
1400 (fp-reg-tn-encoding src2
)))))))
1402 (define-unary-fp-inst fitos
#b011000100
:reads
:fsr
)
1403 (define-unary-fp-inst fitod
#b011001000
:reads
:fsr
:extended t
)
1404 (define-unary-fp-inst fitoq
#b011001100
:reads
:fsr
:extended t
) ; v8
1406 (define-unary-fp-inst fxtos
#b010000100
:reads
:fsr
) ; v9
1407 (define-unary-fp-inst fxtod
#b010001000
:reads
:fsr
:extended t
) ; v9
1408 (define-unary-fp-inst fxtoq
#b010001100
:reads
:fsr
:extended t
) ; v9
1411 ;; I (Raymond Toy) don't think these f{sd}toir instructions exist on
1412 ;; any Ultrasparc, but I only have a V9 manual. The code in
1413 ;; float.lisp seems to indicate that they only existed on non-sun4
1414 ;; machines (sun3 68K machines?).
1415 (define-unary-fp-inst fstoir
#b011000001
:reads
:fsr
)
1416 (define-unary-fp-inst fdtoir
#b011000010
:reads
:fsr
)
1418 (define-unary-fp-inst fstoi
#b011010001
)
1419 (define-unary-fp-inst fdtoi
#b011010010
:extended t
)
1420 (define-unary-fp-inst fqtoi
#b011010011
:extended t
) ; v8
1422 (define-unary-fp-inst fstox
#b010000001
) ; v9
1423 (define-unary-fp-inst fdtox
#b010000010
:extended t
) ; v9
1424 (define-unary-fp-inst fqtox
#b010000011
:extended t
) ; v9
1426 (define-unary-fp-inst fstod
#b011001001
:reads
:fsr
)
1427 (define-unary-fp-inst fstoq
#b011001101
:reads
:fsr
) ; v8
1428 (define-unary-fp-inst fdtos
#b011000110
:reads
:fsr
)
1429 (define-unary-fp-inst fdtoq
#b011001110
:reads
:fsr
) ; v8
1430 (define-unary-fp-inst fqtos
#b011000111
:reads
:fsr
) ; v8
1431 (define-unary-fp-inst fqtod
#b011001011
:reads
:fsr
) ; v8
1433 (define-unary-fp-inst fmovs
#b000000001
)
1434 (define-unary-fp-inst fmovd
#b000000010
:extended t
) ; v9
1435 (define-unary-fp-inst fmovq
#b000000011
:extended t
) ; v9
1437 (define-unary-fp-inst fnegs
#b000000101
)
1438 (define-unary-fp-inst fnegd
#b000000110
:extended t
) ; v9
1439 (define-unary-fp-inst fnegq
#b000000111
:extended t
) ; v9
1441 (define-unary-fp-inst fabss
#b000001001
)
1442 (define-unary-fp-inst fabsd
#b000001010
:extended t
) ; v9
1443 (define-unary-fp-inst fabsq
#b000001011
:extended t
) ; v9
1445 (define-unary-fp-inst fsqrts
#b000101001
:reads
:fsr
) ; V7
1446 (define-unary-fp-inst fsqrtd
#b000101010
:reads
:fsr
:extended t
) ; V7
1447 (define-unary-fp-inst fsqrtq
#b000101011
:reads
:fsr
:extended t
) ; v8
1449 (define-binary-fp-inst fadds
#b001000001
)
1450 (define-binary-fp-inst faddd
#b001000010
:extended t
)
1451 (define-binary-fp-inst faddq
#b001000011
:extended t
) ; v8
1452 (define-binary-fp-inst fsubs
#b001000101
)
1453 (define-binary-fp-inst fsubd
#b001000110
:extended t
)
1454 (define-binary-fp-inst fsubq
#b001000111
:extended t
) ; v8
1456 (define-binary-fp-inst fmuls
#b001001001
)
1457 (define-binary-fp-inst fmuld
#b001001010
:extended t
)
1458 (define-binary-fp-inst fmulq
#b001001011
:extended t
) ; v8
1459 (define-binary-fp-inst fdivs
#b001001101
)
1460 (define-binary-fp-inst fdivd
#b001001110
:extended t
)
1461 (define-binary-fp-inst fdivq
#b001001111
:extended t
) ; v8
1463 ;;; Float comparison instructions.
1465 (define-cmp-fp-inst fcmps
#b0001
)
1466 (define-cmp-fp-inst fcmpd
#b0010
:extended t
)
1467 (define-cmp-fp-inst fcmpq
#b0011
:extended t
) ;v8
1468 (define-cmp-fp-inst fcmpes
#b0101
)
1469 (define-cmp-fp-inst fcmped
#b0110
:extended t
)
1470 (define-cmp-fp-inst fcmpeq
#b0111
:extended t
) ; v8
1474 ;;;; li, jali, ji, nop, cmp, not, neg, move, and more
1476 (defun %li
(reg value
)
1479 (inst add reg zero-tn value
))
1480 ((or (signed-byte 32) (unsigned-byte 32))
1481 (let ((hi (ldb (byte 22 10) value
))
1482 (lo (ldb (byte 10 0) value
)))
1485 (inst add reg lo
))))
1487 (inst sethi reg value
)
1488 (inst add reg value
))))
1490 (define-instruction-macro li
(reg value
)
1493 ;;; Jal to a full 32-bit address. Tmpreg is trashed.
1494 (define-instruction jali
(segment link tmpreg value
)
1495 (:declare
(type tn link tmpreg
)
1496 (type (or (signed-byte 13) (signed-byte 32) (unsigned-byte 32)
1498 (:attributes variable-length
)
1500 (:attributes branch
)
1501 (:dependencies
(writes link
) (writes tmpreg
))
1504 (assemble (segment vop
)
1507 (inst jal link zero-tn value
))
1508 ((or (signed-byte 32) (unsigned-byte 32))
1509 (let ((hi (ldb (byte 22 10) value
))
1510 (lo (ldb (byte 10 0) value
)))
1511 (inst sethi tmpreg hi
)
1512 (inst jal link tmpreg lo
)))
1514 (inst sethi tmpreg value
)
1515 (inst jal link tmpreg value
))))))
1517 ;;; Jump to a full 32-bit address. Tmpreg is trashed.
1518 (define-instruction ji
(segment tmpreg value
)
1519 (:declare
(type tn tmpreg
)
1520 (type (or (signed-byte 13) (signed-byte 32) (unsigned-byte 32)
1522 (:attributes variable-length
)
1524 (:attributes branch
)
1525 (:dependencies
(writes tmpreg
))
1528 (assemble (segment vop
)
1529 (inst jali zero-tn tmpreg value
))))
1531 (define-instruction nop
(segment)
1532 (:printer format-2-immed
((rd 0) (op2 #b100
) (immed 0)) '(:name
))
1533 (:attributes flushable
)
1535 (:emitter
(emit-format-2-immed segment
0 0 #b100
0)))
1537 (defun emit-nop (segment)
1538 (emit-format-2-immed segment
0 0 #b100
0))
1540 (define-instruction cmp
(segment src1
&optional src2
)
1541 (:declare
(type tn src1
) (type (or null tn
(signed-byte 13)) src2
))
1542 (:printer format-3-reg
((op #b10
) (op3 #b010100
) (rd 0))
1543 '(:name
:tab rs1
", " rs2
))
1544 (:printer format-3-immed
((op #b10
) (op3 #b010100
) (rd 0))
1545 '(:name
:tab rs1
", " immed
))
1546 (:dependencies
(reads src1
) (if src2
(reads src2
)) (writes :psr
))
1551 (emit-format-3-reg segment
#b10
0 #b010100
(reg-tn-encoding src1
) 0 0 0))
1553 (emit-format-3-reg segment
#b10
0 #b010100
(reg-tn-encoding src1
) 0 0
1554 (reg-tn-encoding src2
)))
1556 (emit-format-3-immed segment
#b10
0 #b010100
(reg-tn-encoding src1
) 1
1559 (define-instruction not
(segment dst
&optional src1
)
1560 (:declare
(type tn dst
) (type (or tn null
) src1
))
1561 (:printer format-3-reg
((op #b10
) (op3 #b000111
) (rs2 0))
1562 '(:name
:tab
(:unless
(:same-as rd
) rs1
", " ) rd
))
1563 (:dependencies
(if src1
(reads src1
) (reads dst
)) (writes dst
))
1568 (emit-format-3-reg segment
#b10
(reg-tn-encoding dst
) #b000111
1569 (reg-tn-encoding src1
) 0 0 0)))
1571 (define-instruction neg
(segment dst
&optional src1
)
1572 (:declare
(type tn dst
) (type (or tn null
) src1
))
1573 (:printer format-3-reg
((op #b10
) (op3 #b000100
) (rs1 0))
1574 '(:name
:tab
(:unless
(:same-as rd
) rs2
", " ) rd
))
1575 (:dependencies
(if src1
(reads src1
) (reads dst
)) (writes dst
))
1580 (emit-format-3-reg segment
#b10
(reg-tn-encoding dst
) #b000100
1581 0 0 0 (reg-tn-encoding src1
))))
1583 (define-instruction move
(segment dst src1
)
1584 (:declare
(type tn dst src1
))
1585 (:printer format-3-reg
((op #b10
) (op3 #b000010
) (rs1 0))
1586 '(:name
:tab rs2
", " rd
)
1588 (:attributes flushable
)
1589 (:dependencies
(reads src1
) (writes dst
))
1591 (:emitter
(emit-format-3-reg segment
#b10
(reg-tn-encoding dst
) #b000010
1592 0 0 0 (reg-tn-encoding src1
))))
1596 ;;;; Instructions for dumping data and header objects.
1598 (define-instruction word
(segment word
)
1599 (:declare
(type (or (unsigned-byte 32) (signed-byte 32) fixup
) word
))
1605 (note-fixup segment
:absolute word
)
1606 (emit-word segment
0))
1608 (emit-word segment word
)))))
1610 (define-instruction short
(segment short
)
1611 (:declare
(type (or (unsigned-byte 16) (signed-byte 16)) short
))
1615 (emit-short segment short
)))
1617 (define-instruction byte
(segment byte
)
1618 (:declare
(type (or (unsigned-byte 8) (signed-byte 8)) byte
))
1622 (emit-byte segment byte
)))
1624 (define-bitfield-emitter emit-header-object
32
1625 (byte 24 8) (byte 8 0))
1627 (defun emit-header-data (segment type
)
1630 (lambda (segment posn
)
1633 (ash (+ posn
(component-header-length))
1634 (- n-widetag-bits word-shift
)))))))
1636 (define-instruction simple-fun-header-word
(segment)
1640 (emit-header-data segment simple-fun-widetag
)))
1642 (define-instruction lra-header-word
(segment)
1646 (emit-header-data segment return-pc-widetag
)))
1649 ;;;; Instructions for converting between code objects, functions, and lras.
1651 (defun emit-compute-inst (segment vop dst src label temp calc
)
1653 ;; We emit either 12 or 4 bytes, so we maintain 8 byte alignments.
1655 (lambda (segment posn delta-if-after
)
1656 (let ((delta (funcall calc label posn delta-if-after
)))
1657 (when (<= (- (ash 1 12)) delta
(1- (ash 1 12)))
1658 (emit-back-patch segment
4
1659 (lambda (segment posn
)
1660 (assemble (segment vop
)
1662 (funcall calc label posn
0)))))
1664 (lambda (segment posn
)
1665 (let ((delta (funcall calc label posn
0)))
1666 (assemble (segment vop
)
1667 (inst sethi temp
(ldb (byte 22 10) delta
))
1668 (inst or temp
(ldb (byte 10 0) delta
))
1669 (inst add dst src temp
))))))
1671 ;; code = fn - fn-ptr-type - header - label-offset + other-pointer-tag
1672 (define-instruction compute-code-from-fn
(segment dst src label temp
)
1673 (:declare
(type tn dst src temp
) (type label label
))
1674 (:attributes variable-length
)
1675 (:dependencies
(reads src
) (writes dst
) (writes temp
))
1679 (emit-compute-inst segment vop dst src label temp
1680 (lambda (label posn delta-if-after
)
1681 (- other-pointer-lowtag
1683 (label-position label posn delta-if-after
)
1684 (component-header-length))))))
1686 ;; code = lra - other-pointer-tag - header - label-offset + other-pointer-tag
1687 ;; = lra - (header + label-offset)
1688 (define-instruction compute-code-from-lra
(segment dst src label temp
)
1689 (:declare
(type tn dst src temp
) (type label label
))
1690 (:attributes variable-length
)
1691 (:dependencies
(reads src
) (writes dst
) (writes temp
))
1695 (emit-compute-inst segment vop dst src label temp
1696 (lambda (label posn delta-if-after
)
1697 (- (+ (label-position label posn delta-if-after
)
1698 (component-header-length)))))))
1700 ;; lra = code + other-pointer-tag + header + label-offset - other-pointer-tag
1701 ;; = code + header + label-offset
1702 (define-instruction compute-lra-from-code
(segment dst src label temp
)
1703 (:declare
(type tn dst src temp
) (type label label
))
1704 (:attributes variable-length
)
1705 (:dependencies
(reads src
) (writes dst
) (writes temp
))
1709 (emit-compute-inst segment vop dst src label temp
1710 (lambda (label posn delta-if-after
)
1711 (+ (label-position label posn delta-if-after
)
1712 (component-header-length))))))
1714 ;;; Sparc V9 additions
1718 ;; Conditional move integer on condition code
1719 (define-instruction cmove
(segment condition dst src
&optional
(ccreg :icc
))
1720 (:declare
(type (or branch-condition fp-branch-condition
) condition
)
1721 (type cond-move-condition-register ccreg
)
1723 (type (or (signed-byte 13) tn
) src
))
1724 (:printer format-4-cond-move
1729 (cc nil
:type
'integer-condition-register
))
1732 (:printer format-4-cond-move-immed
1737 (cc nil
:type
'integer-condition-register
))
1740 (:printer format-4-cond-move
1744 (cond nil
:type
'branch-fp-condition
)
1746 (cc nil
:type
'fp-condition-register
))
1749 (:printer format-4-cond-move-immed
1753 (cond nil
:type
'branch-fp-condition
)
1755 (cc nil
:type
'fp-condition-register
))
1760 (if (member ccreg
'(:icc
:xcc
))
1769 (multiple-value-bind (cc2 cc01
)
1770 (cond-move-condition-parts ccreg
)
1773 (emit-format-4-cond-move segment
1775 (reg-tn-encoding dst
)
1778 (if (member ccreg
'(:icc
:xcc
))
1779 (branch-condition condition
)
1780 (fp-branch-condition condition
))
1783 (reg-tn-encoding src
)))
1785 (emit-format-4-cond-move segment
1787 (reg-tn-encoding dst
)
1790 (if (member ccreg
'(:icc
:xcc
))
1791 (branch-condition condition
)
1792 (fp-branch-condition condition
))
1797 ;; Conditional move floating-point on condition codes
1798 (macrolet ((define-cond-fp-move (name print-name op op3 opf_low
&key extended
)
1799 `(define-instruction ,name
(segment condition dst src
&optional
(ccreg :fcc0
))
1800 (:declare
(type (or branch-condition fp-branch-condition
) condition
)
1801 (type cond-move-condition-register ccreg
)
1803 (:printer format-fpop2
1807 (opf1 nil
:type
'fp-condition-register-shifted
)
1810 (rs1 nil
:type
'branch-fp-condition
)
1811 (rs2 nil
:type
',(if extended
'fp-ext-reg
'fp-reg
))
1812 (rd nil
:type
',(if extended
'fp-ext-reg
'fp-reg
)))
1813 cond-fp-move-printer
1814 :print-name
',print-name
)
1815 (:printer format-fpop2
1819 (opf1 nil
:type
'integer-condition-register
)
1821 (rs1 nil
:type
'branch-condition
)
1823 (rs2 nil
:type
',(if extended
'fp-ext-reg
'fp-reg
))
1824 (rd nil
:type
',(if extended
'fp-ext-reg
'fp-reg
)))
1825 cond-fp-move-printer
1826 :print-name
',print-name
)
1829 (if (member ccreg
'(:icc
:xcc
))
1836 (multiple-value-bind (opf_cc2 opf_cc01
)
1837 (cond-move-condition-parts ccreg
)
1838 (emit-format-3-fpop2 segment
1840 (fp-reg-tn-encoding dst
)
1842 (if (member ccreg
'(:icc
:xcc
))
1843 (branch-condition condition
)
1844 (fp-branch-condition condition
))
1849 (fp-reg-tn-encoding src
)))))))
1850 (define-cond-fp-move cfmovs fmovs
#b10
#b110101
#b0001
)
1851 (define-cond-fp-move cfmovd fmovd
#b10
#b110101
#b0010
:extended t
)
1852 (define-cond-fp-move cfmovq fmovq
#b10
#b110101
#b0011
:extended t
))
1855 ;; Move on integer register condition
1857 ;; movr dst src reg reg-cond
1859 ;; This means if reg satisfies reg-cond, src is copied to dst. If the
1860 ;; condition is not satisfied, nothing is done.
1862 (define-instruction movr
(segment dst src2 src1 reg-condition
)
1863 (:declare
(type cond-move-integer-condition reg-condition
)
1865 (type (or (signed-byte 10) tn
) src2
))
1866 (:printer format-4-cond-move-integer
1870 (:printer format-4-cond-move-integer-immed
1884 (emit-format-4-cond-move-integer
1885 segment
#b10
(reg-tn-encoding dst
) #b101111
(reg-tn-encoding src1
)
1886 0 (register-condition reg-condition
)
1887 0 (reg-tn-encoding src2
)))
1889 (emit-format-4-cond-move-integer-immed
1890 segment
#b10
(reg-tn-encoding dst
) #b101111
(reg-tn-encoding src1
)
1891 1 (register-condition reg-condition
) src2
)))))
1894 ;; Same as MOVR, except we move FP registers depending on the value of
1895 ;; an integer register.
1897 ;; fmovr dst src reg cond
1899 ;; This means if REG satifies COND, SRC is COPIED to DST. Nothing
1900 ;; happens if the condition is not satisfied.
1901 (macrolet ((define-cond-fp-move-integer (name opf_low
&key extended
)
1902 `(define-instruction ,name
(segment dst src2 src1 reg-condition
)
1903 (:declare
(type cond-move-integer-condition reg-condition
)
1904 (type tn dst src1 src2
))
1905 (:printer format-fpop2
1907 (rd nil
:type
',(if extended
'fp-ext-reg
'fp-reg
))
1909 (rs1 nil
:type
'reg
)
1911 (opf1 nil
:type
'register-condition
)
1914 (rs2 nil
:type
',(if extended
'fp-ext-reg
'fp-reg
))
1916 cond-fp-move-integer-printer
)
1924 (emit-format-3-fpop2
1927 (fp-reg-tn-encoding dst
)
1929 (reg-tn-encoding src1
)
1931 (register-condition reg-condition
)
1934 (fp-reg-tn-encoding src2
))))))
1935 (define-cond-fp-move-integer fmovrs
#b0101
)
1936 (define-cond-fp-move-integer fmovrd
#b0110
:extended t
)
1937 (define-cond-fp-move-integer fmovrq
#b0111
:extended t
))