diff --git a/compiler/generic/interr.lisp b/compiler/generic/interr.lisp
index f43e9f1ac581936b908431b2f448f26804fb3fd7..d32a60324d7683396f144d0a5e9425579fdbf9fa 100644
--- a/compiler/generic/interr.lisp
+++ b/compiler/generic/interr.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/generic/interr.lisp,v 1.8 1997/11/15 04:39:00 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/interr.lisp,v 1.9 1998/03/21 07:55:52 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -58,6 +58,9 @@
    "Object is not of type SINGLE-FLOAT.")
   (object-not-double-float
    "Object is not of type DOUBLE-FLOAT.")
+  #+long-float
+  (object-not-long-float
+   "Object is not of type LONG-FLOAT.")
   (object-not-simple-string
    "Object is not of type SIMPLE-STRING.")
   (object-not-simple-bit-vector
@@ -153,12 +156,18 @@
    "Object is not of type (SIMPLE-ARRAY SINGLE-FLOAT (*)).")
   (object-not-simple-array-double-float
    "Object is not of type (SIMPLE-ARRAY DOUBLE-FLOAT (*)).")
+  #+long-float
+  (object-not-simple-array-long-float
+   "Object is not of type (SIMPLE-ARRAY LONG-FLOAT (*)).")
   #+complex-float
   (object-not-simple-array-complex-single-float
    "Object is not of type (SIMPLE-ARRAY (COMPLEX SINGLE-FLOAT) (*)).")
   #+complex-float
   (object-not-simple-array-complex-double-float
    "Object is not of type (SIMPLE-ARRAY (COMPLEX DOUBLE-FLOAT) (*)).")
+  #+(and complex-float long-float)
+  (object-not-simple-array-complex-long-float
+   "Object is not of type (SIMPLE-ARRAY (COMPLEX LONG-FLOAT) (*)).")
   (object-not-complex
    "Object is not of type COMPLEX.")
   #+complex-float
@@ -173,6 +182,9 @@
   #+complex-float
   (object-not-complex-double-float
    "Object is not of type (COMPLEX DOUBLE-FLOAT).")
+  #+(and complex-float long-float)
+  (object-not-complex-long-float
+   "Object is not of type (COMPLEX LONG-FLOAT).")
   (object-not-weak-pointer
    "Object is not a WEAK-POINTER.")
   (object-not-instance
diff --git a/compiler/generic/new-genesis.lisp b/compiler/generic/new-genesis.lisp
index 8033b9f44cb351526a34dd74d4de822c75a9c92e..ea01bf09d85fb5a20945e582b79037a37fdb4be0 100644
--- a/compiler/generic/new-genesis.lisp
+++ b/compiler/generic/new-genesis.lisp
@@ -4,7 +4,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.32 1998/02/15 15:34:50 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.33 1998/03/21 07:55:52 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -437,6 +437,22 @@
 	 (:big-endian
 	  (write-indexed des vm:double-float-value-slot high-bits)
 	  (write-indexed des (1+ vm:double-float-value-slot) low-bits)))
+       des))
+    #+(and long-float x86)
+    (long-float
+     (let ((des (allocate-unboxed-object *dynamic* vm:word-bits
+					 (1- vm:long-float-size)
+					 vm:long-float-type))
+	   (exp-bits (make-random-descriptor (long-float-exp-bits num)))
+	   (high-bits (make-random-descriptor (long-float-high-bits num)))
+	   (low-bits (make-random-descriptor (long-float-low-bits num))))
+       (ecase (c:backend-byte-order c:*backend*)
+	 (:little-endian
+	  (write-indexed des vm:long-float-value-slot low-bits)
+	  (write-indexed des (1+ vm:long-float-value-slot) high-bits)
+	  (write-indexed des (+ 2 vm:long-float-value-slot) exp-bits))
+	 (:big-endian
+	  (error "Long-Float not supported")))
        des))))
 
 #+complex-float
