Skip to content
Snippets Groups Projects
Commit a94b4291 authored by rtoy's avatar rtoy
Browse files

Floating-point fixes for ppc.

code/float-trap.lisp:
o Set FP modes now.
o Clear out sticky bits in SIGFPE handler

code/ppc-vm.lisp:
o Add (setf sigcontext-floating-point-modes) to set the FP mode.

compiler/ppc/parms.lisp:
o Add fields for various invalid operations bits.
o Fix float-fast-bit
parent 79a39dbc
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.26 2005/11/09 18:26:25 rtoy Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/float-trap.lisp,v 1.27 2006/11/14 02:41:25 rtoy Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -132,8 +132,6 @@ ...@@ -132,8 +132,6 @@
(when precision-control-p (when precision-control-p
(warn "Precision control only available for x86")) (warn "Precision control only available for x86"))
;; Temporarily disabled on darwin due to strange breakage
#-darwin
(setf (floating-point-modes) modes)) (setf (floating-point-modes) modes))
(values)) (values))
...@@ -240,6 +238,23 @@ ...@@ -240,6 +238,23 @@
(alien:sap-alien scp (* unix:sigcontext)))) (alien:sap-alien scp (* unix:sigcontext))))
(traps (logand (ldb float-exceptions-byte modes) (traps (logand (ldb float-exceptions-byte modes)
(ldb float-traps-byte modes)))) (ldb float-traps-byte modes))))
#+darwin
(let ((new-modes modes))
;; Clear out all exceptions and save them to the context.
;;
;; XXX: Should we just clear out the bits for the traps that are
;; enabled? If we did that then the accrued exceptions would be
;; correct.
(setf (ldb float-sticky-bits new-modes) 0)
;; Clear out the various sticky invalid operation bits too.
;;
;; XXX: Should we only do that if the invalid trap is enabled?
(setf (ldb float-invalid-op-1-byte new-modes) 0)
(setf (ldb float-invalid-op-2-byte new-modes) 0)
(setf (floating-point-modes) new-modes)
(setf (sigcontext-floating-point-modes
(alien:sap-alien scp (* unix:sigcontext)))
new-modes))
(multiple-value-bind (fop operands) (multiple-value-bind (fop operands)
(let ((sym (find-symbol "GET-FP-OPERANDS" "VM"))) (let ((sym (find-symbol "GET-FP-OPERANDS" "VM")))
(if (fboundp sym) (if (fboundp sym)
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/ppc-vm.lisp,v 1.6 2006/01/18 15:21:26 rtoy Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/ppc-vm.lisp,v 1.7 2006/11/14 02:41:25 rtoy Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -278,6 +278,13 @@ ...@@ -278,6 +278,13 @@
(with-alien ((scp (* sigcontext) scp)) (with-alien ((scp (* sigcontext) scp))
(slot (slot scp 'sc-regs) 'fpscr))) (slot (slot scp 'sc-regs) 'fpscr)))
(defun %set-sigcontext-floating-point-modes (scp new-value)
(declare (type (alien (* sigcontext)) scp))
(with-alien ((scp (* sigcontext) scp))
(setf (slot (slot scp 'sc-regs) 'fpscr) new-value)))
(defsetf sigcontext-floating-point-modes %set-sigcontext-floating-point-modes)
;;; EXTERN-ALIEN-NAME -- interface. ;;; EXTERN-ALIEN-NAME -- interface.
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/parms.lisp,v 1.14 2006/11/02 01:53:17 rtoy Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/parms.lisp,v 1.15 2006/11/14 02:41:25 rtoy Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -120,12 +120,19 @@ ...@@ -120,12 +120,19 @@
(defconstant float-round-to-positive 2) (defconstant float-round-to-positive 2)
(defconstant float-round-to-negative 3) (defconstant float-round-to-negative 3)
(defconstant float-rounding-mode (byte 2 0)) ; RD (defconstant float-rounding-mode (byte 2 0)) ; RD
;; Accrued exceptions.
(defconstant float-sticky-bits (byte 5 25)) (defconstant float-sticky-bits (byte 5 25))
(defconstant float-traps-byte (byte 5 3)) ; ;; Exception enable
(defconstant float-exceptions-byte (byte 5 25)) ; cexc (defconstant float-traps-byte (byte 5 3))
;; Current exceptions. It seems that PPC doesn't actually have a
(defconstant float-fast-bit 2) ; Non-IEEE mode ;; separate field for current exceptions, so we make this the same as
;; the (sticky) accrued exceptions.
(defconstant float-exceptions-byte (byte 5 25))
;; Various sticky invalid operation bits
(defconstant float-invalid-op-1-byte (byte 6 19))
(defconstant float-invalid-op-2-byte (byte 3 8))
(defconstant float-fast-bit (ash 1 2)) ; Non-IEEE mode
); eval-when ); eval-when
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment