September 2025 - cmucl-cvs - mailman3.common-lisp.net

[Git][cmucl/cmucl] Pushed new tag snapshot-2025-09
by Raymond Toy (＠rtoy) 16 Sep '25

16 Sep '25

Raymond Toy pushed new tag snapshot-2025-09 at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/snapshot-2025-09 You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Update release notes
by Raymond Toy (＠rtoy) 16 Sep '25

16 Sep '25

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 69a8a4b6 by Raymond Toy at 2025-09-16T19:43:12-07:00 Update release notes Forgot to add #381 [skip-ci] - - - - - 1 changed file: - src/general-info/release-21f.md Changes: ===================================== 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. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/69a8a4b6542e2ba224fe333… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/69a8a4b6542e2ba224fe333… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #381: cmucl-unix.pot depends on OS
by Raymond Toy (＠rtoy) 16 Sep '25

16 Sep '25

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 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 - - - - - 1 changed file: - src/code/unix.lisp Changes: ===================================== 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." View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/622350896886c182928c3c… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/622350896886c182928c3c… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-381-cmucl-unix-depends-on-os
by Raymond Toy (＠rtoy) 16 Sep '25

16 Sep '25

Raymond Toy pushed new branch issue-381-cmucl-unix-depends-on-os at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-381-cmucl-unix-depe… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-438-call-out-sets-x87-precision
by Raymond Toy (＠rtoy) 05 Sep '25

05 Sep '25

Raymond Toy pushed new branch issue-438-call-out-sets-x87-precision at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-438-call-out-sets-x… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #431: Fix setting of x87 modes in set-floating-point-modes
by Raymond Toy (＠rtoy) 05 Sep '25

05 Sep '25

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 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 - - - - - 10 changed files: - .gitlab-ci.yml - + src/bootfiles/21e/boot-2025-07.lisp - src/code/float-trap.lisp - src/code/x86-vm.lisp - src/compiler/x86/float-sse2.lisp - src/compiler/x86/parms.lisp - src/general-info/release-21f.md - src/i18n/locale/cmucl-x86-vm.pot - + tests/float-x86.lisp - tests/float.lisp Changes: ===================================== .gitlab-ci.yml ===================================== @@ -4,7 +4,7 @@ variables: download_url: "https://common-lisp.net/project/cmucl/downloads/snapshots/$year/$month" version: "$year-$month-x86" tar_ext: "xz" - bootstrap: "" + bootstrap: "-B boot-2025-07" # Default install configuration to download the cmucl tarballs to use # for building. ===================================== src/bootfiles/21e/boot-2025-07.lisp ===================================== @@ -0,0 +1,25 @@ +;; Bootstrap file to define some constants we use early in the build. + +(in-package :x86) + +(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.") + ===================================== src/code/float-trap.lisp ===================================== @@ -114,21 +114,24 @@ ;; 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) - ) + (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 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-float-precision-control-alist)) + x87-float-precision-control-byte + x87-modes)) + + (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)) #+(and sse2 darwin) (progn ===================================== 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/compiler/x86/float-sse2.lisp ===================================== @@ -1288,6 +1288,10 @@ ;; 0 invalid operation flag ;; ;; See below for rounding control +;; +;; Also see float-rounding-mode, float-sticky-bits, float-traps-byte, +;; and float-exceptions-byte in compiler/x86/parms.lisp. + (defknown sse2-floating-point-modes () float-modes (flushable)) (defknown ((setf sse2-floating-point-modes)) (float-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/general-info/release-21f.md ===================================== @@ -139,6 +139,7 @@ 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` * 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 "" @@ -136,6 +168,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-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)))))) ===================================== tests/float.lisp ===================================== @@ -342,4 +342,3 @@ (x86::x87-floating-point-modes))))) (assert-true (typep new-mode 'x86::float-modes)) (assert-equal new-mode (setf (x86::x87-floating-point-modes) new-mode)))) - View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/c65554a544fc86c05e0f0f… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/c65554a544fc86c05e0f0f… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-431-fix-set-floating-point-modes] Oops. Done.
by Raymond Toy (＠rtoy) 05 Sep '25

