[Git][cmucl/cmucl][rtoy-setexception-inexact] Clean up with-float-traps macro.

[Raymond Toy]

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))))
 			  , at 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/90b9651bf60a59800f76a6e7fede76a4897dfae5
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20151228/51d8ad08/attachment.html>