diff --git a/compiler/sparc/insts.lisp b/compiler/sparc/insts.lisp
index 4d871413722893c447eff8a43782efecd5e5e495..af7f0b5fba26a5d6011512642c4246719913141a 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.16 1998/03/10 21:24:35 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/insts.lisp,v 1.17 1998/03/11 17:00:26 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -21,7 +21,7 @@
 
 (def-assembler-params
     :scheduler-p t
-  :max-locations 68)
+  :max-locations 100)
 
 
 ;;;; Constants, types, conversion functions, some disassembler stuff.
@@ -61,15 +61,15 @@
        (float-registers
 	(+ (tn-offset loc) 32))
        (control-registers
-	64)
+	96)
        (immediate-constant
 	nil)))
     (symbol
      (ecase loc
        (:memory 0)
-       (:psr 65)
-       (:fsr 66)
-       (:y 67)))))
+       (:psr 97)
+       (:fsr 98)
+       (:y 99)))))
 
 ;;; symbols used for disassembly printing
 ;;;
@@ -93,7 +93,7 @@
 
 (defparameter float-reg-symbols
   (coerce 
-   (loop for n from 0 to 31 collect (make-symbol (format nil "%F~d" n)))
+   (loop for n from 0 to 63 collect (make-symbol (format nil "%F~d" n)))
    'vector))
 
 (disassem:define-argument-type fp-reg
@@ -107,6 +107,21 @@
 		  regname
 		  dstate))))
 
