Jul 5, 2010, 4:05:59 PM (11 years ago)

More files from last commit.

arm-callback-support.lisp, arm-error-signal.lisp,
arm-trap-support.lisp,l1-boot-3.lisp: try to get basic stuff working
well enough to enable callbacks. Enable callbacks.

arm-backtrace.lisp: a little bit of platform-specific code and some
code from the PPC port, so that backtrace sort of works.

1 edited


  • branches/arm/lib/arm-backtrace.lisp

    r13918 r13922  
    3232          (return t)))
    3333      (setq catch (next-catch catch)))))
     35(defun %stack< (index1 index2 &optional context)
     36  (let* ((tcr (if context (bt.tcr context) (%current-tcr)))
     37         (cs-area (%fixnum-ref tcr target::tcr.cs-area)))
     38    (and (%ptr-in-area-p index1 cs-area)
     39         (%ptr-in-area-p index2 cs-area)
     40         (< (the fixnum index1) (the fixnum index2)))))
     42(defun registers-used-by (lfun &optional at-pc)
     43  (declare (ignore lfun at-pc))
     44  (values nil nil))
     46(defun exception-frame-p (f)
     47  (fake-stack-frame-p f))
     50;;; Used for printing only.
     51(defun index->address (p)
     52  (when (fake-stack-frame-p p)
     53    (setq p (%fake-stack-frame.sp p)))
     54  (ldb (byte  32 0)  (ash p arm::fixnumshift)))
     56(defun %raw-frame-ref (cfp context idx bad)
     57  (declare (fixnum idx))
     58  (multiple-value-bind (frame base)
     59      (vsp-limits cfp context)
     60    (let* ((raw-size (- base frame)))
     61      (declare (fixnum frame base raw-size))
     62      (if (and (>= idx 0)
     63               (< idx raw-size))
     64        (let* ((addr (- (the fixnum (1- base))
     65                        idx)))
     66          (multiple-value-bind (db-count first-db last-db)
     67              (count-db-links-in-frame frame base context)
     68            (let* ((is-db-link
     69                    (unless (zerop db-count)
     70                      (do* ((last last-db (previous-db-link last first-db)))
     71                           ((null last))
     72                        (when (= addr last)                          (return t))))))
     73              (if is-db-link
     74                (oldest-binding-frame-value context addr)
     75                (%fixnum-ref addr)))))
     76        bad))))
     78;;; Return two values: the vsp of p and the vsp of p's "parent" frame.
     79;;; The "parent" frame vsp might actually be the end of p's segment,
     80;;; if the real "parent" frame vsp is in another segment.
     81(defun vsp-limits (p context)
     82  (let* ((vsp (%frame-savevsp p))
     83         parent)
     84    (when (eql vsp 0)
     85      ; This frame is where the code continues after an unwind-protect cleanup form
     86      (setq vsp (%frame-savevsp (child-frame p context))))
     87    (flet ((grand-parent (frame)
     88             (let ((parent (parent-frame frame context)))
     89               (when (and parent (eq parent (%frame-backlink frame context)))
     90                 (let ((grand-parent (parent-frame parent context)))
     91                   (when (and grand-parent (eq grand-parent (%frame-backlink parent context)))
     92                     grand-parent))))))
     93      (declare (dynamic-extent #'grand-parent))
     94      (let* ((frame p)
     95             grand-parent)
     96        (loop
     97          (setq grand-parent (grand-parent frame))
     98          (when (or (null grand-parent) (not (eql 0 (%frame-savevsp grand-parent))))
     99            (return))
     100          (setq frame grand-parent))
     101        (setq parent (parent-frame frame context)))
     102      (let* ((parent-vsp (if parent (%frame-savevsp parent) vsp))
     103             (tcr (if context (bt.tcr context) (%current-tcr)))
     104             (vsp-area (%fixnum-ref tcr target::tcr.vs-area)))
     105        (if (eql 0 parent-vsp)
     106          (values vsp vsp)              ; p is the kernel frame pushed by an unwind-protect cleanup form
     107          (progn
     108            (unless vsp-area
     109              (error "~s is not a stack frame pointer for context ~s" p tcr))
     110            (unless (%ptr-in-area-p parent-vsp vsp-area)
     111              (setq parent-vsp (%fixnum-ref vsp-area target::area.high)))
     112            (values vsp parent-vsp)))))))
     114(defun %frame-savevsp (p)
     115  (if (fake-stack-frame-p p)
     116    (%fake-stack-frame.vsp p)
     117    (%%frame-savevsp p)))
Note: See TracChangeset for help on using the changeset viewer.