diff --git a/compiler/main.lisp b/compiler/main.lisp
index 11ed11a4467abf90ccb44a045cfb3cedce08b0cd..69f1f123e18bbb7abef646d351d3dd8c65041a72 100644
--- a/compiler/main.lisp
+++ b/compiler/main.lisp
@@ -656,8 +656,8 @@
 ;;; Read-Source-Form  --  Internal
 ;;;
 ;;;    Read the next form from the source designated by Info.  The second value
-;;; is the initial source path for the read form.  The third value is true when
-;;; at EOF.
+;;; is the top-level form number of the read form.  The third value is true
+;;; when at EOF.
 ;;;
 ;;;   We carefully read from the current source file.  If it is at EOF, we
 ;;; advance to the next file and try again.  When we get a form, we enter it
@@ -677,7 +677,7 @@
 				 (file-info-source-root file))))
 	    (vector-push-extend res forms)
 	    (vector-push-extend pos (file-info-positions file))
-	    (return (values res (list current-idx) nil))))
+	    (return (values res current-idx nil))))
 
 	(unless (advance-source-file info)
 	  (return (values nil nil t)))))))
@@ -708,9 +708,9 @@
 ;;; form, but delay compilation, pushing the result on *TOP-LEVEL-LAMBDAS*
 ;;; instead.
 ;;; 
-(defun convert-and-maybe-compile (form path object)
-  (declare (list path) (type object object))
-  (let ((tll (ir1-top-level form path nil)))
+(defun convert-and-maybe-compile (form tlf-num object)
+  (declare (type index tlf-num) (type object object))
+  (let ((tll (ir1-top-level form tlf-num nil)))
     (cond (*block-compile* (push tll *top-level-lambdas*))
 	  (t
 	   (compile-top-level (list tll) object)
@@ -720,17 +720,13 @@
 ;;; PROCESS-PROGN  --  Internal
 ;;;
 ;;;    Process a PROGN-like portion of a top-level form.  Forms is a list of
-;;; the forms, and Path is the source path that lead to the immediately
-;;; enclosing form.  Offset is added to the position within Forms when
-;;; computing the source path of the subforms.
+;;; the forms, and TLF-Num is the top-level form number of the form they came
+;;; out of.
 ;;;
-(defun process-progn (forms path offset object)
-  (declare (list forms path) (type unsigned-byte offset)
-	   (type object object))
-  (do ((i offset (1+ i))
-       (form forms (cdr form)))
-      ((endp form))
-    (process-form (car form) (cons i path) object)))
+(defun process-progn (forms tlf-num object)
+  (declare (list forms) (type index tlf-num) (type object object))
+  (dolist (form forms)
+    (process-form form tlf-num object)))
 
 
 (proclaim '(special *compiler-error-bailout*))
@@ -744,18 +740,23 @@
 ;;; ### At least for now, always dump package frobbing as interpreted cold load
 ;;; forms.  This might want to be on a switch someday.
 ;;;
-(defun process-form (form path object)
-  (declare (list path) (type object object))
+(defun process-form (form tlf-num object)
+  (declare (type index tlf-num) (type object object))
   (catch 'process-form-error-abort
-    (let ((*compiler-error-bailout*
-	   #'(lambda ()
-	       (convert-and-maybe-compile
-		`(error "Execution of a form compiled with errors:~% ~S"
-		       ',form)
-		path object)
-	       (throw 'process-form-error-abort nil))))
+    (let* ((*compiler-error-bailout*
+	    #'(lambda ()
+		(convert-and-maybe-compile
+		 `(error "Execution of a form compiled with errors:~% ~S"
+			 ',form)
+		 tlf-num object)
+		(throw 'process-form-error-abort nil)))
+	   (form
+	    (handler-case (macroexpand form *fenv*)
+	      (error (condition)
+		     (compiler-error "(during macroexpansion)~%~A"
+				     condition)))))
       (if (atom form)
-	  (convert-and-maybe-compile form path object)
+	  (convert-and-maybe-compile form tlf-num object)
 	  (case (car form)
 	    ((make-package in-package shadow shadowing-import export
 			   unexport use-package unuse-package import)
@@ -769,17 +770,17 @@
 	     (do-eval-when-stuff
 	      (cadr form) (cddr form)
 	      #'(lambda (forms)
-		  (process-progn forms path 2 object))))
+		  (process-progn forms tlf-num object))))
 	    ((macrolet)
 	     (unless (>= (length form) 2)
 	       (compiler-error "MACROLET form is too short: ~S." form))
 	     (do-macrolet-stuff
 	      (cadr form)
 	      #'(lambda ()
-		  (process-progn (cddr form) path 2 object))))
-	    (progn (process-progn (cdr form) path 1 object))
+		  (process-progn (cddr form) tlf-num object))))
+	    (progn (process-progn (cdr form) tlf-num object))
 	    (t
-	     (convert-and-maybe-compile form path object))))))
+	     (convert-and-maybe-compile form tlf-num object))))))
       
   (undefined-value))
 