@@ -492,6 +508,9 @@
     ((complex single-float) (complex-single-float-to-core number))
     #+complex-float
     ((complex double-float) (complex-double-float-to-core number))
+    #+(and complex-float long-float)
+    ((complex long-float)
+     (error "~S isn't a cold-loadable number at all!" number))
     (complex (number-pair-to-core (number-to-core (realpart number))
 				  (number-to-core (imagpart number))
 				  vm:complex-type))
@@ -755,6 +774,18 @@
       (frob "*FP-CONSTANT-1D0*" "X86" (number-to-core 1d0))
       (frob "*FP-CONSTANT-0S0*" "X86" (number-to-core 0s0))
       (frob "*FP-CONSTANT-1S0*" "X86" (number-to-core 1s0))
+      #+long-float
+      (when (c:backend-featurep :long-float)
+	(frob "*FP-CONSTANT-0L0*" "X86" (number-to-core 0l0))
+	(frob "*FP-CONSTANT-1L0*" "X86" (number-to-core 1l0))
+	(frob "*FP-CONSTANT-PI*" "X86" (number-to-core pi))
+	(frob "*FP-CONSTANT-L2T*" "X86" (number-to-core (log 10l0 2l0)))
+	(frob "*FP-CONSTANT-L2E*" "X86"
+	      (number-to-core (log 2.718281828459045235360287471352662L0 2l0)))
+	(frob "*FP-CONSTANT-LG2*" "X86" (number-to-core (log 2l0 10l0)))
+	(frob "*FP-CONSTANT-LN2*" "X86"
+	      (number-to-core
+	       (log 2l0 2.718281828459045235360287471352662L0))))
       (when (c:backend-featurep :gencgc)
 	(frob "*SCAVENGE-READ-ONLY-SPACE*" "X86" (cold-intern nil))))))
 
@@ -1301,6 +1332,11 @@
 		    (* len vm:word-bytes 2)))
     result))
 
