Backtrace.

["Clark M. Baker" <cmb@VALLECITO.SCRC.SYMBOLICS.COM>]

    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))))

(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))))