-

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

-

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

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