Changeset 8014


Ignore:
Timestamp:
Jan 8, 2008, 5:43:40 AM (12 years ago)
Author:
gb
Message:

Add a STATUS slot to ARITHMETIC-ERROR, with reader
CCL::ARITHMETIC-ERROR-STATUS.

Define xp-mxcsr for all current x86-64 platforms; use it to access
the mxcsr on an exception which generates an ARITHMETIC-ERROR, and
initialize that ARITHMETIC-ERROR's status slot to the mxcsr value.

Location:
trunk/ccl/level-1
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/level-1/l1-error-system.lisp

    r7885 r8014  
    439439(define-condition arithmetic-error (error)
    440440  ((operation :initform nil :initarg :operation :reader arithmetic-error-operation)
    441    (operands :initform nil :initarg :operands :reader arithmetic-error-operands))
    442   (:report (lambda (c s) (format s "~S detected ~&performing ~S on ~:S"
    443                                  (type-of c)
    444                                  (arithmetic-error-operation c)
    445                                  (arithmetic-error-operands c)))))
     441   (operands :initform nil :initarg :operands :reader arithmetic-error-operands)
     442   (status :initform nil :initarg :status :reader arithmetic-error-status))
     443  (:report (lambda (c s)
     444             (format s "~S detected "
     445                     (type-of c))
     446             (let* ((operands (arithmetic-error-operands c)))
     447               (when operands
     448                 (format s "~&performing ~S on ~:S"
     449                         (arithmetic-error-operation c)
     450                         operands))))))
    446451
    447452(define-condition division-by-zero (arithmetic-error))
  • trunk/ccl/level-1/x86-trap-support.lisp

    r6270 r8014  
    2929  (defconstant flags-register-offset #$REG_EFL)
    3030  (defconstant rip-register-offset #$REG_RIP)
     31  (defun xp-mxcsr (xp)
     32    (pref x :ucontext.uc_mcontext.fpregs.mxcsr))
    3133  (defparameter *encoded-gpr-to-indexed-gpr*
    3234    #(13                                ;rax
     
    5456  (defconstant flags-register-offset 22)
    5557  (defconstant rip-register-offset 20)
     58  (defun xp-mxcsr (xp)
     59    (with-macptrs ((state (pref xp :__ucontext.uc_mcontext.mc_fpstate)))
     60      (pref state :savefpu.sv_env.en_mxcsr)))
    5661  (defparameter *encoded-gpr-to-indexed-gpr*
    5762    #(7                                 ;rax
     
    97102                 (:uc_mcsize (:unsigned 64))
    98103                 (:uc_mcontext64 (:* (:struct :portable_mcontext64))))))
     104  (defun xp-mxcsr (xp)
     105    (%get-unsigned-long
     106     (pref (pref xp :portable_ucontext64.uc_mcontext64) :portable_mcontext64.fs) 32))
    99107  (defconstant gp-regs-offset 0)
    100108  (defmacro xp-gp-regs (xp)
     
    182190           (multiple-value-bind (operation operands)
    183191               (decode-arithmetic-error xp xcf)
     192             
    184193             (let* ((condition-name
    185194                     (cond ((or (= code #$FPE_INTDIV)
     
    196205               (%error (make-condition condition-name
    197206                                       :operation operation
    198                                        :operands operands)
     207                                       :operands operands
     208                                       :status (xp-mxcsr xp))
    199209                       ()
    200210                       frame-ptr))))
Note: See TracChangeset for help on using the changeset viewer.