Skip to content
Snippets Groups Projects
Commit 220f2b78 authored by gerd's avatar gerd
Browse files

(/ 1 0.0) not signaling a divide-by-zero on FreeBSD.

	* src/code/float-trap.lisp (FPE_*) [freebsd4]: Define constants
	from machine/trap.h.
	(sigfpe-handler) [freebsd4]: Use the code parameter to determine
	the reason for the signal.
parent c957a57b
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (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 @@ ...@@ -183,7 +183,7 @@
;;; Signal the appropriate condition when we get a floating-point error. ;;; Signal the appropriate condition when we get a floating-point error.
;;; ;;;
#+BSD #+(and bsd (not freebsd))
(define-condition floating-point-exception (arithmetic-error) (define-condition floating-point-exception (arithmetic-error)
((flags :initarg :traps ((flags :initarg :traps
:reader floating-point-exception-traps)) :reader floating-point-exception-traps))
...@@ -199,8 +199,38 @@ ...@@ -199,8 +199,38 @@
"No traps are enabled? How can this be?" "No traps are enabled? How can this be?"
stream)))))) 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) (defun sigfpe-handler (signal code scp)
(declare (ignore signal code) (declare (ignore signal)
(type system-area-pointer scp)) (type system-area-pointer scp))
(let* ((modes (sigcontext-floating-point-modes (let* ((modes (sigcontext-floating-point-modes
(alien:sap-alien scp (* unix:sigcontext)))) (alien:sap-alien scp (* unix:sigcontext))))
......
...@@ -146,6 +146,7 @@ New in this release: ...@@ -146,6 +146,7 @@ New in this release:
- FIXNUM no longer naming a function. - FIXNUM no longer naming a function.
- MAKE-STRING-OUTPUT-STREAM accepts :ELEMENT-TYPE. - MAKE-STRING-OUTPUT-STREAM accepts :ELEMENT-TYPE.
- Numerous LOOP fixes. - Numerous LOOP fixes.
- On FreeBSD, CLtS-required floating-point conditions are signaled.
* Numerous bugfixes: * Numerous bugfixes:
- NSET-EXCLUSIVE-OR returns the same results as SET-EXCLUSIVE-OR - NSET-EXCLUSIVE-OR returns the same results as SET-EXCLUSIVE-OR
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment