mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-26 14:32:11 -08:00
Code Issues Projects Releases Packages Wiki Activity

long-float: remove conditionalization

Browse source 
Many parts of the source code were bent backward to support builds
without long floats which are always present given we depend expect
c99 compiler.

The corresponding C macros (ECL_LONG_FLOAT) and the *feature*
entry (:long-float) are marked as deprecated in the documentation.
This commit is contained in:
Daniel Kochmański 2019-05-24 21:04:59 +00:00
parent 8c30d1a371
commit ea87100a06
84 changed files with 332 additions and 528 deletions
Download patch file Download diff file Expand all files Collapse all files

3
src/cmp/cmpc-inliner.lsp
View file

@ -112,7 +112,7 @@
output))
(defun to-fixnum-float-type (type)
(dolist (i '(FIXNUM DOUBLE-FLOAT SINGLE-FLOAT #+long-float LONG-FLOAT)
(dolist (i '(FIXNUM DOUBLE-FLOAT SINGLE-FLOAT LONG-FLOAT)
nil)
(when (type>= i type)
(return i))))
@ -120,7 +120,6 @@
(defun maximum-float-type (t1 t2)
(cond ((null t1)
t2)
#+long-float
((or (eq t1 'LONG-FLOAT) (eq t2 'LONG-FLOAT))
'LONG-FLOAT)
((or (eq t1 'DOUBLE-FLOAT) (eq t2 'DOUBLE-FLOAT))

2
src/cmp/cmpc-machine.lsp
View file

@ -99,7 +99,6 @@
#+:sse2 (:float-sse-pack . nil)
#+:sse2 (:double-sse-pack . nil)
#+:sse2 (:int-sse-pack . nil)
#+:long-float (:long-double . nil)
#+complex-float (:csfloat . nil)
#+complex-float (:cdfloat . nil)
#+complex-float (:clfloat . nil)))
@ -108,6 +107,7 @@
'((:object)
(:float)
(:double)
(:long-double)
(:char)
(:unsigned-char)
(:wchar)

6
src/cmp/cmpct.lsp
View file

@ -115,9 +115,7 @@
(#.(coerce 0 'double-float) "cl_core.doublefloat_zero")
(#.(coerce -0.0 'single-float) "cl_core.singlefloat_minus_zero")
(#.(coerce -0.0 'double-float) "cl_core.doublefloat_minus_zero")
#+long-float
(#.(coerce 0 'long-float) "cl_core.longfloat_zero")
#+long-float
(#.(coerce -0.0 'long-float) "cl_core.longfloat_minus_zero")
;; We temporarily remove this constant, because the bytecodes compiler
@ -165,7 +163,6 @@
(SINGLE-FLOAT-NEGATIVE-INFINITY "-INFINITY")
(DOUBLE-FLOAT-NEGATIVE-INFINITY "-INFINITY"))
#+long-float
,@'((MOST-POSITIVE-LONG-FLOAT "LDBL_MAX")
(MOST-NEGATIVE-LONG-FLOAT "-LDBL_MAX")
(LEAST-POSITIVE-LONG-FLOAT "LDBL_TRUE_MIN")
@ -175,5 +172,4 @@
#+ieee-floating-point
(LONG-FLOAT-POSITIVE-INFINITY "INFINITY")
#+ieee-floating-point
(LONG-FLOAT-NEGATIVE-INFINITY "-INFINITY")
)))))
(LONG-FLOAT-NEGATIVE-INFINITY "-INFINITY"))))))

2
src/cmp/cmploc.lsp
View file

