diff --git a/bootfiles/19e/boot-2009-01-1.lisp b/bootfiles/19e/boot-2009-01-1.lisp new file mode 100644 index 0000000000000000000000000000000000000000..157e7a2bbaa768cc8ce72531129f28921432156d --- /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 fb6db445014f6c44efd4e6cffdada34512b6bfc7..186184323b58468e4eedf631c3a6fa69d595c9f2 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 8826b5fb7e10d1af492abd54ca7c4807448f3e43..d1830d0a90917da0fa3a8c58b34db71e3104f05b 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 60d98114b98373fb682afef705a9a384b4e01548..b0e00b3b1352c5a23db0d04994cfdc0877c659b4 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 54b4b9f55e02fc6881b6f8dcf353e2db7c007ad2..66ad41f8cb1ac339bc573f8fa7d1901c0b6cb2f2 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 a7f4b30067ec24e25ece374d9614abdd3409f006..66a5766673b3d8b572134abe0a08795ca984c05f 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 7e21d7a748cb2bc9dc9a17e3bc0b0b24590dfd3b..22b9f11639e5262f72a3a150e05e123e32a90aec 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