| ... |
... |
@@ -632,6 +632,8 @@ |
|
632
|
632
|
accrued exceptions are cleared at the start of the body to support
|
|
633
|
633
|
their testing within, and restored on exit."))
|
|
634
|
634
|
|
|
|
635
|
+;; Solaris/x86 needs to handle the x87 and sse2 mode bits separately
|
|
|
636
|
+;; instead of using a merged from from FLOATING-POINT-MODES.
|
|
635
|
637
|
#+(and solaris x86)
|
|
636
|
638
|
(macrolet
|
|
637
|
639
|
((with-float-traps (name merge-traps docstring)
|
| ... |
... |
@@ -646,22 +648,22 @@ |
|
646
|
648
|
`(progn
|
|
647
|
649
|
(defmacro ,macro-name (traps &body body)
|
|
648
|
650
|
,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-")))
|
|
|
651
|
+ (let ((sse2-trap-mask (dpb (lognot (float-trap-mask traps))
|
|
|
652
|
+ float-traps-byte #xffffffff))
|
|
|
653
|
+ ;; The x87 trap masks are ordered the same as
|
|
|
654
|
+ ;; sse2 trap masks, but are located in a
|
|
|
655
|
+ ;; different part of the word.
|
|
|
656
|
+ (x87-trap-mask (dpb (lognot (ash (float-trap-mask traps) 16))
|
|
|
657
|
+ float-traps-byte #xffffffff))
|
|
|
658
|
+ ;; The exception bits (sticky bits) are located in
|
|
|
659
|
+ ;; the same place for both x87 and sse2 modes so
|
|
|
660
|
+ ;; we can use just one exception mask for both.
|
|
|
661
|
+ (exception-mask (dpb (lognot (vm::float-trap-mask traps))
|
|
|
662
|
+ float-sticky-bits #xffffffff))
|
|
|
663
|
+ (orig-modes-x87 (gensym "ORIG-MODES-X87-"))
|
|
|
664
|
+ (orig-modes-sse2 (gensym "ORIG-MODES-SSE2-")))
|
|
660
|
665
|
`(let ((,orig-modes-x87 (x87-floating-point-modes))
|
|
661
|
666
|
(,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
|
667
|
(unwind-protect
|
|
666
|
668
|
(progn
|
|
667
|
669
|
(setf (x87-floating-point-modes)
|
| ... |
... |
@@ -672,8 +674,6 @@ |
|
672
|
674
|
(ldb (byte 32 0)
|
|
673
|
675
|
(logand (,',merge-traps ,orig-modes-sse2 ,sse2-trap-mask)
|
|
674
|
676
|
,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
|
677
|
,@body)
|
|
678
|
678
|
;; Restore the modes exactly as they were.
|
|
679
|
679
|
(setf (x87-floating-point-modes) ,orig-modes-x87)
|