| ... |
... |
@@ -568,6 +568,7 @@ |
|
568
|
568
|
(alien:sap-alien scp (* unix:sigcontext))
|
|
569
|
569
|
(logandc2 sse2-modes trap-bit)))))))
|
|
570
|
570
|
|
|
|
571
|
+#-(and solaris x86)
|
|
571
|
572
|
(macrolet
|
|
572
|
573
|
((with-float-traps (name merge-traps docstring)
|
|
573
|
574
|
;; Define macros to enable or disable floating-point
|
| ... |
... |
@@ -631,6 +632,71 @@ |
|
631
|
632
|
accrued exceptions are cleared at the start of the body to support
|
|
632
|
633
|
their testing within, and restored on exit."))
|
|
633
|
634
|
|
|
|
635
|
+#+(and solaris x86)
|
|
|
636
|
+(macrolet
|
|
|
637
|
+ ((with-float-traps (name merge-traps docstring)
|
|
|
638
|
+ ;; Define macros to enable or disable floating-point
|
|
|
639
|
+ ;; exceptions. Masked exceptions and enabled exceptions only
|
|
|
640
|
+ ;; differ whether we AND in the bits or OR them, respectively.
|
|
|
641
|
+ ;; MERGE-TRAPS is the logical operation to merge the traps with
|
|
|
642
|
+ ;; the current floating-point mode. Thus, use and MERGE-EXCEPTIONS is the
|
|
|
643
|
+ ;; logical operation to merge the exceptions (sticky bits) with
|
|
|
644
|
+ ;; the current mode.
|
|
|
645
|
+ (let ((macro-name (symbolicate "WITH-FLOAT-TRAPS-" name)))
|
|
|
646
|
+ `(progn
|
|
|
647
|
+ (defmacro ,macro-name (traps &body body)
|
|
|
648
|
+ ,docstring
|
|
|
649
|
+ (let* ((sse2-trap-mask (dpb (lognot (float-trap-mask traps))
|
|
|
650
|
+ float-traps-byte #xffffffff))
|
|
|
651
|
+ ;; The x87 trap masks are ordered the same as
|
|
|
652
|
+ ;; sse2 trap masks, but are located in a
|
|
|
653
|
+ ;; different part of the word.
|
|
|
654
|
+ (x87-trap-mask (dpb (lognot (ash (float-trap-mask traps) 16))
|
|
|
655
|
+ float-traps-byte #xffffffff))
|
|
|
656
|
+ (exception-mask (dpb (lognot (vm::float-trap-mask traps))
|
|
|
657
|
+ float-sticky-bits #xffffffff))
|
|
|
658
|
+ (orig-modes-x87 (gensym "ORIG-MODES-X87-"))
|
|
|
659
|
+ (orig-modes-sse2 (gensym "ORIG-MODES-SSE2-")))
|
|
|
660
|
+ `(let ((,orig-modes-x87 (x87-floating-point-modes))
|
|
|
661
|
+ (,orig-modes-sse2 (sse2-floating-point-modes)))
|
|
|
662
|
+ (format t "In W-F-T:~%")
|
|
|
663
|
+ (format t " orig x87 modes: ~32,'0b~%" ,orig-modes-x87)
|
|
|
664
|
+ (format t " orig sse2 modes: ~32,'0b~%" ,orig-modes-sse2)
|
|
|
665
|
+ (unwind-protect
|
|
|
666
|
+ (progn
|
|
|
667
|
+ (setf (x87-floating-point-modes)
|
|
|
668
|
+ (ldb (byte 32 0)
|
|
|
669
|
+ (logand (,',merge-traps ,orig-modes-x87 ,x87-trap-mask)
|
|
|
670
|
+ ,exception-mask)))
|
|
|
671
|
+ (setf (sse2-floating-point-modes)
|
|
|
672
|
+ (ldb (byte 32 0)
|
|
|
673
|
+ (logand (,',merge-traps ,orig-modes-sse2 ,sse2-trap-mask)
|
|
|
674
|
+ ,exception-mask)))
|
|
|
675
|
+ (format t " masked x87 modes: ~32,'0b~%" (x87-floating-point-modes))
|
|
|
676
|
+ (format t " masked sse2 modes: ~32,'0b~%" (sse2-floating-point-modes))
|
|
|
677
|
+ ,@body)
|
|
|
678
|
+ ;; Restore the modes exactly as they were.
|
|
|
679
|
+ (setf (x87-floating-point-modes) ,orig-modes-x87)
|
|
|
680
|
+ (setf (sse2-floating-point-modes) ,orig-modes-sse2)))))))))
|
|
|
681
|
+
|
|
|
682
|
+ ;; WITH-FLOAT-TRAPS-MASKED -- Public
|
|
|
683
|
+ (with-float-traps masked logand
|
|
|
684
|
+ _N"Execute BODY with the floating point exceptions listed in TRAPS
|
|
|
685
|
+ masked (disabled). TRAPS should be a list of possible exceptions
|
|
|
686
|
+ which includes :UNDERFLOW, :OVERFLOW, :INEXACT, :INVALID and
|
|
|
687
|
+ :DIVIDE-BY-ZERO and on the X86 :DENORMALIZED-OPERAND. The respective
|
|
|
688
|
+ accrued exceptions are cleared at the start of the body to support
|
|
|
689
|
+ their testing within, and restored on exit.")
|
|
|
690
|
+
|
|
|
691
|
+ ;; WITH-FLOAT-TRAPS-ENABLED -- Public
|
|
|
692
|
+ (with-float-traps enabled logorc2
|
|
|
693
|
+ _N"Execute BODY with the floating point exceptions listed in TRAPS
|
|
|
694
|
+ enabled. TRAPS should be a list of possible exceptions which
|
|
|
695
|
+ includes :UNDERFLOW, :OVERFLOW, :INEXACT, :INVALID and
|
|
|
696
|
+ :DIVIDE-BY-ZERO and on the X86 :DENORMALIZED-OPERAND. The respective
|
|
|
697
|
+ accrued exceptions are cleared at the start of the body to support
|
|
|
698
|
+ their testing within, and restored on exit."))
|
|
|
699
|
+
|
|
634
|
700
|
(defmacro with-float-rounding-mode ((rounding-mode) &body body)
|
|
635
|
701
|
_N"Execute BODY with the floating-point rounding mode set to
|
|
636
|
702
|
ROUNDING-MODE. ROUNDING-MODE must be a one:
|