Changeset 8037


Ignore:
Timestamp:
Jan 10, 2008, 8:22:54 AM (12 years ago)
Author:
gb
Message:

Lots of changes to APPLY-IN-FRAME and supporting functions.
Define RETURN-FROM-FRAME in terms of APPLY-IN-FRAME.

File:
1 edited

Legend:

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

    r8026 r8037  
    265265
    266266(defun apply-in-frame (frame function arglist &optional context)
     267  (setq function (coerce-to-function function))
    267268  (let* ((parent (parent-frame frame context)))
    268269    (when parent
     
    278279            (error "Can't find process for backtrace context ~s" context)))))))
    279280
    280 (defun return-from-frame (frame context &rest values)
    281   (apply-in-frame frame #'values values context))
     281(defun return-from-frame (frame &rest values)
     282  (apply-in-frame frame #'values values nil))
    282283   
     284
     285(defun last-tsp-before (target)
     286  (declare (fixnum target))
     287  (do* ((tsp (%fixnum-ref (%current-tcr) target::tcr.save-tsp)
     288             (%fixnum-ref tsp target::tsp-frame.backptr)))
     289       ((zerop tsp) nil)
     290    (declare (fixnum tsp))
     291    (when (> (the fixnum (%fixnum-ref tsp target::tsp-frame.rbp))
     292             target)
     293      (return tsp))))
     294
     295   
     296
     297
    283298;;; We can't determine this reliably (yet).
    284 (defun last-tsp-since (target source context)
    285   (declare (ignore target source context))
    286   nil)
    287 
    288 ;;; We can't determine this reliably (yet).
    289 (defun last-foreign-sp-since (target source context)
    290   (declare (ignore target source context))
    291   nil)
    292 
    293 
    294 ;;; This can lose (possibly badly) if the oldest binding younger
    295 ;;; than the stack frame "frame" was established via PROGV.
    296 ;;; We could make PROGV establish a "normal" binding (of
    297 ;;; something like *CURRENT-PROGV* on the vstack; otherwise,
    298 ;;; we'd need info about how the tstack is used at each point
    299 ;;; on the vstack.
    300 (defun last-binding-since (frame start context)
    301   (declare (fixnum frame start))
    302   (do* ((db
    303          (if context (bt.db-link context) (%current-db-link))
    304          (%fixnum-ref db 0))
    305         (last nil))
    306        ((eql db 0) last)
    307     (declare (fixnum db))
    308     (if (and (< db frame)
    309              (< start db))
    310       (setq last db))))
     299(defun last-foreign-sp-before (target)
     300  (declare (fixnum target))
     301  (do* ((cfp (%fixnum-ref (%current-tcr) target::tcr.foreign-sp)
     302             (%fixnum-ref cfp target::csp-frame.backptr)))
     303       ((zerop cfp))
     304    (declare (fixnum cfp))
     305    (let* ((rbp (%fixnum-ref cfp target::csp-frame.rbp)))
     306      (declare (fixnum rbp))
     307      (if (> rbp target)
     308        (return cfp)
     309        (if (zerop rbp)
     310          (return nil))))))
     311
     312
     313(defun %tsp-frame-containing-progv-binding (db)
     314  (declare (fixnum db))
     315  (do* ((tsp (%fixnum-ref (%current-tcr) target::tcr.save-tsp) next)
     316        (next (%fixnum-ref tsp target::tsp-frame.backptr)
     317              (%fixnum-ref tsp target::tsp-frame.backptr)))
     318       ()
     319    (declare (fixnum tsp next))
     320    (let* ((rbp (%fixnum-ref tsp target::tsp-frame.rbp)))
     321      (declare (fixnum rbp))
     322      (if (zerop rbp)
     323        (return (values nil nil))
     324        (if (and (> db tsp)
     325                 (< db next))
     326          (return (values tsp rbp)))))))
     327
     328       
     329
     330
     331
     332
     333(defun last-binding-before (frame)
     334  (declare (fixnum frame))
     335  (do* ((db (%current-db-link) (%fixnum-ref db 0))
     336        (tcr (%current-tcr))
     337        (vs-area (%fixnum-ref tcr target::tcr.vs-area))
     338        (vs-low (%fixnum-ref vs-area target::area.low))
     339        (vs-high (%fixnum-ref vs-area target::area.high)))
     340       ((eql db 0) nil)
     341    (declare (fixnum db vs-low vs-high))
     342    (if (and (> db vs-low)
     343             (< db vs-high))
     344      (if (> db frame)
     345        (return db))
     346      ;; db link points elsewhere; PROGV uses the temp stack
     347      ;; to store an indefinite number of bindings.
     348      (multiple-value-bind (tsp rbp)
     349          (%tsp-frame-containing-progv-binding db)
     350        (if tsp
     351          (if (> rbp frame)
     352            (return db)
     353            ;; If the tsp frame is too young, we can skip
     354            ;; all of the bindings it contains.  The tsp
     355            ;; frame contains two words of overhead, followed
     356            ;; by a count of binding records in the frame,
     357            ;; followed by the youngest of "count" binding
     358            ;; records (which happens to be the value of
     359            ;; "db".)  Skip "count" binding records.
     360            (dotimes (i (the fixnum (%fixnum-ref tsp target::dnode-size)))
     361              (setq db (%fixnum-ref db 0))))
     362          ;; If the binding record wasn't on the temp stack and wasn't
     363          ;; on the value stack, that probably means that things are
     364          ;; seriously screwed up.  This error will be almost
     365          ;; meaningless to the user.
     366          (error "binding record (#x~16,'0x/#x~16,'0x) not on temp or value stack" (index->address db) db))))))
     367         
     368
    311369
    312370(defun find-x8664-saved-nvrs (frame start-fp context)
     
    349407                     (%get-frame-ptr)))
    350408         (target-xcf (last-xcf-since frame start-fp nil))
    351          (target-db-link (last-binding-since frame start-fp nil))
    352          (target-tsp (last-tsp-since frame start-fp nil))
    353          (target-foreign-sp (last-foreign-sp-since frame start-fp nil)))
     409         (target-db-link (last-binding-before frame))
     410         (target-tsp (last-tsp-before frame))
     411         (target-foreign-sp (last-foreign-sp-before frame)))
    354412    (multiple-value-bind (save0-loc save1-loc save2-loc save3-loc)
    355413        (find-x8664-saved-nvrs frame start-fp nil)
Note: See TracChangeset for help on using the changeset viewer.