[slime-cvs] CVS slime
mbaringer
mbaringer at common-lisp.net
Mon Feb 4 20:35:15 UTC 2008
Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv24062
Modified Files:
swank.lisp swank-openmcl.lisp slime.el slime-autoloads.el
ChangeLog
Log Message:
--- /project/slime/cvsroot/slime/swank.lisp 2008/02/04 17:35:03 1.526
+++ /project/slime/cvsroot/slime/swank.lisp 2008/02/04 20:35:11 1.527
@@ -2841,7 +2841,6 @@
(defvar *inspector-history* (make-array 10 :adjustable t :fill-pointer 0))
(declaim (type vector *inspector-history*))
(defvar *inspect-length* 30)
-(defvar *default-inspector* (make-default-inspector))
(defun reset-inspector ()
(setq *inspectee* nil
--- /project/slime/cvsroot/slime/swank-openmcl.lisp 2008/02/04 17:35:03 1.121
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp 2008/02/04 20:35:11 1.122
@@ -211,14 +211,18 @@
(defvar *break-in-sldb* t)
+
(let ((ccl::*warn-if-redefine-kernel* nil))
- (ccl::advise
- cl::break
+ (ccl::advise
+ ccl::cbreak-loop
(if (and *break-in-sldb*
- (find ccl::*current-process* (symbol-value (intern "*CONNECTIONS*" 'swank))
- :key (intern "CONNECTION.REPL-THREAD" 'swank)))
+ (find ccl::*current-process*
+ (symbol-value (intern (string :*connections*) :swank))
+ :key (intern (string :connection.repl-thread) :swank)))
(apply 'break-in-sldb ccl::arglist)
- (:do-it)) :when :around :name sldb-break))
+ (:do-it))
+ :when :around
+ :name sldb-break))
(defun break-in-sldb (&optional string &rest args)
(let ((c (make-condition 'simple-condition
@@ -335,8 +339,7 @@
for (value nil name) = (multiple-value-list (ccl::nth-value-in-frame p count context lfun pc vsp parent-vsp))
when name do (incf varcount)
until (= varcount var)
- finally (return value))
- )))))))
+ finally (return value)))))))))
(defun xref-locations (relation name &optional (inverse nil))
(flet ((function-source-location (entry)
@@ -345,8 +348,8 @@
(ccl::%db-key-from-xref-entry entry)
(if (eql (ccl::xref-entry-type entry)
'macro)
- 'function
- (ccl::xref-entry-type entry)))
+ 'function
+ (ccl::xref-entry-type entry)))
(cond ((not info)
(list :error
(format nil "No source info available for ~A"
@@ -466,7 +469,8 @@
(setq ccl::*fasl-save-definitions* nil)
(setq ccl::*fasl-save-doc-strings* t)
(setq ccl::*fasl-save-local-symbols* t)
- (setq ccl::*ppc2-compiler-register-save-label* t)
+ #+ppc (setq ccl::*ppc2-compiler-register-save-label* t)
+ #+x86-64 (setq ccl::*x862-compiler-register-save-label* t)
(setq ccl::*save-arglist-info* t)
(setq ccl::*save-definitions* nil)
(setq ccl::*save-doc-strings* t)
@@ -513,9 +517,8 @@
(defun frame-arguments (p context lfun pc)
"Returns a string representing the arguments of a frame."
- (multiple-value-bind (args types names count nclosed)
+ (multiple-value-bind (args types names)
(ccl::frame-supplied-args p lfun pc nil context)
- (declare (ignore count nclosed))
(let ((result nil))
(loop named loop
for var = (cond
@@ -575,7 +578,9 @@
(push (list
:name name
:id 0
- :value var)
+ :value (if (typep var 'ccl::value-cell)
+ (ccl::uvref var 0)
+ var))
result))))
(return-from frame-locals (nreverse result)))))))))
@@ -610,19 +615,24 @@
(when (= frame-number the-frame-number)
(setq function-to-disassemble lfun)
(return-from find-frame)))))
- (ccl::print-ppc-instructions
- *standard-output*
- (ccl::function-to-dll-header function-to-disassemble) nil)))
+ #+ppc (ccl::print-ppc-instructions
+ *standard-output*
+ (ccl::function-to-dll-header function-to-disassemble)
+ nil)
+ #+x86-64 (ccl::x8664-xdisassemble function-to-disassemble)))
;;;
-(defun canonicalize-location (file symbol)
+(defun canonicalize-location (file symbol &optional snippet)
(etypecase file
((or string pathname)
(multiple-value-bind (truename c) (ignore-errors (namestring (truename file)))
(cond (c (list :error (princ-to-string c)))
(t (make-location (list :file (remove-filename-quoting truename))
- (list :function-name (princ-to-string symbol)))))))))
+ (list :function-name (princ-to-string symbol))
+ (if snippet
+ (list :snippet snippet)
+ '()))))))))
(defun remove-filename-quoting (string)
(if (search "\\" string)
@@ -644,20 +654,20 @@
(list (list type symbol)
(canonicalize-location file symbol))))))
-
(defun function-source-location (function)
- (multiple-value-bind (info name) (ccl::edit-definition-p function)
+ (multiple-value-bind (info name)
+ (ccl::edit-definition-p function)
(cond ((not info) (list :error (format nil "No source info available for ~A" function)))
((typep (caar info) 'ccl::method)
`(:location
(:file ,(remove-filename-quoting (namestring (translate-logical-pathname (cdr (car info))) )))
(:method ,(princ-to-string (ccl::method-name (caar info)))
- ,(mapcar 'princ-to-string
- (mapcar #'specializer-name
- (ccl::method-specializers (caar info))))
- ,@(mapcar 'princ-to-string (ccl::method-qualifiers (caar info))))
+ ,(mapcar 'princ-to-string
+ (mapcar #'specializer-name
+ (ccl::method-specializers (caar info))))
+ ,@(mapcar 'princ-to-string (ccl::method-qualifiers (caar info))))
nil))
- (t (canonicalize-location (cdr (first info)) name)))))
+ (t (canonicalize-location (second (first info)) name (third (first info)))))))
(defimplementation frame-source-location-for-emacs (index)
"Return to Emacs the location of the source code for the
@@ -693,6 +703,7 @@
,form)))
)))))))
+#+ppc
(defimplementation return-from-frame (index form)
(let ((values (multiple-value-list (eval-in-frame form index))))
(map-backtrace
@@ -700,7 +711,8 @@
(declare (ignore context lfun pc))
(when (= frame-number index)
(ccl::apply-in-frame p #'values values))))))
-
+
+#+ppc
(defimplementation restart-frame (index)
(map-backtrace
(lambda (frame-number p context lfun pc)
@@ -784,11 +796,6 @@
;;;; Inspection
-(defclass openmcl-inspector (backend-inspector) ())
-
-(defimplementation make-default-inspector ()
- (make-instance 'openmcl-inspector))
-
(defimplementation describe-primitive-type (thing)
(let ((typecode (ccl::typecode thing)))
(if (gethash typecode *value2tag*)
@@ -833,7 +840,7 @@
(:method ((object t)) nil)
(:method ((object uvector-inspector)) t))
-(defmethod inspect-for-emacs ((uv uvector-inspector) )
+(defmethod inspect-for-emacs ((uv uvector-inspector))
(with-slots (object)
uv
(values (format nil "The UVECTOR for ~S." object)
@@ -854,7 +861,6 @@
(list label (if cellp (ccl::closed-over-value value) value))))))
(defmethod inspect-for-emacs ((c ccl::compiled-lexical-closure))
- (declare (ignore inspector))
(values
(format nil "A closure: ~a" c)
`(,@(if (arglist c)
--- /project/slime/cvsroot/slime/slime.el 2008/02/04 16:36:28 1.898
+++ /project/slime/cvsroot/slime/slime.el 2008/02/04 20:35:11 1.899
@@ -71,11 +71,16 @@
CONTRIBS is a list of contrib packages to load."
(when (member 'lisp-mode slime-lisp-modes)
(add-hook 'lisp-mode-hook 'slime-lisp-mode-hook))
- (dolist (c contribs)
- (require c)
- (let ((init (intern (format "%s-init" c))))
- (when (fboundp init)
- (funcall init)))))
+ (when contribs
+ (pushnew (file-name-as-directory
+ (expand-file-name (concat slime-path "contribs")))
+ load-path
+ :test 'string=)
+ (dolist (c contribs)
+ (require c)
+ (let ((init (intern (format "%s-init" c))))
+ (when (fboundp init)
+ (funcall init))))))
(defun slime-lisp-mode-hook ()
(slime-mode 1)
--- /project/slime/cvsroot/slime/slime-autoloads.el 2007/09/20 14:59:08 1.3
+++ /project/slime/cvsroot/slime/slime-autoloads.el 2008/02/04 20:35:11 1.4
@@ -39,11 +39,16 @@
(defvar slime-setup-contribs nil)
(defun slime-setup-contribs ()
- (dolist (c slime-setup-contribs)
- (require c)
- (let ((init (intern (format "%s-init" c))))
- (when (fboundp init)
- (funcall init)))))
+ (when slime-setup-contribs
+ (pushnew (file-name-as-directory
+ (expand-file-name (concat slime-path "contribs")))
+ load-path
+ :test 'string=)
+ (dolist (c slime-setup-contribs)
+ (require c)
+ (let ((init (intern (format "%s-init" c))))
+ (when (fboundp init)
+ (funcall init))))))
(provide 'slime-autoloads)
--- /project/slime/cvsroot/slime/ChangeLog 2008/02/04 17:35:04 1.1280
+++ /project/slime/cvsroot/slime/ChangeLog 2008/02/04 20:35:11 1.1281
@@ -1,5 +1,15 @@
2008-02-04 Marco Baringer <mb at bese.it>
+ * swank-openmcl.lisp (ccl::advise ccl::break): advise the
+ lower-level ccl::cbreak-loop instead of cl:break.
+ (frame-locals): If the value is a value-cell (a closed over value)
+ show the closed over value and not the value cell.
+ (disassemble-frame): add in x86-64 code.
+
+ * slime-autoloads.el (slime-setup-contribs): Add contribs
+ directory to load-path.
+
+ * slime.el (slime-setup): Add contribs directory to load-path.
* swank-abcl.lisp, swank-allegro.lisp, swank-backend.lisp,
swank-clisp.lisp, swank-cmucl.lisp, swank-corman.lisp,
More information about the slime-cvs
mailing list