Changeset 9476


Ignore:
Timestamp:
May 14, 2008, 6:47:41 PM (11 years ago)
Author:
rme
Message:

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

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

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/ia32/level-0/X86/X8632/x8632-float.lisp

    r8214 r9476  
    401401                              :operands operands))))))
    402402
     403(defvar *rounding-mode-alist*
     404  '((:nearest . 0) (:zero . 1) (:positive . 2) (:negative . 3)))
     405
     406(defun get-fpu-mode (&optional (mode nil mode-p))
     407  (let* ((flags (%get-mxcsr-control)))
     408    (declare (fixnum flags))
     409    (let* ((rounding-mode
     410            (car (nth (+ (if (logbitp x86::mxcsr-rc0-bit flags) 1 0)
     411                         (if (logbitp x86::mxcsr-rc1-bit flags) 2 0))
     412                      *rounding-mode-alist*)))
     413           (overflow (not (logbitp x86::mxcsr-om-bit flags)))
     414           (underflow (not (logbitp x86::mxcsr-um-bit flags)))
     415           (division-by-zero (not (logbitp x86::mxcsr-zm-bit flags)))
     416           (invalid (not (logbitp x86::mxcsr-im-bit flags)))
     417           (inexact (not (logbitp x86::mxcsr-pm-bit flags))))
     418    (if mode-p
     419      (ecase mode
     420        (:rounding-mode rounding-mode)
     421        (:overflow overflow)
     422        (:underflow underflow)
     423        (:division-by-zero division-by-zero)
     424        (:invalid invalid)
     425        (:inexact inexact))
     426      `(:rounding-mode ,rounding-mode
     427        :overflow ,overflow
     428        :underflow ,underflow
     429        :division-by-zero ,division-by-zero
     430        :invalid ,invalid
     431        :inexact ,inexact)))))
     432
     433;;; did we document this?
     434(defun set-fpu-mode (&key (rounding-mode :nearest rounding-p)
     435                          (overflow t overflow-p)
     436                          (underflow t underflow-p)
     437                          (division-by-zero t zero-p)
     438                          (invalid t invalid-p)
     439                          (inexact t inexact-p))
     440  (let* ((current (%get-mxcsr-control))
     441         (new current))
     442    (declare (fixnum current new))
     443    (when rounding-p
     444      (let* ((rc-bits (or
     445                       (cdr (assoc rounding-mode *rounding-mode-alist*))
     446                       (error "Unknown rounding mode: ~s" rounding-mode))))
     447        (declare (fixnum rc-bits))
     448        (if (logbitp 0 rc-bits)
     449          (bitsetf x86::mxcsr-rc0-bit new)
     450          (bitclrf x86::mxcsr-rc0-bit new))
     451        (if (logbitp 1 rc-bits)
     452          (bitsetf x86::mxcsr-rc1-bit new)
     453          (bitclrf x86::mxcsr-rc1-bit new))))
     454    (when invalid-p
     455      (if invalid
     456        (bitclrf x86::mxcsr-im-bit new)
     457        (bitsetf x86::mxcsr-im-bit new)))
     458    (when overflow-p
     459      (if overflow
     460        (bitclrf x86::mxcsr-om-bit new)
     461        (bitsetf x86::mxcsr-om-bit new)))
     462    (when underflow-p
     463      (if underflow
     464        (bitclrf x86::mxcsr-um-bit new)
     465        (bitsetf x86::mxcsr-um-bit new)))
     466    (when zero-p
     467      (if division-by-zero
     468        (bitclrf x86::mxcsr-zm-bit new)
     469        (bitsetf x86::mxcsr-zm-bit new)))
     470    (when inexact-p
     471      (if inexact
     472        (bitclrf x86::mxcsr-pm-bit new)
     473        (bitsetf x86::mxcsr-pm-bit new)))
     474    (unless (= current new)
     475      (%set-mxcsr-control new))
     476    (%get-mxcsr)))
     477
    403478;;; end duplicated code
    404479
Note: See TracChangeset for help on using the changeset viewer.