+#+long-float (not-cold-fop fop-long-float-vector)
+#+complex-float (not-cold-fop fop-complex-single-float-vector)
+#+complex-float (not-cold-fop fop-complex-double-float-vector)
+#+(and complex-float long-float) (not-cold-fop fop-complex-long-float-vector)
+
 (define-cold-fop (fop-array)
   (let* ((rank (read-arg 4))
 	 (data-vector (pop-stack))
@@ -1347,6 +1383,94 @@
 #+complex-float (cold-number fop-complex-single-float)
 #+complex-float (cold-number fop-complex-double-float)
 
+#+long-float
+(define-cold-fop (fop-long-float)
+  (ecase (c:backend-fasl-file-implementation c:*backend*)
+    (#.c:x86-fasl-file-implementation		; 80 bit long-float format.
+     (prepare-for-fast-read-byte *fasl-file*
+       (let* ((des (allocate-unboxed-object *dynamic* vm:word-bits
+					    (1- vm:long-float-size)
+					    vm:long-float-type))
+	      (low-bits (make-random-descriptor (fast-read-u-integer 4)))
+	      (high-bits (make-random-descriptor (fast-read-u-integer 4)))
+	      (exp-bits (make-random-descriptor (fast-read-s-integer 2))))
+	 (done-with-fast-read-byte)
+	 (write-indexed des vm:long-float-value-slot low-bits)
+	 (write-indexed des (1+ vm:long-float-value-slot) high-bits)
+	 (write-indexed des (+ 2 vm:long-float-value-slot) exp-bits)
+	 des)))
+    (#.c:sparc-fasl-file-implementation		; 128 bit long-float format.
+     (prepare-for-fast-read-byte *fasl-file*
+       (let* ((des (allocate-unboxed-object *dynamic* vm:word-bits
+					    (1- vm:long-float-size)
+					    vm:long-float-type))
+	      (low-bits (make-random-descriptor (fast-read-u-integer 4)))
+	      (mid-bits (make-random-descriptor (fast-read-u-integer 4)))
+	      (high-bits (make-random-descriptor (fast-read-u-integer 4)))
+	      (exp-bits (make-random-descriptor (fast-read-s-integer 4))))
+	 (done-with-fast-read-byte)
+	 (write-indexed des vm:long-float-value-slot exp-bits)
+	 (write-indexed des (1+ vm:long-float-value-slot) high-bits)
+	 (write-indexed des (+ 2 vm:long-float-value-slot) mid-bits)
+	 (write-indexed des (+ 3 vm:long-float-value-slot) low-bits)
+	 des)))))
+
+#+(and complex-float long-float)
+(define-cold-fop (fop-complex-long-float)
+  (ecase (c:backend-fasl-file-implementation c:*backend*)
+    (#.c:x86-fasl-file-implementation		; 80 bit long-float format.
+     (prepare-for-fast-read-byte *fasl-file*
+       (let* ((des (allocate-unboxed-object *dynamic* vm:word-bits
+					    (1- vm:complex-long-float-size)
+					    vm:complex-long-float-type))
+	      (real-low-bits (make-random-descriptor (fast-read-u-integer 4)))
+	      (real-high-bits (make-random-descriptor (fast-read-u-integer 4)))
+	      (real-exp-bits (make-random-descriptor (fast-read-s-integer 2)))
+	      (imag-low-bits (make-random-descriptor (fast-read-u-integer 4)))
+	      (imag-high-bits (make-random-descriptor (fast-read-u-integer 4)))
+	      (imag-exp-bits (make-random-descriptor (fast-read-s-integer 2))))
+	 (done-with-fast-read-byte)
+	 (write-indexed des vm:complex-long-float-real-slot real-low-bits)
+	 (write-indexed des (1+ vm:complex-long-float-real-slot)
+			real-high-bits)
+	 (write-indexed des (+ 2 vm:complex-long-float-real-slot)
+			real-exp-bits)
+	 (write-indexed des vm:complex-long-float-imag-slot imag-low-bits)
+	 (write-indexed des (1+ vm:complex-long-float-imag-slot)
+			imag-high-bits)
+	 (write-indexed des (+ 2 vm:complex-long-float-imag-slot)
+			imag-exp-bits)
+	 des)))
+    (#.c:sparc-fasl-file-implementation		; 128 bit long-float format.
+     (prepare-for-fast-read-byte *fasl-file*
+       (let* ((des (allocate-unboxed-object *dynamic* vm:word-bits
+					    (1- vm:complex-long-float-size)
+					    vm:complex-long-float-type))
+	      (real-low-bits (make-random-descriptor (fast-read-u-integer 4)))
+	      (real-mid-bits (make-random-descriptor (fast-read-u-integer 4)))
+	      (real-high-bits (make-random-descriptor (fast-read-u-integer 4)))
+	      (real-exp-bits (make-random-descriptor (fast-read-s-integer 4)))
+	      (imag-low-bits (make-random-descriptor (fast-read-u-integer 4)))
+	      (imag-mid-bits (make-random-descriptor (fast-read-u-integer 4)))
+	      (imag-high-bits (make-random-descriptor (fast-read-u-integer 4)))
+	      (imag-exp-bits (make-random-descriptor (fast-read-s-integer 4))))
+	 (done-with-fast-read-byte)
+	 (write-indexed des vm:complex-long-float-real-slot real-exp-bits)
+	 (write-indexed des (1+ vm:complex-long-float-real-slot)
+			real-high-bits)
+	 (write-indexed des (+ 2 vm:complex-long-float-real-slot)
+			real-mid-bits)
+	 (write-indexed des (+ 3 vm:complex-long-float-real-slot)
+			real-low-bits)
+	 (write-indexed des vm:complex-long-float-real-slot imag-exp-bits)
+	 (write-indexed des (1+ vm:complex-long-float-real-slot)
+			imag-high-bits)
+	 (write-indexed des (+ 2 vm:complex-long-float-real-slot)
+			imag-mid-bits)
+	 (write-indexed des (+ 3 vm:complex-long-float-real-slot)
+			imag-low-bits)
+	 des)))))
+
 (define-cold-fop (fop-ratio)
   (let ((den (pop-stack)))
     (number-pair-to-core (pop-stack) den vm:ratio-type)))
diff --git a/compiler/generic/objdef.lisp b/compiler/generic/objdef.lisp
index 3c4715b4f8ac7f91274dd7f043ec2c60245112dd..66f78b133e7df9ef91ca38f56060f9ea3c1d0237 100644
--- a/compiler/generic/objdef.lisp
+++ b/compiler/generic/objdef.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/generic/objdef.lisp,v 1.42 1998/01/17 10:24:55 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/objdef.lisp,v 1.43 1998/03/21 07:55:53 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -21,15 +21,15 @@
 	  even-fixnum-type function-pointer-type other-immediate-0-type
 	  list-pointer-type odd-fixnum-type instance-pointer-type
 	  other-immediate-1-type other-pointer-type bignum-type ratio-type
-	  single-float-type double-float-type complex-type
+	  single-float-type double-float-type long-float-type complex-type
 	  simple-array-type simple-string-type simple-bit-vector-type
 	  simple-vector-type simple-array-unsigned-byte-2-type
 	  simple-array-unsigned-byte-4-type simple-array-unsigned-byte-8-type
 	  simple-array-unsigned-byte-16-type simple-array-unsigned-byte-32-type
 	  simple-array-signed-byte-8-type simple-array-signed-byte-16-type
 	  simple-array-signed-byte-30-type simple-array-signed-byte-32-type
-	  simple-array-single-float-type
-	  simple-array-double-float-type complex-string-type
+	  simple-array-single-float-type simple-array-double-float-type
+	  simple-array-long-float-type complex-string-type
 	  complex-bit-vector-type complex-vector-type complex-array-type
 	  code-header-type function-header-type closure-header-type
 	  closure-function-header-type return-pc-header-type
@@ -42,8 +42,10 @@
 	  vector-valid-hashing-subtype vector-must-rehash-subtype
 	  forwarding-pointer-type scavenger-hook-type
 	  complex-single-float-type complex-double-float-type
+	  complex-long-float-type
 	  simple-array-complex-single-float-type
-	  simple-array-complex-double-float-type))
+	  simple-array-complex-double-float-type
+	  simple-array-complex-long-float-type))
 
 (in-package "KERNEL")
 (export '(%make-funcallable-instance
@@ -112,9 +114,11 @@
   ratio
   single-float
   double-float
+  #+long-float long-float
   complex
   #+complex-float complex-single-float
   #+complex-float complex-double-float
+  #+(and complex-float long-float) complex-long-float
   
   simple-array
   simple-string
@@ -131,8 +135,10 @@
   #+signed-array simple-array-signed-byte-32
   simple-array-single-float
   simple-array-double-float
+  #+long-float simple-array-long-float
   #+complex-float simple-array-complex-single-float
   #+complex-float simple-array-complex-double-float
+  #+(and complex-float long-float) simple-array-complex-long-float
   complex-string
   complex-bit-vector
   complex-vector
@@ -208,6 +214,12 @@
   (filler)
   (value :c-type "double" :length 2))
 
