← Back to branch summary

~ubuntu-branches/ubuntu/utopic/electric/utopic-proposed

« back to all changes in this revision

Viewing changes to lib/lisp/debug.scm

  • Committer: Bazaar Package Importer
  • Author(s): Onkar Shinde
  • Date: 2008-07-23 02:09:53 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20080723020953-1gmnv7q2wpsdbnop
Tags: 8.07-0ubuntu1
https://launchpad.net/bugs/242720
* New Upstream version. Please check changelog for details. (LP: #242720)
* debian/control
  - Add build dependencies *-jdk, cdbs and bsh.
  - Remove build dependency dpatch. We will be using CDBS simple patchsys.
  - Refreshed runtime dependencies to default-jre | java2-runtime and bsh.
  - Added home page field.
  - Standard version 3.8.0.
  - Modify Maintainer value to match the DebianMaintainerField
    specification.
  - Changed email address for original maintainer to indicate who has
    refreshed the packaging.
* debian/rules
  - Revamped to use cdbs.
  - Added get-orig-source target.
* debian/patches
  - 00list, 02_sensible-browser.dpatch, 01_errors-numbers.dpatch,
    03_manpage.dpatch - Deleted, not relevant anymore.
  - 01_fix_build_xml.patch - Patch to fix the build.xml.
* debian/ant.properties
  - File to set various compilation properties.
* debian/electric.1
  - Remove the entry that causes lintian warning.
* debian/electric.desktop
  - Change as suggested by desktop-file-validate.
* debian/electric.docs
  - Updated as per changes in file names.
* debian/electric.svg
  - Name changed from electric_icon.svg.
* debian/install
  - Added appropriate locations for jar file, desktop file and wrapper shell
    script.
* debian/README.source
  - Added to comply with standards version 3.8.0.
* debian/TODO.Debian
  - Name changed form TODO.
* debain/wrapper/electric
  - Wrapper shell script to launch the application.
* debian/manpages
  - Added for installation of manpage.
* debian/watch
  - Updated to match jar files instead of older tar.gz files.
* debian/dirs
  - Removed, not needed anymore.
* debian/{electric.doc-base, electric.examples, substvars}
  - Removed, not relevant anymore.
* debian/*.debhelper
  - Removed auto generated files. Not relevant anymore.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/lisp/debug.scm
1
 
;;; -*-Scheme-*-
2
 
;;;
3
 
;;; A simple debugger (improvements by Thomas M. Breuel <tmb@ai.mit.edu>).
4
 
 
5
 
(define (backtrace . args)
6
 
  (if (> (length args) 1)
7
 
      (error 'backtrace "too many arguments"))
8
 
  (if (not (null? args))
9
 
      (if (not (eq? (type (car args)) 'control-point))
10
 
          (error 'backtrace "argument must be a control point")))
11
 
  (let ((trace (apply backtrace-list args)))
12
 
    (if (null? args)
13
 
        (set! trace (cdddr trace)))
14
 
    (show-backtrace trace 0 999999)))
15
 
 
16
 
(define (show-backtrace trace start-frame end-frame)
17
 
  (define (rjust n x)
18
 
    (let* ((y (string-append (make-string n #\space) x))
19
 
           (l (string-length y)))
20
 
      (substring y (- l n) l)))
21
 
  (let ((maxlen 28))
22
 
    (let loop ((frames (list-tail trace start-frame)) (num start-frame))
23
 
      (if (or (null? frames) (>= num end-frame)) #v
24
 
          (let ((frame (car frames)))
25
 
            (let* ((func
26
 
                    (format #f "~s" (vector-ref frame 0)))
27
 
                   (indent 
28
 
                    (- maxlen (+ 5 (string-length func)))))
29
 
              (display (rjust 4 (number->string num)))
30
 
              (display " ")
31
 
              (display func)
32
 
              (if (negative? indent)
33
 
                  (begin
34
 
                    (newline)
35
 
                    (set! indent maxlen)))
36
 
              (do ((i indent (1- i)))
37
 
                  ((> 0 i))
38
 
                (display " ")))
39
 
            (fluid-let
40
 
                ((print-depth 2)
41
 
                 (print-length 3))
42
 
              (display (vector-ref frame 1)))
43
 
            (newline))
44
 
          (loop (cdr frames) (1+ num))))))
45
 
 
46
 
(define (show-environment env)
47
 
  (fluid-let
48
 
      ((print-length 2)
49
 
       (print-depth 2))
50
 
    (do ((f (environment->list env) (cdr f)))
51
 
        ((null? f))
52
 
      (do ((b (car f) (cdr b)))
53
 
          ((null? b))
54
 
        (format #t "~s\t~s~%" (caar b) (cdar b)))
55
 
      (print '-------)))
56
 
  #v)
57
 
 
58
 
(define inspect)
59
 
 
60
 
(let ((frame)
61
 
      (trace)
62
 
      (help-text
63
 
       '("q     -- quit inspector"
64
 
         "f     -- print current frame"
65
 
         "u     -- go up one frame"
66
 
         "d     -- go down one frame"
67
 
         "^     -- go to top frame"
68
 
         "$     -- go to bottom frame"
69
 
         "g <n> -- goto to n-th frame"
70
 
         "e     -- eval expressions in environment"
71
 
         "p     -- pretty-print procedure"
72
 
         "v     -- show environment"
73
 
         "<n>   -- pretty-print n-th argument"
74
 
         "b     -- show backtrace starting at current frame"
75
 
         "t     -- show top of bracktrace starting at current frame"
76
 
         "z     -- show and move top of backtrace starting at current frame"
77
 
         "o     -- obarray information")))
78
 
  
79
 
  (define (inspect-command-loop)
80
 
    (let ((input) (done #f))
81
 
      (display "inspect> ")
82
 
      (set! input (read))
83
 
      (case input
84
 
        (q
85
 
         (set! done #t))
86
 
        (? 
87
 
         (for-each
88
 
          (lambda (msg)
89
 
            (display msg)
90
 
            (newline))
91
 
          help-text))
92
 
        (f
93
 
         (print-frame))
94
 
        (^
95
 
         (set! frame 0)
96
 
         (print-frame))
97
 
        ($
98
 
         (set! frame (1- (length trace)))
99
 
         (print-frame))
100
 
        (u
101
 
         (if (zero? frame)
102
 
             (format #t "Already on top frame.~%")
103
 
             (set! frame (1- frame))
104
 
           (print-frame)))
105
 
        (d
106
 
         (if (= frame (1- (length trace)))
107
 
             (format #t "Already on bottom frame.~%")
108
 
             (set! frame (1+ frame))
109
 
           (print-frame)))
110
 
        (g
111
 
         (set! input (read))
112
 
         (if (integer? input)
113
 
             (set! frame
114
 
                   (cond ((negative? input) 0)
115
 
                         ((>= input (length trace)) (1- (length trace)))
116
 
                         (else input)))
117
 
             (format #t "Frame number must be an integer.~%")))
118
 
        (v
119
 
         (show-environment (vector-ref (list-ref trace frame) 2)))
120
 
        (e
121
 
         (format #t "Type ^D to return to Inspector.~%")
122
 
         (let loop ()
123
 
           (display "eval> ")
124
 
           (set! input (read))
125
 
           (if (not (eof-object? input))
126
 
               (begin
127
 
                 (write (eval input
128
 
                              (vector-ref (list-ref trace frame) 2)))
129
 
                 (newline)
130
 
                 (loop))))
131
 
         (newline))
132
 
        (p
133
 
         (pp (vector-ref (list-ref trace frame) 0))
134
 
         (newline))
135
 
        (z
136
 
         (show-backtrace trace frame (+ frame 10))
137
 
         (set! frame (+ frame 9))
138
 
         (if (>= frame (length trace)) (set! frame (1- (length trace)))))
139
 
        (t
140
 
         (show-backtrace trace frame (+ frame 10)))
141
 
        (b
142
 
         (show-backtrace trace frame 999999))
143
 
        (o
144
 
         (let ((l (map length (oblist))))
145
 
           (let ((n 0))
146
 
             (for-each (lambda (x) (set! n (+ x n))) l)
147
 
             (format #t "~s symbols " n)
148
 
             (format #t "(maximum bucket: ~s).~%" (apply max l)))))
149
 
        (else
150
 
         (cond
151
 
          ((integer? input)
152
 
           (let ((args (vector-ref (list-ref trace frame) 1)))
153
 
             (if (or (< input 1) (> input (length args)))
154
 
                 (format #t "No such argument.~%")
155
 
                 (pp (list-ref args (1- input)))
156
 
               (newline))))
157
 
          ((eof-object? input)
158
 
           (set! done #t))
159
 
          (else
160
 
           (format #t "Invalid command.  Type ? for help.~%")))))
161
 
      (if (not done)
162
 
          (inspect-command-loop))))
163
 
 
164
 
  (define (print-frame)
165
 
    (format #t "~%Frame ~s of ~s:~%~%" frame (1- (length trace)))
166
 
    (let* ((f (list-ref trace frame)) (args (vector-ref f 1)))
167
 
      (format #t "Procedure:    ~s~%" (vector-ref f 0))
168
 
      (format #t "Environment:  ~s~%" (vector-ref f 2))
169
 
      (if (null? args)
170
 
          (format #t "No arguments.~%")
171
 
          (fluid-let
172
 
              ((print-depth 2)
173
 
               (print-length 3))
174
 
            (do ((i 1 (1+ i)) (args args (cdr args))) ((null? args))
175
 
              (format #t "Argument ~s:   ~s~%" i (car args))))))
176
 
    (newline))
177
 
 
178
 
  (define (find-frame proc)
179
 
    (let loop ((l trace) (i 0))
180
 
         (cond ((null? l) -1)
181
 
               ((eq? (vector-ref (car l) 0) proc) i)
182
 
               (else (loop (cdr l) (1+ i))))))
183
 
  
184
 
  (set! inspect
185
 
        (lambda ()
186
 
          (set! trace (backtrace-list))
187
 
          (set! trace (cddr trace))
188
 
          (do ((t trace (cdr t)) (f 1 (1+ f))) ((null? t))
189
 
            (if (not (null? (vector-ref (car t) 1)))
190
 
                (let ((last (last-pair (vector-ref (car t) 1))))
191
 
                  (if (not (null? (cdr last)))
192
 
                      (begin
193
 
                        (format #t
194
 
 "[inspector: fixing improper arglist in frame ~s]~%" f)
195
 
                        (set-cdr! last (cons (cdr last) '())))))))
196
 
          (set! frame (find-frame error-handler))
197
 
          (if (negative? frame)
198
 
              (set! frame 0))
199
 
          (format #t "Inspector (type ? for help):~%")
200
 
          (let loop ()
201
 
            (if (call-with-current-continuation
202
 
                 (lambda (control-point)
203
 
                   (push-frame control-point)
204
 
                   (inspect-command-loop)
205
 
                   #f))
206
 
                (begin
207
 
                  (pop-frame)
208
 
                  (loop))))
209
 
          (newline)
210
 
          (pop-frame)
211
 
          (let ((next-frame (car rep-frames)))
212
 
            (next-frame #t)))))