[slime-cvs] CVS update: slime/swank-allegro.lisp slime/swank-backend.lisp slime/swank-cmucl.lisp slime/swank-gray.lisp slime/swank-lispworks.lisp slime/swank-loader.lisp slime/swank-openmcl.lisp
Helmut Eller
heller at common-lisp.net
Tue Mar 9 19:35:37 UTC 2004
Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv30208
Modified Files:
swank-allegro.lisp swank-backend.lisp swank-cmucl.lisp
swank-gray.lisp swank-lispworks.lisp swank-loader.lisp
swank-openmcl.lisp
Log Message:
Minor modifications.
Date: Tue Mar 9 14:35:36 2004
Author: heller
Index: slime/swank-allegro.lisp
diff -u slime/swank-allegro.lisp:1.20 slime/swank-allegro.lisp:1.21
--- slime/swank-allegro.lisp:1.20 Tue Mar 9 07:46:27 2004
+++ slime/swank-allegro.lisp Tue Mar 9 14:35:36 2004
@@ -9,12 +9,17 @@
;;; Edition "5.0 [Linux/X86] (8/29/98 10:57)".
;;;
+(in-package :swank-backend)
+
(eval-when (:compile-toplevel :load-toplevel :execute)
(require :sock)
(require :process))
+<<<<<<< swank-allegro.lisp
+=======
(in-package :swank-backend)
+>>>>>>> 1.20
(import
'(excl:fundamental-character-output-stream
excl:stream-write-char
@@ -30,8 +35,13 @@
;;;; TCP Server
+<<<<<<< swank-allegro.lisp
+(defimplementation preferred-communication-style ()
+ :spawn)
+=======
(defimplementation preferred-communication-style ()
:spawn)
+>>>>>>> 1.20
(defimplementation create-socket (host port)
(socket:make-socket :connect :passive :local-port port
@@ -61,8 +71,16 @@
;;;; Misc
+<<<<<<< swank-allegro.lisp
+(defimplementation arglist (symbol)
+ (excl:arglist symbol))
+
+(defimplementation macroexpand-all (form)
+ (excl::walk form))
+=======
(defimplementation arglist (symbol)
(excl:arglist symbol))
+>>>>>>> 1.20
(defimplementation describe-symbol-for-emacs (symbol)
(let ((result '()))
@@ -82,6 +100,16 @@
(doc 'class)))
result)))
+<<<<<<< swank-allegro.lisp
+(defimplementation describe-definition (symbol namespace)
+ (ecase namespace
+ (:variable
+ (describe symbol))
+ ((:function :generic-function)
+ (describe (symbol-function symbol)))
+ (:class
+ (describe (find-class symbol)))))
+=======
(defimplementation macroexpand-all (form)
(excl::walk form))
@@ -93,6 +121,7 @@
(describe (symbol-function symbol)))
(:class
(describe (find-class symbol)))))
+>>>>>>> 1.20
;;;; Debugger
@@ -103,11 +132,6 @@
(excl::*break-hook* nil))
(funcall debugger-loop-fn)))
-(defun format-restarts-for-emacs ()
- (loop for restart in *sldb-restarts*
- collect (list (princ-to-string (restart-name restart))
- (princ-to-string restart))))
-
(defun nth-frame (index)
(do ((frame *sldb-topframe* (excl::int-next-older-frame frame))
(i index (1- i)))
@@ -134,6 +158,9 @@
(declare (ignore index))
nil)
+(defimplementation disassemble-frame (index)
+ (disassemble (debugger:frame-function (nth-frame index))))
+
(defimplementation frame-source-location-for-emacs (index)
(list :error (format nil "Cannot find source for frame: ~A"
(nth-frame index))))
@@ -150,7 +177,7 @@
form
(debugger:environment-of-frame frame)))))
-;;; XXX doens't work for frames with arguments
+;;; XXX doesn't work for frames with arguments
(defimplementation restart-frame (frame-number)
(let ((frame (nth-frame frame-number)))
(debugger:frame-retry frame (debugger:frame-function frame))))
@@ -198,6 +225,23 @@
;;;; Definition Finding
+<<<<<<< swank-allegro.lisp
+(defun find-fspec-location (fspec type)
+ (let ((file (excl::fspec-pathname fspec type)))
+ (etypecase file
+ (pathname
+ (let ((start (scm:find-definition-in-file fspec type file)))
+ (make-location (list :file (namestring (truename file)))
+ (if start
+ (list :position (1+ start))
+ (list :function-name (string fspec))))))
+ ((member :top-level)
+ (list :error (format nil "Defined at toplevel: ~A" fspec)))
+ (null
+ (list :error (format nil "Unkown source location for ~A" fspec))))))
+
+(defun fspec-definition-locations (fspec)
+=======
(defun find-fspec-location (fspec type)
(let ((file (excl::fspec-pathname fspec type)))
(etypecase file
@@ -213,15 +257,40 @@
(list :error (format nil "Unkown source location for ~A" fspec))))))
(defun fspec-source-locations (fspec)
+>>>>>>> 1.20
(let ((defs (excl::find-multiple-definitions fspec)))
+<<<<<<< swank-allegro.lisp
+ (loop for (fspec type) in defs
+ collect (list fspec (find-fspec-location fspec type)))))
+
+(defimplementation find-definitions (symbol)
+ (fspec-definition-locations symbol))
+=======
(loop for (fspec type) in defs
collect (list fspec (find-fspec-location fspec type)))))
(defimplementation find-definitions (symbol)
(fspec-source-locations symbol))
+>>>>>>> 1.20
;;;; XREF
+<<<<<<< swank-allegro.lisp
+(defmacro defxref (name relation name1 name2)
+ `(defimplementation ,name (x)
+ (xref-result (xref:get-relation ,relation ,name1 ,name2))))
+
+(defxref who-calls :calls :wild x)
+(defxref who-references :uses :wild x)
+(defxref who-binds :binds :wild x)
+(defxref who-macroexpands :macro-calls :wild x)
+(defxref who-sets :sets :wild x)
+(defxref list-callees :calls x :wild)
+
+(defun xref-result (fspecs)
+ (loop for fspec in fspecs
+ append (fspec-definition-locations fspec)))
+=======
(defun xrefs (fspecs)
(loop for fspec in fspecs
nconc (loop for (ref location) in (fspec-source-locations fspec)
@@ -244,6 +313,7 @@
(defimplementation list-callees (name)
(xrefs (xref:get-relation :calls name :wild)))
+>>>>>>> 1.20
;;;; Inspecting
Index: slime/swank-backend.lisp
diff -u slime/swank-backend.lisp:1.36 slime/swank-backend.lisp:1.37
--- slime/swank-backend.lisp:1.36 Tue Mar 9 07:46:27 2004
+++ slime/swank-backend.lisp Tue Mar 9 14:35:36 2004
@@ -307,7 +307,12 @@
for a debugger stack frame. The results are undefined unless
this is called within the dynamic contour of a function defined
by DEFINE-DEBUGGER-HOOK.")
-
+
+(definterface disassemble-frame (frame-number)
+ "Disassemble the code for the FRAME-NUMBER.
+The output should be written to standard output.
+FRAME-NUMBER is a non-negative interger.")
+
(definterface eval-in-frame (form frame-number)
"Evaluate a Lisp form in the lexical context of a stack frame
in the debugger. The results are undefined unless called in the
Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.80 slime/swank-cmucl.lisp:1.81
--- slime/swank-cmucl.lisp:1.80 Tue Mar 9 07:46:27 2004
+++ slime/swank-cmucl.lisp Tue Mar 9 14:35:36 2004
@@ -372,6 +372,16 @@
;;;; XREF
+<<<<<<< swank-cmucl.lisp
+(defmacro defxref (name function)
+ `(defimplementation ,name (name)
+ (xref-results (,function ,name))))
+
+(defxref who-calls xref:who-calls)
+(defxref who-references xref:who-references)
+(defxref who-binds xref:who-binds)
+(defxref who-sets xref:who-sets)
+=======
(defimplementation who-calls (symbol)
(xrefs (xref:who-calls symbol)))
@@ -383,15 +393,32 @@
(defimplementation who-sets (symbol)
(xrefs (xref:who-sets symbol)))
+>>>>>>> 1.80
#+cmu19
(progn
+<<<<<<< swank-cmucl.lisp
+ (defxref who-macroexpands xref:who-macroexpands)
+ ;; XXX
+ (defimplementation who-specializes (symbol)
+ (let* ((methods (xref::who-specializes (find-class symbol)))
+=======
(defimplementation who-macroexpands (macro)
(xrefs (xref:who-macroexpands macro)))
;; XXX
(defimplementation who-specializes (symbol)
(let* ((methods (xref::who-specializes (find-class symbol)))
+>>>>>>> 1.80
(locations (mapcar #'method-source-location methods)))
+<<<<<<< swank-cmucl.lisp
+ (mapcar #'list methods locations))))
+
+(defun xref-results (contexts)
+ (mapcar (lambda (xref)
+ (list (xref:xref-context-name xref)
+ (resolve-xref-location xref)))
+ contexts))
+=======
(mapcar #'list methods locations))))
(defun xrefs (contexts)
@@ -399,6 +426,7 @@
(list (xref:xref-context-name xref)
(resolve-xref-location xref)))
contexts))
+>>>>>>> 1.80
(defun resolve-xref-location (xref)
(let ((name (xref:xref-context-name xref))
@@ -1034,6 +1062,23 @@
LRA = ~X~%" (mapcar #'fixnum
(multiple-value-list (frame-registers frame)))))))
+<<<<<<< swank-cmucl.lisp
+(defimplementation disassemble-frame (frame-number)
+ "Return a string with the disassembly of frames code."
+ (print-frame-registers frame-number)
+ (terpri)
+ (let* ((frame (di::frame-real-frame (nth-frame frame-number)))
+ (debug-fun (di::frame-debug-function frame)))
+ (etypecase debug-fun
+ (di::compiled-debug-function
+ (let* ((component (di::compiled-debug-function-component debug-fun))
+ (fun (di:debug-function-function debug-fun)))
+ (if fun
+ (disassemble fun)
+ (disassem:disassemble-code-component component))))
+ (di::bogus-debug-function
+ (format t "~%[Disassembling bogus frames not implemented]")))))
+=======
;; (defslimefun sldb-disassemble (frame-number)
;; "Return a string with the disassembly of frames code."
;; (with-output-to-string (*standard-output*)
@@ -1050,6 +1095,7 @@
;; (disassem:disassemble-code-component component))))
;; (di::bogus-debug-function
;; (format t "~%[Disassembling bogus frames not implemented]"))))))
+>>>>>>> 1.80
#+(or)
(defun print-binding-stack ()
Index: slime/swank-gray.lisp
diff -u slime/swank-gray.lisp:1.4 slime/swank-gray.lisp:1.5
--- slime/swank-gray.lisp:1.4 Tue Mar 9 08:58:50 2004
+++ slime/swank-gray.lisp Tue Mar 9 14:35:36 2004
@@ -7,8 +7,6 @@
;;; This code has been placed in the Public Domain. All warranties
;;; are disclaimed.
;;;
-;;; $Id: swank-gray.lisp,v 1.4 2004/03/09 13:58:50 heller Exp $
-;;;
(in-package :swank-backend)
Index: slime/swank-lispworks.lisp
diff -u slime/swank-lispworks.lisp:1.30 slime/swank-lispworks.lisp:1.31
--- slime/swank-lispworks.lisp:1.30 Tue Mar 9 07:46:27 2004
+++ slime/swank-lispworks.lisp Tue Mar 9 14:35:36 2004
@@ -356,6 +356,24 @@
;;; xref
+<<<<<<< swank-lispworks.lisp
+(defmacro defxref (name function)
+ `(defimplementation ,name (name)
+ (xref-results (,function name))))
+
+(defxref who-calls hcl:who-calls)
+(defxref who-references hcl:who-references)
+(defxref who-binds hcl:who-binds)
+(defxref who-sets hcl:who-sets)
+(defxref list-callees hcl:calls-who)
+
+(defun xref-results (dspecs)
+ (loop for dspec in dspecs
+ nconc (loop for (dspec location) in
+ (dspec:dspec-definition-locations dspec)
+ collect (list dspec
+ (make-dspec-location dspec location)))))
+=======
(defun xrefs (dspecs)
(loop for dspec in dspecs
nconc (loop for (dspec location) in
@@ -380,6 +398,7 @@
(defimplementation list-callees (name)
(xrefs (hcl:calls-who name)))
+>>>>>>> 1.30
;;; Inspector
Index: slime/swank-loader.lisp
diff -u slime/swank-loader.lisp:1.18 slime/swank-loader.lisp:1.19
--- slime/swank-loader.lisp:1.18 Tue Mar 9 07:46:27 2004
+++ slime/swank-loader.lisp Tue Mar 9 14:35:36 2004
@@ -7,8 +7,6 @@
;;; This code has been placed in the Public Domain. All warranties
;;; are disclaimed.
;;;
-;;; $Id: swank-loader.lisp,v 1.18 2004/03/09 12:46:27 heller Exp $
-;;;
(cl:defpackage :swank-loader
(:use :common-lisp))
Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.69 slime/swank-openmcl.lisp:1.70
--- slime/swank-openmcl.lisp:1.69 Tue Mar 9 07:46:27 2004
+++ slime/swank-openmcl.lisp Tue Mar 9 14:35:36 2004
@@ -327,11 +327,18 @@
((symbolp tag)
tag)
((and (listp tag)
+<<<<<<< swank-openmcl.lisp
+ (typep (car tag) 'restart))
+ `(:restart ,(restart-name (car tag))))))))))))
+
+(defimplementation disassemble-frame (the-frame-number)
+=======
(typep (car tag) 'restart))
`(:restart ,(restart-name (car tag))))))))))))
(defimplementation sldb-disassemble (the-frame-number)
"Return a string with the disassembly of frames code."
+>>>>>>> 1.69
(let ((function-to-disassemble nil))
(block find-frame
(map-backtrace
@@ -340,9 +347,9 @@
(when (= frame-number the-frame-number)
(setq function-to-disassemble lfun)
(return-from find-frame)))))
- (with-output-to-string (s)
- (ccl::print-ppc-instructions
- s (ccl::function-to-dll-header function-to-disassemble) nil))))
+ (ccl::print-ppc-instructions
+ *standard-output*
+ (ccl::function-to-dll-header function-to-disassemble) nil)))
;;;
More information about the slime-cvs
mailing list