Changeset 9476

Timestamp:

May 14, 2008, 11:47:41 AM (17 years ago)

Author:

R. Matthew Emerson

Message:

{set,get}-fpu-mode for x8632.

Like other lisp code in this file, these should be shared with x8664.

File:

• branches/ia32/level-0/X86/X8632/x8632-float.lisp (modified) (1 diff)

branches/ia32/level-0/X86/X8632/x8632-float.lisp

@@ -401 +401 @@
                               :operands operands))))))
 
+(defvar *rounding-mode-alist*
+  '((:nearest . 0) (:zero . 1) (:positive . 2) (:negative . 3)))
+
+(defun get-fpu-mode (&optional (mode nil mode-p))
+  (let* ((flags (%get-mxcsr-control)))
+    (declare (fixnum flags))
+    (let* ((rounding-mode
+            (car (nth (+ (if (logbitp x86::mxcsr-rc0-bit flags) 1 0)
+                         (if (logbitp x86::mxcsr-rc1-bit flags) 2 0))
+                      *rounding-mode-alist*)))
+           (overflow (not (logbitp x86::mxcsr-om-bit flags)))
+           (underflow (not (logbitp x86::mxcsr-um-bit flags)))
+           (division-by-zero (not (logbitp x86::mxcsr-zm-bit flags)))
+           (invalid (not (logbitp x86::mxcsr-im-bit flags)))
+           (inexact (not (logbitp x86::mxcsr-pm-bit flags))))
+    (if mode-p
+      (ecase mode
+        (:rounding-mode rounding-mode)
+        (:overflow overflow)
+        (:underflow underflow)
+        (:division-by-zero division-by-zero)
+        (:invalid invalid)
+        (:inexact inexact))
+      `(:rounding-mode ,rounding-mode
+        :overflow ,overflow
+        :underflow ,underflow
+        :division-by-zero ,division-by-zero
+        :invalid ,invalid
+        :inexact ,inexact)))))
+
+;;; did we document this?
+(defun set-fpu-mode (&key (rounding-mode :nearest rounding-p)
+                          (overflow t overflow-p)
+                          (underflow t underflow-p)
+                          (division-by-zero t zero-p)
+                          (invalid t invalid-p)
+                          (inexact t inexact-p))
+  (let* ((current (%get-mxcsr-control))
+         (new current))
+    (declare (fixnum current new))
+    (when rounding-p
+      (let* ((rc-bits (or
+                       (cdr (assoc rounding-mode *rounding-mode-alist*))
+                       (error "Unknown rounding mode: ~s" rounding-mode))))
+        (declare (fixnum rc-bits))
+        (if (logbitp 0 rc-bits)
+          (bitsetf x86::mxcsr-rc0-bit new)
+          (bitclrf x86::mxcsr-rc0-bit new))
+        (if (logbitp 1 rc-bits)
+          (bitsetf x86::mxcsr-rc1-bit new)
+          (bitclrf x86::mxcsr-rc1-bit new))))
+    (when invalid-p
+      (if invalid
+        (bitclrf x86::mxcsr-im-bit new)
+        (bitsetf x86::mxcsr-im-bit new)))
+    (when overflow-p
+      (if overflow
+        (bitclrf x86::mxcsr-om-bit new)
+        (bitsetf x86::mxcsr-om-bit new)))
+    (when underflow-p
+      (if underflow
+        (bitclrf x86::mxcsr-um-bit new)
+        (bitsetf x86::mxcsr-um-bit new)))
+    (when zero-p
+      (if division-by-zero
+        (bitclrf x86::mxcsr-zm-bit new)
+        (bitsetf x86::mxcsr-zm-bit new)))
+    (when inexact-p
+      (if inexact
+        (bitclrf x86::mxcsr-pm-bit new)
+        (bitsetf x86::mxcsr-pm-bit new)))
+    (unless (= current new)
+      (%set-mxcsr-control new))
+    (%get-mxcsr)))
+
 ;;; end duplicated code