[Git][cmucl/cmucl][master] Add %SET-FLOATING-POINT-MODES and %GET-FLOATING-POINT-MODES functions.
Raymond Toy
rtoy at common-lisp.net
Wed Dec 30 00:34:59 UTC 2015
Raymond Toy pushed to branch master at cmucl / cmucl
Commits:
b4771d76 by Raymond Toy at 2015-12-29T16:34:46Z
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.
- - - - -
2 changed files:
- src/code/exports.lisp
- src/code/float-trap.lisp
Changes:
=====================================
src/code/exports.lisp
=====================================
--- a/src/code/exports.lisp
+++ b/src/code/exports.lisp
@@ -1579,7 +1579,10 @@
"DOUBLE-FLOAT-POSITIVE-INFINITY" "LONG-FLOAT-POSITIVE-INFINITY"
"SINGLE-FLOAT-NEGATIVE-INFINITY" "SHORT-FLOAT-NEGATIVE-INFINITY"
"DOUBLE-FLOAT-NEGATIVE-INFINITY" "LONG-FLOAT-NEGATIVE-INFINITY"
- "GET-FLOATING-POINT-MODES" "SET-FLOATING-POINT-MODES"
+ "%GET-FLOATING-POINT-MODES"
+ "GET-FLOATING-POINT-MODES"
+ "SET-FLOATING-POINT-MODES"
+ "%SET-FLOATING-POINT-MODES"
"FLOAT-DENORMALIZED-P" "FLOAT-INFINITY-P"
"FLOAT-NAN-P" "FLOAT-TRAPPING-NAN-P"
"FLOAT-SIGNALING-NAN-P"
=====================================
src/code/float-trap.lisp
=====================================
--- a/src/code/float-trap.lisp
+++ b/src/code/float-trap.lisp
@@ -22,7 +22,10 @@
(export '(current-float-trap floating-point-modes sigfpe-handler))
)
(in-package "EXTENSIONS")
-(export '(set-floating-point-modes get-floating-point-modes
+(export '(set-floating-point-modes
+ %set-floating-point-modes
+ get-floating-point-modes
+ %get-floating-point-modes
with-float-traps-masked
with-float-traps-enabled))
(in-package "VM")
@@ -135,16 +138,18 @@
new-mode)
)
-;;; SET-FLOATING-POINT-MODES -- Public
+;;; %SET-FLOATING-POINT-MODES -- Public
;;;
-(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:
+(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:
:TRAPS
A list of the exception conditions that should cause traps. Possible
@@ -169,7 +174,7 @@
GET-FLOATING-POINT-MODES may be used to find the floating point modes
currently in effect."
- (let ((modes (floating-point-modes)))
+ (let ((modes floating-point-modes))
(when traps-p
(let ((trap-mask-bits (float-trap-mask traps)))
(setf (ldb float-traps-byte modes) trap-mask-bits)
@@ -215,20 +220,56 @@
(setq modes (logior float-fast-bit modes))
(setq modes (logand (lognot float-fast-bit) modes))))
- (setf (floating-point-modes) modes))
-
+ 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))
(values))
-;;; GET-FLOATING-POINT-MODES -- Public
+;;; %GET-FLOATING-POINT-MODES -- Public
;;;
-(defun get-floating-point-modes ()
+(defun %get-floating-point-modes (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)."
+ modes given in Modes. The list is in the same format as the keyword arguments to
+ SET-FLOATING-POINT-MODES."
(flet ((exc-keys (bits)
(macrolet ((frob ()
`(collect ((res))
@@ -238,13 +279,23 @@
float-trap-alist)
(res))))
(frob))))
- (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)))))
+ `(: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)))
;;; CURRENT-FLOAT-TRAP -- Interface
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/b4771d761fc122a33e39dfd5546db753fb58ae52
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20151230/9a32596b/attachment.html>
More information about the cmucl-cvs
mailing list