Raymond Toy pushed to branch rtoy-setexception-inexact at cmucl / cmucl
Commits: 90b9651b by Raymond Toy at 2015-12-27T21:02:14Z Clean up with-float-traps macro.
* Add some comments. * Change x86 (setf floating-point-modes) to accept (unsigned-byte 32). * Remove unneeded x86 conditionalization on the byte size.
- - - - -
1 changed file:
- src/code/float-trap.lisp
Changes:
===================================== src/code/float-trap.lisp ===================================== --- a/src/code/float-trap.lisp +++ b/src/code/float-trap.lisp @@ -104,7 +104,7 @@
final-mode)) (defun (setf floating-point-modes) (new-mode) - (declare (type (unsigned-byte 24) new-mode)) + (declare (type (unsigned-byte 32) new-mode)) ;; Set the floating point modes for both X87 and SSE2. This ;; include the rounding control bits. (let* ((rc (ldb float-rounding-mode new-mode)) @@ -117,8 +117,8 @@ ;; is ok and would be the correct setting if we ;; ever support long-floats. (ash 3 8)))) - (setf (vm::sse2-floating-point-modes) new-mode) - (setf (vm::x87-floating-point-modes) x87-modes)) + (setf (vm::sse2-floating-point-modes) (ldb (byte 24 0) new-mode)) + (setf (vm::x87-floating-point-modes) (ldb (byte 24 0) x87-modes))) new-mode) )
@@ -365,12 +365,12 @@ (error _"SIGFPE with no exceptions currently enabled? (si-code = ~D)" code)))))))
-;;; WITH-FLOAT-TRAPS-MASKED -- Public -;;; WITH-FLOAT-TRAPS-ENABLED -- Public - - (macrolet ((with-float-traps (name logical-op docstring) + ;; Define macros to enable or disable floating-point + ;; exceptions. Masked exceptions and enabled exceptions only + ;; differ whether we AND in the bits or OR them, respectively. + ;; Logical-op is the operation to use. (let ((macro-name (symbolicate "WITH-FLOAT-TRAPS-" name))) `(progn (defmacro ,macro-name (traps &body body) @@ -398,9 +398,7 @@ (unwind-protect (progn (setf (floating-point-modes) - (ldb (byte #+x86 24 - #-x86 32 - 0) + (ldb (byte 32 0) (,',logical-op ,orig-modes ,(logand trap-mask exception-mask)))) ,@body) ;; Restore the original traps and exceptions. @@ -411,8 +409,8 @@ #+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 -- Public (with-float-traps masked logand _N"Execute BODY with the floating point exceptions listed in TRAPS masked (disabled). TRAPS should be a list of possible exceptions @@ -421,6 +419,7 @@ accrued exceptions are cleared at the start of the body to support their testing within, and restored on exit.")
+ ;; WITH-FLOAT-TRAPS-ENABLED -- Public (with-float-traps enabled logorc2 _N"Execute BODY with the floating point exceptions listed in TRAPS enabled. TRAPS should be a list of possible exceptions which
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/90b9651bf60a59800f76a6e7fe...