Changeset 9384


Ignore:
Timestamp:
May 6, 2008, 5:42:50 PM (11 years ago)
Author:
rme
Message:

%xerr-disp for x8632; probably buggy.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/ia32/level-1/x86-error-signal.lisp

    r6558 r9384  
    6060    (setf (encoded-gpr-lisp xp x8664::arg_z) values
    6161          (encoded-gpr-lisp xp x8664::fn) f)))
    62  
     62
     63#+x8664-target
    6364(defcallback %xerr-disp (:address xp :address xcf :int)
    6465  (with-error-reentry-detection
     
    222223          skip))))
    223224
    224 
    225          
     225;;; lots of duplicated code here
     226#+x8632-target
     227(defcallback %xerr-disp (:address xp :address xcf :int)
     228  (with-error-reentry-detection
     229      (let* ((frame-ptr (macptr->fixnum xcf))
     230             (fn (%get-object xcf x8632::xcf.nominal-function))
     231             (op0 (%get-xcf-byte xcf 0))
     232             (op1 (%get-xcf-byte xcf 1))
     233             (op2 (%get-xcf-byte xcf 2)))
     234        (declare (type (unsigned-byte 8) op0 op1 op2))
     235        (let* ((skip 2))
     236          (if (and (= op0 #xcd)
     237                   (>= op1 #x70))
     238            (cond ((< op1 #x90)
     239                   (setq skip 3)
     240                   (setq *error-reentry-count* 0)
     241                   (setf (encoded-gpr-lisp xp (ldb (byte 4 0) op1))
     242                         (%slot-unbound-trap
     243                          (encoded-gpr-lisp xp (ldb (byte 4 4) op2))
     244                          (encoded-gpr-lisp xp (ldb (byte 4 0) op2))
     245                          frame-ptr)))
     246                  ((< op1 #xa0)
     247                   ;; #x9x - register X is a symbol.  It's unbound.
     248                   (%kernel-restart-internal $xvunbnd
     249                                             (list
     250                                              (encoded-gpr-lisp
     251                                               xp
     252                                               (ldb (byte 4 0) op1)))
     253                                             frame-ptr))
     254                  ((< op1 #xb0)
     255                   (%err-disp-internal $xfunbnd
     256                                       (list (encoded-gpr-lisp
     257                                              xp
     258                                              (ldb (byte 4 0) op1)))
     259                                       frame-ptr))
     260                  ((< op1 #xc0)
     261                   (setq skip 3)
     262                   (%err-disp-internal
     263                    #.(car (rassoc 'type-error *kernel-simple-error-classes*))
     264                    (list (encoded-gpr-lisp
     265                           xp
     266                           (ldb (byte 4 0) op1))
     267                          (logandc2 op2 arch::error-type-error))
     268                    frame-ptr))
     269                  ((= op1 #xc0)
     270                   (%error 'too-few-arguments
     271                           (list :nargs (xp-argument-count xp)
     272                                 :fn fn)
     273                           frame-ptr))
     274                  ((= op1 #xc1)
     275                   (%error 'too-many-arguments
     276                           (list :nargs (xp-argument-count xp)
     277                                 :fn fn)
     278                           frame-ptr))
     279                  ((= op1 #xc2)
     280                   (let* ((flags (xp-flags-register xp))
     281                          (nargs (xp-argument-count xp))
     282                          (carry-bit (logbitp x86::x86-carry-flag-bit flags)))
     283                     (if carry-bit
     284                       (%error 'too-few-arguments
     285                               (list :nargs nargs
     286                                     :fn fn)
     287                               frame-ptr)
     288                       (%error 'too-many-arguments
     289                               (list :nargs nargs
     290                                     :fn fn)
     291                               frame-ptr))))
     292                  ((= op1 #xc3)         ;array rank
     293                   (%err-disp-internal $XNDIMS
     294                                       (list (encoded-gpr-lisp xp (ldb (byte 4 4) op2))
     295                                             (encoded-gpr-lisp xp (ldb (byte 4 0) op2)))
     296                                       frame-ptr))
     297                  ((= op1 #xc6)
     298                   (%error (make-condition 'type-error
     299                                           :datum (encoded-gpr-lisp xp x8632::temp0)
     300                                           :expected-type '(or symbol function)
     301                                           :format-control
     302                                           "~S is not of type ~S, and can't be FUNCALLed or APPLYed")
     303                           nil frame-ptr))
     304                  ((= op1 #xc7)
     305                   (handle-udf-call xp frame-ptr)
     306                   (setq skip 0))
     307                  ((or (= op1 #xc8) (= op1 #xcb))
     308                   (setq skip 3)
     309                   (%error (%rsc-string $xarroob)
     310                           (list (encoded-gpr-lisp xp (ldb (byte 4 4) op2))
     311                                 (encoded-gpr-lisp xp (ldb (byte 4 0) op2)))
     312                           frame-ptr))
     313                  ((= op1 #xc9)
     314                   (%err-disp-internal $xnotfun
     315                                       (list (encoded-gpr-lisp xp x8632::temp0))
     316                                       frame-ptr))
     317                  ;; #xca = uuo-error-debug-trap
     318                  ((= op1 #xcc)
     319                   ;; external entry point or foreign variable
     320                   (setq skip 3)
     321                   (let* ((eep-or-fv (encoded-gpr-lisp xp (ldb (byte 4 4) op2))))
     322                     (etypecase eep-or-fv
     323                       (external-entry-point
     324                        (resolve-eep eep-or-fv)
     325                        (setf (encoded-gpr-lisp xp (ldb (byte 4 0) op2))
     326                              (eep.address eep-or-fv)))
     327                       (foreign-variable
     328                        (resolve-foreign-variable eep-or-fv)
     329                        (setf (encoded-gpr-lisp xp (ldb (byte 4 0) op2))
     330                              (fv.addr eep-or-fv))))))
     331                  ((< op1 #xe0)
     332                   (setq skip 3)
     333                   (if (= op2 x8632::subtag-catch-frame)
     334                     (%error (make-condition 'cant-throw-error
     335                                             :tag (encoded-gpr-lisp
     336                                                   xp
     337                                                   (ldb (byte 4 0) op1)))
     338                             nil frame-ptr)
     339                     (let* ((typename
     340                             (cond ((= op2 x8632::tag-fixnum) 'fixnum)
     341                                   ((= op2 x8632::subtag-character) 'character)
     342                                   ((= op2 x8632::fulltag-cons) 'cons)
     343                                   ((= op2 x8632::tag-misc) 'uvector)
     344                                   (t (let* ((class (logand op2 x8632::fulltagmask))
     345                                             (high5 (ash op2 (- x8632::ntagbits))))
     346                                        (cond ((= class x8632::fulltag-nodeheader)
     347                                               (svref *nodeheader-types* high5))
     348                                              ((= class x8632::fulltag-immheader)
     349                                               (svref *immheader-types* high5))
     350                                              (t (list 'bogus op2))))))))
     351                       (%error (make-condition 'type-error
     352                                               :datum (encoded-gpr-lisp
     353                                                       xp
     354                                                       (ldb (byte 4 0) op1))
     355                                               :expected-type typename)
     356                               nil
     357                               frame-ptr))))
     358                  ((< op1 #xf0)
     359                   (%error (make-condition 'type-error
     360                                           :datum (encoded-gpr-lisp
     361                                                   xp
     362                                                   (ldb (byte 4 0) op1))
     363                                           :expected-type 'list)
     364                           nil
     365                           frame-ptr))
     366                  (t
     367                   (%error (make-condition 'type-error
     368                                           :datum (encoded-gpr-lisp
     369                                                   xp
     370                                                   (ldb (byte 4 0) op1))
     371                                           :expected-type 'fixnum)
     372                           nil
     373                           frame-ptr)))
     374            (%error "Unknown trap: #x~x~%xp=~s"
     375                    (list (list op0 op1 op2) xp)
     376                    frame-ptr))
     377          skip))))
    226378                 
    227                  
    228                
    229                
    230                  
    231 
    232 
    233 
    234 
    235 
    236                    
    237                
    238            
Note: See TracChangeset for help on using the changeset viewer.