[slime-cvs] CVS update: slime/swank-openmcl.lisp slime/ChangeLog
Alan Ruttenberg
aruttenberg at common-lisp.net
Thu May 13 04:47:51 UTC 2004
Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv20267/slime
Modified Files:
swank-openmcl.lisp ChangeLog
Log Message:
2004-05-12 Alan Ruttenberg <alanr-l at mumble.net>
* swank-openmcl.lisp: Fixes to support openmcl 0.14.2 changes in
backtrace protocol, from Gary Byers.
- Replace string "tcr" to "context".
- Change the call to %current-tcr in map-backtrace to get-backtrace-context,
defined so as to be back compatible with 0.14.1.
- Change the call to %catch-top to explicitly use %current-tcr
instead of the passed in tcr-which-is-now-called-context.
Users of map-backtrace (outside of slime code) note: The tcr position in the
function call is now occupied by the backtrace "context" which is always nil.
If you really need the tcr then you need to call %current-tcr yourself now.
Gary comments: The part that's a little hard to document about
the new "context" stuff - used to walk the stacks of thread A from
thread B - is that thread B has to be aware of when a context
becomes invalid (a context describing part of thread A's stack is
valid while thread A's sitting in a break loop and becomes invalid
as soon as it exits that break loop.) A thread sort of announces
when a context becomes valid and when it becomes invalid; whether
and how SWANK could hook into that isn't yet clear.
* swank-openmcl.lisp: Minor changes to backtrace display: Anonymous
functions names in function position surrounded by #<>. Use prin1 instead of
princ to print function arguments (so strings have "s around them).
prefix symbol and list arguments by "'" to make them more look like a
valid function call. Let me know if you don't like this...
Date: Thu May 13 00:47:51 2004
Author: aruttenberg
Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.74 slime/swank-openmcl.lisp:1.75
--- slime/swank-openmcl.lisp:1.74 Thu May 6 03:38:41 2004
+++ slime/swank-openmcl.lisp Thu May 13 00:47:51 2004
@@ -109,8 +109,8 @@
(previous-f nil))
(block find-frame
(map-backtrace
- #'(lambda(frame-number p tcr lfun pc)
- (declare (ignore frame-number tcr pc))
+ #'(lambda(frame-number p context lfun pc)
+ (declare (ignore frame-number context pc))
(when (eq previous-f 'ccl::%pascal-functions%)
(setq *swank-debugger-stack-frame* p)
(return-from find-frame))
@@ -139,8 +139,8 @@
(previous-f2 nil))
(block find-frame
(map-backtrace
- #'(lambda(frame-number p tcr lfun pc)
- (declare (ignore frame-number tcr pc))
+ #'(lambda(frame-number p context lfun pc)
+ (declare (ignore frame-number context pc))
(when (eq previous-f2 'break-in-sldb)
(setq *swank-debugger-stack-frame* p)
(return-from find-frame))
@@ -224,54 +224,72 @@
(ccl::*signal-printing-errors* nil)) ; don't let error while printing error take us down
(funcall debugger-loop-fn)))
+(defun backtrace-context ()
+ (if (and (= ccl::*openmcl-major-version* 0)
+ (<= ccl::*openmcl-minor-version* 14)
+ (< ccl::*openmcl-revision* 2))
+ (ccl::%current-tcr)
+ nil))
+
(defun map-backtrace (function &optional
(start-frame-number 0)
(end-frame-number most-positive-fixnum))
"Call FUNCTION passing information about each stack frame
from frames START-FRAME-NUMBER to END-FRAME-NUMBER."
- (let ((tcr (ccl::%current-tcr))
+ (let ((context (backtrace-context))
(frame-number 0)
(top-stack-frame (or *swank-debugger-stack-frame*
(ccl::%get-frame-ptr))))
- (do* ((p top-stack-frame (ccl::parent-frame p tcr))
- (q (ccl::last-frame-ptr tcr)))
- ((or (null p) (eq p q) (ccl::%stack< q p tcr))
+ (do* ((p top-stack-frame (ccl::parent-frame p context))
+ (q (ccl::last-frame-ptr context)))
+ ((or (null p) (eq p q) (ccl::%stack< q p context))
(values))
(multiple-value-bind (lfun pc) (ccl::cfp-lfun p)
(when lfun
(if (and (>= frame-number start-frame-number)
(< frame-number end-frame-number))
- (funcall function frame-number p tcr lfun pc))
+ (funcall function frame-number p context lfun pc))
(incf frame-number))))))
-(defun frame-arguments (p tcr lfun pc)
+;; May 13, 2004 alanr: use prin1 instead of princ so I see " around strings. Write ' in front of symbol names and lists.
+
+(defun frame-arguments (p context lfun pc)
"Returns a string representing the arguments of a frame."
(multiple-value-bind (count vsp parent-vsp)
- (ccl::count-values-in-frame p tcr)
+ (ccl::count-values-in-frame p nil)
(let (result)
(dotimes (i count)
(multiple-value-bind (var type name)
- (ccl::nth-value-in-frame p i tcr lfun pc vsp parent-vsp)
+ (ccl::nth-value-in-frame p i context lfun pc vsp parent-vsp)
(when name
+ (when (or (symbolp var) (listp var)) (setq var (list 'quote var)))
(cond ((equal type "required")
- (push (princ-to-string var) result))
+ (push (prin1-to-string var) result))
((equal type "optional")
- (push (princ-to-string var) result))
+ (push (prin1-to-string var) result))
((equal type "keyword")
(push (format nil "~S ~A"
(intern (symbol-name name) "KEYWORD")
- (princ-to-string var))
+ (prin1-to-string var))
result))))))
(format nil "~{ ~A~}" (nreverse result)))))
+
+
+
;; XXX should return something less stringy
+;; alanr May 13, 2004: put #<> around anonymous functions in the backtrace.
+
(defimplementation compute-backtrace (start-frame-number end-frame-number)
(let (result)
- (map-backtrace (lambda (frame-number p tcr lfun pc)
+ (map-backtrace (lambda (frame-number p context lfun pc)
+ (declare (ignore frame-number))
(push (with-output-to-string (s)
(format s "(~A~A)"
- (ccl::%lfun-name-string lfun)
- (frame-arguments p tcr lfun pc)))
+ (if (ccl::function-name lfun)
+ (ccl::%lfun-name-string lfun)
+ lfun)
+ (frame-arguments p context lfun pc)))
result))
start-frame-number end-frame-number)
(nreverse result)))
@@ -281,14 +299,14 @@
(defimplementation frame-locals (index)
(map-backtrace
- (lambda (frame-number p tcr lfun pc)
+ (lambda (frame-number p context lfun pc)
(when (= frame-number index)
(multiple-value-bind (count vsp parent-vsp)
- (ccl::count-values-in-frame p tcr)
+ (ccl::count-values-in-frame p context)
(let (result)
(dotimes (i count)
(multiple-value-bind (var type name)
- (ccl::nth-value-in-frame p i tcr lfun pc vsp parent-vsp)
+ (ccl::nth-value-in-frame p i context lfun pc vsp parent-vsp)
(declare (ignore type))
(when name
(push (list
@@ -300,19 +318,19 @@
(defimplementation frame-catch-tags (index &aux my-frame)
(map-backtrace
- (lambda (frame-number p tcr lfun pc)
+ (lambda (frame-number p context lfun pc)
(declare (ignore pc lfun))
(if (= frame-number index)
(setq my-frame p)
(when my-frame
(return-from frame-catch-tags
- (loop for catch = (ccl::%catch-top tcr) then (ccl::next-catch catch)
+ (loop for catch = (ccl::%catch-top (ccl::%current-tcr)) then (ccl::next-catch catch)
while catch
for csp = (ccl::uvref catch 3) ; ppc32::catch-frame.csp-cell) defined in arch.lisp
for tag = (ccl::uvref catch 0) ; ppc32::catch-frame.catch-tag-cell)
- until (ccl::%stack< p csp tcr)
+ until (ccl::%stack< p csp context)
do (print "-") (print catch) (terpri) (describe tag)
- when (ccl::%stack< my-frame csp tcr)
+ when (ccl::%stack< my-frame csp context)
collect (cond
((symbolp tag)
tag)
@@ -324,8 +342,8 @@
(let ((function-to-disassemble nil))
(block find-frame
(map-backtrace
- (lambda(frame-number p tcr lfun pc)
- (declare (ignore p tcr pc))
+ (lambda(frame-number p context lfun pc)
+ (declare (ignore p context pc))
(when (= frame-number the-frame-number)
(setq function-to-disassemble lfun)
(return-from find-frame)))))
@@ -360,47 +378,46 @@
find the precise position of the frame, but we do attempt to give
at least the filename containing it."
(map-backtrace
- (lambda (frame-number p tcr lfun pc)
- (declare (ignore p tcr pc))
+ (lambda (frame-number p context lfun pc)
+ (declare (ignore p context pc))
(when (and (= frame-number index) lfun)
(return-from frame-source-location-for-emacs
(function-source-location lfun))))))
(defimplementation eval-in-frame (form index)
(map-backtrace
- (lambda (frame-number p tcr lfun pc)
+ (lambda (frame-number p context lfun pc)
(when (= frame-number index)
(multiple-value-bind (count vsp parent-vsp)
- (ccl::count-values-in-frame p tcr)
+ (ccl::count-values-in-frame p context)
(let ((bindings nil))
(dotimes (i count)
(multiple-value-bind (var type name)
- (ccl::nth-value-in-frame p i tcr lfun pc vsp parent-vsp)
+ (ccl::nth-value-in-frame p i context lfun pc vsp parent-vsp)
(declare (ignore type))
(when name
(push (list name `',var) bindings))
))
(return-from eval-in-frame
(eval `(let ,bindings
- (Declare (ccl::ignore-if-unused
- ,@(mapcar 'car bindings)))
+ (declare (ignorable ,@(mapcar 'car bindings)))
,form)))
))))))
(defimplementation return-from-frame (index form)
(let ((values (multiple-value-list (eval-in-frame form index))))
(map-backtrace
- (lambda (frame-number p tcr lfun pc)
- (declare (ignore tcr lfun pc))
+ (lambda (frame-number p context lfun pc)
+ (declare (ignore context lfun pc))
(when (= frame-number index)
(ccl::apply-in-frame p #'values values))))))
(defimplementation restart-frame (index)
(map-backtrace
- (lambda (frame-number p tcr lfun pc)
+ (lambda (frame-number p context lfun pc)
(when (= frame-number index)
(ccl::apply-in-frame p lfun
- (ccl::frame-supplied-args p lfun pc nil tcr))))))
+ (ccl::frame-supplied-args p lfun pc nil context))))))
;;; Utilities
@@ -441,7 +458,7 @@
(loop for caller in (ccl::callers symbol)
append (multiple-value-bind (info name type specializers modifiers)
(ccl::edit-definition-p caller)
- (loop for (dspec . file) in info
+ (loop for (nil . file) in info
collect (list (if (eq t type)
name
`(,type ,name ,specializers
Index: slime/ChangeLog
diff -u slime/ChangeLog:1.374 slime/ChangeLog:1.375
--- slime/ChangeLog:1.374 Wed May 12 12:23:31 2004
+++ slime/ChangeLog Thu May 13 00:47:51 2004
@@ -1,3 +1,31 @@
+2004-05-12 Alan Ruttenberg <alanr-l at mumble.net>
+ * swank-openmcl.lisp: Fixes to support openmcl 0.14.2 changes in
+ backtrace protocol, from Gary Byers.
+ - Replace string "tcr" to "context".
+ - Change the call to %current-tcr in map-backtrace to get-backtrace-context,
+ defined so as to be back compatible with 0.14.1.
+ - Change the call to %catch-top to explicitly use %current-tcr
+ instead of the passed in tcr-which-is-now-called-context.
+
+ Users of map-backtrace (outside of slime code) note: The tcr position in the
+ function call is now occupied by the backtrace "context" which is always nil.
+ If you really need the tcr then you need to call %current-tcr yourself now.
+
+ Gary comments: The part that's a little hard to document about
+ the new "context" stuff - used to walk the stacks of thread A from
+ thread B - is that thread B has to be aware of when a context
+ becomes invalid (a context describing part of thread A's stack is
+ valid while thread A's sitting in a break loop and becomes invalid
+ as soon as it exits that break loop.) A thread sort of announces
+ when a context becomes valid and when it becomes invalid; whether
+ and how SWANK could hook into that isn't yet clear.
+
+ * swank-openmcl.lisp: Minor changes to backtrace display: Anonymous
+ functions names in function position surrounded by #<>. Use prin1 instead of
+ princ to print function arguments (so strings have "s around them).
+ prefix symbol and list arguments by "'" to make them more look like a
+ valid function call. Let me know if you don't like this...
+
2004-05-12 Luke Gorrie <luke at bluetail.com>
* slime.el: Fixes for outline-mode in *slime-events* from Edi
@@ -1670,7 +1698,7 @@
* slime.el, swank-backend.lisp, swank-cmucl.lisp, swank-sbcl.lisp,
swank.lisp: Profiler support.
-2004-01-23 Alan Ruttenberg <alanralanr at comcast.net>
+2004-01-23 Alan Ruttenberg <alanr-l at mumble.net>
* swank-openmcl.lisp: Bind ccl::*signal-printing-errors* to nil
inside debugger so that error while printing error take us down.
@@ -1789,7 +1817,7 @@
"Eval Region", "Scratch Buffer", "Apropos Package..."
Added some bold to default SLDB faces.
-2004-01-19 Alan Ruttenberg <alanralanr at comcast.net>
+2004-01-19 Alan Ruttenberg <alanr-l at mumble.net>
*swank-openmcl.lisp in frame-catch-tags, ppc32::catch-frame.catch-tag-cell -> 0,
ppc32::catch-frame.csp-cell -> 3. FIXME when this code is more stable in openMCL.
@@ -1859,7 +1887,7 @@
a buffer local variable. Reported by Janis Dzerins.
(slime-batch-test): Wait until the connection is ready.
-2004-01-18 Alan Ruttenberg <alanralanr at comcast.net>
+2004-01-18 Alan Ruttenberg <alanr-l at mumble.net>
* swank-openmcl: Implement frame-catch-tags. Added debugger functions
sldb-restart-frame, sldb-return-from-frame. Should probably be added to backend.lisp
@@ -2395,11 +2423,11 @@
(slime-open-inspector): Minor indentation fixes.
(slime-net-output-funcall): Removed. Was unused.
-2003-12-19 Alan Ruttenberg <alanralanr at comcast.net>
+2003-12-19 Alan Ruttenberg <alanr-l at mumble.net>
* slime.el 1.157
fix bug in sldb-princ-locals I introduced when adding fonts to sldb
-2003-12-19 Alan Ruttenberg <alanralanr at comcast.net>
+2003-12-19 Alan Ruttenberg <alanr-l at mumble.net>
* swank-openmcl.lisp 1.42
in request-loop register output stream to be periodically slushed per Gary Byer's email.
* slime.el 1.156
@@ -2411,12 +2439,12 @@
* null-swank-impl.lisp: Deleted this old file. See
swank-backend.lisp instead.
-2003-12-18 Alan Ruttenberg <alanralanr at comcast.net>
+2003-12-18 Alan Ruttenberg <alanr-l at mumble.net>
* swank-openmcl.lisp 1.41
in openmcl (break) now goes into slime debugger.
(setq swank:*break-in-sldb* nil) to disable that.
-2003-12-17 Alan Ruttenberg <alanralanr at comcast.net>
+2003-12-17 Alan Ruttenberg <alanr-l at mumble.net>
* slime.el 1.155
Allow font choices for backtrack. Add group for customizing them: sldb.
Whole thing is enabled with sldb-enable-styled-backtrace which is off by default, for now.
@@ -2431,7 +2459,7 @@
'(sldb-selected-frame-line-face ((t (:foreground "brown" :weight bold :height 1.2))))
'(sldb-topline-face ((t (:foreground "brown" :weight bold :height 1.2))))
-2003-12-17 Alan Ruttenberg <alanralanr at comcast.net>
+2003-12-17 Alan Ruttenberg <alanr-l at mumble.net>
* slime.el 1.154
Allow some face choices in the inspector. Try
'(slime-inspector-label-face ((t (:weight bold))))
@@ -2439,7 +2467,7 @@
'(slime-inspector-type-face ((t (:foreground "DarkRed" :weight bold))))
You can also set slime-inspector-value-face
-2003-12-17 Alan Ruttenberg <alanralanr at comcast.net>
+2003-12-17 Alan Ruttenberg <alanr-l at mumble.net>
* swank-openmcl.lisp 1.40
Fix an error with frame-source-location-for-emacs when the
@@ -2555,7 +2583,7 @@
(slime-popup-thread-control-panel): When true, automatically
popup the thread-control buffer when a new thread suspends.
-2003-12-14 Alan Ruttenberg <alanralanr at comcast.net>
+2003-12-14 Alan Ruttenberg <alanr-l at mumble.net>
* swank-openmcl.lisp (eval-in-frame, inspect-object and friends):
Most of this is copied from swank-cmucl. The parts between &&&&&
More information about the slime-cvs
mailing list