Raymond Toy pushed to branch issue-431-fix-set-floating-point-modes at cmucl / cmucl Commits: ef367c52 by Raymond Toy at 2025-08-17T07:14:14-07:00 More cleanups Remove old comment and debugging prints. Wrap comments neatly. Clean up printing of the mode word for x87. - - - - - 2 changed files: - src/code/float-trap.lisp - src/compiler/x86/float-sse2.lisp Changes: ===================================== src/code/float-trap.lisp ===================================== @@ -109,37 +109,17 @@ (ash x87-enables 7)))) final-mode)) - #+nil - (defun (setf floating-point-modes) (new-mode) - (declare (type (unsigned-byte 32) new-mode)) - ;; 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 new-exceptions - (ash rc 10) - (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 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) + (defun (setf floating-point-modes) (new-mode) (declare (type (unsigned-byte 32) new-mode)) ;; Set the floating point modes for both X87 and SSE2. This ;; include the rounding control bits. - #+nil - (format t "new-mode = ~8,'0x~%" new-mode) (let* ((rc (ldb float-rounding-mode new-mode)) (new-exceptions (ldb float-exceptions-byte new-mode)) (new-enables (ldb float-traps-byte new-mode)) (x87-modes 0)) - ;; From the new mode, update the x87 FPU mode with the same set of accrued exceptions, enabled exceptions, and rounding mode. + ;; From the new mode, update the x87 FPU mode with the same set + ;; of accrued exceptions, enabled exceptions, and rounding mode. (setf x87-modes (dpb new-exceptions float-exceptions-byte x87-modes)) (setf x87-modes (dpb new-enables x87-float-traps-byte x87-modes)) (setf x87-modes (dpb rc x87-float-rounding-mode x87-modes)) @@ -152,8 +132,7 @@ (setf (vm::sse2-floating-point-modes) (ldb (byte 16 0) new-mode)) (setf (vm::x87-floating-point-modes) (ldb (byte 30 0) x87-modes))) - new-mode) - ) + new-mode)) #+(and sse2 darwin) (progn ===================================== src/compiler/x86/float-sse2.lisp ===================================== @@ -1422,7 +1422,7 @@ ;; the rest of cmucl, these bits are represented as enable bits. (format t "Flush-to-zero: ~30T~A~%" (ldb (byte 1 15) sse-mode)) (let ((rc (ldb float-rounding-mode sse-mode))) - (format t "Rounding control: ~30T~A ~A~%" + (format t "Rounding control: ~30T#b~2,'0b ~S~%" rc (car (rassoc rc rounding-mode-alist)))) (print-fp-exceptions-enabled (ldb float-traps-byte sse-mode)) @@ -1432,26 +1432,28 @@ "Print X87 floating modes word in a readable fashion." ;; Note that Intel uses masks to disable the exception, but to match ;; the rest of cmucl, these bits are represented as enable bits. - (format t "SW: FPU busy: ~30T~A~%" (ldb (byte 1 15) x87-mode)) - (format t "SW: Condition code C3: ~30T~A~%" (ldb (byte 1 14) x87-mode)) - (format t "SW: Top of stack: ~30T~D~%" (ldb (byte 3 11) x87-mode)) - (format t "SW: Condition code C2: ~30T~A~%" (ldb (byte 1 10) x87-mode)) - (format t "SW: Condition code C1: ~30T~A~%" (ldb (byte 1 9) x87-mode)) - (format t "SW: Condition code C0: ~30T~A~%" (ldb (byte 1 8) x87-mode)) - (format t "SW: Error summary: ~30T~A~%" (ldb (byte 1 7) x87-mode)) - (format t "SW: Stack fault: ~30T~A~%" (ldb (byte 1 6) x87-mode)) + (format t "Status word:~%") + (format t "FPU busy: ~30T~A~%" (ldb (byte 1 15) x87-mode)) + (format t "Condition code C3: ~30T~A~%" (ldb (byte 1 14) x87-mode)) + (format t "Top of stack: ~30T~D~%" (ldb (byte 3 11) x87-mode)) + (format t "Condition code C2: ~30T~A~%" (ldb (byte 1 10) x87-mode)) + (format t "Condition code C1: ~30T~A~%" (ldb (byte 1 9) x87-mode)) + (format t "Condition code C0: ~30T~A~%" (ldb (byte 1 8) x87-mode)) + (format t "Error summary: ~30T~A~%" (ldb (byte 1 7) x87-mode)) + (format t "Stack fault: ~30T~A~%" (ldb (byte 1 6) x87-mode)) (print-fp-current-exceptions (ldb float-exceptions-byte x87-mode)) - (format t "CW: Reserved: ~30T~A~%" (ldb (byte 2 (+ 13 16)) x87-mode)) - (format t "CW: Infinity control: ~30T~A~%" (ldb x87-float-infinity-control-byte x87-mode)) + (format t "~%Control word:~%") + (format t "Reserved: ~30T#b~2,'0b~%" (ldb (byte 2 (+ 13 16)) x87-mode)) + (format t "Infinity control: ~30T~A~%" (ldb x87-float-infinity-control-byte x87-mode)) (let ((rc (ldb x87-float-rounding-mode x87-mode))) - (format t "CW: Rounding control: ~30T~A ~A~%" + (format t "Rounding control: ~30T#b~2,'0b ~S~%" rc (car (rassoc rc rounding-mode-alist)))) (let ((pc (ldb x87-float-precision-control-byte x87-mode))) - (format t "CW: Precision control: ~30T~A ~A~%" + (format t "Precision control: ~30T#b~2,'0b ~S~%" pc (car (rassoc pc x87-float-precision-control-alist)))) - (format t "CW: Reserved: ~30T~A~%" (ldb (byte 2 (+ 6 16)) x87-mode)) + (format t "Reserved: ~30T#b~2,'0b~%" (ldb (byte 2 (+ 6 16)) x87-mode)) (print-fp-exceptions-enabled (ldb x87-float-traps-byte x87-mode))) (defknown x87-floating-point-modes () float-modes (flushable)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ef367c524ca6e359970c5fe3... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ef367c524ca6e359970c5fe3... You're receiving this email because of your account on gitlab.common-lisp.net.