Raymond Toy pushed to branch master at cmucl / cmucl

Commits:

10 changed files:

Changes:

  • .gitlab-ci.yml
    ... ... @@ -4,7 +4,7 @@ variables:
    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"
    7 
    -  bootstrap: ""
    7 
    +  bootstrap: "-B boot-2025-07"
    8 8
    9 9 
     # Default install configuration to download the cmucl tarballs to use
    10 10 
     # for building.

  • src/bootfiles/21e/boot-2025-07.lisp
    1 
    +;; Bootstrap file to define some constants we use early in the build.
    2 
    +
    3 
    +(in-package :x86)
    4 
    +
    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
    19 
    +  `((:24-bits . 0)
    20 
    +    (:reserved . 1)
    21 
    +    (:53-bits . 2)
    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 
    +

  • src/code/float-trap.lisp
    ... ... @@ -114,21 +114,24 @@
    114 114 
         ;; Set the floating point modes for both X87 and SSE2.  This
    115 115 
         ;; include the rounding control bits.
    116 116 
         (let* ((rc (ldb float-rounding-mode new-mode))
    117 
    -	   (new-exceptions (logand #x3f new-mode))
    118 
    -	   (new-enables (logand #x3f (ash new-mode -7)))
    119 
    -	   (x87-modes
    120 
    -	    (logior new-exceptions
    121 
    -		    (ash rc 10)
    122 
    -		    (ash new-enables 16)
    123 
    -		    ;; Set precision control to be 64-bit, always.  We
    124 
    -		    ;; don't use the x87 registers with sse2, so this
    125 
    -		    ;; is ok and would be the correct setting if we
    126 
    -		    ;; ever support long-floats.
    127 
    -		    (ash 3 (+ 8 16)))))
    128 
    -      (setf (vm::sse2-floating-point-modes) (ldb (byte 24 0) new-mode))
    129 
    -      (setf (vm::x87-floating-point-modes) (ldb (byte 24 0) x87-modes)))
    130 
    -    new-mode)
    131 
    -  )
    117 
    +	   (new-exceptions (ldb float-exceptions-byte new-mode))
    118 
    +	   (new-enables (ldb float-traps-byte new-mode))
    119 
    +	   (x87-modes 0))
    120 
    +      ;; From the new mode, update the x87 FPU mode with the same set
    121 
    +      ;; of accrued exceptions, enabled exceptions, and rounding mode.
    122 
    +      (setf x87-modes (dpb new-exceptions float-exceptions-byte x87-modes))
    123 
    +      (setf x87-modes (dpb new-enables x87-float-traps-byte x87-modes))
    124 
    +      (setf x87-modes (dpb rc x87-float-rounding-mode x87-modes))
    125 
    +
    126 
    +      ;; Set precision to 64-bits (double-extended).
    127 
    +      (setf x87-modes
    128 
    +	    (dpb (cdr (assoc :64-bits x87-float-precision-control-alist))
    129 
    +		 x87-float-precision-control-byte
    130 
    +		 x87-modes))
    131 
    +
    132 
    +      (setf (vm::sse2-floating-point-modes) (ldb (byte 16 0) new-mode))
    133 
    +      (setf (vm::x87-floating-point-modes) (ldb (byte 30 0) x87-modes)))
    134 
    +    new-mode))
    132 135
    133 136 
     #+(and sse2 darwin)
    134 137 
     (progn

  • 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/compiler/x86/float-sse2.lisp
    ... ... @@ -1288,6 +1288,10 @@
    1288 1288 
     ;;  0         invalid operation flag
    1289 1289 
     ;;
    1290 1290 
     ;; See below for rounding control
    1291 
    +;;
    1292 
    +;; Also see float-rounding-mode, float-sticky-bits, float-traps-byte,
    1293 
    +;; and float-exceptions-byte in compiler/x86/parms.lisp.
    1294 
    +
    1291 1295 
     (defknown sse2-floating-point-modes () float-modes (flushable))
    1292 1296 
     (defknown ((setf sse2-floating-point-modes)) (float-modes) float-modes)
    1293 1297

  • src/compiler/x86/parms.lisp
    ... ... @@ -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

  • src/general-info/release-21f.md
    ... ... @@ -139,6 +139,7 @@ public domain.
    139 139 
           package-local-nicknames)
    140 140 
         * #424 Use fdlibm `hypot` to fix bug in snapshot 2025-07
    141 141 
         * #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`
    142 143 
       * Other changes:
    143 144 
       * Improvements to the PCL implementation of CLOS:
    144 145 
       * 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 ""
    ... ... @@ -136,6 +168,23 @@ msgstr ""
    136 168 
     msgid "Maximum number of bits in a positive fixnum"
    137 169 
     msgstr ""
    138 170
    171 
    +#: src/compiler/x86/parms.lisp
    172 
    +msgid ""
    173 
    +"The bits in the FP mode that hold the accrued exceptions that have\n"
    174 
    +" occurred since the bits were reset."
    175 
    +msgstr ""
    176 
    +
    177 
    +#: src/compiler/x86/parms.lisp
    178 
    +msgid "The bits in the FP mode that hold FP exceptions that are enabled."
    179 
    +msgstr ""
    180 
    +
    181 
    +#: src/compiler/x86/parms.lisp
    182 
    +msgid ""
    183 
    +"The bits in the FP mode that hold the current exception.  However\n"
    184 
    +" for x86, there aren't separate bits for this, so we use the stick\n"
    185 
    +" bits from the accrued exceptions"
    186 
    +msgstr ""
    187 
    +
    139 188 
     #: src/compiler/x86/vm.lisp
    140 189 
     msgid "Redefining SC number ~D from ~S to ~S."
    141 190 
     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))))))

  • tests/float.lisp
    ... ... @@ -342,4 +342,3 @@
    342 342 
     			     (x86::x87-floating-point-modes)))))
    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 
    -

    • —
    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/c65554a544fc86c05e0f0ff9aa3b8099d1d6a073...7ab74e1351115d5435a495fac4ff404ea6d7443b at 1757084120