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
-
1dfdaba2
by Raymond Toy at 2025-08-15T19:17:20-07:00
-
3f9a71d1
by Raymond Toy at 2025-08-16T07:52:41-07:00
-
a1adbe86
by Raymond Toy at 2025-08-16T07:54:15-07:00
-
0ac12cb6
by Raymond Toy at 2025-08-16T07:54:43-07:00
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:
| ... | ... | @@ -2,18 +2,24 @@ |
| 2 | 2 | |
| 3 | 3 | (in-package :x86)
|
| 4 | 4 | |
| 5 | -(defconstant x87-exceptions-byte
|
|
| 6 | - (byte 6 0))
|
|
| 7 | -(defconstant x87-infinity-control-byte
|
|
| 8 | - (byte 1 (+ 12 16)))
|
|
| 9 | -(defconstant x87-rounding-control-byte
|
|
| 10 | - (byte 2 (+ 10 16)))
|
|
| 11 | -(defconstant x87-precision-control-byte
|
|
| 12 | - (byte 2 (+ 8 16)))
|
|
| 13 | -(defconstant x87-exceptions-mask-byte
|
|
| 14 | - (byte 6 16))
|
|
| 15 | -(defconstant x87-precision-control-alist
|
|
| 5 | +(defconstant x87-float-infinity-control-byte
|
|
| 6 | + (byte 1 (+ 12 16))
|
|
| 7 | + "The bit in the x87 FPU control word that controls the infinity mode.")
|
|
| 8 | +(defconstant x87-float-rounding-mode
|
|
| 9 | + (byte 2 (+ 10 16))
|
|
| 10 | + "The bits in the x87 FPU control word for the rounding mode.")
|
|
| 11 | +(defconstant x87-float-precision-control-byte
|
|
| 12 | + (byte 2 (+ 8 16))
|
|
| 13 | + "The bits in the x87 FPU contol word for the FP operation precision.")
|
|
| 14 | +(defconstant x87-float-traps-byte
|
|
| 15 | + (byte 6 16)
|
|
| 16 | + "The bits in the x87 FPU control word indicating the exceptions that
|
|
| 17 | + are enabled.")
|
|
| 18 | +(defconstant x87-float-precision-control-alist
|
|
| 16 | 19 | `((:24-bits . 0)
|
| 17 | 20 | (:reserved . 1)
|
| 18 | 21 | (:53-bits . 2)
|
| 19 | - (:64-bits . 3))) |
|
| 22 | + (:64-bits . 3))
|
|
| 23 | + "Alist for the x87 precison control. The car is the symbolic
|
|
| 24 | + precision and the cdr is the value for the precision control field.")
|
|
| 25 | + |
| ... | ... | @@ -139,16 +139,15 @@ |
| 139 | 139 | (new-exceptions (ldb float-exceptions-byte new-mode))
|
| 140 | 140 | (new-enables (ldb float-traps-byte new-mode))
|
| 141 | 141 | (x87-modes 0))
|
| 142 | - ;; From the new mode, update the x87 FPU mode with the same set
|
|
| 143 | - ;; of accrued exceptions, enabled exceptions, and rounding mode.
|
|
| 144 | - (setf x87-modes (dpb new-exceptions x87-exceptions-byte x87-modes))
|
|
| 145 | - (setf x87-modes (dpb new-enables x87-exceptions-mask-byte x87-modes))
|
|
| 146 | - (setf x87-modes (dpb rc x87-rounding-control-byte x87-modes))
|
|
| 142 | + ;; From the new mode, update the x87 FPU mode with the same set of accrued exceptions, enabled exceptions, and rounding mode.
|
|
| 143 | + (setf x87-modes (dpb new-exceptions float-exceptions-byte x87-modes))
|
|
| 144 | + (setf x87-modes (dpb new-enables x87-float-traps-byte x87-modes))
|
|
| 145 | + (setf x87-modes (dpb rc x87-float-rounding-mode x87-modes))
|
|
| 147 | 146 | |
| 148 | 147 | ;; Set precision to 64-bits (double-extended).
|
| 149 | 148 | (setf x87-modes
|
| 150 | - (dpb (cdr (assoc :64-bits x87-precision-control-alist))
|
|
| 151 | - x87-precision-control-byte
|
|
| 149 | + (dpb (cdr (assoc :64-bits x87-float-precision-control-alist))
|
|
| 150 | + x87-float-precision-control-byte
|
|
| 152 | 151 | x87-modes))
|
| 153 | 152 | |
| 154 | 153 | (setf (vm::sse2-floating-point-modes) (ldb (byte 16 0) new-mode))
|
| ... | ... | @@ -1379,21 +1379,26 @@ |
| 1379 | 1379 | ;; 10 double precision (53 bits)
|
| 1380 | 1380 | ;; 11 double extended precision (64 bits)
|
| 1381 | 1381 | |
| 1382 | -(defconstant x87-exceptions-byte
|
|
| 1383 | - (byte 6 0))
|
|
| 1384 | -(defconstant x87-infinity-control-byte
|
|
| 1385 | - (byte 1 (+ 12 16)))
|
|
| 1386 | -(defconstant x87-rounding-control-byte
|
|
| 1387 | - (byte 2 (+ 10 16)))
|
|
| 1388 | -(defconstant x87-precision-control-byte
|
|
| 1389 | - (byte 2 (+ 8 16)))
|
|
| 1390 | -(defconstant x87-exceptions-mask-byte
|
|
| 1391 | - (byte 6 16))
|
|
| 1392 | -(defconstant x87-precision-control-alist
|
|
| 1382 | +(defconstant x87-float-infinity-control-byte
|
|
| 1383 | + (byte 1 (+ 12 16))
|
|
| 1384 | + "The bit in the x87 FPU control word that controls the infinity mode.")
|
|
| 1385 | +(defconstant x87-float-rounding-mode
|
|
| 1386 | + (byte 2 (+ 10 16))
|
|
| 1387 | + "The bits in the x87 FPU control word for the rounding mode.")
|
|
| 1388 | +(defconstant x87-float-precision-control-byte
|
|
| 1389 | + (byte 2 (+ 8 16))
|
|
| 1390 | + "The bits in the x87 FPU contol word for the FP operation precision.")
|
|
| 1391 | +(defconstant x87-float-traps-byte
|
|
| 1392 | + (byte 6 16)
|
|
| 1393 | + "The bits in the x87 FPU control word indicating the exceptions that
|
|
| 1394 | + are enabled.")
|
|
| 1395 | +(defconstant x87-float-precision-control-alist
|
|
| 1393 | 1396 | `((:24-bits . 0)
|
| 1394 | 1397 | (:reserved . 1)
|
| 1395 | 1398 | (:53-bits . 2)
|
| 1396 | - (:64-bits . 3)))
|
|
| 1399 | + (:64-bits . 3))
|
|
| 1400 | + "Alist for the x87 precison control. The car is the symbolic
|
|
| 1401 | + precision and the cdr is the value for the precision control field.")
|
|
| 1397 | 1402 | |
| 1398 | 1403 | (defun print-fp-exceptions-enabled (enabled)
|
| 1399 | 1404 | (format t "Precision enable: ~30T~A~%" (ldb (byte 1 5) enabled))
|
| ... | ... | @@ -1416,7 +1421,7 @@ |
| 1416 | 1421 | ;; Note that Intel uses masks to disable the exception, but to match
|
| 1417 | 1422 | ;; the rest of cmucl, these bits are represented as enable bits.
|
| 1418 | 1423 | (format t "Flush-to-zero: ~30T~A~%" (ldb (byte 1 15) sse-mode))
|
| 1419 | - (let ((rc (ldb (byte 2 13) sse-mode)))
|
|
| 1424 | + (let ((rc (ldb float-rounding-mode sse-mode)))
|
|
| 1420 | 1425 | (format t "Rounding control: ~30T~A ~A~%"
|
| 1421 | 1426 | rc
|
| 1422 | 1427 | (car (rassoc rc rounding-mode-alist))))
|
| ... | ... | @@ -1437,17 +1442,17 @@ |
| 1437 | 1442 | (format t "SW: Stack fault: ~30T~A~%" (ldb (byte 1 6) x87-mode))
|
| 1438 | 1443 | (print-fp-current-exceptions (ldb float-exceptions-byte x87-mode))
|
| 1439 | 1444 | (format t "CW: Reserved: ~30T~A~%" (ldb (byte 2 (+ 13 16)) x87-mode))
|
| 1440 | - (format t "CW: Infinity control: ~30T~A~%" (ldb (byte 1 (+ 12 16)) x87-mode))
|
|
| 1441 | - (let ((rc (ldb (byte 2 (+ 10 16)) x87-mode)))
|
|
| 1445 | + (format t "CW: Infinity control: ~30T~A~%" (ldb x87-float-infinity-control-byte x87-mode))
|
|
| 1446 | + (let ((rc (ldb x87-float-rounding-mode x87-mode)))
|
|
| 1442 | 1447 | (format t "CW: Rounding control: ~30T~A ~A~%"
|
| 1443 | 1448 | rc
|
| 1444 | 1449 | (car (rassoc rc rounding-mode-alist))))
|
| 1445 | - (let ((pc (ldb (byte 2 (+ 8 16)) x87-mode)))
|
|
| 1450 | + (let ((pc (ldb x87-float-precision-control-byte x87-mode)))
|
|
| 1446 | 1451 | (format t "CW: Precision control: ~30T~A ~A~%"
|
| 1447 | 1452 | pc
|
| 1448 | - (car (rassoc pc x87-precision-control-alist))))
|
|
| 1453 | + (car (rassoc pc x87-float-precision-control-alist))))
|
|
| 1449 | 1454 | (format t "CW: Reserved: ~30T~A~%" (ldb (byte 2 (+ 6 16)) x87-mode))
|
| 1450 | - (print-fp-exceptions-enabled (ldb x87-exceptions-mask-byte x87-mode)))
|
|
| 1455 | + (print-fp-exceptions-enabled (ldb x87-float-traps-byte x87-mode)))
|
|
| 1451 | 1456 | |
| 1452 | 1457 | (defknown x87-floating-point-modes () float-modes (flushable))
|
| 1453 | 1458 | (defknown ((setf x87-floating-point-modes)) (float-modes)
|
| ... | ... | @@ -205,9 +205,15 @@ |
| 205 | 205 | ;; need to do it this way because the interface assumes the modes are
|
| 206 | 206 | ;; in the same order as the MXCSR register.
|
| 207 | 207 | (defconstant float-rounding-mode (byte 2 13))
|
| 208 | -(defconstant float-sticky-bits (byte 6 0))
|
|
| 209 | -(defconstant float-traps-byte (byte 6 7))
|
|
| 210 | -(defconstant float-exceptions-byte (byte 6 0))
|
|
| 208 | +(defconstant float-sticky-bits (byte 6 0)
|
|
| 209 | + "The bits in the FP mode that hold the accrued exceptions that have
|
|
| 210 | + occurred since the bits were reset.")
|
|
| 211 | +(defconstant float-traps-byte (byte 6 7)
|
|
| 212 | + "The bits in the FP mode that hold FP exceptions that are enabled.")
|
|
| 213 | +(defconstant float-exceptions-byte (byte 6 0)
|
|
| 214 | + "The bits in the FP mode that hold the current exception. However
|
|
| 215 | + for x86, there aren't separate bits for this, so we use the stick
|
|
| 216 | + bits from the accrued exceptions")
|
|
| 211 | 217 | |
| 212 | 218 | (progn
|
| 213 | 219 | ;; SSE2 has a flush-to-zero flag, which we use as the fast bit. Some
|
| ... | ... | @@ -86,6 +86,30 @@ msgstr "" |
| 86 | 86 | msgid "inline ftruncate"
|
| 87 | 87 | msgstr ""
|
| 88 | 88 | |
| 89 | +#: src/compiler/x86/float-sse2.lisp
|
|
| 90 | +msgid "The bit in the x87 FPU control word that controls the infinity mode."
|
|
| 91 | +msgstr ""
|
|
| 92 | + |
|
| 93 | +#: src/compiler/x86/float-sse2.lisp
|
|
| 94 | +msgid "The bits in the x87 FPU control word for the rounding mode."
|
|
| 95 | +msgstr ""
|
|
| 96 | + |
|
| 97 | +#: src/compiler/x86/float-sse2.lisp
|
|
| 98 | +msgid "The bits in the x87 FPU contol word for the FP operation precision."
|
|
| 99 | +msgstr ""
|
|
| 100 | + |
|
| 101 | +#: src/compiler/x86/float-sse2.lisp
|
|
| 102 | +msgid ""
|
|
| 103 | +"The bits in the x87 FPU control word indicating the exceptions that\n"
|
|
| 104 | +" are enabled."
|
|
| 105 | +msgstr ""
|
|
| 106 | + |
|
| 107 | +#: src/compiler/x86/float-sse2.lisp
|
|
| 108 | +msgid ""
|
|
| 109 | +"Alist for the x87 precison control. The car is the symbolic\n"
|
|
| 110 | +" precision and the cdr is the value for the precision control field."
|
|
| 111 | +msgstr ""
|
|
| 112 | + |
|
| 89 | 113 | #: src/compiler/x86/float-sse2.lisp
|
| 90 | 114 | msgid "Print SSE2 modes word in a readable fashion."
|
| 91 | 115 | msgstr ""
|
| ... | ... | @@ -136,6 +136,23 @@ msgstr "" |
| 136 | 136 | msgid "Maximum number of bits in a positive fixnum"
|
| 137 | 137 | msgstr ""
|
| 138 | 138 | |
| 139 | +#: src/compiler/x86/parms.lisp
|
|
| 140 | +msgid ""
|
|
| 141 | +"The bits in the FP mode that hold the accrued exceptions that have\n"
|
|
| 142 | +" occurred since the bits were reset."
|
|
| 143 | +msgstr ""
|
|
| 144 | + |
|
| 145 | +#: src/compiler/x86/parms.lisp
|
|
| 146 | +msgid "The bits in the FP mode that hold FP exceptions that are enabled."
|
|
| 147 | +msgstr ""
|
|
| 148 | + |
|
| 149 | +#: src/compiler/x86/parms.lisp
|
|
| 150 | +msgid ""
|
|
| 151 | +"The bits in the FP mode that hold the current exception. However\n"
|
|
| 152 | +" for x86, there aren't separate bits for this, so we use the stick\n"
|
|
| 153 | +" bits from the accrued exceptions"
|
|
| 154 | +msgstr ""
|
|
| 155 | + |
|
| 139 | 156 | #: src/compiler/x86/vm.lisp
|
| 140 | 157 | msgid "Redefining SC number ~D from ~S to ~S."
|
| 141 | 158 | msgstr ""
|
| ... | ... | @@ -343,3 +343,48 @@ |
| 343 | 343 | (assert-true (typep new-mode 'x86::float-modes))
|
| 344 | 344 | (assert-equal new-mode (setf (x86::x87-floating-point-modes) new-mode))))
|
| 345 | 345 | |
| 346 | +(define-test set-floating-point-modes
|
|
| 347 | + (let ((old-x87-modes (x86::x87-floating-point-modes))
|
|
| 348 | + (old-sse2-modes (x86::sse2-floating-point-modes)))
|
|
| 349 | + (unwind-protect
|
|
| 350 | + (progn
|
|
| 351 | + ;; Set some new traps and rounding mode
|
|
| 352 | + (ext:set-floating-point-modes :traps '(:underflow
|
|
| 353 | + :overflow
|
|
| 354 | + :invalid
|
|
| 355 | + :divide-by-zero)
|
|
| 356 | + :rounding-mode :zero)
|
|
| 357 | + (let* ((x87-modes (x86::x87-floating-point-modes))
|
|
| 358 | + (x87-exceptions-enabled (ldb x86::x87-float-traps-byte x87-modes))
|
|
| 359 | + (x87-rc (ldb x86::x87-float-rounding-mode x87-modes))
|
|
| 360 | + (sse2-modes (x86::sse2-floating-point-modes))
|
|
| 361 | + (sse2-exceptions-enabled (ldb x86::float-traps-byte sse2-modes))
|
|
| 362 | + (sse2-rc (ldb x86::float-rounding-mode sse2-modes)))
|
|
| 363 | + (x86::print-x87-fp-modes x87-modes)
|
|
| 364 | + ;; Verify that we set the enabled exceptions
|
|
| 365 | + ;; correctly. First for sse2, then for x87.
|
|
| 366 | + (assert-false (logbitp 5 sse2-exceptions-enabled)) ; precision
|
|
| 367 | + (assert-true (logbitp 4 sse2-exceptions-enabled)) ; underflow
|
|
| 368 | + (assert-true (logbitp 3 sse2-exceptions-enabled)) ; overflow
|
|
| 369 | + (assert-true (logbitp 2 sse2-exceptions-enabled)) ; divide-by-zero
|
|
| 370 | + (assert-false (logbitp 1 sse2-exceptions-enabled)) ; denormal
|
|
| 371 | + (assert-true (logbitp 0 sse2-exceptions-enabled)) ; invalid
|
|
| 372 | +
|
|
| 373 | + (assert-false (logbitp 5 x87-exceptions-enabled)) ; precision
|
|
| 374 | + (assert-true (logbitp 4 x87-exceptions-enabled)) ; underflow
|
|
| 375 | + (assert-true (logbitp 3 x87-exceptions-enabled)) ; overflow
|
|
| 376 | + (assert-true (logbitp 2 x87-exceptions-enabled)) ; divide-by-zero
|
|
| 377 | + (assert-false (logbitp 1 x87-exceptions-enabled)) ; denormal
|
|
| 378 | + (assert-true (logbitp 0 x87-exceptions-enabled)) ; invalid
|
|
| 379 | + |
|
| 380 | + ;; Verify the rounding mode is set to zero
|
|
| 381 | + (assert-eql :zero (car (rassoc sse2-rc x86::rounding-mode-alist)))
|
|
| 382 | + (assert-eql :zero (car (rassoc x87-rc x86::rounding-mode-alist)))
|
|
| 383 | + |
|
| 384 | + ;; Verify precision for x87
|
|
| 385 | + (assert-eql :64-bits
|
|
| 386 | + (car (rassoc (ldb x86::x87-float-precision-control-byte x87-modes)
|
|
| 387 | + x86::x87-float-precision-control-alist)))))
|
|
| 388 | + |
|
| 389 | + (setf (x86::x87-floating-point-modes) old-x87-modes)
|
|
| 390 | + (setf (x86::sse2-floating-point-modes) old-sse2-modes)))) |