Changeset 659

Timestamp:

Mar 17, 2004, 7:28:19 AM (21 years ago)

Author:

Gary Byers

Message:

tsp/vsp ranges, for bogus-object detection.

File:

• trunk/ccl/lib/describe.lisp (modified) (4 diffs)

trunk/ccl/lib/describe.lisp

@@ -1549 +1549 @@
    (break-condition :accessor break-condition
                     :initform ccl::*break-condition*)))
+  
 
 ; This is set up to access the result of
@@ -1684 +1685 @@
         (flet ((maybe-ignore ()
                  (loop while (ignore-function-in-backtrace? 
-                            f
-                            (ccl::cfp-lfun (ccl::parent-frame child tcr))) 
+                              f
+                              (ccl::cfp-lfun (ccl::parent-frame child tcr))) 
                      do (multiple-value-setq (child last-catch srv)
                           (ccl::parent-frame-saved-vars tcr child last-catch srv srv)))))
@@ -1720 +1721 @@
 (defclass stack-inspector (inspector)
   ((show-frame-addresses :initform *show-backtrace-frame-addresses*
-                         :accessor show-frame-addresses)))
-
+                         :accessor show-frame-addresses)
+   (vsp-range :accessor vsp-range :initarg :vsp-range)
+   (tsp-range :accessor tsp-range :initarg :tsp-range)))
+
+(defun make-tsp-stack-range (tcr bt-info)
+  (list (cons (ccl::%catch-tsp (ccl::bt.top-catch bt-info))
+              (ccl::%fixnum-ref (ccl::%fixnum-ref tcr target::tcr.ts-area)
+                                target::area.high))))
+
+(defun make-vsp-stack-range (tcr bt-info)
+  (list (cons (ccl::%fixnum-ref
+               (ccl::%svref (ccl::bt.top-catch bt-info) target::catch-frame.csp-cell)
+               target::lisp-frame.savevsp)
+              (ccl::%fixnum-ref (ccl::%fixnum-ref tcr target::tcr.vs-area)
+                                target::area.high))))
+
+                           
 (defmethod initialize-instance ((i stack-inspector) &rest initargs &key info)
   (declare (dynamic-extent initargs))
@@ -1733 +1749 @@
              :stack-end end
              :tcr tcr)
+           :tsp-range (make-tsp-stack-range tcr info)
+           :vsp-range (make-vsp-stack-range tcr info)
            initargs)))