|
0
|
1 ;;; sun-eos-debugger.el --- Implements the XEmacs/SPARCworks interface
|
|
|
2
|
|
|
3 ;; Copyright (C) 1995 Sun Microsystems, Inc.
|
|
|
4
|
|
|
5 ;; Maintainer: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
|
|
|
6 ;; Author: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
|
|
|
7
|
|
|
8 ;; Keywords: SPARCworks EOS Era on SPARCworks Debugger dbx
|
|
|
9
|
|
|
10 ;;; Commentary:
|
|
|
11
|
|
|
12 ;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com
|
|
|
13
|
|
|
14 ;;; Code:
|
|
|
15
|
|
|
16 (require 'eos-common "sun-eos-common")
|
|
|
17
|
|
|
18 ;;; =================
|
|
|
19 ;;; debugger protocol
|
|
|
20 ;;; =================
|
|
|
21
|
|
|
22 (defvar eos::current-hollow-arrow nil)
|
|
|
23 (defvar eos::current-solid-arrow nil)
|
|
|
24 (defvar eos::current-dbx-proc-id nil
|
|
|
25 "TT id for the current dbx")
|
|
|
26 (defvar eos::current-debugger-clique-id nil
|
|
|
27 "Clique_ID for the current debugger/dbx")
|
|
|
28
|
|
|
29 ;; currentpc.color
|
|
|
30
|
|
|
31 (defvar eos::currentpc-inst "/* XPM */
|
|
|
32 static char * file[] = {
|
|
|
33 \"16 11 5 1\",
|
|
|
34 \" s background c #BDBDBDBDBDBD\",
|
|
|
35 \". c #000000000000\",
|
|
|
36 \"X c #0000FFFF0000\",
|
|
|
37 \"o c #000077770000\",
|
|
|
38 \"O c #000044440000\",
|
|
|
39 \" . \",
|
|
|
40 \" .. \",
|
|
|
41 \" .X. \",
|
|
|
42 \" .........XX. \",
|
|
|
43 \" .XXXXXXXXXoX. \",
|
|
|
44 \" .Xooooooooooo. \",
|
|
|
45 \" .oOOOOOOOOoO. \",
|
|
|
46 \" .........OO. \",
|
|
|
47 \" .O. \",
|
|
|
48 \" .. \",
|
|
|
49 \" . \"};")
|
|
|
50
|
|
|
51 (defvar eos::currentpc-inst-alt
|
|
|
52 "/* XPM */
|
|
|
53 static char * file[] = {
|
|
|
54 \"16 11 5 1\",
|
|
|
55 \" s background c #BDBDBDBDBDBD\",
|
|
|
56 \". c #000000000000\",
|
|
|
57 \"X c #0000FFFF0000\",
|
|
|
58 \"o c #000077770000\",
|
|
|
59 \"O c #000044440000\",
|
|
|
60 \" . \",
|
|
|
61 \" .. \",
|
|
|
62 \" .X. \",
|
|
|
63 \" .........XX. \",
|
|
|
64 \" .XXXXXXXXXoX. \",
|
|
|
65 \" .Xooooooooooo. \",
|
|
|
66 \" .oOOOOOOOOoO. \",
|
|
|
67 \" .........OO. \",
|
|
|
68 \" .O. \",
|
|
|
69 \" .. ..\",
|
|
|
70 \" . ..\"};")
|
|
|
71
|
|
|
72 (defvar eos::visitedpc-inst
|
|
|
73 "/* XPM */
|
|
|
74 static char * file[] ={
|
|
|
75 \"16 11 5 1\",
|
|
|
76 \" s background c #BDBDBDBDBDBD\",
|
|
|
77 \". c #000000000000\",
|
|
|
78 \"X c #AFAFAFAFAFAF\",
|
|
|
79 \"o c #7E7E7E7EA9A9\",
|
|
|
80 \"O c #666633339999\",
|
|
|
81 \" . \",
|
|
|
82 \" .. \",
|
|
|
83 \" .X. \",
|
|
|
84 \" .........XX. \",
|
|
|
85 \" .XXXXXXXXXoX. \",
|
|
|
86 \" .XooooooooooO. \",
|
|
|
87 \" .XOOOOOOOOoO. \",
|
|
|
88 \" .........OO. \",
|
|
|
89 \" .O. \",
|
|
|
90 \" .. \",
|
|
|
91 \" . \"};")
|
|
|
92
|
|
|
93 (defvar eos::visitedpc-inst-alt
|
|
|
94 "/* XPM */
|
|
|
95 static char * file[] ={
|
|
|
96 \"16 11 5 1\",
|
|
|
97 \" s background c #BDBDBDBDBDBD\",
|
|
|
98 \". c #000000000000\",
|
|
|
99 \"X c #AFAFAFAFAFAF\",
|
|
|
100 \"o c #7E7E7E7EA9A9\",
|
|
|
101 \"O c #666633339999\",
|
|
|
102 \" . \",
|
|
|
103 \" .. \",
|
|
|
104 \" .X. \",
|
|
|
105 \" .........XX. \",
|
|
|
106 \" .XXXXXXXXXoX. \",
|
|
|
107 \" .XooooooooooO. \",
|
|
|
108 \" .XOOOOOOOOoO. \",
|
|
|
109 \" .........OO. \",
|
|
|
110 \" .O. \",
|
|
|
111 \" .. ..\",
|
|
|
112 \" . ..\"};")
|
|
|
113
|
|
|
114 (defvar eos::breakpoint-inst
|
|
|
115 "/* XPM */
|
|
|
116 static char * file[] ={
|
|
|
117 \"11 11 5 1\",
|
|
|
118 \" s background c #BDBDBDBDBDBD\",
|
|
|
119 \". c #000000000000\",
|
|
|
120 \"X c #FFFF66666666\",
|
|
|
121 \"o c #FFFF00000000\",
|
|
|
122 \"O c #777700000000\",
|
|
|
123 \" ..... \",
|
|
|
124 \" .XXXXX. \",
|
|
|
125 \" .XXoooXX. \",
|
|
|
126 \".XXoooooXO.\",
|
|
|
127 \".XoooooooO.\",
|
|
|
128 \".XoooooooO.\",
|
|
|
129 \".XoooooooO.\",
|
|
|
130 \".XXoooooOO.\",
|
|
|
131 \" .XXoooOO. \",
|
|
|
132 \" .OOOOO. \",
|
|
|
133 \" ..... \"};")
|
|
|
134
|
|
|
135 (defvar eos::breakpoint-inst-alt
|
|
|
136 "/* XPM */
|
|
|
137 static char * file[] ={
|
|
|
138 \"11 11 5 1\",
|
|
|
139 \" s background c #BDBDBDBDBDBD\",
|
|
|
140 \". c #000000000000\",
|
|
|
141 \"X c #FFFF66666666\",
|
|
|
142 \"o c #FFFF00000000\",
|
|
|
143 \"O c #777700000000\",
|
|
|
144 \" ..... \",
|
|
|
145 \" .XXXXX. \",
|
|
|
146 \" .XXoooXX. \",
|
|
|
147 \".XXoooooXO.\",
|
|
|
148 \".XoooooooO.\",
|
|
|
149 \".XoooooooO.\",
|
|
|
150 \".XoooooooO.\",
|
|
|
151 \".XXoooooOO.\",
|
|
|
152 \" .XXoooOO. \",
|
|
|
153 \" .OOOOO...\",
|
|
|
154 \" ..... ..\"};")
|
|
|
155
|
|
|
156 ;; The TT protocol does not provide enough information to
|
|
|
157 ;; use the eos::disabledBreakpoint glyph.
|
|
|
158
|
|
|
159 (defvar eos::disabledBreakpoint-inst
|
|
|
160 "/* XPM */
|
|
|
161 static char * file[] ={
|
|
|
162 \"11 11 4 1\",
|
|
|
163 \" s background c #BDBDBDBDBDBD\",
|
|
|
164 \". c #000000000000\",
|
|
|
165 \"X c Grey\",
|
|
|
166 \"O c Grey80\",
|
|
|
167 \" ..... \",
|
|
|
168 \" .XXXXX. \",
|
|
|
169 \" .XXXXXXX. \",
|
|
|
170 \".XXXXXXXXO.\",
|
|
|
171 \".XXXXXXXXO.\",
|
|
|
172 \".XXXXXXXXO.\",
|
|
|
173 \".XXXXXXXXO.\",
|
|
|
174 \".XXXXXXXOO.\",
|
|
|
175 \" .XXXXXOO. \",
|
|
|
176 \" .OOOOO. \",
|
|
|
177 \" ..... \"};")
|
|
|
178
|
|
|
179 (defvar eos::disabledBreakpoint-inst-alt
|
|
|
180 "/* XPM */
|
|
|
181 static char * file[] ={
|
|
|
182 \"11 11 4 1\",
|
|
|
183 \" s background c #BDBDBDBDBDBD\",
|
|
|
184 \". c #000000000000\",
|
|
|
185 \"X c Grey\",
|
|
|
186 \"O c Grey80\",
|
|
|
187 \" ..... \",
|
|
|
188 \" .XXXXX. \",
|
|
|
189 \" .XXXXXXX. \",
|
|
|
190 \".XXXXXXXXO.\",
|
|
|
191 \".XXXXXXXXO.\",
|
|
|
192 \".XXXXXXXXO.\",
|
|
|
193 \".XXXXXXXXO.\",
|
|
|
194 \".XXXXXXXOO.\",
|
|
|
195 \" .XXXXXOO. \",
|
|
|
196 \" .OOOOO...\",
|
|
|
197 \" ..... ..\"};")
|
|
|
198
|
|
|
199 (defvar eos::dbx-pattern-list nil)
|
|
|
200
|
|
|
201 (defun eos::debugger-startup ()
|
|
|
202 ;; Actions to do at startup for eos-debugger.el
|
|
|
203 (make-face 'stop-face)
|
|
|
204 (make-face 'solid-arrow-face)
|
|
|
205 (make-face 'hollow-arrow-face)
|
|
|
206
|
|
|
207 (set-face-foreground 'stop-face eos::stop-color)
|
|
|
208 (set-face-background 'stop-face
|
|
|
209 (face-background (get-face 'default)))
|
|
|
210 (set-face-foreground 'solid-arrow-face eos::solid-arrow-color)
|
|
|
211 (set-face-background 'solid-arrow-face
|
|
|
212 (face-background (get-face 'default)))
|
|
|
213 (set-face-foreground 'hollow-arrow-face eos::hollow-arrow-color)
|
|
|
214 (set-face-background 'hollow-arrow-face
|
|
|
215 (face-background (get-face 'default)))
|
|
|
216
|
|
|
217 (setq eos::dbx-pattern-list ; list of dbx TT patterns
|
|
|
218 (eos::create-debugger-patterns))
|
|
|
219
|
|
|
220 ;; should there be only one stop-face, with different properties depending
|
|
|
221 ;; on the frame/device?
|
|
|
222
|
|
|
223 (eos::annotation-set-inst 'debugger-stop 'x eos::breakpoint-inst [nothing])
|
|
|
224 (eos::annotation-set-inst 'debugger-stop 'tty "[S]" [nothing])
|
|
|
225 (eos::annotation-set-face 'debugger-stop 'x
|
|
|
226 (get-face 'stop-face) (get-face 'stop-face))
|
|
|
227 (eos::annotation-set-face 'debugger-stop 'tty
|
|
|
228 (get-face 'highlight) (get-face 'highlight))
|
|
|
229
|
|
|
230 (eos::annotation-set-inst 'debugger-hollow-arrow 'x eos::visitedpc-inst [nothing])
|
|
|
231 (eos::annotation-set-inst 'debugger-hollow-arrow 'tty "[]>" [nothing])
|
|
|
232 (eos::annotation-set-face 'debugger-hollow-arrow 'x
|
|
|
233 (get-face 'hollow-arrow-face)
|
|
|
234 (get-face 'hollow-arrow-face))
|
|
|
235 (eos::annotation-set-face 'debugger-hollow-arrow 'tty
|
|
|
236 (get-face 'highlight) (get-face 'highlight))
|
|
|
237
|
|
|
238 (eos::annotation-set-inst 'debugger-solid-arrow 'x eos::currentpc-inst [nothing])
|
|
|
239 (eos::annotation-set-inst 'debugger-solid-arrow 'tty "=>" [nothing])
|
|
|
240 (eos::annotation-set-face 'debugger-solid-arrow 'x
|
|
|
241 (get-face 'solid-arrow-face)
|
|
|
242 (get-face 'solid-arrow-face))
|
|
|
243 (eos::annotation-set-face 'debugger-solid-arrow 'tty
|
|
|
244 (get-face 'highlight) (get-face 'highlight))
|
|
|
245 )
|
|
|
246
|
|
|
247 ;; Not yet ready for prime time.
|
|
|
248
|
|
|
249 (defvar eos::fill-stack-buffer nil
|
|
|
250 "when t don't try any stack tracing")
|
|
|
251
|
|
|
252 (defvar eos::stack-buffer "*Eos Stack*"
|
|
|
253 "name of buffer where to log Stack")
|
|
|
254
|
|
|
255 (defun eos::empty-stack ()
|
|
|
256 ;; No valid stack data - e.g. resume/run program -
|
|
|
257 (if eos::fill-stack-buffer
|
|
|
258 (progn
|
|
|
259 (set-buffer (get-buffer-create eos::stack-buffer))
|
|
|
260 (toggle-read-only -1)
|
|
|
261 (delete-region (point-min) (point-max))
|
|
|
262 (toggle-read-only 1)
|
|
|
263 )))
|
|
|
264
|
|
|
265 (defun eos::load-stack ()
|
|
|
266 ;; Should send a TT message requesting for the stack information;
|
|
|
267 ;; with the real work done in a callback
|
|
|
268 (if eos::fill-stack-buffer
|
|
|
269 (eos::stack-test 1)))
|
|
|
270
|
|
|
271 (defun eos::visit-stack (stackpos)
|
|
|
272 (if eos::fill-stack-buffer
|
|
|
273 (progn
|
|
|
274 (eos::empty-stack)
|
|
|
275 (eos::stack-test 1)
|
|
|
276 )))
|
|
|
277
|
|
|
278 (defun eos::create-stack-patterns ()
|
|
|
279 ;; returns a list of patterns
|
|
|
280 (list
|
|
|
281 (make-an-observer "SPRO_SPIDER_FRAMES" 'eos::spro_spider_frames)
|
|
|
282 ))
|
|
|
283
|
|
|
284 (defun eos::spro_spider_frames (msg pat)
|
|
|
285 ;; We have received a SPRO_SPIDER_FRAMES notice
|
|
|
286 (let ((count (get-tooltalk-message-attribute msg 'args_count))
|
|
|
287 (i 1))
|
|
|
288 (set-buffer (get-buffer-create eos::stack-buffer))
|
|
|
289 (toggle-read-only -1)
|
|
|
290 (while (< i count)
|
|
|
291 ;; optional leading comment
|
|
|
292 (if (equal (get-tooltalk-message-attribute msg 'arg_type i)
|
|
|
293 "Stack_Info1")
|
|
|
294 (progn
|
|
|
295 (insert (get-tooltalk-message-attribute msg 'arg_val i))
|
|
|
296 (setq i (1+ i))))
|
|
|
297 ;; current frame?
|
|
|
298 (insert (if (equal (get-tooltalk-message-attribute msg 'arg_ival i)
|
|
|
299 "0") " " "> "))
|
|
|
300 (setq i (1+ i))
|
|
|
301 (insert (format "[%s] %s%s %s:%s"
|
|
|
302 ;; frameno
|
|
|
303 (get-tooltalk-message-attribute msg 'arg_ival i)
|
|
|
304 ;; funcname
|
|
|
305 (get-tooltalk-message-attribute msg 'arg_val (+ i 1))
|
|
|
306 ;; funcargs
|
|
|
307 (get-tooltalk-message-attribute msg 'arg_val (+ i 2))
|
|
|
308 ;; source
|
|
|
309 (get-tooltalk-message-attribute msg 'arg_val (+ i 3))
|
|
|
310 ;; line
|
|
|
311 (get-tooltalk-message-attribute msg 'arg_val (+ i 4))))
|
|
|
312 (setq i (+ i 5))
|
|
|
313 (if (equal (get-tooltalk-message-attribute msg 'arg_type i)
|
|
|
314 "Stack_Info2")
|
|
|
315 (progn
|
|
|
316 (insert (get-tooltalk-message-attribute msg 'arg_val i))
|
|
|
317 (setq i (1+ i))))
|
|
|
318 (insert "\n"))
|
|
|
319 (toggle-read-only 1)
|
|
|
320 ;; (return-tooltalk-message msg)
|
|
|
321 ))
|
|
|
322
|
|
|
323 (defun eos::spider-stack-callback (msg pat)
|
|
|
324 ;; Callback after processing a spider_stack request
|
|
|
325 (destroy-tooltalk-message msg)
|
|
|
326 )
|
|
|
327
|
|
|
328 (defmacro eos::stack-tt-args (spider-id clique-id hidden verbose quick starting-index count)
|
|
|
329 (` (list
|
|
|
330 'class TT_REQUEST
|
|
|
331 'address TT_HANDLER
|
|
|
332 'scope TT_SESSION
|
|
|
333 'handler (, spider-id)
|
|
|
334 'op "SPRO_SPIDER_STACK"
|
|
|
335 'callback 'eos::spider-stack-callback
|
|
|
336 'args (list
|
|
|
337 (list 'TT_IN (, clique-id) "Context_ID")
|
|
|
338 (list 'TT_IN (, hidden) "Boolean")
|
|
|
339 (list 'TT_IN (, verbose) "Boolean")
|
|
|
340 (list 'TT_IN (, quick) "Boolean")
|
|
|
341 (list 'TT_IN (, starting-index) "int")
|
|
|
342 (list 'TT_IN (, count) "int"))
|
|
|
343 )))
|
|
|
344
|
|
|
345 (defun eos::stack-test (starting-index)
|
|
|
346 (let ((msg (make-tooltalk-message
|
|
|
347 (eos::stack-tt-args eos::current-dbx-proc-id
|
|
|
348 eos::current-debugger-clique-id
|
|
|
349 0 ; hidden
|
|
|
350 1 ; verbose
|
|
|
351 0 ; quick
|
|
|
352 starting-index
|
|
|
353 4 ; count
|
|
|
354 ))))
|
|
|
355 (send-tooltalk-message msg)
|
|
|
356 ;; (destroy-tooltalk-message msg)
|
|
|
357 ))
|
|
|
358
|
|
|
359 ;; (setq eos::fill-stack-buffer t)
|
|
|
360 ;; (setq eos::fill-stack-buffer nil)
|
|
|
361 ;; (setq eos::stack-pattern-list (eos::create-stack-patterns))
|
|
|
362 ;; (mapcar 'register-tooltalk-pattern eos::stack-pattern-list)
|
|
|
363 ;; (mapcar 'unregister-tooltalk-pattern eos::stack-pattern-list)
|
|
|
364 ;; (eos::stack-test 1)
|
|
|
365
|
|
|
366
|
|
|
367 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
368
|
|
|
369
|
|
|
370 ;;
|
|
|
371
|
|
|
372 (defun eos::spro_te_eventset (msg pat)
|
|
|
373 ;; thread_id trap_id string string filename lineno string string
|
|
|
374 (let* ((trap-id
|
|
|
375 (get-tooltalk-message-attribute msg 'arg_val 1))
|
|
|
376 (filename
|
|
|
377 (get-tooltalk-message-attribute msg 'arg_val 4))
|
|
|
378 (lineno
|
|
|
379 (read (get-tooltalk-message-attribute msg 'arg_ival 5))))
|
|
|
380 (eos::add-annotation 'debugger-stop filename lineno trap-id)
|
|
|
381 ;; (return-tooltalk-message msg)
|
|
|
382 ))
|
|
|
383
|
|
|
384 (defun eos::spro_te_eventdel (msg pat)
|
|
|
385 ;; trap_id string string filename lineno string string
|
|
|
386 (let* ((trap-id
|
|
|
387 (get-tooltalk-message-attribute msg 'arg_val 0))
|
|
|
388 (filename
|
|
|
389 (get-tooltalk-message-attribute msg 'arg_val 3))
|
|
|
390 (lineno
|
|
|
391 (read (get-tooltalk-message-attribute msg 'arg_ival 4))))
|
|
|
392 (eos::delete-annotation 'debugger-stop filename lineno trap-id)
|
|
|
393 ;; (return-tooltalk-message msg)
|
|
|
394 ))
|
|
|
395
|
|
|
396 (defun eos::spro_te_stopped (msg pat)
|
|
|
397 ;; thread_id filename procname lineno filename procname lineno
|
|
|
398 (let* ((filename-hollow
|
|
|
399 (get-tooltalk-message-attribute msg 'arg_val 1))
|
|
|
400 (procname-hollow
|
|
|
401 (get-tooltalk-message-attribute msg 'arg_val 2))
|
|
|
402 (lineno-hollow
|
|
|
403 (read (get-tooltalk-message-attribute msg 'arg_ival 3)))
|
|
|
404 (filename-solid
|
|
|
405 (get-tooltalk-message-attribute msg 'arg_val 4))
|
|
|
406 (lineno-solid
|
|
|
407 (read (get-tooltalk-message-attribute msg 'arg_ival 6)))
|
|
|
408 )
|
|
|
409 (setq eos::current-solid-arrow
|
|
|
410 (eos::make-annotation-visible eos::current-solid-arrow
|
|
|
411 filename-solid
|
|
|
412 lineno-solid
|
|
|
413 'debugger-solid-arrow))
|
|
|
414 (if (or (not (equal filename-solid filename-hollow))
|
|
|
415 (not (equal lineno-solid lineno-hollow)))
|
|
|
416 (setq eos::current-hollow-arrow
|
|
|
417 (eos::make-annotation-visible eos::current-hollow-arrow
|
|
|
418 filename-hollow
|
|
|
419 lineno-hollow
|
|
|
420 'debugger-hollow-arrow)))
|
|
|
421 ;; (return-tooltalk-message msg)
|
|
|
422 (eos::load-stack)
|
|
|
423 ))
|
|
|
424
|
|
|
425 ;; Tracking current id's
|
|
|
426 ;;
|
|
|
427
|
|
|
428 (defun eos::update-dbx-proc-id (msg)
|
|
|
429 (setq eos::current-dbx-proc-id
|
|
|
430 (get-tooltalk-message-attribute msg 'sender))
|
|
|
431 ;; the following is needed to make toolbar entries be active or not
|
|
|
432 ;; I think it is not needed in 19.13
|
|
|
433 (eos::select-debugger-frame eos::debugger-frame)
|
|
|
434 )
|
|
|
435
|
|
|
436 (defun eos::update-current-debugger-clique-id (msg)
|
|
|
437 (setq eos::current-debugger-clique-id
|
|
|
438 (get-tooltalk-message-attribute msg 'arg_val 0))
|
|
|
439 )
|
|
|
440
|
|
|
441 ;;
|
|
|
442 ;; Updating arrows
|
|
|
443 ;;
|
|
|
444
|
|
|
445
|
|
|
446 (defun eos::update-pids (msg)
|
|
|
447 (eos::update-dbx-proc-id msg)
|
|
|
448 (eos::update-current-debugger-clique-id msg))
|
|
|
449
|
|
|
450 (defun eos::internal-clear-annotations (stack arrows stops &optional clique)
|
|
|
451 (if stack
|
|
|
452 (eos::empty-stack))
|
|
|
453 (if arrows
|
|
|
454 (progn
|
|
|
455 (eos::make-annotation-invisible eos::current-hollow-arrow)
|
|
|
456 (eos::make-annotation-invisible eos::current-solid-arrow)))
|
|
|
457 (if clique
|
|
|
458 (progn
|
|
|
459 (setq eos::current-debugger-clique-id nil)
|
|
|
460 ;; not needed in 19.13?
|
|
|
461 (eos::select-debugger-frame eos::debugger-frame)))
|
|
|
462 (if stops
|
|
|
463 (eos::remove-all-from-annotation-list 'debugger-stop)))
|
|
|
464
|
|
|
465
|
|
|
466 (defun eos::clear-arrows (msg pat)
|
|
|
467 (eos::internal-clear-annotations t t nil)
|
|
|
468 ;; (return-tooltalk-message msg)
|
|
|
469 )
|
|
|
470
|
|
|
471 (defun eos::update-clear-stops (msg pat)
|
|
|
472 (eos::update-pids msg)
|
|
|
473 (eos::internal-clear-annotations t nil t)
|
|
|
474 ;; (return-tooltalk-message msg)
|
|
|
475 )
|
|
|
476
|
|
|
477 (defun eos::update-clear-arrows-stops (msg pat)
|
|
|
478 (eos::update-pids msg)
|
|
|
479 (eos::internal-clear-annotations t t t)
|
|
|
480 ;; (return-tooltalk-message msg)
|
|
|
481 )
|
|
|
482
|
|
|
483 (defun eos::clear-arrows-stops (msg pat)
|
|
|
484 (let ((this-proc-id
|
|
|
485 (get-tooltalk-message-attribute msg 'sender)))
|
|
|
486 (if (equal eos::current-dbx-proc-id this-proc-id)
|
|
|
487 (progn
|
|
|
488 (eos::internal-clear-annotations t t t)
|
|
|
489 ;; (return-tooltalk-message msg)
|
|
|
490 ))))
|
|
|
491
|
|
|
492 ;;
|
|
|
493
|
|
|
494 ;;
|
|
|
495
|
|
|
496 (defun eos::spro_detach (msg pat)
|
|
|
497 ;; a detach notification has been received. this means dbx/debugger
|
|
|
498 ;; is exiting
|
|
|
499 (eos::internal-clear-annotations t t t t)
|
|
|
500 (eos::dismiss-print-frame))
|
|
|
501
|
|
|
502 (defun eos::spro_te_location (msg pat)
|
|
|
503 ;; thread_id filename procname lineno filename procname lineno
|
|
|
504 (let* ((filename-hollow
|
|
|
505 (get-tooltalk-message-attribute msg 'arg_val 1))
|
|
|
506 (lineno-hollow
|
|
|
507 (read (get-tooltalk-message-attribute msg 'arg_ival 3)))
|
|
|
508 (filename-solid
|
|
|
509 (get-tooltalk-message-attribute msg 'arg_val 4))
|
|
|
510 (lineno-solid
|
|
|
511 (read (get-tooltalk-message-attribute msg 'arg_ival 6)))
|
|
|
512 )
|
|
|
513 (setq eos::current-solid-arrow
|
|
|
514 (eos::make-annotation-visible eos::current-solid-arrow
|
|
|
515 filename-solid
|
|
|
516 lineno-solid
|
|
|
517 'debugger-solid-arrow))
|
|
|
518 (if (or (not (equal filename-solid filename-hollow))
|
|
|
519 (not (equal lineno-solid lineno-hollow)))
|
|
|
520 (setq eos::current-hollow-arrow
|
|
|
521 (eos::make-annotation-visible eos::current-hollow-arrow
|
|
|
522 filename-hollow
|
|
|
523 lineno-hollow
|
|
|
524 'debugger-hollow-arrow)))
|
|
|
525 ;; (return-tooltalk-message msg)
|
|
|
526 ))
|
|
|
527
|
|
|
528 (defun eos::spro_te_visit (msg pat)
|
|
|
529 ;; thread_id filename procname lineno stackpos
|
|
|
530 (let* ((filename
|
|
|
531 (get-tooltalk-message-attribute msg 'arg_val 1))
|
|
|
532 (procname
|
|
|
533 (get-tooltalk-message-attribute msg 'arg_val 2))
|
|
|
534 (lineno
|
|
|
535 (read (get-tooltalk-message-attribute msg 'arg_ival 3)))
|
|
|
536 (stackpos
|
|
|
537 (read (get-tooltalk-message-attribute msg 'arg_ival 4)))
|
|
|
538 )
|
|
|
539 (eos::make-annotation-invisible eos::current-hollow-arrow)
|
|
|
540 (if (equal stackpos 1)
|
|
|
541 (progn
|
|
|
542 (eos::make-annotation-invisible eos::current-solid-arrow)
|
|
|
543 (setq eos::current-solid-arrow
|
|
|
544 (eos::make-annotation-visible eos::current-solid-arrow
|
|
|
545 filename
|
|
|
546 lineno
|
|
|
547 'debugger-solid-arrow))
|
|
|
548 )
|
|
|
549 (setq eos::current-hollow-arrow
|
|
|
550 (eos::make-annotation-visible eos::current-hollow-arrow
|
|
|
551 filename
|
|
|
552 lineno
|
|
|
553 'debugger-hollow-arrow))
|
|
|
554 )
|
|
|
555 ;; (return-tooltalk-message msg)
|
|
|
556 (eos::visit-stack stackpos)
|
|
|
557 ))
|
|
|
558
|
|
|
559 ;; generate a list of patterns
|
|
|
560 ;; so it can be registered and unregistered.
|
|
|
561
|
|
|
562
|
|
|
563 (defun eos::create-debugger-patterns ()
|
|
|
564 ;; returns a list of patterns
|
|
|
565 (list
|
|
|
566 (make-an-observer "SPRO_TE_STOPPED" 'eos::spro_te_stopped)
|
|
|
567 (make-an-observer "SPRO_SE_STARTED" 'eos::clear-arrows)
|
|
|
568 (make-an-observer "SPRO_TE_STEPPED" 'eos::clear-arrows)
|
|
|
569 (make-an-observer "SPRO_TE_CONTINUED" 'eos::clear-arrows)
|
|
|
570 (make-an-observer "SPRO_SE_DROPPED" 'eos::clear-arrows-stops)
|
|
|
571 (make-an-observer "SPRO_SE_DEBUGGED" 'eos::update-clear-stops)
|
|
|
572 (make-an-observer "SPRO_SE_REVIVED" 'eos::update-clear-arrows-stops)
|
|
|
573 (make-an-observer "SPRO_SE_ATTACHED" 'eos::update-clear-arrows-stops)
|
|
|
574 (make-an-observer "SPRO_SE_GONE" 'eos::clear-arrows)
|
|
|
575 (make-an-observer "SPRO_TE_LOCATION" 'eos::spro_te_location)
|
|
|
576 (make-an-observer "SPRO_TE_VISIT" 'eos::spro_te_visit)
|
|
|
577 (make-an-observer "SPRO_TE_EVENTSET" 'eos::spro_te_eventset)
|
|
|
578 (make-an-observer "SPRO_TE_EVENTDEL" 'eos::spro_te_eventdel)
|
|
|
579 (make-an-observer "SPRO_DETACH" 'eos::spro_detach)
|
|
|
580 ))
|
|
|
581
|
|
|
582 (defun eos::register-debugger-patterns ()
|
|
|
583 ;; register all dbx patterns
|
|
|
584 (mapcar 'register-tooltalk-pattern eos::dbx-pattern-list)
|
|
|
585 (eos::register-debugger-extra-patterns))
|
|
|
586
|
|
|
587 (defun eos::unregister-debugger-patterns ()
|
|
|
588 ;; unregister all dbx patterns
|
|
|
589 (mapcar 'unregister-tooltalk-pattern eos::dbx-pattern-list)
|
|
|
590 (eos::unregister-debugger-extra-patterns))
|
|
|
591
|
|
|
592 (provide 'eos-debugger)
|
|
|
593
|
|
|
594 ;;; sun-eos-debugger.el ends here
|
