[Git][cmucl/cmucl][rtoy-setexception-inexact] Fix bug on sparc and clean up.

[Raymond Toy]

Raymond Toy pushed to branch rtoy-setexception-inexact at cmucl / cmucl


Commits:
38e8ce5c by Raymond Toy at 2015-12-26T09:09:56Z
Fix bug on sparc and clean up.

On sparc and ppc (setf vm:floating-point-modes) takes an
(unsigned-byte 32) arg, so adjust the ldb byte appopriately. 

Clean up code by putting the docstring into the macro.

- - - - -


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
@@ -374,6 +374,7 @@
        (let ((macro-name (symbolicate "WITH-FLOAT-TRAPS-" name)))
 	 `(progn
 	    (defmacro ,macro-name (traps &body body)
+	      ,docstring
 	      (let ((traps (dpb (float-trap-mask traps) float-traps-byte 0))
 		    (exceptions (dpb (float-trap-mask traps) float-sticky-bits 0))
 		    (trap-mask (dpb (lognot (float-trap-mask traps))
@@ -397,7 +398,9 @@
 		   (unwind-protect
 			(progn
 			  (setf (floating-point-modes)
-				(ldb (byte 24 0)
+				(ldb (byte #+x86 24
+					   #-x86 32
+					   0)
 				     (,',logical-op ,orig-modes ,(logand trap-mask exception-mask))))
 			  , at body)
 		     ;; Restore the original traps and exceptions.
@@ -407,25 +410,22 @@
 					   ,(logand trap-mask exception-mask)
 					   #+ppc
 					   ,invalid-mask
-					   #+mips ,(dpb 0 float-exceptions-byte #xffffffff))))))))
-	    ;; Set the docstring appropriately 
-	    (setf (c::info function documentation ',macro-name)
-		  ,docstring)))))
+					   #+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 logand
-	      "Execute BODY with the floating point exceptions listed in TRAPS
-  disabled.  TRAPS should be a list of possible exceptions which
-  includes :UNDERFLOW, :OVERFLOW, :INEXACT, :INVALID and
+    _N"Execute BODY with the floating point exceptions listed in TRAPS
+  masked (disabled).  TRAPS should be a list of possible exceptions
+  which includes :UNDERFLOW, :OVERFLOW, :INEXACT, :INVALID and
   :DIVIDE-BY-ZERO and on the X86 :DENORMALIZED-OPERAND. The respective
   accrued exceptions are cleared at the start of the body to support
   their testing within, and restored on exit.")
+
   (with-float-traps enabled logorc2
-	      "Execute BODY with the floating point exceptions listed in TRAPS
+    _N"Execute BODY with the floating point exceptions listed in TRAPS
   enabled.  TRAPS should be a list of possible exceptions which
   includes :UNDERFLOW, :OVERFLOW, :INEXACT, :INVALID and
   :DIVIDE-BY-ZERO and on the X86 :DENORMALIZED-OPERAND. The respective
   accrued exceptions are cleared at the start of the body to support
   their testing within, and restored on exit."))
-;; Set up the appropriate documentation for these macros
 



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/38e8ce5c1084e1c55f90028829c7491a47909835
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20151226/6a887cce/attachment.html>