<html lang='en'>
<head>
<meta content='text/html; charset=utf-8' http-equiv='Content-Type'>
<title>
GitLab
</title>
</meta>
</head>
<style>
  img {
    max-width: 100%;
    height: auto;
  }
  p.details {
    font-style:italic;
    color:#777
  }
  .footer p {
    font-size:small;
    color:#777
  }
  pre.commit-message {
    white-space: pre-wrap;
  }
  .file-stats a {
    text-decoration: none;
  }
  .file-stats .new-file {
    color: #090;
  }
  .file-stats .deleted-file {
    color: #B00;
  }
</style>
<body>
<div class='content'>
<h3>Raymond Toy pushed to branch rtoy-setexception-inexact at <a href="https://gitlab.common-lisp.net/cmucl/cmucl">cmucl / cmucl</a></h3>
<h4>
Commits:
</h4>
<ul>
<li>
<strong><a href="https://gitlab.common-lisp.net/cmucl/cmucl/commit/d2a8d5c7c555a2632934b0b4d1f071f59c445eaf">d2a8d5c7</a></strong>
<div>
<span>by Raymond Toy</span>
<i>at 2015-12-24T22:25:13Z</i>
</div>
<pre class='commit-message'>ADD docstrings for WITH-FLOAT-TRAPS-MASKED and
WITH-FLOAT-TRAPS-ENABLED.</pre>
</li>
<li>
<strong><a href="https://gitlab.common-lisp.net/cmucl/cmucl/commit/519d513377255796b21230c2d51df6dcc51e3f67">519d5133</a></strong>
<div>
<span>by Raymond Toy</span>
<i>at 2015-12-24T22:47:24Z</i>
</div>
<pre class='commit-message'>(setf floating-point-modes) wants (unsigned-byte 24)

When enabling traps, need to take just the low 24 bits of the arg
because (setf floating-point-modes) wants an (unsigned-byte 24)
argument.  The logorc2 makes the result negative when enabling traps.</pre>
</li>
<li>
<strong><a href="https://gitlab.common-lisp.net/cmucl/cmucl/commit/46e43aed4319f89f4ad6b68584774b348ea69be3">46e43aed</a></strong>
<div>
<span>by Raymond Toy</span>
<i>at 2015-12-24T22:48:49Z</i>
</div>
<pre class='commit-message'>Use correct package (EXT) for WITH-FLOAT-TRAPS-MASKED.

Also replae WITH-INXACT-EXCEPTION-ENABLED with
WITH-FLOAT-TRAPS-ENABLED.

