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(a)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
