Backtrace.

[Scott McKay <SWM%sapsucker.scrc.symbolics.com@RELAY.CS.NET>]

    Date: Tue, 6 Jun 89 09:10 EDT
    From: cmb@VALLECITO.SCRC.Symbolics.COM (Clark M. Baker)

        Date: Mon, 5 Jun 89  15:05:06 MDT
        From: snicoud@atc.boeing.com (Stephen Nicoud)

        How can a process get a backtrace of its own stack?

    I have found the following code useful.  It is not exactly what you
    asked for since it shows how a different process can get a backtrace of
    a certain process.  Maybe you can change it for your needs.

    I use this a cheap, simple, always available piece of metering code.
    Whenever something is running and I wonder what it is doing, I just
    "Watch Process" it.  The features I like are that it takes no
    pre-arraignment to run, it doesn't appear to take up much CPU time, and
    it gives enough information to be useful.  The things I don't like are
    the way it scrolls when the stack gets large and then shrinks.

    ;;; -*- Mode: LISP; Package: USER; Lowercase: T; Base: 10; Patch-File: Yes; Syntax: Common-Lisp -*-
    ;;; Created 8/27/84 16:34:37 by CMB

    ;;; Copyright 1984, Symbolics, Inc.  All Rights Reserved.
    ;;; This should notice if it wraps the screen and only update the n lines that fit
    ;;; from some displacement off the beginning of the stack (changeable by c-V, m-V) --
    ;;; Kalman

    (cp:define-command (si:com-watch-process :command-table "Global" :provide-output-destination-keyword nil)
        ((process 'si:process)
         (update-interval '(and number (satisfies plusp)) :default .5 :documentation "Number of seconds between updates"
                          :prompt "a interval (in seconds)"))
      (dw:with-own-coordinates (nil :enable-output-recording nil :bottom 100000)
        (loop with update-time-in-sixtieths = (round (* update-interval 60))
              with function-name-array = (make-array 500)
              with old-function-name-array = (make-array 500)
              with old-number-of-entries = -1
              for number-of-entries = (put-backtrace-in-array process function-name-array)
              do (loop for line from 0
                       for index from (1- number-of-entries) downto 0
                       for old-index = (- old-number-of-entries line 1)
                       when (or (minusp old-index)
                                (neq (aref function-name-array index) (aref old-function-name-array old-index)))
                         do (send *standard-output* :set-cursorpos 0 line :character)
                            (send *standard-output* :clear-rest-of-line)
                            (format t "~A" (aref function-name-array index))
                       finally (loop for line from line
                                     for old-index from (- old-number-of-entries line 1) downto 0
                                     do (send cl:*standard-output* :set-cursorpos 0 line :character)
                                        (send cl:*standard-output* :clear-rest-of-line)))
                 ;; Update to process:sleep when using new scheduler
                 (si:process-sleep update-time-in-sixtieths)
                 (setq old-number-of-entries number-of-entries)
                 (rotatef function-name-array old-function-name-array))))

    1#+3600
0    (defun put-backtrace-in-array (process function-name-array)
      (without-interrupts
        (loop for index from 0
              for frame-pointer first (sys:sg-frame-pointer (send process :stack-group))
                                then (sys:frame-previous-frame frame-pointer)
              while frame-pointer
              do (setf (aref function-name-array index) (sys:function-name (sys:frame-function frame-pointer)))
              finally (return index))))

On Ivory-based machines, the suggested version of 1put-backtrace-in-array
0is very expensive, since the previous-frame pointer is not maintained in
the stack-frame.  The second function should read as follows on I-machines:

#+IMach
(defun put-backtrace-in-array (process function-name-array)
  (process:with-no-other-processes
    (let ((index 0))
      (sys:map-over-frames-in-stack (send process :stack-group)
	#'(lambda (fp lcr function)
	    (ignore fp lcr)
	    (setf (aref function-name-array index) (sys:function-name function))
	    (incf index))) 
      index)))

I would recommend doing the 1sys:function-name0 someplace outside of the
1without-interrupts0 (or 1process:without-no-other-processes0) since it can
be expensive because it often takes page faults.