@@ -822,10 +823,12 @@
 	       (*last-format-args* nil)
 	       (*last-message-count* 0))
 	  (loop
-	    (multiple-value-bind (form path eof-p)
+	    (multiple-value-bind (form tlf eof-p)
 				 (read-source-form info)
 	      (when eof-p (return))
-	      (process-form form path object)))
+	      (clrhash *source-paths*)
+	      (find-source-paths form tlf)
+	      (process-form form tlf object)))
 	  
 	  (when *block-compile*
 	    (compile-top-level (nreverse *top-level-lambdas*) object)
@@ -1066,34 +1069,35 @@
 	     (*last-format-string* nil)
 	     (*last-format-args* nil)
 	     (*last-message-count* 0)
-	     (object (make-core-object))
-	     (lambda (ir1-top-level form '(0) t)))
-	
-	(compile-fix-function-name lambda name)
-	(let* ((component
-		(block-component (node-block (lambda-bind lambda))))
-	       (*all-components* (list component)))
-	  (local-call-analyze component))
-	
-	(let* ((components (find-initial-dfo (list lambda)))
-	       (*all-components* components))
-	  (dolist (component components)
-	    (compile-component component object)
-	    (clear-ir2-info component)))
-	
-	(fix-core-source-info *source-info* object)
-	(let* ((res (core-call-top-level-lambda lambda object))
-	       (return (or name res)))
-	  (when name
-	    (setf (fdefinition name) res))
+	     (object (make-core-object)))
+	(find-source-paths form 0)
+	(let ((lambda (ir1-top-level form 0 t)))
 	  
-	  (cond ((or (> *compiler-error-count* start-errors)
-		     (> *compiler-warning-count* start-warnings))
-		 (values return t t))
-		((> *compiler-note-count* start-notes)
-		 (values return t nil))
-		(t
-		 (values return nil nil)))))))))
+	  (compile-fix-function-name lambda name)
+	  (let* ((component
+		  (block-component (node-block (lambda-bind lambda))))
+		 (*all-components* (list component)))
+	    (local-call-analyze component))
+	  
+	  (let* ((components (find-initial-dfo (list lambda)))
+		 (*all-components* components))
+	    (dolist (component components)
+	      (compile-component component object)
+	      (clear-ir2-info component)))
+	  
+	  (fix-core-source-info *source-info* object)
+	  (let* ((res (core-call-top-level-lambda lambda object))
+		 (return (or name res)))
+	    (when name
+	      (setf (fdefinition name) res))
+	    
+	    (cond ((or (> *compiler-error-count* start-errors)
+		       (> *compiler-warning-count* start-warnings))
+		   (values return t t))
+		  ((> *compiler-note-count* start-notes)
+		   (values return t nil))
+		  (t
+		   (values return nil nil)))))))))
 
 #+new-compiler
 ;;; UNCOMPILE  --  Public