From f7eb1887164c94af40264f56c859451740463e22 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Fri, 15 Jun 1990 22:52:51 +0000
Subject: [PATCH] Changed source context stuff to use the TLF number to do N
 reads to find the TLF when the source has been modified.  Also, we print the
 file that the source is in.

---
 code/debug.lisp | 24 ++++++++++++++++--------
 1 file changed, 16 insertions(+), 8 deletions(-)

diff --git a/code/debug.lisp b/code/debug.lisp
index c21de3c36..9919615fc 100644
--- a/code/debug.lisp
+++ b/code/debug.lisp
@@ -718,17 +718,28 @@
     (cond ((not (eq :file (di:debug-source-from d-source)))
 	   (format t "~%Source did not come from a file."))
 	  ((not (probe-file name))
-	   (format t "~%Source file no longer exists -- ~A."
+	   (format t "~%Source file no longer exists:~%  ~A."
 		   (namestring name)))
-	  ((= (di:debug-source-created d-source)
-	      (file-write-date name))
+	  (t
 	   (let* ((tlf-offset (di:code-location-top-level-form-offset
 			       location))
 		  (char-offset (aref (di:debug-source-start-positions
 				      d-source)
 				     tlf-offset)))
 	     (with-open-file (f name)
-	       (file-position f char-offset)
+	       (cond
+		((= (di:debug-source-created d-source)
+		    (file-write-date name))
+		 (file-position f char-offset))
+		(t
+		 (format t "~%File has been modified since compilation:~%  ~A~@
+		             Using form offset instead of character position.~%"
+			 (namestring name))
+		 (dotimes (i tlf-offset)
+		   (read f))))
+	   ((not any-valid-p)
+	       (format t "File: ~A~%" (namestring name))
+		  
 	       (let* ((tlf (read f))
 		      (translations (di:form-number-translations
 				     tlf tlf-offset))
@@ -738,10 +749,7 @@
 			 tlf
 			 (svref translations
 				(di:code-location-form-number location))
-			 context))))))
-	    (t
-	     (format t "~%File has been modified since compilation -- ~A."
-		     (namestring name))))))
+			 context)))))))))
 		  (setf *possible-breakpoints*
 			(possible-breakpoints
 			 *default-breakpoint-debug-function*))))))
-- 
GitLab