Raymond Toy pushed to branch master at cmucl / cmucl

Commits:

2 changed files:

Changes:

  • src/lisp/irrat.c
    ... ... @@ -39,10 +39,22 @@ extern void cr_sincos(double, double *, double *);
    39 39 
      * Wrappers for the special functions
    40 40 
      */
    41 41
    42 
    +#define MAYBE_SIGNAL_INVALID(test, val)		\
    43 
    +    if ((test)) {				\
    44 
    +        return fdlibm_setexception(val, FDLIBM_INVALID);	\
    45 
    +    }
    46 
    +
    47 
    +#define MAYBE_SIGNAL_OVERFLOW(x)	\
    48 
    +    if (isinf(x)) {	\
    49 
    +	return fdlibm_setexception(x, FDLIBM_OVERFLOW); \
    50 
    +    }
    51 
    +
    42 52 
     double
    43 53 
     lisp_sin(double x)
    44 54 
     {
    45 55 
     #ifdef FEATURE_CORE_MATH
    56 
    +    MAYBE_SIGNAL_INVALID(isinf(x), x)
    57 
    +
    46 58 
         return cr_sin(x);
    47 59 
     #else
    48 60 
         return fdlibm_sin(x);
    ... ... @@ -53,6 +65,8 @@ double
    53 65 
     lisp_cos(double x)
    54 66 
     {
    55 67 
     #ifdef FEATURE_CORE_MATH
    68 
    +    MAYBE_SIGNAL_INVALID(isinf(x), x)
    69 
    +
    56 70 
         return cr_cos(x);
    57 71 
     #else
    58 72 
         return fdlibm_cos(x);
    ... ... @@ -63,6 +77,8 @@ double
    63 77 
     lisp_tan(double x)
    64 78 
     {
    65 79 
     #ifdef FEATURE_CORE_MATH
    80 
    +    MAYBE_SIGNAL_INVALID(isinf(x), x)
    81 
    +
    66 82 
         return cr_tan(x);
    67 83 
     #else
    68 84 
         return fdlibm_tan(x);
    ... ... @@ -113,6 +129,8 @@ double
    113 129 
     lisp_sinh(double x)
    114 130 
     {
    115 131 
     #ifdef FEATURE_CORE_MATH
    132 
    +    MAYBE_SIGNAL_OVERFLOW(x)
    133 
    +
    116 134 
         return cr_sinh(x);
    117 135 
     #else
    118 136 
         return __ieee754_sinh(x);
    ... ... @@ -143,6 +161,8 @@ double
    143 161 
     lisp_asinh(double x)
    144 162 
     {
    145 163 
     #ifdef FEATURE_CORE_MATH
    164 
    +    MAYBE_SIGNAL_OVERFLOW(x)
    165 
    +
    146 166 
         return cr_asinh(x);
    147 167 
     #else
    148 168 
         return fdlibm_asinh(x);
    ... ... @@ -153,6 +173,10 @@ double
    153 173 
     lisp_acosh(double x)
    154 174 
     {
    155 175 
     #ifdef FEATURE_CORE_MATH
    176 
    +    MAYBE_SIGNAL_INVALID(x < 1, x)
    177 
    +
    178 
    +    MAYBE_SIGNAL_OVERFLOW(x)
    179 
    +
    156 180 
         return cr_acosh(x);
    157 181 
     #else
    158 182 
         return __ieee754_acosh(x);

  • tests/fdlibm.lisp
    ... ... @@ -90,12 +90,8 @@
    90 90
    91 91 
     (define-test %acosh.exceptions
    92 92 
       (:tag :fdlibm)
    93 
    -  ;; Core-math returns infinity instead of signaling overflow.
    94 
    -  #-core-math
    95 93 
       (assert-error 'floating-point-overflow
    96 94 
     		(kernel:%acosh ext:double-float-positive-infinity))
    97 
    -  ;; Core-math currently returns QNaN
    98 
    -  #-core-math
    99 95 
       (assert-error 'floating-point-invalid-operation
    100 96 
     		(kernel:%acosh 0d0))
    101 97 
       (ext:with-float-traps-masked (:overflow)
    ... ... @@ -108,12 +104,8 @@
    108 104 
       (:tag :fdlibm)
    109 105 
       (assert-error 'floating-point-invalid-operation
    110 106 
     		(kernel:%asinh *snan*))
    111 
    -  ;; Core-math returns the signed infinity instead of signaling an
    112 
    -  ;; overflow.
    113 
    -  #-core-math
    114 107 
       (assert-error 'floating-point-overflow
    115 108 
     		(kernel:%asinh ext:double-float-positive-infinity))
    116 
    -  #-core-math
    117 109 
       (assert-error 'floating-point-overflow
    118 110 
     		(kernel:%asinh ext:double-float-negative-infinity))
    119 111 
       (assert-true (ext:float-nan-p (kernel:%asinh *qnan*)))
    ... ... @@ -218,7 +210,6 @@
    218 210 
       (ext:with-float-traps-masked (:overflow)
    219 211 
         (assert-equal ext:double-float-positive-infinity
    220 212 
     		  (kernel:%exp 710d0)))
    221 
    -  #-core-math
    222 213 
       (let ((modes (ext:get-floating-point-modes)))
    223 214 
         (unwind-protect
    224 215 
     	 (progn
    ... ... @@ -675,6 +666,14 @@
    675 666
    676 667 
     (define-test %cos.exceptions
    677 668 
         (:tag :fdlibm)
    669 
    +  ;; cos(inf) signals invalid operation
    670 
    +  (assert-error 'floating-point-invalid-operation
    671 
    +		(kernel:%cos ext:double-float-positive-infinity))
    672 
    +  (assert-error 'floating-point-invalid-operation
    673 
    +		(kernel:%cos ext:double-float-negative-infinity))
    674 
    +  ;; cos(nan) is NaN
    675 
    +  (assert-true (ext:float-nan-p (kernel:%cos *qnan*)))
    676 
    +
    678 677 
       ;; cos(x) = 1 for |x| < 2^-27.  Signal inexact unless x = 0
    679 678 
       (let ((x (scale-float 1d0 -28))
    680 679 
     	(x0 0d0))
    ... ... @@ -690,6 +689,14 @@
    690 689
    691 690 
     (define-test %sin.exceptions
    692 691 
         (:tag :fdlibm)
    692 
    +  ;; sin(inf) signals invalid operation
    693 
    +  (assert-error 'floating-point-invalid-operation
    694 
    +		(kernel:%sin ext:double-float-positive-infinity))
    695 
    +  (assert-error 'floating-point-invalid-operation
    696 
    +		(kernel:%sin ext:double-float-negative-infinity))
    697 
    +  ;; sin(nan) is NaN
    698 
    +  (assert-true (ext:float-nan-p (kernel:%sin *qnan*)))
    699 
    +
    693 700 
       ;; sin(x) = x for |x| < 2^-27.  Signal inexact unless x = 0
    694 701 
       (let ((x (scale-float 1d0 -28))
    695 702 
     	(x0 0d0))
    ... ... @@ -705,6 +712,14 @@
    705 712
    706 713 
     (define-test %tan.exceptions
    707 714 
         (:tag :fdlibm)
    715 
    +  ;; tan(inf) signals invalid operation
    716 
    +  (assert-error 'floating-point-invalid-operation
    717 
    +		(kernel:%tan ext:double-float-positive-infinity))
    718 
    +  (assert-error 'floating-point-invalid-operation
    719 
    +		(kernel:%tan ext:double-float-negative-infinity))
    720 
    +  ;; tan(nan) is NaN
    721 
    +  (assert-true (ext:float-nan-p (kernel:%sin *qnan*)))
    722 
    +
    708 723 
       ;; tan(x) = x for |x| < 2^-28.  Signal inexact unless x = 0
    709 724 
       (let ((x (scale-float 1d0 -29))
    710 725 
     	(x0 0d0))

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.common-lisp.net. Manage all notifications · Help Notification message regarding https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6ac1b6b434353fc47f4530660d84dfbeb1f7e84c...ec7e3a2575d7569191232b380a7176760dc0ce63 at 1771256419