[cmucl-cvs] [git] CMU Common Lisp branch remove-long-float created. snapshot-2012-09-2-gb9f4c10

Raymond Toy rtoy at common-lisp.net
Mon Sep 3 16:45:35 UTC 2012


This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".

The branch, remove-long-float has been created
        at  b9f4c10c9e410e05d0c7d2cee6ab708d521b061a (commit)

- Log -----------------------------------------------------------------
commit b9f4c10c9e410e05d0c7d2cee6ab708d521b061a
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Mon Sep 3 09:43:38 2012 -0700

    Remove long-float support.

diff --git a/src/code/alieneval.lisp b/src/code/alieneval.lisp
index c8f0fb8..3f267e6 100644
--- a/src/code/alieneval.lisp
+++ b/src/code/alieneval.lisp
@@ -19,7 +19,7 @@
 (intl:textdomain "cmucl")
 
 (export '(alien * array struct union enum function integer signed unsigned
-	  boolean values single-float double-float long-float
+	  boolean values single-float double-float
 	  system-area-pointer def-alien-type def-alien-variable sap-alien
 	  extern-alien with-alien slot deref addr cast alien-sap alien-size
 	  alien-funcall def-alien-routine make-alien free-alien
@@ -43,7 +43,6 @@
 	  alien-float-type alien-float-type-p
 	  alien-single-float-type alien-single-float-type-p
 	  alien-double-float-type alien-double-float-type-p
-	  alien-long-float-type alien-long-float-type-p
 	  alien-pointer-type alien-pointer-type-p alien-pointer-type-to
 	  make-alien-pointer-type
 	  alien-array-type alien-array-type-p alien-array-type-element-type
@@ -89,7 +88,6 @@
 	  alien-float-type alien-float-type-p
 	  alien-single-float-type alien-single-float-type-p
 	  alien-double-float-type alien-double-float-type-p
-	  alien-long-float-type alien-long-float-type-p
 	  alien-pointer-type alien-pointer-type-p alien-pointer-type-to
 	  make-alien-pointer-type
 	  alien-array-type alien-array-type-p alien-array-type-element-type
@@ -901,19 +899,6 @@
   `(sap-ref-double ,sap (/ ,offset vm:byte-bits)))
 
 
-#+long-float
-(def-alien-type-class (long-float :include (float (:bits #+x86 96 #+sparc 128))
-				  :include-args (type)))
-
-#+long-float
-(def-alien-type-translator long-float ()
-  (make-alien-long-float-type :type 'long-float))
-
-#+long-float
-(def-alien-type-method (long-float :extract-gen) (type sap offset)
-  (declare (ignore type))
-  `(sap-ref-long ,sap (/ ,offset vm:byte-bits)))
-
 
 ;;;; The SAP type
 
