Changeset 7224


Ignore:
Timestamp:
Sep 15, 2007, 9:38:05 AM (12 years ago)
Author:
gb
Message:

Revert to older version.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/lib/x86-backtrace.lisp

    r7206 r7224  
    9595      bad)))
    9696
    97 (defun %raw-frame-set (frame context idx new)
    98   (declare (fixnum frame idx))
    99   (let* ((base (parent-frame frame context))
    100          (raw-size (- base frame)))
    101     (declare (fixnum base raw-size))
    102     (if (and (>= idx 0)
    103              (< idx raw-size))
    104       (let* ((addr (- (the fixnum (1- base))
    105                       idx)))
    106         (multiple-value-bind (db-count first-db last-db)
    107             (count-db-links-in-frame frame base context)
    108           (let* ((is-db-link
    109                   (unless (zerop db-count)
    110                     (do* ((last last-db (previous-db-link last first-db)))
    111                          ((null last))
    112                       (when (= addr last)
    113                         (return t))))))
    114             (if is-db-link
    115               (oldest-binding-frame-value context addr)
    116               (setf (%fixnum-ref addr) new))))))))
    117 
    11897(defun %stack< (index1 index2 &optional context)
    11998  (let* ((tcr (if context (bt.tcr context) (%current-tcr)))
     
    174153    (get-register-value nil last-catch index)))
    175154
    176 (defun %set-register-argument-value (context cfp regval new)
    177   (let* ((last-catch (last-catch-since cfp context))
    178          (index (register-number->saved-register-index regval)))
    179     (do* ((frame cfp (child-frame frame context))
    180           (first t))
    181          ((null frame))
    182       (if (xcf-p frame)
    183         (with-macptrs (xp)
    184           (%setf-macptr-to-object xp (%fixnum-ref frame x8664::xcf.xp))
    185           (return-from %set-register-argument-value
    186             (setf (encoded-gpr-lisp xp regval) new)))
    187         (progn
    188           (unless first
    189             (multiple-value-bind (lfun pc)
    190                 (cfp-lfun frame)
    191               (when lfun
    192                 (multiple-value-bind (mask where)
    193                     (registers-used-by lfun pc)
    194                   (when (if mask (logbitp index mask))
    195                     (incf where (logcount (logandc2 mask (1- (ash 1 (1+ index))))))
    196 
    197                     (return-from %set-register-argument-value
    198                       (raw-frame-set frame context where new)))))))
    199           (setq first nil))))
    200     (set-register-value new nil last-catch index)))
    201 
    202155;;; Used for printing only.
    203156(defun index->address (p)
Note: See TracChangeset for help on using the changeset viewer.