[cmucl-commit] [git] CMU Common Lisp branch master updated. snapshot-2013-05-8-g9be6530

[Raymond Toy]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".

The branch, master has been updated
       via  9be6530c85baf6d45ab60a94867ba1e3ff3d66b0 (commit)
      from  d879838d33c578bcecf282b8b95628b6d9bbc476 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 9be6530c85baf6d45ab60a94867ba1e3ff3d66b0
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Mon May 20 19:24:53 2013 -0700

    Fix ticket:82:  If the form numbers are too large to be encoded, don't
    try to set the source location information.  We try to print a warning
    in such cases.

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index c39f17e..1995360 100644
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -447,9 +447,11 @@
   form)
 
 (defun encode-form-numbers (tlf-number form-number)
-  "Return the TLF-NUMBER and FORM-NUMBER encoded as fixnum."
-  (declare (type (unsigned-byte 14) tlf-number form-number))
-  (logior tlf-number (ash form-number 14)))
+  "Return the TLF-NUMBER and FORM-NUMBER encoded as fixnum, if
+  possible.  Otherwise, return Nil."
+  (when (and (typep tlf-number '(unsigned-byte 14))
+	     (typep form-number '(unsigned-byte 14)))
+    (logior tlf-number (ash form-number 14))))
 
 (defun decode-form-numbers (fixnum)
   "Return the tlf-number and form-number from an encoded FIXNUM."
@@ -460,7 +462,7 @@
   "Return a source-location for the call site."
   nil)
 
-(define-compiler-macro source-location ()
+(define-compiler-macro source-location (&whole whole)
   (let ((file-info (let ((rest (source-info-current-file *source-info*)))
 		     (cond (rest (car rest))
 			   ;; MAKE-LISP-SOURCE-INFO doesn't set current-file
@@ -468,18 +470,24 @@
 	(form-numbers (encode-form-numbers
 		       (source-path-tlf-number *current-path*)
 		       (source-path-form-number *current-path*))))
-    (etypecase (file-info-name file-info)
-      (pathname
-       `(quote ,(make-file-source-location 
-		 :form-numbers form-numbers
-		 :pathname (namestring-for-debug-source file-info))))
-      ((member :stream)
-       `(quote ,(make-stream-source-location :form-numbers form-numbers
-					     :user-info *user-source-info*)))
-      ((member :lisp)
-       `(quote ,(make-lisp-source-location 
-		 :form-numbers form-numbers
-		 :form (aref (file-info-forms file-info) 0)))))))
+    (cond (form-numbers
+	   (etypecase (file-info-name file-info)
+	     (pathname
+	      `(quote ,(make-file-source-location 
+			:form-numbers form-numbers
+			:pathname (namestring-for-debug-source file-info))))
+	     ((member :stream)
+	      `(quote ,(make-stream-source-location :form-numbers form-numbers
+						    :user-info *user-source-info*)))
+	     ((member :lisp)
+	      `(quote ,(make-lisp-source-location 
+			:form-numbers form-numbers
+			:form (aref (file-info-forms file-info) 0))))))
+	  (t
+	   (warn "Dropping source-location because form numbers are too large: ~S ~S"
+		 (source-path-tlf-number *current-path*)
+		 (source-path-form-number *current-path*))
+	   whole))))
 
 
 ;;; MAKE-LEXENV  --  Interface
diff --git a/src/general-info/release-20e.txt b/src/general-info/release-20e.txt
index 858f585..f36f6d0 100644
--- a/src/general-info/release-20e.txt
+++ b/src/general-info/release-20e.txt
@@ -82,6 +82,7 @@ New in this release:
     * Ticket #80 fixed.
     * Ticket #81 fixed.
     * Ticket #83 fixed.
+    * Ticket #82 fixed.
 
   * Other changes:
     * -8 option for build-all.sh is deprecated since we don't

-----------------------------------------------------------------------

Summary of changes:
 src/compiler/ir1util.lisp        |   40 +++++++++++++++++++++++---------------
 src/general-info/release-20e.txt |    1 +
 2 files changed, 25 insertions(+), 16 deletions(-)


hooks/post-receive
-- 
CMU Common Lisp