From 71c9883d382dd32478918f0b3c942f5e40239135 Mon Sep 17 00:00:00 2001
From: dtc <dtc>
Date: Wed, 16 Feb 2000 00:25:33 +0000
Subject: [PATCH] o Branch with prediction instructions are defined.

o On the V9, all branches are replaced with the corresponding
  branch-with-prediciton versions.  To minimize the number of
  changes, I did this by keeping the CMUCL instruction name the
  same, but it actually uses the prediction version.  This means,
  however, that you can't use the deprecated branch instructions
  on the V9.

  The disassembler, however, uses the branch-with-prediction
  instruction mnemonics, and should still be able to disassemble
  the deprecated branch instructions (I think).

o Added the conditional move instructions: conditional move
  integer/FP depending on the integer or FP condition code and
  conditional move integer/FP depending on the value of an integer
  register.

o The FCMP instructions can place its result into one of four FP
  condition registers on the V9.

o Unified the extended FP instructions by making the printer print
  the right thing instead of having several separate formats and
  macros for them.

o Added a :print-name keyword to the define-f3-inst macro.

o The ld instruction is printed as lduw on the V9 because that's
  what it is and does.

o Marked the deprecated V9 instructions but left them in.

o For the T instruction, set the type of the target to be the
  right size for the V9.  (It's only 7 bits instead of 13 on the V9.)
---
 compiler/sparc/insts.lisp | 867 ++++++++++++++++++++++++++++++++------
 1 file changed, 735 insertions(+), 132 deletions(-)

diff --git a/compiler/sparc/insts.lisp b/compiler/sparc/insts.lisp
index 10a0fe3e8..f651c0645 100644
--- a/compiler/sparc/insts.lisp
+++ b/compiler/sparc/insts.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/insts.lisp,v 1.23 2000/01/12 19:48:14 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/insts.lisp,v 1.24 2000/02/16 00:25:33 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -218,6 +218,117 @@
   (op2  :field (byte 3 22))
   (disp :field (byte 22 0) :type 'relative-label))
 
+;; Branch with prediction instruction for V9
+
+;; Currently only %icc and %xcc are used of the four possible values
+
+(defconstant integer-condition-registers
+  '(:icc :invalid-1 :xcc :invalid-2))
+
+(defconstant integer-cond-reg-name-vec
+  (coerce integer-condition-registers 'vector))
+
+(defparameter integer-condition-reg-symbols
+  (map 'vector
+       #'(lambda (name)
+	   (make-symbol (concatenate 'string "%" (string name))))
+       integer-condition-registers))
+
+(disassem:define-argument-type integer-condition-register
+    :printer #'(lambda (value stream dstate)
+		 (declare (stream stream) (fixnum value) (ignore dstate))
+		 (let ((regname (aref integer-condition-reg-symbols value)))
+		   (princ regname stream))))
+
+(defconstant branch-predictions
+  '(:pn :pt))
+
+(defconstant branch-predictions-name-vec
+  (coerce branch-predictions 'vector))
+
+(disassem:define-argument-type branch-prediction
+    :printer branch-predictions-name-vec)
+
+(defun integer-condition (condition-reg)
+  (declare (type (member :icc :xcc) condition-reg))
+  (or (position condition-reg integer-condition-registers)
+      (error "Unknown integer condition register:  ~S~%"
+	     condition-reg)))
+
+(defun branch-prediction (pred)
+  (or (position pred branch-predictions)
+      (error "Unknown branch prediction:  ~S~%Must be one of: ~S~%"
+	     pred branch-predictions)))
+
+(defconstant branch-pred-printer
+  `(:name (:unless (:constant ,branch-cond-true) cond)
+	  (:unless (a :constant 0) "," 'A)
+          (:unless (p :constant 1) "," 'pn)
+	  :tab
+	  cc
+	  ", "
+	  disp))
+
+(disassem:define-instruction-format
+    (format-2-branch-pred 32 :default-printer branch-pred-printer)
+  (op   :field (byte 2 30) :value 0)
+  (a    :field (byte 1 29) :value 0)
+  (cond :field (byte 4 25) :type 'branch-condition)
+  (op2  :field (byte 3 22))
+  (cc   :field (byte 2 20) :type 'integer-condition-register)
+  (p    :field (byte 1 19))
+  (disp :field (byte 19 0) :type 'relative-label))
+
+(defconstant fp-condition-registers
+  '(:fcc0 :fcc1 :fcc2 :fcc3))
+
+(defconstant fp-cond-reg-name-vec
+  (coerce fp-condition-registers 'vector))
+
+(defparameter fp-condition-reg-symbols
+  (map 'vector
+       #'(lambda (name)
+	   (make-symbol (concatenate 'string "%" (string name))))
+       fp-condition-registers))
+
+(disassem:define-argument-type fp-condition-register
+    :printer #'(lambda (value stream dstate)
+		 (declare (stream stream) (fixnum value) (ignore dstate))
+		 (let ((regname (aref fp-condition-reg-symbols value)))
+		   (princ regname stream))))
+
+(disassem:define-argument-type fp-condition-register-shifted
+    :printer #'(lambda (value stream dstate)
+		 (declare (stream stream) (fixnum value) (ignore dstate))
+		 (let ((regname (aref fp-condition-reg-symbols (ash value -1))))
+		   (princ regname stream))))
+
+(defun fp-condition (condition-reg)
+  (or (position condition-reg fp-condition-registers)
+      (error "Unknown integer condition register:  ~S~%"
+	     condition-reg)))
+
+(defconstant fp-branch-pred-printer
+  `(:name (:unless (:constant ,branch-cond-true) cond)
+	  (:unless (a :constant 0) "," 'A)
+	  (:unless (p :constant 1) "," 'pn)
+	  :tab
+	  fcc
+	  ", "
+	  disp))
+  
+(disassem:define-instruction-format
+    (format-2-fp-branch-pred 32 :default-printer fp-branch-pred-printer)
+  (op   :field (byte 2 30) :value 0)
+  (a    :field (byte 1 29) :value 0)
+  (cond :field (byte 4 25) :type 'branch-fp-condition)
+  (op2  :field (byte 3 22))
+  (fcc  :field (byte 2 20) :type 'fp-condition-register)
+  (p    :field (byte 1 19))
+  (disp :field (byte 19 0) :type 'relative-label))
+  
+
+
 (disassem:define-instruction-format
     (format-2-unimp 32 :default-printer '(:name :tab data))
   (op     :field (byte 2 30) :value 0)
@@ -271,67 +382,183 @@
   (rs2  :field (byte 5 0) :type 'fp-reg))
 
 ;;; Floating point comparison instructions encoding.
+
+;; This is a merge of the instructions for FP comparison and FP
+;; conditional moves available in the Sparc V9.  The main problem is
+;; that the new instructions use part of the opcode space used by the
+;; comparison instructions.  In particular, the OPF field is arranged
+;; as so:
+;;
+;; Bit          1       0
+;;              3       5
+;; FMOVcc	0nn0000xx	%fccn
+;;		1000000xx	%icc
+;;		1100000xx	%xcc
+;; FMOVR	0ccc001yy
+;; FCMP		001010zzz
+;;
+;; So we see that if we break up the OPF field into 4 pieces, opf0,
+;; opf1, opf2, and opf3, we can distinguish between these
+;; instructions. So bit 9 (opf2) can be used to distinguish between
+;; FCMP and the rest.  Also note that the nn field overlaps with the
+;; ccc.  We need to take this into account as well.
+;;
 (disassem:define-instruction-format
-    (format-cmp-fpop 32 :default-printer '(:name :tab rs1 ", " rs2))
+    (format-fpop2 32
+		  :default-printer #-sparc-v9 '(:name :tab rs1 ", " rs2)
+		                   #+sparc-v9 '(:name :tab rd ", " rs1 ", " rs2))
   (op	:field (byte 2 30))
   (rd 	:field (byte 5 25) :value 0)
   (op3  :field (byte 6 19))
-  (rs1  :field (byte 5 14) :type 'fp-reg)
-  (opf  :field (byte 9 5))
+  (rs1  :field (byte 5 14))
+  (opf0 :field (byte 1 13))
+  (opf1 :field (byte 3 10))
+  (opf2 :field (byte 1 9))
+  (opf3 :field (byte 4 5))
   (rs2  :field (byte 5 0) :type 'fp-reg))
 
-;;; Double and long float instruction format of the sparc v9.
+;;; Shift instructions
 (disassem:define-instruction-format
-    (format-binary-ext-fpop 32
-     :default-printer '(:name :tab rs1 ", " rs2 ", " rd))
+    (format-3-shift-reg 32 :default-printer f3-printer)
   (op	:field (byte 2 30))
-  (rd 	:field (byte 5 25) :type 'fp-ext-reg)
+  (rd    :field (byte 5 25) :type 'reg)
   (op3  :field (byte 6 19))
-  (rs1  :field (byte 5 14) :type 'fp-ext-reg)
-  (opf  :field (byte 9 5))
-  (rs2  :field (byte 5 0) :type 'fp-ext-reg))
+  (rs1   :field (byte 5 14) :type 'reg)
+  (i     :field (byte 1 13) :value 0)
+  (x     :field (byte 1 12))
+  (asi   :field (byte 7 5) :value 0)
+  (rs2   :field (byte 5 0) :type 'reg))
 
-;;; Double and long floating point load/save instructions encoding.
 (disassem:define-instruction-format
-    (format-unary-ext-fpop 32 :default-printer '(:name :tab rs2 ", " rd))
+    (format-3-shift-immed 32 :default-printer f3-printer)
   (op	:field (byte 2 30))
-  (rd 	:field (byte 5 25) :type 'fp-ext-reg)
+  (rd    :field (byte 5 25) :type 'reg)
   (op3  :field (byte 6 19))
-  (rs1  :field (byte 5 14) :value 0)
-  (opf  :field (byte 9 5))
-  (rs2  :field (byte 5 0) :type 'fp-ext-reg))
+  (rs1   :field (byte 5 14) :type 'reg)
+  (i     :field (byte 1 13) :value 1)
+  (x     :field (byte 1 12))
+  (immed :field (byte 12 0) :sign-extend nil))
+
+
+;;; Conditional moves (only available for Sparc V9 architectures)
 
-;;; Double and long floating point comparison instructions encoding.
+;; The names of all of the condition registers on the V9: 4 FP
+;; conditions, the original integer condition register and the new
+;; extended register.  The :reserved register is reserved on the V9.
+
+(defconstant cond-move-condition-registers
+  '(:fcc0 :fcc1 :fcc2 :fcc3 :icc :reserved :xcc :reserved))
+(defconstant cond-move-cond-reg-name-vec
+  (coerce cond-move-condition-registers 'vector))
+
+(deftype cond-move-condition-register ()
+    `(member ,@(remove :reserved cond-move-condition-registers)))
+
+(defparameter cond-move-condition-reg-symbols
+  (map 'vector
+       #'(lambda (name)
+	   (make-symbol (concatenate 'string "%" (string name))))
+       cond-move-condition-registers))
+
+(disassem:define-argument-type cond-move-condition-register
+    :printer #'(lambda (value stream dstate)
+		 (declare (stream stream) (fixnum value) (ignore dstate))
+		 (let ((regname (aref cond-move-condition-reg-symbols value)))
+		   (princ regname stream))))
+
+;; From the given condition register, figure out what the cc2, cc1,
+;; and cc0 bits should be.  Return cc2 and cc1/cc0 concatenated.
+(defun cond-move-condition-parts (condition-reg)
+  (let ((posn (position condition-reg cond-move-condition-registers)))
+    (if posn
+	(truncate posn 4)
+	(error "Unknown conditional move condition register:  ~S~%"
+	       condition-reg))))
+
+(defun cond-move-condition (condition-reg)
+  (or (position condition-reg cond-move-condition-registers)
+      (error "Unknown conditional move condition register:  ~S~%")))
+
+(defconstant cond-move-printer
+  `(:name cond :tab
+          cc ", " (:choose immed rs2) ", " rd))
+
+;; Conditional move integer register on integer or FP condition code
 (disassem:define-instruction-format
-    (format-cmp-ext-fpop 32 :default-printer '(:name :tab rs1 ", " rs2))
+    (format-4-cond-move 32 :default-printer cond-move-printer)
   (op	:field (byte 2 30))
-  (rd 	:field (byte 5 25) :value 0)
+  (rd    :field (byte 5 25) :type 'reg)
   (op3  :field (byte 6 19))
-  (rs1  :field (byte 5 14) :type 'fp-ext-reg)
-  (opf  :field (byte 9 5))
-  (rs2  :field (byte 5 0) :type 'fp-ext-reg))
+  (cc2   :field (byte 1 18) :value 1)
+  (cond  :field (byte 4 14) :type 'branch-condition)
+  (i     :field (byte 1 13) :value 0)
+  (cc    :field (byte 2 11) :type 'integer-condition-register)
+  (empty :field (byte 6 5) :value 0)
+  (rs2   :field (byte 5 0) :type 'reg))
 
-;;; Shift instructions
 (disassem:define-instruction-format
-    (format-3-shift-reg 32 :default-printer f3-printer)
+    (format-4-cond-move-immed 32 :default-printer cond-move-printer)
+  (op    :field (byte 2 30))
+  (rd    :field (byte 5 25) :type 'reg)
+  (op3   :field (byte 6 19))
+  (cc2   :field (byte 1 18) :value 1)
+  (cond  :field (byte 4 14) :type 'branch-condition)
+  (i     :field (byte 1 13) :value 1)
+  (cc    :field (byte 2 11) :type 'integer-condition-register)
+  (immed :field (byte 11 0) :sign-extend t))
+
+;; Floating-point versions of the above integer conditional moves
+(defconstant cond-fp-move-printer
+  `(:name rs1 :tab opf1 ", " rs2 ", " rd))
+
+;;; Conditional move on integer register condition (only on Sparc
+;;; V9). That is, move an integer register if some other integer
+;;; register satisfies some condition.
+
+(defconstant cond-move-integer-conditions
+  '(:reserved :z :lez :lz :reserved :nz :gz :gez))
+(defconstant cond-move-integer-condition-vec
+  (coerce cond-move-integer-conditions 'vector))
+
+(deftype cond-move-integer-condition ()
+  `(member ,@(remove :reserved cond-move-integer-conditions)))
+
+(disassem:define-argument-type register-condition
+    :printer #'(lambda (value stream dstate)
+		 (declare (stream stream) (fixnum value) (ignore dstate))
+		 (let ((regname (aref cond-move-integer-condition-vec value)))
+		   (princ regname stream))))
+
+(defconstant cond-move-integer-printer
+  `(:name rcond :tab rs1 ", " (:choose immed rs2) ", " rd))
+
+(defun register-condition (rcond)
+  (or (position rcond cond-move-integer-conditions)
+      (error "Unknown register condition:  ~S~%")))
+
+(disassem:define-instruction-format
+    (format-4-cond-move-integer 32 :default-printer cond-move-integer-printer)
   (op    :field (byte 2 30))
   (rd    :field (byte 5 25) :type 'reg)
   (op3   :field (byte 6 19))
   (rs1   :field (byte 5 14) :type 'reg)
   (i     :field (byte 1 13) :value 0)
-  (x     :field (byte 1 12))
-  (asi   :field (byte 7 5) :value 0)
+  (rcond :field (byte 3 10) :type 'register-condition)
+  (opf   :field (byte 5 5))
   (rs2   :field (byte 5 0) :type 'reg))
 
 (disassem:define-instruction-format
-    (format-3-shift-immed 32 :default-printer f3-printer)
+    (format-4-cond-move-integer-immed 32 :default-printer cond-move-integer-printer)
   (op    :field (byte 2 30))
   (rd    :field (byte 5 25) :type 'reg)
   (op3   :field (byte 6 19))
   (rs1   :field (byte 5 14) :type 'reg)
   (i     :field (byte 1 13) :value 1)
-  (x     :field (byte 1 12))
-  (immed :field (byte 12 0) :sign-extend nil))
+  (rcond :field (byte 3 10) :type 'register-condition)
+  (immed :field (byte 10 0) :sign-extend t))
+
+(defconstant cond-fp-move-integer-printer
+  `(:name opf1 :tab rs1 ", " rs2 ", " rd))
 
 
 ;;;; Primitive emitters.
@@ -351,6 +578,12 @@
 (define-emitter emit-format-2-branch 32
   (byte 2 30) (byte 1 29) (byte 4 25) (byte 3 22) (byte 22 0))
 
+;; Integer and FP branches with prediction for V9
+(define-emitter emit-format-2-branch-pred 32
+  (byte 2 30) (byte 1 29) (byte 4 25) (byte 3 22) (byte 2 20) (byte 1 19) (byte 19 0))
+(define-emitter emit-format-2-fp-branch-pred 32
+  (byte 2 30) (byte 1 29) (byte 4 25) (byte 3 22) (byte 2 20) (byte 1 19) (byte 19 0))
+  
 (define-emitter emit-format-2-unimp 32
   (byte 2 30) (byte 5 25) (byte 3 22) (byte 22 0))
 
@@ -364,6 +597,11 @@
 (define-emitter emit-format-3-fpop 32
   (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 9 5) (byte 5 0))
 
+(define-emitter emit-format-3-fpop2 32
+  (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14)
+  (byte 1 13) (byte 3 10) (byte 1 9) (byte 4 5)
+  (byte 5 0))
+
 ;;; Shift instructions
 
 (define-emitter emit-format-3-shift-reg 32
@@ -373,6 +611,22 @@
 (define-emitter emit-format-3-shift-immed 32
   (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 1 13) (byte 1 12) (byte 12 0))
 
+;;; Conditional moves
+
+;; Conditional move in condition code
+(define-emitter emit-format-4-cond-move 32
+  (byte 2 30) (byte 5 25) (byte 6 19) (byte 1 18) (byte 4 14) (byte 1 13) (byte 2 11)
+  (byte 11 0))
+
+;; Conditional move on integer condition
+(define-emitter emit-format-4-cond-move-integer 32
+  (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 1 13) (byte 3 10) (byte 5 5)
+  (byte 5 0))
+
+(define-emitter emit-format-4-cond-move-integer-immed 32
+  (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 1 13) (byte 3 10)
+  (byte 10 0))
+
 
 ;;;; Most of the format-3-instructions.
 
@@ -443,7 +697,7 @@
   (with-ref-format `(:NAME :TAB rd ", " ,ref-format)))
 
 (defmacro define-f3-inst (name op op3 &key fixup load-store (dest-kind 'reg)
-			       (printer :default) reads writes flushable)
+			       (printer :default) reads writes flushable print-name)
   (let ((printer
 	 (if (eq printer :default)
 	     (case load-store
@@ -462,10 +716,12 @@
 		      '(type (or tn (signed-byte 13) null) src1 src2)))
        (:printer format-3-reg
 		 ((op ,op) (op3 ,op3) (rd nil :type ',dest-kind))
-	 	 ,printer)
+	 	 ,printer
+	         ,@(when print-name `(:print-name ,print-name)))
        (:printer format-3-immed
 	 	 ((op ,op) (op3 ,op3) (rd nil :type ',dest-kind))
-	 	 ,printer)
+	 	 ,printer
+	         ,@(when print-name `(:print-name ,print-name)))
        ,@(when flushable
 	   '((:attributes flushable)))
        (:dependencies
@@ -510,11 +766,9 @@
      (:declare (type tn dst)
 	       (type (or tn (unsigned-byte 6) null) src1 src2))
      (:printer format-3-shift-reg
-	       ((op ,op) (op3 ,op3) (x, (if extended 1 0)) (rd nil :type 'reg))
-	       :default)
+	       ((op ,op) (op3 ,op3) (x ,(if extended 1 0)) (i 0)))
      (:printer format-3-shift-immed
-	       ((op ,op) (op3 ,op3) (x ,(if extended 1 0)) (rd nil :type 'reg))
-	       :default)
+	       ((op ,op) (op3 ,op3) (x ,(if extended 1 0)) (i 1)))
      (:dependencies
       (reads src1)
       (if src2 (reads src2) (reads dst))
@@ -529,32 +783,61 @@
 (define-f3-inst ldsh #b11 #b001010 :load-store :load)
 (define-f3-inst ldub #b11 #b000001 :load-store :load)
 (define-f3-inst lduh #b11 #b000010 :load-store :load)
-(define-f3-inst ld #b11 #b000000 :load-store :load)
+
+;; This instruction is called lduw for V9 , but looks exactly like ld
+;; on previous architectures.
+(define-f3-inst ld #b11 #b000000 :load-store :load
+		#+sparc-v9 :print-name #+sparc-v9 'lduw)
+
+(define-f3-inst ldsw #b11 #b001000 :load-store :load) ; v9
+
+;; ldd is deprecated on the Sparc V9.
 (define-f3-inst ldd #b11 #b000011 :load-store :load)
+
+(define-f3-inst ldx #b11 #b001011 :load-store :load) ; v9
+
 (define-f3-inst ldf #b11 #b100000 :dest-kind fp-reg :load-store :load)
 (define-f3-inst lddf #b11 #b100011 :dest-kind fp-reg :load-store :load)
 (define-f3-inst ldxf #b11 #b100010 :dest-kind fp-reg :load-store :load)	; v9
 (define-f3-inst stb #b11 #b000101 :load-store :store)
 (define-f3-inst sth #b11 #b000110 :load-store :store)
 (define-f3-inst st #b11 #b000100 :load-store :store)
+
+;; std is deprecated on the Sparc V9.
 (define-f3-inst std #b11 #b000111 :load-store :store)
+
+(define-f3-inst stx #b11 #b001110 :load-store :store) ; v9
+
 (define-f3-inst stf #b11 #b100100 :dest-kind fp-reg :load-store :store)
 (define-f3-inst stdf #b11 #b100111 :dest-kind fp-reg :load-store :store)
 (define-f3-inst stxf #b11 #b100110 :dest-kind fp-reg :load-store :store) ; v9
 (define-f3-inst ldstub #b11 #b001101 :load-store t)
+
+;; swap is deprecated on the Sparc V9
 (define-f3-inst swap #b11 #b001111 :load-store t)
+
 (define-f3-inst add #b10 #b000000 :fixup t)
 (define-f3-inst addcc #b10 #b010000 :writes :psr)
 (define-f3-inst addx #b10 #b001000 :reads :psr)
 (define-f3-inst addxcc #b10 #b011000 :reads :psr :writes :psr)
 (define-f3-inst taddcc #b10 #b100000 :writes :psr)
+
+;; taddcctv is deprecated on the Sparc V9.  Use taddcc and bpvs or
+;; taddcc and trap to get a similar effect.  (Requires changing the C
+;; code though!)
 (define-f3-inst taddcctv #b10 #b100010 :writes :psr)
+
 (define-f3-inst sub #b10 #b000100)
 (define-f3-inst subcc #b10 #b010100 :writes :psr)
 (define-f3-inst subx #b10 #b001100 :reads :psr)
 (define-f3-inst subxcc #b10 #b011100 :reads :psr :writes :psr)
 (define-f3-inst tsubcc #b10 #b100001 :writes :psr)
+
+;; tsubcctv is deprecated on the Sparc V9.  Use tsubcc and bpvs or
+;; tsubcc and trap to get a similar effect.  (Requires changing the C
+;; code though!)
 (define-f3-inst tsubcctv #b10 #b100011 :writes :psr)
+
 (define-f3-inst mulscc #b10 #b100100 :reads :y :writes (:psr :y))
 (define-f3-inst and #b10 #b000001)
 (define-f3-inst andcc #b10 #b010001 :writes :psr)
@@ -579,6 +862,8 @@
 (define-f3-inst save #b10 #b111100 :reads :psr :writes :psr)
 (define-f3-inst restore #b10 #b111101 :reads :psr :writes :psr)
 
+;; smul, smulcc, umul, umulcc, sdiv, sdivcc, udiv, and udivcc are
+;; deprecated on the Sparc V9.  Use mulx, sdivx, and udivx instead.
 (define-f3-inst smul #b10 #b001011 :writes :y)			; v8
 (define-f3-inst smulcc #b10 #b011011 :writes (:psr :y))		; v8
 (define-f3-inst umul #b10 #b001010 :writes :y)			; v8
@@ -597,22 +882,46 @@
 
 ;;;; Random instructions.
 
+;; ldfsr is deprecated on the Sparc V9.  Use ldxfsr instead
 (define-instruction ldfsr (segment src1 src2)
   (:declare (type tn src1) (type (signed-byte 13) src2))
-  (:printer format-3-immed ((op #b11) (op3 #b100001)))
+  (:printer format-3-immed ((op #b11) (op3 #b100001) (rd 0)))
   :pinned
   (:delay 0)
   (:emitter (emit-format-3-immed segment #b11 0 #b100001
 				 (reg-tn-encoding src1) 1 src2)))
 
+#+sparc-64
+(define-instruction ldxfsr (segment src1 src2)
+  (:declare (type tn src1) (type (signed-byte 13) src2))
+  (:printer format-3-immed ((op #b11) (op3 #b100001) (rd 1))
+	    '(:name :tab "[" rs1 (:unless (:constant 0) "+" immed) "], %FSR")
+	    :print-name 'ldx)
+  :pinned
+  (:delay 0)
+  (:emitter (emit-format-3-immed segment #b11 1 #b100001
+				 (reg-tn-encoding src1) 1 src2)))
+  
+;; stfsr is deprecated on the Sparc V9.  Use stxfsr instead.
 (define-instruction stfsr (segment src1 src2)
   (:declare (type tn src1) (type (signed-byte 13) src2))
-  (:printer format-3-immed ((op #b11) (op3 #b100101)))
+  (:printer format-3-immed ((op #b11) (op3 #b100101) (rd 0)))
   :pinned
   (:delay 0)
   (:emitter (emit-format-3-immed segment #b11 0 #b100101 
 				 (reg-tn-encoding src1) 1 src2)))
 
+#+sparc-64
+(define-instruction stxfsr (segment src1 src2)
+  (:declare (type tn src1) (type (signed-byte 13) src2))
+  (:printer format-3-immed ((op #b11) (op3 #b100101) (rd 1))
+	    '(:name :tab "%FSR, [" rs1 "+" (:unless (:constant 0) "+" immed) "]")
+	    :print-name 'stx)
+  :pinned
+  (:delay 0)
+  (:emitter (emit-format-3-immed segment #b11 1 #b100101 
+				 (reg-tn-encoding src1) 1 src2)))
+
 (eval-when (compile load eval)
   (defun sethi-arg-printer (value stream dstate)
     (declare (ignore dstate))
@@ -635,6 +944,8 @@
       (note-fixup segment :sethi src1)
       (emit-format-2-immed segment #b00 (reg-tn-encoding dst) #b100 0)))))
 			   
+;; rdy is deprecated on the Sparc V9.  It's not needed with 64-bit
+;; registers.
 (define-instruction rdy (segment dst)
   (:declare (type tn dst))
   (:printer format-3-immed ((op #b10) (op3 #b101000) (rs1 0) (immed 0))
@@ -647,6 +958,8 @@
 (defconstant wry-printer
   '('WR :tab rs1 (:unless (:constant 0) ", " (:choose immed rs2)) ", " '%Y))
 
+;; wry is deprecated on the Sparc V9.  It's not needed with 64-bit
+;; registers.
 (define-instruction wry (segment src1 &optional src2)
   (:declare (type tn src1) (type (or (signed-byte 13) tn null) src2))
   (:printer format-3-reg ((op #b10) (op3 #b110000) (rd 0)) wry-printer)
@@ -720,7 +1033,8 @@
 
 (define-instruction unimp (segment data)
   (:declare (type (unsigned-byte 22) data))
-  (:printer format-2-unimp () :default :control #'unimp-control)
+  (:printer format-2-unimp () :default :control #'unimp-control
+	    :print-name #-sparc-v9 'unimp #+sparc-v9 'illtrap)
   (:delay 0)
   (:emitter (emit-format-2-unimp segment 0 0 0 data)))
 
@@ -728,6 +1042,8 @@
 
 ;;;; Branch instructions.
 
+;; The branch instruction is deprecated on the Sparc V9.  Use the
+;; branch with prediction instructions instead.
 (defun emit-relative-branch (segment a op2 cond-or-target target &optional fp)
   (emit-back-patch segment 4
     #'(lambda (segment posn)
@@ -745,6 +1061,48 @@
 	      (error "Offset of BA must be positive"))
 	    offset)))))
 
+#+sparc-v9
+(defun emit-relative-branch-integer (segment a op2 cond-or-target target &optional (cc :icc) (pred :pt))
+  (emit-back-patch segment 4
+    #'(lambda (segment posn)
+	(unless target
+	  (setf target cond-or-target)
+	  (setf cond-or-target :t))
+	(emit-format-2-branch-pred
+	  segment #b00 a
+	  (branch-condition cond-or-target)
+	  op2
+	  (integer-condition cc)
+	  (branch-prediction pred)
+	  (let ((offset (ash (- (label-position target) posn) -2)))
+	    (when (and (= a 1) (> 0 offset))
+	      (error "Offset of BA must be positive"))
+	    offset)))))
+
+#+sparc-v9
+(defun emit-relative-branch-fp (segment a op2 cond-or-target target &optional (cc :icc) (pred :pt))
+  (emit-back-patch segment 4
+    #'(lambda (segment posn)
+	(unless target
+	  (setf target cond-or-target)
+	  (setf cond-or-target :t))
+	(emit-format-2-branch-pred
+	  segment #b00 a
+	  (fp-branch-condition cond-or-target)
+	  op2
+	  (fp-condition cc)
+	  (branch-prediction pred)
+	  (let ((offset (ash (- (label-position target) posn) -2)))
+	    (when (and (= a 1) (> 0 offset))
+	      (error "Offset of BA must be positive"))
+	    offset)))))
+
+;; So that I don't have to go change the syntax of every single use of
+;; branches, I'm keeping the Lisp instruction names the same.  They
+;; just get translated to the branch with prediction
+;; instructions. However, the disassembler uses the correct V9
+;; mnemonic.
+#-sparc-v9
 (define-instruction b (segment cond-or-target &optional target)
   (:declare (type (or label branch-condition) cond-or-target)
 	    (type (or label null) target))
@@ -755,6 +1113,20 @@
   (:emitter
    (emit-relative-branch segment 0 #b010 cond-or-target target)))
 
+#+sparc-v9
+(define-instruction b (segment cond-or-target &optional target cc pred)
+  (:declare (type (or label branch-condition) cond-or-target)
+	    (type (or label null) target))
+  (:printer format-2-branch-pred ((op #b00) (op2 #b001))
+	    branch-pred-printer
+	    :print-name 'bp)
+  (:attributes branch)
+  (:dependencies (reads :psr))
+  (:delay 1)
+  (:emitter
+   (emit-relative-branch-integer segment 0 #b001 cond-or-target target (or cc :icc) (or pred :pt))))
+
+#-sparc-v9
 (define-instruction ba (segment cond-or-target &optional target)
   (:declare (type (or label branch-condition) cond-or-target)
 	    (type (or label null) target))
@@ -767,9 +1139,24 @@
   (:emitter
    (emit-relative-branch segment 1 #b010 cond-or-target target)))
 
+#+sparc-v9
+(define-instruction ba (segment cond-or-target &optional target cc pred)
+  (:declare (type (or label branch-condition) cond-or-target)
+	    (type (or label null) target))
+  (:printer format-2-branch ((op #b00) (op2 #b001) (a 1))
+            nil
+            :print-name 'bp)
+  (:attributes branch)
+  (:dependencies (reads :psr))
+  (:delay 0)
+  (:emitter
+   (emit-relative-branch-integer segment 1 #b001 cond-or-target target (or cc :icc) (or pred :pt))))
+
 (define-instruction t (segment condition target)
   (:declare (type branch-condition condition)
-	    (type (or (signed-byte 13) (unsigned-byte 13)) target))
+	    (type #-sparc-v9 (or (signed-byte 13) (unsigned-byte 13))
+		  #+sparc-v9 (or (signed-byte 7) (unsigned-byte 7))
+		  target))
   (:printer format-3-immed ((op #b10)
                             (rd nil :type 'branch-condition)
                             (op3 #b111010)
@@ -781,6 +1168,9 @@
   (:emitter (emit-format-3-immed segment #b10 (branch-condition condition)
 				 #b111010 0 1 target)))
 
+;; Same as for the branch instructions.  On the Sparc V9, we will use
+;; the FP branch with prediction instructions instead.
+#-sparc-v9
 (define-instruction fb (segment condition target)
   (:declare (type fp-branch-condition condition) (type label target))
   (:printer format-2-branch ((op #B00)
@@ -792,6 +1182,18 @@
   (:emitter
    (emit-relative-branch segment 0 #b110 condition target t)))
 
+#+sparc-v9
+(define-instruction fb (segment condition target &optional fcc pred)
+  (:declare (type fp-branch-condition condition) (type label target))
+  (:printer format-2-fp-branch-pred ((op #b00) (op2 #b101))
+	    fp-branch-pred-printer
+	    :print-name 'fbp)
+  (:attributes branch)
+  (:dependencies (reads :fsr))
+  (:delay 1)
+  (:emitter
+   (emit-relative-branch-fp segment 0 #b101 condition target (or fcc :fcc0) (or pred :pt))))
+
 (defconstant jal-printer
   '(:name :tab
           (:choose (rs1 (:unless (:constant 0) (:plus-integer immed)))
@@ -856,10 +1258,14 @@
 
 (eval-when (compile eval)
 
-(defmacro define-unary-fp-inst (name opf &key reads)
+(defmacro define-unary-fp-inst (name opf &key reads extended)
   `(define-instruction ,name (segment dst src)
      (:declare (type tn dst src))
-     (:printer format-unary-fpop ((op #b10) (op3 #b110100) (opf ,opf) (rs1 0)))
+     (:printer format-unary-fpop
+       ((op #b10) (op3 #b110100) (opf ,opf)
+	(rs1 0)
+	(rs2 nil :type ',(if extended 'fp-ext-reg 'fp-reg))
+	(rd nil :type ',(if extended 'fp-ext-reg 'fp-reg))))
      (:dependencies
       ,@(when reads
 	  `((reads ,reads)))
@@ -871,10 +1277,15 @@
 		#b110100 0 ,opf (fp-reg-tn-encoding src)))))
 
 (defmacro define-binary-fp-inst (name opf &key (op3 #b110100)
-				      reads writes delay)
+				      reads writes delay extended)
   `(define-instruction ,name (segment dst src1 src2)
      (:declare (type tn dst src1 src2))
-     (:printer format-binary-fpop ((op #b10) (op3 ,op3) (opf ,opf)))
+     (:printer format-binary-fpop
+      ((op #b10) (op3 ,op3) (opf ,opf)
+       (rs1 nil :type ',(if extended 'fp-ext-reg 'fp-reg))
+       (rs2 nil :type ',(if extended 'fp-ext-reg 'fp-reg))
+       (rd nil :type ',(if extended 'fp-ext-reg 'fp-reg))
+       ))
      (:dependencies
       ,@(when reads
 	  `((reads ,reads)))
@@ -890,85 +1301,56 @@
 		,op3 (fp-reg-tn-encoding src1) ,opf
 		(fp-reg-tn-encoding src2)))))
 
-(defmacro define-cmp-fp-inst (name opf)
-  `(define-instruction ,name (segment src1 src2)
-     (:declare (type tn src1 src2))
-     (:printer format-cmp-fpop ((op #b10) (op3 #b110101) (opf ,opf) (rd 0)))
+(defmacro define-cmp-fp-inst (name opf &key extended)
+  (let ((opf0 #b0)
+	(opf1 #b010)
+	(opf2 #b1))
+    `(define-instruction ,name (segment src1 src2 &optional (fcc :fcc0))
+       (:declare (type tn src1 src2)
+	         (type (member :fcc0 :fcc1 :fcc2 :fcc3) fcc))
+       (:printer format-fpop2
+		 ((op #b10)
+		  (op3 #b110101)
+		  (opf0 ,opf0)
+		  (opf1 ,opf1)
+		  (opf2 ,opf2)
+		  (opf3 ,opf)
+		  (rs1 nil :type ',(if extended 'fp-ext-reg 'fp-reg))
+		  (rs2 nil :type ',(if extended 'fp-ext-reg 'fp-reg))
+		  #-sparc-v9
+		  (rd 0)
+		  #+sparc-v9
+		  (rd nil :type 'fp-condition-register))
+	)
      (:dependencies
       (reads src1)
       (reads src2)
       (writes :fsr))
      ;; The Sparc V9 doesn't need a delay after a FP compare.
      (:delay #-sparc-v9 1 #+sparc-v9 0)
-     (:emitter (emit-format-3-fpop segment #b10 0 #b110101
-		(fp-reg-tn-encoding src1) ,opf (fp-reg-tn-encoding src2)))))
-
-;;; Double and long float instruction encodings.
-
-(defmacro define-unary-ext-fp-inst (name opf &key reads)
-  `(define-instruction ,name (segment dst src)
-     (:declare (type tn dst src))
-     (:printer format-unary-ext-fpop ((op #b10) (op3 #b110100) (opf ,opf)
-				      (rs1 0)))
-     (:dependencies
-      ,@(when reads
-	  `((reads ,reads)))
-      (reads dst)
-      (reads src)
-      (writes dst))
-     (:delay 0)
-     (:emitter (emit-format-3-fpop segment #b10
-		(fp-reg-tn-encoding dst) #b110100 0 ,opf
-		(fp-reg-tn-encoding src)))))
-
-(defmacro define-binary-ext-fp-inst (name opf &key (op3 #b110100)
-					  reads writes delay)
-  `(define-instruction ,name (segment dst src1 src2)
-     (:declare (type tn dst src1 src2))
-     (:printer format-binary-ext-fpop ((op #b10) (op3 ,op3) (opf ,opf)))
-     (:dependencies
-      ,@(when reads
-	  `((reads ,reads)))
-      (reads src1)
-      (reads src2)
-      ,@(when writes
-	  `((writes ,writes)))
-      (writes dst))
-     ,@(if delay
-	   `((:delay ,delay))
-	   '((:delay 0)))
-     (:emitter (emit-format-3-fpop segment #b10
-		(fp-reg-tn-encoding dst) ,op3 (fp-reg-tn-encoding src1) ,opf
-		(fp-reg-tn-encoding src2)))))
-
-(defmacro define-cmp-ext-fp-inst (name opf)
-  `(define-instruction ,name (segment src1 src2)
-     (:declare (type tn src1 src2))
-     (:printer format-cmp-ext-fpop ((op #b10) (op3 #b110101) (opf ,opf)
-				    (rd 0)))
-     (:dependencies
-      (reads src1)
-      (reads src2)
-      (writes :fsr))
-     ;; The Sparc V9 doesn't need a delay after a FP compare.
-     (:delay #-sparc-v9 1 #+sparc-v9 0)
-     (:emitter (emit-format-3-fpop segment #b10 0 #b110101
-		(fp-reg-tn-encoding src1) ,opf (fp-reg-tn-encoding src2)))))
+       (:emitter
+	(emit-format-3-fpop2 segment #b10
+	                     (or (position fcc '(:fcc0 :fcc1 :fcc2 :fcc3))
+				 0)
+	                     #b110101
+			     (fp-reg-tn-encoding src1)
+			     ,opf0 ,opf1 ,opf2 ,opf
+			     (fp-reg-tn-encoding src2))))))
 
 ); eval-when (compile eval)
 
 
 (define-unary-fp-inst fitos #b011000100 :reads :fsr)
-(define-unary-ext-fp-inst fitod #b011001000 :reads :fsr)
-(define-unary-ext-fp-inst fitox #b011001100 :reads :fsr)	; v8
+(define-unary-fp-inst fitod #b011001000 :reads :fsr :extended t)
+(define-unary-fp-inst fitox #b011001100 :reads :fsr :extended t)	; v8
 
 (define-unary-fp-inst fstoir #b011000001 :reads :fsr)
-(define-unary-ext-fp-inst fdtoir #b011000010 :reads :fsr)
-(define-unary-ext-fp-inst fxtoir #b011000011 :reads :fsr)
+(define-unary-fp-inst fdtoir #b011000010 :reads :fsr :extended t)
+(define-unary-fp-inst fxtoir #b011000011 :reads :fsr :extended t)
 
 (define-unary-fp-inst fstoi #b011010001)
-(define-unary-ext-fp-inst fdtoi #b011010010)
-(define-unary-ext-fp-inst fxtoi #b011010011)	; v8
+(define-unary-fp-inst fdtoi #b011010010 :extended t)
+(define-unary-fp-inst fxtoi #b011010011 :extended t)	; v8
 
 (define-unary-fp-inst fstod #b011001001 :reads :fsr)
 (define-unary-fp-inst fstox #b011001101 :reads :fsr)	; v8
@@ -978,43 +1360,43 @@
 (define-unary-fp-inst fxtod #b011001011 :reads :fsr)	; v8
 
 (define-unary-fp-inst fmovs #b000000001)
-(define-unary-ext-fp-inst fmovd #b000000010)	; v9
-(define-unary-ext-fp-inst fmovx #b000000011)	; v9
+(define-unary-fp-inst fmovd #b000000010 :extended t)	; v9
+(define-unary-fp-inst fmovx #b000000011 :extended t)	; v9
 
 (define-unary-fp-inst fnegs #b000000101)
-(define-unary-ext-fp-inst fnegd #b000000110)	; v9
-(define-unary-ext-fp-inst fnegx #b000000111)	; v9
+(define-unary-fp-inst fnegd #b000000110 :extended t)	; v9
+(define-unary-fp-inst fnegx #b000000111 :extended t)	; v9
 
 (define-unary-fp-inst fabss #b000001001)
-(define-unary-ext-fp-inst fabsd #b000001010)	; v9
-(define-unary-ext-fp-inst fabsx #b000001011)	; v9
+(define-unary-fp-inst fabsd #b000001010 :extended t)	; v9
+(define-unary-fp-inst fabsx #b000001011 :extended t)	; v9
 
 (define-unary-fp-inst fsqrts #b000101001 :reads :fsr)		; V7
-(define-unary-ext-fp-inst fsqrtd #b000101010 :reads :fsr)	; V7
-(define-unary-ext-fp-inst fsqrtx #b000101011 :reads :fsr)	; v8
+(define-unary-fp-inst fsqrtd #b000101010 :reads :fsr :extended t)	; V7
+(define-unary-fp-inst fsqrtx #b000101011 :reads :fsr :extended t)	; v8
 
 (define-binary-fp-inst fadds #b001000001)
-(define-binary-ext-fp-inst faddd #b001000010)
-(define-binary-ext-fp-inst faddx #b001000011)	; v8
+(define-binary-fp-inst faddd #b001000010 :extended t)
+(define-binary-fp-inst faddx #b001000011 :extended t)	; v8
 (define-binary-fp-inst fsubs #b001000101)
-(define-binary-ext-fp-inst fsubd #b001000110)
-(define-binary-ext-fp-inst fsubx #b001000111)	; v8
+(define-binary-fp-inst fsubd #b001000110 :extended t)
+(define-binary-fp-inst fsubx #b001000111 :extended t)	; v8
 
 (define-binary-fp-inst fmuls #b001001001)
-(define-binary-ext-fp-inst fmuld #b001001010)
-(define-binary-ext-fp-inst fmulx #b001001011)	; v8
+(define-binary-fp-inst fmuld #b001001010 :extended t)
+(define-binary-fp-inst fmulx #b001001011 :extended t)	; v8
 (define-binary-fp-inst fdivs #b001001101)
-(define-binary-ext-fp-inst fdivd #b001001110)
-(define-binary-ext-fp-inst fdivx #b001001111)	; v8
+(define-binary-fp-inst fdivd #b001001110 :extended t)
+(define-binary-fp-inst fdivx #b001001111 :extended t)	; v8
 
 ;;; Float comparison instructions.
 ;;;
-(define-cmp-fp-inst fcmps #b001010001)
-(define-cmp-ext-fp-inst fcmpd #b001010010)
-(define-cmp-ext-fp-inst fcmpx #b001010011)	; v8
-(define-cmp-fp-inst fcmpes #b001010101)
-(define-cmp-ext-fp-inst fcmped #b001010110)
-(define-cmp-ext-fp-inst fcmpex #b001010111)	; v8
+(define-cmp-fp-inst fcmps #b0001)
+(define-cmp-fp-inst fcmpd #b0010 :extended t)
+(define-cmp-fp-inst fcmpx #b0011 :extended t) ;v8
+(define-cmp-fp-inst fcmpes #b0101)
+(define-cmp-fp-inst fcmped #b0110 :extended t)
+(define-cmp-fp-inst fcmpex #b0111 :extended t)	; v8
 
 
 
@@ -1249,3 +1631,224 @@
 		      #'(lambda (label posn delta-if-after)
 			  (+ (label-position label posn delta-if-after)
 			     (component-header-length))))))
+
+;;; Sparc V9 additions
+
+
+
+;; Conditional move integer on condition code
+(define-instruction cmove (segment condition dst src &optional (ccreg :icc))
+  (:declare (type (or branch-condition fp-branch-condition) condition)
+	    (type cond-move-condition-register ccreg)
+	    (type tn dst)
+	    (type (or (signed-byte 13) tn) src))
+  (:printer format-4-cond-move
+	    ((op #b10)
+	     (op3 #b101100)
+	     (cc2 #b1)
+	     (i 0)
+	     (cc nil :type 'integer-condition-register))
+	     cond-move-printer
+	     :print-name 'mov)
+  (:printer format-4-cond-move-immed
+	    ((op #b10)
+	     (op3 #b101100)
+	     (cc2 #b1)
+	     (i 1)
+	     (cc nil :type 'integer-condition-register))
+	     cond-move-printer
+	     :print-name 'mov)
+  (:printer format-4-cond-move
+	    ((op #b10)
+	     (op3 #b101100)
+	     (cc2 #b0)
+	     (i 0)
+	     (cc nil :type 'fp-condition-register))
+	     cond-move-printer
+	     :print-name 'mov)
+  (:printer format-4-cond-move-immed
+	    ((op #b10)
+	     (op3 #b101100)
+	     (cc2 #b0)
+	     (i 1)
+	     (cc nil :type 'fp-condition-register))
+	     cond-move-printer
+	     :print-name 'mov)
+  (:delay 0)
+  (:dependencies
+   (if (member ccreg '(:icc :xcc))
+       (reads :psr)
+       (reads :fsr))
+   (reads src)
+   (writes dst))
+  (:emitter
+   (let ((op #b10)
+	 (op3 #b101100))
+     (multiple-value-bind (cc2 cc01)
+	 (cond-move-condition-parts ccreg)
+       (etypecase src
+	 (tn
+	  (emit-format-4-cond-move segment
+				   op
+				   (reg-tn-encoding dst)
+				   op3
+				   cc2
+				   (if (member ccreg '(:icc :xcc))
+				       (branch-condition condition)
+				       (fp-branch-condition condition))
+				   0
+				   cc01
+				   (reg-tn-encoding src)))
+	 (integer
+	  (emit-format-4-cond-move segment
+				   op
+				   (reg-tn-encoding dst)
+				   op3
+				   cc2
+				   (if (member ccreg '(:icc :xcc))
+				       (branch-condition condition)
+				       (fp-branch-condition condition))
+				   1
+				   cc01
+				   src)))))))
+
+;; Conditional move floating-point on condition codes
+(defmacro define-cond-fp-move (name print-name op op3 opf_low &key extended)
+  `(define-instruction ,name (segment condition dst src &optional (ccreg :fcc0))
+     (:declare (type (or branch-condition fp-branch-condition) condition)
+	       (type cond-move-condition-register ccreg)
+	       (type tn dst src))
+     (:printer format-fpop2
+	       ((op ,op)
+		(op3 ,op3)
+		(opf0 0)
+		(opf1 nil :type 'fp-condition-register-shifted)
+		(opf2 0)
+		(opf3 ,opf_low)
+		(rs1 nil :type 'branch-fp-condition)
+		(rs2 nil :type ',(if extended 'fp-ext-reg 'fp-reg))
+		(rd nil :type ',(if extended 'fp-ext-reg 'fp-reg)))
+                cond-fp-move-printer
+                :print-name ',print-name)
+     (:printer format-fpop2
+	       ((op ,op)
+		(op3 ,op3)
+		(opf0 1)
+		(opf1 nil :type 'integer-condition-register)
+		(opf2 0)
+		(rs1 nil :type 'branch-condition)
+		(opf3 ,opf_low)
+		(rs2 nil :type ',(if extended 'fp-ext-reg 'fp-reg))
+		(rd nil :type ',(if extended 'fp-ext-reg 'fp-reg)))
+               cond-fp-move-printer
+               :print-name ',print-name)
+     (:delay 0)
+     (:dependencies
+      (if (member ccreg '(:icc :xcc))
+	  (reads :psr)
+	  (reads :fsr))
+      (reads src)
+      (writes dst))
+     (:emitter
+      (multiple-value-bind (opf_cc2 opf_cc01)
+	  (cond-move-condition-parts ccreg)
+	(emit-format-3-fpop2 segment
+			     ,op
+			     (fp-reg-tn-encoding dst)
+			     ,op3
+			     (if (member ccreg '(:icc :xcc))
+				 (branch-condition condition)
+				 (fp-branch-condition condition))
+			     opf_cc2
+			     (ash opf_cc01 1)
+			     0
+			     ,opf_low
+			     (fp-reg-tn-encoding src))))))
+
+(define-cond-fp-move cfmovs fmovs #b10 #b110101 #b0001)
+(define-cond-fp-move cfmovd fmovd #b10 #b110101 #b0010 :extended t)
+(define-cond-fp-move cfmovq fmovq #b10 #b110101 #b0011 :extended t)
+
+
+;; Move on integer register condition
+;;
+;; movr dst src reg reg-cond
+;;
+;; This means if reg satisfies reg-cond, src is copied to dst.  If the
+;; condition is not satisfied, nothing is done.
+;;
+(define-instruction movr (segment dst src2 src1 reg-condition)
+  (:declare (type cond-move-integer-condition reg-condition)
+	    (type tn dst src1)
+	    (type (or (signed-byte 10) tn) src2))
+  (:printer format-4-cond-move-integer
+	    ((op #b10)
+	     (op3 #b101111)
+	     (i 0)))
+  (:printer format-4-cond-move-integer-immed
+	    ((op #b10)
+	     (op3 #b101111)
+	     (i 1)))
+  (:delay 0)
+  (:dependencies
+   (reads :psr)
+   (reads src2)
+   (reads src1)
+   (writes dst))
+  (:emitter
+   (etypecase src2
+     (tn
+      (emit-format-4-cond-move-integer
+       segment #b10 (reg-tn-encoding dst) #b101111 (reg-tn-encoding src1)
+       0 (register-condition reg-condition)
+       0 (reg-tn-encoding src2)))
+     (integer
+      (emit-format-4-cond-move-integer-immed
+       segment #b10 (reg-tn-encoding dst) #b101111 (reg-tn-encoding src1)
+       1 (register-condition reg-condition) src2)))))
+
+
+;; Same as MOVR, except we move FP registers depending on the value of
+;; an integer register.
+;;
+;; fmovr dst src reg cond
+;;
+;; This means if REG satifies COND, SRC is COPIED to DST.  Nothing
+;; happens if the condition is not satisfied.
+(defmacro define-cond-fp-move-integer (name opf_low &key extended)
+  `(define-instruction ,name (segment dst src2 src1 reg-condition)
+     (:declare (type cond-move-integer-condition reg-condition)
+	       (type tn dst src1 src2))
+     (:printer format-fpop2
+	       ((op #b10)
+		(rd nil :type ',(if extended 'fp-ext-reg 'fp-reg))
+		(op3 #b110101)
+		(rs1 nil :type 'reg)
+		(opf0 0)
+		(opf1 nil :type 'register-condition)
+		(opf2 0)
+		(opf3 ,opf_low)
+		(rs2 nil :type ',(if extended 'fp-ext-reg 'fp-reg))
+		)
+               cond-fp-move-integer-printer)
+     (:delay 0)
+     (:dependencies
+      (reads src2)
+      (reads src1)
+      (writes dst))
+     (:emitter
+      (emit-format-3-fpop2
+       segment
+       #b10
+       (fp-reg-tn-encoding dst)
+       #b110101
+       (reg-tn-encoding src1)
+       0
+       (register-condition reg-condition)
+       0
+       ,opf_low
+       (fp-reg-tn-encoding src2)))))
+
+(define-cond-fp-move-integer fmovrs #b0101)
+(define-cond-fp-move-integer fmovrd #b0110 :extended t)
+(define-cond-fp-move-integer fmovrq #b0111 :extended t)
-- 
GitLab