[slime-cvs] CVS slime

[CVS User heller]

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

Modified Files:
	ChangeLog swank-openmcl.lisp 
Log Message:
Recent CCLs support much better source location recording.
Let's use the new features in SLIME.

* swank-openmcl.lisp (pc-source-location): New function, based on
ccl:find-source-note-at-pc.
(frame-source-location-for-emacs): Use it.

--- /project/slime/cvsroot/slime/ChangeLog	2008/12/28 14:32:14	1.1606
+++ /project/slime/cvsroot/slime/ChangeLog	2008/12/28 15:45:42	1.1607
@@ -1,7 +1,13 @@
 2008-12-28  Helmut Eller  <heller at common-lisp.net>
 
+	Recent CCLs support much better source location recording.
+	Let's use the new features in SLIME.
+
 	* swank-openmcl.lisp (function-source-location): Use
 	ccl:function-source-note.
+	(pc-source-location): New function, based on
+	ccl:find-source-note-at-pc.
+	(frame-source-location-for-emacs): Use it.
 
 2008-12-27  Helmut Eller  <heller at common-lisp.net>
 
--- /project/slime/cvsroot/slime/swank-openmcl.lisp	2008/12/28 14:32:15	1.145
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp	2008/12/28 15:45:42	1.146
@@ -642,10 +642,14 @@
 ;; is to make Slime, and our IDE, use this eventually.
 
 #+#.(cl:if (cl:fboundp 'ccl::function-source-note) '(:or) '(:and))
-(defun function-source-location (function)
-  (or (car (source-locations function))
-      (list :error (format nil "No source info available for ~A" function))))
-
+(progn
+  (defun function-source-location (function)
+    (or (car (source-locations function))
+        (list :error (format nil "No source info available for ~A" function))))
+  
+  (defun pc-source-location (function pc)
+    (function-source-location function)))
+  
 #+#.(cl:if (cl:fboundp 'ccl::function-source-note) '(:and) '(:or))
 (progn
   (defun function-source-location (function)
@@ -655,11 +659,18 @@
           (list :error
                 (format nil "No source info available for ~A" function)))))
 
+  (defun pc-source-location (function pc)
+    (let ((note (ccl:find-source-note-at-pc function pc)))
+      (if note
+          (source-note-to-source-location note)
+          (list :error
+                (format nil "No source note at ~A:#~x" function pc)))))
+
   (defun source-note-to-source-location (note)
     (let ((filename (namestring (truename (ccl:source-note-filename note)))))
       (make-location
        (list :file filename)
-       (list :position (ccl:source-note-start-pos note))))))
+       (list :position (1+ (ccl:source-note-start-pos note)))))))
 
 ;; source-locations THING => LOCATIONS NAMES
 ;; LOCATIONS ... a list of source-locations.  Most "specific" first.
@@ -713,10 +724,10 @@
   (block frame-source-location-for-emacs
     (map-backtrace
      (lambda (frame-number p context lfun pc)
-       (declare (ignore p context pc))
+       (declare (ignore p context))
        (when (and (= frame-number index) lfun)
          (return-from frame-source-location-for-emacs
-           (function-source-location lfun)))))))
+           (pc-source-location lfun pc)))))))
 
 (defimplementation eval-in-frame (form index)
   (block eval-in-frame