home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / xl21hos2.zip / STEP.LSP < prev    next >
Lisp/Scheme  |  1995-12-27  |  5KB  |  121 lines
  1. ;Title:  step.lsp
  2. ;Author: Jonathan Engdahl (jengdahl on BIX)
  3. ;Date:   Jan-25-1987
  4.  
  5. ;This file contains a simple Lisp single-step debugger. It
  6. ;started as an implementation of the "hook" example in chapter 20
  7. ;of Steele's "Common Lisp". This version was brought up on Xlisp 1.7
  8. ;for the Amiga, and then on VAXLISP.
  9.  
  10. ;To invoke: (step (whatever-form with args))
  11. ;For each list (interpreted function call), the stepper prints the
  12. ;environment and the list, then enters a read-eval-print loop
  13. ;At this point the available commands are:
  14.  
  15. ;    (a list)<CR> - evaluate the list in the current environment,
  16. ;                   print the result, and repeat.                 
  17. ;    <CR> - step into the called function
  18. ;    anything_else<CR> - step over the called function.
  19.  
  20. ;If the stepper comes to a form that is not a list it prints the form 
  21. ;and the value, and continues on without stopping.
  22.  
  23. ;Note that stepper commands are executed in the current environment.
  24. ;Since this is the case, the stepper commands can change the current
  25. ;environment. For example, a SETF will change an environment variable
  26. ;and thus can alter the course of execution.
  27.  
  28. #+:packages
  29. (unless (find-package "TOOLS")
  30.     (make-package "TOOLS" :use '("XLISP")))
  31.  
  32. (in-package "TOOLS")
  33.  
  34. (export '(step))
  35.  
  36. ;set the representation for an input #/newline
  37. ;the value, notation, and data type of newline may be implementation dependent
  38. (setf newline #\newline)   ;for XLISP
  39. ;(setf newline 10)         ;for VAXLISP
  40.  
  41. ;define a C-like iterator.
  42. (defmacro while (test &rest forms) `(do () ((not ,test)) ,@forms))
  43.  
  44. ;create the nesting level counter.
  45. (defparameter *hooklevel* 0)
  46.  
  47. ;this macro invokes the stepper.
  48. ;for VAXLISP you better rename this to xstep or something, lest
  49. ;defun say nasty things to you about step already being defined
  50.  
  51. (defmacro step (form &aux val)
  52.      `(progn
  53.        (step-flush)                  ;get rid of garbage on the line
  54.        (setf *hooklevel* 0)          ;init nesting counter
  55.        (princ *hooklevel*)           ;print the form
  56.        (princ "  form: ")
  57.        (prin1 ',form)
  58.        (terpri)
  59.        (setf val (evalhook ',form    ;eval, and kick off stepper
  60.                            #'eval-hook-function
  61.                            nil
  62.                            nil))
  63.        (princ *hooklevel*)           ;print returned value
  64.        (princ " value: ")
  65.        (prin1 val)
  66.        (terpri)
  67.        val))                         ;and return it
  68.  
  69.  
  70. ;this is the substitute "eval" routine that gets control when
  71. ;a user form is evaluated during stepping.
  72.  
  73. (defun eval-hook-function (form env &aux val f1)
  74.      (setf *hooklevel* (+ *hooklevel* 1))    ;inc the nesting level
  75.      (cond ((consp form)                     ;if interpreted function 
  76.             (step-spaces *hooklevel*)        ;print the environment
  77.             (princ *hooklevel*)
  78.             (princ "    env: ")
  79.             (prin1 env)
  80.             (terpri)
  81.             (step-spaces *hooklevel*)        ;then the form
  82.             (princ *hooklevel*)
  83.             (princ "   form: ")
  84.             (prin1 form)
  85.             (princ " ")
  86.             (while (eql (peek-char) #\( )    ;while a form is typed           
  87.                    (setf f1 (read))          ;read a form
  88.                    (step-flush)              ;get rid of junk
  89.                    (step-spaces *hooklevel*) ;print out result
  90.                    (princ *hooklevel*)
  91.                    (princ " result: ")       ;which is evaled in env
  92.                    (prin1 (evalhook f1 nil nil env))
  93.                    (princ " "))   
  94.             (cond ((eql (read-char) newline) ;if <cr> then step into
  95.                    (setf val (evalhook form
  96.                                        #'eval-hook-function
  97.                                        nil
  98.                                        env)))
  99.                   (t (step-flush)            ;else step over
  100.                      (setf val (evalhook form nil nil env)))))
  101.            (t (step-spaces *hooklevel*)      ;if not interpreted func
  102.               (princ *hooklevel*)            ;print the form
  103.               (princ "   form: ")
  104.               (prin1 form)
  105.               (terpri)
  106.               (setf val (evalhook form nil nil env)))) ;eval it
  107.      (step-spaces *hooklevel*)               ;in either case
  108.      (princ *hooklevel*)                     ;print the result
  109.      (princ "  value: ")
  110.      (prin1 val)
  111.      (terpri)
  112.      (setf *hooklevel* (- *hooklevel* 1))    ;decrement level
  113.      val)                                    ;and return the value
  114.  
  115.  
  116. ;a non-recursive fn to print spaces (not as elegant, easier on the gc)
  117. (defun step-spaces (n) (while (> n 0) (princ " ") (setf n (- n 1))))
  118.      
  119. ;and one to clear the input buffer
  120. (defun step-flush () (while (not (eql (read-char) newline))))
  121.