Commit 0b0e0266 authored by Juan Jose Garcia Ripoll's avatar Juan Jose Garcia Ripoll
Browse files

Create constants in cl_core for variants of -0.0 and use them in compiled...

Create constants in cl_core for variants of -0.0 and use them in compiled code. IMAGPART now produces signed zeros for negative real numbers.
parent cbffb985
......@@ -8,6 +8,15 @@ ECL 9.6.2:
- RATIONAL and FLOAT work more accurately with long-floats.
- IMAGPART returns (* 0 x) when the argument X is a real. This follows the
ANSI specification, but has the (wrong?) side effect that the imaginary
part of -0.0 is -0.0, not 0.
- Three new C constants {single,double,long}float_minus_zero in cl_core
save memory when creating zeros.
- The constants in cl_core are now used in compiled code.
ECL 9.6:
========
......
......@@ -1335,18 +1335,30 @@ cl_imagpart(cl_object x)
break;
#ifdef ECL_SHORT_FLOAT
case t_shortfloat:
x = make_shortfloat(0.0);
if (signbit(ecl_short_float(x)))
x = make_shortfloat(-0.0);
else
x = make_shortfloat(0.0);
break;
#endif
case t_singlefloat:
x = cl_core.singlefloat_zero;
if (signbit(sf(x)))
x = cl_core.singlefloat_minus_zero;
else
x = cl_core.singlefloat_zero;
break;
case t_doublefloat:
x = cl_core.doublefloat_zero;
if (signbit(df(x)))
x = cl_core.doublefloat_minus_zero;
else
x = cl_core.doublefloat_zero;
break;
#ifdef ECL_LONG_FLOAT
case t_longfloat:
x = cl_core.longfloat_zero;
if (signbit(ecl_long_float(x)))
x = cl_core.singlefloat_minus_zero;
else
x = cl_core.singlefloat_zero;
break;
#endif
case t_complex:
......
......@@ -504,9 +504,10 @@ ecl_make_singlefloat(float f)
DO_DETECT_FPE(f);
if (f == (float)0.0) {
#if defined(ECL_SIGNED_ZERO)
if (!signbit(f))
if (signbit(f))
return cl_core.singlefloat_minus_zero;
#endif
return(cl_core.singlefloat_zero);
return cl_core.singlefloat_zero;
}
x = ecl_alloc_object(t_singlefloat);
sf(x) = f;
......@@ -521,9 +522,10 @@ ecl_make_doublefloat(double f)
DO_DETECT_FPE(f);
if (f == (double)0.0) {
#if defined(ECL_SIGNED_ZERO)
if (!signbit(f))
if (signbit(f))
return cl_core.doublefloat_minus_zero;
#endif
return(cl_core.doublefloat_zero);
return cl_core.doublefloat_zero;
}
x = ecl_alloc_object(t_doublefloat);
df(x) = f;
......@@ -539,9 +541,10 @@ ecl_make_longfloat(long double f)
DO_DETECT_FPE(f);
if (f == (long double)0.0) {
#if defined(ECL_SIGNED_ZERO)
if (!signbit(f))
if (signbit(f))
return cl_core.longfloat_minus_zero;
#endif
return cl_core.longfloat_zero;
return cl_core.longfloat_zero;
}
x = ecl_alloc_object(t_longfloat);
x->longfloat.value = f;
......@@ -947,6 +950,22 @@ init_number(void)
#ifdef ECL_LONG_FLOAT
cl_core.longfloat_zero = ecl_alloc_object(t_longfloat);
cl_core.longfloat_zero->longfloat.value = (long double)0;
#endif
#ifdef ECL_SIGNED_ZERO
cl_core.singlefloat_minus_zero = ecl_alloc_object(t_singlefloat);
sf(cl_core.singlefloat_minus_zero) = (float)-0.0;
cl_core.doublefloat_minus_zero = ecl_alloc_object(t_doublefloat);
df(cl_core.doublefloat_minus_zero) = (double)-0.0;
# ifdef ECL_LONG_FLOAT
cl_core.longfloat_minus_zero = ecl_alloc_object(t_longfloat);
cl_core.longfloat_minus_zero->longfloat.value = (long double)-0.0;
# endif
#else
cl_core.singlefloat_minus_zero = cl_core.singlefloat_zero;
cl_core.doublefloat_minus_zero = cl_core.doublefloat_zero;
# ifdef ECL_LONG_FLOAT
cl_core.longfloat_minus_zero = cl_core.longfloat_zero;
# endif
#endif
cl_core.plus_half = ecl_make_ratio(MAKE_FIXNUM(1), MAKE_FIXNUM(2));
cl_core.minus_half = ecl_make_ratio(MAKE_FIXNUM(-1), MAKE_FIXNUM(2));
......
......@@ -67,8 +67,8 @@ cl_symbols[] = {
{"*BREAK-ON-SIGNALS*", CL_SPECIAL, NULL, -1, Cnil},
{"*COMPILE-FILE-PATHNAME*", CL_SPECIAL, NULL, -1, Cnil},
{"*COMPILE-FILE-TRUENAME*", CL_SPECIAL, NULL, -1, Cnil},
{"*COMPILE-PRINT*", CL_SPECIAL, NULL, -1, Ct},
{"*COMPILE-VERBOSE*", CL_SPECIAL, NULL, -1, Ct},
{"*COMPILE-PRINT*", CL_SPECIAL, NULL, -1, Cnil},
{"*COMPILE-VERBOSE*", CL_SPECIAL, NULL, -1, Cnil},
{"*DEBUG-IO*", CL_SPECIAL, NULL, -1, OBJNULL},
{"*DEBUGGER-HOOK*", CL_SPECIAL, NULL, -1, Cnil},
{"*DEFAULT-PATHNAME-DEFAULTS*", CL_SPECIAL, NULL, -1, OBJNULL},
......
......@@ -13,14 +13,17 @@
(in-package "COMPILER")
(defvar +optimizable-constant+ '())
(defparameter +optimizable-constants+ '())
(defun c1constant-value (val &key always only-small-values)
(cond
((let ((x (assoc val +optimizable-constant+)))
((let ((x (assoc val +optimizable-constants+)))
(when x
(pushnew "#include <float.h>" *clines-string-list*)
(c1expr (cdr x)))))
(setf x (cdr x))
(if (listp x)
(c1expr x)
x))))
((eq val nil) (c1nil))
((eq val t) (c1t))
((sys::fixnump val)
......@@ -45,17 +48,32 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; OPTIMIZABLE DOUBLE CONSTANTS
;;; OPTIMIZABLE FLOAT CONSTANTS
;;;
(mapc
#'(lambda (record)
(let* ((name (first record))
(c-value (second record))
(value (symbol-value name))
(type (lisp-type->rep-type (type-of value))))
(push (cons value `(c-inline () () ,type ,c-value :one-liner t :side-effects nil))
+optimizable-constant+)))
(c-value (second record)))
(push
(cond ((symbolp name)
(let* ((value (symbol-value name))
(type (lisp-type->rep-type (type-of value))))
(cons value `(c-inline () () ,type ,c-value
:one-liner t :side-effects nil))))
((float name)
(let* ((value name)
(type (type-of value))
(loc-type (case type
(single-float 'single-float-value)
(double-float 'double-float-value)
(long-float 'long-float-value)))
(location `(VV ,c-value)))
(cons value (make-c1form* 'LOCATION :type type
:args (list loc-type value location)))))
(t
(baboon)))
+optimizable-constants+)))
'((MOST-POSITIVE-SHORT-FLOAT "FLT_MAX")
(MOST-POSITIVE-SINGLE-FLOAT "FLT_MAX")
......@@ -80,6 +98,13 @@
(LEAST-NEGATIVE-DOUBLE-FLOAT "-DBL_MIN")
(LEAST-NEGATIVE-NORMALIZED-DOUBLE-FLOAT "-DBL_MIN")
;; Order is important: on platforms where 0.0 and -0.0 are the same
;; the last one is prioritized.
(#.(coerce -0.0 'single-float) "cl_core.singlefloat_minus_zero")
(#.(coerce -0.0 'double-float) "cl_core.doublefloat_minus_zero")
(#.(coerce 0 'single-float) "cl_core.singlefloat_zero")
(#.(coerce 0 'double-float) "cl_core.doublefloat_zero")
. #+long-float NIL #-long-float
(
(MOST-POSITIVE-LONG-FLOAT "DBL_MAX")
......@@ -88,5 +113,7 @@
(LEAST-POSITIVE-NORMALIZED-LONG-FLOAT" DBL_MIN")
(LEAST-NEGATIVE-LONG-FLOAT "-DBL_MIN")
(LEAST-NEGATIVE-NORMALIZED-LONG-FLOAT "-DBL_MIN")
(#.(coerce -0.0 'long-float) "cl_core.longfloat_minus_zero")
(#.(coerce 0 'long-float) "cl_core.longfloat_zero")
)
))
......@@ -185,8 +185,11 @@ struct cl_core_struct {
cl_object imag_two;
cl_object singlefloat_zero;
cl_object doublefloat_zero;
cl_object singlefloat_minus_zero;
cl_object doublefloat_minus_zero;
#ifdef ECL_LONG_FLOAT
cl_object longfloat_zero;
cl_object longfloat_minus_zero;
#endif
cl_object gensym_prefix;
......
......@@ -158,14 +158,14 @@ struct ecl_singlefloat {
float SFVAL; /* singlefloat value */
};
#define sf(obje) (obje)->SF.SFVAL
#define ecl_single_float(o) ((o)->singlefloat.value)
#define ecl_single_float(o) ((o)->SF.value)
struct ecl_doublefloat {
HEADER;
double DFVAL; /* doublefloat value */
};
#define df(obje) (obje)->DF.DFVAL
#define ecl_double_float(o) ((o)->doublefloat.value)
#define ecl_double_float(o) ((o)->DF.value)
#ifdef ECL_LONG_FLOAT
struct ecl_long_float {
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment