Changeset 7179


Ignore:
Timestamp:
Sep 7, 2007, 11:25:59 AM (12 years ago)
Author:
gb
Message:

x8664 support for new stack-walking stuff.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0709/ccl/lib/x86-backtrace.lisp

    r6920 r7179  
    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              (setf (oldest-binding-frame-value context addr) new)
     116              (setf (%fixnum-ref addr) new))))))))
     117
    97118(defun %stack< (index1 index2 &optional context)
    98119  (let* ((tcr (if context (bt.tcr context) (%current-tcr)))
     
    153174    (get-register-value nil last-catch index)))
    154175
     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
    155202;;; Used for printing only.
    156203(defun index->address (p)
Note: See TracChangeset for help on using the changeset viewer.