[slime-cvs] CVS slime

[CVS User msimmons]

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

Modified Files:
	ChangeLog swank-lispworks.lisp 
Log Message:
* swank-lispworks.lisp (list-callers-internal): Revert to previous
low level implementation, fixed for LW6.
(list-callees-internal): Reimplement using low level instead of
the compiler's xref.


--- /project/slime/cvsroot/slime/ChangeLog	2010/10/23 12:18:28	1.2159
+++ /project/slime/cvsroot/slime/ChangeLog	2010/11/02 12:32:10	1.2160
@@ -1,3 +1,10 @@
+2010-11-02  Martin Simmons  <martin at lispworks.com>
+
+	* swank-lispworks.lisp (list-callers-internal): Revert to previous
+	low level implementation, fixed for LW6.
+	(list-callees-internal): Reimplement using low level instead of
+	the compiler's xref.
+
 2010-10-23  Stas Boukarev  <stassats at gmail.com>
 
 	* slime.el (slime-goto-location-position): In case of
--- /project/slime/cvsroot/slime/swank-lispworks.lisp	2010/07/22 13:45:46	1.137
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp	2010/11/02 12:32:10	1.138
@@ -697,10 +697,8 @@
 (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)
-#+lispworks6
 (defxref list-callees   list-callees-internal)
 
-#-lispworks6
 (defun list-callers-internal (name)
   (let ((callers (make-array 100
                              :fill-pointer 0
@@ -708,7 +706,8 @@
     (hcl:sweep-all-objects
      #'(lambda (object)
          (when (and #+Harlequin-PC-Lisp (low:compiled-code-p object)
-                    #-Harlequin-PC-Lisp (sys::callablep object)
+                    #+Harlequin-Unix-Lisp (sys:callablep object)
+                    #-(or Harlequin-PC-Lisp Harlequin-Unix-Lisp) (sys:compiled-code-p object)
                     (system::find-constant$funcallable name object))
            (vector-push-extend object callers))))
     ;; Delay dspec:object-dspec until after sweep-all-objects
@@ -718,23 +717,18 @@
 		      (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))))
+  (let ((callees '()))
+    (system::find-constant$funcallable
+     'junk name
+     :test #'(lambda (junk constant)
+               (declare (ignore junk))
+               (when (and (symbolp constant)
+                          (fboundp constant))
+                 (pushnew (list 'function constant) callees :test 'equal))
+               ;; Return nil so we iterate over all constants.
+               nil))
+    callees))
 
 ;; only for lispworks 4.2 and above
 #-lispworks4.1