diff --git a/bootfiles/19d/boot-2007-11-2.lisp b/bootfiles/19d/boot-2007-11-2.lisp new file mode 100644 index 0000000000000000000000000000000000000000..8bdae1072a3e2b7ea1fc92f42580bb75dc403bc9 --- /dev/null +++ b/bootfiles/19d/boot-2007-11-2.lisp @@ -0,0 +1,8 @@ +(in-package :c) +(handler-bind ((error (lambda (c) + (declare (ignore c)) + (invoke-restart 'kernel::continue)))) + (defconstant policy-parameter-slots + '((speed . cookie-speed) (space . cookie-space) (safety . cookie-safety) + (cspeed . cookie-cspeed) (brevity . cookie-brevity) + (debug . cookie-debug)))) diff --git a/code/env-access.lisp b/code/env-access.lisp index ad9038741a045e1ea2d428b5d92f9bfce5e71366..6370fa1d0ce920a8686a937d5d9a9936c92b79d7 100644 --- a/code/env-access.lisp +++ b/code/env-access.lisp @@ -6,7 +6,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/env-access.lisp,v 1.3 2007/08/17 14:09:20 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/env-access.lisp,v 1.4 2007/11/14 10:04:33 cshapiro Exp $") ;;; ;;; ********************************************************************** @@ -76,8 +76,7 @@ alist of declarations that apply to the apparent binding of VAR." (list 'compilation-speed (cookie-cspeed cookie)) (list 'space (cookie-space cookie)) (list 'debug (cookie-debug cookie)) - (list 'inhibit-warnings (cookie-brevity cookie)) - (list 'float-accuracy (cookie-float-accuracy cookie))) + (list 'inhibit-warnings (cookie-brevity cookie))) )) (ext:optimize-interface (let ((cookie (lexenv-interface-cookie lexenv))) @@ -86,8 +85,7 @@ alist of declarations that apply to the apparent binding of VAR." (list 'compilation-speed (cookie-cspeed cookie)) (list 'space (cookie-space cookie)) (list 'debug (cookie-debug cookie)) - (list 'inhibit-warnings (cookie-brevity cookie)) - (list 'float-accuracy (cookie-float-accuracy cookie))))) + (list 'inhibit-warnings (cookie-brevity cookie))))) (declaration (cond (env ;; What are we supposed to do if an environment is diff --git a/code/float-trap.lisp b/code/float-trap.lisp index a0646e43cfd15944e71d0db85f9dd3b906ef8cae..7d1b5117a9543329238181cbd8b299963a3b2390 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.30 2007/07/06 08:04:39 cshapiro Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/float-trap.lisp,v 1.31 2007/11/14 10:04:33 cshapiro Exp $") ;;; ;;; ********************************************************************** ;;; @@ -48,12 +48,6 @@ (cons :zero float-round-to-zero) (cons :positive-infinity float-round-to-positive) (cons :negative-infinity float-round-to-negative))) - -#+x86 -(defconstant precision-control-alist - (list (cons :24-bit float-precision-24-bit) - (cons :53-bit float-precision-53-bit) - (cons :64-bit float-precision-64-bit))) ); Eval-When (Compile Load Eval) @@ -70,8 +64,7 @@ (rounding-mode nil round-p) (current-exceptions nil current-x-p) (accrued-exceptions nil accrued-x-p) - (fast-mode nil fast-mode-p) - (precision-control nil precision-control-p)) + (fast-mode nil fast-mode-p)) "This function sets options controlling the floating-point hardware. If a keyword is not supplied, then the current value is preserved. Possible keywords: @@ -97,15 +90,8 @@ conformance or debuggability may be impaired. Some machines may not have this feature, in which case the value is always NIL. - :PRECISION-CONTROL - On the x86 architecture, you can set the precision of the arithmetic - to :24-BIT, :53-BIT, or :64-BIT mode, corresponding to IEEE single - precision, double precision, and extended double precision. - GET-FLOATING-POINT-MODES may be used to find the floating point modes currently in effect." - #-x86 - (declare (ignore precision-control)) (let ((modes (floating-point-modes))) (when traps-p (setf (ldb float-traps-byte modes) (float-trap-mask traps))) @@ -132,15 +118,6 @@ (if fast-mode (setq modes (logior float-fast-bit modes)) (setq modes (logand (lognot float-fast-bit) modes)))) - #+x86 - (when precision-control-p - (setf (ldb float-precision-control modes) - (or (cdr (assoc precision-control precision-control-alist)) - (error "Unknown precision mode: ~S." precision-control)))) - #-x86 - (when precision-control-p - (warn "Precision control only available for x86")) - (setf (floating-point-modes) modes)) (values)) @@ -170,13 +147,7 @@ rounding-mode-alist)) :current-exceptions ,(exc-keys (ldb float-exceptions-byte modes)) :accrued-exceptions ,(exc-keys (ldb float-sticky-bits modes)) - :fast-mode ,(logtest float-fast-bit modes) - #+x86 - :precision-control - #+x86 - ,(car (rassoc (ldb float-precision-control modes) - precision-control-alist)) - )))) + :fast-mode ,(logtest float-fast-bit modes))))) ;;; CURRENT-FLOAT-TRAP -- Interface diff --git a/code/lispinit.lisp b/code/lispinit.lisp index 9c96c0de3b0e002a49d7c8cf0f29f4e05997dfb4..b8f5c5fe341fb2bddb5ad173dc438e06b6efd2bb 100644 --- a/code/lispinit.lisp +++ b/code/lispinit.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/lispinit.lisp,v 1.77 2007/10/04 19:58:19 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/lispinit.lisp,v 1.78 2007/11/14 10:04:33 cshapiro Exp $") ;;; ;;; ********************************************************************** ;;; @@ -400,8 +400,7 @@ (print-and-call kernel::signal-init) (setf (alien:extern-alien "internal_errors_enabled" boolean) t) - (set-floating-point-modes :traps '(:overflow :invalid :divide-by-zero) - #+x86 :precision-control #+x86 :53-bit) + (set-floating-point-modes :traps '(:overflow :invalid :divide-by-zero)) ;; This is necessary because some of the initial top level forms might ;; have changed the compilation policy in strange ways. (print-and-call c::proclaim-init) diff --git a/code/unix-glibc2.lisp b/code/unix-glibc2.lisp index 539ca9b85ddc78f2329c9e4067a2a8a86e16e5d6..1fc55a86ce49e98195e6a6b285e13fd2f49d62ab 100644 --- a/code/unix-glibc2.lisp +++ b/code/unix-glibc2.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/unix-glibc2.lisp,v 1.41 2007/11/09 19:24:36 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unix-glibc2.lisp,v 1.42 2007/11/14 10:04:33 cshapiro Exp $") ;;; ;;; ********************************************************************** ;;; @@ -350,26 +350,22 @@ (format nil "Unknown error [~d]" error-number))) (defmacro syscall ((name &rest arg-types) success-form &rest args) - `(locally - (declare (optimize (ext::float-accuracy 0))) - (let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types)) - ,@args))) - (if (minusp result) - (values nil (unix-errno)) - ,success-form)))) + `(let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types)) + ,@args))) + (if (minusp result) + (values nil (unix-errno)) + ,success-form))) ;;; Like syscall, but if it fails, signal an error instead of returning error ;;; codes. Should only be used for syscalls that will never really get an ;;; error. ;;; (defmacro syscall* ((name &rest arg-types) success-form &rest args) - `(locally - (declare (optimize (ext::float-accuracy 0))) - (let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types)) - ,@args))) - (if (minusp result) - (error "Syscall ~A failed: ~A" ,name (get-unix-error-msg)) - ,success-form)))) + `(let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types)) + ,@args))) + (if (minusp result) + (error "Syscall ~A failed: ~A" ,name (get-unix-error-msg)) + ,success-form))) (defmacro void-syscall ((name &rest arg-types) &rest args) `(syscall (,name ,@arg-types) (values t 0) ,@args)) diff --git a/compiler/macros.lisp b/compiler/macros.lisp index 7e30ef8035256cb13373c87f20cd41d0d2632199..9b99006ffdc4696329c85271ddfbe9211bf886f0 100644 --- a/compiler/macros.lisp +++ b/compiler/macros.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/compiler/macros.lisp,v 1.55 2005/08/04 16:00:04 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/macros.lisp,v 1.56 2007/11/14 10:04:34 cshapiro Rel $") ;;; ;;; ********************************************************************** ;;; @@ -52,7 +52,7 @@ (defconstant policy-parameter-slots '((speed . cookie-speed) (space . cookie-space) (safety . cookie-safety) (cspeed . cookie-cspeed) (brevity . cookie-brevity) - (debug . cookie-debug) (float-accuracy . cookie-float-accuracy))) + (debug . cookie-debug))) ;;; Find-Used-Parameters -- Internal ;;; diff --git a/compiler/proclaim.lisp b/compiler/proclaim.lisp index 6d8746d3a02ba36c683aaa614671c1156c3d517e..b32ae70d08a914c4b7dd4a9dfd25665aa8bb618d 100644 --- a/compiler/proclaim.lisp +++ b/compiler/proclaim.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/compiler/proclaim.lisp,v 1.43 2005/10/21 17:56:07 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/proclaim.lisp,v 1.44 2007/11/14 10:04:35 cshapiro Rel $") ;;; ;;; ********************************************************************** ;;; @@ -18,8 +18,7 @@ (in-package "C") (in-package "EXTENSIONS") -(export '(inhibit-warnings freeze-type optimize-interface constant-function - float-accuracy)) +(export '(inhibit-warnings freeze-type optimize-interface constant-function)) (in-package "KERNEL") (export '(note-name-defined define-function-name undefine-function-name *type-system-initialized* %note-type-defined)) @@ -42,16 +41,7 @@ (safety nil :type (or (rational 0 3) null)) (cspeed nil :type (or (rational 0 3) null)) (brevity nil :type (or (rational 0 3) null)) - (debug nil :type (or (rational 0 3) null)) - ;; float-accuracy is intended for x86 FPU. It has no effect on - ;; other architectures. float-accuracy controls the rounding-mode. - ;; A value of 3 means that when calling out to C, we set the x86 FPU - ;; rounding mode to 64-bits. Otherwise the rounding-mode is left - ;; unchanged. By setting the rounding-mode to 53-bit, - ;; double-float-epsilon really is double-float-epsilon. However - ;; calling out to C with 53-bit mode affects the accuracy of - ;; floating-point functions, which normally want 64-bit. - (float-accuracy 3 :type (or (rational 0 3) null))) + (debug nil :type (or (rational 0 3) null))) ;;; The *default-cookie* represents the current global compiler policy @@ -73,8 +63,7 @@ (defun proclaim-init () (setf *default-cookie* (make-cookie :safety 1 :speed 1 :space 1 :cspeed 1 - :brevity 1 :debug 2 - :float-accuracy 3)) + :brevity 1 :debug 2)) (setf *default-interface-cookie* (make-cookie))) ;;; @@ -313,7 +302,6 @@ (compilation-speed (setf (cookie-cspeed res) value)) ((inhibit-warnings brevity) (setf (cookie-brevity res) value)) ((debug-info debug) (setf (cookie-debug res) value)) - (float-accuracy (setf (cookie-float-accuracy res) value)) (t (compiler-warning "Unknown optimization quality ~S in ~S." (car quality) spec)))) diff --git a/compiler/x86/c-call.lisp b/compiler/x86/c-call.lisp index e2338f17ab36441b56892bbb4dcce1dec6163af0..33ec7d6fac9e81d06ad6abad3d9f33ba6df67f83 100644 --- a/compiler/x86/c-call.lisp +++ b/compiler/x86/c-call.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/c-call.lisp,v 1.18 2007/10/04 19:58:20 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/c-call.lisp,v 1.19 2007/11/14 10:04:35 cshapiro Exp $") ;;; ;;; ********************************************************************** ;;; @@ -262,61 +262,33 @@ (:node-var node) (:generator 0 (assert (location= result esp-tn)) - ;; Set the rounding precision to 64-bits when calling out to C. - (when (policy node (= float-accuracy 3)) + #+(or darwin linux) + (progn (inst sub esp-tn 4) (inst fnstcw (make-ea :word :base esp-tn)) - (inst wait) + (inst and (make-ea :word :base esp-tn) #xcff) (inst or (make-ea :word :base esp-tn) #x300) (inst fldcw (make-ea :word :base esp-tn)) - (inst wait)) + (inst add esp-tn 4)) (unless (zerop amount) (let ((delta (logandc2 (+ amount 3) 3))) (inst sub esp-tn delta))) #+darwin (inst and esp-tn #xfffffff0) (move result esp-tn))) -#+nil -(define-vop (dealloc-number-stack-space) - (:info amount) - (:node-var node) - (:generator 0 - (unless (zerop amount) - (let ((delta (logandc2 (+ amount 3) 3))) - (inst add esp-tn delta))) - ;; Reset the rounding precision to 53-bits - (when (policy node (= float-accuracy 3)) - (inst fnstcw (make-ea :word :base esp-tn)) - (inst wait) - (inst and (make-ea :word :base esp-tn) #xfeff) - (inst fldcw (make-ea :word :base esp-tn)) - (inst wait) - (inst add esp-tn 4)))) - (define-vop (dealloc-number-stack-space) (:info amount) (:node-var node) - (:temporary (:sc unsigned-reg) precision) - (:temporary (:sc word-reg) cw) (:generator 0 (unless (zerop amount) (let ((delta (logandc2 (+ amount 3) 3))) (inst add esp-tn delta))) - ;; Reset the rounding precision to 53-bits - (when (policy node (= float-accuracy 3)) + #+(or darwin linux) + (progn + (inst sub esp-tn 4) (inst fnstcw (make-ea :word :base esp-tn)) - (load-symbol-value precision *fpu-precision*) - (inst sar precision 2) ; Remove fixnum tag bits - (inst wait) - ;; Clear the precision bits so we can fill them in with our - ;; desired precision value. - (inst mov cw (make-ea :word :base esp-tn)) - (inst and cw #xfcff) - (inst or cw - (make-random-tn :kind :normal - :sc (sc-or-lose 'word-reg *backend*) - :offset (tn-offset precision))) - (inst mov (make-ea :word :base esp-tn) cw) + (inst and (make-ea :word :base esp-tn) #xcff) + (inst or (make-ea :word :base esp-tn) #x200) (inst fldcw (make-ea :word :base esp-tn)) (inst wait) (inst add esp-tn 4)))) diff --git a/compiler/x86/float.lisp b/compiler/x86/float.lisp index 511453b64570deef9519b59acade730fd0d227d2..f60efca2e59c09cfc654ba1a2e3dcc101f999e06 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.50 2007/10/04 19:58:20 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float.lisp,v 1.51 2007/11/14 10:04:35 cshapiro Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2267,37 +2267,27 @@ ;;;; Float mode hackery: -(deftype float-modes () '(unsigned-byte 32)) ; really only 16 +(deftype float-modes () '(unsigned-byte 24)) (defknown floating-point-modes () float-modes (flushable)) (defknown ((setf floating-point-modes)) (float-modes) float-modes) -(defconstant npx-env-size (* 7 vm:word-bytes)) -(defconstant npx-cw-offset 0) -(defconstant npx-sw-offset 4) - -(defvar *fpu-precision* - (dpb float-precision-53-bit float-precision-control 0)) - (define-vop (floating-point-modes) (:results (res :scs (unsigned-reg))) (:result-types unsigned-num) (:translate floating-point-modes) (:policy :fast-safe) - (:temporary (:sc unsigned-reg :offset eax-offset :target res - :to :result) eax) + (:temporary (:sc unsigned-stack) cw-stack) + (:temporary (:sc unsigned-reg :offset eax-offset) sw-reg) (:generator 8 - (inst sub esp-tn npx-env-size) ; make space on stack - (inst wait) ; Catch any pending FPE exceptions - (inst fstenv (make-ea :dword :base esp-tn)) ; masks all exceptions - (inst fldenv (make-ea :dword :base esp-tn)) ; restore previous state - ;; Current status to high word - (inst mov eax (make-ea :dword :base esp-tn :disp (- npx-sw-offset 2))) - ;; Exception mask to low word - (inst mov ax-tn (make-ea :word :base esp-tn :disp npx-cw-offset)) - (inst add esp-tn npx-env-size) ; Pop stack - (inst xor eax #x3f) ; Flip exception mask to trap enable bits - (move res eax))) + (inst fnstsw) + (inst fnstcw cw-stack) + (inst and sw-reg #xff) ; mask exception flags + (inst shl sw-reg 16) + (inst byte #x66) ; operand size prefix + (inst or sw-reg cw-stack) + (inst xor sw-reg #x3f) ; invert exception mask + (move res sw-reg))) (define-vop (set-floating-point-modes) (:args (new :scs (unsigned-reg) :to :result :target res)) @@ -2306,25 +2296,24 @@ (:result-types unsigned-num) (:translate (setf floating-point-modes)) (:policy :fast-safe) - (:temporary (:sc unsigned-reg :offset eax-offset - :from :eval :to :result) eax) - (:generator 3 - (inst sub esp-tn npx-env-size) ; make space on stack - (inst wait) ; Catch any pending FPE exceptions + (:temporary (:sc unsigned-stack) cw-stack) + (:temporary (:sc byte-reg :offset al-offset) sw-reg) + (:temporary (:sc unsigned-reg :offset ecx-offset) old) + (:generator 6 + (inst mov cw-stack new) + (inst xor cw-stack #x3f) ; invert exception mask + (inst fnstsw) + (inst fldcw cw-stack) ; always update the control word + (inst mov old new) + (inst shr old 16) + (inst cmp cl-tn sw-reg) ; compare exception flags + (inst jmp :z DONE) ; skip updating the status word + (inst sub esp-tn 28) (inst fstenv (make-ea :dword :base esp-tn)) - (inst mov eax new) - ;; Save precision bits so we can restore them properly - (inst and eax #x300) - (inst shl eax 2) ; Convert to fixnum - (store-symbol-value eax *fpu-precision*) - ;; Now set the desired mode - (inst mov eax new) - (inst xor eax #x3f) ; turn trap enable bits into exception mask - (inst mov (make-ea :word :base esp-tn :disp npx-cw-offset) ax-tn) - (inst shr eax 16) ; position status word - (inst mov (make-ea :word :base esp-tn :disp npx-sw-offset) ax-tn) + (inst mov (make-ea :byte :base esp-tn :disp 4) cl-tn) (inst fldenv (make-ea :dword :base esp-tn)) - (inst add esp-tn npx-env-size) ; Pop stack + (inst add esp-tn 28) + DONE (move res new))) diff --git a/compiler/x86/parms.lisp b/compiler/x86/parms.lisp index 27448d4137aab93cf453ae61b2eb29ca6ff79c55..a6f63a5acbe50326bff4ae20b33c8330a115cb7e 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.33 2007/10/04 19:58:20 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/parms.lisp,v 1.34 2007/11/14 10:04:35 cshapiro Exp $") ;;; ;;; ********************************************************************** ;;; @@ -162,15 +162,10 @@ (defconstant float-round-to-positive 2) (defconstant float-round-to-zero 3) -(defconstant float-precision-24-bit 0) -(defconstant float-precision-53-bit 2) -(defconstant float-precision-64-bit 3) - (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-precision-control (byte 2 8)) (defconstant float-fast-bit 0) ; No fast mode on x86 ); eval-when @@ -333,7 +328,6 @@ :key-and-value :key-or-value - *fpu-precision* ;; Spare symbols. Rename these when you need to add some static ;; symbols and don't want to do a cross-compile. spare-8