Raymond Toy pushed to branch issue-425-correctly-rounded-math-functions-single-float at cmucl / cmucl Commits: cd2edae5 by Raymond Toy at 2025-08-19T14:16:31-07:00 Fix #432: Don't pass -M option to make-extra-dist.sh - - - - - c65554a5 by Raymond Toy at 2025-08-19T14:16:31-07:00 Merge branch 'issue-432-fix-man-option-for-make-extra-dist' into 'master' Fix #432: Don't pass -M option to make-extra-dist.sh Closes #432 See merge request cmucl/cmucl!315 - - - - - 633e64a4 by Raymond Toy at 2025-09-05T07:55:14-07:00 Fix #431: Fix setting of x87 modes in set-floating-point-modes - - - - - 7ab74e13 by Raymond Toy at 2025-09-05T07:55:15-07:00 Merge branch 'issue-431-fix-set-floating-point-modes' into 'master' Fix #431: Fix setting of x87 modes in set-floating-point-modes Closes #431 See merge request cmucl/cmucl!314 - - - - - 62235089 by Raymond Toy at 2025-09-12T08:51:26-07:00 Update release notes Forgot to include #432 [skip-ci] - - - - - 61592012 by Raymond Toy at 2025-09-16T17:50:14-07:00 Fix #381: cmucl-unix.pot depends on OS - - - - - 4dd79bc9 by Raymond Toy at 2025-09-16T17:50:15-07:00 Merge branch 'issue-381-cmucl-unix-depends-on-os' into 'master' Fix #381: cmucl-unix.pot depends on OS Closes #381 See merge request cmucl/cmucl!319 - - - - - 69a8a4b6 by Raymond Toy at 2025-09-16T19:43:12-07:00 Update release notes Forgot to add #381 [skip-ci] - - - - - fb29eb6e by Raymond Toy at 2025-09-17T08:32:41-07:00 Fix #440: Update CI to use snapshot 2025-09 - - - - - d537a8a3 by Raymond Toy at 2025-09-17T08:32:41-07:00 Merge branch 'issue-440-ci-use-snapshot-2025-09' into 'master' Fix #440: Update CI to use snapshot 2025-09 Closes #440 See merge request cmucl/cmucl!320 - - - - - 131d10d8 by Raymond Toy at 2025-09-17T12:13:35-07:00 Merge branch 'master' into issue-425-correctly-rounded-math-functions - - - - - f3a339b9 by Raymond Toy at 2025-09-17T12:22:36-07:00 Merge branch 'issue-425-correctly-rounded-math-functions' into issue-425-correctly-rounded-math-functions-single-float - - - - - 7 changed files: - .gitlab-ci.yml - bin/make-dist.sh - src/code/unix.lisp - src/code/x86-vm.lisp - src/general-info/release-21f.md - src/i18n/locale/cmucl-x86-vm.pot - + tests/float-x86.lisp Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1,6 +1,6 @@ variables: year: "2025" - month: "07" + month: "09" download_url: "https://common-lisp.net/project/cmucl/downloads/snapshots/$year/$month" version: "$year-$month-x86" tar_ext: "xz" ===================================== bin/make-dist.sh ===================================== @@ -189,7 +189,7 @@ GTAR_OPTS="-t ${GTAR:-tar}" EXTRA_OPTS="${GROUP:+ -G ${GROUP}} ${OWNER:+ -O ${OWNER}}" INSTALL_OPTS="${INSTALL_DIR:+ -I ${INSTALL_DIR}}" MANDIR="${MANDIR:+ -M ${MANDIR}}" -OPTIONS="${GTAR_OPTS} ${EXTRA_OPTS} ${INSTALL_OPTS} ${MANDIR}" +OPTIONS="${GTAR_OPTS} ${EXTRA_OPTS} ${INSTALL_OPTS}" set -x echo Creating distribution for $ARCH $OS ===================================== src/code/unix.lisp ===================================== @@ -2166,7 +2166,7 @@ #+linux (defun unix-getpwuid (uid) - "Return a USER-INFO structure for the user identified by UID. If + _N"Return a USER-INFO structure for the user identified by UID. If not found, NIL is returned with a second value indicating the cause of the failure. In particular, if the second value is 0 (or ENONENT, ESRCH, EBADF, etc.), then the uid was not found." ===================================== src/code/x86-vm.lisp ===================================== @@ -733,3 +733,88 @@ (multiple-value-bind (fop dst src) (get-fp-operation scp) (values fop (list dst src)))) + +;; See src/compiler/x86/float-sse2.lisp for a description of the x87 +;; control and status words. + +(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)) + "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)) + (format t "Underflow enable: ~30T~A~%" (ldb (byte 1 4) enabled)) + (format t "Overflow enable: ~30T~A~%" (ldb (byte 1 3) enabled)) + (format t "Divide-by-zero enable: ~30T~A~%" (ldb (byte 1 2) enabled)) + (format t "Denormal op enable: ~30T~A~%" (ldb (byte 1 1) enabled)) + (format t "Invalid op enable: ~30T~A~%" (ldb (byte 1 0) enabled))) + +(defun print-fp-current-exceptions (current) + (format t "Precision flag: ~30T~A~%" (ldb (byte 1 5) current)) + (format t "Underflow flag: ~30T~A~%" (ldb (byte 1 4) current)) + (format t "Overflow flag: ~30T~A~%" (ldb (byte 1 3) current)) + (format t "Divide-by-zero flag: ~30T~A~%" (ldb (byte 1 2) current)) + (format t "Denormal op flag: ~30T~A~%" (ldb (byte 1 1) current)) + (format t "Invalid op flag: ~30T~A~%" (ldb (byte 1 0) current))) + +(defun print-sse2-fp-modes (&optional (sse-mode (sse2-floating-point-modes))) + "Print SSE2 floating modes word in a human-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 "Flush-to-zero: ~30T~A~%" (ldb (byte 1 15) sse-mode)) + (let ((rc (ldb float-rounding-mode sse-mode))) + (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)) + (print-fp-current-exceptions (ldb float-exceptions-byte sse-mode))) + +(defun print-x87-fp-modes (&optional (x87-mode (x87-floating-point-modes))) + "Print X87 floating modes word in a human-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 "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 "~%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 "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 "Precision control: ~30T#b~2,'0b ~S~%" + pc + (car (rassoc pc x87-float-precision-control-alist)))) + (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))) + ===================================== src/general-info/release-21f.md ===================================== @@ -123,6 +123,7 @@ public domain. * #375 `unix-mkstemp` and `unix-mkdtemp` actually returns the file names now. * #379 Support GNU-style command-line option names + * #381 cmucl-unix.pot depends on OS * #382 Command-line options are case-sensitive * #385 Fixed compiler warning about `%p` in Linux-os.c * #386 Generate `def-unix-error` forms from OS-specific files. @@ -139,7 +140,8 @@ public domain. package-local-nicknames) * #424 Use fdlibm `hypot` to fix bug in snapshot 2025-07 * #426 Define float-modes type correctly for `(setf (x87-set-floating-point-modes))` - * $431 Fix setting of x87 FP modes in `set-floating-point-modes` + * #431 Fix setting of x87 FP modes in `set-floating-point-modes` + * #432 `make-dist.sh` passes `-M` to `make-extra-dist.sh` which doesn't accept `-M` option. * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== src/i18n/locale/cmucl-x86-vm.pot ===================================== @@ -77,6 +77,38 @@ msgstr "" msgid "Thread safe push of val onto the list in the vector element." msgstr "" +#: src/code/x86-vm.lisp +msgid "The bit in the x87 FPU control word that controls the infinity mode." +msgstr "" + +#: src/code/x86-vm.lisp +msgid "The bits in the x87 FPU control word for the rounding mode." +msgstr "" + +#: src/code/x86-vm.lisp +msgid "The bits in the x87 FPU contol word for the FP operation precision." +msgstr "" + +#: src/code/x86-vm.lisp +msgid "" +"The bits in the x87 FPU control word indicating the exceptions that\n" +" are enabled." +msgstr "" + +#: src/code/x86-vm.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/code/x86-vm.lisp +msgid "Print SSE2 floating modes word in a human-readable fashion." +msgstr "" + +#: src/code/x86-vm.lisp +msgid "Print X87 floating modes word in a human-readable fashion." +msgstr "" + #: src/code/load.lisp msgid "Top-Level Form" msgstr "" ===================================== tests/float-x86.lisp ===================================== @@ -0,0 +1,59 @@ +;; Tests of float functions + +(defpackage :float-x86-tests + (:use :cl :lisp-unit)) + +(in-package "FLOAT-X86-TESTS") + +(define-test set-floating-point-modes + (let ((old-x87-modes (x86::x87-floating-point-modes)) + (old-sse2-modes (x86::sse2-floating-point-modes)) + x87-modes sse2-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) + ;; Save these new FP modes + (setf x87-modes (x86::x87-floating-point-modes)) + (setf sse2-modes (x86::sse2-floating-point-modes))) + + (setf (x86::x87-floating-point-modes) old-x87-modes) + (setf (x86::sse2-floating-point-modes) old-sse2-modes)) + + (let* ((x87-exceptions-enabled (ldb x86::x87-float-traps-byte x87-modes)) + (x87-rc (ldb x86::x87-float-rounding-mode x87-modes)) + (sse2-exceptions-enabled (ldb x86::float-traps-byte sse2-modes)) + (sse2-rc (ldb x86::float-rounding-mode sse2-modes))) + (format t "*X87 FP mode words:~%") + (x86::print-x87-fp-modes x87-modes) + (format t "~%*SSE2 FP mode words:~%") + (x86::print-sse2-fp-modes sse2-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)))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/8c957e766463e0bac0d2d14... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/8c957e766463e0bac0d2d14... You're receiving this email because of your account on gitlab.common-lisp.net.