[slime-cvs] CVS slime

[CVS User heller]

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

Modified Files:
	ChangeLog swank-allegro.lisp 
Log Message:
* swank-allegro.lisp (ldb-code-to-src-loc): Scan backward to the
first code point with a non-nil start-char.
(frame-package): Also match for ((:internal foo ...)).

--- /project/slime/cvsroot/slime/ChangeLog	2012/11/08 12:34:06	1.2364
+++ /project/slime/cvsroot/slime/ChangeLog	2012/11/11 09:30:53	1.2365
@@ -1,3 +1,9 @@
+2012-11-11  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-allegro.lisp (ldb-code-to-src-loc): Scan backward to the
+	first code point with a non-nil start-char.
+	(frame-package): Also match for ((:internal foo ...)).
+
 2012-11-08  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el (slime-timer-call): Use debug marker in
--- /project/slime/cvsroot/slime/swank-allegro.lisp	2012/11/02 08:14:28	1.155
+++ /project/slime/cvsroot/slime/swank-allegro.lisp	2012/11/11 09:30:53	1.156
@@ -239,8 +239,13 @@
 
 #+(version>= 8 2)
 (defun ldb-code-to-src-loc (code)
-  (let* ((start (excl::ldb-code-start-char code))
-         (func (excl::ldb-code-func code))
+  (declare (optimize debug))
+  (let* ((func (excl::ldb-code-func code))
+         (debug-info (excl::function-source-debug-info func))
+         (start (loop for i downfrom (excl::ldb-code-index code) 
+                      for bpt = (aref debug-info i)
+                      for start = (excl::ldb-code-start-char bpt)
+                      when start return start))
          (src-file (excl:source-file func)))
     (cond (start
            (buffer-or-file-location src-file start))
@@ -250,7 +255,7 @@
                   (paths (source-paths-of (excl::ldb-code-source whole)
                                           (excl::ldb-code-source code)))
                   (path (if paths (longest-common-prefix paths) '()))
-                  (start (excl::ldb-code-start-char whole)))
+                  (start 0))
              (buffer-or-file
               src-file
               (lambda (file)
@@ -296,7 +301,9 @@
   (let* ((frame (nth-frame frame-number))
          (exp (debugger:frame-expression frame)))
     (typecase exp
-      ((cons symbol) (symbol-package (car exp))))))
+      ((cons symbol) (symbol-package (car exp)))
+      ((cons (cons (eql :internal) (cons symbol)))
+       (symbol-package (cadar exp))))))
 
 (defimplementation return-from-frame (frame-number form)
   (let ((frame (nth-frame frame-number)))