Changeset 7856


Ignore:
Timestamp:
Dec 9, 2007, 1:48:42 PM (13 years ago)
Author:
gb
Message:

If the byte following a UUO is 0, update the xcf's relative PC from
the (32-bit) word preceding the current rpc (address of UUO. and
prepare to tell the kernel that we skipped -1 bytes (to indicate
that it should set the real PC based on the updated relative PC.

Location:
branches/working-0711/ccl/level-1
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/level-1/x86-error-signal.lisp

    r7795 r7856  
    7373                   (>= op1 #x70))
    7474            (cond ((< op1 #x90)
    75                    (setq skip 3)
     75                   (setq skip (%check-anchored-uuo xcf 3))
    7676                   (setq *error-reentry-count* 0)
    7777                   (setf (encoded-gpr-lisp xp (ldb (byte 4 0) op1))
     
    8181                          frame-ptr)))
    8282                  ((< op1 #xa0)
     83                   (setq skip (%check-anchored-uuo xcf 2))
    8384                   ;; #x9x - register X is a symbol.  It's unbound.
    8485                   (%kernel-restart-internal $xvunbnd
     
    8990                                             frame-ptr))
    9091                  ((< op1 #xb0)
     92                   (setq skip (%check-anchored-uuo xcf 2))
    9193                   (%err-disp-internal $xfunbnd
    9294                                       (list (encoded-gpr-lisp
     
    9597                                       frame-ptr))
    9698                  ((< op1 #xc0)
    97                    (setq skip 3)
     99                   (setq skip (%check-anchored-uuo skip 3))
    98100                   (%err-disp-internal
    99101                    #.(car (rassoc 'type-error *kernel-simple-error-classes*))
     
    104106                    frame-ptr))
    105107                  ((= op1 #xc0)
     108                   (setq skip (%check-anchored-uuo xcf 2))
    106109                   (%error 'too-few-arguments
    107110                           (list :nargs (xp-argument-count xp)
     
    109112                           frame-ptr))
    110113                  ((= op1 #xc1)
     114                   (setq skip (%check-anchored-uuo xcf 2))
    111115                   (%error 'too-many-arguments
    112116                           (list :nargs (xp-argument-count xp)
     
    114118                           frame-ptr))
    115119                  ((= op1 #xc2)
     120                   (setq skip (%check-anchored-uuo xcf 2))
    116121                   (let* ((flags (xp-flags-register xp))
    117122                          (nargs (xp-argument-count xp))
     
    127132                               frame-ptr))))
    128133                  ((= op1 #xc3)         ;array rank
     134                   (setq skip (%check-anchored-uuo xcf 3))                   
    129135                   (%err-disp-internal $XNDIMS
    130136                                       (list (encoded-gpr-lisp xp (ldb (byte 4 4) op2))
     
    132138                                       frame-ptr))
    133139                  ((= op1 #xc6)
     140                   (setq skip (%check-anchored-uuo xcf 2))
    134141                   (%error (make-condition 'type-error
    135142                                           :datum (encoded-gpr-lisp xp x8664::temp0)
     
    142149                   (setq skip 0))
    143150                  ((or (= op1 #xc8) (= op1 #xcb))
    144                    (setq skip 3)
     151                   (setq skip (%check-anchored-uuo xcf 3))
    145152                   (%error (%rsc-string $xarroob)
    146153                           (list (encoded-gpr-lisp xp (ldb (byte 4 4) op2))
     
    148155                           frame-ptr))
    149156                  ((= op1 #xc9)
     157                   (setq skip (%check-anchored-uuo xcf 2))
    150158                   (%err-disp-internal $xnotfun
    151159                                       (list (encoded-gpr-lisp xp x8664::temp0))
     
    154162                  ((= op1 #xcc)
    155163                   ;; external entry point or foreign variable
    156                    (setq skip 3)
     164                   (setq skip (%check-anchored-uuo xcf 3))
    157165                   (let* ((eep-or-fv (encoded-gpr-lisp xp (ldb (byte 4 4) op2))))
    158166                     (etypecase eep-or-fv
     
    166174                              (fv.addr eep-or-fv))))))
    167175                  ((< op1 #xe0)
    168                    (setq skip 3)
     176                   (setq skip (%check-anchored-uuo xcf 3))
    169177                   (if (= op2 x8664::subtag-catch-frame)
    170178                     (%error (make-condition 'cant-throw-error
     
    202210                               frame-ptr))))
    203211                  ((< op1 #xf0)
     212                   (setq skip (%check-anchored-uuo xcf 2))
    204213                   (%error (make-condition 'type-error
    205214                                           :datum (encoded-gpr-lisp
     
    210219                           frame-ptr))
    211220                  (t
     221                   (setq skip (%check-anchored-uuo xcf 2))
    212222                   (%error (make-condition 'type-error
    213223                                           :datum (encoded-gpr-lisp
  • branches/working-0711/ccl/level-1/x86-trap-support.lisp

    r6270 r7856  
    164164      (%get-unsigned-byte (%int-to-ptr byte-offset) delta))))
    165165
     166;;; If the byte following a uuo (which is "skip" bytes long, set
     167;;; the xcf's relative PC to the value contained in the 32-bit
     168;;; word preceding the current relative PC and return -1, else return skip.
     169(defun %check-anchored-uuo (xcf skip)
     170  (if (eql 0 (%get-xcf-byte xcf skip))
     171    (let* ((new-rpc (+ target::tag-function
     172                       (logior (ash (%get-xcf-byte xcf -1) 24)
     173                               (ash (%get-xcf-byte xcf -2) 16)
     174                               (ash (%get-xcf-byte xcf -3) 8)
     175                               (%get-xcf-byte xcf -4)))))
     176      (%set-object xcf x8664::xcf.relative-pc new-rpc)
     177      -1)
     178    skip))
     179                           
    166180                                 
    167181(defun decode-arithmetic-error (xp xcf)
Note: See TracChangeset for help on using the changeset viewer.