@ -94,7 +94,7 @@
(loc-in-c1form-movable-p (third loc)))
((member (setf loc (car loc))
'(VV VV-TEMP FIXNUM-VALUE CHARACTER-VALUE
DOUBLE-FLOAT-VALUE SINGLE-FLOAT-VALUE #+long-float LONG-FLOAT-VALUE
DOUBLE-FLOAT-VALUE SINGLE-FLOAT-VALUE LONG-FLOAT-VALUE
#+complex-float CSFLOAT-VALUE
#+complex-float CDFLOAT-VALUE
#+complex-float CLFLOAT-VALUE

4
src/cmp/cmpnum.lsp
View file

@ -97,10 +97,10 @@
(default (if only-real 'REAL 'NUMBER))
(types-list (if only-real
'(FIXNUM INTEGER RATIONAL SINGLE-FLOAT
DOUBLE-FLOAT #+long-float LONG-FLOAT FLOAT REAL
DOUBLE-FLOAT LONG-FLOAT FLOAT REAL
NUMBER)
'(FIXNUM INTEGER RATIONAL SINGLE-FLOAT
DOUBLE-FLOAT #+long-float LONG-FLOAT FLOAT REAL))))
DOUBLE-FLOAT LONG-FLOAT FLOAT REAL))))
(dolist (i types-list)
(when (and (null t1-eq) (type>= i t1))
(if (equalp t1 t2)

4
src/cmp/cmpopt.lsp
View file

@ -124,7 +124,7 @@
;;
;; (INTEGER * *), etc
((member first '(INTEGER RATIONAL FLOAT REAL SINGLE-FLOAT
DOUBLE-FLOAT #+long-float LONG-FLOAT))
DOUBLE-FLOAT LONG-FLOAT))
(let ((var1 (gensym))
(var2 (gensym)))
;; Small optimization: it is easier to check for fixnum
@ -318,7 +318,7 @@
;; does not match. However, if safety settings are low, we
;; skip the interval test.
((member first '(INTEGER RATIONAL FLOAT REAL SINGLE-FLOAT
DOUBLE-FLOAT #+long-float LONG-FLOAT))
DOUBLE-FLOAT LONG-FLOAT))
(let ((unchecked (expand-coerce form value `',first env)))
(if (policy-assume-no-errors)
unchecked

4
src/cmp/cmptop.lsp
View file

@ -481,7 +481,6 @@
(CHARACTER "CODE_CHAR")
(DOUBLE-FLOAT "ecl_make_double_float")
(SINGLE-FLOAT "ecl_make_single_float")
#+long-float
(LONG-FLOAT "ecl_make_long_float"))
"(LI" cfun "(")
(do ((types arg-types (cdr types))
@ -493,7 +492,6 @@
(CHARACTER "ecl_char_code")
(DOUBLE-FLOAT "df")
(SINGLE-FLOAT "sf")
#+long-float
(LONG-FLOAT "ecl_long_float")
(otherwise "")) "(")
(wt-lcl n) (wt ")")
@ -609,7 +607,7 @@
(:char . "_ecl_base_char_loc")
(:float . "_ecl_float_loc")
(:double . "_ecl_double_loc")
#+long-float (:long-double . "_ecl_long_double_loc")
(:long-double . "_ecl_long_double_loc")
#+complex-float (:csfloat . "_ecl_csfloat_loc")
#+complex-float (:cdfloat . "_ecl_cdfloat_loc")
#+complex-float (:clfloat . "_ecl_clfloat_loc")

14
src/cmp/cmptype.lsp
View file

@ -36,9 +36,17 @@
(defun default-init (var &optional warn)
(declare (ignore warn))
(let ((new-value (cdr (assoc (var-type var)
'((fixnum . 0) (character . #\space)
#+long-float (long-float 0.0L1)
(double-float . 0.0D1) (single-float . 0.0F1))
'((fixnum . 0)
(character . #\space)
(long-float . 0.0L1)
(double-float . 0.0D1)
(single-float . 0.0F1)
#+complex-float
(si:complex-single-float . #c(0.0f0 0.0f0))
#+complex-float
(si:complex-double-float . #c(0.0d0 0.0d0))
#+complex-float
(si:complex-single-float . #c(0.0l0 0.0l0)))
:test #'subtypep))))
(if new-value
(c1constant-value new-value :only-small-values t)

2
src/cmp/cmpwt.lsp
View file

@ -252,7 +252,6 @@
(format stream "ecl_def_ct_double_float(~A,~S,static,const);"
name value stream)))
#+long-float
(defun static-long-float-builder (name value stream)
(let* ((*read-default-float-format* 'long-float)
(*print-readably* t))
@ -328,7 +327,6 @@
(double-float (and (not (ext:float-nan-p object))
(not (ext:float-infinity-p object))
#'static-double-float-builder))
#+long-float
(long-float (and (not (ext:float-nan-p object))
(not (ext:float-infinity-p object))
#'static-long-float-builder))

20
src/cmp/sysfun.lsp
View file

@ -39,7 +39,6 @@
(def-inline aref :unsafe ((array base-char) fixnum fixnum) :unsigned-char "@0;(#0)->base_string.self[#1*(#0)->array.dims[1]+#2]")
(def-inline aref :unsafe ((array double-float) fixnum fixnum) :double "@0;(#0)->array.self.df[#1*(#0)->array.dims[1]+#2]")
(def-inline aref :unsafe ((array single-float) fixnum fixnum) :float "@0;(#0)->array.self.sf[#1*(#0)->array.dims[1]+#2]")
#+long-float
(def-inline aref :unsafe ((array long-float) fixnum fixnum) :long-double "@0;(#0)->array.self.lf[#1*(#0)->array.dims[1]+#2]")
#+complex-float (def-inline aref :unsafe ((array si:complex-single-float) fixnum fixnum) :csfloat "@0;(#0)->array.self.csf[#1*(#0)->array.dims[1]+#2]")
#+complex-float (def-inline aref :unsafe ((array si:complex-double-float) fixnum fixnum) :cdfloat "@0;(#0)->array.self.cdf[#1*(#0)->array.dims[1]+#2]")
@ -57,7 +56,6 @@
(def-inline aref :unsafe ((array base-char) fixnum) :unsigned-char "(#0)->base_string.self[#1]")
(def-inline aref :unsafe ((array double-float) fixnum) :double "(#0)->array.self.df[#1]")
(def-inline aref :unsafe ((array single-float) fixnum) :float "(#0)->array.self.sf[#1]")
#+long-float
(def-inline aref :unsafe ((array long-float) fixnum) :long-double "(#0)->array.self.lf[#1]")
#+complex-float (def-inline aref :unsafe ((array si:complex-single-float) fixnum) :csfloat "(#0)->array.self.csf[#1]")
#+complex-float (def-inline aref :unsafe ((array si:complex-double-float) fixnum) :cdfloat "(#0)->array.self.cdf[#1]")
@ -81,7 +79,6 @@
(def-inline row-major-aref :unsafe ((array ext:integer32) fixnum) :int32-t "(#0)->vector.self.i32[#1]")
(def-inline row-major-aref :unsafe ((array ext:byte64) fixnum) :uint64-t "(#0)->vector.self.b64[#1]")
(def-inline row-major-aref :unsafe ((array ext:integer64) fixnum) :int64-t "(#0)->vector.self.i64[#1]")
#+long-float
(def-inline row-major-aref :unsafe ((array long-float) fixnum) :long-double "(#0)->array.self.lf[#1]")
(def-inline row-major-aref :unsafe ((array double-float) fixnum) :double "(#0)->array.self.df[#1]")
(def-inline row-major-aref :unsafe ((array single-float) fixnum) :float "(#0)->array.self.sf[#1]")
@ -108,7 +105,6 @@
(def-inline si:row-major-aset :unsafe ((array ext:integer32) fixnum ext:integer32) :int32-t "(#0)->vector.self.i32[#1]= #2")
(def-inline si:row-major-aset :unsafe ((array ext:byte64) fixnum ext:byte64) :uint64-t "(#0)->vector.self.b64[#1]= #2")
(def-inline si:row-major-aset :unsafe ((array ext:integer64) fixnum ext:integer64) :int64-t "(#0)->vector.self.i64[#1]= #2")
#+long-float
(def-inline si:row-major-aset :unsafe ((array long-float) fixnum long-float) :long-double "(#0)->array.self.lf[#1]= #2")
(def-inline si:row-major-aset :unsafe ((array double-float) fixnum double-float) :double "(#0)->array.self.df[#1]= #2")
(def-inline si:row-major-aset :unsafe ((array single-float) fixnum single-float) :float "(#0)->array.self.sf[#1]= #2")
@ -326,7 +322,6 @@
(def-inline 1+ :always (t) t "ecl_one_plus(#0)")
(def-inline 1+ :always (fixnum) t "ecl_make_integer((#0)+1)")
#+long-float
(def-inline 1+ :always (long-float) :long-double "(long double)(#0)+1")
(def-inline 1+ :always (double-float) :double "(double)(#0)+1")
(def-inline 1+ :always (single-float) :float "(float)(#0)+1")
@ -337,7 +332,6 @@
(def-inline 1- :always (t) t "ecl_one_minus(#0)")
(def-inline 1- :always (fixnum) t "ecl_make_integer((#0)-1)")
#+long-float
(def-inline 1- :always (long-float) :long-double "(long double)(#0)-1")
(def-inline 1- :always (double-float) :double "(double)(#0)-1")
(def-inline 1- :always (single-float) :float "(float)(#0)-1")
@ -350,9 +344,7 @@
(def-inline float :always (t single-float) :float "ecl_to_float(#0)")
(def-inline float :always (t double-float) :double "ecl_to_double(#0)")
#+long-float
(def-inline float :always (t long-float) :long-double "ecl_to_long_double(#0)")
#+long-float
(def-inline float :always (fixnum-float) :long-double "((long double)(#0))" :exact-return-type t)
(def-inline float :always (fixnum-float) :double "((double)(#0))" :exact-return-type t)
(def-inline float :always (fixnum-float) :float "((float)(#0))" :exact-return-type t)
@ -491,7 +483,6 @@
(def-inline expt :always ((integer 2 2) (integer 0 29)) :fixnum "(1<<(#1))")
(def-inline expt :always ((integer 0 0) t) :fixnum "0")
(def-inline expt :always ((integer 1 1) t) :fixnum "1")
#+long-float
(def-inline expt :always ((long-float 0.0 *) long-float) :long-double "powl((long double)#0,(long double)#1)")
(def-inline expt :always ((double-float 0.0 *) double-float) :double "pow((double)#0,(double)#1)")
(def-inline expt :always ((single-float 0.0 *) single-float) :float "powf((float)#0,(float)#1)")
@ -499,7 +490,6 @@
#+complex-float (def-inline expt :always (si:complex-double-float si:complex-double-float) :cdfloat "cpow(#0,#1)")
#+complex-float (def-inline expt :always (si:complex-long-float si:complex-long-float) :clfloat "cpowl(#0,#1)")
#+long-float
(def-inline log :always (fixnum-float) :long-double "logl((long double)(#0))" :exact-return-type t)
(def-inline log :always (fixnum-float) :double "log((double)(#0))" :exact-return-type t)
(def-inline log :always (fixnum-float) :float "logf((float)(#0))" :exact-return-type t)
@ -508,7 +498,6 @@
#+complex-float (def-inline log :always (si:complex-long-float) :clfloat "clogl(#0)")
(def-inline sqrt :always (number) number "ecl_sqrt(#0)")
#+long-float
(def-inline sqrt :always ((long-float 0.0 *)) :long-double "sqrtl((long double)(#0))")
(def-inline sqrt :always ((double-float 0.0 *)) :double "sqrt((double)(#0))")
(def-inline sqrt :always ((single-float 0.0 *)) :float "sqrtf((float)(#0))")
@ -517,7 +506,6 @@
#+complex-float (def-inline sqrt :always (si:complex-long-float) :clfloat "csqrtl(#0)")
(def-inline sin :always (number) number "ecl_sin(#0)")
#+long-float
(def-inline sin :always (fixnum-float) :long-double "sinl((long double)(#0))" :exact-return-type t)
(def-inline sin :always (fixnum-float) :double "sin((double)(#0))" :exact-return-type t)
(def-inline sin :always (fixnum-float) :float "sinf((float)(#0))" :exact-return-type t)
@ -526,7 +514,6 @@
#+complex-float (def-inline sin :always (si:complex-long-float) :clfloat "csinl(#0)")
(def-inline cos :always (t) number "ecl_cos(#0)")
#+long-float
(def-inline cos :always (fixnum-float) :long-double "cosl((long double)(#0))" :exact-return-type t)
(def-inline cos :always (fixnum-float) :double "cos((double)(#0))" :exact-return-type t)
(def-inline cos :always (fixnum-float) :float "cosf((float)(#0))" :exact-return-type t)
@ -535,7 +522,6 @@
#+complex-float (def-inline cos :always (si:complex-long-float) :clfloat "ccosl(#0)")
(def-inline tan :always (t) number "ecl_tan(#0)")
#+long-float
(def-inline tan :always (fixnum-float) :long-double "tanl((long double)(#0))" :exact-return-type t)
(def-inline tan :always (fixnum-float) :double "tan((double)(#0))" :exact-return-type t)
(def-inline tan :always (fixnum-float) :float "tanf((float)(#0))" :exact-return-type t)
@ -544,7 +530,6 @@
#+complex-float (def-inline tan :always (si:complex-long-float) :clfloat "ctanl(#0)")
(def-inline sinh :always (t) number "ecl_sinh(#0)")
#+long-float
(def-inline sinh :always (fixnum-float) :long-double "sinhl((long double)(#0))" :exact-return-type t)
(def-inline sinh :always (fixnum-float) :double "sinh((double)(#0))" :exact-return-type t)
(def-inline sinh :always (fixnum-float) :float "sinhf((float)(#0))" :exact-return-type t)
@ -553,7 +538,6 @@
#+complex-float (def-inline sinh :always (si:complex-long-float) :clfloat "csinhl(#0)")
(def-inline cosh :always (t) number "ecl_cosh(#0)")
#+long-float
(def-inline cosh :always (fixnum-float) :long-double "coshl((long double)(#0))" :exact-return-type t)
(def-inline cosh :always (fixnum-float) :double "cosh((double)(#0))" :exact-return-type t)
(def-inline cosh :always (fixnum-float) :float "coshf((float)(#0))" :exact-return-type t)
@ -562,7 +546,6 @@
#+complex-float (def-inline cosh :always (si:complex-long-float) :clfloat "ccoshl(#0)")
(def-inline tanh :always (t) number "ecl_tanh(#0)")
#+long-float
(def-inline tanh :always (fixnum-float) :long-double "tanhl((long double)(#0))" :exact-return-type t)
(def-inline tanh :always (fixnum-float) :double "tanh((double)(#0))" :exact-return-type t)
(def-inline tanh :always (fixnum-float) :float "tanhf((float)(#0))" :exact-return-type t)
@ -775,9 +758,6 @@
(def-inline si:double-float-p :always (t) :bool "@0;ECL_DOUBLE_FLOAT_P(#0)")
#-long-float
(def-inline si:long-float-p :always (t) :bool "@0;ECL_DOUBLE_FLOAT_P(#0)")
#+long-float
(def-inline si:long-float-p :always (t) :bool "@0;ECL_LONG_FLOAT_P(#0)")
#+complex-float