home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / guile / 1.8 / ice-9 / debugging / ice-9-debugger-extensions.scm < prev    next >
Encoding:
Text File  |  2008-12-17  |  6.0 KB  |  173 lines
  1.  
  2. (define-module (ice-9 debugging ice-9-debugger-extensions)
  3.   #:use-module (ice-9 debugger))
  4.  
  5. ;;; Upgrade the debugger state object so that it can carry a flag
  6. ;;; indicating whether the debugging session is continuable.
  7.  
  8. (cond ((string>=? (version) "1.7")
  9.        (use-modules (ice-9 debugger state))
  10.        (define-module (ice-9 debugger state)))
  11.       (else
  12.        (define-module (ice-9 debugger))))
  13.  
  14. (set! state-rtd (make-record-type "debugger-state" '(stack index flags)))
  15. (set! state? (record-predicate state-rtd))
  16. (set! make-state
  17.   (let ((make-state-internal (record-constructor state-rtd
  18.                          '(stack index flags))))
  19.     (lambda (stack index . flags)
  20.       (make-state-internal stack index flags))))
  21. (set! state-stack (record-accessor state-rtd 'stack))
  22. (set! state-index (record-accessor state-rtd 'index))
  23.  
  24. (define state-flags (record-accessor state-rtd 'flags))
  25.  
  26. ;;; Add commands that (ice-9 debugger) doesn't currently have, for
  27. ;;; continuing or single stepping program execution.
  28.  
  29. (cond ((string>=? (version) "1.7")
  30.        (use-modules (ice-9 debugger command-loop))
  31.        (define-module (ice-9 debugger command-loop)
  32.      #:use-module (ice-9 debugger)
  33.      #:use-module (ice-9 debugger state)
  34.      #:use-module (ice-9 debugging traps))
  35.        (define new-define-command define-command)
  36.        (set! define-command
  37.          (lambda (name argument-template documentation procedure)
  38.            (new-define-command name argument-template procedure))))
  39.       (else
  40.        (define-module (ice-9 debugger))))
  41.  
  42. (use-modules (ice-9 debugging steps))
  43.  
  44. (define (assert-continuable state)
  45.   ;; Check that debugger is in a state where `continuing' makes sense.
  46.   ;; If not, signal an error.
  47.   (or (memq #:continuable (state-flags state))
  48.       (user-error "This debug session is not continuable.")))
  49.  
  50. (define (debugger:continue state)
  51.   "Tell the program being debugged to continue running.  (In fact this is
  52. the same as the @code{quit} command, because it exits the debugger
  53. command loop and so allows whatever code it was that invoked the
  54. debugger to continue.)"
  55.   (assert-continuable state)
  56.   (throw 'exit-debugger))
  57.  
  58. (define (debugger:finish state)
  59.   "Continue until evaluation of the current frame is complete, and
  60. print the result obtained."
  61.   (assert-continuable state)
  62.   (at-exit (- (stack-length (state-stack state))
  63.           (state-index state))
  64.        (list trace-trap debug-trap))
  65.   (debugger:continue state))
  66.  
  67. (define (debugger:step state n)
  68.   "Tell the debugged program to do @var{n} more steps from its current
  69. position.  One @dfn{step} means executing until the next frame entry
  70. or exit of any kind.  @var{n} defaults to 1."
  71.   (assert-continuable state)
  72.   (at-step debug-trap (or n 1))
  73.   (debugger:continue state))
  74.  
  75. (define (debugger:next state n)
  76.   "Tell the debugged program to do @var{n} more steps from its current
  77. position, but only counting frame entries and exits where the
  78. corresponding source code comes from the same file as the current
  79. stack frame.  (See @ref{Step Traps} for the details of how this
  80. works.)  If the current stack frame has no source code, the effect of
  81. this command is the same as of @code{step}.  @var{n} defaults to 1."
  82.   (assert-continuable state)
  83.   (at-step debug-trap
  84.        (or n 1)
  85.        (frame-file-name (stack-ref (state-stack state)
  86.                        (state-index state)))
  87.        (if (memq #:return (state-flags state))
  88.            #f
  89.            (- (stack-length (state-stack state)) (state-index state))))
  90.   (debugger:continue state))
  91.  
  92. (define-command "continue" '()
  93.   "Continue program execution."
  94.   debugger:continue)
  95.  
  96. (define-command "finish" '()
  97.   "Continue until evaluation of the current frame is complete, and
  98. print the result obtained."
  99.   debugger:finish)
  100.  
  101. (define-command "step" '('optional exact-integer)
  102.   "Continue until entry to @var{n}th next frame."
  103.   debugger:step)
  104.  
  105. (define-command "next" '('optional exact-integer)
  106.   "Continue until entry to @var{n}th next frame in same file."
  107.   debugger:next)
  108.  
  109. ;;; Export a couple of procedures for use by (ice-9 debugging trace).
  110.  
  111. (cond ((string>=? (version) "1.7"))
  112.       (else
  113.        (define-module (ice-9 debugger))
  114.        (export write-frame-short/expression
  115.            write-frame-short/application)))
  116.  
  117. ;;; Provide a `debug-trap' entry point in (ice-9 debugger).  This is
  118. ;;; designed so that it can be called to explore the stack at a
  119. ;;; breakpoint, and to single step from the breakpoint.
  120.  
  121. (define-module (ice-9 debugger))
  122.  
  123. (use-modules (ice-9 debugging traps))
  124.  
  125. (define *not-yet-introduced* #t)
  126.  
  127. (cond ((string>=? (version) "1.7"))
  128.       (else
  129.        (define (debugger-command-loop state)
  130.      (read-and-dispatch-commands state (current-input-port)))))
  131.  
  132. (define-public (debug-trap trap-context)
  133.   "Invoke the Guile debugger to explore the stack at the specified @var{trap}."
  134.   (start-stack 'debugger
  135.            (let* ((stack (tc:stack trap-context))
  136.               (flags1 (let ((trap-type (tc:type trap-context)))
  137.                 (case trap-type
  138.                   ((#:return #:error)
  139.                    (list trap-type
  140.                      (tc:return-value trap-context)))
  141.                   (else
  142.                    (list trap-type)))))
  143.               (flags (if (tc:continuation trap-context)
  144.                  (cons #:continuable flags1)
  145.                  flags1))
  146.               (state (apply make-state stack 0 flags)))
  147.          (if *not-yet-introduced*
  148.              (let ((ssize (stack-length stack)))
  149.                (display "This is the Guile debugger -- for help, type `help'.\n")
  150.                (set! *not-yet-introduced* #f)
  151.                (if (= ssize 1)
  152.                (display "There is 1 frame on the stack.\n\n")
  153.                (format #t "There are ~A frames on the stack.\n\n" ssize))))
  154.          (write-state-short-with-source-location state)
  155.          (debugger-command-loop state))))
  156.  
  157. (define write-state-short-with-source-location
  158.   (cond ((string>=? (version) "1.7")
  159.      write-state-short)
  160.     (else
  161.      (lambda (state)
  162.        (let* ((frame (stack-ref (state-stack state) (state-index state)))
  163.           (source (frame-source frame))
  164.           (position (and source (source-position source))))
  165.          (format #t "Frame ~A at " (frame-number frame))
  166.          (if position
  167.          (display-position position)
  168.          (display "unknown source location"))
  169.          (newline)
  170.          (write-char #\tab)
  171.          (write-frame-short frame)
  172.          (newline))))))
  173.