(in-package "SB!C")
-(file-comment
- "$Header$")
-
;;; FIXME: Doesn't this belong somewhere else, like early-c.lisp?
(declaim (special *constants* *free-variables* *component-being-compiled*
*code-vector* *next-location* *result-fixups*
;;; Mumble conditional on *COMPILE-PROGRESS*.
(defun maybe-mumble (&rest foo)
(when *compile-progress*
- (apply #'compiler-mumble foo)))
+ (compiler-mumble "~&")
+ (pprint-logical-block (*error-output* nil :per-line-prefix "; ")
+ (apply #'compiler-mumble foo))))
(deftype object () '(or fasl-file core-object null))
(zerop *compiler-warning-count*)
(zerop *compiler-style-warning-count*)
(zerop *compiler-note-count*)))
+ (format *error-output* "~&")
+ (pprint-logical-block (*error-output* nil :per-line-prefix "; ")
(compiler-mumble
- "~2&compilation unit ~:[finished~;aborted~]~
+ "compilation unit ~:[finished~;aborted~]~
~[~:;~:*~& caught ~D fatal ERROR condition~:P~]~
~[~:;~:*~& caught ~D ERROR condition~:P~]~
~[~:;~:*~& caught ~D WARNING condition~:P~]~
~[~:;~:*~& caught ~D STYLE-WARNING condition~:P~]~
- ~[~:;~:*~& printed ~D note~:P~]~2%"
+ ~[~:;~:*~& printed ~D note~:P~]"
abort-p
*aborted-compilation-unit-count*
*compiler-error-count*
*compiler-warning-count*
*compiler-style-warning-count*
- *compiler-note-count*)))
+ *compiler-note-count*))))
;;; Evaluate BODY, then return (VALUES BODY-VALUE WARNINGS-P
;;; FAILURE-P), where BODY-VALUE is the first value of the body, and
(return nil)))))))
(when sb!xc:*compile-print*
- (compiler-mumble "~&~:[~;byte ~]compiling ~A: "
+ (compiler-mumble "~&; ~:[~;byte ~]compiling ~A: "
*byte-compiling*
(component-name component)))
(untruename nil :type (or pathname null))
;; The file's write date (if relevant.)
(write-date nil :type (or unsigned-byte null))
- ;; This file's FILE-COMMENT, or NIL if none.
- (comment nil :type (or simple-string null))
;; The source path root number of the first form in this file (i.e. the
;; total number of forms converted previously in this compilation.)
(source-root 0 :type unsigned-byte)
(*default-interface-cookie* (lexenv-interface-cookie *lexenv*)))
(process-top-level-progn forms path))))
-;;; Stash file comment in the FILE-INFO structure.
-(defun process-file-comment (form)
- (unless (and (proper-list-of-length-p form 2)
- (stringp (second form)))
- (compiler-error "bad FILE-COMMENT form: ~S" form))
- (let ((file (first (source-info-current-file *source-info*))))
- (cond ((file-info-comment file)
- (compiler-warning "ignoring extra file comment:~% ~S" form))
- (t
- (let ((comment (coerce (second form) 'simple-string)))
- (setf (file-info-comment file) comment)
- (when sb!xc:*compile-verbose*
- (compiler-mumble "~&FILE-COMMENT: ~A~2&" comment)))))))
-
-;;; Force any pending top-level forms to be compiled and dumped so that they
-;;; will be evaluated in the correct package environment. Dump the form to be
-;;; evaled at (cold) load time, and if EVAL is true, eval the form immediately.
+;;; Force any pending top-level forms to be compiled and dumped so
+;;; that they will be evaluated in the correct package environment.
+;;; Dump the form to be evaled at (cold) load time, and if EVAL is
+;;; true, eval the form immediately.
(defun process-cold-load-form (form path eval)
(let ((object *compile-object*))
(etypecase object
(process-top-level-progn (cddr form) path))))
(locally (process-top-level-locally form path))
(progn (process-top-level-progn (cdr form) path))
- (file-comment (process-file-comment form))
(t
(let* ((uform (uncross form))
(exp (preprocessor-macroexpand uform)))
;;;
;;; Otherwise, we bind *CONSTANTS-BEING-CREATED* and
;;; *CONSTANTS-CREATED-SINCE- LAST-INIT* and compile the creation form
-;;; a la LOAD-TIME-VALUE. When this finishes, we tell the dumper to
-;;; use that result instead whenever it sees this constant.
+;;; much the way LOAD-TIME-VALUE does. When this finishes, we tell the
+;;; dumper to use that result instead whenever it sees this constant.
;;;
;;; Now we try to compile the init form. We bind
;;; *CONSTANTS-CREATED-SINCE- LAST-INIT* to NIL and compile the init
#+nil (*compiler-style-warning-count* 0)
#+nil (*compiler-note-count* 0)
(*block-compile* *block-compile-argument*)
- (*package* *package*)
- (*initial-package* *package*)
+ (*package* (sane-package))
+ (*initial-package* (sane-package))
(*initial-cookie* *default-cookie*)
(*initial-interface-cookie* *default-interface-cookie*)
(*default-cookie* (copy-cookie *initial-cookie*))
(*top-level-lambdas* ())
(*pending-top-level-lambdas* ())
(*compiler-error-bailout*
- #'(lambda ()
- (compiler-mumble
- "~2&fatal error, aborting compilation~%")
- (return-from sub-compile-file (values nil t t))))
+ (lambda ()
+ (compiler-mumble "~2&; fatal error, aborting compilation~%")
+ (return-from sub-compile-file (values nil t t))))
(*current-path* nil)
(*last-source-context* nil)
(*last-original-source* nil)
(defun start-error-output (source-info)
(declare (type source-info source-info))
(dolist (x (source-info-files source-info))
- (compiler-mumble "compiling file ~S (written ~A):~%"
+ (compiler-mumble "~&; compiling file ~S (written ~A):~%"
(namestring (file-info-name x))
(sb!int:format-universal-time nil
(file-info-write-date x)
:style :government
:print-weekday nil
:print-timezone nil)))
- (compiler-mumble "~%")
(values))
+
(defun finish-error-output (source-info won)
(declare (type source-info source-info))
- (compiler-mumble "~&compilation ~:[aborted after~;finished in~] ~A~&"
+ (compiler-mumble "~&; compilation ~:[aborted after~;finished in~] ~A~&"
won
(elapsed-time-to-string
(- (get-universal-time)
(close-fasl-file fasl-file (not compile-won))
(setq output-file-name (pathname (fasl-file-stream fasl-file)))
(when (and compile-won sb!xc:*compile-verbose*)
- (compiler-mumble "~2&~A written~%" (namestring output-file-name))))
+ (compiler-mumble "~2&; ~A written~%" (namestring output-file-name))))
(when sb!xc:*compile-verbose*
(finish-error-output source-info compile-won)))
projects / sbcl.git / blobdiff