Raymond Toy pushed to branch master at cmucl / cmucl Commits: 56f2d8fd by Raymond Toy at 2024-09-09T20:36:09+00:00 Fix #356: Put x87 status word in low 16 bits of mode word - - - - - c8020846 by Raymond Toy at 2024-09-09T20:36:12+00:00 Merge branch 'issue-356-x87-status-word-in-low-part' into 'master' Fix #356: Put x87 status word in low 16 bits of mode word Closes #356 See merge request cmucl/cmucl!255 - - - - - 2 changed files: - src/code/float-trap.lisp - src/compiler/x86/float-sse2.lisp Changes: ===================================== src/code/float-trap.lisp ===================================== @@ -102,9 +102,11 @@ ;; FPU and only use the SSE2 rounding control bits. (let* ((x87-modes (vm::x87-floating-point-modes)) (sse-modes (vm::sse2-floating-point-modes)) + (x87-exceptions (logand #x3f x87-modes)) + (x87-enables (logand #x3f (ash x87-modes -16))) (final-mode (logior sse-modes - (ash (logand #x3f x87-modes) 7) ; control - (logand #x3f (ash x87-modes -16))))) + x87-exceptions + (ash x87-enables 7)))) final-mode)) (defun (setf floating-point-modes) (new-mode) @@ -112,15 +114,17 @@ ;; Set the floating point modes for both X87 and SSE2. This ;; include the rounding control bits. (let* ((rc (ldb float-rounding-mode new-mode)) + (new-exceptions (logand #x3f new-mode)) + (new-enables (logand #x3f (ash new-mode -7))) (x87-modes - (logior (ash (logand #x3f new-mode) 16) + (logior new-exceptions (ash rc 10) - (logand #x3f (ash new-mode -7)) + (ash new-enables 16) ;; Set precision control to be 64-bit, always. We ;; don't use the x87 registers with sse2, so this ;; is ok and would be the correct setting if we ;; ever support long-floats. - (ash 3 8)))) + (ash 3 (+ 8 16))))) (setf (vm::sse2-floating-point-modes) (ldb (byte 24 0) new-mode)) (setf (vm::x87-floating-point-modes) (ldb (byte 24 0) x87-modes))) new-mode) ===================================== src/compiler/x86/float-sse2.lisp ===================================== @@ -1380,7 +1380,7 @@ float-modes) ;; Extract the control and status words from the FPU. The low 16 bits -;; contain the control word, and the high 16 bits contain the status. +;; contain the status word, and the high 16 bits contain the control. (define-vop (x87-floating-point-modes) (:results (res :scs (unsigned-reg))) (:result-types unsigned-num) @@ -1396,12 +1396,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))) + (move res sw-reg) + ;; Put status word in the low 16 bits and the control word in the + ;; high 16 bits. This is to match the SSE2 mxcsr register that has + ;; the status bits (sticky bits) in lowest part of the word. + (inst rol res 16))) ;; Set the control and status words from the FPU. The low 16 bits -;; contain the control word, and the high 16 bits contain the status. +;; contain the status word, and the high 16 bits contain the control. (define-vop (x87-set-floating-point-modes) - (:args (new :scs (unsigned-reg) :to :result :target res)) + (:args (new-modes :scs (unsigned-reg) :to :result :target res)) (:results (res :scs (unsigned-reg))) (:arg-types unsigned-num) (:result-types unsigned-num) @@ -1410,7 +1414,12 @@ (:temporary (:sc unsigned-stack) cw-stack) (:temporary (:sc byte-reg :offset al-offset) sw-reg) (:temporary (:sc unsigned-reg :offset ecx-offset) old) + (:temporary (:sc unsigned-reg) new) (:generator 6 + (move new new-modes) + ;; Put the status word in the high 16 bits and the control word in + ;; the low 16 bits. + (inst rol new 16) (inst mov cw-stack new) (inst xor cw-stack #x3f) ; invert exception mask (inst fnstsw) @@ -1425,7 +1434,7 @@ (inst fldenv (make-ea :dword :base esp-tn)) (inst add esp-tn 28) DONE - (move res new))) + (move res new-modes))) (defun sse2-floating-point-modes () View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/bca25992c5fc536391f39f7... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/bca25992c5fc536391f39f7... You're receiving this email because of your account on gitlab.common-lisp.net.