Changeset 7416 for branches/working-0710


Ignore:
Timestamp:
Oct 12, 2007, 9:51:48 AM (12 years ago)
Author:
gb
Message:

Low-level stack-frame/register setting stuff.

Location:
branches/working-0710/ccl/lib
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0710/ccl/lib/ppc-backtrace.lisp

    r6925 r7416  
    250250    (get-register-value nil last-catch index)))
    251251
     252(defun %set-register-argument-value (context cfp regval new)
     253  (let* ((last-catch (last-catch-since cfp context))
     254         (index (register-number->saved-register-index regval)))
     255    (do* ((frame cfp
     256                 (child-frame frame context))
     257          (first t))
     258         ((null frame))
     259      (if (fake-stack-frame-p frame)
     260        (return-from %set-register-argument-value
     261          (setf (xp-gpr-lisp (%fake-stack-frame.xp frame) regval) new))
     262        (if first
     263          (setq first nil)
     264          (multiple-value-bind (lfun pc)
     265              (cfp-lfun frame)
     266            (when lfun
     267              (multiple-value-bind (mask where)
     268                  (registers-used-by lfun pc)
     269                (when (if mask (logbitp index mask))
     270                  (incf where (logcount (logandc2 mask (1- (ash 1 (1+ index))))))
     271                  (return-from
     272                   %set-register-argument-value
     273                    (raw-frame-set frame context where new)))))))))
     274    (set-register-value new nil last-catch index)))
     275
    252276(defun %raw-frame-ref (cfp context idx bad)
    253277  (declare (fixnum idx))
     
    273297        bad))))
    274298
     299(defun %raw-frame-set (cfp context idx new)
     300  (declare (fixnum idx))
     301  (multiple-value-bind (frame base)
     302      (vsp-limits cfp context)
     303    (let* ((raw-size (- base frame)))
     304      (declare (fixnum frame base raw-size))
     305      (if (and (>= idx 0)
     306               (< idx raw-size))
     307        (let* ((addr (- (the fixnum (1- base))
     308                        idx)))
     309          (multiple-value-bind (db-count first-db last-db)
     310              (count-db-links-in-frame frame base context)
     311            (let* ((is-db-link
     312                    (unless (zerop db-count)
     313                      (do* ((last last-db (previous-db-link last first-db)))
     314                           ((null last))
     315                        (when (= addr last)
     316                          (return t))))))
     317              (if is-db-link
     318                (setf (oldest-binding-frame-value context addr) new)
     319                (setf (%fixnum-ref addr) new))))
     320          t)))))
     321
    275322;;; Used for printing only.
    276323(defun index->address (p)
  • branches/working-0710/ccl/lib/x86-backtrace.lisp

    r7224 r7416  
    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.