Raymond Toy pushed to branch issue-425-correctly-rounded-math-functions-single-float at cmucl / cmucl

Commits:

7 changed files:

Changes:

  • .gitlab-ci.yml
    1 1 
     variables:
    2 2 
       year: "2025"
    3 
    -  month: "07"
    3 
    +  month: "09"
    4 4 
       download_url: "https://common-lisp.net/project/cmucl/downloads/snapshots/$year/$month"
    5 5 
       version: "$year-$month-x86"
    6 6 
       tar_ext: "xz"

  • bin/make-dist.sh
    ... ... @@ -189,7 +189,7 @@ GTAR_OPTS="-t ${GTAR:-tar}"
    189 189 
     EXTRA_OPTS="${GROUP:+ -G ${GROUP}} ${OWNER:+ -O ${OWNER}}"
    190 190 
     INSTALL_OPTS="${INSTALL_DIR:+ -I ${INSTALL_DIR}}"
    191 191 
     MANDIR="${MANDIR:+ -M ${MANDIR}}"
    192 
    -OPTIONS="${GTAR_OPTS} ${EXTRA_OPTS} ${INSTALL_OPTS} ${MANDIR}"
    192 
    +OPTIONS="${GTAR_OPTS} ${EXTRA_OPTS} ${INSTALL_OPTS}"
    193 193
    194 194 
     set -x
    195 195 
     echo Creating distribution for $ARCH $OS

  • src/code/unix.lisp
    ... ... @@ -2166,7 +2166,7 @@
    2166 2166
    2167 2167 
     #+linux
    2168 2168 
     (defun unix-getpwuid (uid)
    2169 
    -  "Return a USER-INFO structure for the user identified by UID.  If
    2169 
    +  _N"Return a USER-INFO structure for the user identified by UID.  If
    2170 2170 
       not found, NIL is returned with a second value indicating the cause
    2171 2171 
       of the failure.  In particular, if the second value is 0 (or
    2172 2172 
       ENONENT, ESRCH, EBADF, etc.), then the uid was not found."

  • src/code/x86-vm.lisp
    ... ... @@ -733,3 +733,88 @@
    733 733 
       (multiple-value-bind (fop dst src)
    734 734 
           (get-fp-operation scp)
    735 735 
         (values fop (list dst src))))
    736 
    +
    737 
    +;; See src/compiler/x86/float-sse2.lisp for a description of the x87
    738 
    +;; control and status words.
    739 
    +
    740 
    +(defconstant x87-float-infinity-control-byte
    741 
    +  (byte 1 (+ 12 16))
    742 
    +  "The bit in the x87 FPU control word that controls the infinity mode.")
    743 
    +
    744 
    +(defconstant x87-float-rounding-mode
    745 
    +  (byte 2 (+ 10 16))
    746 
    +  "The bits in the x87 FPU control word for the rounding mode.")
    747 
    +
    748 
    +(defconstant x87-float-precision-control-byte
    749 
    +  (byte 2 (+ 8 16))
    750 
    +  "The bits in the x87 FPU contol word for the FP operation precision.")
    751 
    +
    752 
    +(defconstant x87-float-traps-byte
    753 
    +  (byte 6 16)
    754 
    +  "The bits in the x87 FPU control word indicating the exceptions that
    755 
    + are enabled.")
    756 
    +
    757 
    +(defconstant x87-float-precision-control-alist
    758 
    +  `((:24-bits . 0)
    759 
    +    (:reserved . 1)
    760 
    +    (:53-bits . 2)
    761 
    +    (:64-bits . 3))
    762 
    +  "Alist for the x87 precison control.  The car is the symbolic
    763 
    + precision and the cdr is the value for the precision control field.")
    764 
    +
    765 
    +(defun print-fp-exceptions-enabled (enabled)
    766 
    +  (format t "Precision enable:      ~30T~A~%" (ldb (byte 1 5) enabled))
    767 
    +  (format t "Underflow enable:      ~30T~A~%" (ldb (byte 1 4) enabled))
    768 
    +  (format t "Overflow enable:       ~30T~A~%" (ldb (byte 1 3) enabled))
    769 
    +  (format t "Divide-by-zero enable: ~30T~A~%" (ldb (byte 1 2) enabled))
    770 
    +  (format t "Denormal op enable:    ~30T~A~%" (ldb (byte 1 1) enabled))
    771 
    +  (format t "Invalid op enable:     ~30T~A~%" (ldb (byte 1 0) enabled)))
    772 
    +
    773 
    +(defun print-fp-current-exceptions (current)
    774 
    +  (format t "Precision flag:        ~30T~A~%" (ldb (byte 1 5) current))
    775 
    +  (format t "Underflow flag:        ~30T~A~%" (ldb (byte 1 4) current))
    776 
    +  (format t "Overflow flag:         ~30T~A~%" (ldb (byte 1 3) current))
    777 
    +  (format t "Divide-by-zero flag:   ~30T~A~%" (ldb (byte 1 2) current))
    778 
    +  (format t "Denormal op flag:      ~30T~A~%" (ldb (byte 1 1) current))
    779 
    +  (format t "Invalid op flag:       ~30T~A~%" (ldb (byte 1 0) current)))
    780 
    +
    781 
    +(defun print-sse2-fp-modes (&optional (sse-mode (sse2-floating-point-modes)))
    782 
    +  "Print SSE2 floating modes word in a human-readable fashion."
    783 
    +  ;; Note that Intel uses masks to disable the exception, but to match
    784 
    +  ;; the rest of cmucl, these bits are represented as enable bits.
    785 
    +  (format t "Flush-to-zero:         ~30T~A~%" (ldb (byte 1 15) sse-mode))
    786 
    +  (let ((rc (ldb float-rounding-mode sse-mode)))
    787 
    +    (format t "Rounding control:      ~30T#b~2,'0b ~S~%"
    788 
    +	    rc
    789 
    +	    (car (rassoc rc rounding-mode-alist))))
    790 
    +  (print-fp-exceptions-enabled (ldb float-traps-byte sse-mode))
    791 
    +  (print-fp-current-exceptions (ldb float-exceptions-byte sse-mode)))
    792 
    +
    793 
    +(defun print-x87-fp-modes (&optional (x87-mode (x87-floating-point-modes)))
    794 
    +  "Print X87 floating modes word in a human-readable fashion."
    795 
    +  ;; Note that Intel uses masks to disable the exception, but to match
    796 
    +  ;; the rest of cmucl, these bits are represented as enable bits.
    797 
    +  (format t "Status word:~%")
    798 
    +  (format t "FPU busy:             ~30T~A~%" (ldb (byte 1 15) x87-mode))
    799 
    +  (format t "Condition code C3:    ~30T~A~%" (ldb (byte 1 14) x87-mode))
    800 
    +  (format t "Top of stack:         ~30T~D~%" (ldb (byte 3 11) x87-mode))
    801 
    +  (format t "Condition code C2:    ~30T~A~%" (ldb (byte 1 10) x87-mode))
    802 
    +  (format t "Condition code C1:    ~30T~A~%" (ldb (byte 1 9) x87-mode))
    803 
    +  (format t "Condition code C0:    ~30T~A~%" (ldb (byte 1 8) x87-mode))
    804 
    +  (format t "Error summary:        ~30T~A~%" (ldb (byte 1 7) x87-mode))
    805 
    +  (format t "Stack fault:          ~30T~A~%" (ldb (byte 1 6) x87-mode))
    806 
    +  (print-fp-current-exceptions (ldb float-exceptions-byte x87-mode))
    807 
    +  (format t "~%Control word:~%")
    808 
    +  (format t "Reserved:             ~30T#b~2,'0b~%" (ldb (byte 2 (+ 13 16)) x87-mode))
    809 
    +  (format t "Infinity control:     ~30T~A~%" (ldb x87-float-infinity-control-byte x87-mode))
    810 
    +  (let ((rc (ldb x87-float-rounding-mode x87-mode)))
    811 
    +    (format t "Rounding control:     ~30T#b~2,'0b ~S~%"
    812 
    +	    rc
    813 
    +	    (car (rassoc rc rounding-mode-alist))))
    814 
    +  (let ((pc (ldb x87-float-precision-control-byte x87-mode)))
    815 
    +    (format t "Precision control:    ~30T#b~2,'0b ~S~%"
    816 
    +	    pc
    817 
    +	    (car (rassoc pc x87-float-precision-control-alist))))
    818 
    +  (format t "Reserved:             ~30T#b~2,'0b~%" (ldb (byte 2 (+ 6 16)) x87-mode))
    819 
    +  (print-fp-exceptions-enabled (ldb x87-float-traps-byte x87-mode)))
    820 
    +

  • src/general-info/release-21f.md
    ... ... @@ -123,6 +123,7 @@ public domain.
    123 123 
         * #375 `unix-mkstemp` and `unix-mkdtemp` actually returns the
    124 124 
           file names now.
    125 125 
         * #379 Support GNU-style command-line option names
    126 
    +    * #381 cmucl-unix.pot depends on OS
    126 127 
         * #382 Command-line options are case-sensitive
    127 128 
         * #385 Fixed compiler warning about `%p` in Linux-os.c
    128 129 
         * #386 Generate `def-unix-error` forms from OS-specific files.
    ... ... @@ -139,7 +140,8 @@ public domain.
    139 140 
           package-local-nicknames)
    140 141 
         * #424 Use fdlibm `hypot` to fix bug in snapshot 2025-07
    141 142 
         * #426 Define float-modes type correctly for `(setf (x87-set-floating-point-modes))`
    142 
    -    * $431 Fix setting of x87 FP modes in `set-floating-point-modes`
    143 
    +    * #431 Fix setting of x87 FP modes in `set-floating-point-modes`
    144 
    +    * #432 `make-dist.sh` passes `-M` to `make-extra-dist.sh` which doesn't accept `-M` option.
    143 145 
       * Other changes:
    144 146 
       * Improvements to the PCL implementation of CLOS:
    145 147 
       * Changes to building procedure:

  • src/i18n/locale/cmucl-x86-vm.pot
    ... ... @@ -77,6 +77,38 @@ msgstr ""
    77 77 
     msgid "Thread safe push of val onto the list in the vector element."
    78 78 
     msgstr ""
    79 79
    80 
    +#: src/code/x86-vm.lisp
    81 
    +msgid "The bit in the x87 FPU control word that controls the infinity mode."
    82 
    +msgstr ""
    83 
    +
    84 
    +#: src/code/x86-vm.lisp
    85 
    +msgid "The bits in the x87 FPU control word for the rounding mode."
    86 
    +msgstr ""
    87 
    +
    88 
    +#: src/code/x86-vm.lisp
    89 
    +msgid "The bits in the x87 FPU contol word for the FP operation precision."
    90 
    +msgstr ""
    91 
    +
    92 
    +#: src/code/x86-vm.lisp
    93 
    +msgid ""
    94 
    +"The bits in the x87 FPU control word indicating the exceptions that\n"
    95 
    +" are enabled."
    96 
    +msgstr ""
    97 
    +
    98 
    +#: src/code/x86-vm.lisp
    99 
    +msgid ""
    100 
    +"Alist for the x87 precison control.  The car is the symbolic\n"
    101 
    +" precision and the cdr is the value for the precision control field."
    102 
    +msgstr ""
    103 
    +
    104 
    +#: src/code/x86-vm.lisp
    105 
    +msgid "Print SSE2 floating modes word in a human-readable fashion."
    106 
    +msgstr ""
    107 
    +
    108 
    +#: src/code/x86-vm.lisp
    109 
    +msgid "Print X87 floating modes word in a human-readable fashion."
    110 
    +msgstr ""
    111 
    +
    80 112 
     #: src/code/load.lisp
    81 113 
     msgid "Top-Level Form"
    82 114 
     msgstr ""

  • tests/float-x86.lisp
    1 
    +;; Tests of float functions
    2 
    +
    3 
    +(defpackage :float-x86-tests
    4 
    +  (:use :cl :lisp-unit))
    5 
    +
    6 
    +(in-package "FLOAT-X86-TESTS")
    7 
    +
    8 
    +(define-test set-floating-point-modes
    9 
    +  (let ((old-x87-modes (x86::x87-floating-point-modes))
    10 
    +	(old-sse2-modes (x86::sse2-floating-point-modes))
    11 
    +	x87-modes sse2-modes)
    12 
    +    (unwind-protect
    13 
    +	 (progn
    14 
    +	   ;; Set some new traps and rounding mode.
    15 
    +	   (ext:set-floating-point-modes :traps '(:underflow
    16 
    +						  :overflow
    17 
    +						  :invalid
    18 
    +						  :divide-by-zero)
    19 
    +					 :rounding-mode :zero)
    20 
    +	   ;; Save these new FP modes
    21 
    +	   (setf x87-modes (x86::x87-floating-point-modes))
    22 
    +	   (setf sse2-modes (x86::sse2-floating-point-modes)))
    23 
    +
    24 
    +      (setf (x86::x87-floating-point-modes) old-x87-modes)
    25 
    +      (setf (x86::sse2-floating-point-modes) old-sse2-modes))
    26 
    +
    27 
    +    (let* ((x87-exceptions-enabled (ldb x86::x87-float-traps-byte x87-modes))
    28 
    +	   (x87-rc (ldb x86::x87-float-rounding-mode x87-modes))
    29 
    +	   (sse2-exceptions-enabled (ldb x86::float-traps-byte sse2-modes))
    30 
    +	   (sse2-rc (ldb x86::float-rounding-mode sse2-modes)))
    31 
    +      (format t "*X87 FP mode words:~%")
    32 
    +      (x86::print-x87-fp-modes x87-modes)
    33 
    +      (format t "~%*SSE2 FP mode words:~%")
    34 
    +      (x86::print-sse2-fp-modes sse2-modes)
    35 
    +
    36 
    +      ;; Verify that we set the enabled exceptions
    37 
    +      ;; correctly. First for sse2, then for x87.
    38 
    +      (assert-false (logbitp 5 sse2-exceptions-enabled)) ; precision
    39 
    +      (assert-true (logbitp 4 sse2-exceptions-enabled))	 ; underflow
    40 
    +      (assert-true (logbitp 3 sse2-exceptions-enabled))	 ; overflow
    41 
    +      (assert-true (logbitp 2 sse2-exceptions-enabled))	; divide-by-zero
    42 
    +      (assert-false (logbitp 1 sse2-exceptions-enabled)) ; denormal
    43 
    +      (assert-true (logbitp 0 sse2-exceptions-enabled))	 ; invalid
    44 
    +
    45 
    +      (assert-false (logbitp 5 x87-exceptions-enabled))	; precision
    46 
    +      (assert-true (logbitp 4 x87-exceptions-enabled))	; underflow
    47 
    +      (assert-true (logbitp 3 x87-exceptions-enabled))	; overflow
    48 
    +      (assert-true (logbitp 2 x87-exceptions-enabled)) ; divide-by-zero
    49 
    +      (assert-false (logbitp 1 x87-exceptions-enabled))	; denormal
    50 
    +      (assert-true (logbitp 0 x87-exceptions-enabled))	; invalid
    51 
    +
    52 
    +      ;; Verify the rounding mode is set to zero
    53 
    +      (assert-eql :zero (car (rassoc sse2-rc x86::rounding-mode-alist)))
    54 
    +      (assert-eql :zero (car (rassoc x87-rc x86::rounding-mode-alist)))
    55 
    +
    56 
    +      ;; Verify precision for x87
    57 
    +      (assert-eql :64-bits
    58 
    +		  (car (rassoc (ldb x86::x87-float-precision-control-byte x87-modes)
    59 
    +			       x86::x87-float-precision-control-alist))))))

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.common-lisp.net. Manage all notifications · Help Notification message regarding https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/8c957e766463e0bac0d2d14886d9dd5a4c6490cd...f3a339b97669e4963762290dab3b8eb9559f550a at 1758138556