[slime-cvs] CVS slime

[CVS User sboukarev]

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv32481

Modified Files:
	ChangeLog swank-lispworks.lisp 
Log Message:
* swank-lispworks.lisp (list-callers-internal): Fix for LW6.
(list-callees-internal): New function, use it.


--- /project/slime/cvsroot/slime/ChangeLog	2010/07/21 13:40:32	1.2114
+++ /project/slime/cvsroot/slime/ChangeLog	2010/07/22 13:45:46	1.2115
@@ -1,3 +1,8 @@
+2010-07-22  Vitaly Mayatskikh  <v.mayatskih at gmail.com>
+
+	* swank-lispworks.lisp (list-callers-internal): Fix for LW6.
+	(list-callees-internal): New function, use it.
+
 2010-07-21  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-sbcl.lisp (quit-lisp): Use sb-thread:terminate-thread
--- /project/slime/cvsroot/slime/swank-lispworks.lisp	2010/03/02 12:38:07	1.136
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp	2010/07/22 13:45:46	1.137
@@ -697,8 +697,10 @@
 (defxref who-macroexpands hcl:who-calls) ; macros are in the calls table too
 (defxref calls-who      hcl:calls-who)
 (defxref list-callers   list-callers-internal)
-;; (defxref list-callees   list-callees-internal)
+#+lispworks6
+(defxref list-callees   list-callees-internal)
 
+#-lispworks6
 (defun list-callers-internal (name)
   (let ((callers (make-array 100
                              :fill-pointer 0
@@ -716,6 +718,24 @@
 		      (list 'function object)
                       (or (dspec:object-dspec object) object)))))
 
+#+lispworks6
+(defun list-callers-internal (name)
+    ;; Delay dspec:object-dspec until after sweep-all-objects
+    ;; to reduce allocation problems.
+    (loop for object in (hcl::who-calls name)
+          collect (if (symbolp object)
+		      (list 'function object)
+                      (or (dspec:object-dspec object) object))))
+
+#+lispworks6
+(defun list-callees-internal (name)
+    ;; Delay dspec:object-dspec until after sweep-all-objects
+    ;; to reduce allocation problems.
+    (loop for object in (hcl::calls-who name)
+          collect (if (symbolp object)
+		      (list 'function object)
+                      (or (dspec:object-dspec object) object))))
+
 ;; only for lispworks 4.2 and above
 #-lispworks4.1
 (progn