OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gdb-6.8/] [gdb/] [mi/] [gdb-mi.el] - Blame information for rev 157

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 24 jeremybenn
;;; gdb-mi.el
2
 
3
;; Author: Nick Roberts <nickrob@gnu.org>
4
;; Maintainer: Nick Roberts <nickrob@gnu.org>
5
;; Keywords: unix, tools
6
 
7
;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
8
 
9
;; This file is part of GNU GDB.
10
 
11
;; GNU GDB is free software; you can redistribute it and/or modify
12
;; it under the terms of the GNU General Public License as published by
13
;; the Free Software Foundation; either version 2, or (at your option)
14
;; any later version.
15
 
16
;; This program is distributed in the hope that it will be useful,
17
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19
;; GNU General Public License for more details.
20
 
21
;;; Commentary:
22
 
23
;; This mode acts as a graphical user interface to GDB and works with Emacs
24
;; 22.x and the version of GDB with which it is distributed.  You can interact
25
;; with GDB through the GUD buffer in the usual way, but there are also
26
;; buffers which control the execution and describe the state of your program.
27
;; It separates the input/output of your program from that of GDB and displays
28
;; expressions and their current values in their own buffers.  It also uses
29
;; features of Emacs 21 such as the fringe/display margin for breakpoints, and
30
;; the toolbar (see the GDB Graphical Interface section in the Emacs info
31
;; manual).
32
 
33
;; Start the debugger with M-x gdbmi.
34
 
35
;; This file uses GDB/MI as the primary interface to GDB. It is still under
36
;; development and is part of a process to migrate Emacs from annotations (as
37
;; used in gdb-ui.el) to GDB/MI.  It runs gdb with GDB/MI (-interp=mi) and
38
;; access CLI using "-interpreter-exec console cli-command".
39
 
40
;; This mode acts on top of gdb-ui.el.  After the release of 22.1,
41
;; mainline Emacs in the CVS repository will have a file also called gdb-mi.el
42
;; which will *replace* gdb-ui.el.  If you are interested in developing
43
;; this mode you should get this version.
44
;;
45
;; Known Bugs:
46
;;
47
;; 1) To handle program input, if required, and to avoid extra output in the
48
;; GUD buffer you must not use run, step, next or continue etc but their MI
49
;; counterparts through gud-run, gud-step etc, e.g clicking on the appropriate
50
;; icon in the toolbar.
51
;; 2) Some commands send extra prompts to the GUD buffer.
52
;; 3) Doesn't list catchpoints in breakpoints buffer.
53
;;
54
;; TODO:
55
;; 1) Prefix MI commands with a token instead of queueing commands.
56
;; 2) Use MI command -data-read-memory for memory window.
57
;; 3) Use MI command -data-disassemble for disassembly window.
58
;; 4) Allow separate buffers for Inferior IO and GDB IO.
59
;; 5) Watch windows to work with threads.
60
;;
61
;;; Code:
62
 
