Raymond Toy pushed to branch issue-425-correctly-rounded-math-functions-single-float at cmucl / cmucl

Commits:

2 changed files:

Changes:

  • src/lisp/irrat.c
    ... ... @@ -163,6 +163,8 @@ double
    163 163 
     lisp_cosh(double x)
    164 164 
     {
    165 165 
     #ifdef FEATURE_CORE_MATH
    166 
    +    MAYBE_SIGNAL_OVERFLOW(fabs(x))
    167 
    +
    166 168 
         return cr_cosh(x);
    167 169 
     #else
    168 170 
         return __ieee754_cosh(x);
    ... ... @@ -319,6 +321,8 @@ float
    319 321 
     lisp_sinf(float x)
    320 322 
     {
    321 323 
     #ifdef FEATURE_CORE_MATH
    324 
    +    MAYBE_SIGNAL_INVALID(isinf(x), x)
    325 
    +
    322 326 
         return cr_sinf(x);
    323 327 
     #else
    324 328 
         return (float) fdlibm_sin((double) x);
    ... ... @@ -329,6 +333,8 @@ float
    329 333 
     lisp_cosf(float x)
    330 334 
     {
    331 335 
     #ifdef FEATURE_CORE_MATH
    336 
    +    MAYBE_SIGNAL_INVALID(isinf(x), x)
    337 
    +
    332 338 
         return cr_cosf(x);
    333 339 
     #else
    334 340 
         return (float) fdlibm_cos((double) x);
    ... ... @@ -339,6 +345,8 @@ float
    339 345 
     lisp_tanf(float x)
    340 346 
     {
    341 347 
     #ifdef FEATURE_CORE_MATH
    348 
    +    MAYBE_SIGNAL_INVALID(isinf(x), x)
    349 
    +
    342 350 
         return cr_tanf(x);
    343 351 
     #else
    344 352 
         return (float) fdlibm_tan((double) x);
    ... ... @@ -389,6 +397,8 @@ float
    389 397 
     lisp_sinhf(float x)
    390 398 
     {
    391 399 
     #ifdef FEATURE_CORE_MATH
    400 
    +    MAYBE_SIGNAL_OVERFLOW(x)
    401 
    +
    392 402 
         return cr_sinhf(x);
    393 403 
     #else
    394 404 
         return (float) __ieee754_sinh((double) x);
    ... ... @@ -399,6 +409,8 @@ float
    399 409 
     lisp_coshf(float x)
    400 410 
     {
    401 411 
     #ifdef FEATURE_CORE_MATH
    412 
    +    MAYBE_SIGNAL_OVERFLOW(fabs(x))
    413 
    +
    402 414 
         return cr_coshf(x);
    403 415 
     #else
    404 416 
         return (float) __ieee754_cosh((double) x);
    ... ... @@ -419,6 +431,8 @@ float
    419 431 
     lisp_asinhf(float x)
    420 432 
     {
    421 433 
     #ifdef FEATURE_CORE_MATH
    434 
    +    MAYBE_SIGNAL_OVERFLOW(x)
    435 
    +
    422 436 
         return cr_asinhf(x);
    423 437 
     #else
    424 438 
         return (float) fdlibm_asinh((double) x);
    ... ... @@ -429,6 +443,10 @@ float
    429 443 
     lisp_acoshf(float x)
    430 444 
     {
    431 445 
     #ifdef FEATURE_CORE_MATH
    446 
    +    MAYBE_SIGNAL_INVALID(x < 1, x)
    447 
    +
    448 
    +    MAYBE_SIGNAL_OVERFLOW(x)
    449 
    +
    432 450 
         return cr_acoshf(x);
    433 451 
     #else
    434 452 
         return (float) __ieee754_acosh((double) x);

  • tests/fdlibm.lisp
    ... ... @@ -8,14 +8,23 @@
    8 8 
     (defparameter *qnan*
    9 9 
       (ext:with-float-traps-masked (:invalid)
    10 10 
         (* 0 ext:double-float-positive-infinity))
    11 
    -  "Some randon quiet MaN value")
    11 
    +  "Some randon quiet double-float MaN value")
    12 
    +
    13 
    +(defparameter *qnan-single-float*
    14 
    +  (ext:with-float-traps-masked (:invalid)
    15 
    +    (* 0 ext:single-float-positive-infinity))
    16 
    +  "Some randon quiet single-float MaN value")
    12 17
    13 18 
     (defparameter *snan*
    14 19 
       (kernel:make-double-float #x7ff00000 1)
    15 
    -  "A randon signaling MaN value")
    20 
    +  "A randon signaling double-float MaN value")
    21 
    +
    22 
    +(defparameter *snan-single-float*
    23 
    +  (kernel:make-single-float #x7f800001)
    24 
    +  "A randon signaling single-float MaN value")
    16 25
    17 26 
     (define-test %cosh.exceptions
    18 
    -  (:tag :fdlibm)
    27 
    +    (:tag :fdlibm)
    19 28 
       (assert-error 'floating-point-overflow
    20 29 
     		(kernel:%cosh 1000d0))
    21 30 
       (assert-error 'floating-point-overflow
    ... ... @@ -23,6 +32,10 @@
    23 32 
       (assert-error 'floating-point-invalid-operation
    24 33 
     		(kernel:%cosh *snan*))
    25 34 
       (assert-true (ext:float-nan-p (kernel:%cosh *qnan*)))
    35 
    +  (assert-error 'floating-point-overflow
    36 
    +		(kernel:%cosh ext:double-float-positive-infinity))
    37 
    +  (assert-error 'floating-point-overflow
    38 
    +		(kernel:%cosh ext:double-float-negative-infinity))
    26 39
    27 40 
       ;; Same, but with overflow's masked
    28 41 
       (ext:with-float-traps-masked (:overflow)
    ... ... @@ -38,6 +51,34 @@
    38 51 
       (ext:with-float-traps-masked (:invalid)
    39 52 
         (assert-true (ext:float-nan-p (kernel:%cosh *snan*)))))
    40 53
    54 
    +(define-test %coshf.exceptions
    55 
    +  (:tag :fdlibm)
    56 
    +  (assert-error 'floating-point-overflow
    57 
    +		(kernel:%coshf 100f0))
    58 
    +  (assert-error 'floating-point-overflow
    59 
    +		(kernel:%coshf -100f0))
    60 
    +  (assert-error 'floating-point-invalid-operation
    61 
    +		(kernel:%coshf *snan-single-float*))
    62 
    +  (assert-true (ext:float-nan-p (kernel:%coshf *qnan-single-float*)))
    63 
    +  (assert-error 'floating-point-overflow
    64 
    +		(kernel:%coshf ext:single-float-positive-infinity))
    65 
    +  (assert-error 'floating-point-overflow
    66 
    +		(kernel:%coshf ext:single-float-negative-infinity))
    67 
    +
    68 
    +  ;; Same, but with overflow's masked
    69 
    +  (ext:with-float-traps-masked (:overflow)
    70 
    +    (assert-equal ext:single-float-positive-infinity
    71 
    +		  (kernel:%coshf 100f0))
    72 
    +    (assert-equal ext:single-float-positive-infinity
    73 
    +		  (kernel:%coshf -100f0))
    74 
    +    (assert-equal ext:single-float-positive-infinity
    75 
    +		  (kernel:%coshf ext:single-float-positive-infinity))
    76 
    +    (assert-equal ext:single-float-positive-infinity
    77 
    +		  (kernel:%coshf ext:single-float-negative-infinity)))
    78 
    +  ;; Test NaN
    79 
    +  (ext:with-float-traps-masked (:invalid)
    80 
    +    (assert-true (ext:float-nan-p (kernel:%coshf *snan-single-float*)))))
    81 
    +
    41 82 
     (define-test %sinh.exceptions
    42 83 
       (:tag :fdlibm)
    43 84 
       (assert-error 'floating-point-overflow
    ... ... @@ -47,6 +88,7 @@
    47 88 
       (assert-error 'floating-point-invalid-operation
    48 89 
     		(kernel:%sinh *snan*))
    49 90 
       (assert-true (ext:float-nan-p (kernel:%sinh *qnan*)))
    91 
    +
    50 92 
       ;; Same, but with overflow's masked
    51 93 
       (ext:with-float-traps-masked (:overflow)
    52 94 
         (assert-equal ext:double-float-positive-infinity

    • —
    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/70bd3787f0128805658e8369c83806541a6dc306...3e89a81cdee2de0d0f444d6a3113ce745fe9308d at 1771367461