[Cmucl-cvs] [git] CMU Common Lisp branch 20f-branch updated. snapshot-2014-09-10-g4469701
Raymond Toy
rtoy at common-lisp.net
Fri Sep 26 02:33:49 UTC 2014
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, 20f-branch has been updated
via 44697013015d63a72c1dc5b0a62f4331c333931c (commit)
via bcc8cd7dd797fe3998efdca0cf2adfe49150bb3f (commit)
via b51c9978bcfab5952438a1c831949c8f387cfc90 (commit)
via 8fb489459a9f50049a5eb8cf3ccc06f8225e98bc (commit)
from 02c1bde6f02c195a17d76dc57fd18562ef52bbea (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 44697013015d63a72c1dc5b0a62f4331c333931c
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Thu Sep 25 19:24:02 2014 -0700
Oops. Remove debugging print left in from commit [c0052f55]
diff --git a/src/code/reader.lisp b/src/code/reader.lisp
index 996b1f3..03f03a0 100644
--- a/src/code/reader.lisp
+++ b/src/code/reader.lisp
@@ -62,7 +62,6 @@
(reader-error-format-arguments condition))
nil error-stream
(file-position error-stream)))
- (format t "open-stream-p ~A~%" (open-stream-p error-stream))
(format stream (intl:gettext "Reader error ~@[at ~D ~]on ~S:~%~?")
(and (open-stream-p error-stream)
(file-position error-stream))
commit bcc8cd7dd797fe3998efdca0cf2adfe49150bb3f
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Wed Sep 24 20:27:54 2014 -0700
Fix type derivation of the exponent for DECODE-FLOAT.
The minimum exponent is from 0, it's from least-positive float.
* src/compiler/float-tran.lisp:
* Derive the correct minimum exponent by using the exponent from
the least-positive float value of the appropriate type.
* tests/float-tran.lisp:
* Add tests for the derived exponent type for DECODE-FLOAT.
Conflicts:
tests/float-tran.lisp
diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp
index 4aecd5c..ff09474 100644
--- a/src/compiler/float-tran.lisp
+++ b/src/compiler/float-tran.lisp
@@ -2057,13 +2057,13 @@
(when x
(nth-value 1 (decode-float x))))
(min-exp ()
- ;; Use decode-float on 0 of the appropriate type to find
- ;; the min exponent. If we don't know the actual number
- ;; format, use double, which has the widest range
- ;; (including double-double-float).
- (if (numeric-type-format arg)
- (nth-value 1 (decode-float (coerce 0 (numeric-type-format arg))))
- (nth-value 1 (decode-float (coerce 0 'double-float)))))
+ ;; Use decode-float on the least positive float of the
+ ;; appropriate type to find the min exponent. If we don't
+ ;; know the actual number format, use double, which has the
+ ;; widest range (including double-double-float).
+ (nth-value 1 (decode-float (if (eq 'single-float (numeric-type-format arg))
+ least-positive-single-float
+ least-positive-double-float))))
(max-exp ()
;; Use decode-float on the most postive number of the
;; appropriate type to find the max exponent. If we don't
diff --git a/tests/float-tran.lisp b/tests/float-tran.lisp
index 9c81882..713d399 100644
--- a/tests/float-tran.lisp
+++ b/tests/float-tran.lisp
@@ -1,3 +1,4 @@
+
;; Tests for various float transformations.
(defpackage :float-tran-tests
@@ -14,4 +15,18 @@
(assert-equalp (c::make-member-type :members (list 1f0))
(c::decode-float-sign-derive-type-aux (c::specifier-type '(single-float (0f0))))))
-
\ No newline at end of file
+(define-test decode-float-exp
+ "Test type derivation of the exponent from decode-float"
+ (assert-equalp (c::specifier-type '(integer -148 128))
+ (c::decode-float-exp-derive-type-aux
+ (c::specifier-type 'single-float)))
+ (assert-equalp (c::specifier-type '(integer -1073 1024))
+ (c::decode-float-exp-derive-type-aux
+ (c::specifier-type 'double-float)))
+ #+double-double
+ (assert-equalp (c::specifier-type '(integer -1073 1024))
+ (c::decode-float-exp-derive-type-aux
+ (c::specifier-type 'double-double-float)))
+ (assert-equalp (c::specifier-type '(integer 2 8))
+ (c::decode-float-exp-derive-type-aux
+ (c::specifier-type '(double-float 2d0 128d0)))))
commit b51c9978bcfab5952438a1c831949c8f387cfc90
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Fri Sep 19 22:35:27 2014 -0700
Fix error in type derivation for the sign in DECODE-FLOAT.
Type derivation of the sign of (DECODE-FLOAT X) returned the incorrect
value when x was declared to be of type (DOUBLE-FLOAT (0d0)).
* src/compiler/float-tran.lisp
* Fix type derivation
* tests/float-tran.lisp
* New file for tests of DECODE-FLOAT-SIGN-DERIVE-TYPE-AUX.
* tests/float.lisp
* New file to test that decode-float is compiled correctly.
diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp
index ccb6e06..4aecd5c 100644
--- a/src/compiler/float-tran.lisp
+++ b/src/compiler/float-tran.lisp
@@ -2082,24 +2082,19 @@
(defun decode-float-sign-derive-type-aux (arg)
;; Derive the sign of the float.
- (flet ((calc-sign (x)
- (when x
- (nth-value 2 (decode-float x)))))
- (let* ((lo (bound-func #'calc-sign
- (numeric-type-low arg)))
- (hi (bound-func #'calc-sign
- (numeric-type-high arg))))
- (if (numeric-type-format arg)
- (specifier-type `(,(numeric-type-format arg)
- ;; If lo or high bounds are NIL, use -1
- ;; or 1 of the appropriate type instead.
- ,(or lo (coerce -1 (numeric-type-format arg)))
- ,(or hi (coerce 1 (numeric-type-format arg)))))
- (specifier-type '(or (member 1f0 -1f0
- 1d0 -1d0
- #+double-double 1w0
- #+double-double -1w0)))))))
-
+ (if (numeric-type-format arg)
+ (let ((arg-range (interval-range-info (numeric-type->interval arg))))
+ (case arg-range
+ (+ (make-member-type :members (list (coerce 1 (numeric-type-format arg)))))
+ (- (make-member-type :members (list (coerce -1 (numeric-type-format arg)))))
+ (otherwise
+ (make-member-type :members (list (coerce 1 (numeric-type-format arg))
+ (coerce -1 (numeric-type-format arg)))))))
+ (specifier-type '(or (member 1f0 -1f0
+ 1d0 -1d0
+ #+double-double 1w0
+ #+double-double -1w0)))))
+
(defoptimizer (decode-float derive-type) ((num))
(let ((f (one-arg-derive-type num
#'(lambda (arg)
diff --git a/tests/float-tran.lisp b/tests/float-tran.lisp
new file mode 100644
index 0000000..9c81882
--- /dev/null
+++ b/tests/float-tran.lisp
@@ -0,0 +1,17 @@
+;; Tests for various float transformations.
+
+(defpackage :float-tran-tests
+ (:use :cl :lisp-unit))
+
+(in-package "FLOAT-TRAN-TESTS")
+
+(define-test decode-float-sign
+ "Test type derivation of the sign from decode-float"
+ (assert-equalp (c::make-member-type :members (list 1f0 -1f0))
+ (c::decode-float-sign-derive-type-aux (c::specifier-type 'single-float)))
+ (assert-equalp (c::make-member-type :members (list 1d0 -1d0))
+ (c::decode-float-sign-derive-type-aux (c::specifier-type 'double-float)))
+ (assert-equalp (c::make-member-type :members (list 1f0))
+ (c::decode-float-sign-derive-type-aux (c::specifier-type '(single-float (0f0))))))
+
+
\ No newline at end of file
diff --git a/tests/float.lisp b/tests/float.lisp
new file mode 100644
index 0000000..6fe1f50
--- /dev/null
+++ b/tests/float.lisp
@@ -0,0 +1,12 @@
+;; Tests of float functions
+
+(defpackage :float-tests
+ (:use :cl :lisp-unit))
+
+(in-package "FLOAT-TESTS")
+
+(define-test decode-float
+ (assert-true (funcall (compile nil #'(lambda (x)
+ (declare (type (double-float (0d0)) x))
+ (decode-float x)))
+ 1d0)))
commit 8fb489459a9f50049a5eb8cf3ccc06f8225e98bc
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Fri Sep 12 00:29:00 2014 -0700
Remove the NetBSD setexception changes on the master branch. This is
only for the upcoming release.
diff --git a/src/lisp/GNUmakefile b/src/lisp/GNUmakefile
index 056e9ea..c557d3b 100644
--- a/src/lisp/GNUmakefile
+++ b/src/lisp/GNUmakefile
@@ -12,7 +12,7 @@ FDLIBM = k_sin.c k_cos.c k_tan.c s_sin.c s_cos.c s_tan.c sincos.c \
e_acosh.c s_asinh.c e_atanh.c \
e_atan2.c \
e_rem_pio2.c k_rem_pio2.c \
- setexception.c double-values.c
+ setexception.c
SRCS = lisp.c coreparse.c alloc.c monitor.c print.c interr.c \
vars.c parse.c interrupt.c search.c validate.c globals.c \
diff --git a/src/lisp/double-values.c b/src/lisp/double-values.c
deleted file mode 100644
index 79d5921..0000000
--- a/src/lisp/double-values.c
+++ /dev/null
@@ -1,40 +0,0 @@
-/*
- * Some helper functions to return specific double values for use by
- * fdlibm_setexceptions on NetBSD. Currently, NetBSD doesn't have
- * feraiseexcept so we have to do something special. See
- * fdlibm_setexceptions.
- */
-
-#include "fdlibm.h"
-
-double
-double_zero()
-{
- return 0.0;
-}
-
-/*
- * Return most-positive-double-float
- */
-double
-double_huge()
-{
- union { int i[2]; double d; } ux;
- ux.i[HIWORD] = 0x7fefffff;
- ux.i[LOWORD] = 0xffffffff;
-
- return ux.d;
-}
-
-/*
- * Return least-positive-double-float
- */
-double
-double_tiny()
-{
- union { int i[2]; double d; } ux;
- ux.i[HIWORD] = 0;
- ux.i[LOWORD] = 1;
-
- return ux.d;
-}
diff --git a/src/lisp/setexception.c b/src/lisp/setexception.c
index d0f4519..a77a9d8 100644
--- a/src/lisp/setexception.c
+++ b/src/lisp/setexception.c
@@ -1,25 +1,4 @@
-#if defined(__NetBSD__)
-/*
- * NetBSD doesn't have fenv.h. At least the version currently being
- * used to build cmucl doesn't. Assume this also means we don't have
- * feraiseexcept. So, to generate the desired exceptions, we have to
- * create the appropriate operations to generate the desired
- * exceptions.
- */
-#undef HAVE_FERAISEEXCEPT
-
-extern double double_zero();
-extern double double_huge();
-extern double double_tiny();
-
-#else
-#define HAVE_FERAISEEXCEPT
-#endif
-
-#ifdef HAVE_FERAISEEXCEPT
#include <fenv.h>
-#endif
-
#include <math.h>
#include <stdio.h>
@@ -71,48 +50,32 @@ fdlibm_setexception(double x, enum FDLIBM_EXCEPTION type)
/* Division by zero. Use the sign of x to get the correct
* signed infinity
*/
-#ifdef HAVE_FERAISEEXCEPT
feraiseexcept(FE_DIVBYZERO);
- ret = copysign(INFINITY, x);
-#else
- ret = copysign(1, x) / double_zero();
-#endif
+ ret = copysign(INFINITY, x);
break;
case 1:
/* Underflow. Use the sign of x to get a signed zero. */
-#ifdef HAVE_FERAISEEXCEPT
feraiseexcept(FE_UNDERFLOW);
ret = copysign(0.0, x);
-#else
- ret = double_tiny() * double_tiny();;
-#endif
break;
case 2:
/* overflow */
-#ifdef HAVE_FERAISEEXCEPT
feraiseexcept(FE_OVERFLOW);
ret = copysign(INFINITY, x);
-#else
- ret = double_huge() * copysign(double_huge(), x);
-#endif
break;
case 3:
{
- /* if */
+ /* invalid */
if (!isQNaN(x)) {
/*
* If it's not a quiet NaN, we want to signal an invalid
* operation. Otherwise, we silently return a NaN.
*/
-#ifdef HAVE_FERAISEEXCEPT
feraiseexcept(FE_INVALID);
-#else
- ret = double_zero() / double_zero();
- return ret;
-#endif
}
+
/*
* FIXME: Of the many NaN values that we have, what NaN
* should we return?
-----------------------------------------------------------------------
Summary of changes:
src/code/reader.lisp | 1 -
src/compiler/float-tran.lisp | 45 +++++++++++++++++++-----------------------
src/lisp/GNUmakefile | 2 +-
src/lisp/double-values.c | 40 -------------------------------------
src/lisp/setexception.c | 43 +++-------------------------------------
tests/float-tran.lisp | 32 ++++++++++++++++++++++++++++++
tests/float.lisp | 12 +++++++++++
7 files changed, 68 insertions(+), 107 deletions(-)
delete mode 100644 src/lisp/double-values.c
create mode 100644 tests/float-tran.lisp
create mode 100644 tests/float.lisp
hooks/post-receive
--
CMU Common Lisp
More information about the cmucl-cvs
mailing list