;; Run gcl under Emacs ;; Author: W. Schelter, University of Texas ;; wfs@rascal.ics.utexas.edu ;; This file is part of GNU Emacs. ;; Copyright (C) 1988 Free Software Foundation, Inc. ;; GNU Emacs is distributed in the hope that it will be useful, but ;; WITHOUT ANY WARRANTY. No author or distributor accepts responsibility ;; to anyone for the consequences of using it or for whether it serves ;; any particular purpose or works at all, unless he says so in writing. ;; Refer to the GNU Emacs General Public License for full details. ;; Everyone is granted permission to copy, modify and redistribute GNU ;; Emacs, but only under the conditions described in the GNU Emacs ;; General Public License. A copy of this license is supposed to have ;; been given to you along with GNU Emacs so you can know your rights and ;; responsibilities. It should be in a file named COPYING. Among other ;; things, the copyright notice and this notice must be preserved on all ;; copies. ;; Description of DBL interface: ;; A facility is provided for the simultaneous display of the source code ;; in one window, while using dbl to step through a function in the ;; other. A small arrow in the source window, indicates the current ;; line. ;; Starting up: ;; In order to use this facility, invoke the command DBL to obtain a ;; shell window with the appropriate command bindings. You will be asked ;; for the name of a file to run. Dbl will be invoked on this file, in a ;; window named *dbl-foo* if the file is foo. ;; M-s steps by one line, and redisplays the source file and line. ;; You may easily create additional commands and bindings to interact ;; with the display. For example to put the dbl command next on \M-n ;; (def-dbl next "\M-n") ;; This causes the emacs command dbl-next to be defined, and runs ;; dbl-display-frame after the command. ;; dbl-display-frame is the basic display function. It tries to display ;; in the other window, the file and line corresponding to the current ;; position in the dbl window. For example after a dbl-step, it would ;; display the line corresponding to the position for the last step. Or ;; if you have done a backtrace in the dbl buffer, and move the cursor ;; into one of the frames, it would display the position corresponding to ;; that frame. ;; dbl-display-frame is invoked automatically when a filename-and-line-number ;; appears in the output. (require 'sshell) (require 'gcl) (defvar dbl-prompt-pattern "\\(^(.*gdb[+]*) *\\)\\|\\(^[^#$%>]*[#$%>]+ *\\)" "A regexp to recognize the prompt for dbl or dbl+.") (defvar dbl-mode-map nil "Keymap for dbl-mode.") (if dbl-mode-map nil (setq dbl-mode-map (copy-keymap shell-mode-map)) (define-key dbl-mode-map "\C-cl" 'dbl-find-line) ) (define-key ctl-x-map " " 'dbl-break) ;(define-key ctl-x-map "&" 'send-dbl-command) ;;Of course you may use `def-dbl' with any other dbl command, including ;;user defined ones. (defmacro def-dbl (name key &optional doc) (let* ((fun (intern (format "dbl-%s" name))) (cstr (list 'if '(not (= 1 arg)) (list 'format "%s %s" name 'arg) name))) (list 'progn (list 'defun fun '(arg) (or doc "") '(interactive "p") (list 'dbl-call cstr)) (list 'define-key 'dbl-mode-map key (list 'quote fun))))) (def-dbl ":step" "\M-s" "Step one source line with display") (def-dbl ":step" "\M-i" "Step one instruction with display") (def-dbl ":next" "\M-n" "Step one source line (skip functions)") (def-dbl ":r" "\M-c" "Continue with display") (def-dbl "finish" "\C-c\C-f" "Finish executing current function") (def-dbl ":up" "\M-u" "Go up N stack frames (numeric arg) with display") (def-dbl ":down" "\M-d" "Go down N stack frames (numeric arg) with display") (defun dbl-mode () "Major mode for interacting with an inferior Dbl process. The following commands are available: \\{dbl-mode-map} \\[dbl-display-frame] displays in the other window the last line referred to in the dbl buffer. \\[dbl-:step] and \\[dbl-:next] in the dbl window, call dbl to step and next and then update the other window with the current file and position. If you are in a source file, you may select a point to break at, by doing \\[dbl-break]. Commands: Many commands are inherited from shell mode. Additionally we have: \\[dbl-display-frame] display frames file in other window \\[dbl-:step] advance one line in program \\[dbl-:next] advance one line in program (skip over calls). \\[send-dbl-command] used for special printing of an arg at the current point. C-x SPACE sets break point at current line." (interactive) (kill-all-local-variables) (setq major-mode 'dbl-mode) (setq mode-name "Inferior Dbl") (setq mode-line-process '(": %s")) (use-local-map dbl-mode-map) (make-local-variable 'last-input-start) (setq last-input-start (make-marker)) (make-local-variable 'last-input-end) (setq last-input-end (make-marker)) (make-local-variable 'dbl-last-frame) (setq dbl-last-frame nil) (make-local-variable 'dbl-last-frame-displayed-p) (setq dbl-last-frame-displayed-p t) (make-local-variable 'dbl-delete-prompt-marker) (setq dbl-delete-prompt-marker nil) (make-local-variable 'dbl-filter-accumulator) (setq dbl-filter-accumulator nil) (make-local-variable 'shell-prompt-pattern) (setq shell-prompt-pattern dbl-prompt-pattern) (run-hooks 'shell-mode-hook 'dbl-mode-hook)) (defvar current-dbl-buffer nil) (defvar dbl-command-name "/bin/csh" "Pathname for executing dbl.") (defun dbl (arg) " makes a dbl buffer, suitable for running an inferior gcl. It has special keybindings for stepping and viewing sources. Once in the buffer invoke the lisp. Enter the debug loop with (si::dbl) or :dbl in a debug loop. " (interactive "sName: ") (let ((file arg) tem (dir default-directory)) (switch-to-buffer (concat "*dbl-" file "*")) (setq default-directory (if (and (setq tem (file-name-directory file)) (file-directory-p tem)) tem dir)) (or (bolp) (newline)) (insert "Current directory is " default-directory "\n") (make-shell (concat "dbl-" file) dbl-command-name nil ) (dbl-mode) (set-process-filter (get-buffer-process (current-buffer)) 'dbl-filter) (set-process-sentinel (get-buffer-process (current-buffer)) 'dbl-sentinel) (dbl-set-buffer))) (defun dbl-set-buffer () (cond ((eq major-mode 'dbl-mode) (setq current-dbl-buffer (current-buffer))))) ;; This function is responsible for inserting output from DBL ;; into the buffer. ;; Aside from inserting the text, it notices and deletes ;; each filename-and-line-number; ;; that DBL prints to identify the selected frame. ;; It records the filename and line number, and maybe displays that file. (defun dbl-filter (proc string) (let ((inhibit-quit t)) (if dbl-filter-accumulator (dbl-filter-accumulate-marker proc (concat dbl-filter-accumulator string)) (dbl-filter-scan-input proc string)))) (defun dbl-filter-accumulate-marker (proc string) (setq dbl-filter-accumulator nil) (if (> (length string) 1) (if (= (aref string 1) ?\032) (let ((end (string-match "\n" string))) (if end (progn (let* ((first-colon (string-match ":" string 2)) (second-colon (string-match ":" string (1+ first-colon)))) (setq dbl-last-frame (cons (substring string 2 first-colon) (string-to-int (substring string (1+ first-colon) second-colon))))) (setq dbl-last-frame-displayed-p nil) (dbl-filter-scan-input proc (substring string (1+ end)))) (setq dbl-filter-accumulator string))) (dbl-filter-insert proc "\032") (dbl-filter-scan-input proc (substring string 1))) (setq dbl-filter-accumulator string))) (defun dbl-filter-scan-input (proc string) (if (equal string "") (setq dbl-filter-accumulator nil) (let ((start (string-match "\032" string))) (if start (progn (dbl-filter-insert proc (substring string 0 start)) (dbl-filter-accumulate-marker proc (substring string start))) (dbl-filter-insert proc string))))) (defun dbl-filter-insert (proc string) (let ((moving (= (point) (process-mark proc))) (output-after-point (< (point) (process-mark proc))) (old-buffer (current-buffer)) start) (set-buffer (process-buffer proc)) (unwind-protect (save-excursion ;; Insert the text, moving the process-marker. (goto-char (process-mark proc)) (setq start (point)) (insert string) (set-marker (process-mark proc) (point)) (dbl-maybe-delete-prompt) ;; Check for a filename-and-line number. (dbl-display-frame ;; Don't display the specified file ;; unless (1) point is at or after the position where output appears ;; and (2) this buffer is on the screen. (or output-after-point (not (get-buffer-window (current-buffer)))) ;; Display a file only when a new filename-and-line-number appears. t) (goto-char (point-max)) ) (set-buffer old-buffer)) (if moving (goto-char (process-mark proc))))) (setq me nil) (defun dbl-sentinel (proc msg) (cond ((null (buffer-name (process-buffer proc))) ;; buffer killed ;; Stop displaying an arrow in a source file. (setq overlay-arrow-position nil) (set-process-buffer proc nil)) ((memq (process-status proc) '(signal exit)) ;; Stop displaying an arrow in a source file. (setq overlay-arrow-position nil) ;; Fix the mode line. (setq mode-line-process (concat ": " (symbol-name (process-status proc)))) (let* ((obuf (current-buffer))) ;; save-excursion isn't the right thing if ;; process-buffer is current-buffer (unwind-protect (progn ;; Write something in *compilation* and hack its mode line, (set-buffer (process-buffer proc)) ;; Force mode line redisplay soon (set-buffer-modified-p (buffer-modified-p)) (if (eobp) (insert ?\n mode-name " " msg) (save-excursion (goto-char (point-max)) (insert ?\n mode-name " " msg))) ;; If buffer and mode line will show that the process ;; is dead, we can delete it now. Otherwise it ;; will stay around until M-x list-processes. (delete-process proc)) ;; Restore old buffer, but don't restore old point ;; if obuf is the dbl buffer. (set-buffer obuf)))))) (defun dbl-refresh () "Fix up a possibly garbled display, and redraw the arrow." (interactive) (redraw-display) (dbl-display-frame)) (defun dbl-display-frame (&optional nodisplay noauto) "Find, obey and delete the last filename-and-line marker from DBL. The marker looks like \\032\\032FILENAME:LINE:CHARPOS\\n. Obeying it means displaying in another window the specified file and line." (interactive) (dbl-set-buffer) (and dbl-last-frame (not nodisplay) (or (not dbl-last-frame-displayed-p) (not noauto)) (progn (dbl-display-line (car dbl-last-frame) (cdr dbl-last-frame)) (setq dbl-last-frame-displayed-p t)))) ;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen ;; and that its line LINE is visible. ;; Put the overlay-arrow on the line LINE in that buffer. (defun dbl-find-file (file) (cond ((file-exists-p file) (find-file-noselect file)) ((get-buffer file)) (t (find-file-noselect file)))) (defvar dbl-dirs nil) (defun search-path (file dirs) (let ((paths (symbol-value dirs)) true-file) (cond ((file-exists-p file) (setq true-file file)) (t (while paths (let ((tem (expand-file-name file (or (car paths) default-directory)))) (if (file-exists-p tem) (setq true-file tem)) (setq paths (cdr paths)))))) (cond (true-file) (t (setq paths (symbol-value dirs)) (set dirs (append paths (list (file-name-directory (read-file-name (format "%s = %s, add path :" dirs paths)))))) (search-path file dirs))))) (defun dbl-find-line () (interactive) (save-excursion (end-of-line) (cond ((re-search-backward "[a-zA-Z] line [0-9]+)" 300 nil) (let (at) (setq at (point)) (forward-char 1) (forward-sexp 1) (setq line (read (current-buffer))) (search-backward "(") (setq file (buffer-substring (+ 1 (point)) (+ 1 at))) (and (integerp line) (setq file (search-path file 'dbl-dirs)) (dbl-display-line file line))))))) (defun dbl-display-line (true-file line) (let* ((buffer (dbl-find-file true-file)) (window (display-buffer buffer t)) (pos)) (save-excursion (set-buffer buffer) (save-restriction (widen) (goto-line line) (setq pos (point)) (setq overlay-arrow-string "=>") (or overlay-arrow-position (setq overlay-arrow-position (make-marker))) (set-marker overlay-arrow-position (point) (current-buffer))) (cond ((or (< pos (point-min)) (> pos (point-max))) (widen) (goto-char pos)))) (set-window-point window overlay-arrow-position))) (defun dbl-call (command) "Invoke dbl COMMAND displaying source in other window." (interactive) (goto-char (point-max)) (setq dbl-delete-prompt-marker (point-marker)) (dbl-set-buffer) (send-string (get-buffer-process current-dbl-buffer) (concat command "\n"))) (defun dbl-maybe-delete-prompt () (if (and dbl-delete-prompt-marker (> (point-max) (marker-position dbl-delete-prompt-marker))) (let (start) (goto-char dbl-delete-prompt-marker) (setq start (point)) (beginning-of-line) (delete-region (point) start) (setq dbl-delete-prompt-marker nil)))) (defun dbl-break () "Set DBL breakpoint at this source line." (interactive) (cond ((eq major-mode 'lisp-mode) (save-excursion (end-of-line) (let (name at where) (setq where (point)) (mark-defun) (search-forward "(def") (forward-sexp 2) (setq at (point)) (forward-sexp -1) (setq name (buffer-substring (point) at)) (beginning-of-line) ; (setq at ; (progn (re-search-forward "^[^;\"\n]+([a-zA-Z ]" (mark) t) ; (forward-char -2) ; (point))) (setq name (format "(si::break-function '%s %s t)" name (count-lines 1 where))) (other-window 1) (if (get-buffer-process (current-buffer)) (setq current-dbl-buffer (current-buffer))) (other-window 1) (message name) (send-string (get-buffer-process current-dbl-buffer) (concat name "\n"))))) (t (let ((file-name (file-name-nondirectory buffer-file-name)) (line (save-restriction (widen) (1+ (count-lines 1 (point)))))) (send-string (get-buffer-process current-dbl-buffer) (concat "break " file-name ":" line "\n")))))) (defun dbl-read-address() "Return a string containing the core-address found in the buffer at point." (save-excursion (let ((pt (dot)) found begin) (setq found (if (search-backward "0x" (- pt 7) t)(dot))) (cond (found (forward-char 2)(setq result (buffer-substring found (progn (re-search-forward "[^0-9a-f]") (forward-char -1) (dot))))) (t (setq begin (progn (re-search-backward "[^0-9]") (forward-char 1) (dot))) (forward-char 1) (re-search-forward "[^0-9]") (forward-char -1) (buffer-substring begin (dot))))))) (defvar dbl-commands nil "List of strings or functions used by send-dbl-command. It is for customization by you.") (defun send-dbl-command (arg) "This command reads the number where the cursor is positioned. It then inserts this ADDR at the end of the dbl buffer. A numeric arg selects the ARG'th member COMMAND of the list dbl-print-command. If COMMAND is a string, (format COMMAND ADDR) is inserted, otherwise (funcall COMMAND ADDR) is inserted. eg. \"p (rtx)%s->fld[0].rtint\" is a possible string to be a member of dbl-commands. " (interactive "P") (let (comm addr) (if arg (setq comm (nth arg dbl-commands))) (setq addr (dbl-read-address)) (if (eq (current-buffer) current-dbl-buffer) (set-mark (point))) (cond (comm (setq comm (if (stringp comm) (format comm addr) (funcall comm addr)))) (t (setq comm addr))) (switch-to-buffer current-dbl-buffer) (goto-char (dot-max)) (insert-string comm)))