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/b4771d761fc122a33e39dfd554...