diff --git a/src/code/array.lisp b/src/code/array.lisp
index a365a57..d7d9617 100644
--- a/src/code/array.lisp
+++ b/src/code/array.lisp
@@ -136,9 +136,6 @@
     ((signed-byte 32) (values #.vm:simple-array-signed-byte-32-type 32))
     (single-float (values #.vm:simple-array-single-float-type 32))
     (double-float (values #.vm:simple-array-double-float-type 64))
-    #+long-float
-    (long-float
-     (values #.vm:simple-array-long-float-type #+x86 96 #+sparc 128))
     #+double-double
     (double-double-float
      (values #.vm::simple-array-double-double-float-type 128))
@@ -146,9 +143,6 @@
      (values #.vm:simple-array-complex-single-float-type 64))
     ((complex double-float)
      (values #.vm:simple-array-complex-double-float-type 128))
-    #+long-float
-    ((complex long-float)
-     (values #.vm:simple-array-complex-long-float-type #+x86 192 #+sparc 256))
     #+double-double
     ((complex double-double-float)
      (values #.vm::simple-array-complex-double-double-float-type 256))
@@ -508,11 +502,9 @@
        (signed-byte 32)
        single-float
        double-float
-       #+long-float long-float
        #+double-double double-double-float
        (complex single-float)
        (complex double-float)
-       #+long-float (complex long-float)
        #+double-double (complex double-double-float)))))
 
 (defun data-vector-set (array index new-value)
@@ -543,11 +535,9 @@
        (signed-byte 32)
        single-float
        double-float
-       #+long-float long-float
        #+double-double double-double-float
        (complex single-float)
        (complex double-float)
-       #+long-float (complex long-float)
        #+double-double (complex double-double-float)))))
 
 
@@ -707,14 +697,10 @@
        (vm:simple-array-signed-byte-32-type '(signed-byte 32))
        (vm:simple-array-single-float-type 'single-float)
        (vm:simple-array-double-float-type 'double-float)
-       #+long-float
-       (vm:simple-array-long-float-type 'long-float)
        #+double-double
        (vm::simple-array-double-double-float-type 'double-double-float)
        (vm:simple-array-complex-single-float-type '(complex single-float))
        (vm:simple-array-complex-double-float-type '(complex double-float))
-       #+long-float
-       (vm:simple-array-complex-long-float-type '(complex long-float))
        #+double-double
        (vm::simple-array-complex-double-double-float-type '(complex double-double-float))
        ((vm:simple-array-type vm:complex-vector-type vm:complex-array-type)
@@ -1044,8 +1030,6 @@
 	((simple-array (signed-byte 32) (*)) 0)
 	((simple-array single-float (*)) (coerce 0 'single-float))
 	((simple-array double-float (*)) (coerce 0 'double-float))
-	#+long-float
-	((simple-array long-float (*)) (coerce 0 'long-float))
 	#+double-double
 	((simple-array double-double-float (*))
 	 (coerce 0 'double-double-float))
@@ -1053,9 +1037,6 @@
 	 (coerce 0 '(complex single-float)))
 	((simple-array (complex double-float) (*))
 	 (coerce 0 '(complex double-float)))
-	#+long-float
-	((simple-array (complex long-float) (*))
-	 (coerce 0 '(complex long-float)))
 	#+double-double
 	((simple-array (complex double-double-float) (*))
 	 (coerce 0 '(complex double-double-float))))))
diff --git a/src/code/bignum.lisp b/src/code/bignum.lisp
index 3072fc7..6d80465 100644
--- a/src/code/bignum.lisp
+++ b/src/code/bignum.lisp
@@ -1863,17 +1863,6 @@ down to individual words.")
 	 hi
 	 (logior hi (ash -1 vm:float-sign-shift)))
      (%bignum-ref bits 1))))
-;;;
-#+(and long-float x86)
-(defun long-float-from-bits (bits exp plusp)
-  (declare (fixnum exp))
-  (declare (optimize (ext:inhibit-warnings 3)))
-  (make-long-float
-   (if plusp
-       exp
-       (logior exp (ash 1 15)))
-   (%bignum-ref bits 2)
-   (%bignum-ref bits 1)))
 
 ;;;
 #+nil
diff --git a/src/code/class.lisp b/src/code/class.lisp
index d30fd31..14bda3d 100644
--- a/src/code/class.lisp
+++ b/src/code/class.lisp
@@ -767,14 +767,6 @@
 	   :inherits (vector simple-array array sequence generic-vector
 		      generic-array mutable-sequence mutable-collection
 		      generic-sequence collection))
-	  #+long-float
-	  (simple-array-long-float
-	   :translation (simple-array long-float (*))
-	   :codes (#.vm:simple-array-long-float-type)
-	   :direct-superclasses (vector simple-array)
-	   :inherits (vector simple-array array sequence generic-vector
-		      generic-array mutable-sequence mutable-collection
-		      generic-sequence collection))
 	  #+double-double
 	  (simple-array-double-double-float
 	   :translation (simple-array double-double-float (*))
@@ -797,14 +789,6 @@
 	   :inherits (vector simple-array array sequence generic-vector
 		      generic-array mutable-sequence mutable-collection
 		      generic-sequence collection))
-	  #+long-float
-	  (simple-array-complex-long-float
-	   :translation (simple-array (complex long-float) (*))
-	   :codes (#.vm:simple-array-complex-long-float-type)
-	   :direct-superclasses (vector simple-array)
-	   :inherits (vector simple-array array sequence generic-vector
-		      generic-array mutable-sequence mutable-collection
-		      generic-sequence collection))
 	  #+double-double
 	  (simple-array-complex-double-double-float
 	   :translation (simple-array (complex double-double-float) (*))
@@ -842,11 +826,6 @@
 	   :translation (complex double-float)
 	   :inherits (complex number generic-number)
 	   :codes (#.vm:complex-double-float-type))
-	  #+long-float
-	  (complex-long-float
-	   :translation (complex long-float)
-	   :inherits (complex number generic-number)
-	   :codes (#.vm:complex-long-float-type))
 	  #+double-double
 	  (complex-double-double-float
 	   :translation (complex double-double-float)
@@ -862,11 +841,6 @@
 	   :translation double-float
 	   :inherits (float real number generic-number)
 	   :codes (#.vm:double-float-type))
-	  #+long-float
-	  (long-float
-	   :translation long-float
-	   :inherits (float real number generic-number)
-	   :codes (#.vm:long-float-type))
 	  #+double-double
 	  (double-double-float
 	   :translation double-double-float
diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index 0941ffe..5047c17 100644
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -3137,9 +3137,6 @@ The result is a symbol or nil if the routine cannot be found."
        (escaped-float-value single-float))
       (#.vm:double-reg-sc-number
        (escaped-float-value double-float))
-      #+long-float
-      (#.vm:long-reg-sc-number
-       (escaped-float-value long-float))
       #+double-double
       (#.vm:double-double-reg-sc-number
        (if escaped
@@ -3167,16 +3164,6 @@ The result is a symbol or nil if the routine cannot be found."
 	     escaped (+ (c:sc-offset-offset sc-offset) #+sparc 2 #-sparc 1)
 	     'double-float))
 	   :invalid-value-for-unescaped-register-storage))
-      #+long-float
-      (#.vm:complex-long-reg-sc-number
-       (if escaped
-	   (complex
-	    (vm:sigcontext-float-register
-	     escaped (c:sc-offset-offset sc-offset) 'long-float)
-	    (vm:sigcontext-float-register
-	     escaped (+ (c:sc-offset-offset sc-offset) #+sparc 4)
-	     'long-float))
-	   :invalid-value-for-unescaped-register-storage))
       #+double-double
       (#.vm:complex-double-double-reg-sc-number
        (if escaped
@@ -3203,11 +3190,6 @@ The result is a symbol or nil if the routine cannot be found."
        (with-nfp (nfp)
 	 (system:sap-ref-double nfp (* (c:sc-offset-offset sc-offset)
 				       vm:word-bytes))))
-      #+long-float
-      (#.vm:long-stack-sc-number
-       (with-nfp (nfp)
-	 (system:sap-ref-long nfp (* (c:sc-offset-offset sc-offset)
-				     vm:word-bytes))))
       #+double-double
       (#.vm:double-double-stack-sc-number
        (with-nfp (nfp)
@@ -3248,15 +3230,6 @@ The result is a symbol or nil if the routine cannot be found."
 	   (system:sap-ref-double nfp (* (+ (c:sc-offset-offset sc-offset)
 					    6)
 					 vm:word-bytes))))))
-      #+long-float
-      (#.vm:complex-long-stack-sc-number
-       (with-nfp (nfp)
-	 (complex
-	  (system:sap-ref-long nfp (* (c:sc-offset-offset sc-offset)
-				      vm:word-bytes))
-	  (system:sap-ref-long nfp (* (+ (c:sc-offset-offset sc-offset)
-					 #+sparc 4)
-				      vm:word-bytes)))))
       (#.vm:control-stack-sc-number
        (kernel:stack-ref fp (c:sc-offset-offset sc-offset)))
       (#.vm:base-char-stack-sc-number
@@ -3349,9 +3322,6 @@ The result is a symbol or nil if the routine cannot be found."
        (escaped-float-value single-float))
       (#.vm:double-reg-sc-number
        (escaped-float-value double-float))
-      #+long-float
-      (#.vm:long-reg-sc-number
-       (escaped-float-value long-float))
       #+double-double
       (#.vm:double-double-reg-sc-number
        (if escaped
@@ -3366,19 +3336,12 @@ The result is a symbol or nil if the routine cannot be found."
        (escaped-complex-float-value single-float))
       (#.vm:complex-double-reg-sc-number
        (escaped-complex-float-value double-float))
-      #+long-float
-      (#.vm:complex-long-reg-sc-number
-       (escaped-complex-float-value long-float))
       (#.vm:single-stack-sc-number
        (system:sap-ref-single fp (- (* (1+ (c:sc-offset-offset sc-offset))
 				       vm:word-bytes))))
       (#.vm:double-stack-sc-number
        (system:sap-ref-double fp (- (* (+ (c:sc-offset-offset sc-offset) 2)
 				       vm:word-bytes))))
-      #+long-float
-      (#.vm:long-stack-sc-number
-       (system:sap-ref-long fp (- (* (+ (c:sc-offset-offset sc-offset) 3)
-				     vm:word-bytes))))
       #+double-double
       (#.vm:complex-double-double-reg-sc-number
        (if escaped
@@ -3409,13 +3372,6 @@ The result is a symbol or nil if the routine cannot be found."
 					vm:word-bytes)))
 	(system:sap-ref-double fp (- (* (+ (c:sc-offset-offset sc-offset) 4)
 					vm:word-bytes)))))
-      #+long-float
-      (#.vm:complex-long-stack-sc-number
-       (complex
-	(system:sap-ref-long fp (- (* (+ (c:sc-offset-offset sc-offset) 3)
-				      vm:word-bytes)))
-	(system:sap-ref-long fp (- (* (+ (c:sc-offset-offset sc-offset) 6)
-				      vm:word-bytes)))))
       #+double-double
       (#.vm:complex-double-double-stack-sc-number
        (if escaped
@@ -3560,9 +3516,6 @@ The result is a symbol or nil if the routine cannot be found."
        (set-escaped-float-value single-float value))
       (#.vm:double-reg-sc-number
        (set-escaped-float-value double-float value))
-      #+long-float
-      (#.vm:long-reg-sc-number
-       (set-escaped-float-value long-float value))
       (#.vm:complex-single-reg-sc-number
        (when escaped
 	 (setf (vm:sigcontext-float-register
@@ -3584,18 +3537,6 @@ The result is a symbol or nil if the routine cannot be found."
 		'double-float)
 	       (imagpart value)))
        value)
-      #+long-float
-      (#.vm:complex-long-reg-sc-number
-       (when escaped
-	 (setf (vm:sigcontext-float-register
-		escaped (c:sc-offset-offset sc-offset) 'long-float)
-	       (realpart value))
-	 (setf (vm:sigcontext-float-register
-		escaped
-		(+ (c:sc-offset-offset sc-offset) #+sparc 4)
-		'long-float)
-	       (imagpart value)))
-       value)
       (#.vm:single-stack-sc-number
        (with-nfp (nfp)
 	 (setf (system:sap-ref-single nfp (* (c:sc-offset-offset sc-offset)
@@ -3606,12 +3547,6 @@ The result is a symbol or nil if the routine cannot be found."
 	 (setf (system:sap-ref-double nfp (* (c:sc-offset-offset sc-offset)
 					     vm:word-bytes))
 	       (the double-float value))))
-      #+long-float
-      (#.vm:long-stack-sc-number
-       (with-nfp (nfp)
-	 (setf (system:sap-ref-long nfp (* (c:sc-offset-offset sc-offset)
-					   vm:word-bytes))
-	       (the long-float value))))
       (#.vm:complex-single-stack-sc-number
        (with-nfp (nfp)
 	 (setf (system:sap-ref-single
@@ -3628,16 +3563,6 @@ The result is a symbol or nil if the routine cannot be found."
 	 (setf (system:sap-ref-double
 		nfp (* (+ (c:sc-offset-offset sc-offset) 2) vm:word-bytes))
 	       (the double-float (realpart value)))))
-      #+long-float
-      (#.vm:complex-long-stack-sc-number
-       (with-nfp (nfp)
-	 (setf (system:sap-ref-long
-		nfp (* (c:sc-offset-offset sc-offset) vm:word-bytes))
-	       (the long-float (realpart value)))
-	 (setf (system:sap-ref-long
-		nfp (* (+ (c:sc-offset-offset sc-offset) #+sparc 4)
-		       vm:word-bytes))
-	       (the long-float (realpart value)))))
       (#.vm:control-stack-sc-number
        (setf (kernel:stack-ref fp (c:sc-offset-offset sc-offset)) value))
       (#.vm:base-char-stack-sc-number
@@ -3690,10 +3615,6 @@ The result is a symbol or nil if the routine cannot be found."
       (#.vm:double-reg-sc-number
 	#+nil ;;  don't have escaped floats -- still in npx?
        (set-escaped-float-value double-float value))
-      #+long-float
-      (#.vm:long-reg-sc-number
-	#+nil ;;  don't have escaped floats -- still in npx?
-       (set-escaped-float-value long-float value))
       (#.vm:single-stack-sc-number
        (setf (system:sap-ref-single
 	      fp (- (* (1+ (c:sc-offset-offset sc-offset)) vm:word-bytes)))
@@ -3702,11 +3623,6 @@ The result is a symbol or nil if the routine cannot be found."
        (setf (system:sap-ref-double
 	      fp (- (* (+ (c:sc-offset-offset sc-offset) 2) vm:word-bytes)))
 	     (the double-float value)))
-      #+long-float
-      (#.vm:long-stack-sc-number
-       (setf (system:sap-ref-long
-	      fp (- (* (+ (c:sc-offset-offset sc-offset) 3) vm:word-bytes)))
-	     (the long-float value)))
       (#.vm:complex-single-stack-sc-number
        (setf (system:sap-ref-single
 	      fp (- (* (1+ (c:sc-offset-offset sc-offset)) vm:word-bytes)))
@@ -3721,14 +3637,6 @@ The result is a symbol or nil if the routine cannot be found."
        (setf (system:sap-ref-double
 	      fp (- (* (+ (c:sc-offset-offset sc-offset) 4) vm:word-bytes)))
 	     (imagpart (the (complex double-float) value))))
-      #+long-float
-      (#.vm:complex-long-stack-sc-number
-       (setf (system:sap-ref-long
-	      fp (- (* (+ (c:sc-offset-offset sc-offset) 3) vm:word-bytes)))
-	     (realpart (the (complex long-float) value)))
-       (setf (system:sap-ref-long
-	      fp (- (* (+ (c:sc-offset-offset sc-offset) 6) vm:word-bytes)))
-	     (imagpart (the (complex long-float) value))))
       (#.vm:control-stack-sc-number
        (setf (kernel:stack-ref fp (c:sc-offset-offset sc-offset)) value))
       (#.vm:base-char-stack-sc-number
diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp
index 931bbb7..3ee290b 100644
--- a/src/code/defstruct.lisp
+++ b/src/code/defstruct.lisp
@@ -69,11 +69,6 @@
   (declare (type index index))
   (%raw-ref-double vec index))
 
-#+long-float
-(defun %raw-ref-long (vec index)
-  (declare (type index index))
-  (%raw-ref-long vec index))
-
 (defun %raw-set-single (vec index val)
   (declare (type index index))
   (%raw-set-single vec index val))
@@ -82,11 +77,6 @@
   (declare (type index index))
   (%raw-set-double vec index val))
 
-#+long-float
-(defun %raw-set-long (vec index val)
-  (declare (type index index))
-  (%raw-set-long vec index val))
-
 (defun %raw-ref-complex-single (vec index)
   (declare (type index index))
   (%raw-ref-complex-single vec index))
@@ -95,11 +85,6 @@
   (declare (type index index))
   (%raw-ref-complex-double vec index))
 
-#+long-float
-(defun %raw-ref-complex-long (vec index)
-  (declare (type index index))
-  (%raw-ref-complex-long vec index))
-
 (defun %raw-set-complex-single (vec index val)
   (declare (type index index))
   (%raw-set-complex-single vec index val))
@@ -108,11 +93,6 @@
   (declare (type index index))
   (%raw-set-complex-double vec index val))
 
-#+long-float
-(defun %raw-set-complex-long (vec index val)
-  (declare (type index index))
-  (%raw-set-complex-long vec index val))
-
 (defun %instance-layout (instance)
   (%instance-layout instance))
 
@@ -168,12 +148,8 @@
 (defsetf %instance-ref %instance-set)
 (defsetf %raw-ref-single %raw-set-single)
 (defsetf %raw-ref-double %raw-set-double)
-#+long-float
-(defsetf %raw-ref-long %raw-set-long)
 (defsetf %raw-ref-complex-single %raw-set-complex-single)
 (defsetf %raw-ref-complex-double %raw-set-complex-double)
-#+long-float
-(defsetf %raw-ref-complex-long %raw-set-complex-long)
 (defsetf %instance-layout %set-instance-layout)
 (defsetf %funcallable-instance-info %set-funcallable-instance-info)
 
@@ -294,9 +270,8 @@
   (type t)			; declared type specifier
   ;;
   ;; If a raw slot, what it holds.  T means not raw.
-  (raw-type t :type (member t single-float double-float #+long-float long-float
+  (raw-type t :type (member t single-float double-float
 			    complex-single-float complex-double-float
-			    #+long-float complex-long-float
 			    unsigned-byte))
   (read-only nil :type (member t nil)))
 
@@ -737,16 +712,10 @@
 	       (values 'single-float 1))
 	      ((subtypep type 'double-float)
 	       (values 'double-float 2))
-	      #+long-float
-	      ((subtypep type 'long-float)
-	       (values 'long-float #+x86 3 #+sparc 4))
 	      ((subtypep type '(complex single-float))
 	       (values 'complex-single-float 2))
 	      ((subtypep type '(complex double-float))
 	       (values 'complex-double-float 4))
-	      #+long-float
-	      ((subtypep type '(complex long-float))
-	       (values 'complex-long-float #+x86 6 #+sparc 8))
 	      (t (values nil nil)))
 
       (cond ((not raw-type)
@@ -1147,24 +1116,14 @@
      (ecase rtype
        (single-float '%raw-ref-single)
        (double-float '%raw-ref-double)
-       #+long-float
-       (long-float '%raw-ref-long)
        (complex-single-float '%raw-ref-complex-single)
        (complex-double-float '%raw-ref-complex-double)
-       #+long-float
-       (complex-long-float '%raw-ref-complex-long)
        (unsigned-byte 'aref)
        ((t)
 	(if (eq (dd-type defstruct) 'funcallable-structure)
 	    '%funcallable-instance-info
 	    '%instance-ref)))
      (case rtype
-       #+long-float
-       (complex-long-float
-	(truncate (dsd-index slot) #+x86 6 #+sparc 8))
-       #+long-float
-       (long-float
-	(truncate (dsd-index slot) #+x86 3 #+sparc 4))
        (double-float
 	(ash (dsd-index slot) -1))
        (complex-double-float
diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index e41b331..e633b66 100644
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -114,10 +114,6 @@
     ((simple-array double-float (*)) 8)
     ((simple-array (complex single-float) (*)) 8)
     ((simple-array (complex double-float) (*)) 16)
-    #+long-float
-    ((simple-array long-float (*)) 10)
-    #+long-float
-    ((simple-array (complex long-float) (*)) 20)
     #+double-double
     ((simple-array double-double-float (*)) 16)
     #+double-double
diff --git a/src/code/float.lisp b/src/code/float.lisp
index ce7e572..7ce7021 100644
--- a/src/code/float.lisp
+++ b/src/code/float.lisp
@@ -146,13 +146,8 @@
 		  (ash vm:long-float-hidden-bit 32)))
 (defconstant least-negative-normalized-double-float
   (double-from-bits 1 vm:double-float-normal-exponent-min 0))
-#-long-float
 (defconstant least-negative-normalized-long-float
   least-negative-normalized-double-float)
-#+(and long-float x86)
-(defconstant least-negative-normalized-long-float
-  (long-from-bits 1 vm:long-float-normal-exponent-min
-		  (ash vm:long-float-hidden-bit 32)))
 
 (defconstant most-positive-single-float
   (single-from-bits 0 vm:single-float-normal-exponent-max
@@ -165,21 +160,11 @@
 (defconstant most-positive-double-float
   (double-from-bits 0 vm:double-float-normal-exponent-max
 		    (ldb (byte vm:double-float-digits 0) -1)))
-#-long-float
 (defconstant most-positive-long-float most-positive-double-float)
-#+(and long-float x86)
-(defconstant most-positive-long-float
-  (long-from-bits 0 vm:long-float-normal-exponent-max
-		  (ldb (byte vm:long-float-digits 0) -1)))
 (defconstant most-negative-double-float
   (double-from-bits 1 vm:double-float-normal-exponent-max
 		    (ldb (byte vm:double-float-digits 0) -1)))
-#-long-float
 (defconstant most-negative-long-float most-negative-double-float)
-#+(and long-float x86)
-(defconstant most-negative-long-float
-  (long-from-bits 1 vm:long-float-normal-exponent-max
-		  (ldb (byte vm:long-float-digits 0) -1)))
 
 (defconstant single-float-positive-infinity
   (single-from-bits 0 (1+ vm:single-float-normal-exponent-max) 0))
@@ -189,20 +174,10 @@
 (defconstant short-float-negative-infinity single-float-negative-infinity)
 (defconstant double-float-positive-infinity
   (double-from-bits 0 (1+ vm:double-float-normal-exponent-max) 0))
-#-long-float
 (defconstant long-float-positive-infinity double-float-positive-infinity)
-#+(and long-float x86)
-(defconstant long-float-positive-infinity
-  (long-from-bits 0 (1+ vm:long-float-normal-exponent-max)
-		  (ash vm:long-float-hidden-bit 32)))
 (defconstant double-float-negative-infinity
   (double-from-bits 1 (1+ vm:double-float-normal-exponent-max) 0))
-#-long-float
 (defconstant long-float-negative-infinity double-float-negative-infinity)
-#+(and long-float x86)
-(defconstant long-float-negative-infinity
-  (long-from-bits 1 (1+ vm:long-float-normal-exponent-max)
-		  (ash vm:long-float-hidden-bit 32)))
 
 (defconstant single-float-epsilon
   (single-from-bits 0 (- vm:single-float-bias (1- vm:single-float-digits)) 1))
@@ -210,32 +185,12 @@
 (defconstant single-float-negative-epsilon
   (single-from-bits 0 (- vm:single-float-bias vm:single-float-digits) 1))
 (defconstant short-float-negative-epsilon single-float-negative-epsilon)
-#-(and long-float x86)
 (defconstant double-float-epsilon
   (double-from-bits 0 (- vm:double-float-bias (1- vm:double-float-digits)) 1))
-#+(and long-float x86)
-(defconstant double-float-epsilon
-  (double-from-bits 0 (- vm:double-float-bias (1- vm:double-float-digits))
-		    (expt 2 42)))
-#-long-float
 (defconstant long-float-epsilon double-float-epsilon)
-#+(and long-float x86)
-(defconstant long-float-epsilon
-  (long-from-bits 0 (- vm:long-float-bias (1- vm:long-float-digits))
-		  (+ 1 (ash vm:long-float-hidden-bit 32))))
-#-(and long-float x86)
 (defconstant double-float-negative-epsilon
   (double-from-bits 0 (- vm:double-float-bias vm:double-float-digits) 1))
-#+(and long-float x86)
-(defconstant double-float-negative-epsilon
-  (double-from-bits 0 (- vm:double-float-bias vm:double-float-digits)
-		    (expt 2 42)))
-#-long-float
 (defconstant long-float-negative-epsilon double-float-negative-epsilon)
-#+(and long-float x86)
-(defconstant long-float-negative-epsilon
-  (long-from-bits 0 (- vm:long-float-bias vm:long-float-digits)
-		  (+ 1 (ash vm:long-float-hidden-bit 32))))
 
 
 ;;;; Float predicates and environment query:
@@ -254,13 +209,9 @@
     ((double-float)
      (and (zerop (ldb vm:double-float-exponent-byte
 		      (double-float-high-bits x)))
-	  (not (zerop x))))
-    #+(and long-float x86)
-    ((long-float)
-     (and (zerop (ldb vm:long-float-exponent-byte (long-float-exp-bits x)))
 	  (not (zerop x))))))
 
-(macrolet ((frob (name doc single double #+(and long-float x86) long
+(macrolet ((frob (name doc single double
 		       #+double-double double-double)
 	     `(defun ,name (x)
 		,doc
@@ -277,15 +228,6 @@
 		     (and (> (ldb vm:double-float-exponent-byte hi)
 			     vm:double-float-normal-exponent-max)
 			  ,double)))
-		  #+(and long-float x86)
-		  ((long-float)
-		   (let ((exp (long-float-exp-bits x))
-			 (hi (long-float-high-bits x))
-			 (lo (long-float-low-bits x)))
-		     (declare (ignorable lo))
-		     (and (> (ldb vm:long-float-exponent-byte exp)
-			     vm:long-float-normal-exponent-max)
-			  ,long)))
 		  #+double-double
 		  ((double-double-float)
 		   ,double-double)))))
@@ -294,9 +236,6 @@
     (zerop (ldb vm:single-float-significand-byte bits))
     (and (zerop (ldb vm:double-float-significand-byte hi))
 	 (zerop lo))
-    #+(and long-float x86)
-    (and (zerop (ldb vm:long-float-significand-byte hi))
-	 (zerop lo))
     #+double-double
     (float-infinity-p (double-double-hi x)))
 
@@ -304,9 +243,6 @@
     (not (zerop (ldb vm:single-float-significand-byte bits)))
     (or (not (zerop (ldb vm:double-float-significand-byte hi)))
 	(not (zerop lo)))
-    #+(and long-float x86)
-    (or (not (zerop (ldb vm:long-float-significand-byte hi)))
-	(not (zerop lo)))
     #+double-double
     (float-nan-p (double-double-hi x)))
 
@@ -316,9 +252,6 @@
 		   vm:single-float-trapping-nan-bit))
     (zerop (logand (ldb vm:double-float-significand-byte hi)
 		   vm:double-float-trapping-nan-bit))
-    #+(and long-float x86)
-    (zerop (logand (ldb vm:long-float-significand-byte hi)
-		   vm:long-float-trapping-nan-bit))
     #+double-double
     (float-trapping-nan-p (double-double-hi x))))
 
@@ -350,10 +283,6 @@
       ((double-float)
        (frob vm:double-float-digits vm:double-float-bias
 	 integer-decode-double-denorm))
-      #+long-float
-      ((long-float)
-       (frob vm:long-float-digits vm:long-float-bias
-	     integer-decode-long-denorm))
       #+double-double
       ((double-double-float)
        ;; What exactly is the precision for a double-double?  We make
@@ -406,8 +335,6 @@
   (let ((f1-sign (if (etypecase float1
 		       (single-float (minusp (single-float-bits float1)))
 		       (double-float (minusp (double-float-high-bits float1)))
-		       #+long-float
-		       (long-float (minusp (long-float-exp-bits float1)))
 		       #+double-double
 		       (double-double-float (minusp (float-sign (double-double-hi float1)))))
 		     (float -1 float1)
@@ -424,9 +351,7 @@
 (defun float-format-digits (format)
   (ecase format
     ((short-float single-float) vm:single-float-digits)
-    ((double-float #-long-float long-float) vm:double-float-digits)
-    #+long-float
-    (long-float vm:long-float-digits)
+    ((double-float long-float) vm:double-float-digits)
     #+double-double
     (double-double-float vm:double-double-float-digits)))
 
@@ -439,8 +364,6 @@
   (number-dispatch ((f float))
     ((single-float) vm:single-float-digits)
     ((double-float) vm:double-float-digits)
-    #+long-float
-    ((long-float) vm:long-float-digits)
     #+double-double
     ((double-double-float) vm:double-double-float-digits)))
 
@@ -566,40 +489,6 @@
 	    biased sign)))))
 
 
-;;; INTEGER-DECODE-LONG-DENORM  --  Internal
-;;;
-#+(and long-float x86)
-(defun integer-decode-long-denorm (x)
-  (declare (type long-float x))
-  (let* ((high-bits (long-float-high-bits (abs x)))
-	 (sig-high (ldb vm:long-float-significand-byte high-bits))
-	 (low-bits (long-float-low-bits x))
-	 (sign (if (minusp (float-sign x)) -1 1))
-	 (biased (- (- vm:long-float-bias) vm:long-float-digits)))
-    (if (zerop sig-high)
-	(let ((sig low-bits)
-	      (extra-bias (- vm:long-float-digits 33))
-	      (bit (ash 1 31)))
-	  (declare (type (unsigned-byte 32) sig) (fixnum extra-bias))
-	  (loop
-	    (unless (zerop (logand sig bit)) (return))
-	    (setq sig (ash sig 1))
-	    (incf extra-bias))
-	  (values (ash sig (- vm:long-float-digits 32))
-		  (truly-the fixnum (- biased extra-bias))
-		  sign))
-	(let ((sig (ash sig-high 1))
-	      (extra-bias 0))
-	  (declare (type (unsigned-byte 32) sig) (fixnum extra-bias))
-	  (loop
-	    (unless (zerop (logand sig vm:long-float-hidden-bit))
-	      (return))
-	    (setq sig (ash sig 1))
-	    (incf extra-bias))
-	  (values (logior (ash sig 32) (ash low-bits (1- extra-bias)))
-		  (truly-the fixnum (- biased extra-bias))
-		  sign)))))
-
 #+double-double
 (defun integer-decode-double-double-float (x)
   (declare (type double-double-float x))
@@ -620,27 +509,6 @@
 		  lo-exp
 		  sign)))))
 
-;;; INTEGER-DECODE-LONG-FLOAT  --  Internal
-;;;
-#+(and long-float x86)
-(defun integer-decode-long-float (x)
-  (declare (long-float x))
-  (let* ((hi (long-float-high-bits x))
-	 (lo (long-float-low-bits x))
-	 (exp-bits (long-float-exp-bits x))
-	 (exp (ldb vm:long-float-exponent-byte exp-bits))
-	 (sign (if (minusp exp-bits) -1 1))
-	 (biased (- exp vm:long-float-bias vm:long-float-digits)))
-    (declare (fixnum biased))
-    (unless (<= exp vm:long-float-normal-exponent-max)
-      (error (intl:gettext "Can't decode NAN or infinity: ~S.") x))
-    (cond ((and (zerop exp) (zerop hi) (zerop lo))
-	   (values 0 biased sign))
-	  ((< exp vm:long-float-normal-exponent-min)
-	   (integer-decode-long-denorm x))
-	  (t
-	   (values (logior (ash hi 32) lo) biased sign)))))
-
 
 ;;; INTEGER-DECODE-FLOAT  --  Public
 ;;;
@@ -659,9 +527,6 @@
      (integer-decode-single-float x))
     ((double-float)
      (integer-decode-double-float x))
-    #+long-float
-    ((long-float)
-     (integer-decode-long-float x))
     #+double-double
     ((double-double-float)
      (integer-decode-double-double-float x))))
@@ -753,45 +618,6 @@
 		    lo)
 		   biased sign)))))
 
-
-;;; DECODE-LONG-DENORM  --  Internal
-;;;
-#+(and long-float x86)
-(defun decode-long-denorm (x)
-  (declare (long-float x))
-  (multiple-value-bind (sig exp sign)
-		       (integer-decode-long-denorm x)
-    (values (make-long-float vm:long-float-bias (ash sig -32)
-			     (ldb (byte 32 0) sig))
-	    (truly-the fixnum (+ exp vm:long-float-digits))
-	    (float sign x))))
-
-
-;;; DECODE-LONG-FLOAT  --  Public
-;;;
-#+(and long-float x86)
-(defun decode-long-float (x)
-  (declare (long-float x))
-  (let* ((hi (long-float-high-bits x))
-	 (lo (long-float-low-bits x))
-	 (exp-bits (long-float-exp-bits x))
-	 (exp (ldb vm:long-float-exponent-byte exp-bits))
-	 (sign (if (minusp exp-bits) -1l0 1l0))
-	 (biased (truly-the long-float-exponent (- exp vm:long-float-bias))))
-    (unless (<= exp vm:long-float-normal-exponent-max)
-      (error (intl:gettext "Can't decode NAN or infinity: ~S.") x))
-    (cond ((zerop x)
-	   (values 0.0l0 biased sign))
-	  ((< exp vm:long-float-normal-exponent-min)
-	   (decode-long-denorm x))
-	  (t
-	   (values (make-long-float
-		    (dpb vm:long-float-bias vm:long-float-exponent-byte
-			 exp-bits)
-		    hi
-		    lo)
-		   biased sign)))))
-
 ;;; DECODE-DOUBLE-DOUBLE-FLOAT -- Public
 #+double-double
 (defun decode-double-double-float (x)
@@ -818,9 +644,6 @@
      (decode-single-float f))
     ((double-float)
      (decode-double-float f))
-    #+long-float
-    ((long-float)
-     (decode-long-float f))
     #+double-double
     ((double-double-float)
      (decode-double-double-float f))))
@@ -942,11 +765,6 @@
       (make-double-float (dpb new-exp vm:double-float-exponent-byte hi)
 			 lo)))))
 
-#+(and x86 long-float)
-(defun scale-long-float (x exp)
-  (declare (long-float x) (fixnum exp))
-  (scale-float x exp))
-
 #+double-double
 (defun scale-double-double-float (x exp)
   (declare (type double-double-float x) (fixnum exp))
@@ -967,9 +785,6 @@
      (scale-single-float f ex))
     ((double-float)
      (scale-double-float f ex))
-    #+long-float
-    ((long-float)
-     (scale-long-float f ex))
     #+double-double
     ((double-double-float)
      (scale-double-double-float f ex))))
@@ -983,9 +798,9 @@
   result is the same float format as OTHER."
   (if otherp
       (number-dispatch ((number real) (other float))
-	(((foreach rational single-float double-float #+long-float long-float
+	(((foreach rational single-float double-float
 		   #+double-double double-double-float)
-	  (foreach single-float double-float #+long-float long-float
+	  (foreach single-float double-float
 		   #+double-double double-double-float))
 	 (coerce number '(dispatch-type other))))
       (if (floatp number)
@@ -997,7 +812,6 @@
 	     `(defun ,name (x)
 		(number-dispatch ((x real))
 		  (((foreach single-float double-float
-			     #+long-float long-float
 			     #+double-double double-double-float
 			     fixnum))
 		   (coerce x ',type))
@@ -1007,8 +821,6 @@
 		   (float-ratio x ',type))))))
   (frob %single-float single-float)
   (frob %double-float double-float)
-  #+long-float
-  (frob %long-float long-float)
   #+(and nil double-double)
   (frob %double-double-float double-double-float))
 
@@ -1105,10 +917,7 @@
 		     (single-float
 		      (single-from-bits sign vm:single-float-bias bits))
 		     (double-float
-		      (double-from-bits sign vm:double-float-bias bits))
-		     #+long-float
-		     (long-float
-		      (long-from-bits sign vm:long-float-bias bits))))))
+		      (double-from-bits sign vm:double-float-bias bits))))))
 	(loop
 	  (multiple-value-bind (fraction-and-guard rem)
 			       (truncate shifted-num den)
@@ -1226,7 +1035,7 @@ rounding modes & do ieee round-to-integer.
   (number-dispatch ((number real))
     ((integer) number)
     ((ratio) (values (truncate (numerator number) (denominator number))))
-    (((foreach single-float double-float #+long-float long-float))
+    (((foreach single-float double-float))
      (if (< (float most-negative-fixnum number)
 	    number
 	    (float most-positive-fixnum number))
@@ -1283,7 +1092,7 @@ rounding modes & do ieee round-to-integer.
     (number-dispatch ((number real))
       ((integer) number)
       ((ratio) (values (round (numerator number) (denominator number))))
-      (((foreach single-float double-float #+long-float long-float))
+      (((foreach single-float double-float))
        (if (< (float most-negative-fixnum number)
 	      number
 	      (float most-positive-fixnum number))
@@ -1504,7 +1313,7 @@ rounding modes & do ieee round-to-integer.
   more efficient than RATIONALIZE, but it assumes that floating-point is
   completely accurate, giving a result that isn't as pretty."
   (number-dispatch ((x real))
-    (((foreach single-float double-float #+long-float long-float
+    (((foreach single-float double-float
 	       #+double-double double-double-float))
      (multiple-value-bind (bits exp)
 			  (integer-decode-float x)
@@ -1625,7 +1434,7 @@ rounding modes & do ieee round-to-integer.
   their precision.  RATIONALIZE (and also RATIONAL) preserve the invariant:
       (= x (float (rationalize x) x))"
   (number-dispatch ((x real))
-    (((foreach single-float double-float #+long-float long-float
+    (((foreach single-float double-float
 	       #+double-double double-double-float))
      ;; This is a fairly straigtforward implementation of the iterative
      ;; algorithm above.

-----------------------------------------------------------------------


hooks/post-receive
-- 
CMU Common Lisp




More information about the cmucl-cvs mailing list