[comp.lang.lisp.x] Step debugger for XLISP 2.1

comas@math.lsa.umich.edu (Ray Comas) (02/04/90)

 
The attached listing is a step debugger inspired by the "step.lsp"
stepper included with XLISP 2.1, originally written by Jonathan Engdahl
(jengdahl on BIX).  This version has the ability to set/reset
breakpoints, and a few bells and whistles.
 
To invoke the stepper:
	(step (form with args))
 
The stepper will stop and print every form, then wait for user input. 
Forms are printed compressed, i.e. only atoms at the top 2 paren. level
are printed.  The user may change the compression factor.  Example:
Suppose you have the following defined:
 
(defun fib (n)
  (if ((or (eql n 1) (eql n 2))
      1
      (+ (fib (- n 2)) (fib (- n 1))))))
 
Then (step (fib 4)) will produce the following:
 
0 >==> (fib 4)
 1 >==> (if (**) 1 (+ ** **)) :
 
The colon is the stepper's prompt.  For a list of commands, type h<cr>. 
All stepper commands are terminated by a return, <cr>.  Typing h<cr>
produces:
 
Stepper Commands 
----------------
          n - next form
          s - step over form
 f FUNCTION - go until FUNCTION is called
 b FUNCTION - set breakpoint at FUNCTION
 b <list>   - set breakpoint at each function in list
 c FUNCTION - clear breakpoint at FUNCTION
 c <list>   - clear breakpoint at each function in list
 c *all*    - clear all breakpoints
          g - go until a breakpoint is reached
          w - where am I? -- backtrace
          q - quit stepper, continue execution
          t - toggle trace on/off
          p - pretty-print current form (uncompressed)
          e - print environment
  x <expr> - execute expression in current environment
       * nn - set list compression to nn
          h - print this summary
  All commands are terminated by <cr>
 1 >==> (if (**) 1 (+ ** **)) :
 
Breakpoints may be set with the b command.  You may set breakpoints at
on function, e.g. b FOO<cr> sets a breakpoint at the function FOO,
or at various functions at once, e.g. b (FOO FIE FUM)<cr> sets
breakpoints at the functions FOO, FIE, and FUM.  Breakpoints are cleared
with the c command in an analogous way.  Furthermore, a special form of
the c command, c *all* <cr>, clears all previously set breakpoints. 
Breakpoints are remembered from one invocation of step to the next, so
it is only neccessary to set them once in a debugging session.
 
The g command causes execution to proceed until a breakpoint is reached,
at which time more stepper commands can be entered.
 
The f command sets a temporary breakpoint at one function, and causes
execution to proceed until that function is called.
 
The w command prints a back trace.
 
The q command quits and causes execution to continue uninterrupted.
 
Entry and exit to functions are traced after a g, f, or q command.  To
turn off tracing, use the t command which toggles the trace on/off. 
Also, with trace off, the values of function parameters are not printed.
 
The s command causes the current form to be evaluated.
 
The n command steps into the current form.
 
The * command changes the compression of displayed forms.  E.g. in the
previous example:
 
 1 >==> (if (**) 1 (+ ** **)) : * 3	; change compression to 3 ...
 1 >==> (if (or (eql n 1) (eql n 2)) 1 (+ (fib **) (fib **))) :
 
To have the entire form printed, set the compression to 300 or some
outrageously high value, or just use the p command, which pretty-prints
the form uncompressed.  The d command simply displays the compressed
form again.
 
The e command causes the current environment to be printed;  the x
command causes an expression to be executed in the current environment. 
Note that this permits the user to alter values while the program is
running, and may affect execution of the program.
 
I hope this is of some value to you all.  Feel free to make any
changes/enhancements.  Regards,
				Ray.
 
========CUT HERE=========CUT HERE=========CUT HERE=========CUT HERE===========
 
;
; File: NSTEP.LSP
; Author: Ray Comas (comas@math.lsa.umich.edu)
;
 
