[slime-cvs] CVS slime
CVS User heller
heller at common-lisp.net
Fri Oct 17 21:26:54 UTC 2008
Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv30786
Modified Files:
ChangeLog slime.el swank-abcl.lisp swank-allegro.lisp
swank-backend.lisp swank-clisp.lisp swank-cmucl.lisp
swank-corman.lisp swank-ecl.lisp swank-lispworks.lisp
swank-openmcl.lisp swank-sbcl.lisp swank-scl.lisp swank.lisp
Log Message:
* swank-backend.lisp (frame-restartable-p): New function.
(swank-frame): Deleted. Update implemenetations accordingly.
(print-frame): Renamed back from print-swank-frame.
* swank.lisp (backtrace): Don't clutter the backtrace with
'(:restartable :unknown). For practical purposes :unknown is the
same as nil.
* slime.el (sldb-compute-frame-face): Only accept nil or t for
the :restartable prop.
--- /project/slime/cvsroot/slime/ChangeLog 2008/10/16 21:16:01 1.1559
+++ /project/slime/cvsroot/slime/ChangeLog 2008/10/17 21:26:53 1.1560
@@ -1,3 +1,16 @@
+2008-10-17 Helmut Eller <heller at common-lisp.net>
+
+ * swank-backend.lisp (frame-restartable-p): New function.
+ (swank-frame): Deleted. Update implemenetations accordingly.
+ (print-frame): Renamed back from print-swank-frame.
+
+ * swank.lisp (backends): Don't clutter the backtrace with
+ '(:restartable :unknown). For practical purposes :unknown is the
+ same as nil.
+
+ * slime.el (sldb-compute-frame-face): Only accept nil or t for
+ the :restartable prop.
+
2008-10-16 Helmut Eller <heller at common-lisp.net>
* swank-backend.lisp (swank-compile-file): Return the same
--- /project/slime/cvsroot/slime/slime.el 2008/10/16 21:15:28 1.1048
+++ /project/slime/cvsroot/slime/slime.el 2008/10/17 21:26:53 1.1049
@@ -6876,7 +6876,8 @@
(when more
(slime-insert-propertized
`(, at nil sldb-default-action sldb-fetch-more-frames
- sldb-previous-frame-number ,(sldb-frame.number (first (last frames)))
+ sldb-previous-frame-number
+ ,(sldb-frame.number (first (last frames)))
point-entered sldb-fetch-more-frames
start-open t
face sldb-section-face
@@ -6885,14 +6886,9 @@
(insert "\n")))
(defun sldb-compute-frame-face (frame)
- (let ((restartable (getf (sldb-frame.plist frame) :restartable)))
- (cond ((eq restartable 't)
- 'sldb-restartable-frame-line-face)
- ((eq restartable :unknown)
- 'sldb-frame-line-face)
- ((eq restartable 'nil)
- 'sldb-non-restartable-frame-line-face)
- (t (error "fall through")))))
+ (ecase (plist-get (sldb-frame.plist frame) :restartable)
+ ((nil) 'sldb-frame-line-face)
+ ((t) 'sldb-restartable-frame-line-face)))
(defun sldb-insert-frame (frame &optional face)
"Insert FRAME with FACE at point.
--- /project/slime/cvsroot/slime/swank-abcl.lisp 2008/10/16 21:16:01 1.57
+++ /project/slime/cvsroot/slime/swank-abcl.lisp 2008/10/17 21:26:53 1.58
@@ -253,11 +253,11 @@
(defimplementation compute-backtrace (start end)
(let ((end (or end most-positive-fixnum)))
(loop for f in (subseq (backtrace-as-list-ignoring-swank-calls) start end)
- collect (make-swank-frame :%frame f :restartable :unknown))))
+ collect f)))
-(defimplementation print-swank-frame (frame stream)
+(defimplementation print-frame (frame stream)
(write-string (string-trim '(#\space #\newline)
- (prin1-to-string (swank-frame.%frame frame)))
+ (prin1-to-string frame))
stream))
(defimplementation frame-locals (index)
--- /project/slime/cvsroot/slime/swank-allegro.lisp 2008/10/16 21:16:01 1.116
+++ /project/slime/cvsroot/slime/swank-allegro.lisp 2008/10/17 21:26:53 1.117
@@ -163,10 +163,10 @@
(let ((end (or end most-positive-fixnum)))
(loop for f = (nth-frame start) then (next-frame f)
for i from start below end
- while f collect (make-swank-frame :%frame f :restartable :unknown))))
+ while f collect f)))
-(defimplementation print-swank-frame (frame stream)
- (debugger:output-frame stream (swank-frame.%frame frame) :moderate))
+(defimplementation print-frame (frame stream)
+ (debugger:output-frame stream frame :moderate))
(defimplementation frame-locals (index)
(let ((frame (nth-frame index)))
@@ -210,6 +210,9 @@
form
(debugger:environment-of-frame frame)))))
+(defimplementation frame-restartable-p (frame)
+ (debugger:frame-retryable-p frame))
+
(defimplementation restart-frame (frame-number)
(let ((frame (nth-frame frame-number)))
(cond ((debugger:frame-retryable-p frame)
--- /project/slime/cvsroot/slime/swank-backend.lisp 2008/10/16 21:15:28 1.156
+++ /project/slime/cvsroot/slime/swank-backend.lisp 2008/10/17 21:26:53 1.157
@@ -20,9 +20,6 @@
#:condition
#:severity
#:with-compilation-hooks
- #:swank-frame
- #:swank-frame-p
- #:swank-frame.restartable
#:location
#:location-p
#:location-buffer
@@ -656,13 +653,9 @@
;;; The following functions in this section are supposed to be called
;;; within the dynamic contour of CALL-WITH-DEBUGGING-ENVIRONMENT only.
-(defstruct (swank-frame (:conc-name swank-frame.))
- %frame
- restartable)
-
(definterface compute-backtrace (start end)
"Returns a backtrace of the condition currently being debugged,
-that is an ordered list consisting of swank-frames. ``Ordered list''
+that is an ordered list consisting of frames. ``Ordered list''
means that an integer I can be mapped back to the i-th frame of this
backtrace.
@@ -671,9 +664,14 @@
debugger. If END is nil, return the frames from START to the end of
the stack.")
-(definterface print-swank-frame (frame stream)
+(definterface print-frame (frame stream)
"Print frame to stream.")
+(definterface frame-restartable-p (frame)
+ "Is the frame FRAME restartable?.
+Return T if `restart-frame' can safely be called on the frame."
+ nil)
+
(definterface frame-source-location-for-emacs (frame-number)
"Return the source location for the frame associated to FRAME-NUMBER.")
--- /project/slime/cvsroot/slime/swank-clisp.lisp 2008/10/16 21:16:01 1.80
+++ /project/slime/cvsroot/slime/swank-clisp.lisp 2008/10/17 21:26:53 1.81
@@ -349,7 +349,7 @@
(let* ((bt *sldb-backtrace*)
(len (length bt)))
(loop for f in (subseq bt start (min (or end len) len))
- collect (make-swank-frame :%frame f :restartable :unknown))))
+ collect f)))
;;; CLISP's REPL sets up an ABORT restart that kills SWANK. Here we
;;; can omit that restart so that users don't select it by mistake.
@@ -358,9 +358,8 @@
;; list, hopefully that's our unwanted ABORT restart.
(butlast (compute-restarts condition)))
-(defimplementation print-swank-frame (swank-frame stream)
- (let* ((frame (swank-frame.%frame swank-frame))
- (str (frame-to-string frame)))
+(defimplementation print-frame (frame stream)
+ (let* ((str (frame-to-string frame)))
(write-string (extract-frame-line str)
stream)))
--- /project/slime/cvsroot/slime/swank-cmucl.lisp 2008/10/16 21:15:28 1.201
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp 2008/10/17 21:26:53 1.202
@@ -1502,11 +1502,10 @@
(let ((end (or end most-positive-fixnum)))
(loop for f = (nth-frame start) then (frame-down f)
for i from start below end
- while f collect (make-swank-frame :%frame f :restartable :unknown))))
+ while f collect f)))
-(defimplementation print-swank-frame (swank-frame stream)
- (let ((frame (swank-frame.%frame swank-frame))
- (*standard-output* stream))
+(defimplementation print-frame (frame stream)
+ (let ((*standard-output* stream))
(handler-case
(debug::print-frame-call frame :verbosity 1 :number nil)
(error (e)
--- /project/slime/cvsroot/slime/swank-corman.lisp 2008/09/17 06:19:48 1.18
+++ /project/slime/cvsroot/slime/swank-corman.lisp 2008/10/17 21:26:53 1.19
@@ -177,10 +177,10 @@
(defimplementation compute-backtrace (start end)
(loop for f in (subseq *stack-trace* start (min end (length *stack-trace*)))
- collect (make-swank-frame :%frame f :restartable :unknown)))
+ collect f))
-(defimplementation print-swank-frame (frame stream)
- (format stream "~S" (swank-frame.%frame frame)))
+(defimplementation print-frame (frame stream)
+ (format stream "~S" frame))
(defun get-frame-debug-info (frame)
(or (frame-debug-info frame)
@@ -370,9 +370,10 @@
(declare (ignore external-format))
(with-compilation-hooks ()
(let ((*buffer-name* nil))
- (compile-file *compile-filename*)
- (when load-p
- (load (compile-file-pathname *compile-filename*))))))
+ (multiple-value-bind (output-file warnings? failure?)
+ (compile-file *compile-filename*)
+ (values output-file warnings?
+ (or failure? (and load-p (load output-file))))))))
(defimplementation swank-compile-string (string &key buffer position directory
debug)
@@ -382,7 +383,8 @@
(*buffer-position* position)
(*buffer-string* string))
(funcall (compile nil (read-from-string
- (format nil "(~S () ~A)" 'lambda string)))))))
+ (format nil "(~S () ~A)" 'lambda string))))
+ t)))
;;;; Inspecting
--- /project/slime/cvsroot/slime/swank-ecl.lisp 2008/10/16 21:16:01 1.34
+++ /project/slime/cvsroot/slime/swank-ecl.lisp 2008/10/17 21:26:53 1.35
@@ -316,7 +316,7 @@
(when (numberp end)
(setf end (min end (length *backtrace*))))
(loop for f in (subseq *backtrace* start end)
- collect (make-swank-frame :%frame f :restartable :unknown)))
+ collect f))
(defun frame-name (frame)
(let ((x (first frame)))
@@ -356,9 +356,8 @@
))))
(values functions blocks variables)))
-(defimplementation print-swank-frame (swank-frame stream)
- (let ((frame (swank-frame.%frame swank-frame)))
- (format stream "~A" (first frame))))
+(defimplementation print-frame (frame stream)
+ (format stream "~A" (first frame)))
(defimplementation frame-source-location-for-emacs (frame-number)
(nth-value 1 (frame-function (elt *backtrace* frame-number))))
--- /project/slime/cvsroot/slime/swank-lispworks.lisp 2008/10/16 21:15:48 1.120
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp 2008/10/17 21:26:53 1.121
@@ -318,8 +318,7 @@
((or (not frame) (= i end)) (nreverse backtrace))
(when (interesting-frame-p frame)
(incf i)
- (push (make-swank-frame :%frame frame :restartable :unknown)
- backtrace)))))
+ (push frame backtrace)))))
(defun frame-actual-args (frame)
(let ((*break-on-signals* nil))
@@ -331,13 +330,12 @@
(error (e) (format nil "<~A>" arg))))))
(dbg::call-frame-arglist frame))))
-(defimplementation print-swank-frame (swank-frame stream)
- (let ((frame (swank-frame.%frame swank-frame)))
- (cond ((dbg::call-frame-p frame)
- (format stream "~S ~S"
- (dbg::call-frame-function-name frame)
- (frame-actual-args frame)))
- (t (princ frame stream)))))
+(defimplementation print-frame (frame stream)
+ (cond ((dbg::call-frame-p frame)
+ (format stream "~S ~S"
+ (dbg::call-frame-function-name frame)
+ (frame-actual-args frame)))
+ (t (princ frame stream))))
(defun frame-vars (frame)
(first (dbg::frame-locals-format-list frame #'list 75 0)))
--- /project/slime/cvsroot/slime/swank-openmcl.lisp 2008/10/16 21:15:13 1.141
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp 2008/10/17 21:26:53 1.142
@@ -492,19 +492,17 @@
(let (result)
(map-backtrace (lambda (frame-number p context lfun pc)
(declare (ignore frame-number))
- (push (make-swank-frame :%frame (list :openmcl-frame p context lfun pc)
- :restartable :unknown)
+ (push (list :frame p context lfun pc)
result))
start-frame-number end-frame-number)
(nreverse result)))
-(defimplementation print-swank-frame (swank-frame stream)
- (let ((frame (swank-frame.%frame swank-frame)))
- (assert (eq (first frame) :openmcl-frame))
- (destructuring-bind (p context lfun pc) (rest frame)
- (format stream "(~S~{ ~S~})"
- (or (ccl::function-name lfun) lfun)
- (frame-arguments p context lfun pc)))))
+(defimplementation print-frame (frame stream)
+ (assert (eq (first frame) :frame))
+ (destructuring-bind (p context lfun pc) (rest frame)
+ (format stream "(~S~{ ~S~})"
+ (or (ccl::function-name lfun) lfun)
+ (frame-arguments p context lfun pc)))))
(defimplementation frame-locals (index)
(block frame-locals
@@ -963,7 +961,7 @@
(nconc (ldiff q tail) (cdr tail)))
(return (car tail)))))
(when (eq timeout t) (return (values nil t)))
- (ccl:timed-wait-on-semaphore (mailbox.semaphore mbox) 0.2))))
+ (ccl:timed-wait-on-semaphore (mailbox.semaphore mbox) 1))))
(defimplementation quit-lisp ()
(ccl::quit))
--- /project/slime/cvsroot/slime/swank-sbcl.lisp 2008/10/16 21:15:28 1.224
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2008/10/17 21:26:53 1.225
@@ -882,16 +882,14 @@
(let ((end (or end most-positive-fixnum)))
(loop for f = (nth-frame start) then (sb-di:frame-down f)
for i from start below end
- while f collect (make-swank-frame
- :%frame f
- :restartable (frame-restartable-p f)))))
+ while f collect f)))
-(defimplementation print-swank-frame (swank-frame stream)
- (sb-debug::print-frame-call (swank-frame.%frame swank-frame) stream))
+(defimplementation print-frame (frame stream)
+ (sb-debug::print-frame-call frame stream))
-(defun frame-restartable-p (frame)
+(defimplementation frame-restartable-p (frame)
#+#.(swank-backend::sbcl-with-restart-frame)
- (sb-debug:frame-has-debug-tag-p frame))
+ (not (null (sb-debug:frame-has-debug-tag-p frame))))
;;;; Code-location -> source-location translation
--- /project/slime/cvsroot/slime/swank-scl.lisp 2008/10/16 21:15:28 1.28
+++ /project/slime/cvsroot/slime/swank-scl.lisp 2008/10/17 21:26:53 1.29
@@ -1354,11 +1354,10 @@
(let ((end (or end most-positive-fixnum)))
(loop for f = (nth-frame start) then (frame-down f)
for i from start below end
- while f collect (make-swank-frame :%frame f :restartable :unknown))))
+ while f collect f)))
-(defimplementation print-swank-frame (swank-frame stream)
- (let ((frame (swank-frame.%frame swank-frame))
- (*standard-output* stream))
+(defimplementation print-frame (frame stream)
+ (let ((*standard-output* stream))
(handler-case
(debug::print-frame-call frame :verbosity 1 :number nil)
(error (e)
--- /project/slime/cvsroot/slime/swank.lisp 2008/10/16 21:15:48 1.603
+++ /project/slime/cvsroot/slime/swank.lisp 2008/10/17 21:26:53 1.604
@@ -2294,21 +2294,21 @@
I is an integer, and can be used to reference the corresponding frame
from Emacs; FRAME is a string representation of an implementation's
frame."
- (flet ((print-swank-frame-to-string (frame)
- (call/truncated-output-to-string
- 100
- (lambda (stream)
- (handler-case
- (with-bindings *backtrace-printer-bindings*
- (print-swank-frame frame stream))
- (t ()
- (format stream "[error printing frame]")))))))
- (loop for frame in (compute-backtrace start end)
- for i from start collect
- (list i (print-swank-frame-to-string frame)
- (list :restartable (let ((r (swank-frame.restartable frame)))
- (check-type r (member nil t :unknown))
- r))))))
+ (loop for frame in (compute-backtrace start end)
+ for i from start collect
+ (list* i (frame-to-string frame)
+ (ecase (frame-restartable-p frame)
+ ((nil) nil)
+ ((t) `((:restartable t)))))))
+
+(defun frame-to-string (frame)
+ (with-bindings *backtrace-printer-bindings*
+ (call/truncated-output-to-string
+ (* (or *print-lines* 1) (or *print-right-margin* 100))
+ (lambda (stream)
+ (handler-case (print-frame frame stream)
+ (serious-condition ()
+ (format stream "[error printing frame]")))))))
(defslimefun debugger-info-for-emacs (start end)
"Return debugger state, with stack frames from START to END.
More information about the slime-cvs
mailing list