63
(require 'gud)
64
(require 'gdb-ui)
65
 
66
(defvar gdb-last-command nil)
67
(defvar gdb-prompt-name nil)
68
 
69
;;;###autoload
70
(defun gdbmi (command-line)
71
  "Run gdb on program FILE in buffer *gud-FILE*.
72
The directory containing FILE becomes the initial working directory
73
and source-file directory for your debugger.
74
 
75
If `gdb-many-windows' is nil (the default value) then gdb just
76
pops up the GUD buffer unless `gdb-show-main' is t. In this case
77
it starts with two windows: one displaying the GUD buffer and the
78
other with the source file with the main routine of the inferior.
79
 
80
If `gdb-many-windows' is t, regardless of the value of
81
`gdb-show-main', the layout below will appear. Keybindings are
82
given in relevant buffer.
83
 
84
Watch expressions appear in the speedbar/slowbar.
85
 
86
The following commands help control operation :
87
 
88
`gdb-many-windows'    - Toggle the number of windows gdb uses.
89
`gdb-restore-windows' - To restore the window layout.
90
 
91
See Info node `(emacs)GDB Graphical Interface' for a more
92
detailed description of this mode.
93
 
94
 
95
+--------------------------------------------------------------+
96
|                           GDB Toolbar                        |
97
+-------------------------------+------------------------------+
98
| GUD buffer (I/O of GDB)       | Locals buffer                |
99
|                               |                              |
100
|                               |                              |
101
|                               |                              |
102
+-------------------------------+------------------------------+
103
| Source buffer                                                |
104
|                                                              |
105
|                                                              |
106
|                                                              |
107
|                                                              |
108
|                                                              |
109
|                                                              |
110
|                                                              |
111
+-------------------------------+------------------------------+
112
| Stack buffer                  | Breakpoints buffer           |
113
| RET      gdb-frames-select    | SPC    gdb-toggle-breakpoint |
114
|                               | RET    gdb-goto-breakpoint   |
115
|                               | d      gdb-delete-breakpoint |
116
+-------------------------------+------------------------------+"
117
  ;;
118
  (interactive (list (gud-query-cmdline 'gdbmi)))
119
  ;;
120
  ;; Let's start with a basic gud-gdb buffer and then modify it a bit.
121
  (gdb command-line)
122
  ;;
123
  (setq gdb-debug-ring nil)
124
  (set (make-local-variable 'gud-minor-mode) 'gdbmi)
125
  (set (make-local-variable 'gud-marker-filter) 'gud-gdbmi-marker-filter)
126
  ;;
127
  (gud-def gud-step   "-exec-step %p"              "\C-s"
128
           "Step one source line with display.")
129
  (gud-def gud-stepi  "-exec-step-instruction %p"  "\C-i"
130
           "Step one instruction with display.")
131
  (gud-def gud-next   "-exec-next %p"              "\C-n"
132
           "Step one line (skip functions).")
133
  (gud-def gud-cont   "-exec-continue"             "\C-r"
134
           "Continue with display.")
135
  (gud-def gud-finish "-exec-finish"               "\C-f"
136
           "Finish executing current function.")
137
  (gud-def gud-run    "-exec-run"            nil    "Run the program.")
138
  (gud-def gud-break (if (not (string-equal mode-name "Machine"))
139
                         (gud-call "break %f:%l" arg)
140
                       (save-excursion
141
                         (beginning-of-line)
142
                         (forward-char 2)
143
                         (gud-call "break *%a" arg)))
144
           "\C-b" "Set breakpoint at current line or address.")
145
  ;;
146
  (gud-def gud-remove (if (not (string-equal mode-name "Machine"))
147
                          (gud-call "clear %f:%l" arg)
148
                        (save-excursion
149
                          (beginning-of-line)
150
                          (forward-char 2)
151
                          (gud-call "clear *%a" arg)))
152
           "\C-d" "Remove breakpoint at current line or address.")
153
  ;;
154
  (gud-def gud-until  (if (not (string-equal mode-name "Machine"))
155
                          (gud-call "-exec-until %f:%l" arg)
156
                        (save-excursion
157
                          (beginning-of-line)
158
                          (forward-char 2)
159
                          (gud-call "-exec-until *%a" arg)))
160
           "\C-u" "Continue to current line or address.")
161
 
162
  (define-key gud-minor-mode-map [left-margin mouse-1]
163
    'gdb-mouse-set-clear-breakpoint)
164
  (define-key gud-minor-mode-map [left-fringe mouse-1]
165
    'gdb-mouse-set-clear-breakpoint)
166
  (define-key gud-minor-mode-map [left-fringe mouse-2]
167
    'gdb-mouse-until)
168
  (define-key gud-minor-mode-map [left-fringe drag-mouse-1]
169
    'gdb-mouse-until)
170
  (define-key gud-minor-mode-map [left-margin mouse-3]
171
    'gdb-mouse-toggle-breakpoint-margin)
172
  (define-key gud-minor-mode-map [left-fringe mouse-3]
173
    'gdb-mouse-toggle-breakpoint-fringe)
174
 
175
  (setq comint-input-sender 'gdbmi-send)
176
  ;;
177
  ;; (re-)initialise
178
  (setq gdb-pc-address (if gdb-show-main "main" nil)
179
        gdb-previous-frame-address nil
180
        gdb-memory-address "main"
181
        gdb-previous-frame nil
182
        gdb-selected-frame nil
183
        gdb-frame-number nil
184
        gdb-var-list nil
185
        gdb-prompting nil
186
        gdb-input-queue nil
187
        gdb-current-item nil
188
        gdb-pending-triggers nil
189
        gdb-output-sink 'user
190
        gdb-server-prefix nil
191
        gdb-flush-pending-output nil
192
        gdb-location-alist nil
193
        gdb-source-file-list nil
194
        gdb-last-command nil
195
        gdb-prompt-name nil
196
        gdb-buffer-fringe-width (car (window-fringes)))
197
        gdb-debug-ring nil
198
        gdb-source-window nil
199
        gdb-inferior-status nil
200
        gdb-continuation nil
201
  ;;
202
  (setq gdb-buffer-type 'gdbmi)
203
  ;;
204
  ;; FIXME: use tty command to separate io.
205
  ;;(gdb-clear-inferior-io)
206
  ;;
207
  (if (eq window-system 'w32)
208
      (gdb-enqueue-input (list "-gdb-set new-console off\n" 'ignore)))
209
  (gdb-enqueue-input (list "-gdb-set height 0\n" 'ignore))
210
  ;; find source file and compilation directory here
211
  (gdb-enqueue-input
212
   ; Needs GDB 6.2 onwards.
213
   (list "-file-list-exec-source-files\n"
214
         'gdb-set-gud-minor-mode-existing-buffers-1))
215
  (gdb-enqueue-input
216
   ; Needs GDB 6.0 onwards.
217
   (list "-file-list-exec-source-file\n" 'gdb-get-source-file))
218
  (gdb-enqueue-input
219
   (list "-data-list-register-names\n" 'gdb-get-register-names))
220
  (gdb-enqueue-input
221
   (list "-gdb-show prompt\n" 'gdb-get-prompt))
222
  ;;
223
  (setq gdb-locals-font-lock-keywords gdb-locals-font-lock-keywords-2)
224
  (run-hooks 'gdbmi-mode-hook))
225
 
226
 
227
(defun gdbmi-send (proc string)
228
  "A comint send filter for gdb."
229
  (if gud-running
230
      (process-send-string proc (concat string "\n"))
231
    (with-current-buffer gud-comint-buffer
232
      (let ((inhibit-read-only t))
233
        (remove-text-properties (point-min) (point-max) '(face))))
234
    (setq gdb-output-sink 'user)
235
    (setq gdb-prompting nil)
236
    ;; mimic <RET> key to repeat previous command in GDB
237
    (if (not (string-match "^\\s+$" string))
238
        (setq gdb-last-command string)
239
      (if gdb-last-command (setq string gdb-last-command)))
240
    (if gdb-enable-debug
241
        (push (cons 'mi-send (concat string "\n")) gdb-debug-ring))
242
     (if (string-match "^-" string)
243
         ;; MI command
244
         (process-send-string proc (concat string "\n"))
245
       ;; CLI command
246
    (if (string-match "\\\\$" string)
247
        (setq gdb-continuation (concat gdb-continuation string "\n"))
248
      (process-send-string proc
249
                           (concat "-interpreter-exec console \""
250
                                   gdb-continuation string "\"\n"))
251
      (setq gdb-continuation nil)))))
252
 
253
(defcustom gud-gdbmi-command-name "gdb -interp=mi"
254
  "Default command to execute an executable under the GDB-UI debugger."
255
  :type 'string
256
  :group 'gud)
257
 
258
(defconst gdb-gdb-regexp "(gdb) \n")
259
 
260
(defconst gdb-running-regexp (concat "\\^running\n" gdb-gdb-regexp))
261
 
262
;; fullname added GDB 6.4+.
263
;; Probably not needed. -stack-info-frame computes filename and line.
264
(defconst gdb-stopped-regexp
265
  "\\*stopped,reason=.*?,file=\".*?\"\
266
,fullname=\"\\(.*?\\)\",line=\"\\(.*?\\)\"}\n")
267
 
268
(defconst gdb-error-regexp "\\^error,msg=\\(\".+\"\\)\n")
269
 
270
(defconst gdb-done-regexp "\\^done,*\n*")
271
 
272
(defconst gdb-console-regexp "~\\(\".*?[^\\]\"\\)\n")
273
 
274
(defconst gdb-internals-regexp "&\\(\".*?\\n\"\\)\n")
275
 
276
(defun gdbmi-prompt1 ()
277
  "Queue any GDB commands that the user interface needs."
278
  (unless gdb-pending-triggers
279
    (gdbmi-get-selected-frame)
280
    (gdbmi-invalidate-frames)
281
    (gdbmi-invalidate-breakpoints)
282
    (gdb-get-changed-registers)
283
    (gdb-invalidate-registers-1)
284
    (gdb-invalidate-locals-1)
285
    (if (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
286
        (gdb-var-update-1))))
287
 
288
(defun gdbmi-prompt2 ()
289
  "Handle any output and send next GDB command."
290
  (let ((sink gdb-output-sink))
291
    (when (eq sink 'emacs)
292
      (let ((handler
293
             (car (cdr gdb-current-item))))
294
        (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
295
          (funcall handler)))))
296
  (let ((input (gdb-dequeue-input)))
297
    (if input
298
        (gdb-send-item input)
299
      (progn
300
        (setq gud-running nil)
301
        (setq gdb-prompting t)
302
        (gud-display-frame)))))
303
 
304
(defun gud-gdbmi-marker-filter (string)
305
  "Filter GDB/MI output."
306
  (if gdb-flush-pending-output
307
      nil
308
    (if gdb-enable-debug (push (cons 'recv (list string gdb-output-sink))
309
                                         gdb-debug-ring))
310
    ;; Recall the left over gud-marker-acc from last time
311
    (setq gud-marker-acc (concat gud-marker-acc string))
312
    ;; Start accumulating output for the GUD buffer
313
    (let ((output "") running)
314
 
315
      (if (string-match gdb-running-regexp gud-marker-acc)
316
          (setq
317
           gud-marker-acc
318
           (concat (substring gud-marker-acc 0 (match-beginning 0))
319
                   (substring gud-marker-acc (match-end 0)))
320
           running t))
321
 
322
      (if (string-match gdb-stopped-regexp gud-marker-acc)
323
          (setq
324
 
325
           ;; Extract the frame position from the marker.
326
           gud-last-frame (cons (match-string 1 gud-marker-acc)
327
                                (string-to-number
328
                                 (match-string 2 gud-marker-acc)))
329
 
330
           gud-marker-acc
331
           (concat (substring gud-marker-acc 0 (match-beginning 0))
332
                   (substring gud-marker-acc (match-end 0)))))
333
 
334
      ;; Filter error messages going to GUD buffer and
335
      ;; display in minibuffer.
336
      (when (eq gdb-output-sink 'user)
337
        (while (string-match gdb-error-regexp gud-marker-acc)
338
          (message (read (match-string 1 gud-marker-acc)))
339
          (setq
340
           gud-marker-acc
341
           (concat (substring gud-marker-acc 0 (match-beginning 0))
342
                   (substring gud-marker-acc (match-end 0)))))
343
 
344
        (if (string-match gdb-done-regexp gud-marker-acc)
345
            (setq
346
             gud-marker-acc
347
             (concat (substring gud-marker-acc 0 (match-beginning 0))
348
                     (substring gud-marker-acc (match-end 0))))))
349
 
350
      (when (string-match gdb-gdb-regexp gud-marker-acc)
351
        (setq
352
         gud-marker-acc
353
         (concat (substring gud-marker-acc 0 (match-beginning 0))
354
                   (substring gud-marker-acc (match-end 0))))
355
 
356
        ;; Remove the trimmings from the console stream.
357
        (while (string-match gdb-console-regexp gud-marker-acc)
358
          (setq
359
           gud-marker-acc (concat
360
                           (substring gud-marker-acc 0 (match-beginning 0))
361
                           (read (match-string 1 gud-marker-acc))
362
                           (substring gud-marker-acc (match-end 0)))))
363
 
364
        ;; Remove the trimmings from log stream containing debugging messages
365
        ;; being produced by GDB's internals and use warning face.
366
        (while (string-match gdb-internals-regexp gud-marker-acc)
367
          (setq
368
           gud-marker-acc
369
           (concat (substring gud-marker-acc 0 (match-beginning 0))
370
                   (let ((error-message
371
                          (read (match-string 1 gud-marker-acc))))
372
                     (put-text-property
373
 
374
                      'face font-lock-warning-face
375
                      error-message)
376
                     error-message)
377
                   (substring gud-marker-acc (match-end 0)))))
378
 
379
        (setq output (gdbmi-concat-output output gud-marker-acc))
380
        (setq gud-marker-acc "")
381
        (gdbmi-prompt1)
382
        (unless gdb-input-queue
383
          (setq output (concat output gdb-prompt-name)))
384
        (gdbmi-prompt2)
385
        (setq gud-running running))
386
 
387
      (when gud-running
388
        (setq output (gdbmi-concat-output output gud-marker-acc))
389
        (setq gud-marker-acc ""))
390
 
391
       output)))
392
 
393
(defun gdbmi-concat-output (so-far new)
394
  (let ((sink gdb-output-sink))
395
    (cond
396
     ((eq sink 'user) (concat so-far new))
397
     ((eq sink 'emacs)
398
      (gdb-append-to-partial-output new)
399
      so-far)
400
     ((eq sink 'inferior)
401
      (gdb-append-to-inferior-io new)
402
      so-far))))
403
 
404
 
405
;; Breakpoint buffer : This displays the output of `-break-list'.
406
;;
407
(def-gdb-auto-update-trigger gdbmi-invalidate-breakpoints
408
  (gdb-get-buffer 'gdb-breakpoints-buffer)
409
  "-break-list\n"
410
  gdb-break-list-handler)
411
 
412
(defconst gdb-break-list-regexp
413
"bkpt={.*?number=\"\\(.*?\\)\",.*?type=\"\\(.*?\\)\",.*?disp=\"\\(.*?\\)\",.*?\
414
enabled=\"\\(.\\)\",.*?addr=\"\\(.*?\\)\",\\(?:.*?func=\"\\(.*?\\)\",.*?\
415
file=\"\\(.*?\\)\",.*?fullname=\".*?\",.*?line=\"\\(.*?\\)\",\
416
\\|\\(?:.*?what=\"\\(.*?\\)\",\\)*\\).*?times=\"\\(.*?\\)\".*?}")
417
 
418
(defun gdb-break-list-handler ()
419
  (setq gdb-pending-triggers (delq 'gdbmi-invalidate-breakpoints
420
                                  gdb-pending-triggers))
421
  (let ((breakpoint) (breakpoints-list))
422
    (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
423
      (goto-char (point-min))
424
      (while (re-search-forward gdb-break-list-regexp nil t)
425
        (let ((breakpoint (list (match-string 1)
426
                                (match-string 2)
427
                                (match-string 3)
428
                                (match-string 4)
429
                                (match-string 5)
430
                                (match-string 6)
431
                                (match-string 7)
432
                                (match-string 8)
433
                                (match-string 9)
434
                                (match-string 10))))
435
          (push breakpoint breakpoints-list))))
436
    (let ((buf (gdb-get-buffer 'gdb-breakpoints-buffer)))
437
      (and buf (with-current-buffer buf
438
                 (let ((p (point))
439
                       (buffer-read-only nil))
440
                   (erase-buffer)
441
                   (insert "Num Type           Disp Enb Hits Addr       What\n")
442
                   (dolist (breakpoint breakpoints-list)
443
                     (insert
444
                      (concat
445
                       (nth 0 breakpoint) "   "
446
                       (nth 1 breakpoint) "     "
447
                       (nth 2 breakpoint) " "
448
                       (nth 3 breakpoint) "   "
449
                       (nth 9 breakpoint) " "
450
                       (nth 4 breakpoint) " "
451
                       (if (nth 5 breakpoint)
452
                           (concat "in " (nth 5 breakpoint) " at " (nth 6 breakpoint) ":" (nth 7 breakpoint) "\n")
453
                         (concat (nth 8 breakpoint) "\n")))))
454
                   (goto-char p))))))
455
  (gdb-info-breakpoints-custom))
456
 
457
(defun gdbmi-get-location (bptno line flag)
458
  "Find the directory containing the relevant source file.
459
Put in buffer and place breakpoint icon."
460
  (goto-char (point-min))
461
  (catch 'file-not-found
462
    (if (re-search-forward gdb-source-file-regexp-1 nil t)
463
        (delete (cons bptno "File not found") gdb-location-alist)
464
        (push (cons bptno (match-string 1)) gdb-location-alist)
465
      (gdb-resync)
466
      (unless (assoc bptno gdb-location-alist)
467
        (push (cons bptno "File not found") gdb-location-alist)
468
        (message-box "Cannot find source file for breakpoint location.
469
Add directory to search path for source files using the GDB command, dir."))
470
      (throw 'file-not-found nil))
471
    (with-current-buffer
472
        (find-file-noselect (match-string 1))
473
      (save-current-buffer
474
        (set (make-local-variable 'gud-minor-mode) 'gdbmi)
475
        (set (make-local-variable 'tool-bar-map) gud-tool-bar-map))
476
      ;; only want one breakpoint icon at each location
477
      (save-excursion
478
        (goto-line (string-to-number line))
479
        (gdb-put-breakpoint-icon (eq flag ?y) bptno)))))
480
 
481
;; Frames buffer.  This displays a perpetually correct bactrack trace.
482
;;
483
(def-gdb-auto-update-trigger gdbmi-invalidate-frames
484
  (gdb-get-buffer 'gdb-stack-buffer)
485
  "-stack-list-frames\n"
486
  gdb-stack-list-frames-handler)
487
 
488
(defconst gdb-stack-list-frames-regexp
489
"{.*?level=\"\\(.*?\\)\",.*?addr=\"\\(.*?\\)\",.*?func=\"\\(.*?\\)\",\
490
\\(?:.*?file=\".*?\",.*?fullname=\"\\(.*?\\)\",.*?line=\"\\(.*?\\)\".*?}\\|\
491
from=\"\\(.*?\\)\"\\)")
492
 
493
(defun gdb-stack-list-frames-handler ()
494
  (setq gdb-pending-triggers (delq 'gdbmi-invalidate-frames
495
                                  gdb-pending-triggers))
496
  (let ((frame nil)
497
        (call-stack nil))
498
    (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
499
      (goto-char (point-min))
500
      (while (re-search-forward gdb-stack-list-frames-regexp nil t)
501
        (let ((frame (list (match-string 1)
502
                           (match-string 2)
503
                           (match-string 3)
504
                           (match-string 4)
505
                           (match-string 5)
506
                           (match-string 6))))
507
          (push frame call-stack))))
508
    (let ((buf (gdb-get-buffer 'gdb-stack-buffer)))
509
      (and buf (with-current-buffer buf
510
                 (let ((p (point))
511
                       (buffer-read-only nil))
512
                   (erase-buffer)
513
                   (insert "Level\tAddr\tFunc\tFile:Line\n")
514
                   (dolist (frame (nreverse call-stack))
515
                     (insert
516
                      (concat
517
                       (nth 0 frame) "\t"
518
                       (nth 1 frame) "\t"
519
                       (propertize (nth 2 frame)
520
                                   'face font-lock-function-name-face) "\t"
521
                       (if (nth 3 frame)
522
                           (concat "at "(nth 3 frame) ":" (nth 4 frame) "\n")
523
                         (concat "from " (nth 5 frame) "\n")))))
524
                   (goto-char p))))))
525
  (gdb-stack-list-frames-custom))
526
 
527
(defun gdb-stack-list-frames-custom ()
528
  (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer)
529
    (save-excursion
530
      (let ((buffer-read-only nil))
531
        (goto-char (point-min))
532
        (forward-line 1)
533
        (while (< (point) (point-max))
534
          (add-text-properties (point-at-bol) (point-at-eol)
535
                             '(mouse-face highlight
536
                               help-echo "mouse-2, RET: Select frame"))
537
          (beginning-of-line)
538
          (when (and (looking-at "^[0-9]+\\s-+\\(\\S-+\\)")
539
                     (equal (match-string 1) gdb-selected-frame))
540
            (put-text-property (point-at-bol) (point-at-eol)
541
                               'face '(:inverse-video t)))
542
          (forward-line 1))))))
543
 
544
 
545
;; gdb-ui.el uses "info source" to find out if macro information is present.
546
(defun gdb-get-source-file ()
547
  "Find the source file where the program starts and display it with related
548
buffers, if required."
549
  (goto-char (point-min))
550
  (if (re-search-forward gdb-source-file-regexp-1 nil t)
551
      (setq gdb-main-file (match-string 1)))
552
 (if gdb-many-windows
553
      (gdb-setup-windows)
554
   (gdb-get-buffer-create 'gdb-breakpoints-buffer)
555
   (if gdb-show-main
556
       (let ((pop-up-windows t))
557
         (display-buffer (gud-find-file gdb-main-file))))))
558
 
559
(defun gdbmi-get-selected-frame ()
560
  (if (not (member 'gdbmi-get-selected-frame gdb-pending-triggers))
561
      (progn
562
        (gdb-enqueue-input
563
         (list "-stack-info-frame\n" 'gdbmi-frame-handler))
564
        (push 'gdbmi-get-selected-frame
565
               gdb-pending-triggers))))
566
 
567
(defun gdbmi-frame-handler ()
568
  (setq gdb-pending-triggers
569
        (delq 'gdbmi-get-selected-frame gdb-pending-triggers))
570
  (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
571
    (goto-char (point-min))
572
    (when (re-search-forward gdb-stack-list-frames-regexp nil t)
573
      (setq gdb-frame-number (match-string 1))
574
      (setq gdb-pc-address (match-string 2))
575
      (setq gdb-selected-frame (match-string 3))
576
      (when (match-string 4)
577
        (setq gud-last-frame
578
              (cons (match-string 4) (string-to-number (match-string 5))))
579
        (gud-display-frame)
580
        (if gud-overlay-arrow-position
581
            (let ((buffer (marker-buffer gud-overlay-arrow-position))
582
                  (position (marker-position gud-overlay-arrow-position)))
583
              (when buffer
584
                (with-current-buffer buffer
585
                  (setq fringe-indicator-alist
586
                        (if (string-equal gdb-frame-number "0")
587
                            nil
588
                          '((overlay-arrow . hollow-right-triangle))))
589
                  (setq gud-overlay-arrow-position (make-marker))
590
                  (set-marker gud-overlay-arrow-position position))))))
591
      (if (gdb-get-buffer 'gdb-locals-buffer)
592
          (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer)
593
            (setq mode-name (concat "Locals:" gdb-selected-frame))))
594
      (if (gdb-get-buffer 'gdb-assembler-buffer)
595
          (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer)
596
            (setq mode-name (concat "Machine:" gdb-selected-frame)))))))
597
 
598
(defvar gdb-prompt-name-regexp "value=\"\\(.*?\\)\"")
599
 
600
(defun gdb-get-prompt ()
601
  "Find prompt for GDB session."
602
  (goto-char (point-min))
603
  (setq gdb-prompt-name nil)
604
  (re-search-forward gdb-prompt-name-regexp nil t)
605
  (setq gdb-prompt-name (match-string 1)))
606
 
607
(provide 'gdb-mi)
608
;;; gdbmi.el ends here

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.