+#+long-float
+(define-primitive-object (long-float :lowtag other-pointer-type
+				     :header long-float-type)
+  #+sparc (filler)
+  (value :c-type "long double" :length #+x86 3 #+sparc 4))
+
 (define-primitive-object (complex :type complex
 				  :lowtag other-pointer-type
 				  :header complex-type
@@ -487,3 +499,11 @@
   (filler)
   (real :c-type "double" :length 2)
   (imag :c-type "double" :length 2))
+
+#+(and complex-float long-float)
+(define-primitive-object (complex-long-float
+			  :lowtag other-pointer-type
+			  :header complex-long-float-type)
+  #+sparc (filler)
+  (real :c-type "long double" :length #+x86 3 #+sparc 4)
+  (imag :c-type "long double" :length #+x86 3 #+sparc 4))
diff --git a/compiler/generic/primtype.lisp b/compiler/generic/primtype.lisp
index a63b536042f50e02ea53dd62ffdb4660c2abc2b0..d1e66d5078f58730164b979a54c53a4b7de2bbe1 100644
--- a/compiler/generic/primtype.lisp
+++ b/compiler/generic/primtype.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/generic/primtype.lisp,v 1.18 1998/02/03 19:22:20 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/primtype.lisp,v 1.19 1998/03/21 07:55:54 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -84,12 +84,17 @@
 (def-primitive-type complex (descriptor-reg))
 (def-primitive-type single-float (single-reg descriptor-reg))
 (def-primitive-type double-float (double-reg descriptor-reg))
+#+long-float
+(def-primitive-type long-float (long-reg descriptor-reg))
 #+complex-float
 (def-primitive-type complex-single-float (complex-single-reg descriptor-reg)
   :type (complex single-float))
 #+complex-float
 (def-primitive-type complex-double-float (complex-double-reg descriptor-reg)
   :type (complex double-float))
+#+(and complex-float long-float)
+(def-primitive-type complex-long-float (complex-long-reg descriptor-reg)
+  :type (complex long-float))
 
 ;;; Primitive other-pointer array types.
 ;;; 
@@ -122,12 +127,18 @@
   :type (simple-array single-float (*)))
 (def-primitive-type simple-array-double-float (descriptor-reg)
   :type (simple-array double-float (*)))
+#+long-float
+(def-primitive-type simple-array-long-float (descriptor-reg)
+  :type (simple-array long-float (*)))
 #+complex-float
 (def-primitive-type simple-array-complex-single-float (descriptor-reg)
   :type (simple-array (complex single-float) (*)))
 #+complex-float
 (def-primitive-type simple-array-complex-double-float (descriptor-reg)
   :type (simple-array (complex double-float) (*)))
+#+(and complex-float long-float)
+(def-primitive-type simple-array-complex-long-float (descriptor-reg)
+  :type (simple-array (complex long-float) (*)))
 
 ;;; Note: The complex array types are not inclueded, 'cause it is pointless to
 ;;; restrict VOPs to them.
@@ -172,10 +183,13 @@
     #+signed-array ((signed-byte 32) . simple-array-signed-byte-32)
     (single-float . simple-array-single-float)
     (double-float . simple-array-double-float)
+    #+long-float (long-float . simple-array-long-float)
     #+complex-float
     ((complex single-float) . simple-array-complex-single-float)
     #+complex-float
     ((complex double-float) . simple-array-complex-double-float)
+    #+(and complex-float long-float)
+    ((complex long-float) . simple-array-complex-long-float)
     (t . simple-vector))
   "An a-list for mapping simple array element types to their
   corresponding primitive types.")
@@ -283,9 +297,13 @@
 		     ((short-float single-float)
 		      (values (primitive-type-or-lose 'single-float *backend*)
 			      exact))
-		     ((double-float long-float)
+		     ((double-float #-long-float long-float)
 		      (values (primitive-type-or-lose 'double-float *backend*)
 			      exact))
+		     #+long-float
+		     (long-float
+		      (values (primitive-type-or-lose 'long-float *backend*)
+			      exact))
 		     (t
 		      (any)))))
 		(t
@@ -299,10 +317,15 @@
 		       (values (primitive-type-or-lose 'complex-single-float
 						       *backend*)
 			       exact))
-		      ((double-float long-float)
+		      ((double-float #-long-float long-float)
 		       (values (primitive-type-or-lose 'complex-double-float
 						       *backend*)
 			       exact))
+		      #+long-float
+		      (long-float
+		       (values (primitive-type-or-lose 'complex-long-float
+						       *backend*)
+			       exact))
 		      (t
 		       (part-of complex))))
 		  (part-of complex))
diff --git a/compiler/generic/vm-fndb.lisp b/compiler/generic/vm-fndb.lisp
index 07a8ffbb9191fc9a6eeaa5b6410d1bc3d8983aef..ca765b512a27bb03c4d875f9d0defdb3c41131c8 100644
--- a/compiler/generic/vm-fndb.lisp
+++ b/compiler/generic/vm-fndb.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/generic/vm-fndb.lisp,v 1.59 1998/03/03 17:35:22 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-fndb.lisp,v 1.60 1998/03/21 07:55:55 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -51,6 +51,7 @@
 	   #+complex-float complex-rational-p #+complex-float complex-float-p
 	   #+complex-float complex-single-float-p
 	   #+complex-float complex-double-float-p
+	   #+(and complex-float long-float) complex-long-float-p
 	   base-char-p %standard-char-p %instancep
 	   array-header-p simple-array-p simple-array-unsigned-byte-2-p
 	   simple-array-unsigned-byte-4-p simple-array-unsigned-byte-8-p
@@ -60,8 +61,10 @@
 	   #+signed-array simple-array-signed-byte-30-p
 	   #+signed-array simple-array-signed-byte-32-p
 	   simple-array-single-float-p simple-array-double-float-p
+	   #+long-float simple-array-long-float-p
 	   #+complex-float simple-array-complex-single-float-p
 	   #+complex-float simple-array-complex-double-float-p
+	   #+(and complex-float long-float) simple-array-complex-long-float-p
 	   system-area-pointer-p realp unsigned-byte-32-p signed-byte-32-p
 	   weak-pointer-p scavenger-hook-p code-component-p lra-p
 	   funcallable-instance-p dylan::dylan-function-p)
@@ -120,14 +123,15 @@
   (foldable flushable))
 (defknown %raw-ref-double (raw-vector index) double-float
   (foldable flushable))
+#+long-float
+(defknown %raw-ref-long (raw-vector index) long-float
+  (foldable flushable))
 (defknown %raw-set-single (raw-vector index single-float) single-float
   (unsafe))
 (defknown %raw-set-double (raw-vector index double-float) double-float
   (unsafe))
-
-(defknown %raw-bits (t fixnum) (unsigned-byte 32)
-  (foldable flushable))
-(defknown (%set-raw-bits) (t fixnum (unsigned-byte 32)) (unsigned-byte 32)
+#+long-float
+(defknown %raw-set-long (raw-vector index long-float) long-float
   (unsafe))
 
 #+complex-float
@@ -151,6 +155,11 @@
   (unsafe))
 ) ; end progn complex-float
 
+(defknown %raw-bits (t fixnum) (unsigned-byte 32)
+  (foldable flushable))
+(defknown (%set-raw-bits) (t fixnum (unsigned-byte 32)) (unsigned-byte 32)
+  (unsafe))
+
 
 (defknown allocate-vector ((unsigned-byte 8) index index) (simple-array * (*))
   (flushable movable))
diff --git a/compiler/generic/vm-tran.lisp b/compiler/generic/vm-tran.lisp
index 114a49cc4ad010a6c659961571fda9756734d0a2..ae86f4356479123e45c5b011e68d01f573b1571c 100644
--- a/compiler/generic/vm-tran.lisp
+++ b/compiler/generic/vm-tran.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/generic/vm-tran.lisp,v 1.35 1997/01/18 14:31:17 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-tran.lisp,v 1.36 1998/03/21 07:55:55 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -20,6 +20,7 @@
 ;;; equivalent types.
 ;;;
 (def-source-transform short-float-p (x) `(single-float-p ,x))
+#-long-float
 (def-source-transform long-float-p (x) `(double-float-p ,x))
 
 (def-source-transform compiled-function-p (x)
diff --git a/compiler/generic/vm-type.lisp b/compiler/generic/vm-type.lisp
index 367cd379f5eef193065c613341b09da51775a618..f95c2332a1effed094a1805bb80a375ccb18c884 100644
--- a/compiler/generic/vm-type.lisp
+++ b/compiler/generic/vm-type.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/generic/vm-type.lisp,v 1.35 1998/01/25 15:11:21 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-type.lisp,v 1.36 1998/03/21 07:55:56 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -24,7 +24,9 @@
 ;;; This is be expanded before the translator gets a chance, so we will get
 ;;; precedence.
 ;;;
+#-long-float
 (setf (info type kind 'long-float) :defined)
+#-long-float
 (deftype long-float (&optional low high)
   `(double-float ,low ,high))
 ;;;
@@ -44,8 +46,12 @@
 ;;;
 ;;; Worst case values for float attributes.
 ;;;
-(deftype float-exponent () 'double-float-exponent)
-(deftype float-digits () `(integer 0 ,vm:double-float-digits))
+(deftype float-exponent ()
+  #-long-float 'double-float-exponent
+  #+long-float 'long-float-exponent)
+(deftype float-digits ()
+  #-long-float `(integer 0 ,vm:double-float-digits)
+  #+long-float `(integer 0 ,vm:long-float-digits))
 (deftype float-radix () '(integer 2 2))
 ;;;
 ;;; A code for Boole.
@@ -92,7 +98,9 @@
     #+signed-array (signed-byte 30) #+signed-array (signed-byte 32)
     #+complex-float (complex single-float)
     #+complex-float (complex double-float)
-    base-char single-float double-float))
+    #+(and complex-float long-float) (complex long-float)
+    base-char single-float double-float
+    #+long-float long-float))
 
 (deftype unboxed-array (&optional dims)
   (collect ((types (list 'or)))
@@ -119,7 +127,8 @@
 (defun float-format-name (x)
   (etypecase x
     (single-float 'single-float)
-    (double-float 'double-float)))
+    (double-float 'double-float)
+    #+long-float (long-float 'long-float)))
 
 ;;; Specialize-Array-Type  --  Internal
 ;;;
diff --git a/compiler/generic/vm-typetran.lisp b/compiler/generic/vm-typetran.lisp
index 6e2a660f9eca83d23e11147ca0dbc7d1b6540384..b105664857cf22fb77af0ee8365974d5a0aee179 100644
--- a/compiler/generic/vm-typetran.lisp
+++ b/compiler/generic/vm-typetran.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/generic/vm-typetran.lisp,v 1.14 1998/02/03 19:22:23 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-typetran.lisp,v 1.15 1998/03/21 07:55:56 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -31,6 +31,8 @@
 (define-type-predicate complex-double-float-p (complex double-float))
 #+complex-float
 (define-type-predicate complex-single-float-p (complex single-float))
+#+(and complex-float long-float)
+(define-type-predicate complex-long-float-p (complex long-float))
 (define-type-predicate double-float-p double-float)
 (define-type-predicate fixnump fixnum)
 (define-type-predicate long-float-p long-float)
@@ -64,12 +66,18 @@
 		       (simple-array single-float (*)))
 (define-type-predicate simple-array-double-float-p
 		       (simple-array double-float (*)))
+#+long-float
+(define-type-predicate simple-array-long-float-p
+		       (simple-array long-float (*)))
 #+complex-float
 (define-type-predicate simple-array-complex-single-float-p
 		       (simple-array (complex single-float) (*)))
 #+complex-float
 (define-type-predicate simple-array-complex-double-float-p
 		       (simple-array (complex double-float) (*)))
+#+(and complex-float long-float)
+(define-type-predicate simple-array-complex-long-float-p
+		       (simple-array (complex long-float) (*)))
 (define-type-predicate system-area-pointer-p system-area-pointer)
 (define-type-predicate unsigned-byte-32-p (unsigned-byte 32))
 (define-type-predicate signed-byte-32-p (signed-byte 32))