Raymond Toy pushed to branch issue-431-fix-set-floating-point-modes at cmucl / cmucl Commits: e80d2fe4 by Raymond Toy at 2025-08-15T15:15:00-07:00 Add some more tests for set-floating-point-modes - - - - - 1dfdaba2 by Raymond Toy at 2025-08-15T19:17:20-07:00 Rename things and update corresponding uses. We don't need x87-exceptions-byte anymore because it's the same as float-exceptions-byte. Rename the defconstants to include the word "float". Also make the x87 constant names more like the corresponding names in parms.lisp, which are basically for sse2. - - - - - 3f9a71d1 by Raymond Toy at 2025-08-16T07:52:41-07:00 Renamed some x87 FP constants x87-exceptions-mask-byte -> x87-float-traps-byte x87-rounding-control-byte -> x87-float-rounding-mode These new names match the existing float-traps-byte and float-rounding-mode constants that exist in parms.lisp. - - - - - a1adbe86 by Raymond Toy at 2025-08-16T07:54:15-07:00 rename x87-traps-byte to x87-float-traps-byte - - - - - 0ac12cb6 by Raymond Toy at 2025-08-16T07:54:43-07:00 Update pot files for updated docstrings - - - - - 7 changed files: - src/bootfiles/21e/boot-2025-07.lisp - src/code/float-trap.lisp - src/compiler/x86/float-sse2.lisp - src/compiler/x86/parms.lisp - src/i18n/locale/cmucl-sse2.pot - src/i18n/locale/cmucl-x86-vm.pot - tests/float.lisp Changes: ===================================== src/bootfiles/21e/boot-2025-07.lisp ===================================== @@ -2,18 +2,24 @@ (in-package :x86) -(defconstant x87-exceptions-byte - (byte 6 0)) -(defconstant x87-infinity-control-byte - (byte 1 (+ 12 16))) -(defconstant x87-rounding-control-byte - (byte 2 (+ 10 16))) -(defconstant x87-precision-control-byte - (byte 2 (+ 8 16))) -(defconstant x87-exceptions-mask-byte - (byte 6 16)) -(defconstant x87-precision-control-alist +(defconstant x87-float-infinity-control-byte + (byte 1 (+ 12 16)) + "The bit in the x87 FPU control word that controls the infinity mode.") +(defconstant x87-float-rounding-mode + (byte 2 (+ 10 16)) + "The bits in the x87 FPU control word for the rounding mode.") +(defconstant x87-float-precision-control-byte + (byte 2 (+ 8 16)) + "The bits in the x87 FPU contol word for the FP operation precision.") +(defconstant x87-float-traps-byte + (byte 6 16) + "The bits in the x87 FPU control word indicating the exceptions that + are enabled.") +(defconstant x87-float-precision-control-alist `((:24-bits . 0) (:reserved . 1) (:53-bits . 2) - (:64-bits . 3))) + (:64-bits . 3)) + "Alist for the x87 precison control. The car is the symbolic + precision and the cdr is the value for the precision control field.") + ===================================== src/code/float-trap.lisp ===================================== @@ -139,16 +139,15 @@ (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. - (setf x87-modes (dpb new-exceptions x87-exceptions-byte x87-modes)) - (setf x87-modes (dpb new-enables x87-exceptions-mask-byte x87-modes)) - (setf x87-modes (dpb rc x87-rounding-control-byte x87-modes)) + ;; 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)) ;; Set precision to 64-bits (double-extended). (setf x87-modes - (dpb (cdr (assoc :64-bits x87-precision-control-alist)) - x87-precision-control-byte + (dpb (cdr (assoc :64-bits x87-float-precision-control-alist)) + x87-float-precision-control-byte x87-modes)) (setf (vm::sse2-floating-point-modes) (ldb (byte 16 0) new-mode)) ===================================== src/compiler/x86/float-sse2.lisp ===================================== @@ -1379,21 +1379,26 @@ ;; 10 double precision (53 bits) ;; 11 double extended precision (64 bits) -(defconstant x87-exceptions-byte - (byte 6 0)) -(defconstant x87-infinity-control-byte - (byte 1 (+ 12 16))) -(defconstant x87-rounding-control-byte - (byte 2 (+ 10 16))) -(defconstant x87-precision-control-byte - (byte 2 (+ 8 16))) -(defconstant x87-exceptions-mask-byte - (byte 6 16)) -(defconstant x87-precision-control-alist +(defconstant x87-float-infinity-control-byte + (byte 1 (+ 12 16)) + "The bit in the x87 FPU control word that controls the infinity mode.") +(defconstant x87-float-rounding-mode + (byte 2 (+ 10 16)) + "The bits in the x87 FPU control word for the rounding mode.") +(defconstant x87-float-precision-control-byte + (byte 2 (+ 8 16)) + "The bits in the x87 FPU contol word for the FP operation precision.") +(defconstant x87-float-traps-byte + (byte 6 16) + "The bits in the x87 FPU control word indicating the exceptions that + are enabled.") +(defconstant x87-float-precision-control-alist `((:24-bits . 0) (:reserved . 1) (:53-bits . 2) - (:64-bits . 3))) + (:64-bits . 3)) + "Alist for the x87 precison control. The car is the symbolic + precision and the cdr is the value for the precision control field.") (defun print-fp-exceptions-enabled (enabled) (format t "Precision enable: ~30T~A~%" (ldb (byte 1 5) enabled)) @@ -1416,7 +1421,7 @@ ;; 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 "Flush-to-zero: ~30T~A~%" (ldb (byte 1 15) sse-mode)) - (let ((rc (ldb (byte 2 13) sse-mode))) + (let ((rc (ldb float-rounding-mode sse-mode))) (format t "Rounding control: ~30T~A ~A~%" rc (car (rassoc rc rounding-mode-alist)))) @@ -1437,17 +1442,17 @@ (format t "SW: 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 (byte 1 (+ 12 16)) x87-mode)) - (let ((rc (ldb (byte 2 (+ 10 16)) x87-mode))) + (format t "CW: 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~%" rc (car (rassoc rc rounding-mode-alist)))) - (let ((pc (ldb (byte 2 (+ 8 16)) x87-mode))) + (let ((pc (ldb x87-float-precision-control-byte x87-mode))) (format t "CW: Precision control: ~30T~A ~A~%" pc - (car (rassoc pc x87-precision-control-alist)))) + (car (rassoc pc x87-float-precision-control-alist)))) (format t "CW: Reserved: ~30T~A~%" (ldb (byte 2 (+ 6 16)) x87-mode)) - (print-fp-exceptions-enabled (ldb x87-exceptions-mask-byte x87-mode))) + (print-fp-exceptions-enabled (ldb x87-float-traps-byte x87-mode))) (defknown x87-floating-point-modes () float-modes (flushable)) (defknown ((setf x87-floating-point-modes)) (float-modes) ===================================== src/compiler/x86/parms.lisp ===================================== @@ -205,9 +205,15 @@ ;; 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)) +(defconstant float-sticky-bits (byte 6 0) + "The bits in the FP mode that hold the accrued exceptions that have + occurred since the bits were reset.") +(defconstant float-traps-byte (byte 6 7) + "The bits in the FP mode that hold FP exceptions that are enabled.") +(defconstant float-exceptions-byte (byte 6 0) + "The bits in the FP mode that hold the current exception. However + for x86, there aren't separate bits for this, so we use the stick + bits from the accrued exceptions") (progn ;; SSE2 has a flush-to-zero flag, which we use as the fast bit. Some ===================================== src/i18n/locale/cmucl-sse2.pot ===================================== @@ -86,6 +86,30 @@ msgstr "" msgid "inline ftruncate" msgstr "" +#: src/compiler/x86/float-sse2.lisp +msgid "The bit in the x87 FPU control word that controls the infinity mode." +msgstr "" + +#: src/compiler/x86/float-sse2.lisp +msgid "The bits in the x87 FPU control word for the rounding mode." +msgstr "" + +#: src/compiler/x86/float-sse2.lisp +msgid "The bits in the x87 FPU contol word for the FP operation precision." +msgstr "" + +#: src/compiler/x86/float-sse2.lisp +msgid "" +"The bits in the x87 FPU control word indicating the exceptions that\n" +" are enabled." +msgstr "" + +#: src/compiler/x86/float-sse2.lisp +msgid "" +"Alist for the x87 precison control. The car is the symbolic\n" +" precision and the cdr is the value for the precision control field." +msgstr "" + #: src/compiler/x86/float-sse2.lisp msgid "Print SSE2 modes word in a readable fashion." msgstr "" ===================================== src/i18n/locale/cmucl-x86-vm.pot ===================================== @@ -136,6 +136,23 @@ msgstr "" msgid "Maximum number of bits in a positive fixnum" msgstr "" +#: src/compiler/x86/parms.lisp +msgid "" +"The bits in the FP mode that hold the accrued exceptions that have\n" +" occurred since the bits were reset." +msgstr "" + +#: src/compiler/x86/parms.lisp +msgid "The bits in the FP mode that hold FP exceptions that are enabled." +msgstr "" + +#: src/compiler/x86/parms.lisp +msgid "" +"The bits in the FP mode that hold the current exception. However\n" +" for x86, there aren't separate bits for this, so we use the stick\n" +" bits from the accrued exceptions" +msgstr "" + #: src/compiler/x86/vm.lisp msgid "Redefining SC number ~D from ~S to ~S." msgstr "" ===================================== tests/float.lisp ===================================== @@ -343,3 +343,48 @@ (assert-true (typep new-mode 'x86::float-modes)) (assert-equal new-mode (setf (x86::x87-floating-point-modes) new-mode)))) +(define-test set-floating-point-modes + (let ((old-x87-modes (x86::x87-floating-point-modes)) + (old-sse2-modes (x86::sse2-floating-point-modes))) + (unwind-protect + (progn + ;; Set some new traps and rounding mode + (ext:set-floating-point-modes :traps '(:underflow + :overflow + :invalid + :divide-by-zero) + :rounding-mode :zero) + (let* ((x87-modes (x86::x87-floating-point-modes)) + (x87-exceptions-enabled (ldb x86::x87-float-traps-byte x87-modes)) + (x87-rc (ldb x86::x87-float-rounding-mode x87-modes)) + (sse2-modes (x86::sse2-floating-point-modes)) + (sse2-exceptions-enabled (ldb x86::float-traps-byte sse2-modes)) + (sse2-rc (ldb x86::float-rounding-mode sse2-modes))) + (x86::print-x87-fp-modes x87-modes) + ;; Verify that we set the enabled exceptions + ;; correctly. First for sse2, then for x87. + (assert-false (logbitp 5 sse2-exceptions-enabled)) ; precision + (assert-true (logbitp 4 sse2-exceptions-enabled)) ; underflow + (assert-true (logbitp 3 sse2-exceptions-enabled)) ; overflow + (assert-true (logbitp 2 sse2-exceptions-enabled)) ; divide-by-zero + (assert-false (logbitp 1 sse2-exceptions-enabled)) ; denormal + (assert-true (logbitp 0 sse2-exceptions-enabled)) ; invalid + + (assert-false (logbitp 5 x87-exceptions-enabled)) ; precision + (assert-true (logbitp 4 x87-exceptions-enabled)) ; underflow + (assert-true (logbitp 3 x87-exceptions-enabled)) ; overflow + (assert-true (logbitp 2 x87-exceptions-enabled)) ; divide-by-zero + (assert-false (logbitp 1 x87-exceptions-enabled)) ; denormal + (assert-true (logbitp 0 x87-exceptions-enabled)) ; invalid + + ;; Verify the rounding mode is set to zero + (assert-eql :zero (car (rassoc sse2-rc x86::rounding-mode-alist))) + (assert-eql :zero (car (rassoc x87-rc x86::rounding-mode-alist))) + + ;; Verify precision for x87 + (assert-eql :64-bits + (car (rassoc (ldb x86::x87-float-precision-control-byte x87-modes) + x86::x87-float-precision-control-alist))))) + + (setf (x86::x87-floating-point-modes) old-x87-modes) + (setf (x86::sse2-floating-point-modes) old-sse2-modes)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/c370c74e74004ba8d25a099... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/c370c74e74004ba8d25a099... You're receiving this email because of your account on gitlab.common-lisp.net.