home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e070 / 4.ddi / LISPLIB / STEPPER.LSP < prev    next >
Encoding:
Text File  |  1984-11-06  |  3.8 KB  |  129 lines
  1. ;; Copyright (C) 1894 by Gold Hill Computers
  2. ;;
  3. ;; The GCLisp Stepper
  4. ;;
  5.  
  6.  
  7. (DEFVAR *STEP-LEVEL* 0)        ; The current step nesting level
  8. (DEFVAR *STEP-TARGET* 0)    ; the next level to step to.
  9.  
  10. ;; The toplevel stepper
  11.  
  12. (DEFMACRO STEP X
  13.   `(STEP1 ',(FIRST X)))
  14.  
  15. (DEFUN STEP1 (STEP-FORM)
  16.   (LET ((*STEP-LEVEL* 1)
  17.         (*STEP-TARGET* 1)
  18.     (*BREAK-EVENT* 'STEP-BREAK)
  19.     STEP-VALUE STEP-VALUES)
  20.   (SEND *TRACE-OUTPUT* :CLEAR-INPUT)
  21.   (STEP-INTERNAL STEP-FORM)))
  22.  
  23. ;; The internal stepper function 
  24. ;;
  25. (DEFUN STEP-INTERNAL (STEP-FORM 
  26.        &REST ENV)
  27.   (WHEN ENV  (SETF STEP-VALUES ENV
  28.              STEP-VALUE  (FIRST ENV)))
  29.   (STEP-INTERNAL-COMMAND))
  30.  
  31. (DEFUN STEP-INTERNAL-COMMAND ()
  32.   (COND 
  33.     ((< *STEP-TARGET* 0)
  34.      (SETF STEP-VALUE
  35.           (FIRST (SETF STEP-VALUES
  36.              (MULTIPLE-VALUE-LIST (EVAL STEP-FORM))))))
  37.     ((NEQ *STEP-TARGET* *STEP-LEVEL*)
  38.      (DECF *STEP-LEVEL*)                ; unwind it.
  39.      (SETF STEP-VALUE
  40.           (FIRST (SETF STEP-VALUES
  41.              (MULTIPLE-VALUE-LIST (EVAL STEP-FORM))))))
  42.     (T 
  43.      (SEND *TRACE-OUTPUT* :FRESH-LINE)        ; clear the output
  44.      (STEP-INDENT)
  45.      (FORMAT *TRACE-OUTPUT* "~S" STEP-FORM)    ; print the input form
  46.      (CASE (STEPPER-COMMAND)            ; now dispatch on it.
  47.        (26                    ; move across it.
  48.         (SETF STEP-VALUE  (FIRST (SETF STEP-VALUES
  49.                                    (MULTIPLE-VALUE-LIST
  50.                             (EVAL STEP-FORM)))))
  51.         (IF (EQ 1 (LENGTH STEP-VALUES))
  52.         (FORMAT *TRACE-OUTPUT* " --> ~S~&" STEP-VALUE)
  53.             (FORMAT *TRACE-OUTPUT* " --> ~S~&" STEP-VALUES)))
  54.  
  55.        (25                    ; next level down
  56.         (INCF *STEP-LEVEL*)
  57.         (INCF *STEP-TARGET*)
  58.         (SETF STEP-VALUE   
  59.       (FIRST (SETF STEP-VALUES 
  60.                   (MULTIPLE-VALUE-LIST
  61.                     (EVALHOOK STEP-FORM 'STEP-INTERNAL NIL)))))
  62.         (SEND *TRACE-OUTPUT* :FRESH-LINE)    ; and print exit things
  63.         (STEP-INDENT)
  64.         (WHEN (EQ *STEP-LEVEL* *STEP-TARGET*)
  65.           (IF (EQ 1 (LENGTH STEP-VALUES))
  66.               (FORMAT *TRACE-OUTPUT* "~S = ~S" STEP-FORM STEP-VALUE)
  67.               (FORMAT *TRACE-OUTPUT* "~S = ~S" STEP-FORM STEP-VALUES))
  68.           (DECF *STEP-TARGET*))
  69.     (DECF *STEP-LEVEL*))
  70.  
  71.        (24                    ; up one level
  72.         (SETF STEP-VALUE             ; eval it with 
  73.             (FIRST (SETF STEP-VALUES    ; no info printed.
  74.                   (MULTIPLE-VALUE-LIST (EVAL STEP-FORM)))))
  75.         (DECF *STEP-TARGET*))
  76.  
  77.        (5                ; let it roll without stepping 
  78.         (SETF *STEP-TARGET* -1)
  79.         (SETF STEP-VALUE         ; eval it with no info printed.
  80.          (FIRST (SETF STEP-VALUES
  81.                     (MULTIPLE-VALUE-LIST (EVAL STEP-FORM))))))
  82.  
  83. ;;
  84.        (11                ; pretty print the thing
  85.         (PPRINT STEP-FORM)
  86.         (SEND *TRACE-OUTPUT* :WRITE-CHAR #\NEWLINE)
  87.         (STEP-INDENT)
  88.     (STEP-INTERNAL-COMMAND))
  89.        (OTHERWISE
  90.         (FORMAT *TRACE-OUTPUT* 
  91. "~&STEP commands are:
  92.       arrow-dn  ==> Step to next level down
  93.       arrow-rt  ==> Value of this form
  94.       arrow-up  ==> Step to next level up
  95.       arrow-lt  ==> PrettyPrint current form
  96.      Ctrl-Break ==> Enter Break Level
  97.         END     ==> Complete without more Stepping~%")
  98.             (STEP-INDENT)
  99.         (STEP-INTERNAL-COMMAND))
  100.      )
  101.                         ; and now return the values
  102.     (APPLY 'VALUES STEP-VALUES))))
  103.  
  104. (DEFUN STEP-BREAK (&REST IGNORE)
  105.   (BREAK "STEPPER BREAK")
  106.   (SEND *TRACE-OUTPUT* :CLEAR-INPUT)
  107.   (FORMAT *TRACE-OUTPUT* "~&Back to STEP with form:")
  108.   (SEND *TRACE-OUTPUT* :FRESH-LINE)        ; clear the output
  109.   (STEP-INDENT)
  110.   (FORMAT *TRACE-OUTPUT* "~S" STEP-FORM)    ; print the input form
  111.   )
  112.  
  113.  
  114.  
  115. (DEFUN STEPPER-COMMAND (&AUX %CHAR)
  116.   (SEND *TRACE-OUTPUT* :CLEAR-INPUT)
  117.   (WHEN (EQ (SETF %CHAR (SEND *TRACE-OUTPUT* :READ-CHAR)) #\SPACE)
  118.     (SETF %CHAR (SEND *TRACE-OUTPUT* :READ-CHAR)))
  119.   %CHAR)
  120.  
  121.  
  122. (DEFUN STEP-INDENT ()
  123.  (DOTIMES (I *STEP-LEVEL*) (SEND *TRACE-OUTPUT* :WRITE-CHAR #\SPACE)))
  124.  
  125.  
  126.  
  127.  
  128.  
  129.