From 9edd3c4ba6c05ac5e0560a9861adbf34b86026bb Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Mon, 5 Jan 2009 22:26:27 +0000 Subject: [PATCH] Fix for handling arithmetic errors with x87. Use bootstrap-2009-01-1.lisp to bootstrap this change. code/float-trap.lisp: o FLOATING-POINT-MODES for :X87 needs to massage the results into the expected format (SSE2 MXCSR order). o Update for changed VOP names too. compiler/x86/float.lisp: o Rename the floating-point-modes and set-floating-point-modes VOPS to x87-floating-point-modes and set-x87-floating-point-modes. Change the translations accordingly too. compiler/x86/parms.lisp: o The float property bytes have been updated to match the SSE2 MXCSR register for both SSE2 and X87 builds because the code assumes SSE2 format. lisp/Linux-os.c: o Don't OR in the SSE2 modes if we're not running an SSE2 build. Doing this can erroneously mask out exceptions because the Lisp code didn't set up the sse2 modes. (This happens if you select the x87 core on a chip that supports sse2.) lisp/globals.h: o Declare fpu_mode. lisp/lisp.c: o Set fpu_mode to be the mode determined from the core file. Needed in Linux-os.c to process the SSE2 modes correctly with an x87 core on a sse2-capable chip. --- bootfiles/19e/boot-2009-01-1.lisp | 16 ++++++++++++++++ code/float-trap.lisp | 25 +++++++++++++++++++++++-- compiler/x86/float.lisp | 14 +++++++------- compiler/x86/parms.lisp | 19 +++++++++---------- lisp/Linux-os.c | 6 +++--- lisp/globals.h | 4 +++- lisp/lisp.c | 3 ++- 7 files changed, 63 insertions(+), 24 deletions(-) create mode 100644 bootfiles/19e/boot-2009-01-1.lisp diff --git a/bootfiles/19e/boot-2009-01-1.lisp b/bootfiles/19e/boot-2009-01-1.lisp new file mode 100644 index 000000000..157e7a2bb --- /dev/null +++ b/bootfiles/19e/boot-2009-01-1.lisp @@ -0,0 +1,16 @@ +;; Bootstrap for x86 to change the location of the floating-point +;; fields. The fields must now match the definitions for the SSE2 +;; MXCSR register, even for x87. +;; +;; (Really only needed if we're not compiling for sse2.) +(in-package "VM") + +#+(and x86 (not sse2)) +(handler-bind ((error (lambda (c) + (declare (ignore c)) + (invoke-restart 'continue)))) + (defconstant float-rounding-mode (byte 2 13)) + (defconstant float-sticky-bits (byte 6 0)) + (defconstant float-traps-byte (byte 6 7)) + (defconstant float-exceptions-byte (byte 6 0)) + ) diff --git a/code/float-trap.lisp b/code/float-trap.lisp index fb6db4450..186184323 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.33 2008/11/12 15:04:23 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/float-trap.lisp,v 1.34 2009/01/05 22:26:26 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -54,12 +54,32 @@ ;;; Interpreter stubs. ;;; -#-sse2 +#+(not x86) (progn (defun floating-point-modes () (floating-point-modes)) (defun (setf floating-point-modes) (new) (setf (floating-point-modes) new)) ) +#+(and x86 (not sse2)) +(progn + (defun floating-point-modes () + (let ((x87-modes (vm::x87-floating-point-modes))) + ;; Massage the bits from x87-floating-point-modes into the order + ;; that the rest of the system wants them to be. (Must match + ;; format in the SSE2 mxcsr register.) + (logior (ash (logand #x3f x87-modes) 7) ; control + (logand #x3f (ash x87-modes -16))))) + (defun (setf floating-point-modes) (new) + (let* ((rc (ldb float-rounding-mode new)) + (x87-modes + (logior (ash (logand #x3f new) 16) + (ash rc 10) + (logand #x3f (ash new -7)) + ;; Set precision control to be 64-bit, always. + (ash 3 8)))) + (setf (x87-floating-point-modes) x87-modes))) + ) + #+sse2 (progn (defun floating-point-modes () @@ -221,6 +241,7 @@ (setf (sigcontext-floating-point-modes (alien:sap-alien scp (* unix:sigcontext))) new-modes)) + #+sse2 (let* ((new-modes modes) (new-exceptions (logandc2 (ldb float-exceptions-byte new-modes) diff --git a/compiler/x86/float.lisp b/compiler/x86/float.lisp index 8826b5fb7..d1830d0a9 100644 --- a/compiler/x86/float.lisp +++ b/compiler/x86/float.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float.lisp,v 1.57 2008/11/12 15:04:23 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float.lisp,v 1.58 2009/01/05 22:26:26 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -2394,14 +2394,14 @@ ;;;; Float mode hackery: (deftype float-modes () '(unsigned-byte 24)) -(defknown floating-point-modes () float-modes (flushable)) -(defknown ((setf floating-point-modes)) (float-modes) +(defknown x87-floating-point-modes () float-modes (flushable)) +(defknown ((setf x87-floating-point-modes)) (float-modes) float-modes) -(define-vop (floating-point-modes) +(define-vop (x87-floating-point-modes) (:results (res :scs (unsigned-reg))) (:result-types unsigned-num) - (:translate floating-point-modes) + (:translate x87-floating-point-modes) (:policy :fast-safe) (:temporary (:sc unsigned-stack) cw-stack) (:temporary (:sc unsigned-reg :offset eax-offset) sw-reg) @@ -2415,12 +2415,12 @@ (inst xor sw-reg #x3f) ; invert exception mask (move res sw-reg))) -(define-vop (set-floating-point-modes) +(define-vop (set-x87-floating-point-modes) (:args (new :scs (unsigned-reg) :to :result :target res)) (:results (res :scs (unsigned-reg))) (:arg-types unsigned-num) (:result-types unsigned-num) - (:translate (setf floating-point-modes)) + (:translate (setf x87-floating-point-modes)) (:policy :fast-safe) (:temporary (:sc unsigned-stack) cw-stack) (:temporary (:sc byte-reg :offset al-offset) sw-reg) diff --git a/compiler/x86/parms.lisp b/compiler/x86/parms.lisp index 60d98114b..b0e00b3b1 100644 --- a/compiler/x86/parms.lisp +++ b/compiler/x86/parms.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/parms.lisp,v 1.35 2008/11/12 15:04:23 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/parms.lisp,v 1.36 2009/01/05 22:26:27 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -163,22 +163,21 @@ (defconstant float-round-to-positive 2) (defconstant float-round-to-zero 3) +;; NOTE: These actually match the SSE2 MXCSR register definitions. We +;; need to do it this way because the interface assumes the modes are +;; in the same order as the MXCSR register. +(defconstant float-rounding-mode (byte 2 13)) +(defconstant float-sticky-bits (byte 6 0)) +(defconstant float-traps-byte (byte 6 7)) +(defconstant float-exceptions-byte (byte 6 0)) + #-sse2 (progn -(defconstant float-rounding-mode (byte 2 10)) -(defconstant float-sticky-bits (byte 6 16)) -(defconstant float-traps-byte (byte 6 0)) -(defconstant float-exceptions-byte (byte 6 16)) (defconstant float-fast-bit 0) ; No fast mode on x86 ) #+sse2 (progn -;; These contants match the format of the MXCSR register -(defconstant float-rounding-mode (byte 2 13)) -(defconstant float-sticky-bits (byte 6 0)) -(defconstant float-traps-byte (byte 6 7)) -(defconstant float-exceptions-byte (byte 6 0)) ;; SSE2 has a flush-to-zero flag, which we use as the fast bit. Some ;; versions of sse2 also have a denormals-are-zeros flag. We don't ;; currently use denormals-are-zeroes for anything. diff --git a/lisp/Linux-os.c b/lisp/Linux-os.c index 54b4b9f55..66ad41f8c 100644 --- a/lisp/Linux-os.c +++ b/lisp/Linux-os.c @@ -15,7 +15,7 @@ * GENCGC support by Douglas Crosher, 1996, 1997. * Alpha support by Julian Dolby, 1999. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Linux-os.c,v 1.41 2008/12/10 02:39:13 rtoy Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Linux-os.c,v 1.42 2009/01/05 22:26:27 rtoy Exp $ * */ @@ -129,9 +129,9 @@ os_sigcontext_fpu_modes(ucontext_t *scp) #ifdef FEATURE_SSE2 /* - * Add in the SSE2 part + * Add in the SSE2 part, if we're running the sse core. */ - if (arch_support_sse2()) { + if (fpu_mode == SSE2) { struct _fpstate *fpstate; unsigned long mxcsr; diff --git a/lisp/globals.h b/lisp/globals.h index a7f4b3006..66a576667 100644 --- a/lisp/globals.h +++ b/lisp/globals.h @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/globals.h,v 1.10 2005/09/15 18:26:51 rtoy Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/globals.h,v 1.11 2009/01/05 22:26:27 rtoy Rel $ */ #ifndef _GLOBALS_H_ #define _GLOBALS_H_ @@ -9,6 +9,8 @@ extern int foreign_function_call_active; +extern fpu_mode_t fpu_mode; + extern lispobj *current_control_stack_pointer; extern lispobj *current_control_frame_pointer; diff --git a/lisp/lisp.c b/lisp/lisp.c index 7e21d7a74..22b9f1163 100644 --- a/lisp/lisp.c +++ b/lisp/lisp.c @@ -1,7 +1,7 @@ /* * main() entry point for a stand alone lisp image. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/lisp.c,v 1.65 2008/12/22 02:59:59 rtoy Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/lisp.c,v 1.66 2009/01/05 22:26:27 rtoy Exp $ * */ @@ -707,6 +707,7 @@ main(int argc, char *argv[], char *envp[]) fprintf(stderr, "Core uses SSE2, but CPU doesn't support SSE2. Exiting\n"); exit(1); } + fpu_mode = fpu_type; #endif #if defined LINKAGE_TABLE -- GitLab