From 9be6530c85baf6d45ab60a94867ba1e3ff3d66b0 Mon Sep 17 00:00:00 2001
From: Raymond Toy <toy.raymond@gmail.com>
Date: Mon, 20 May 2013 19:24:53 -0700
Subject: [PATCH] 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.

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

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index c39f17e3a..199536072 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 858f585c8..f36f6d02b 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
-- 
GitLab