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

Commits:

• 70542bd9
  by Raymond Toy at 2025-08-07T17:10:40-07:00

  The float-modes type is a 30 bit unsigned byte
  
  Since we use a single 32-bit word to set the x87 FP modes, we need at
  least 30 bits because the top 2 bits are reserved so they shouldn't be
  set.  This is because the control word is in the top 16 bits.
  Previously, the float-modes type was an (unsigned-byte 24), which is
  too small now.
  

• 5edb2d90
  by Raymond Toy at 2025-08-08T06:49:06-07:00

  Fix #426:  Define float-modes type correctly
  
  The definition of `float-modes` is `(unsigned-byte 24)`.  This is too
  small if we are trying to set the precision control field for x87 via
  `(setf (x86::x87-floating-point-modes) ...)`.
  
  The field needs to be at least 30 bits to that we can assign values
  for the x87 control and status words.  Thus, set the type to
  `(unsigned-byte 32)`.
  

• 387ed142
  by Raymond Toy at 2025-08-08T07:11:42-07:00

  Add test for (setf (x86::x87-floating-point-modes))
  

• 4d1f287c
  by Raymond Toy at 2025-08-08T18:29:40-07:00

  Merge branch 'issue-426-fix-float-modes-type-def' into issue-425-correctly-rounded-math-functions
  

• 84ee222f
  by Raymond Toy at 2025-08-08T19:59:15-07:00

  lisp.a needs to have the core math routines too.
  

• f47f8f07
  by Raymond Toy at 2025-08-08T20:00:17-07:00

  Set the x87 precision to double when calling out to C
  
  When we call out to C, we save the x87 FPU control word.  Then update
  the FPU control to have the precision set to double (53-bit)
  precision.  This is needed for the core-math routines that depend on
  the x87 precision control to be double.
  
  When the function returns, we restore the original x87 control word.
  

4 changed files:

• src/compiler/x86/float-sse2.lisp
• src/compiler/x86/sse2-c-call.lisp
• src/lisp/GNUmakefile
• tests/float.lisp

Changes:

 ;;;; Float mode hackery:

-(deftype float-modes () '(unsigned-byte 24))

+(deftype float-modes () '(unsigned-byte 30))

 ;; For the record, here is the format of the MXCSR register.

 ;;

 		   :from :eval :to :result) edx)

   (:temporary (:sc single-stack) temp-single)

   (:temporary (:sc double-stack) temp-double)

+  (:temporary (:sc unsigned-stack) save-fpu-cw)

+  (:temporary (:sc unsigned-stack) fpu-cw)

   (:node-var node)

   (:vop-var vop)

   (:save-p t)

-  (:ignore args ecx edx)

+  (:ignore args ecx #+nil edx)

   (:guard (backend-featurep :sse2))

-  (:generator 0 

+  (:generator 0

+    ;; Save the x87 FPU control word.  Then modify it to set the

+    ;; precision bits to double (2).

+    (inst fnstcw save-fpu-cw)

+    (move edx save-fpu-cw)

+    (inst and edx (dpb 0 (byte 2 8) #xffff))	; Zap the precision control bits

+    (inst or edx (dpb 2 (byte 2 8) 0))		; Set precision control to double

+    (move fpu-cw edx)

+    (inst fldcw fpu-cw)			; New CW

+

     (cond ((policy node (> space speed))

 	   (move eax function)

 	   (inst call (make-fixup (extern-alien-name "call_into_c") :foreign)))

 	 (inst movss xmm0-tn (ea-for-sf-stack temp-single)))

 	(double-reg

 	 (inst fstpd (ea-for-df-stack temp-double))

-	 (inst movsd xmm0-tn (ea-for-df-stack temp-double)))))))

+	 (inst movsd xmm0-tn (ea-for-df-stack temp-double)))))

+    ;; Restore the x87 FPU control settings

+    (inst fldcw save-fpu-cw)))

 (define-vop (alloc-number-stack-space)

   (:info amount)

 # 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} ${CORE64_OBJS} ${EXEC_FINAL_OBJ}

-	$(AR) crs lisp.a ${OBJS} version.o

+	$(AR) crs lisp.a ${OBJS} ${CORE64_OBJS} version.o

 ifneq (${EXEC_FINAL_OBJ},)

 	$(AR) d lisp.a exec-init.o

 endif

                                        (declare (ignore c))

                                        (values (invoke-restart 'lisp::largest-float)))))

                       (read-from-string string))))))

+

+#+x86

+(define-test x87-set-floating-point-modes

+    (:tag :issues)

+  (let ((new-mode (setf (x86::x87-floating-point-modes)

+			(dpb 2 (byte 2 24)

+			     (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))))

+