Re: Getting trace info from MACL

[Gary Byers <gb@cambridge.apple.com>]

     All: 
     
     I have an application which will soon be placed in a (semi-) production
     environment. I'd like to: 
     
     1) Catch ALL errors and log them.
     2) Record, as part of #1, the stack trace so's I can isolate the 
        function that caused the error. 
     
     #1 is no problem (wrap the top-level form in a (catch-error-quietly)). 
     
     But how can I do #2? I tried using APROPOS/INSPECT to go routing around 
     in the trace tables, but no luck. Do I have to do my own *EVENTHOOK*, or 
     is there some neat hack that does the trick? I am running version 1.2.2...
     
     Thanx in advance,
     Charlie S. Lindahl
     Automation and Robotics Research Institute
     University of Texas at Arlington
     ARPA: lindahl@evax.utarl.edu
     
     
re: (2)

There really should be a dressed-up version of this in the product, but there
isn't.  Calling (FUNCTION-CALL-HISTORY) should return pretty much the same
information that backtrace does.  Famous last words: I guess I'd be interested
in hearing about cases where it doesn't ...

(defun stack-frame-function (ptr)
  (setq ptr (%inc-ptr ptr -4))
  (let ((highbyte (%get-byte ptr))) ; Tsk, tsk.
    (if (or (= highbyte #x1f) (= highbyte 1))
      (ccl::%caller 
        (%get-ptr (%int-to-ptr (logand (%get-long ptr) #x00ffffff))))
      (stack-frame-function ptr))))

; This doesn't identify saved values of bound specials or "value cells" shared
; by compiled closures as such; sorry ...
(defun stack-frame-values (ptr)
  (flet ((frame-start-addr (addr)
           (%get-ptr (%inc-ptr (logand #x00ffffff (%get-long addr)) -4)))
         (child-frame (addr)
           (do* ((p (%inc-ptr addr -4) (%inc-ptr p -4)))
                ((= (%get-byte p) #x1f) p))))
    (do* ((startfp (frame-start-addr ptr) (%inc-ptr startfp -4))
          (childfp (frame-start-addr (child-frame ptr)))
          (vals ()))
         ((eq startfp childfp) (nreverse vals))
      (let ((marker (%get-byte startfp)))
        (unless (or (= marker 1) (= marker #x1f))
          (push (%get-ptr startfp) vals))))))
  
(defun function-call-history ()
  (do* ((result nil)
        (pos (%inc-ptr (ccl::%get-frame-ptr) 4) (%inc-ptr pos 4))
        (end (%int-to-ptr (logand -3 (%get-long (%int-to-ptr #x908)))))) 
       ((eq pos end) result)
    (when (= (%get-byte pos) #x1f)
      (push (cons (stack-frame-function pos)
                  (stack-frame-values pos))
            result))))

re: (1)

Using FUNCTION-CALL-HISTORY when CATCH-ERROR-QUIETLY indicates that an error
occurred would return information for all pending functions "between" the
toplevel-function and the function containing the CATCH-ERROR-QUIETLY, but
wouldn't show anything between that function and the one which signalled the
error.

One way to get the latter functionality would be to redefine ERROR (and
CERROR, BREAK, etc.) to call FUNCTION-CALL-HISTORY before or instead of
their usual behavior.  Unfortunately, since these functions are block-
compiled into the Lisp kernel, redefining them in such a way that all of
their callers see the new definitions involves much gnashing of teeth ...

If there's interest, I'll try to explain how to do this someday.