| ... |
... |
@@ -450,11 +450,15 @@ |
|
450
|
450
|
"Signal code for FP inexact result")
|
|
451
|
451
|
(defconstant +fpe-fltinv+ 7
|
|
452
|
452
|
"Signal code for FP invalid operation")
|
|
453
|
|
- ;; Not sure what this means.
|
|
|
453
|
+ ;; On FreeBSD (and maybe other OSes), this happens when the x86
|
|
|
454
|
+ ;; BOUND instruction detects an index out of bounds. Linux
|
|
|
455
|
+ ;; apparently generates a SIGSEGV instead. See
|
|
|
456
|
+ ;; https://stackoverflow.com/questions/27051428/what-is-a-fpe-fltsub-subscript-out-of-range-signal
|
|
454
|
457
|
(defconstant +fpe-fltsub+ 8
|
|
455
|
458
|
"Signal code for subscript out of range")
|
|
456
|
459
|
(defconstant +fpe-fltden+ 9
|
|
457
|
460
|
"Signal code for FP denormalize")
|
|
|
461
|
+ ;; We only include the values that FP operations can trap on.
|
|
458
|
462
|
(defconstant +fpe-code-info-alist+
|
|
459
|
463
|
(list (cons +fpe-fltdiv+
|
|
460
|
464
|
(list 'division-by-zero float-divide-by-zero-trap-bit ))
|
| ... |
... |
@@ -489,50 +493,39 @@ |
|
489
|
493
|
;; This means we need to restore the fpu state ourselves.
|
|
490
|
494
|
(unwind-protect
|
|
491
|
495
|
(let ((fpe-info (second (assoc code +fpe-code-info-alist+))))
|
|
|
496
|
+ (format t "fpe code = ~D~%" code)
|
|
492
|
497
|
(if fpe-info
|
|
493
|
498
|
(error fpe-info
|
|
494
|
499
|
:operation fop
|
|
495
|
500
|
:operands operands)
|
|
496
|
501
|
(error _"SIGFPE code ~D not handled" code)))
|
|
497
|
502
|
;; Cleanup
|
|
|
503
|
+ ;;
|
|
|
504
|
+ ;; Clear out the status for any enabled traps. If we don't
|
|
|
505
|
+ ;; then when we return, the exception gets signaled again.
|
|
498
|
506
|
(let* ((trap-bit (third (assoc code +fpe-code-info-alist+)))
|
|
499
|
|
- (new-x87-modes (vm::x87-floating-point-modes))
|
|
500
|
|
- (new-sse2-modes (vm::sse2-floating-point-modes)))
|
|
|
507
|
+ (current-x87-modes (vm::x87-floating-point-modes))
|
|
|
508
|
+ (current-sse2-modes (vm::sse2-floating-point-modes))
|
|
|
509
|
+ (new-x87-modes
|
|
|
510
|
+ (dpb (logandc2 (ldb float-exceptions-byte current-sse2-modes)
|
|
|
511
|
+ trap-bit)
|
|
|
512
|
+ float-exceptions-byte current-sse2-modes))
|
|
|
513
|
+ (new-sse2-modes
|
|
|
514
|
+ (dpb (logandc2 (ldb float-exceptions-byte current-x87-modes)
|
|
|
515
|
+ trap-bit)
|
|
|
516
|
+ float-exceptions-byte current-x87-modes)))
|
|
501
|
517
|
(format t "Trap bit: ~D~%" trap-bit)
|
|
502
|
|
- (format t "Current modes: ~16,'0b~%" (vm::floating-point-modes))
|
|
503
|
|
- (format t "Current x87 modes: ~16,'0b~%" new-x87-modes)
|
|
504
|
|
- (format t "Current sse2 modes: ~16,'0b~%" new-sse2-modes)
|
|
505
|
|
- (format t "Setting sse2 modes to: ~16,'0b~%"
|
|
506
|
|
- (logandc2 (ldb float-exceptions-byte new-sse2-modes)
|
|
507
|
|
- trap-bit))
|
|
508
|
|
- (setf (vm::sse2-floating-point-modes)
|
|
509
|
|
- (logandc2 (ldb float-exceptions-byte new-sse2-modes)
|
|
510
|
|
- trap-bit))
|
|
511
|
|
- (format t "Setting x87 modes to: ~16,'0b~%"
|
|
512
|
|
- (logandc2 (ldb float-exceptions-byte new-x87-modes)
|
|
513
|
|
- trap-bit))
|
|
514
|
|
- (setf (vm::x87-floating-point-modes)
|
|
515
|
|
- (logandc2 (ldb float-exceptions-byte new-x87-modes)
|
|
516
|
|
- trap-bit))
|
|
517
|
|
-
|
|
518
|
|
- (format t "new x87 modes: ~16,'0b~%" (vm::x87-floating-point-modes))
|
|
519
|
|
- (format t "new sse2 modes: ~16,'0b~%" (vm::sse2-floating-point-modes))
|
|
520
|
|
- #+nil
|
|
521
|
|
- (progn
|
|
522
|
|
- ;; Clear out the status for any enabled traps. With SSE2, if
|
|
523
|
|
- ;; the current exception is enabled, the next FP instruction
|
|
524
|
|
- ;; will cause the exception to be signaled again. Hence, we
|
|
525
|
|
- ;; need to clear out the exceptions that we are handling here.
|
|
526
|
|
- (setf (ldb float-exceptions-byte new-modes) new-exceptions)
|
|
527
|
|
- ;;#+nil
|
|
528
|
|
- (progn
|
|
529
|
|
- (format *debug-io* "sigcontext modes: #x~4x (~A)~%"
|
|
530
|
|
- modes (decode-floating-point-modes modes))
|
|
531
|
|
- (format *debug-io* "current modes: #x~4x (~A)~%"
|
|
532
|
|
- (vm:floating-point-modes) (get-floating-point-modes))
|
|
533
|
|
- (format *debug-io* "new modes: #x~x (~A)~%"
|
|
534
|
|
- new-modes (decode-floating-point-modes new-modes)))
|
|
535
|
|
- (setf (vm:floating-point-modes) new-modes)))))))
|
|
|
518
|
+ (format t "Current modes: ~32,'0b~%" (vm::floating-point-modes))
|
|
|
519
|
+ (format t "Current x87 modes: ~32,'0b~%" current-x87-modes)
|
|
|
520
|
+ (format t "Current sse2 modes: ~32,'0b~%" current-sse2-modes)
|
|
|
521
|
+ (format t "Setting sse2 modes to: ~32,'0b~%" new-x87-modes)
|
|
|
522
|
+ (format t "Setting x87 modes to: ~32,'0b~%" new-sse2-modes)
|
|
|
523
|
+ (ignore-errors
|
|
|
524
|
+ (setf (vm::sse2-floating-point-modes) new-sse2-modes)
|
|
|
525
|
+ (setf (vm::x87-floating-point-modes) new-x87-modes))
|
|
|
526
|
+
|
|
|
527
|
+ (format t "new x87 modes: ~32,'0b~%" (vm::x87-floating-point-modes))
|
|
|
528
|
+ (format t "new sse2 modes: ~32,'0b~%" (vm::sse2-floating-point-modes)))))))
|
|
536
|
529
|
|
|
537
|
530
|
(macrolet
|
|
538
|
531
|
((with-float-traps (name merge-traps docstring)
|