mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-24 13:31:58 -08:00
Code Issues Projects Releases Packages Wiki Activity

ieee-floats: improve api, fix ieee-float builds

Browse source 
This initializes CL infinite floats with a precomputed and casted
infinity from the appropriate C macro. This removes runtime 0/0
operations.
This commit is contained in:
Daniel Kochmański 2016-08-11 23:44:38 +02:00
parent 6f2795e4e5
commit c57fcd366c
6 changed files with 42 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

20
src/c/number.d
View file

@ -916,3 +916,23 @@ _ecl_float_to_integer(float d)
return _ecl_big_register_copy(z);
}
}
#ifdef ECL_IEEE_FP
cl_object
si_nan() {
#ifdef ECL_LONG_FLOAT
ecl_make_long_float(NAN);
#else
ecl_make_double_float(NAN);
#endif
}
cl_object
si_infinity() {
#ifdef ECL_LONG_FLOAT
ecl_make_long_float(INFINITY);
#else
ecl_make_double_float(INFINITY);
#endif
}
#endif /* ECL_IEEE_FP */

3
src/c/symbols_list.h
View file

@ -1901,6 +1901,9 @@ cl_symbols[] = {
{EXT_ "*BYTECODES-COMPILER*", EXT_SPECIAL, NULL, -1, ECL_NIL},
#ifdef ECL_IEEE_FP
{SYS_ "NAN", EXT_ORDINARY, si_nan, 0, OBJNULL},
{SYS_ "INFINITY", EXT_ORDINARY, si_infinity, 0, OBJNULL},
{EXT_ "SHORT-FLOAT-POSITIVE-INFINITY", EXT_CONSTANT, NULL, -1, OBJNULL},
{EXT_ "SINGLE-FLOAT-POSITIVE-INFINITY", EXT_CONSTANT, NULL, -1, OBJNULL},
{EXT_ "DOUBLE-FLOAT-POSITIVE-INFINITY", EXT_CONSTANT, NULL, -1, OBJNULL},

3
src/c/symbols_list2.h
View file

@ -1901,6 +1901,9 @@ cl_symbols[] = {
{EXT_ "*BYTECODES-COMPILER*",NULL},
#ifdef ECL_IEEE_FP
{SYS_ "NAN","si_nan"},
{SYS_ "INFINITY","si_infinity"},
{EXT_ "SHORT-FLOAT-POSITIVE-INFINITY",NULL},
{EXT_ "SINGLE-FLOAT-POSITIVE-INFINITY",NULL},
{EXT_ "DOUBLE-FLOAT-POSITIVE-INFINITY",NULL},

4
src/doc/new-doc/standards/index.txi
View file

@ -61,7 +61,9 @@
@node Numbers
@section Numbers
@c build option --with-ieee-fp={yes|no}
@c si::trap-fpe
@c si::nan
@c si::infinity
@c ext:{short,single,double,long}-float-{positive,negative}-infinity
@c ext:float-nan-p
@c ext:float-infinity-p

4
src/h/external.h
View file

@ -1117,6 +1117,10 @@ extern ECL_API double ecl_to_double(cl_object x);
extern ECL_API long double ecl_to_long_double(cl_object x);
extern ECL_API cl_object ecl_make_long_float(long double f);
#endif
#ifdef ECL_IEEE_FP
extern cl_object si_nan();
extern cl_object si_infinity();
#endif /* ECL_IEEE_FP */
/* num_co.c */

25
src/lsp/numlib.lsp
View file

@ -74,22 +74,15 @@
))
#+ieee-floating-point
(locally
(declare (notinline -))
(let* ((bits (si::trap-fpe 'last nil)))
(let ((a (/ (coerce 1 'short-float) (coerce 0.0 'short-float))))
(defconstant short-float-positive-infinity a)
(defconstant short-float-negative-infinity (- a)))
(let ((a (/ (coerce 1 'single-float) (coerce 0.0 'single-float))))
(defconstant single-float-positive-infinity a)
(defconstant single-float-negative-infinity (- a)))
(let ((a (/ (coerce 1 'double-float) (coerce 0.0 'double-float))))
(defconstant double-float-positive-infinity a)
(defconstant double-float-negative-infinity (- a)))
(let ((a (/ (coerce 1 'long-float) (coerce 0.0 'long-float))))
(defconstant long-float-positive-infinity a)
(defconstant long-float-negative-infinity (- a)))
(si::trap-fpe bits t)))
(let ((inf (si::infinity)))
(defconstant short-float-positive-infinity (coerce inf 'short-float))
(defconstant short-float-negative-infinity (coerce (- inf) 'short-float))
(defconstant single-float-positive-infinity (coerce inf 'single-float))
(defconstant single-float-negative-infinity (coerce (- inf) 'single-float))
(defconstant double-float-positive-infinity (coerce inf 'double-float))
(defconstant double-float-negative-infinity (coerce (- inf) 'double-float))
(defconstant long-float-positive-infinity (coerce inf 'long-float))
(defconstant long-float-negative-infinity (coerce (- inf) 'long-float)))
(defconstant imag-one #C(0.0 1.0))