[slime-cvs] CVS slime

[CVS User heller]

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

Modified Files:
	ChangeLog swank-allegro.lisp 
Log Message:
(pc-source-location): Be a bit more fuzzy when searching the
code-location for a pc.

--- /project/slime/cvsroot/slime/ChangeLog	2010/03/09 08:15:05	1.2029
+++ /project/slime/cvsroot/slime/ChangeLog	2010/03/09 09:20:13	1.2030
@@ -10,6 +10,8 @@
 	vs. buffer issue.
 	(ldb-code-to-src-loc): Don't use *temp-file-map* before it is
 	declared.
+	(pc-source-location): Be a bit more fuzzy when searching the
+	code-location for a pc.
 
 2010-03-08  Stas Boukarev  <stassats at gmail.com>
 
--- /project/slime/cvsroot/slime/swank-allegro.lisp	2010/03/09 08:15:05	1.138
+++ /project/slime/cvsroot/slime/swank-allegro.lisp	2010/03/09 09:20:13	1.139
@@ -213,15 +213,15 @@
     (cond ((not debug-info)
            (function-source-location fun))
           (t 
-           (let* ((return-loc (find pc debug-info :key #'excl::ldb-code-pc))
-                  (prev (and return-loc (excl::ldb-code-prev-rec return-loc)))
-                  (call-loc (if (integerp prev) 
-                                (aref debug-info prev) 
-                                return-loc)))
-             (cond ((not call-loc)
+           (let* ((code-loc (find-if (lambda (c)
+                                       (<= (- pc (sys::natural-width))
+                                           (excl::ldb-code-pc c)
+                                           pc))
+                                     debug-info)))
+             (cond ((not code-loc)
                     (ldb-code-to-src-loc (aref debug-info 0)))
                    (t
-                    (ldb-code-to-src-loc call-loc))))))))
+                    (ldb-code-to-src-loc code-loc))))))))
 
 #+(version>= 8 2)
 (defun ldb-code-to-src-loc (code)