home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / STEP / STEPAUX.S < prev    next >
Encoding:
Text File  |  1993-09-29  |  4.8 KB  |  152 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;;
  3. ;;;     MODULE: STEPAUX
  4. ;;;
  5. ;;;     Purpose:        This Module defines all procedures,
  6. ;;;                     which are neccessary to code generated
  7. ;;;                     by the `step' macro.
  8. ;;;
  9. ;;;    Installation:    See "autostep.sc".
  10. ;;;
  11. ;;;     Notes:          All the procedures of this module should be
  12. ;;;            bound in the `user-global-environment'.
  13. ;;;                     
  14. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  15.  
  16. ;;; Is `true' when `step' is in `leap-mode'.
  17. ;;; See "step.doc" for discussion of the `leap-mode'.
  18. (define step-leap-mode #F)
  19.  
  20. ;;; Holds the depth of prodcedure and special form
  21. ;;; executions.
  22. (define step-call-depth 0)
  23.  
  24. ;;; Holds the depth, when `step' stops execution, when
  25. ;;; it is in `go-mode'.
  26. ;;; If `step' is not in `go-mode' this variable 
  27. ;;; is set to `-1'.
  28. (define step-stop-depth -1)
  29.  
  30. ;;; Increments the variable `step-call-depth'.
  31. (define (increment-call-depth)
  32.   (set! step-call-depth
  33.     (add1 step-call-depth)))
  34.  
  35. ;;; Decrements the variable `step-call-depth'.
  36. (define (decrement-call-depth)
  37.   (set! step-call-depth
  38.     (sub1 step-call-depth)))
  39.  
  40. ;;; This procedure is called from the code beeing
  41. ;;; stepped in order to stop after displaying
  42. ;;; some pieces of information.
  43. ;;; Its only argument is the environment of
  44. ;;; the procedure or expression beeing stepped.
  45. (define (stop-step env)
  46.   (if (< step-call-depth 0)
  47.       (set! step-call-depth 0))
  48.   (if (and (> step-stop-depth -1)               ; Are we in `go-mode'?
  49.        (>= step-call-depth step-stop-depth))
  50.       (begin                                    ; Yes; display prompt
  51.     (display "[Step ")
  52.     (display step-call-depth)
  53.     (display "] ")
  54.     (if (char-ready?)                       ; Is there input
  55.         (begin                              ; Yes...
  56.           (set! step-stop-depth -1)         ; Leave `go-mode'!
  57.           (flush-input)
  58.           (display "Halted")
  59.           (newline)
  60.           (stop-step env))
  61.         (display "Going")))                 ; No; display "Going".
  62.       ((named-lambda (loop)
  63.      (set! step-stop-depth -1)              ; Leave `go-mode'!
  64.      (display "[Step ")                     ; Display prompt.
  65.      (display step-call-depth)
  66.      (display "] ")
  67.      (case (integer->char (+ (char->integer (read-char)) 64))
  68.        (#\Q (display "Quit")
  69.         (set! step-call-depth 0)
  70.         (reset))
  71.        (#\R (display "Reset")
  72.         (set! step-call-depth 0)
  73.         (loop))
  74.        (#\M (display "Step"))
  75.        (#\I (display "Inspect")
  76.         (inspect env)
  77.         (loop))
  78.        (#\G (display "Go (Press any key to stop)")
  79.         (set! step-stop-depth step-call-depth))
  80.        (#\L (display "switch mode to: ")
  81.         (display "Leap mode")
  82.         (newline)
  83.         (set! step-leap-mode #T)
  84.         (loop))
  85.        (#\C (display "switch mode to: ")
  86.         (display "Creap mode")
  87.         (newline)
  88.         (set! step-leap-mode #F)
  89.         (loop))
  90.        (#\T (display "toggle mode to: ")
  91.         (if step-leap-mode
  92.             (display "Creap mode")
  93.             (display "Leap mode"))
  94.         (newline)
  95.         (set! step-leap-mode
  96.               (not step-leap-mode))
  97.         (loop))
  98.        (#\S (display "show mode: ")
  99.         (if step-leap-mode
  100.             (display "Leap mode")
  101.             (display "Creap mode"))
  102.         (newline)
  103.         (loop))
  104.        (#\rubout    ; #\? + 64 == #\rubout
  105.          (display #\?)
  106.          (newline)
  107.          (display "   ?    -- display this command summary")
  108.          (newline)
  109.          (display " ctrl-Q -- Quit")
  110.          (newline)
  111.          (display " ctrl-R -- Reset the level counter to zero")
  112.          (newline)
  113.          (display " ctrl-M -- Step")
  114.          (newline)
  115.          (display " ctrl-G -- Go through deeper levels without stopping")
  116.          (newline)
  117.          (display " ctrl-I -- Inspect the environment")
  118.          (newline)
  119.          (display " ctrl-L -- switch to Leap mode")
  120.          (newline)
  121.          (display " ctrl-C -- switch to Creap mode")
  122.          (newline)
  123.          (display " ctrl-T -- Toggle mode")
  124.          (newline)
  125.          (display " ctrl-S -- Show mode")
  126.          (newline)
  127.          (display "To enter `ctrl-Q', press both `CTRL' and `Q'.")
  128.          (newline)
  129.          (newline)
  130.          (loop))
  131.        (else (display "  ?  Invalid response...  Type `?' for help")
  132.          (newline)
  133.          (loop))))))
  134.   (newline))
  135.  
  136.  
  137. ;;; Removes every variable and every procedure 
  138. ;;; related to `step' form the system.
  139. ;;; It is implementation dependent.
  140. ;;; It is neccessary, that "stepaux.*" is loaed into the
  141. ;;; `user-global-environmenmt'.
  142. (define (remove-step)
  143.   (unbind 'step-environment user-global-environment)
  144.   (unbind 'step-leap-mode user-global-environment)
  145.   (unbind 'step-call-depth user-global-environment)
  146.   (unbind 'step-stop-depth user-global-environment)
  147.   (unbind 'increment-call-depth user-global-environment)
  148.   (unbind 'decrement-call-depth user-global-environment)
  149.   (unbind 'stop-step user-global-environment)
  150.   (unbind 'remove-step user-global-environment)
  151.   *the-non-printing-object*)
  152.