(defmacro while (test &rest forms) `(do () ((not ,test)) ,@forms))
(setf newline #\newline)  ;define newline
(setf *hooklevel* 0)	;create the nesting level counter.
(setf *cf* 2)		;create the compression counter
(setf *fcn* '*all*)	;create "one-shot" breakpoint specifier
(setf *steplist* nil)	;create breakpoint list
(setf *steptrace* '(T . T))
(setf *callist* nil)	;create call list for backtrace
 
;this macro invokes the stepper.
(defmacro step (form &aux val)
     `(progn
       (setf *hooklevel* 0)		;init nesting counter
       (setf *cf* 2)			;init compression counter
       (setf *fcn* '*all*)		;init break-point specifier
       (setf *callist* (list (car ',form)))  ;init call list
       (setf *steptrace* '(T . T))
 
       (prin1 ',form)			;print the form
       (terpri)
       (setf val (evalhook ',form		;eval, and kick off stepper
                           #'eval-hook-function
                           nil
                           nil))
       (princ *hooklevel*)           ;print returned value
       (princ " <==< ")
       (prin1 val)
       (terpri)
       val))                         ;and return it
 
(defun eval-hook-function (form env &aux val cmd)
     (setf *hooklevel* (1+ *hooklevel*))	;incr. the nesting level
     (cond ((consp form)			;if interpreted function ...
     	    (setf *callist*
		  (cons (car form) *callist*))  ;add fn. to call list
     	    (tagbody
	      (loop				;repeat forever ...
		;check for a breakpoint
		(when (and (not (equal *fcn* '*all*))
			   (not (equal *fcn* (car form))))
		    (unless (and *fcn* (member (car form) *steplist*))
 
		        ;no breakpoint reached -- continue
		        (setf (cdr *steptrace*) NIL)
		    	(when (car *steptrace*)
		    	      (setf (cdr *steptrace*) T)
			      (fcprt form)
			      (terpri))
                    	(setf val (evalhook form
					#'eval-hook-function
					nil
					env))
			(go next)))
 
		;breakpoint reached -- fix things & get a command
		(fcprt form)
		(setf (cdr *steptrace*) T)
		(setf *fcn* '*all*)	;reset breakpoint specifier
	        (princ ":")		;prompt user
	        (step-flush)		;clear garbage from input line
		(setf cmd (read-char))	;get command from user
 
		;process user's command
            	(cond
		  ((char-equal cmd #\n)		;step into function
                   (setf val (evalhook	form
					#'eval-hook-function
					nil
					env))
                   (go next))
                  ((char-equal cmd #\s)		;step over function
                       (setf val (evalhook form nil nil env))
                       (go next))
            	  ((char-equal cmd #\g)		;go until breakpt. reached
		   (terpri)
            	   (setf *fcn* t)
                   (setf val (evalhook form
				#'eval-hook-function
				nil
				env))
		   (go next))
		  ((char-equal cmd #\w)		;backtrace
		   (step-baktrace))
                  ((char-equal cmd #\h)		;display help
                    (step-help))
		  ((char-equal cmd #\p)		;pretty-print form
		       (terpri)
		       (pprint form))
            	  ((char-equal cmd #\f)		;set function breakpoint
            	   (setf *fcn* (read)))
		  ((char-equal cmd #\b)		;set breakpoint
		   (step-set-breaks (read)))
		  ((char-equal cmd #\c)		;clear a breakpoint
		   (step-clear-breaks (read)))
		  ((char-equal cmd #\t)		;toggle trace mode
		   (setf (car *steptrace*)
		   	 (not (car *steptrace*))))
		  ((char-equal cmd #\q)		;quit stepper
           	   (setf *fcn* nil))
		  ((char-equal cmd #\x)		;evaluate a form
            	   (step-do-form (read) env))
		  ((char-equal cmd #\*)		;set new compress level
		   (step-set-compression (read)))
		  ((char-equal cmd #\e)		;print environment
		   (step-print-env env))
		  (t (princ "Bad command.  Type h<cr> for help\n"))))
 
	next					;exit from loop
	      (setf *callist* (cdr *callist*))	;remove fn. from call list
	      (when (cdr *steptrace*)
		      (step-spaces *hooklevel*)
		      (princ *hooklevel*)
		      (princ " <==< ")       ;print the result
		      (prin1 val)
		      (terpri))))
 
	   ;not an interpreted function -- just trace thru.
           (t (unless (not (symbolp form))
		(when (car *steptrace*)
		        (step-spaces *hooklevel*) ;if form is a symbol ...
        	        (princ "         ")
                	(prin1 form)		  ;... print the form ...
	                (princ " = ")))
              (setf val (evalhook form nil nil env)) ;eval it
              (unless (not (symbolp form))
		(when (car *steptrace*)
	                (prin1 val)		     ;... and value
        	        (terpri)))))
     (setf *hooklevel* (1- *hooklevel*))     ;decrement level
     val)                                    ;and return the value
 
;compress a list
(defun compress (l cf)		;cf == compression factor
  (cond ((null l) nil)
	((atom l) l)
  	((eql cf 0) (if (atom l) l '**))
  	(T (cons (compress (car l) (1- cf)) (compress (cdr l) cf)))))
 
;compress and print a form
(defun fcprt (form)
  (step-spaces *hooklevel*)
  (princ *hooklevel*)
  (princ " >==> ")
  (prin1 (compress form *cf*))
  (princ " "))
 
;a non-recursive fn to print spaces (not as elegant, easier on the gc)
(defun step-spaces (n) (dotimes (i n) (princ " ")))
 
;and one to clear the input buffer
(defun step-flush () (while (not (eql (read-char) newline))))
 
;print help
(defun step-help ()
   (terpri)
   (princ "Stepper Commands\n")
   (princ "----------------\n")
   (princ "          n - next form\n")
   (princ "          s - step over form\n")
   (princ " f FUNCTION - go until FUNCTION is called\n")
   (princ " b FUNCTION - set breakpoint at FUNCTION\n")
   (princ " b <list>   - set breakpoint at each function in list\n")
   (princ " c FUNCTION - clear breakpoint at FUNCTION\n")
   (princ " c <list>   - clear breakpoint at each function in list\n")
   (princ " c *all*    - clear all breakpoints\n")
   (princ "          g - go until a breakpoint is reached\n")
   (princ "          w - where am I? -- backtrace\n")
   (princ "          t - toggle trace on/off\n")
   (princ "          q - quit stepper, continue execution\n")
   (princ "          p - pretty-print current form (uncompressed)\n")
   (princ "          e - print environment\n")
   (princ "   x <expr> - execute expression in current environment\n")
   (princ "       * nn - set list compression to nn\n")
   (princ "          h - print this summary\n")
   (princ "  All commands are terminated by <cr>\n")
   (terpri))
 
;evaluate a form in the given environment
(defun step-do-form (f1 env)
  (step-spaces *hooklevel*)
  (princ *hooklevel*)
  (princ " res: ")
  (prin1 (evalhook f1 nil nil env))   ;print result
  (princ " "))
 
;set new compression factor
(defun step-set-compression (cf)
  (cond ((numberp cf)
	 (setf *cf* (truncate cf)))
	(t (setf *cf* 2))))
 
;print environment
(defun step-print-env (env)
  (step-spaces *hooklevel*)
  (princ *hooklevel*)
  (princ " env: ")
  (prin1 env)
  (terpri))
 
;set breakpoints
(defun step-set-breaks (l)
  (cond ((null l) t)
	((symbolp l) (setf *steplist* (cons l *steplist*)))
        ((listp l)
  	 (step-set-breaks (car l))
  	 (step-set-breaks (cdr l)))))
 
;clear breakpoints
(defun step-clear-breaks (l)
  (cond ((null l) t)
	((eql l '*all*) (setf *steplist* nil))
  	((symbolp l) (delete l *steplist*))
  	((listp l)
  	 (step-clear-breaks (car l))
  	 (step-clear-breaks (cdr l)))))
 
;print backtrace
(defun step-baktrace (&aux l n)
  (setf l *callist*)
  (setf n *hooklevel*)
  (while (>= n 0)
    (step-spaces n)
    (prin1 n) (princ " ")
    (prin1 (car l))
    (terpri)
    (setf l (cdr l))
    (setf n (1- n))))

===============CUT HERE==========CUT HERE=========CUT HERE===========
Ray Comas, comas@math.lsa.umich.edu
------------------------------------
Remember, Finite Groups are your FRIENDS!!
------------------------------------

comas@math.lsa.umich.edu (Ray Comas) (11/28/90)

This is the latest version of my stepper.   I posted an early version of
it about a year ago;  this differs from the old one as follows:
  o  May change both print depth and print length of forms
	(old version only allowed print depth to be changed)
  o  Uses 'get-key' for user input, (in particular this is PC specific,
	I only use XLISP on PC's;  I use KCL on real computers)
  o  New 'u' command (execute until enclosing form returns)
  o  New 'r' command (use a given expression as the return value
	for the current form)
  o  Correct handling of '(go label)' statements
  o  Uses *debug-io* to determine output stream
 
To invoke the stepper:
	(step (form with args))
 
The stepper will stop and print every form, then wait for user input.
Forms are printed compressed, i.e. to a depth and length of 3.  This
may be changed by assigning the desired depth and length values to
*pdepth* and *plen* before invoking the stepper, or from within the
stepper via the . and # commands.
 
For example, suppose you have the following defined:
 
(defun fib (n)
  (if (or (eql n 1) (eql n 2))
      1
      (+ (fib (- n 2)) (fib (- n 1))))))
 
Then (step (fib 4)) will produce the following:
 
0 >==> (fib 4)
 1 >==> (if (or (eql n 1) (eql n 2)) 1 ...) :
 
The colon is the stepper's prompt.  For a list of commands, type h.
this produces:
 
Stepper Commands
----------------
 n or space - next form
 s or <cr>  - step over form
 f FUNCTION - go until FUNCTION is called
 b FUNCTION - set breakpoint at FUNCTION
 b <list>   - set breakpoint at each function in list
 c FUNCTION - clear breakpoint at FUNCTION
 c <list>   - clear breakpoint at each function in list
 c *all*    - clear all breakpoints
          g - go until a breakpoint is reached
          u - go up; continue until enclosing form is done
          w - where am I? -- backtrace
          t - toggle trace on/off
          q - quit stepper, continue execution
          p - pretty-print current form (uncompressed)
          e - print environment
   x <expr> - execute expression in current environment
   r <expr> - execute and return expression
       # nn - set print depth to nn
       . nn - set print length to nn
          h - print this summary
 
Breakpoints may be set with the b command.  You may set breakpoints at
one function, e.g. b FOO<cr> sets a breakpoint at the function FOO,
or at various functions at once, e.g. b (FOO FIE FUM)<cr> sets
breakpoints at the functions FOO, FIE, and FUM.  Breakpoints are cleared
with the c command in an analogous way.  Furthermore, a special form of
the c command, c *all* <cr>, clears all previously set breakpoints.
Breakpoints are remembered from one invocation of step to the next, so
it is only neccessary to set them once in a debugging session.
 
The g command causes execution to proceed until a breakpoint is reached,
at which time more stepper commands can be entered.
 
The f command sets a temporary breakpoint at one function, and causes
execution to proceed until that function is called.
 
The u command continues execution until the form enlosing the current
form is done, then re-enters the stepper.
 
The w command prints a back trace.
 
The q command quits and causes execution to continue uninterrupted.
 
Entry and exit to functions are traced after a g, f, u, or q command.  To
turn off tracing, use the t command which toggles the trace on/off.
Also, with trace off, the values of function parameters are not printed.
 
The s command causes the current form to be evaluated.
 
The n command steps into the current form.
 
The . and # commands change the compression of displayed forms.  E.g. in the
previous example:
 
 1 >==> (if (or (eql n 1) (eql n 2)) 1 ...) : . 2
 1 >==> (if (or (eql n ...) ...) ...) :
 
changes the print length to 2, and
 
 1 >==> (if (or (eql n ...) ...) ...) : # 2
 1 >==> (if (or #\# ...) ...) :
 
changes the print depth to 2.
 
To print the entire form use the p command, which pretty-prints the
entire form.
 
The e command causes the current environment to be printed;
 
The x command causes an expression to be executed in the current
environment.  Note that this permits the user to alter values while
the program is running, and may affect execution of the program.
 
The r command causes the value of the given expression to be returned,
i.e. makes it the return value of the current form.

Enjoy,
      Ray
==================CUT HERE==========CUT HERE==========CUT HERE==========
;;
;; File: STEP.LSP
;; Author: Ray Comas (comas@math.lsa.umich.edu)
;;
 
(setq *hooklevel*	0		;create the nesting level counter.
      *pdepth*		3		;create depth counter
      *plen*		3		;create length counter
      *fcn*		'*all*		;create "one-shot" breakpoint specifier
      *steplist*	nil		;create breakpoint list
      *steptrace*	'(T . T)	;create stepping flags
      *callist*		nil)		;create call list for backtrace
 
; this macro invokes the stepper.
(defmacro step (form &aux val)
  `(progn
     (setq *hooklevel*	0		;init nesting counter
	   *fcn*	'*all*		;init break-point specifier
	   *steptrace*	'(T . T))
     (setq *callist* (list (car ',form))) ;init call list
     (terpri *debug-io*)
     (step-flush)
     (princ *hooklevel* *debug-io*)
     (princ " >==> " *debug-io*)
     (prin1 ',form *debug-io*)		;print the form
     (setq val (evalhook ',form		;eval, and kick off stepper
			 #'eval-hook-function
			 nil
			 nil))
     (terpri *debug-io*)
     (princ *hooklevel* *debug-io*)	;print returned value
     (princ " <==< " *debug-io*)
     (prin1 val *debug-io*)
     (terpri *debug-io*)
     val))				;and return it
 
(defun eval-hook-function (form env &aux val cmd)
  (setq *hooklevel* (1+ *hooklevel*))	;incr. the nesting level
  (cond ((consp form)			;if interpreted function ...
	 (setq *callist*
	       (cons (car form) *callist*)) ;add fn. to call list
	 (tagbody
	  (loop				;repeat forever ...
					;check for a breakpoint
	   (when (and (not (equal *fcn* '*all*))
		      (not (equal *fcn* (car form)))
		      (not (and (numberp *fcn*) (>= *fcn* *hooklevel*))))
		 (unless (and *fcn* (member (car form) *steplist*))
 
					;no breakpoint reached -- continue
			 (setf (cdr *steptrace*) NIL)
			 (when (car *steptrace*)
			       (setf (cdr *steptrace*) T)
			       (fcprt form))
			 (fix-go)
			 (setq val (evalhook form
					     #'eval-hook-function
					     nil
					     env))
			 (go next)))
 
					;breakpoint reached -- fix things & get a command
	   (fcprt form)
	   (setf (cdr *steptrace*) T)
	   (setq *fcn* '*all*)		;reset breakpoint specifier
	   (princ " :" *debug-io*)	;prompt user
	   (setq cmd			;get command from user
		 (char-downcase (code-char (get-key))))
 
					;process user's command
	   (cond
	    ((or (eql cmd #\n) (eql cmd #\Space)) ;step into function
	     (fix-go)
	     (setq val (evalhook form
				 #'eval-hook-function
				 nil
				 env))
	     (go next))
	    ((or (eql cmd #\s) (eql cmd #\Newline)) ;step over function
	     (fix-go)
	     (setq val (evalhook form nil nil env))
	     (go next))
	    ((eql cmd #\g)		;go until breakpt. reached
	     (setq *fcn* t)
	     (fix-go)
	     (setq val (evalhook form
				 #'eval-hook-function
				 nil
				 env))
	     (go next))
	    ((eql cmd #\w)		;backtrace
	     (step-baktrace))
	    ((eql cmd #\h)		;display help
	     (step-help))
	    ((eql cmd #\p)		;pretty-print form
	     (terpri *debug-io*)
	     (pprint form *debug-io*))
	    ((eql cmd #\f)		;set function breakpoint
	     (princ "Go to fn.: " *debug-io*)
	     (setq *fcn* (read *debug-io*))
	     (step-flush))
	    ((eql cmd #\u)		;go up one level
	     (setq *fcn* (1- *hooklevel*)))
	    ((eql cmd #\b)		;set breakpoint
	     (princ "Bkpt.: " *debug-io*)
	     (step-set-breaks (read *debug-io*))
	     (step-flush))
	    ((eql cmd #\c)		;clear a breakpoint
	     (princ "Clear: " *debug-io*)
	     (step-clear-breaks (read *debug-io*))
	     (step-flush))
	    ((eql cmd #\t)		;toggle trace mode
	     (setf (car *steptrace*)
		   (not (car *steptrace*)))
	     (princ "Trace = " *debug-io*)
	     (prin1 (car *steptrace*) *debug-io*))
	    ((eql cmd #\q)		;quit stepper
	     (setq *fcn* nil))
	    ((eql cmd #\x)		;evaluate a form
	     (princ "Eval: " *debug-io*)
	     (step-do-form (read *debug-io*) env)
	     (step-flush))
	    ((eql cmd #\r)		;return given expression
	     (princ "Return: " *debug-io*)
	     (setq val (evalhook (read *debug-io*) nil nil env))
	     (step-flush)
	     (go next))
	    ((eql cmd #\#)		;set new compress level
	     (princ "Depth: " *debug-io*)
	     (step-set-depth (read *debug-io*))
	     (step-flush))
	    ((eql cmd #\.)
	     (princ "Len.: " *debug-io*)
	     (step-set-length (read *debug-io*))
	     (step-flush))
	    ((eql cmd #\e)		;print environment
	     (step-print-env env))
	    (T (princ "Bad command.  Type h for help\n" *debug-io*))))
 
	  next				;exit from loop
	  (setq *callist* (cdr *callist*)) ;remove fn. from call list
	  (when (cdr *steptrace*)
		(terpri *debug-io*)
		(step-spaces *hooklevel*)
		(princ *hooklevel* *debug-io*)
		(princ " <==< " *debug-io*) ;print the result
		(prin1 val *debug-io*))))
 
					;not an interpreted function -- just trace thru.
	(T (unless (not (symbolp form))
		   (when (car *steptrace*)
			 (terpri *debug-io*)
			 (step-spaces *hooklevel*) ;if form is a symbol ...
			 (princ "         " *debug-io*)
			 (prin1 form *debug-io*) ;... print the form ...
			 (princ " = " *debug-io*)))
	   (setq val (evalhook form nil nil env)) ;eval it
	   (unless (not (symbolp form))
		   (when (car *steptrace*)
			 (prin1 val *debug-io*))))) ;... and the value
  (setq *hooklevel* (1- *hooklevel*))	;decrement level
  val)					;and return the value
 
;compress a list
(defun compress (l cd cl ol)		;cd = depth, cl = length, ol = orig. length
  (cond
   ((null l) nil)
   ((eql cl 0) '(...))
   ((atom l) l)
   ((eql cd 0) '#\#)
   (T (cons (compress (car l) (1- cd) ol ol)
	    (compress (cdr l) cd (1- cl) ol)))))
 
;compress and print a form
(defun fcprt (form)
  (terpri *debug-io*)
  (step-spaces (min 20 *hooklevel*))
  (princ *hooklevel* *debug-io*)
  (princ " >==> " *debug-io*)
  (prin1 (compress form *pdepth* *plen* *plen*) *debug-io*)
  (princ " " *debug-io*))
 
;a non-recursive fn to print spaces (not as elegant, easier on the gc)
(defun step-spaces (n) (dotimes (i n) (princ " " *debug-io*)))
 
;and one to clear the input buffer
(defun step-flush () (while (not (eql (read-char *debug-io*) #\newline))))
 
;print help
(defun step-help ()
  (terpri *debug-io*)
  (princ "Stepper Commands\n" *debug-io*)
  (princ "----------------\n" *debug-io*)
  (princ " n or space - next form\n" *debug-io*)
  (princ " s or <cr>  - step over form\n" *debug-io*)
  (princ " f FUNCTION - go until FUNCTION is called\n" *debug-io*)
  (princ " b FUNCTION - set breakpoint at FUNCTION\n" *debug-io*)
  (princ " b <list>   - set breakpoint at each function in list\n" *debug-io*)
  (princ " c FUNCTION - clear breakpoint at FUNCTION\n" *debug-io*)
  (princ " c <list>   - clear breakpoint at each function in list\n" *debug-io*)
  (princ " c *all*    - clear all breakpoints\n" *debug-io*)
  (princ "          g - go until a breakpoint is reached\n" *debug-io*)
  (princ "          u - go up; continue until enclosing form is done\n" *debug-io*)
  (princ "          w - where am I? -- backtrace\n" *debug-io*)
  (princ "          t - toggle trace on/off\n" *debug-io*)
  (princ "          q - quit stepper, continue execution\n" *debug-io*)
  (princ "          p - pretty-print current form (uncompressed)\n" *debug-io*)
  (princ "          e - print environment\n" *debug-io*)
  (princ "   x <expr> - execute expression in current environment\n" *debug-io*)
  (princ "   r <expr> - execute and return expression\n" *debug-io*)
  (princ "       # nn - set print depth to nn\n" *debug-io*)
  (princ "       . nn - set print length to nn\n" *debug-io*)
  (princ "          h - print this summary\n" *debug-io*)
  (terpri *debug-io*))
 
;evaluate a form in the given environment
(defun step-do-form (f1 env)
  (step-spaces *hooklevel*)
  (princ *hooklevel* *debug-io*)
  (princ " res: " *debug-io*)
  (prin1 (evalhook f1 nil nil env) *debug-io*))	;print result
 
;set new print depth
(defun step-set-depth (cf)
  (cond ((numberp cf)
	 (setq *pdepth* (truncate cf)))
	(T (setq *pdepth* 3))))
 
;set new print length
(defun step-set-length (cf)
  (cond ((numberp cf)
	 (setq *plen* (truncate cf)))
	(T (setq *plen* 3))))
 
;print environment
(defun step-print-env (env)
  (terpri *debug-io*)
  (step-spaces *hooklevel*)
  (princ *hooklevel* *debug-io*)
  (princ " env: " *debug-io*)
  (prin1 env *debug-io*)
  (terpri *debug-io*))
 
;set breakpoints
(defun step-set-breaks (l)
  (cond ((null l) t)
	((symbolp l) (setq *steplist* (cons l *steplist*)))
	((listp l)
	 (step-set-breaks (car l))
	 (step-set-breaks (cdr l)))))
 
;clear breakpoints
(defun step-clear-breaks (l)
  (cond ((null l) t)
	((eql l '*all*) (setq *steplist* nil))
	((symbolp l) (delete l *steplist*))
	((listp l)
	 (step-clear-breaks (car l))
	 (step-clear-breaks (cdr l)))))
 
;print backtrace
(defun step-baktrace (&aux l n)
  (setq l *callist*
	n *hooklevel*)
  (while (>= n 0)
    (terpri *debug-io*)
    (step-spaces n)
    (prin1 n *debug-io*)
    (princ " " *debug-io*)
    (prin1 (car l) *debug-io*)
    (setq l (cdr l))
    (setq n (1- n)))
  (terpri *debug-io*))
 
(defun fix-go ()
  (when (equal (car *callist*) 'go)
	(setq *hooklevel* (1- *hooklevel*))
	(setq *callist* (cdr *callist*))))

=============== CUT HERE ============== CUT HERE =================
Ray Comas (comas@math.lsa.umich.edu)
Dept. of Mathematics,
University of Michigan

toma@tekgvs.LABS.TEK.COM (Tom Almy) (11/29/90)

A nice piece of code, not only useful to use, but also useful to study, IMHO.

Those readers who don't have the previous version of this debugger might
want to add this line which is missing from this version (but needed):

(defmacro while (test &rest forms) `(do () ((not ,test)) ,@forms))

Tom Almy
toma@tekgvs.labs.tek.com
Standard Disclaimers Apply