05 Sep '25

Raymond Toy pushed to branch issue-431-fix-set-floating-point-modes at cmucl / cmucl Commits: 70e174a5 by Raymond Toy at 2025-09-05T06:48:57-07:00 Oops. Done. - - - - - 1 changed file: - tests/float-x86.lisp Changes: ===================================== tests/float-x86.lisp ===================================== @@ -56,6 +56,4 @@ ;; 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)))) - ) - ) + x86::x87-float-precision-control-alist)))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/70e174a5eb8f8bd7b1abb19… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/70e174a5eb8f8bd7b1abb19… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-425-correctly-rounded-math-functions-single-float] Include core-math 32-bit functions in lisp.a
by Raymond Toy (＠rtoy) 03 Sep '25

03 Sep '25

Raymond Toy pushed to branch issue-425-correctly-rounded-math-functions-single-float at cmucl / cmucl Commits: 8c957e76 by Raymond Toy at 2025-09-03T12:26:49-07:00 Include core-math 32-bit functions in lisp.a When building lisp.a, we were only adding CORE64_OBJS and forgot to include CORE32_OBJS. To do this, lisp.a needs to include CORE_MATH_OBJS. - - - - - 1 changed file: - src/lisp/GNUmakefile Changes: ===================================== src/lisp/GNUmakefile ===================================== @@ -60,7 +60,7 @@ lisp: ${OBJS} ${CORE_MATH_OBJS} version.o # Create a library out of all the object files so we can build an # executable. However, we need to remove exec-init.o from the library lisp.a: version.o ${OBJS} ${CORE_MATH_OBJS} ${EXEC_FINAL_OBJ} - $(AR) crs lisp.a ${OBJS} ${CORE64_OBJS} version.o + $(AR) crs lisp.a ${OBJS} ${CORE_MATH_OBJS} version.o ifneq (${EXEC_FINAL_OBJ},) $(AR) d lisp.a exec-init.o endif View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/8c957e766463e0bac0d2d14… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/8c957e766463e0bac0d2d14… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-431-fix-set-floating-point-modes] 2 commits: Address review comments
by Raymond Toy (＠rtoy) 02 Sep '25

02 Sep '25

Raymond Toy pushed to branch issue-431-fix-set-floating-point-modes at cmucl / cmucl Commits: 67432557 by Raymond Toy at 2025-09-02T15:52:58-07:00 Address review comments Move new x87 constants and FP mode word printers from compiler/x86/float-sse2.lisp to code/x86-vm.lisp. Move new test from tests/float.lisp to the new file tests/float-x86.lisp. - - - - - 5002a779 by Raymond Toy at 2025-09-02T16:12:27-07:00 Address review comments Reduce scope of `unwind-protect` in tests/float-x86.lisp. Also print out the sse2 FP mode word, just like we do for the x87 FP mode word. - - - - - 6 changed files: - src/code/x86-vm.lisp - src/compiler/x86/float-sse2.lisp - src/i18n/locale/cmucl-sse2.pot - src/i18n/locale/cmucl-x86-vm.pot - + tests/float-x86.lisp - tests/float.lisp Changes: ===================================== 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/compiler/x86/float-sse2.lisp ===================================== @@ -1379,83 +1379,6 @@ ;; 10 double precision (53 bits) ;; 11 double extended precision (64 bits) -(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 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 "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 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))) - (defknown x87-floating-point-modes () float-modes (flushable)) (defknown ((setf x87-floating-point-modes)) (float-modes) float-modes) ===================================== src/i18n/locale/cmucl-sse2.pot ===================================== @@ -86,38 +86,6 @@ 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/compiler/x86/float-sse2.lisp -msgid "Print X87 floating modes word in a readable fashion." -msgstr "" - #: src/compiler/x86/float-sse2.lisp msgid "inline complex single-float creation" msgstr "" ===================================== 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,61 @@ +;; 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)))) + ) + ) ===================================== tests/float.lisp ===================================== @@ -342,49 +342,3 @@ (x86::x87-floating-point-modes))))) (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/12cae745fdb002782b06b4… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/12cae745fdb002782b06b4… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0