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@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