X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmain.lisp;h=3a96c2bbdd024a97c09288615189b74641b68394;hb=6ab9c60f1c53cc7cc912d644658bc23453a82ac4;hp=47b4c92e4f64a0135f2abe4b623a7f7c2d4c08e6;hpb=0794cd3908a441222f430ba0cf3bb7c3e1a96c63;p=sbcl.git

diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index 47b4c92..3a96c2b 100644
--- a/src/compiler/main.lisp
+++ b/src/compiler/main.lisp
@@ -661,7 +661,7 @@
 
 ;;; A FILE-INFO structure holds all the source information for a
 ;;; given file.
-(defstruct (file-info (:copier nil))
+(def!struct (file-info (:copier nil))
   ;; If a file, the truename of the corresponding source file. If from
   ;; a Lisp form, :LISP. If from a stream, :STREAM.
   (name (missing-arg) :type (or pathname (member :lisp :stream)))
@@ -684,11 +684,11 @@
 
 ;;; The SOURCE-INFO structure provides a handle on all the source
 ;;; information for an entire compilation.
-(defstruct (source-info
-	    #-no-ansi-print-object
-	    (:print-object (lambda (s stream)
-			     (print-unreadable-object (s stream :type t))))
-	    (:copier nil))
+(def!struct (source-info
+	     #-no-ansi-print-object
+	     (:print-object (lambda (s stream)
+			      (print-unreadable-object (s stream :type t))))
+	     (:copier nil))
   ;; the UT that compilation started at
   (start-time (get-universal-time) :type unsigned-byte)
   ;; the FILE-INFO structure for this compilation
@@ -806,7 +806,8 @@
 (defun convert-and-maybe-compile (form path)
   (declare (list path))
   (let* ((*lexenv* (make-lexenv :policy *policy*
-				:handled-conditions *handled-conditions*))
+				:handled-conditions *handled-conditions*
+				:disabled-package-locks *disabled-package-locks*))
 	 (tll (ir1-toplevel form path nil)))
     (cond ((eq *block-compile* t) (push tll *toplevel-lambdas*))
 	  (t (compile-toplevel (list tll) nil)))))
@@ -853,7 +854,9 @@
 	   ;; issue a warning instead of silently screwing up.
 	   (*policy* (lexenv-policy *lexenv*))
 	   ;; This is probably also a hack
-	   (*handled-conditions* (lexenv-handled-conditions *lexenv*)))
+	   (*handled-conditions* (lexenv-handled-conditions *lexenv*))
+	   ;; ditto
+	   (*disabled-package-locks* (lexenv-disabled-package-locks *lexenv*)))
       (process-toplevel-progn forms path compile-time-too))))
 
 ;;; Parse an EVAL-WHEN situations list, returning three flags,
@@ -952,7 +955,8 @@
   (when name
     (legal-fun-name-or-type-error name))
   (let* ((*lexenv* (make-lexenv :policy *policy*
-				:handled-conditions *handled-conditions*))
+				:handled-conditions *handled-conditions*
+				:disabled-package-locks *disabled-package-locks*))
          (fun (make-functional-from-toplevel-lambda lambda-expression
 						    :name name
 						    :path path)))
@@ -1057,11 +1061,9 @@
   (catch 'process-toplevel-form-error-abort
     (let* ((path (or (gethash form *source-paths*) (cons form path)))
 	   (*compiler-error-bailout*
-	    (lambda ()
+	    (lambda (&optional condition)
 	      (convert-and-maybe-compile
-	       `(error 'simple-program-error
-		 :format-control "execution of a form compiled with errors:~% ~S"
-		 :format-arguments (list ',form))
+	       (make-compiler-error-form condition form)
 	       path)
 	      (throw 'process-toplevel-form-error-abort nil))))
 
@@ -1175,8 +1177,9 @@
                      ((macrolet)
                       (funcall-in-macrolet-lexenv
                        magic
-                       (lambda (&key funs)
+                       (lambda (&key funs prepend)
                          (declare (ignore funs))
+			 (aver (null prepend))
                          (process-toplevel-locally body
                                                    path
                                                    compile-time-too))
@@ -1184,7 +1187,8 @@
                      ((symbol-macrolet)
                       (funcall-in-symbol-macrolet-lexenv
                        magic
-                       (lambda (&key vars)
+                       (lambda (&key vars prepend)
+			 (aver (null prepend))
                          (process-toplevel-locally body
                                                    path
                                                    compile-time-too
@@ -1392,6 +1396,7 @@
 
         (*policy* *policy*)
 	(*handled-conditions* *handled-conditions*)
+	(*disabled-package-locks* *disabled-package-locks*)
         (*lexenv* (make-null-lexenv))
         (*block-compile* *block-compile-arg*)
         (*source-info* info)
@@ -1688,11 +1693,9 @@
 	(throw 'pending-init circular-ref)))
     (multiple-value-bind (creation-form init-form)
 	(handler-case
-	    (sb!xc:make-load-form constant (make-null-lexenv))
+            (sb!xc:make-load-form constant (make-null-lexenv))
 	  (error (condition)
-		 (compiler-error "(while making load form for ~S)~%~A"
-				 constant
-				 condition)))
+	    (compiler-error condition)))
       (case creation-form
 	(:sb-just-dump-it-normally
 	 (fasl-validate-structure constant *compile-object*)