Mercurial > emacs
comparison lisp/progmodes/gdb-ui.el @ 62716:05f48d9c5aed
(gdb-frame-address):
Rename from gdb-current-address.
(gdb-previous-frame-address): Rename from gdb-previous-address.
(gdb-selected-frame): Rename from gdb-current-frame.
(gdb-get-selected-frame): Rename from gdb-get-current-frame.
(gdb-frame-number): Rename from gdb-current-stack-level.
(gdb-ann3): Match new mode-name for disassembly buffer.
Extend initialisation of variables.
(gdb-post-prompt): Update disassembly from gdb-frame-handler.
(gdb-memory-mode): Use mouse-face in header line.
(gdb-assembler-buffer-name): Call it disassembly and give frame
in mode line.
(gdb-source-spec-regexp, gdb-assembler-custom)
(gdb-invalidate-assembler, gdb-frame-handler):
Make robust to leading zeroes in address format.
author | Nick Roberts <nickrob@snap.net.nz> |
---|---|
date | Thu, 26 May 2005 12:20:21 +0000 |
parents | 2a8fbbf1f0f4 |
children | 0ae5fe9ca759 |
comparison
equal
deleted
inserted
replaced
62715:d07ea6e0706b | 62716:05f48d9c5aed |
---|---|
64 | 64 |
65 ;;; Code: | 65 ;;; Code: |
66 | 66 |
67 (require 'gud) | 67 (require 'gud) |
68 | 68 |
69 (defvar gdb-current-address "main" "Initialisation for Assembler buffer.") | 69 (defvar gdb-frame-address "main" "Initialisation for Assembler buffer.") |
70 (defvar gdb-previous-address nil) | 70 (defvar gdb-previous-frame-address nil) |
71 (defvar gdb-memory-address "main") | 71 (defvar gdb-memory-address "main") |
72 (defvar gdb-previous-frame nil) | 72 (defvar gdb-previous-frame nil) |
73 (defvar gdb-current-frame nil) | 73 (defvar gdb-selected-frame nil) |
74 (defvar gdb-current-stack-level nil) | 74 (defvar gdb-frame-number nil) |
75 (defvar gdb-current-language nil) | 75 (defvar gdb-current-language nil) |
76 (defvar gdb-var-list nil "List of variables in watch window.") | 76 (defvar gdb-var-list nil "List of variables in watch window.") |
77 (defvar gdb-var-changed nil "Non-nil means that gdb-var-list has changed.") | 77 (defvar gdb-var-changed nil "Non-nil means that gdb-var-list has changed.") |
78 (defvar gdb-buffer-type nil) | 78 (defvar gdb-buffer-type nil) |
79 (defvar gdb-overlay-arrow-position nil) | 79 (defvar gdb-overlay-arrow-position nil) |
293 (defun gdb-ann3 () | 293 (defun gdb-ann3 () |
294 (setq gdb-debug-log nil) | 294 (setq gdb-debug-log nil) |
295 (set (make-local-variable 'gud-minor-mode) 'gdba) | 295 (set (make-local-variable 'gud-minor-mode) 'gdba) |
296 (set (make-local-variable 'gud-marker-filter) 'gud-gdba-marker-filter) | 296 (set (make-local-variable 'gud-marker-filter) 'gud-gdba-marker-filter) |
297 ;; | 297 ;; |
298 (gud-def gud-break (if (not (string-equal mode-name "Machine")) | 298 (gud-def gud-break (if (not (string-match "Machine" mode-name)) |
299 (gud-call "break %f:%l" arg) | 299 (gud-call "break %f:%l" arg) |
300 (save-excursion | 300 (save-excursion |
301 (beginning-of-line) | 301 (beginning-of-line) |
302 (forward-char 2) | 302 (forward-char 2) |
303 (gud-call "break *%a" arg))) | 303 (gud-call "break *%a" arg))) |
304 "\C-b" "Set breakpoint at current line or address.") | 304 "\C-b" "Set breakpoint at current line or address.") |
305 ;; | 305 ;; |
306 (gud-def gud-remove (if (not (string-equal mode-name "Machine")) | 306 (gud-def gud-remove (if (not (string-match "Machine" mode-name)) |
307 (gud-call "clear %f:%l" arg) | 307 (gud-call "clear %f:%l" arg) |
308 (save-excursion | 308 (save-excursion |
309 (beginning-of-line) | 309 (beginning-of-line) |
310 (forward-char 2) | 310 (forward-char 2) |
311 (gud-call "clear *%a" arg))) | 311 (gud-call "clear *%a" arg))) |
312 "\C-d" "Remove breakpoint at current line or address.") | 312 "\C-d" "Remove breakpoint at current line or address.") |
313 ;; | 313 ;; |
314 (gud-def gud-until (if (not (string-equal mode-name "Machine")) | 314 (gud-def gud-until (if (not (string-match "Machine" mode-name)) |
315 (gud-call "until %f:%l" arg) | 315 (gud-call "until %f:%l" arg) |
316 (save-excursion | 316 (save-excursion |
317 (beginning-of-line) | 317 (beginning-of-line) |
318 (forward-char 2) | 318 (forward-char 2) |
319 (gud-call "until *%a" arg))) | 319 (gud-call "until *%a" arg))) |
330 ; 'gdb-mouse-toggle-breakpoint) | 330 ; 'gdb-mouse-toggle-breakpoint) |
331 | 331 |
332 (setq comint-input-sender 'gdb-send) | 332 (setq comint-input-sender 'gdb-send) |
333 ;; | 333 ;; |
334 ;; (re-)initialize | 334 ;; (re-)initialize |
335 (setq gdb-current-address "main") | 335 (setq gdb-frame-address (if gdb-show-main "main" nil)) |
336 (setq gdb-previous-address nil) | 336 (setq gdb-previous-frame-address nil |
337 (setq gdb-memory-address "main") | 337 gdb-memory-address "main" |
338 (setq gdb-previous-frame nil) | 338 gdb-previous-frame nil |
339 (setq gdb-current-frame nil) | 339 gdb-selected-frame nil |
340 (setq gdb-current-stack-level nil) | 340 gdb-current-language nil |
341 (setq gdb-var-list nil) | 341 gdb-frame-number nil |
342 (setq gdb-var-changed nil) | 342 gdb-var-list nil |
343 (setq gdb-first-prompt nil) | 343 gdb-var-changed nil |
344 (setq gdb-prompting nil) | 344 gdb-first-prompt nil |
345 (setq gdb-input-queue nil) | 345 gdb-prompting nil |
346 (setq gdb-current-item nil) | 346 gdb-input-queue nil |
347 (setq gdb-pending-triggers nil) | 347 gdb-current-item nil |
348 (setq gdb-output-sink 'user) | 348 gdb-pending-triggers nil |
349 (setq gdb-server-prefix "server ") | 349 gdb-output-sink 'user |
350 (setq gdb-flush-pending-output nil) | 350 gdb-server-prefix "server " |
351 (setq gdb-location-alist nil) | 351 gdb-flush-pending-output nil |
352 (setq gdb-find-file-unhook nil) | 352 gdb-location-alist nil |
353 (setq gdb-macro-info nil) | 353 gdb-find-file-unhook nil |
354 gdb-macro-info nil) | |
354 ;; | 355 ;; |
355 (setq gdb-buffer-type 'gdba) | 356 (setq gdb-buffer-type 'gdba) |
356 ;; | 357 ;; |
357 (if gdb-use-inferior-io-buffer (gdb-clear-inferior-io)) | 358 (if gdb-use-inferior-io-buffer (gdb-clear-inferior-io)) |
358 ;; | 359 ;; |
378 "Watch expression at point." | 379 "Watch expression at point." |
379 (interactive) | 380 (interactive) |
380 (require 'tooltip) | 381 (require 'tooltip) |
381 (let ((expr (tooltip-identifier-from-point (point)))) | 382 (let ((expr (tooltip-identifier-from-point (point)))) |
382 (if (and (string-equal gdb-current-language "c") | 383 (if (and (string-equal gdb-current-language "c") |
383 gdb-use-colon-colon-notation gdb-current-frame) | 384 gdb-use-colon-colon-notation gdb-selected-frame) |
384 (setq expr (concat gdb-current-frame "::" expr))) | 385 (setq expr (concat gdb-selected-frame "::" expr))) |
385 (catch 'already-watched | 386 (catch 'already-watched |
386 (dolist (var gdb-var-list) | 387 (dolist (var gdb-var-list) |
387 (if (string-equal expr (car var)) (throw 'already-watched nil))) | 388 (if (string-equal expr (car var)) (throw 'already-watched nil))) |
388 (set-text-properties 0 (length expr) nil expr) | 389 (set-text-properties 0 (length expr) nil expr) |
389 (gdb-enqueue-input | 390 (gdb-enqueue-input |
860 (setq gdb-input-queue nil) | 861 (setq gdb-input-queue nil) |
861 (setq gdb-pending-triggers nil) | 862 (setq gdb-pending-triggers nil) |
862 (setq gdb-prompting t)) | 863 (setq gdb-prompting t)) |
863 | 864 |
864 (defconst gdb-source-spec-regexp | 865 (defconst gdb-source-spec-regexp |
865 "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:\\(0x[a-f0-9]*\\)") | 866 "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:0x0*\\([a-f0-9]*\\)") |
866 | 867 |
867 ;; Do not use this except as an annotation handler. | 868 ;; Do not use this except as an annotation handler. |
868 (defun gdb-source (args) | 869 (defun gdb-source (args) |
869 (string-match gdb-source-spec-regexp args) | 870 (string-match gdb-source-spec-regexp args) |
870 ;; Extract the frame position from the marker. | 871 ;; Extract the frame position from the marker. |
871 (setq gud-last-frame | 872 (setq gud-last-frame |
872 (cons | 873 (cons |
873 (match-string 1 args) | 874 (match-string 1 args) |
874 (string-to-number (match-string 2 args)))) | 875 (string-to-number (match-string 2 args)))) |
875 (setq gdb-current-address (match-string 3 args)) | 876 (setq gdb-frame-address (match-string 3 args)) |
876 ;; cover for auto-display output which comes *before* | 877 ;; cover for auto-display output which comes *before* |
877 ;; stopped annotation | 878 ;; stopped annotation |
878 (if (eq gdb-output-sink 'inferior) (setq gdb-output-sink 'user))) | 879 (if (eq gdb-output-sink 'inferior) (setq gdb-output-sink 'user))) |
879 | 880 |
880 (defun gdb-pre-prompt (ignored) | 881 (defun gdb-pre-prompt (ignored) |
983 (defun gdb-post-prompt (ignored) | 984 (defun gdb-post-prompt (ignored) |
984 "An annotation handler for `post-prompt'. | 985 "An annotation handler for `post-prompt'. |
985 This begins the collection of output from the current command if that | 986 This begins the collection of output from the current command if that |
986 happens to be appropriate." | 987 happens to be appropriate." |
987 (unless gdb-pending-triggers | 988 (unless gdb-pending-triggers |
988 (gdb-get-current-frame) | 989 (gdb-get-selected-frame) |
989 (gdb-invalidate-frames) | 990 (gdb-invalidate-frames) |
990 (gdb-invalidate-breakpoints) | 991 (gdb-invalidate-breakpoints) |
991 (gdb-invalidate-assembler) | 992 ;; Do this through gdb-get-selected-frame -> gdb-frame-handler |
993 ;; so gdb-frame-address is updated. | |
994 ;; (gdb-invalidate-assembler) | |
992 (gdb-invalidate-registers) | 995 (gdb-invalidate-registers) |
993 (gdb-invalidate-memory) | 996 (gdb-invalidate-memory) |
994 (gdb-invalidate-locals) | 997 (gdb-invalidate-locals) |
995 (gdb-invalidate-threads) | 998 (gdb-invalidate-threads) |
996 (unless (eq system-type 'darwin) ;Breaks on Darwin's GDB-5.3. | 999 (unless (eq system-type 'darwin) ;Breaks on Darwin's GDB-5.3. |
1509 (add-text-properties (line-beginning-position) (line-end-position) | 1512 (add-text-properties (line-beginning-position) (line-end-position) |
1510 '(mouse-face highlight | 1513 '(mouse-face highlight |
1511 help-echo "mouse-2, RET: Select frame")) | 1514 help-echo "mouse-2, RET: Select frame")) |
1512 (beginning-of-line) | 1515 (beginning-of-line) |
1513 (when (and (looking-at "^#\\([0-9]+\\)") | 1516 (when (and (looking-at "^#\\([0-9]+\\)") |
1514 (equal (match-string 1) gdb-current-stack-level)) | 1517 (equal (match-string 1) gdb-frame-number)) |
1515 (put-text-property (line-beginning-position) (line-end-position) | 1518 (put-text-property (line-beginning-position) (line-end-position) |
1516 'face '(:inverse-video t))) | 1519 'face '(:inverse-video t))) |
1517 (forward-line 1)))))) | 1520 (forward-line 1)))))) |
1518 | 1521 |
1519 (defun gdb-stack-buffer-name () | 1522 (defun gdb-stack-buffer-name () |
1913 (concat | 1916 (concat |
1914 "Read address: " | 1917 "Read address: " |
1915 (propertize gdb-memory-address | 1918 (propertize gdb-memory-address |
1916 'face font-lock-warning-face | 1919 'face font-lock-warning-face |
1917 'help-echo "mouse-1: Set memory address" | 1920 'help-echo "mouse-1: Set memory address" |
1921 'mouse-face 'mode-line-highlight | |
1918 'local-map (gdb-make-header-line-mouse-map | 1922 'local-map (gdb-make-header-line-mouse-map |
1919 'mouse-1 | 1923 'mouse-1 |
1920 #'gdb-memory-set-address)) | 1924 #'gdb-memory-set-address)) |
1921 " Repeat Count: " | 1925 " Repeat Count: " |
1922 (propertize (number-to-string gdb-memory-repeat-count) | 1926 (propertize (number-to-string gdb-memory-repeat-count) |
1923 'face font-lock-warning-face | 1927 'face font-lock-warning-face |
1924 'help-echo "mouse-1: Set repeat count" | 1928 'help-echo "mouse-1: Set repeat count" |
1929 'mouse-face 'mode-line-highlight | |
1925 'local-map (gdb-make-header-line-mouse-map | 1930 'local-map (gdb-make-header-line-mouse-map |
1926 'mouse-1 | 1931 'mouse-1 |
1927 #'gdb-memory-set-repeat-count)) | 1932 #'gdb-memory-set-repeat-count)) |
1928 " Display Format: " | 1933 " Display Format: " |
1929 (propertize gdb-memory-format | 1934 (propertize gdb-memory-format |
1930 'face font-lock-warning-face | 1935 'face font-lock-warning-face |
1931 'help-echo "mouse-3: Select display format" | 1936 'help-echo "mouse-3: Select display format" |
1937 'mouse-face 'mode-line-highlight | |
1932 'local-map gdb-memory-format-keymap) | 1938 'local-map gdb-memory-format-keymap) |
1933 " Unit Size: " | 1939 " Unit Size: " |
1934 (propertize gdb-memory-unit | 1940 (propertize gdb-memory-unit |
1935 'face font-lock-warning-face | 1941 'face font-lock-warning-face |
1936 'help-echo "mouse-3: Select unit size" | 1942 'help-echo "mouse-3: Select unit size" |
1943 'mouse-face 'mode-line-highlight | |
1937 'local-map gdb-memory-unit-keymap)))) | 1944 'local-map gdb-memory-unit-keymap)))) |
1938 (run-mode-hooks 'gdb-memory-mode-hook) | 1945 (run-mode-hooks 'gdb-memory-mode-hook) |
1939 'gdb-invalidate-memory) | 1946 'gdb-invalidate-memory) |
1940 | 1947 |
1941 (defun gdb-memory-buffer-name () | 1948 (defun gdb-memory-buffer-name () |
2007 "Major mode for gdb locals. | 2014 "Major mode for gdb locals. |
2008 | 2015 |
2009 \\{gdb-locals-mode-map}" | 2016 \\{gdb-locals-mode-map}" |
2010 (kill-all-local-variables) | 2017 (kill-all-local-variables) |
2011 (setq major-mode 'gdb-locals-mode) | 2018 (setq major-mode 'gdb-locals-mode) |
2012 (setq mode-name (concat "Locals:" gdb-current-frame)) | 2019 (setq mode-name (concat "Locals:" gdb-selected-frame)) |
2013 (setq buffer-read-only t) | 2020 (setq buffer-read-only t) |
2014 (use-local-map gdb-locals-mode-map) | 2021 (use-local-map gdb-locals-mode-map) |
2015 (run-mode-hooks 'gdb-locals-mode-hook) | 2022 (run-mode-hooks 'gdb-locals-mode-hook) |
2016 (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba)) | 2023 (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba)) |
2017 'gdb-invalidate-locals | 2024 'gdb-invalidate-locals |
2067 `(menu-item "GDB-Windows" ,menu | 2074 `(menu-item "GDB-Windows" ,menu |
2068 :visible (memq gud-minor-mode '(gdbmi gdba)))) | 2075 :visible (memq gud-minor-mode '(gdbmi gdba)))) |
2069 (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer)) | 2076 (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer)) |
2070 (define-key menu [threads] '("Threads" . gdb-display-threads-buffer)) | 2077 (define-key menu [threads] '("Threads" . gdb-display-threads-buffer)) |
2071 (define-key menu [memory] '("Memory" . gdb-display-memory-buffer)) | 2078 (define-key menu [memory] '("Memory" . gdb-display-memory-buffer)) |
2072 (define-key menu [assembler] '("Machine" . gdb-display-assembler-buffer)) | 2079 (define-key menu [disassembly] |
2080 '("Disassembly" . gdb-display-assembler-buffer)) | |
2073 (define-key menu [registers] '("Registers" . gdb-display-registers-buffer)) | 2081 (define-key menu [registers] '("Registers" . gdb-display-registers-buffer)) |
2074 (define-key menu [inferior] | 2082 (define-key menu [inferior] |
2075 '(menu-item "Inferior IO" gdb-display-inferior-io-buffer | 2083 '(menu-item "Inferior IO" gdb-display-inferior-io-buffer |
2076 :enable gdb-use-inferior-io-buffer)) | 2084 :enable gdb-use-inferior-io-buffer)) |
2077 (define-key menu [locals] '("Locals" . gdb-display-locals-buffer)) | 2085 (define-key menu [locals] '("Locals" . gdb-display-locals-buffer)) |
2084 `(menu-item "GDB-Frames" ,menu | 2092 `(menu-item "GDB-Frames" ,menu |
2085 :visible (memq gud-minor-mode '(gdbmi gdba)))) | 2093 :visible (memq gud-minor-mode '(gdbmi gdba)))) |
2086 (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer)) | 2094 (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer)) |
2087 (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer)) | 2095 (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer)) |
2088 (define-key menu [memory] '("Memory" . gdb-frame-memory-buffer)) | 2096 (define-key menu [memory] '("Memory" . gdb-frame-memory-buffer)) |
2089 (define-key menu [assembler] '("Machine" . gdb-frame-assembler-buffer)) | 2097 (define-key menu [disassembly] '("Disassembiy" . gdb-frame-assembler-buffer)) |
2090 (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer)) | 2098 (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer)) |
2091 (define-key menu [inferior] | 2099 (define-key menu [inferior] |
2092 '(menu-item "Inferior IO" gdb-frame-inferior-io-buffer | 2100 '(menu-item "Inferior IO" gdb-frame-inferior-io-buffer |
2093 :enable gdb-use-inferior-io-buffer)) | 2101 :enable gdb-use-inferior-io-buffer)) |
2094 (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer)) | 2102 (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer)) |
2130 (gdb-get-create-buffer 'gdba))) | 2138 (gdb-get-create-buffer 'gdba))) |
2131 | 2139 |
2132 (defvar gdb-main-file nil "Source file from which program execution begins.") | 2140 (defvar gdb-main-file nil "Source file from which program execution begins.") |
2133 | 2141 |
2134 (defcustom gdb-show-main nil | 2142 (defcustom gdb-show-main nil |
2135 "Nil means don't display source file containing the main routine." | 2143 "Non-nil means display source file containing the main routine at startup." |
2144 "Also display the main routine in the disassembly buffer if present." | |
2136 :type 'boolean | 2145 :type 'boolean |
2137 :group 'gud | 2146 :group 'gud |
2138 :version "22.1") | 2147 :version "22.1") |
2139 | 2148 |
2140 (defun gdb-set-window-buffer (name) | 2149 (defun gdb-set-window-buffer (name) |
2397 'gdb-assembler-buffer-name | 2406 'gdb-assembler-buffer-name |
2398 'gdb-assembler-mode) | 2407 'gdb-assembler-mode) |
2399 | 2408 |
2400 (def-gdb-auto-updated-buffer gdb-assembler-buffer | 2409 (def-gdb-auto-updated-buffer gdb-assembler-buffer |
2401 gdb-invalidate-assembler | 2410 gdb-invalidate-assembler |
2402 (concat gdb-server-prefix "disassemble " gdb-current-address "\n") | 2411 (concat gdb-server-prefix "disassemble " |
2412 (if (member gdb-frame-address '(nil "main")) nil "0x") | |
2413 gdb-frame-address "\n") | |
2403 gdb-assembler-handler | 2414 gdb-assembler-handler |
2404 gdb-assembler-custom) | 2415 gdb-assembler-custom) |
2405 | 2416 |
2406 (defun gdb-assembler-custom () | 2417 (defun gdb-assembler-custom () |
2407 (let ((buffer (gdb-get-buffer 'gdb-assembler-buffer)) | 2418 (let ((buffer (gdb-get-buffer 'gdb-assembler-buffer)) |
2408 (pos 1) (address) (flag) (bptno)) | 2419 (pos 1) (address) (flag) (bptno)) |
2409 (with-current-buffer buffer | 2420 (with-current-buffer buffer |
2410 (if (not (equal gdb-current-address "main")) | 2421 (if (not (equal gdb-frame-address "main")) |
2411 (progn | 2422 (progn |
2412 (goto-char (point-min)) | 2423 (goto-char (point-min)) |
2413 (if (re-search-forward gdb-current-address nil t) | 2424 (if (and gdb-frame-address |
2425 (re-search-forward gdb-frame-address nil t)) | |
2414 (progn | 2426 (progn |
2415 (setq pos (point)) | 2427 (setq pos (point)) |
2416 (beginning-of-line) | 2428 (beginning-of-line) |
2417 (or gdb-overlay-arrow-position | 2429 (or gdb-overlay-arrow-position |
2418 (setq gdb-overlay-arrow-position (make-marker))) | 2430 (setq gdb-overlay-arrow-position (make-marker))) |
2425 (while (< (point) (- (point-max) 1)) | 2437 (while (< (point) (- (point-max) 1)) |
2426 (forward-line 1) | 2438 (forward-line 1) |
2427 (if (looking-at "[^\t].*breakpoint") | 2439 (if (looking-at "[^\t].*breakpoint") |
2428 (progn | 2440 (progn |
2429 (looking-at | 2441 (looking-at |
2430 "\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+\\(.\\)\\s-+0x\\(\\S-+\\)") | 2442 "\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+\\(.\\)\\s-+0x0*\\(\\S-+\\)") |
2431 (setq bptno (match-string 1)) | 2443 (setq bptno (match-string 1)) |
2432 (setq flag (char-after (match-beginning 2))) | 2444 (setq flag (char-after (match-beginning 2))) |
2433 (setq address (match-string 3)) | 2445 (setq address (match-string 3)) |
2434 ;; remove leading 0s from output of info break. | |
2435 (if (string-match "^0+\\(.*\\)" address) | |
2436 (setq address (match-string 1 address))) | |
2437 (with-current-buffer buffer | 2446 (with-current-buffer buffer |
2438 (goto-char (point-min)) | 2447 (goto-char (point-min)) |
2439 (if (re-search-forward address nil t) | 2448 (if (re-search-forward address nil t) |
2440 (gdb-put-breakpoint-icon (eq flag ?y) bptno))))))) | 2449 (gdb-put-breakpoint-icon (eq flag ?y) bptno))))))) |
2441 (if (not (equal gdb-current-address "main")) | 2450 (if (not (equal gdb-frame-address "main")) |
2442 (set-window-point (get-buffer-window buffer 0) pos)))) | 2451 (set-window-point (get-buffer-window buffer 0) pos)))) |
2443 | 2452 |
2444 (defvar gdb-assembler-mode-map | 2453 (defvar gdb-assembler-mode-map |
2445 (let ((map (make-sparse-keymap))) | 2454 (let ((map (make-sparse-keymap))) |
2446 (suppress-keymap map) | 2455 (suppress-keymap map) |
2466 "Major mode for viewing code assembler. | 2475 "Major mode for viewing code assembler. |
2467 | 2476 |
2468 \\{gdb-assembler-mode-map}" | 2477 \\{gdb-assembler-mode-map}" |
2469 (kill-all-local-variables) | 2478 (kill-all-local-variables) |
2470 (setq major-mode 'gdb-assembler-mode) | 2479 (setq major-mode 'gdb-assembler-mode) |
2471 (setq mode-name "Machine") | 2480 (setq mode-name (concat "Machine:" gdb-selected-frame)) |
2472 (setq gdb-overlay-arrow-position nil) | 2481 (setq gdb-overlay-arrow-position nil) |
2473 (add-to-list 'overlay-arrow-variable-list 'gdb-overlay-arrow-position) | 2482 (add-to-list 'overlay-arrow-variable-list 'gdb-overlay-arrow-position) |
2474 (setq fringes-outside-margins t) | 2483 (setq fringes-outside-margins t) |
2475 (setq buffer-read-only t) | 2484 (setq buffer-read-only t) |
2476 (use-local-map gdb-assembler-mode-map) | 2485 (use-local-map gdb-assembler-mode-map) |
2480 (run-mode-hooks 'gdb-assembler-mode-hook) | 2489 (run-mode-hooks 'gdb-assembler-mode-hook) |
2481 'gdb-invalidate-assembler) | 2490 'gdb-invalidate-assembler) |
2482 | 2491 |
2483 (defun gdb-assembler-buffer-name () | 2492 (defun gdb-assembler-buffer-name () |
2484 (with-current-buffer gud-comint-buffer | 2493 (with-current-buffer gud-comint-buffer |
2485 (concat "*Machine Code " (gdb-get-target-string) "*"))) | 2494 (concat "*Disassembly of " (gdb-get-target-string) "*"))) |
2486 | 2495 |
2487 (defun gdb-display-assembler-buffer () | 2496 (defun gdb-display-assembler-buffer () |
2488 "Display disassembly view." | 2497 "Display disassembly view." |
2489 (interactive) | 2498 (interactive) |
2490 (gdb-display-buffer | 2499 (gdb-display-buffer |
2495 (interactive) | 2504 (interactive) |
2496 (let ((special-display-regexps (append special-display-regexps '(".*"))) | 2505 (let ((special-display-regexps (append special-display-regexps '(".*"))) |
2497 (special-display-frame-alist gdb-frame-parameters)) | 2506 (special-display-frame-alist gdb-frame-parameters)) |
2498 (display-buffer (gdb-get-create-buffer 'gdb-assembler-buffer)))) | 2507 (display-buffer (gdb-get-create-buffer 'gdb-assembler-buffer)))) |
2499 | 2508 |
2500 ;; modified because if gdb-current-address has changed value a new command | 2509 ;; modified because if gdb-frame-address has changed value a new command |
2501 ;; must be enqueued to update the buffer with the new output | 2510 ;; must be enqueued to update the buffer with the new output |
2502 (defun gdb-invalidate-assembler (&optional ignored) | 2511 (defun gdb-invalidate-assembler (&optional ignored) |
2503 (if (gdb-get-buffer 'gdb-assembler-buffer) | 2512 (if (gdb-get-buffer 'gdb-assembler-buffer) |
2504 (progn | 2513 (progn |
2505 (unless (string-equal gdb-current-frame gdb-previous-frame) | 2514 (unless (and gdb-selected-frame |
2515 (string-equal gdb-selected-frame gdb-previous-frame)) | |
2506 (if (or (not (member 'gdb-invalidate-assembler | 2516 (if (or (not (member 'gdb-invalidate-assembler |
2507 gdb-pending-triggers)) | 2517 gdb-pending-triggers)) |
2508 (not (string-equal gdb-current-address | 2518 (not (string-equal gdb-frame-address |
2509 gdb-previous-address))) | 2519 gdb-previous-frame-address))) |
2510 (progn | 2520 (progn |
2511 ;; take previous disassemble command off the queue | 2521 ;; take previous disassemble command, if any, off the queue |
2512 (with-current-buffer gud-comint-buffer | 2522 (with-current-buffer gud-comint-buffer |
2513 (let ((queue gdb-input-queue)) | 2523 (let ((queue gdb-input-queue)) |
2514 (dolist (item queue) | 2524 (dolist (item queue) |
2515 (if (equal (cdr item) '(gdb-assembler-handler)) | 2525 (if (equal (cdr item) '(gdb-assembler-handler)) |
2516 (setq gdb-input-queue | 2526 (setq gdb-input-queue |
2517 (delete item gdb-input-queue)))))) | 2527 (delete item gdb-input-queue)))))) |
2518 (gdb-enqueue-input | 2528 (gdb-enqueue-input |
2519 (list (concat gdb-server-prefix "disassemble " | 2529 (list |
2520 gdb-current-address "\n") | 2530 (concat gdb-server-prefix "disassemble " |
2531 (if (member gdb-frame-address '(nil "main")) nil "0x") | |
2532 gdb-frame-address "\n") | |
2521 'gdb-assembler-handler)) | 2533 'gdb-assembler-handler)) |
2522 (push 'gdb-invalidate-assembler gdb-pending-triggers) | 2534 (push 'gdb-invalidate-assembler gdb-pending-triggers) |
2523 (setq gdb-previous-address gdb-current-address) | 2535 (setq gdb-previous-frame-address gdb-frame-address) |
2524 (setq gdb-previous-frame gdb-current-frame))))))) | 2536 (setq gdb-previous-frame gdb-selected-frame))))))) |
2525 | 2537 |
2526 (defun gdb-get-current-frame () | 2538 (defun gdb-get-selected-frame () |
2527 (if (not (member 'gdb-get-current-frame gdb-pending-triggers)) | 2539 (if (not (member 'gdb-get-selected-frame gdb-pending-triggers)) |
2528 (progn | 2540 (progn |
2529 (gdb-enqueue-input | 2541 (gdb-enqueue-input |
2530 (list (concat gdb-server-prefix "info frame\n") 'gdb-frame-handler)) | 2542 (list (concat gdb-server-prefix "info frame\n") 'gdb-frame-handler)) |
2531 (push 'gdb-get-current-frame | 2543 (push 'gdb-get-selected-frame |
2532 gdb-pending-triggers)))) | 2544 gdb-pending-triggers)))) |
2533 | 2545 |
2534 (defun gdb-frame-handler () | 2546 (defun gdb-frame-handler () |
2535 (setq gdb-pending-triggers | 2547 (setq gdb-pending-triggers |
2536 (delq 'gdb-get-current-frame gdb-pending-triggers)) | 2548 (delq 'gdb-get-selected-frame gdb-pending-triggers)) |
2537 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) | 2549 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) |
2538 (goto-char (point-min)) | 2550 (goto-char (point-min)) |
2539 (if (looking-at "Stack level \\([0-9]+\\)") | 2551 (if (re-search-forward "Stack level \\([0-9]+\\)" nil t) |
2540 (setq gdb-current-stack-level (match-string 1))) | 2552 (setq gdb-frame-number (match-string 1))) |
2541 (forward-line) | 2553 (goto-char (point-min)) |
2542 (if (looking-at ".*=\\s-+0x\\(\\S-*\\)\\s-+in\\s-+\\(\\S-*?\\);? ") | 2554 (if (re-search-forward |
2555 ".*=\\s-+0x0*\\(\\S-*\\)\\s-+in\\s-+\\(\\S-*?\\);? " nil t) | |
2543 (progn | 2556 (progn |
2544 (setq gdb-current-frame (match-string 2)) | 2557 (setq gdb-selected-frame (match-string 2)) |
2545 (if (gdb-get-buffer 'gdb-locals-buffer) | 2558 (if (gdb-get-buffer 'gdb-locals-buffer) |
2546 (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer) | 2559 (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer) |
2547 (setq mode-name (concat "Locals:" gdb-current-frame)))) | 2560 (setq mode-name (concat "Locals:" gdb-selected-frame)))) |
2548 (let ((address (match-string 1))) | 2561 (if (gdb-get-buffer 'gdb-assembler-buffer) |
2549 ;; remove leading 0s from output of info frame command. | 2562 (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer) |
2550 (if (string-match "^0+\\(.*\\)" address) | 2563 (setq mode-name (concat "Machine:" gdb-selected-frame)))) |
2551 (setq gdb-current-address | 2564 (setq gdb-frame-address (match-string 1)))) |
2552 (concat "0x" (match-string 1 address))) | 2565 (goto-char (point-min)) |
2553 (setq gdb-current-address (concat "0x" address)))) | |
2554 (if (not (re-search-forward "(\\S-*:[0-9]*);" nil t)) | |
2555 ;;update with new frame for machine code if necessary | |
2556 (gdb-invalidate-assembler))))) | |
2557 (if (re-search-forward " source language \\(\\S-*\\)\." nil t) | 2566 (if (re-search-forward " source language \\(\\S-*\\)\." nil t) |
2558 (setq gdb-current-language (match-string 1)))) | 2567 (setq gdb-current-language (match-string 1)))) |
2568 (gdb-invalidate-assembler)) | |
2559 | 2569 |
2560 (provide 'gdb-ui) | 2570 (provide 'gdb-ui) |
2561 | 2571 |
2562 ;; arch-tag: e9fb00c5-74ef-469f-a088-37384caae352 | 2572 ;; arch-tag: e9fb00c5-74ef-469f-a088-37384caae352 |
2563 ;;; gdb-ui.el ends here | 2573 ;;; gdb-ui.el ends here |