[slime-cvs] CVS slime
CVS User trittweiler
trittweiler at common-lisp.net
Thu Mar 18 12:29:08 UTC 2010
Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv23754
Modified Files:
ChangeLog slime.el swank-backend.lisp swank-ecl.lisp
swank.lisp
Log Message:
Add an ATTACH-GDB restart to SLDB.
* swank.lisp (call-with-gdb-restart): New. Sends the new :gdb-attach event to Emacs.
(with-gdb-restart): Sugar.
(with-top-level-restart): Also expand to with-gdb-restart.
(dispatch-event): Add :gdb-attach event.
* swank-backend.lisp (gdb-initial-commands): New interface
function so backends can customize how gdb needs to be configured
for their implementation.
* swank-ecl.lisp (gdb-initial-commands): Implement.
* slime.el (slime-dispatch-event): Add clause for :gdb-attach.
(slime-attach-gdb): New.
--- /project/slime/cvsroot/slime/ChangeLog 2010/03/18 11:52:34 1.2037
+++ /project/slime/cvsroot/slime/ChangeLog 2010/03/18 12:29:07 1.2038
@@ -1,7 +1,25 @@
2010-03-18 Tobias C. Rittweiler <tcr at freebits.de>
- * swank.lisp (connection): Add socket slot, make slot-io slot not
- be required to be filled in during object creation. Add
+ Add an ATTACH-GDB restart to SLDB.
+
+ * swank.lisp (call-with-gdb-restart): New. Sends the new :gdb-attach event to Emacs.
+ (with-gdb-restart): Sugar.
+ (with-top-level-restart): Also expand to with-gdb-restart.
+ (dispatch-event): Add :gdb-attach event.
+
+ * swank-backend.lisp (gdb-initial-commands): New interface
+ function so backends can customize how gdb needs to be configured
+ for their implementation.
+
+ * swank-ecl.lisp (gdb-initial-commands): Implement.
+
+ * slime.el (slime-dispatch-event): Add clause for :gdb-attach.
+ (slime-attach-gdb): New.
+
+2010-03-18 Tobias C. Rittweiler <tcr at freebits.de>
+
+ * swank.lisp (connection): Add socket slot, make socket-io slot
+ not be required to be filled in during object creation. Add
inferior-lisp slot so we can know whether a connection belongs to
a superior Emacs process. Need for that will come in following
commit.
--- /project/slime/cvsroot/slime/slime.el 2010/03/09 14:10:37 1.1285
+++ /project/slime/cvsroot/slime/slime.el 2010/03/18 12:29:07 1.1286
@@ -2277,6 +2277,9 @@
((:debug-condition thread message)
(assert thread)
(message "%s" message))
+ ((:gdb-attach pid gdb-cmds)
+ (message "Attaching gdb to pid %d..." pid)
+ (slime-attach-gdb pid gdb-cmds))
((:ping thread tag)
(slime-send `(:emacs-pong ,thread ,tag)))
((:reader-error packet condition)
@@ -2290,6 +2293,19 @@
(remove* id (slime-rex-continuations) :key #'car))
(error "Invalid rpc: %s" message))))))
+(defun slime-attach-gdb (pid commands)
+ (gud-gdb (format "gdb -p %d" pid))
+ (with-current-buffer gud-comint-buffer
+ (dolist (cmd commands)
+ ;; First wait until gdb was initialized, then wait until current
+ ;; command was processed.
+ (while (not (looking-back comint-prompt-regexp))
+ (sit-for 0.01))
+ ;; We do not use `gud-call' because we want the initial commands
+ ;; to be displayed by the user so he knows what he's got.
+ (insert cmd)
+ (comint-send-input))))
+
(defun slime-send (sexp)
"Send SEXP directly over the wire on the current connection."
(slime-net-send sexp (slime-connection)))
--- /project/slime/cvsroot/slime/swank-backend.lisp 2010/03/02 12:38:06 1.196
+++ /project/slime/cvsroot/slime/swank-backend.lisp 2010/03/18 12:29:07 1.197
@@ -789,6 +789,11 @@
(declare (ignore condition))
'())
+(definterface gdb-initial-commands ()
+ "List of gdb commands supposed to be executed first for the
+ ATTACH-GDB restart."
+ nil)
+
(definterface activate-stepping (frame-number)
"Prepare the frame FRAME-NUMBER for stepping.")
--- /project/slime/cvsroot/slime/swank-ecl.lisp 2010/03/16 16:20:08 1.64
+++ /project/slime/cvsroot/slime/swank-ecl.lisp 2010/03/18 12:29:07 1.65
@@ -481,6 +481,11 @@
(let ((env (second (elt *backtrace* frame-number))))
(si:eval-with-env form env)))
+(defimplementation gdb-initial-commands ()
+ ;; These signals are used by the GC.
+ #+linux '("handle SIGPWR noprint nostop"
+ "handle SIGXCPU noprint nostop"))
+
;;;; Inspector
--- /project/slime/cvsroot/slime/swank.lisp 2010/03/18 11:52:34 1.700
+++ /project/slime/cvsroot/slime/swank.lisp 2010/03/18 12:29:07 1.701
@@ -471,6 +471,30 @@
(check-type msg string)
`(call-with-retry-restart ,msg #'(lambda () , at body)))
+(defun call-with-gdb-restart (pid thunk)
+ (let ((process (format nil "~A-~A (pid ~D)"
+ (lisp-implementation-type)
+ (lisp-implementation-version)
+ pid)))
+ (restart-bind
+ ((attach-gdb
+ #'(lambda ()
+ (send-to-emacs `(:gdb-attach ,pid ,(gdb-initial-commands)))
+ (format nil "GDB attached to ~A" process))
+ :report-function #'(lambda (s)
+ (format s "Attach GDB to ~A" process))
+ :test-function #'(lambda (c)
+ (declare (ignore c))
+ ;; Do not show this restart if
+ ;; we're connected remotely.
+ (connection.inferior-lisp
+ *emacs-connection*)
+ t)))
+ (funcall thunk))))
+
+(defmacro with-gdb-restart (() &body body)
+ `(call-with-gdb-restart (getpid) #'(lambda () , at body)))
+
(defmacro with-struct* ((conc-name get obj) &body body)
(let ((var (gensym)))
`(let ((,var ,obj))
@@ -896,19 +920,20 @@
;; Execute K if the restart is invoked.
(defmacro with-top-level-restart ((connection k) &body body)
`(with-connection (,connection)
- (restart-case
- ;; We explicitly rebind (and do not look at user's
- ;; customization), so sldb-quit will always be our restart
- ;; for rex requests.
- (let ((*sldb-quit-restart* (find-restart 'abort))
- (*toplevel-restart-available* t))
- (declare (special *toplevel-restart-available*))
- , at body)
- (abort (&optional v)
- :report "Return to SLIME's top level."
- (declare (ignore v))
- (force-user-output)
- ,k))))
+ (with-gdb-restart ()
+ (restart-case
+ ;; We explicitly rebind (and do not look at user's
+ ;; customization), so sldb-quit will always be our restart
+ ;; for rex requests.
+ (let ((*sldb-quit-restart* (find-restart 'abort))
+ (*toplevel-restart-available* t))
+ (declare (special *toplevel-restart-available*))
+ , at body)
+ (abort (&optional v)
+ :report "Return to SLIME's top level."
+ (declare (ignore v))
+ (force-user-output)
+ ,k)))))
(defun top-level-restart-p ()
;; FIXME: this could probably be done better; previously this used
@@ -1094,6 +1119,7 @@
(interrupt-worker-thread thread-id))
(((:write-string
:debug :debug-condition :debug-activate :debug-return :channel-send
+ :gdb-attach
:presentation-start :presentation-end
:new-package :new-features :ed :indentation-update
:eval :eval-no-wait :background-message :inspect :ping
More information about the slime-cvs
mailing list