Changeset 7227


Ignore:
Timestamp:
Sep 16, 2007, 4:04:33 AM (12 years ago)
Author:
gb
Message:

Frame assignment stuff for PPC, too.

File:
1 edited

Legend:

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

    r6925 r7227  
    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)
Note: See TracChangeset for help on using the changeset viewer.