All tests still pass, as expected.</pre>
</li>
</ul>
<h4>2 changed files:</h4>
<ul>
<li class='file-stats'>
<a href='#diff-0'>
src/code/float-trap.lisp
</a>
</li>
<li class='file-stats'>
<a href='#diff-1'>
tests/fdlibm.lisp
</a>
</li>
</ul>
<h4>Changes:</h4>
<li id='diff-0'>
<a href='https://gitlab.common-lisp.net/cmucl/cmucl/compare/5721ddd2c71849c61c25bad61c4d1877be45ccc7...46e43aed4319f89f4ad6b68584774b348ea69be3#diff-0'>
<strong>
src/code/float-trap.lisp
</strong>
</a>
<hr>
<pre class="highlight"><code><span style="color: #000000;background-color: #ffdddd">--- a/src/code/float-trap.lisp
</span><span style="color: #000000;background-color: #ddffdd">+++ b/src/code/float-trap.lisp
</span><span style="color: #aaaaaa">@@ -370,48 +370,62 @@
</span> 
 
 (macrolet
<span style="color: #000000;background-color: #ffdddd">-    ((with-float-traps (name logical-op)
-       `(defmacro ,(symbolicate "WITH-FLOAT-TRAPS-" name) (traps &body body)
-         "Execute BODY with the floating point exceptions listed in TRAPS
</span><span style="color: #000000;background-color: #ddffdd">+    ((with-float-traps (name logical-op docstring)
+       (let ((macro-name (symbolicate "WITH-FLOAT-TRAPS-" name)))
+        `(progn
+           (defmacro ,macro-name (traps &body body)
+             (let ((traps (dpb (float-trap-mask traps) float-traps-byte 0))
+                   (exceptions (dpb (float-trap-mask traps) float-sticky-bits 0))
+                   (trap-mask (dpb (lognot (float-trap-mask traps))
+                                   float-traps-byte #xffffffff))
+                   (exception-mask (dpb (lognot (vm::float-trap-mask traps))
+                                        float-sticky-bits #xffffffff))
+                   ;; On ppc if we are masking the invalid trap, we need to make
+                   ;; sure we wipe out the various individual sticky bits
+                   ;; representing the invalid operation.  Otherwise, if we
+                   ;; enable the invalid trap later, these sticky bits will cause
+                   ;; an exception.
+                   #+ppc
+                   (invalid-mask (if (member :invalid traps)
+                                     (dpb 0
+                                          (byte 1 31)
+                                          (dpb 0 vm::float-invalid-op-2-byte
+                                               (dpb 0 vm:float-invalid-op-1-byte #xffffffff)))
+                                     #xffffffff))
+                   (orig-modes (gensym)))
+               `(let ((,orig-modes (floating-point-modes)))
+                  (unwind-protect
+                       (progn
+                         (setf (floating-point-modes)
+                               (ldb (byte 24 0)
+                                    (,',logical-op ,orig-modes ,(logand trap-mask exception-mask))))
+                         ,@body)
+                    ;; Restore the original traps and exceptions.
+                    (setf (floating-point-modes)
+                          (logior (logand ,orig-modes ,(logior traps exceptions))
+                                  (logand (floating-point-modes)
+                                          ,(logand trap-mask exception-mask)
+                                          #+ppc
+                                          ,invalid-mask
+                                          #+mips ,(dpb 0 float-exceptions-byte #xffffffff))))))))
+           ;; Set the docstring appropriately 
+           (setf (c::info function documentation ',macro-name)
+                 ,docstring)))))
+  ;; Masked and Enabled only differ whether we AND in the bits or OR
+  ;; them.
+  (with-float-traps masked logand
+             "Execute BODY with the floating point exceptions listed in TRAPS
+  disabled.  TRAPS should be a list of possible exceptions which
+  includes :UNDERFLOW, :OVERFLOW, :INEXACT, :INVALID and
+  :DIVIDE-BY-ZERO and on the X86 :DENORMALIZED-OPERAND. The respective
+  accrued exceptions are cleared at the start of the body to support
+  their testing within, and restored on exit.")
+  (with-float-traps enabled logorc2
+             "Execute BODY with the floating point exceptions listed in TRAPS
</span>   enabled.  TRAPS should be a list of possible exceptions which
   includes :UNDERFLOW, :OVERFLOW, :INEXACT, :INVALID and
   :DIVIDE-BY-ZERO and on the X86 :DENORMALIZED-OPERAND. The respective
   accrued exceptions are cleared at the start of the body to support
<span style="color: #000000;background-color: #ffdddd">-  their testing within, and restored on exit."
-         (let ((traps (dpb (float-trap-mask traps) float-traps-byte 0))
-               (exceptions (dpb (float-trap-mask traps) float-sticky-bits 0))
-               (trap-mask (dpb (lognot (float-trap-mask traps))
-                               float-traps-byte #xffffffff))
-               (exception-mask (dpb (lognot (vm::float-trap-mask traps))
-                                    float-sticky-bits #xffffffff))
-               ;; On ppc if we are masking the invalid trap, we need to make
-               ;; sure we wipe out the various individual sticky bits
-               ;; representing the invalid operation.  Otherwise, if we
-               ;; enable the invalid trap later, these sticky bits will cause
-               ;; an exception.
-               #+ppc
-               (invalid-mask (if (member :invalid traps)
-                                 (dpb 0
-                                      (byte 1 31)
-                                      (dpb 0 vm::float-invalid-op-2-byte
-                                           (dpb 0 vm:float-invalid-op-1-byte #xffffffff)))
-                                 #xffffffff))
-               (orig-modes (gensym)))
-           `(let ((,orig-modes (floating-point-modes)))
-              (unwind-protect
-                   (progn
-                     (setf (floating-point-modes)
-                           (,',logical-op ,orig-modes ,(logand trap-mask exception-mask)))
-                     ,@body)
-                ;; Restore the original traps and exceptions.
-                (setf (floating-point-modes)
-                      (logior (logand ,orig-modes ,(logior traps exceptions))
-                              (logand (floating-point-modes)
-                                      ,(logand trap-mask exception-mask)
-                                      #+ppc
-                                      ,invalid-mask
-                                      #+mips ,(dpb 0 float-exceptions-byte #xffffffff))))))))))
-  ;; Masked and Enabled only differ whether we AND in the bits or OR
-  ;; them.
-  (with-float-traps masked logand)
-  (with-float-traps enabled logorc2))
</span><span style="color: #000000;background-color: #ddffdd">+  their testing within, and restored on exit."))
+;; Set up the appropriate documentation for these macros
+
</span></code></pre>

<br>
</li>
<li id='diff-1'>
<a href='https://gitlab.common-lisp.net/cmucl/cmucl/compare/5721ddd2c71849c61c25bad61c4d1877be45ccc7...46e43aed4319f89f4ad6b68584774b348ea69be3#diff-1'>
<strong>
tests/fdlibm.lisp
</strong>
</a>
<hr>
<pre class="highlight"><code><span style="color: #000000;background-color: #ffdddd">--- a/tests/fdlibm.lisp
</span><span style="color: #000000;background-color: #ddffdd">+++ b/tests/fdlibm.lisp
</span><span style="color: #aaaaaa">@@ -6,7 +6,7 @@
</span> (in-package "FDLIBM-TESTS")
 
 (defparameter *qnan*
<span style="color: #000000;background-color: #ffdddd">-  (kernel::with-float-traps-masked (:invalid)
</span><span style="color: #000000;background-color: #ddffdd">+  (ext:with-float-traps-masked (:invalid)
</span>     (* 0 ext:double-float-positive-infinity))
   "Some randon quiet MaN value")
 
<span style="color: #aaaaaa">@@ -15,13 +15,9 @@
</span>   "A randon signaling MaN value")
 
 (defmacro with-inexact-exception-enabled (&body body)
<span style="color: #000000;background-color: #ffdddd">-  (let ((old-modes (gensym "OLD-MODES-")))
-    `(let ((,old-modes (ext:get-floating-point-modes)))
-       (unwind-protect
-           (progn
-             (ext:set-floating-point-modes :traps '(:inexact))
-             ,@body)
-        (apply 'ext:set-floating-point-modes ,old-modes)))))
</span><span style="color: #000000;background-color: #ddffdd">+  `(ext:with-float-traps-enabled (:inexact)
+     ,@body))
+
</span> 
 (define-test %cosh.exceptions
   (:tag :fdlibm)
<span style="color: #aaaaaa">@@ -34,7 +30,7 @@
</span>   (assert-true (ext:float-nan-p (kernel:%cosh *qnan*)))
   
   ;; Same, but with overflow's masked
<span style="color: #000000;background-color: #ffdddd">-  (kernel::with-float-traps-masked (:overflow)
</span><span style="color: #000000;background-color: #ddffdd">+  (ext:with-float-traps-masked (:overflow)
</span>     (assert-equal ext:double-float-positive-infinity
                  (kernel:%cosh 1000d0))
     (assert-equal ext:double-float-positive-infinity
<span style="color: #aaaaaa">@@ -44,7 +40,7 @@
</span>     (assert-equal ext:double-float-positive-infinity
                  (kernel:%cosh ext:double-float-negative-infinity)))
   ;; Test NaN
<span style="color: #000000;background-color: #ffdddd">-  (kernel::with-float-traps-masked (:invalid)
</span><span style="color: #000000;background-color: #ddffdd">+  (ext:with-float-traps-masked (:invalid)
</span>     (assert-true (ext:float-nan-p (kernel:%cosh *snan*)))))
 
 (define-test %sinh.exceptions
<span style="color: #aaaaaa">@@ -57,7 +53,7 @@
</span>           (kernel:%sinh *snan*))
   (assert-true (ext:float-nan-p (kernel:%sinh *qnan*)))
   ;; Same, but with overflow's masked
<span style="color: #000000;background-color: #ffdddd">-  (kernel::with-float-traps-masked (:overflow)
</span><span style="color: #000000;background-color: #ddffdd">+  (ext:with-float-traps-masked (:overflow)
</span>     (assert-equal ext:double-float-positive-infinity
                  (kernel:%sinh 1000d0))
     (assert-equal ext:double-float-negative-infinity
<span style="color: #aaaaaa">@@ -67,7 +63,7 @@
</span>     (assert-equal ext:double-float-negative-infinity
                  (kernel:%sinh ext:double-float-negative-infinity)))
   ;; Test NaN
<span style="color: #000000;background-color: #ffdddd">-  (kernel::with-float-traps-masked (:invalid)
</span><span style="color: #000000;background-color: #ddffdd">+  (ext:with-float-traps-masked (:invalid)
</span>     (assert-true (ext:float-nan-p (kernel:%sinh *qnan*))))
   ;; sinh(x) = x for |x| < 2^-28.  Should signal inexact unless x = 0.
   (let ((x (scale-float 1d0 -29))
<span style="color: #aaaaaa">@@ -87,7 +83,7 @@
</span>   (assert-true (ext:float-nan-p (kernel:%tanh *qnan*)))
   (assert-error 'floating-point-invalid-operation
                (kernel:%tanh *snan*))
<span style="color: #000000;background-color: #ffdddd">-  (kernel::with-float-traps-masked (:invalid)
</span><span style="color: #000000;background-color: #ddffdd">+  (ext:with-float-traps-masked (:invalid)
</span>     (assert-true (ext:float-nan-p (kernel:%tanh *snan*))))
   ;; tanh(x) = +/- 1 for |x| > 22, raising inexact, always.
   (let ((x 22.1d0))
<span style="color: #aaaaaa">@@ -103,10 +99,10 @@
</span>           (kernel:%acosh ext:double-float-positive-infinity))
   (assert-error 'floating-point-invalid-operation
                (kernel:%acosh 0d0))
<span style="color: #000000;background-color: #ffdddd">-  (kernel::with-float-traps-masked (:overflow)
</span><span style="color: #000000;background-color: #ddffdd">+  (ext:with-float-traps-masked (:overflow)
</span>     (assert-equal ext:double-float-positive-infinity
                  (kernel:%acosh ext:double-float-positive-infinity)))
<span style="color: #000000;background-color: #ffdddd">-  (kernel::with-float-traps-masked (:invalid)
</span><span style="color: #000000;background-color: #ddffdd">+  (ext:with-float-traps-masked (:invalid)
</span>     (assert-true (ext:float-nan-p (kernel:%acosh 0d0)))))
 
 (define-test %asinh.exceptions
<span style="color: #aaaaaa">@@ -118,12 +114,12 @@
</span>   (assert-error 'floating-point-overflow
                (kernel:%asinh ext:double-float-negative-infinity))
   (assert-true (ext:float-nan-p (kernel:%asinh *qnan*)))
<span style="color: #000000;background-color: #ffdddd">-  (kernel::with-float-traps-masked (:overflow)
</span><span style="color: #000000;background-color: #ddffdd">+  (ext:with-float-traps-masked (:overflow)
</span>     (assert-equal ext:double-float-positive-infinity
                  (kernel:%asinh ext:double-float-positive-infinity))
     (assert-error ext:double-float-negative-infinity
                  (kernel:%asinh ext:double-float-negative-infinity)))
<span style="color: #000000;background-color: #ffdddd">-  (kernel::with-float-traps-masked (:invalid)
</span><span style="color: #000000;background-color: #ddffdd">+  (ext:with-float-traps-masked (:invalid)
</span>     (assert-true (ext:float-nan-p (kernel:%asinh *snan*))))
   (let ((x (scale-float 1d0 -29))
        (x0 0d0))
<span style="color: #aaaaaa">@@ -147,10 +143,10 @@
</span>           (kernel:%atanh 1d0))
   (assert-error 'division-by-zero
                (kernel:%atanh -1d0))
<span style="color: #000000;background-color: #ffdddd">-  (kernel::with-float-traps-masked (:invalid)
</span><span style="color: #000000;background-color: #ddffdd">+  (ext:with-float-traps-masked (:invalid)
</span>     (assert-true (ext:float-nan-p (kernel:%atanh 2d0)))
     (assert-true (ext:float-nan-p (kernel:%atanh -2d0))))
<span style="color: #000000;background-color: #ffdddd">-  (kernel::with-float-traps-masked (:divide-by-zero)
</span><span style="color: #000000;background-color: #ddffdd">+  (ext:with-float-traps-masked (:divide-by-zero)
</span>     (assert-equal ext:double-float-positive-infinity
                  (kernel:%atanh 1d0))
     (assert-equal ext:double-float-negative-infinity
<span style="color: #aaaaaa">@@ -165,11 +161,11 @@
</span>   (assert-error 'floating-point-invalid-operation
                (kernel:%expm1 *snan*))
   (assert-true (ext:float-nan-p (kernel:%expm1 *qnan*)))
<span style="color: #000000;background-color: #ffdddd">-  (kernel::with-float-traps-masked (:overflow)
</span><span style="color: #000000;background-color: #ddffdd">+  (ext:with-float-traps-masked (:overflow)
</span>     (assert-equal ext:double-float-positive-infinity
                 (kernel:%expm1 709.8d0))
     )
<span style="color: #000000;background-color: #ffdddd">-  (kernel::with-float-traps-masked (:invalid)
</span><span style="color: #000000;background-color: #ddffdd">+  (ext:with-float-traps-masked (:invalid)
</span>     (assert-true (ext::float-nan-p (kernel:%expm1 *snan*))))
   ;; expm1(x) = -1 for x < -56*log(2), signaling inexact
   (let ((x (* -57 (log 2d0))))
<span style="color: #aaaaaa">@@ -184,10 +180,10 @@
</span>   (assert-error 'floating-point-overflow
                (kernel:%log1p -1d0))
   (assert-true (ext:float-nan-p (kernel:%log1p *qnan*)))
<span style="color: #000000;background-color: #ffdddd">-  (kernel::with-float-traps-masked (:overflow)
</span><span style="color: #000000;background-color: #ddffdd">+  (ext:with-float-traps-masked (:overflow)
</span>     (assert-equal ext:double-float-negative-infinity
                  (kernel:%log1p -1d0)))
<span style="color: #000000;background-color: #ffdddd">-  (kernel::with-float-traps-masked (:invalid)
</span><span style="color: #000000;background-color: #ddffdd">+  (ext:with-float-traps-masked (:invalid)
</span>     (assert-true (ext:float-nan-p (kernel:%log1p *snan*))))
   ;; log1p(x) = x for |x| < 2^-54, signaling inexact except for x = 0.
   (let ((x (scale-float 1d0 -55))
<span style="color: #aaaaaa">@@ -213,7 +209,7 @@
</span>           (kernel:%exp ext:double-float-positive-infinity))
   (assert-equal 0d0
                (kernel:%exp -1000d0))
<span style="color: #000000;background-color: #ffdddd">-  (kernel::with-float-traps-masked (:overflow)
</span><span style="color: #000000;background-color: #ddffdd">+  (ext:with-float-traps-masked (:overflow)
</span>     (assert-equal ext:double-float-positive-infinity
                  (kernel:%exp 710d0)))
   (let ((modes (ext:get-floating-point-modes)))
<span style="color: #aaaaaa">@@ -247,12 +243,12 @@
</span>   (assert-error 'floating-point-invalid-operation
                (kernel:%log *snan*))
   (assert-true (ext:float-nan-p (kernel:%log *qnan*)))
<span style="color: #000000;background-color: #ffdddd">-  (kernel::with-float-traps-masked (:divide-by-zero)
</span><span style="color: #000000;background-color: #ddffdd">+  (ext:with-float-traps-masked (:divide-by-zero)
</span>     (assert-equal ext:double-float-negative-infinity
                  (kernel:%log 0d0))
     (assert-equal ext:double-float-negative-infinity
                  (kernel:%log -0d0)))
<span style="color: #000000;background-color: #ffdddd">-  (kernel::with-float-traps-masked (:invalid)
</span><span style="color: #000000;background-color: #ddffdd">+  (ext:with-float-traps-masked (:invalid)
</span>     (assert-true (ext:float-nan-p (kernel:%log -1d0)))
     (assert-true (ext:float-nan-p (kernel:%log *snan*)))))
 
<span style="color: #aaaaaa">@@ -262,7 +258,7 @@
</span>           (kernel:%acos 2d0))
   (assert-error 'floating-point-invalid-operation
                (kernel:%acos -2d0))
<span style="color: #000000;background-color: #ffdddd">-  (kernel::with-float-traps-masked (:invalid)
</span><span style="color: #000000;background-color: #ddffdd">+  (ext:with-float-traps-masked (:invalid)
</span>     (assert-true (ext:float-nan-p (kernel:%acos 2d0)))
     (assert-true (ext:float-nan-p (kernel:%acos -2d0)))))
 
<span style="color: #aaaaaa">@@ -272,7 +268,7 @@
</span>           (kernel:%asin 2d0))
   (assert-error 'floating-point-invalid-operation
                (kernel:%asin -2d0))
<span style="color: #000000;background-color: #ffdddd">-  (kernel::with-float-traps-masked (:invalid)
</span><span style="color: #000000;background-color: #ddffdd">+  (ext:with-float-traps-masked (:invalid)
</span>     (assert-true (ext:float-nan-p (kernel:%asin 2d0)))
     (assert-true (ext:float-nan-p (kernel:%asin -2d0)))))
 
<span style="color: #aaaaaa">@@ -281,7 +277,7 @@
</span>   (assert-error 'floating-point-invalid-operation
                (kernel:%atan *snan*))
   (assert-true (ext:float-nan-p (kernel:%atan *qnan*)))
<span style="color: #000000;background-color: #ffdddd">-  (kernel::with-float-traps-masked (:invalid)
</span><span style="color: #000000;background-color: #ddffdd">+  (ext:with-float-traps-masked (:invalid)
</span>     (assert-true (ext:float-nan-p (kernel:%atan *snan*))))
   ;; atan(x) = x for |x| < 2^-29, signaling inexact.
   (let ((x (scale-float 1d0 -30))
<span style="color: #aaaaaa">@@ -309,12 +305,12 @@
</span>   (assert-true (ext:float-nan-p (kernel:%log10 *qnan*)))
   (assert-equal ext:double-float-positive-infinity
                (kernel:%log10 ext:double-float-positive-infinity))
<span style="color: #000000;background-color: #ffdddd">-  (kernel::with-float-traps-masked (:divide-by-zero)
</span><span style="color: #000000;background-color: #ddffdd">+  (ext:with-float-traps-masked (:divide-by-zero)
</span>     (assert-equal ext:double-float-negative-infinity
                  (kernel:%log10 0d0))
     (assert-equal ext:double-float-negative-infinity
                  (kernel:%log10 -0d0)))
<span style="color: #000000;background-color: #ffdddd">-  (kernel::with-float-traps-masked (:invalid)
</span><span style="color: #000000;background-color: #ddffdd">+  (ext:with-float-traps-masked (:invalid)
</span>     (assert-true (ext:float-nan-p (kernel:%log10 -1d0)))))
 
 (define-test %scalbn.exceptions
<span style="color: #aaaaaa">@@ -338,7 +334,7 @@
</span>           (kernel:%scalbn most-positive-double-float 2))
   (assert-error 'floating-point-overflow
                (kernel:%scalbn most-negative-double-float 2))
<span style="color: #000000;background-color: #ffdddd">-  (kernel::with-float-traps-masked (:overflow)
</span><span style="color: #000000;background-color: #ddffdd">+  (ext:with-float-traps-masked (:overflow)
</span>     (assert-equal ext:double-float-positive-infinity
                  (kernel:%scalbn ext:double-float-positive-infinity 1))
     (assert-equal ext:double-float-positive-infinity
</code></pre>

<br>
</li>

</div>
<div class='footer' style='margin-top: 10px;'>
<p>

<br>
<a href="https://gitlab.common-lisp.net/cmucl/cmucl/compare/5721ddd2c71849c61c25bad61c4d1877be45ccc7...46e43aed4319f89f4ad6b68584774b348ea69be3">View it on GitLab</a>.
<br>
You're receiving this email because of your account on gitlab.common-lisp.net.
If you'd like to receive fewer emails, you can adjust your notification settings.

</p>
</div>
</body>
</html>