[slime-cvs] CVS slime

[CVS User heller]

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

Modified Files:
	ChangeLog swank-allegro.lisp 
Log Message:
* swank-allegro.lisp (handle-compiler-warning): Ignore "Closure
will be stack allocated" notes.  Those are harmless and there are
too many of them.
(pc-source-location, ldb-code-to-src-loc): Handle case when
excl::ldb-code-pc returns nil.

--- /project/slime/cvsroot/slime/ChangeLog	2013/02/02 10:11:16	1.2390
+++ /project/slime/cvsroot/slime/ChangeLog	2013/02/08 14:11:23	1.2391
@@ -1,3 +1,11 @@
+2013-02-08  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-allegro.lisp (handle-compiler-warning): Ignore "Closure
+	will be stack allocated" notes.  Those are harmless and there are
+	too many of them.
+	(pc-source-location, ldb-code-to-src-loc): Handle case when
+	excl::ldb-code-pc returns nil.
+
 2013-02-02  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-backend.lisp (type-specifier-p): New.
--- /project/slime/cvsroot/slime/swank-allegro.lisp	2013/02/02 10:11:16	1.158
+++ /project/slime/cvsroot/slime/swank-allegro.lisp	2013/02/08 14:11:23	1.159
@@ -237,7 +237,8 @@
           (t
            (let* ((code-loc (find-if (lambda (c)
                                        (<= (- pc (sys::natural-width))
-                                           (excl::ldb-code-pc c)
+                                           (let ((x (excl::ldb-code-pc c)))
+                                             (or x -1))
                                            pc))
                                      debug-info)))
              (cond ((not code-loc)
@@ -250,7 +251,7 @@
   (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) 
+         (start (loop for i from (excl::ldb-code-index code) downto 0
                       for bpt = (aref debug-info i)
                       for start = (excl::ldb-code-start-char bpt)
                       when start return start))
@@ -362,9 +363,16 @@
 
 (defun handle-compiler-warning (condition)
   (declare (optimize (debug 3) (speed 0) (space 0)))
-  (cond ((and (not *buffer-name*) 
+  (cond ((and (not *buffer-name*)
               (compiler-undefined-functions-called-warning-p condition))
          (handle-undefined-functions-warning condition))
+        ((and (typep condition 'excl::compiler-note)
+              (let ((format (slot-value condition 'excl::format-control)))
+                (and (search "Closure" format)
+                     (search "will be stack allocated" format))))
+         ;; Ignore "Closure <foo> will be stack allocated" notes.
+         ;; That occurs often but is usually uninteresting.
+         )
         (t
          (signal-compiler-condition
           :original-condition condition
@@ -376,7 +384,7 @@
                       (reader-error  :read-error)
                       (error         :error))
           :message (format nil "~A" condition)
-          :location (if (typep condition 'reader-error) 
+          :location (if (typep condition 'reader-error)
                         (location-for-reader-error condition)
                         (location-for-warning condition))))))