Raymond Toy pushed to branch issue-425-correctly-rounded-math-functions-single-float at cmucl / cmucl Commits: 9624af73 by Raymond Toy at 2026-02-04T08:58:21-08:00 Remove extraneous blank line [skip-ci] - - - - - d88b905f by Raymond Toy at 2026-02-04T09:02:57-08:00 Clean up more merge mistakes Remove these extra stuff that were moved in the master branch are no longer exist in these files. - - - - - 3 changed files: - src/code/float-trap.lisp - src/compiler/x86/float-sse2.lisp - src/compiler/x86/sse2-c-call.lisp Changes: ===================================== src/code/float-trap.lisp ===================================== @@ -109,7 +109,6 @@ (ash x87-enables 7)))) final-mode)) - (defun (setf floating-point-modes) (new-mode) (declare (type (unsigned-byte 32) new-mode)) ;; Set the floating point modes for both X87 and SSE2. This ===================================== 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/compiler/x86/sse2-c-call.lisp ===================================== @@ -36,12 +36,6 @@ :from :eval :to :result) edx) (:temporary (:sc single-stack) temp-single) (:temporary (:sc double-stack) temp-double) - #+core-math - (:temporary (:sc unsigned-stack) save-fpu-cw) - #+core-math - (:temporary (:sc unsigned-stack) fpu-cw) - #+core-math - (:temporary (:sc unsigned-reg :offset esi-offset) temp-cw) (:node-var node) (:vop-var vop) (:save-p t) @@ -69,10 +63,7 @@ (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))))) - ;; Restore the x87 FPU control settings - #+(and nil core-math) - (inst fldcw save-fpu-cw))) + (inst movsd xmm0-tn (ea-for-df-stack temp-double))))))) (define-vop (alloc-number-stack-space) (:info amount) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/4573ff8693fdf746579781b... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/4573ff8693fdf746579781b... You're receiving this email because of your account on gitlab.common-lisp.net.