diff --git a/code/float-trap.lisp b/code/float-trap.lisp index 53e501aad9ea35ff6ab5a5e68fb14655c843933e..199a8d2dd7b261fb39c0b334cad702e39ae9aabb 100644 --- a/code/float-trap.lisp +++ b/code/float-trap.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/float-trap.lisp,v 1.22 2003/06/18 09:23:11 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/float-trap.lisp,v 1.23 2003/09/02 13:51:46 gerd Exp $") ;;; ;;; ********************************************************************** ;;; @@ -183,7 +183,7 @@ ;;; Signal the appropriate condition when we get a floating-point error. ;;; -#+BSD +#+(and bsd (not freebsd)) (define-condition floating-point-exception (arithmetic-error) ((flags :initarg :traps :reader floating-point-exception-traps)) @@ -199,8 +199,38 @@ "No traps are enabled? How can this be?" stream)))))) +#+freebsd +(progn +(defconstant FPE_INTOVF 1) ; integer overflow +(defconstant FPE_INTDIV 2) ; integer divide by zero +(defconstant FPE_FLTDIV 3) ; floating point divide by zero +(defconstant FPE_FLTOVF 4) ; floating point overflow +(defconstant FPE_FLTUND 5) ; floating point underflow +(defconstant FPE_FLTRES 6) ; floating point inexact result +(defconstant FPE_FLTINV 7) ; invalid floating point operation +(defconstant FPE_FLTSUB 8) ; subscript out of range +) + +#+freebsd +(defun sigfpe-handler (signal code scp) + (declare (ignore signal)) + (let ((condition + (ecase code + ((#.FPE_INTDIV #.FPE_FLTDIV) 'division-by-zero) + ((#.FPE_FLTINV #.FPE_FLTSUB) 'floating-point-invalid-operation) + ((#.FPE_FLTOVF #.FPE_INTOVF) 'floating-point-overflow) + (#.FPE_FLTUND 'floating-point-underflow) + (#.FPE_FLTRES 'floating-point-inexact))) + fop operands + (sym (find-symbol "GET-FP-OPERANDS" "VM"))) + (when (and sym (fboundp sym)) + (multiple-value-setq (fop operands) + (funcall sym (alien:sap-alien scp (* unix:sigcontext))))) + (error condition :operation fop :operands operands))) + +#-freebsd (defun sigfpe-handler (signal code scp) - (declare (ignore signal code) + (declare (ignore signal) (type system-area-pointer scp)) (let* ((modes (sigcontext-floating-point-modes (alien:sap-alien scp (* unix:sigcontext)))) diff --git a/general-info/release-19a.txt b/general-info/release-19a.txt index cf668485be3bd613250fe42b234b57c170391d78..41a872f72a7a88181ade68ab8ccb5d8d9cd38e09 100644 --- a/general-info/release-19a.txt +++ b/general-info/release-19a.txt @@ -146,6 +146,7 @@ New in this release: - FIXNUM no longer naming a function. - MAKE-STRING-OUTPUT-STREAM accepts :ELEMENT-TYPE. - Numerous LOOP fixes. + - On FreeBSD, CLtS-required floating-point conditions are signaled. * Numerous bugfixes: - NSET-EXCLUSIVE-OR returns the same results as SET-EXCLUSIVE-OR