Commit b9f4c10c authored by Raymond Toy's avatar Raymond Toy
Browse files

Remove long-float support.

parent 000a0be0
......@@ -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
......
......@@ -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))))))
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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)))