<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 master
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/b4771d761fc122a33e39dfd5546db753fb58ae52">b4771d76</a></strong>
<div>
<span>by Raymond Toy</span>
<i>at 2015-12-29T16:34:46Z</i>
</div>
<pre class='commit-message'>Add %SET-FLOATING-POINT-MODES and %GET-FLOATING-POINT-MODES functions.
To aid in debugging floating point modes, add two new functions:
o %SET-FLOATING-POINT-MODES is like SET-FLOATING-POINT-MODES but
applies the result to a specified mode value, returning the new mode
value (as an integer). This is useful for investigating different
mode values without modifying the actual hardware mode.
o %GET-FLOATING-POINT-MODES is like GET-FLOATING-POINT-MODES but uses
an integer argument instead of the actual floating-point mode.
Useful when used with %SET-FLOATING-POINT-MODE or on its own.</pre>
</li>
</ul>
<h4>2 changed files:</h4>
<ul>
<li class='file-stats'>
<a href='#diff-0'>
src/code/exports.lisp
</a>
</li>
<li class='file-stats'>
<a href='#diff-1'>
src/code/float-trap.lisp
</a>
</li>
</ul>
<h4>Changes:</h4>
<li id='diff-0'>
<a href='https://gitlab.common-lisp.net/cmucl/cmucl/commit/b4771d761fc122a33e39dfd5546db753fb58ae52#diff-0'>
<strong>
src/code/exports.lisp
</strong>
</a>
<hr>
<pre class="highlight"><code><span style="color: #000000;background-color: #ffdddd">--- a/src/code/exports.lisp
</span><span style="color: #000000;background-color: #ddffdd">+++ b/src/code/exports.lisp
</span><span style="color: #aaaaaa">@@ -1579,7 +1579,10 @@
</span> "DOUBLE-FLOAT-POSITIVE-INFINITY" "LONG-FLOAT-POSITIVE-INFINITY"
"SINGLE-FLOAT-NEGATIVE-INFINITY" "SHORT-FLOAT-NEGATIVE-INFINITY"
"DOUBLE-FLOAT-NEGATIVE-INFINITY" "LONG-FLOAT-NEGATIVE-INFINITY"
<span style="color: #000000;background-color: #ffdddd">- "GET-FLOATING-POINT-MODES" "SET-FLOATING-POINT-MODES"
</span><span style="color: #000000;background-color: #ddffdd">+ "%GET-FLOATING-POINT-MODES"
+ "GET-FLOATING-POINT-MODES"
+ "SET-FLOATING-POINT-MODES"
+ "%SET-FLOATING-POINT-MODES"
</span> "FLOAT-DENORMALIZED-P" "FLOAT-INFINITY-P"
"FLOAT-NAN-P" "FLOAT-TRAPPING-NAN-P"
"FLOAT-SIGNALING-NAN-P"
</code></pre>
<br>
</li>
<li id='diff-1'>
<a href='https://gitlab.common-lisp.net/cmucl/cmucl/commit/b4771d761fc122a33e39dfd5546db753fb58ae52#diff-1'>
<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">@@ -22,7 +22,10 @@
</span> (export '(current-float-trap floating-point-modes sigfpe-handler))
)
(in-package "EXTENSIONS")
<span style="color: #000000;background-color: #ffdddd">-(export '(set-floating-point-modes get-floating-point-modes
</span><span style="color: #000000;background-color: #ddffdd">+(export '(set-floating-point-modes
+ %set-floating-point-modes
+ get-floating-point-modes
+ %get-floating-point-modes
</span> with-float-traps-masked
with-float-traps-enabled))
(in-package "VM")
<span style="color: #aaaaaa">@@ -135,16 +138,18 @@
</span> new-mode)
)
<span style="color: #000000;background-color: #ffdddd">-;;; SET-FLOATING-POINT-MODES -- Public
</span><span style="color: #000000;background-color: #ddffdd">+;;; %SET-FLOATING-POINT-MODES -- Public
</span> ;;;
<span style="color: #000000;background-color: #ffdddd">-(defun set-floating-point-modes (&key (traps nil traps-p)
- (rounding-mode nil round-p)
- (current-exceptions nil current-x-p)
- (accrued-exceptions nil accrued-x-p)
- (fast-mode nil fast-mode-p))
- "This function sets options controlling the floating-point hardware. If a
- keyword is not supplied, then the current value is preserved. Possible
- keywords:
</span><span style="color: #000000;background-color: #ddffdd">+(defun %set-floating-point-modes (&key (floating-point-modes (floating-point-modes))
+ (traps nil traps-p)
+ (rounding-mode nil round-p)
+ (current-exceptions nil current-x-p)
+ (accrued-exceptions nil accrued-x-p)
+ (fast-mode nil fast-mode-p))
+ "Sets floating-point modes according to the give options and the
+ specified mode, Floating-Point-Modes. The resulting new mode is
+ returned. If a keyword is not supplied, then the current value is
+ preserved. Possible keywords:
</span>
:TRAPS
A list of the exception conditions that should cause traps. Possible
<span style="color: #aaaaaa">@@ -169,7 +174,7 @@
</span>
GET-FLOATING-POINT-MODES may be used to find the floating point modes
currently in effect."
<span style="color: #000000;background-color: #ffdddd">- (let ((modes (floating-point-modes)))
</span><span style="color: #000000;background-color: #ddffdd">+ (let ((modes floating-point-modes))
</span> (when traps-p
(let ((trap-mask-bits (float-trap-mask traps)))
(setf (ldb float-traps-byte modes) trap-mask-bits)
<span style="color: #aaaaaa">@@ -215,20 +220,56 @@
</span> (setq modes (logior float-fast-bit modes))
(setq modes (logand (lognot float-fast-bit) modes))))
<span style="color: #000000;background-color: #ffdddd">- (setf (floating-point-modes) modes))
-
</span><span style="color: #000000;background-color: #ddffdd">+ modes))
+
+;;; SET-FLOATING-POINT-MODES -- Public
+;;;
+(defun set-floating-point-modes (&rest args
+ &key traps
+ rounding-mode
+ current-exceptions
+ accrued-exceptions
+ fast-mode)
+ "This function sets options controlling the floating-point hardware. If a
+ keyword is not supplied, then the current value is preserved. Possible
+ keywords:
+
+ :TRAPS
+ A list of the exception conditions that should cause traps. Possible
+ exceptions are :UNDERFLOW, :OVERFLOW, :INEXACT, :INVALID,
+ :DIVIDE-BY-ZERO, and on the X86 :DENORMALIZED-OPERAND. Initially
+ all traps except :INEXACT are enabled.
+
+ :ROUNDING-MODE
+ The rounding mode to use when the result is not exact. Possible values
+ are :NEAREST, :POSITIVE-INFINITY, :NEGATIVE-INFINITY and :ZERO.
+ Initially, the rounding mode is :NEAREST.
+
+ :CURRENT-EXCEPTIONS
+ :ACCRUED-EXCEPTIONS
+ These arguments allow setting of the exception flags. The main use is
+ setting the accrued exceptions to NIL to clear them.
+
+ :FAST-MODE
+ Set the hardware's \"fast mode\" flag, if any. When set, IEEE
+ conformance or debuggability may be impaired. Some machines may not
+ have this feature, in which case the value is always NIL.
+
+ GET-FLOATING-POINT-MODES may be used to find the floating point modes
+ currently in effect."
+ (declare (ignorable traps rounding-mode current-exceptions accrued-exceptions fast-mode))
+
+ (setf (floating-point-modes)
+ (apply #'%set-floating-point-modes args))
</span> (values))
<span style="color: #000000;background-color: #ffdddd">-;;; GET-FLOATING-POINT-MODES -- Public
</span><span style="color: #000000;background-color: #ddffdd">+;;; %GET-FLOATING-POINT-MODES -- Public
</span> ;;;
<span style="color: #000000;background-color: #ffdddd">-(defun get-floating-point-modes ()
</span><span style="color: #000000;background-color: #ddffdd">+(defun %get-floating-point-modes (modes)
</span> "This function returns a list representing the state of the floating point
<span style="color: #000000;background-color: #ffdddd">- modes. The list is in the same format as the keyword arguments to
- SET-FLOATING-POINT-MODES, i.e.
- (apply #'set-floating-point-modes (get-floating-point-modes))
-
- sets the floating point modes to their current values (and thus is a no-op)."
</span><span style="color: #000000;background-color: #ddffdd">+ modes given in Modes. The list is in the same format as the keyword arguments to
+ SET-FLOATING-POINT-MODES."
</span> (flet ((exc-keys (bits)
(macrolet ((frob ()
`(collect ((res))
<span style="color: #aaaaaa">@@ -238,13 +279,23 @@
</span> float-trap-alist)
(res))))
(frob))))
<span style="color: #000000;background-color: #ffdddd">- (let ((modes (floating-point-modes)))
- `(:traps ,(exc-keys (ldb float-traps-byte modes))
- :rounding-mode ,(car (rassoc (ldb float-rounding-mode modes)
- rounding-mode-alist))
- :current-exceptions ,(exc-keys (ldb float-exceptions-byte modes))
- :accrued-exceptions ,(exc-keys (ldb float-sticky-bits modes))
- :fast-mode ,(logtest float-fast-bit modes)))))
</span><span style="color: #000000;background-color: #ddffdd">+ `(:traps ,(exc-keys (ldb float-traps-byte modes))
+ :rounding-mode ,(car (rassoc (ldb float-rounding-mode modes)
+ rounding-mode-alist))
+ :current-exceptions ,(exc-keys (ldb float-exceptions-byte modes))
+ :accrued-exceptions ,(exc-keys (ldb float-sticky-bits modes))
+ :fast-mode ,(logtest float-fast-bit modes))))
+
+;;; GET-FLOATING-POINT-MODES -- Public
+;;;
+(defun get-floating-point-modes ()
+ "This function returns a list representing the state of the floating point
+ modes. The list is in the same format as the keyword arguments to
+ SET-FLOATING-POINT-MODES, i.e.
+ (apply #'set-floating-point-modes (get-floating-point-modes))
+
+ sets the floating point modes to their current values (and thus is a no-op)."
+ (%get-floating-point-modes (floating-point-modes)))
</span>
;;; CURRENT-FLOAT-TRAP -- Interface
</code></pre>
<br>
</li>
</div>
<div class='footer' style='margin-top: 10px;'>
<p>
—
<br>
<a href="https://gitlab.common-lisp.net/cmucl/cmucl/commit/b4771d761fc122a33e39dfd5546db753fb58ae52">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.
<script type="application/ld+json">{"@context":"http://schema.org","@type":"EmailMessage","action":{"@type":"ViewAction","name":"View Commit","url":"https://gitlab.common-lisp.net/cmucl/cmucl/commit/b4771d761fc122a33e39dfd5546db753fb58ae52"}}</script>
</p>
</div>
</body>
</html>