| ... |
... |
@@ -454,7 +454,22 @@ |
|
454
|
454
|
(defconstant +fpe-fltsub+ 8
|
|
455
|
455
|
"Signal code for subscript out of range")
|
|
456
|
456
|
(defconstant +fpe-fltden+ 9
|
|
457
|
|
- "Signal code for FP denormalize"))
|
|
|
457
|
+ "Signal code for FP denormalize")
|
|
|
458
|
+ (defconstant +fpe-code-info-alist+
|
|
|
459
|
+ (list (cons +fpe-fltdiv+
|
|
|
460
|
+ (list 'division-by-zero float-divide-by-zero-trap-bit ))
|
|
|
461
|
+ (cons +fpe-fltovf+
|
|
|
462
|
+ (list 'floating-point-overflow float-overflow-trap-bit))
|
|
|
463
|
+ (cons +fpe-fltund+
|
|
|
464
|
+ (list 'floating-point-underflow float-underflow-trap-bit))
|
|
|
465
|
+ (cons +fpe-fltres+
|
|
|
466
|
+ (list 'floating-point-inexact float-inexact-trap-bit))
|
|
|
467
|
+ (cons +fpe-fltinv+
|
|
|
468
|
+ (list 'floating-point-invalid-operation float-invalid-trap-bit))
|
|
|
469
|
+ (cons +fpe-fltden+
|
|
|
470
|
+ (list 'floating-point-denormal-operand float-denormal-trap-bit)))
|
|
|
471
|
+ "Alist mapping the FPE code to a list of the corresponding floating
|
|
|
472
|
+ point error type and the correstrap bit value"))
|
|
458
|
473
|
|
|
459
|
474
|
#+(and solaris x86)
|
|
460
|
475
|
(defun sigfpe-handler (signal code scp)
|
| ... |
... |
@@ -473,40 +488,36 @@ |
|
473
|
488
|
;; from the signal handler so the sigcontext is never restored.
|
|
474
|
489
|
;; This means we need to restore the fpu state ourselves.
|
|
475
|
490
|
(unwind-protect
|
|
476
|
|
- (cond
|
|
477
|
|
- ((= code +fpe-fltdiv+)
|
|
478
|
|
- (error 'division-by-zero
|
|
479
|
|
- :operation fop
|
|
480
|
|
- :operands operands))
|
|
481
|
|
- ((= code +fpe-fltovf+)
|
|
482
|
|
- (error 'floating-point-overflow
|
|
483
|
|
- :operation fop
|
|
484
|
|
- :operands operands))
|
|
485
|
|
- ((= code +fpe-fltund+)
|
|
486
|
|
- (error 'floating-point-underflow
|
|
487
|
|
- :operation fop
|
|
488
|
|
- :operands operands))
|
|
489
|
|
- ((= code +fpe-fltres+)
|
|
490
|
|
- (error 'floating-point-inexact
|
|
491
|
|
- :operation fop
|
|
492
|
|
- :operands operands))
|
|
493
|
|
- ((= code +fpe-fltinv+)
|
|
494
|
|
- (error 'floating-point-invalid-operation
|
|
495
|
|
- :operation fop
|
|
496
|
|
- :operands operands))
|
|
497
|
|
- ((= code +fpe-fltden+)
|
|
498
|
|
- (error 'floating-point-denormal-operand
|
|
499
|
|
- :operation fop
|
|
500
|
|
- :operands operands))
|
|
501
|
|
- (t
|
|
502
|
|
- (error _"SIGFPE code ~D not handled" code)))
|
|
|
491
|
+ (let ((fpe-info (second (assoc code +fpe-code-info-alist+))))
|
|
|
492
|
+ (if fpe-info
|
|
|
493
|
+ (error fpe-info
|
|
|
494
|
+ :operation fop
|
|
|
495
|
+ :operands operands)
|
|
|
496
|
+ (error _"SIGFPE code ~D not handled" code)))
|
|
503
|
497
|
;; Cleanup
|
|
504
|
|
- (let* ((traps (logand (ldb float-exceptions-byte modes)
|
|
505
|
|
- (ldb float-traps-byte modes)))
|
|
506
|
|
- (new-modes modes)
|
|
507
|
|
- (new-exceptions (logandc2 (ldb float-exceptions-byte new-modes)
|
|
508
|
|
- traps)))
|
|
509
|
|
- #+sse2
|
|
|
498
|
+ (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)))
|
|
|
501
|
+ (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
|
|
510
|
521
|
(progn
|
|
511
|
522
|
;; Clear out the status for any enabled traps. With SSE2, if
|
|
512
|
523
|
;; the current exception is enabled, the next FP instruction
|