[slime-devel] LispWorks 6 and list-callers/list-callees

[Vitaly Mayatskikh]

Hi!

Here's patch to bring list-callers back to life for LW6 and
implementation of list-callees. Tested on LW 6.0.1.

--- ChangeLog.~1.2114.~	2010-07-22 13:48:06.000000000 +0200
+++ ChangeLog	2010-07-22 14:12:24.900354346 +0200
@@ -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

--- swank-lispworks.lisp.~1.136.~	2010-03-06 19:29:09.000000000 +0100
+++ swank-lispworks.lisp	2010-07-22 14:04:35.266247655 +0200
@@ -697,8 +697,10 @@ function names like \(SETF GET)."
 (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 @@ function names like \(SETF GET)."
 		      (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

-- 
wbr, Vitaly