+;;; The extended 6 bit floating point register encoding for the double
+;;; and long instructions of the sparc V9.
+(disassem:define-argument-type fp-ext-reg
+  :printer #'(lambda (value stream dstate)
+	       (declare (stream stream) (fixnum value))
+	       (let* (;; Decode the register number.
+		      (value (if (oddp value) (+ value 31) value))
+		      (regname (aref float-reg-symbols value)))
+		 (princ regname stream)
+		 (disassem:maybe-note-associated-storage-ref
+		  value
+		  'float-registers
+		  regname
+		  dstate))))
+
 (disassem:define-argument-type relative-label
   :sign-extend t
   :use-label #'(lambda (value dstate)
@@ -218,9 +233,8 @@
   (immed :field (byte 13 0) :sign-extend t))	; usually sign extended
 
 (disassem:define-instruction-format
-    (format-3-fpop 32
-     :default-printer
-        '(:name :tab (:unless (:same-as rd) rs1 ", ") rs2 ", " rd))
+    (format-binary-fpop 32
+     :default-printer '(:name :tab rd ", " rs1 ", " rs2))
   (op	:field (byte 2 30))
   (rd 	:field (byte 5 25) :type 'fp-reg)
   (op3  :field (byte 6 19))
@@ -228,6 +242,56 @@
   (opf  :field (byte 9 5))
   (rs2  :field (byte 5 0) :type 'fp-reg))
 
+;;; Floating point load/save instructions encoding.
+(disassem:define-instruction-format
+    (format-unary-fpop 32 :default-printer '(:name :tab rd ", " rs2))
+  (op	:field (byte 2 30))
+  (rd 	:field (byte 5 25) :type 'fp-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-reg))
+
+;;; Floating point comparison instructions encoding.
+(disassem:define-instruction-format
+    (format-cmp-fpop 32 :default-printer '(:name :tab 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))
+  (rs2  :field (byte 5 0) :type 'fp-reg))
+
+;;; Double and long float instruction format of the sparc V9.
+(disassem:define-instruction-format
+    (format-binary-ext-fpop 32
+     :default-printer '(:name :tab rd ", " rs1 ", " rs2))
+  (op	:field (byte 2 30))
+  (rd 	:field (byte 5 25) :type 'fp-ext-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))
+
+;;; Double and long floating point load/save instructions encoding.
+(disassem:define-instruction-format
+    (format-unary-ext-fpop 32 :default-printer '(:name :tab rd ", " rs2))
+  (op	:field (byte 2 30))
+  (rd 	:field (byte 5 25) :type 'fp-ext-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))
+
+;;; Double and long floating point comparison instructions encoding.
+(disassem:define-instruction-format
+    (format-cmp-ext-fpop 32 :default-printer '(:name :tab 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-ext-reg)
+  (opf  :field (byte 9 5))
+  (rs2  :field (byte 5 0) :type 'fp-ext-reg))
 
 
 ;;;; Primitive emitters.
@@ -260,7 +324,6 @@
 (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))
 
-
 
 ;;;; Most of the format-3-instructions.
 
@@ -689,19 +752,12 @@
 
 ;;;; Unary and binary fp insts.
 
-(defun emit-fp-inst (segment opf op3 dst src1 src2 &optional odd)
-  (flet ((maybe-fp-reg-tn-encoding (reg)
-	   (if reg (fp-reg-tn-encoding reg odd) 0)))
-    (emit-format-3-fpop segment #b10 (maybe-fp-reg-tn-encoding dst) op3
-		      (maybe-fp-reg-tn-encoding src1) opf
-		      (maybe-fp-reg-tn-encoding src2))))
-
 (eval-when (compile eval)
 
-(defmacro define-unary-fp-inst (name opf &key reads odd)
+(defmacro define-unary-fp-inst (name opf &key reads)
   `(define-instruction ,name (segment dst src)
      (:declare (type tn dst src))
-     (:printer format-3-fpop ((op #b10) (op3 #b110100) (opf ,opf)))
+     (:printer format-unary-fpop ((op #b10) (op3 #b110100) (opf ,opf) (rs1 0)))
      (:dependencies
       ,@(when reads
 	  `((reads ,reads)))
@@ -709,13 +765,14 @@
       (reads src)
       (writes dst))
      (:delay 0)
-     (:emitter (emit-fp-inst segment ,opf #b110100 dst nil src ,odd))))
+     (:emitter (emit-format-3-fpop segment #b10 (fp-reg-tn-encoding dst)
+		#b110100 0 ,opf (fp-reg-tn-encoding src)))))
 
-(defmacro define-binary-fp-inst (name opf
-				      &key (op3 #b110100) reads writes delay)
+(defmacro define-binary-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-3-fpop ((op #b10) (op3 ,op3) (opf ,opf)))
+     (:printer format-binary-fpop ((op #b10) (op3 ,op3) (opf ,opf)))
      (:dependencies
       ,@(when reads
 	  `((reads ,reads)))
@@ -727,33 +784,87 @@
      ,@(if delay
 	   `((:delay ,delay))
 	   '((:delay 0)))
-     (:emitter (emit-fp-inst segment ,opf ,op3 dst src1 src2))))
+     (: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-fp-cmp-inst (name opf)
+(defmacro define-cmp-fp-inst (name opf)
   `(define-instruction ,name (segment src1 src2)
      (:declare (type tn src1 src2))
-     (:printer format-3-fpop ((op #b10) (op3 #b110101) (opf ,opf)))
+     (:printer format-cmp-fpop ((op #b10) (op3 #b110101) (opf ,opf) (rd 0)))
      (:dependencies
       (reads src1)
       (reads src2)
       (writes :fsr))
      (:delay 1)
-     (:emitter (emit-fp-inst segment ,opf #b110101 nil src1 src2))))
-  
+     (: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))
+     (:delay 1)
+     (:emitter (emit-format-3-fpop segment #b10 0 #b110101
+		(fp-reg-tn-encoding src1) ,opf (fp-reg-tn-encoding src2)))))
+
 ); eval-when (compile eval)
 
 
 (define-unary-fp-inst fitos #b011000100 :reads :fsr)
-(define-unary-fp-inst fitod #b011001000 :reads :fsr)
-(define-unary-fp-inst fitox #b011001100 :reads :fsr)
+(define-unary-ext-fp-inst fitod #b011001000 :reads :fsr)
+(define-unary-ext-fp-inst fitox #b011001100 :reads :fsr)
 
 (define-unary-fp-inst fstoir #b011000001 :reads :fsr)
-(define-unary-fp-inst fdtoir #b011000010 :reads :fsr)
-(define-unary-fp-inst fxtoir #b011000011 :reads :fsr)
+(define-unary-ext-fp-inst fdtoir #b011000010 :reads :fsr)
+(define-unary-ext-fp-inst fxtoir #b011000011 :reads :fsr)
 
 (define-unary-fp-inst fstoi #b011010001)
-(define-unary-fp-inst fdtoi #b011010010)
-(define-unary-fp-inst fxtoi #b011010011)
+(define-unary-ext-fp-inst fdtoi #b011010010)
+(define-unary-ext-fp-inst fxtoi #b011010011)
 
 (define-unary-fp-inst fstod #b011001001 :reads :fsr)
 (define-unary-fp-inst fstox #b011001101 :reads :fsr)
@@ -767,40 +878,42 @@
   (:declare (type tn dst src1))
   (:dependencies (reads dst) (reads src1) (writes dst))
   (:delay 0)
-  (:emitter (emit-fp-inst segment #b000000001 #b110100 dst nil src1 t)))
-(define-unary-fp-inst fmovd #b000000010)	; V9
-(define-unary-fp-inst fmovq #b000000011)	; V9
+  (:emitter (emit-format-3-fpop segment #b10 (fp-reg-tn-encoding dst t)
+				#b110100 0 #b000000001
+				(fp-reg-tn-encoding src1 t))))
+(define-unary-ext-fp-inst fmovd #b000000010)	; V9
+(define-unary-ext-fp-inst fmovq #b000000011)	; V9
 
 (define-unary-fp-inst fnegs #b000000101)
 (define-unary-fp-inst fabss #b000001001)
 
 (define-unary-fp-inst fsqrts #b000101001 :reads :fsr)
-(define-unary-fp-inst fsqrtd #b000101010 :reads :fsr)
-(define-unary-fp-inst fsqrtx #b000101011 :reads :fsr)
+(define-unary-ext-fp-inst fsqrtd #b000101010 :reads :fsr)
+(define-unary-ext-fp-inst fsqrtx #b000101011 :reads :fsr)
 
 
 (define-binary-fp-inst fadds #b001000001)
-(define-binary-fp-inst faddd #b001000010)
-(define-binary-fp-inst faddx #b001000011)
+(define-binary-ext-fp-inst faddd #b001000010)
+(define-binary-ext-fp-inst faddx #b001000011)
 (define-binary-fp-inst fsubs #b001000101)
-(define-binary-fp-inst fsubd #b001000110)
-(define-binary-fp-inst fsubx #b001000111)
+(define-binary-ext-fp-inst fsubd #b001000110)
+(define-binary-ext-fp-inst fsubx #b001000111)
 
 (define-binary-fp-inst fmuls #b001001001)
-(define-binary-fp-inst fmuld #b001001010)
-(define-binary-fp-inst fmulx #b001001011)
+(define-binary-ext-fp-inst fmuld #b001001010)
+(define-binary-ext-fp-inst fmulx #b001001011)
 (define-binary-fp-inst fdivs #b001001101)
-(define-binary-fp-inst fdivd #b001001110)
-(define-binary-fp-inst fdivx #b001001111)
+(define-binary-ext-fp-inst fdivd #b001001110)
+(define-binary-ext-fp-inst fdivx #b001001111)
 
 ;;; Float comparison instructions.
 ;;;
-(define-fp-cmp-inst fcmps #b001010001)
-(define-fp-cmp-inst fcmpd #b001010010)
-(define-fp-cmp-inst fcmpx #b001010011)
-(define-fp-cmp-inst fcmpes #b001010101)
-(define-fp-cmp-inst fcmped #b001010110)
-(define-fp-cmp-inst fcmpex #b001010111)
+(define-cmp-fp-inst fcmps #b001010001)
+(define-cmp-ext-fp-inst fcmpd #b001010010)
+(define-cmp-ext-fp-inst fcmpx #b001010011)
+(define-cmp-fp-inst fcmpes #b001010101)
+(define-cmp-ext-fp-inst fcmped #b001010110)
+(define-cmp-ext-fp-inst fcmpex #b001010111)
 
 
 
diff --git a/compiler/sparc/vm.lisp b/compiler/sparc/vm.lisp
index bd7c965c003df0f52858fe4e3fcd22423795d960..8ecd0a77009476709ff56811b39821a21b9d5f51 100644
--- a/compiler/sparc/vm.lisp
+++ b/compiler/sparc/vm.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/vm.lisp,v 1.9 1998/01/21 10:10:05 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/vm.lisp,v 1.10 1998/03/11 17:00:24 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -95,7 +95,7 @@
 ;;;; SB and SC definition:
 
 (define-storage-base registers :finite :size 32)
-(define-storage-base float-registers :finite :size 32)
+(define-storage-base float-registers :finite :size 64)
 (define-storage-base control-stack :unbounded :size 8)
 (define-storage-base non-descriptor-stack :unbounded :size 0)
 (define-storage-base constant :non-packed)