Mercurial > emacs

comparison lisp/progmodes/gdb-ui.el @ 70053:9099e9f6d57a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(gdb-pc-address): Rename from gdb-frame-address. (gdb-frame-address): Re-use to identify frame for watch expression. (gdb-var-list, gdb-var-create-handler): Add frame address for root variables. (gdb-init-1, gdb-source, gdb-post-prompt, ) (gdb-assembler-custom, gdb-invalidate-assembler): Use gdb-pc-address. (gdb-frame-handler): Get gdb-frame-address.
author Nick Roberts <nickrob@snap.net.nz>
date Mon, 17 Apr 2006 19:48:50 +0000
parents f4b6648f6d4f
children 21438c8b3a3f 2d2f6f096f6e
comparison
equal deleted inserted replaced
70052:261c2dbe91d2 70053:9099e9f6d57a
98 (require 'gud) 98 (require 'gud)
99 99
100 (defvar tool-bar-map) 100 (defvar tool-bar-map)
101 (defvar speedbar-initial-expansion-list-name) 101 (defvar speedbar-initial-expansion-list-name)
102 102
103 (defvar gdb-frame-address "main" "Initialization for Assembler buffer.") 103 (defvar gdb-pc-address nil "Initialization for Assembler buffer.
104 Set to \"main\" at start if gdb-show-main is t.")
105 (defvar gdb-frame-address nil "Identity of frame for watch expression.")
104 (defvar gdb-previous-frame-address nil) 106 (defvar gdb-previous-frame-address nil)
105 (defvar gdb-memory-address "main") 107 (defvar gdb-memory-address "main")
106 (defvar gdb-previous-frame nil) 108 (defvar gdb-previous-frame nil)
107 (defvar gdb-selected-frame nil) 109 (defvar gdb-selected-frame nil)
108 (defvar gdb-frame-number nil) 110 (defvar gdb-frame-number nil)
109 (defvar gdb-current-language nil) 111 (defvar gdb-current-language nil)
110 (defvar gdb-var-list nil 112 (defvar gdb-var-list nil
111 "List of variables in watch window. 113 "List of variables in watch window.
112 Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS) where 114 Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS FP)
113 STATUS is nil (unchanged), `changed' or `out-of-scope'.") 115 where STATUS is nil (unchanged), `changed' or `out-of-scope', FP the frame
116 address for root variables.")
114 (defvar gdb-force-update t 117 (defvar gdb-force-update t
115 "Non-nil means that view of watch expressions will be updated in the speedbar.") 118 "Non-nil means that view of watch expressions will be updated in the speedbar.")
116 (defvar gdb-main-file nil "Source file from which program execution begins.") 119 (defvar gdb-main-file nil "Source file from which program execution begins.")
117 (defvar gdb-overlay-arrow-position nil) 120 (defvar gdb-overlay-arrow-position nil)
118 (defvar gdb-server-prefix nil) 121 (defvar gdb-server-prefix nil)
514 'gdb-mouse-toggle-breakpoint-fringe) 517 'gdb-mouse-toggle-breakpoint-fringe)
515 518
516 (setq comint-input-sender 'gdb-send) 519 (setq comint-input-sender 'gdb-send)
517 520
518 ;; (re-)initialize 521 ;; (re-)initialize
519 (setq gdb-frame-address (if gdb-show-main "main" nil)) 522 (setq gdb-pc-address (if gdb-show-main "main" nil))
520 (setq gdb-previous-frame-address nil 523 (setq gdb-previous-frame-address nil
521 gdb-memory-address "main" 524 gdb-memory-address "main"
522 gdb-previous-frame nil 525 gdb-previous-frame nil
523 gdb-selected-frame nil 526 gdb-selected-frame nil
524 gdb-current-language nil 527 gdb-current-language nil
718 gdb-use-colon-colon-notation gdb-selected-frame) 721 gdb-use-colon-colon-notation gdb-selected-frame)
719 (setq expr (concat gdb-selected-frame "::" expr)) 722 (setq expr (concat gdb-selected-frame "::" expr))
720 expr) 723 expr)
721 (match-string 2) 724 (match-string 2)
722 (match-string 3) 725 (match-string 3)
723 nil nil))) 726 nil nil gdb-frame-address)))
724 (push var gdb-var-list) 727 (push var gdb-var-list)
725 (speedbar 1) 728 (speedbar 1)
726 (unless (string-equal 729 (unless (string-equal
727 speedbar-initial-expansion-list-name "GUD") 730 speedbar-initial-expansion-list-name "GUD")
728 (speedbar-change-initial-expansion-list "GUD")) 731 (speedbar-change-initial-expansion-list "GUD"))
1204 ;; Extract the frame position from the marker. 1207 ;; Extract the frame position from the marker.
1205 (setq gud-last-frame 1208 (setq gud-last-frame
1206 (cons 1209 (cons
1207 (match-string 1 args) 1210 (match-string 1 args)
1208 (string-to-number (match-string 2 args)))) 1211 (string-to-number (match-string 2 args))))
1209 (setq gdb-frame-address (match-string 3 args)) 1212 (setq gdb-pc-address (match-string 3 args))
1210 ;; cover for auto-display output which comes *before* 1213 ;; cover for auto-display output which comes *before*
1211 ;; stopped annotation 1214 ;; stopped annotation
1212 (if (eq gdb-output-sink 'inferior) (setq gdb-output-sink 'user))) 1215 (if (eq gdb-output-sink 'inferior) (setq gdb-output-sink 'user)))
1213 1216
1214 (defun gdb-pre-prompt (ignored) 1217 (defun gdb-pre-prompt (ignored)
1355 (gdb-invalidate-frames) 1358 (gdb-invalidate-frames)
1356 ;; Regenerate breakpoints buffer in case it has been inadvertantly deleted. 1359 ;; Regenerate breakpoints buffer in case it has been inadvertantly deleted.
1357 (gdb-get-buffer-create 'gdb-breakpoints-buffer) 1360 (gdb-get-buffer-create 'gdb-breakpoints-buffer)
1358 (gdb-invalidate-breakpoints) 1361 (gdb-invalidate-breakpoints)
1359 ;; Do this through gdb-get-selected-frame -> gdb-frame-handler 1362 ;; Do this through gdb-get-selected-frame -> gdb-frame-handler
1360 ;; so gdb-frame-address is updated. 1363 ;; so gdb-pc-address is updated.
1361 ;; (gdb-invalidate-assembler) 1364 ;; (gdb-invalidate-assembler)
1362 1365
1363 (if (string-equal gdb-version "pre-6.4") 1366 (if (string-equal gdb-version "pre-6.4")
1364 (gdb-invalidate-registers) 1367 (gdb-invalidate-registers)
1365 (gdb-get-changed-registers) 1368 (gdb-get-changed-registers)
3002 (defun gdb-assembler-custom () 3005 (defun gdb-assembler-custom ()
3003 (let ((buffer (gdb-get-buffer 'gdb-assembler-buffer)) 3006 (let ((buffer (gdb-get-buffer 'gdb-assembler-buffer))
3004 (pos 1) (address) (flag) (bptno)) 3007 (pos 1) (address) (flag) (bptno))
3005 (with-current-buffer buffer 3008 (with-current-buffer buffer
3006 (save-excursion 3009 (save-excursion
3007 (if (not (equal gdb-frame-address "main")) 3010 (if (not (equal gdb-pc-address "main"))
3008 (progn 3011 (progn
3009 (goto-char (point-min)) 3012 (goto-char (point-min))
3010 (if (and gdb-frame-address 3013 (if (and gdb-pc-address
3011 (search-forward gdb-frame-address nil t)) 3014 (search-forward gdb-pc-address nil t))
3012 (progn 3015 (progn
3013 (setq pos (point)) 3016 (setq pos (point))
3014 (beginning-of-line) 3017 (beginning-of-line)
3015 (setq fringe-indicator-alist 3018 (setq fringe-indicator-alist
3016 (if (string-equal gdb-frame-number "0") 3019 (if (string-equal gdb-frame-number "0")
3036 (with-current-buffer buffer 3039 (with-current-buffer buffer
3037 (save-excursion 3040 (save-excursion
3038 (goto-char (point-min)) 3041 (goto-char (point-min))
3039 (if (search-forward address nil t) 3042 (if (search-forward address nil t)
3040 (gdb-put-breakpoint-icon (eq flag ?y) bptno)))))))) 3043 (gdb-put-breakpoint-icon (eq flag ?y) bptno))))))))
3041 (if (not (equal gdb-frame-address "main")) 3044 (if (not (equal gdb-pc-address "main"))
3042 (with-current-buffer buffer 3045 (with-current-buffer buffer
3043 (set-window-point (get-buffer-window buffer 0) pos))))) 3046 (set-window-point (get-buffer-window buffer 0) pos)))))
3044 3047
3045 (defvar gdb-assembler-mode-map 3048 (defvar gdb-assembler-mode-map
3046 (let ((map (make-sparse-keymap))) 3049 (let ((map (make-sparse-keymap)))
3098 (setq gdb-previous-frame nil) 3101 (setq gdb-previous-frame nil)
3099 (let ((special-display-regexps (append special-display-regexps '(".*"))) 3102 (let ((special-display-regexps (append special-display-regexps '(".*")))
3100 (special-display-frame-alist gdb-frame-parameters)) 3103 (special-display-frame-alist gdb-frame-parameters))
3101 (display-buffer (gdb-get-buffer-create 'gdb-assembler-buffer)))) 3104 (display-buffer (gdb-get-buffer-create 'gdb-assembler-buffer))))
3102 3105
3103 ;; modified because if gdb-frame-address has changed value a new command 3106 ;; modified because if gdb-pc-address has changed value a new command
3104 ;; must be enqueued to update the buffer with the new output 3107 ;; must be enqueued to update the buffer with the new output
3105 (defun gdb-invalidate-assembler (&optional ignored) 3108 (defun gdb-invalidate-assembler (&optional ignored)
3106 (if (gdb-get-buffer 'gdb-assembler-buffer) 3109 (if (gdb-get-buffer 'gdb-assembler-buffer)
3107 (progn 3110 (progn
3108 (unless (and gdb-selected-frame 3111 (unless (and gdb-selected-frame
3109 (string-equal gdb-selected-frame gdb-previous-frame)) 3112 (string-equal gdb-selected-frame gdb-previous-frame))
3110 (if (or (not (member 'gdb-invalidate-assembler 3113 (if (or (not (member 'gdb-invalidate-assembler
3111 gdb-pending-triggers)) 3114 gdb-pending-triggers))
3112 (not (string-equal gdb-frame-address 3115 (not (string-equal gdb-pc-address
3113 gdb-previous-frame-address))) 3116 gdb-previous-frame-address)))
3114 (progn 3117 (progn
3115 ;; take previous disassemble command, if any, off the queue 3118 ;; take previous disassemble command, if any, off the queue
3116 (with-current-buffer gud-comint-buffer 3119 (with-current-buffer gud-comint-buffer
3117 (let ((queue gdb-input-queue)) 3120 (let ((queue gdb-input-queue))
3120 (setq gdb-input-queue 3123 (setq gdb-input-queue
3121 (delete item gdb-input-queue)))))) 3124 (delete item gdb-input-queue))))))
3122 (gdb-enqueue-input 3125 (gdb-enqueue-input
3123 (list 3126 (list
3124 (concat gdb-server-prefix "disassemble " 3127 (concat gdb-server-prefix "disassemble "
3125 (if (member gdb-frame-address '(nil "main")) nil "0x") 3128 (if (member gdb-pc-address '(nil "main")) nil "0x")
3126 gdb-frame-address "\n") 3129 gdb-pc-address "\n")
3127 'gdb-assembler-handler)) 3130 'gdb-assembler-handler))
3128 (push 'gdb-invalidate-assembler gdb-pending-triggers) 3131 (push 'gdb-invalidate-assembler gdb-pending-triggers)
3129 (setq gdb-previous-frame-address gdb-frame-address) 3132 (setq gdb-previous-frame-address gdb-pc-address)
3130 (setq gdb-previous-frame gdb-selected-frame))))))) 3133 (setq gdb-previous-frame gdb-selected-frame)))))))
3131 3134
3132 (defun gdb-get-selected-frame () 3135 (defun gdb-get-selected-frame ()
3133 (if (not (member 'gdb-get-selected-frame gdb-pending-triggers)) 3136 (if (not (member 'gdb-get-selected-frame gdb-pending-triggers))
3134 (progn 3137 (progn
3139 3142
3140 (defun gdb-frame-handler () 3143 (defun gdb-frame-handler ()
3141 (setq gdb-pending-triggers 3144 (setq gdb-pending-triggers
3142 (delq 'gdb-get-selected-frame gdb-pending-triggers)) 3145 (delq 'gdb-get-selected-frame gdb-pending-triggers))
3143 (goto-char (point-min)) 3146 (goto-char (point-min))
3144 (if (re-search-forward "Stack level \\([0-9]+\\)" nil t) 3147 (when (re-search-forward
3145 (setq gdb-frame-number (match-string 1))) 3148 "Stack level \\([0-9]+\\), frame at \\(0x[[:xdigit:]]+\\)" nil t)
3149 (setq gdb-frame-number (match-string 1))
3150 (setq gdb-frame-address (match-string 2)))
3146 (goto-char (point-min)) 3151 (goto-char (point-min))
3147 (when (re-search-forward ".*=\\s-+0x0*\\(\\S-*\\)\\s-+in\\s-+\\(\\S-+?\\)\ 3152 (when (re-search-forward ".*=\\s-+0x0*\\(\\S-*\\)\\s-+in\\s-+\\(\\S-+?\\)\
3148 \\(?: (\\(\\S-+?\\):[0-9]+?)\\)*;? " 3153 \\(?: (\\(\\S-+?\\):[0-9]+?)\\)*;? "
3149 nil t) 3154 nil t)
3150 (setq gdb-selected-frame (match-string 2)) 3155 (setq gdb-selected-frame (match-string 2))
3152 (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer) 3157 (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer)
3153 (setq mode-name (concat "Locals:" gdb-selected-frame)))) 3158 (setq mode-name (concat "Locals:" gdb-selected-frame))))
3154 (if (gdb-get-buffer 'gdb-assembler-buffer) 3159 (if (gdb-get-buffer 'gdb-assembler-buffer)
3155 (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer) 3160 (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer)
3156 (setq mode-name (concat "Machine:" gdb-selected-frame)))) 3161 (setq mode-name (concat "Machine:" gdb-selected-frame))))
3157 (setq gdb-frame-address (match-string 1)) 3162 (setq gdb-pc-address (match-string 1))
3158 (if (and (match-string 3) gud-overlay-arrow-position) 3163 (if (and (match-string 3) gud-overlay-arrow-position)
3159 (let ((buffer (marker-buffer gud-overlay-arrow-position)) 3164 (let ((buffer (marker-buffer gud-overlay-arrow-position))
3160 (position (marker-position gud-overlay-arrow-position))) 3165 (position (marker-position gud-overlay-arrow-position)))
3161 (when (and buffer (string-equal (buffer-name buffer) (match-string 3))) 3166 (when (and buffer (string-equal (buffer-name buffer) (match-string 3)))
3162 (with-current-buffer buffer 3167 (with-current-buffer buffer