diff --git a/compiler/sparc/insts.lisp b/compiler/sparc/insts.lisp
index 10a0fe3e84e4d3c8a969b5b83fc251e6c7b8b8bb..f651c0645a4426bfcf402dd91e11ec09f4a70612 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)