[slime-cvs] CVS update: slime/swank-openmcl.lisp

[Alan Ruttenberg]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv25816/slime

Modified Files:
	swank-openmcl.lisp 
Log Message:
swank-openmcl: typo in who-references. Fix frame-var-value

Date: Wed Sep 15 20:59:45 2004
Author: aruttenberg

Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.83 slime/swank-openmcl.lisp:1.84
--- slime/swank-openmcl.lisp:1.83	Tue Sep 14 18:01:06 2004
+++ slime/swank-openmcl.lisp	Wed Sep 15 20:59:44 2004
@@ -255,10 +255,15 @@
    #'(lambda(frame-number p context lfun pc)
        (when (= frame frame-number)
          (return-from frame-var-value 
-           (multiple-value-bind (count vsp parent-vsp)
+           (multiple-value-bind (total vsp parent-vsp)
                (ccl::count-values-in-frame p context)
-             (declare (ignore count))
-             (ccl::nth-value-in-frame p var context lfun pc vsp parent-vsp)))))))
+             (loop for count below total
+                   with varcount = -1
+                   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))
+             ))))))
 
 (defun xref-locations (relation name &optional (inverse nil))
   (loop for xref in (if inverse 
@@ -277,8 +282,8 @@
   (remove-duplicates
    (append (xref-locations :references name)
            (xref-locations :sets name)
-           (xref-locations :binds name)))
-  :test 'equal)
+           (xref-locations :binds name))
+   :test 'equal))
 
 (defimplementation who-sets (name)
   (xref-locations :sets name))