(defvar *check-consistency* nil)
(defvar *all-components*)
+;;; Set to NIL to disable loop analysis for register allocation.
+(defvar *loop-analyze* t)
+
;;; Bind this to a stream to capture various internal debugging output.
(defvar *compiler-trace-output* nil)
is intended to be wrapped around the compilation of all files in the same
system. These keywords are defined:
:OVERRIDE Boolean-Form
- One of the effects of this form is to delay undefined warnings
- until the end of the form, instead of giving them at the end of each
- compilation. If OVERRIDE is NIL (the default), then the outermost
- WITH-COMPILATION-UNIT form grabs the undefined warnings. Specifying
- OVERRIDE true causes that form to grab any enclosed warnings, even if
- it is enclosed by another WITH-COMPILATION-UNIT."
+ One of the effects of this form is to delay undefined warnings
+ until the end of the form, instead of giving them at the end of each
+ compilation. If OVERRIDE is NIL (the default), then the outermost
+ WITH-COMPILATION-UNIT form grabs the undefined warnings. Specifying
+ OVERRIDE true causes that form to grab any enclosed warnings, even if
+ it is enclosed by another WITH-COMPILATION-UNIT."
`(%with-compilation-unit (lambda () ,@body) ,@options))
(defun %with-compilation-unit (fn &key override)
(when summary
(if (eq kind :variable)
(compiler-warn
- "~:[This ~(~A~) is~;These ~(~A~)s are~] undefined:~
- ~% ~{~<~% ~1:;~S~>~^ ~}"
+ "~:[This ~(~A~) is~;These ~(~A~)s are~] undefined:~
+ ~% ~{~<~% ~1:;~S~>~^ ~}"
(cdr summary) kind summary)
(compiler-style-warn
- "~:[This ~(~A~) is~;These ~(~A~)s are~] undefined:~
- ~% ~{~<~% ~1:;~S~>~^ ~}"
+ "~:[This ~(~A~) is~;These ~(~A~)s are~] undefined:~
+ ~% ~{~<~% ~1:;~S~>~^ ~}"
(cdr summary) kind summary))))))))
(unless (and (not abort-p)
(maybe-mumble "opt")
(event ir1-optimize-until-done)
(let ((count 0)
- (cleared-reanalyze nil))
+ (cleared-reanalyze nil)
+ (fastp nil))
(loop
(when (component-reanalyze component)
(setq count 0)
(setq cleared-reanalyze t)
(setf (component-reanalyze component) nil))
(setf (component-reoptimize component) nil)
- (ir1-optimize component)
+ (ir1-optimize component fastp)
(cond ((component-reoptimize component)
(incf count)
- (when (= count *max-optimize-iterations*)
+ (when (and (>= count *max-optimize-iterations*)
+ (not (component-reanalyze component))
+ (eq (component-reoptimize component) :maybe))
(maybe-mumble "*")
(cond ((retry-delayed-ir1-transforms :optimize)
(maybe-mumble "+")
(t
(maybe-mumble " ")
(return)))
- (maybe-mumble "."))
+ (setq fastp (>= count *max-optimize-iterations*))
+ (maybe-mumble (if fastp "-" ".")))
(when cleared-reanalyze
(setf (component-reanalyze component) t)))
(values))
(ir1-phases component)
+ (when *loop-analyze*
+ (dfo-as-needed component)
+ (find-dominators component)
+ (loop-analyze component))
+
+ #|
+ (when (and *loop-analyze* *compiler-trace-output*)
+ (labels ((print-blocks (block)
+ (format *compiler-trace-output* " ~A~%" block)
+ (when (block-loop-next block)
+ (print-blocks (block-loop-next block))))
+ (print-loop (loop)
+ (format *compiler-trace-output* "loop=~A~%" loop)
+ (print-blocks (loop-blocks loop))
+ (dolist (l (loop-inferiors loop))
+ (print-loop l))))
+ (print-loop (component-outer-loop component))))
+ |#
+
;; FIXME: What is MAYBE-MUMBLE for? Do we need it any more?
(maybe-mumble "env ")
(physenv-analyze component)
(format t "~4TL~D: ~S~:[~; [closure]~]~%"
(label-id (entry-info-offset entry))
(entry-info-name entry)
- (entry-info-closure-p entry)))
+ (entry-info-closure-tn entry)))
(terpri)
(pre-pack-tn-stats component *standard-output*)
(terpri)
;; 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)))
+ ;; the external format that we'll call OPEN with, if NAME is a file.
+ (external-format nil)
;; the defaulted, but not necessarily absolute file name (i.e. prior
;; to TRUENAME call.) Null if not a file. This is used to set
;; *COMPILE-FILE-PATHNAME*, and if absolute, is dumped in the
(stream nil :type (or stream null)))
;;; Given a pathname, return a SOURCE-INFO structure.
-(defun make-file-source-info (file)
+(defun make-file-source-info (file external-format)
(let ((file-info (make-file-info :name (truename file)
:untruename file
+ :external-format external-format
:write-date (file-write-date file))))
(make-source-info :file-info file-info)))
(declare (type source-info info))
(or (source-info-stream info)
(let* ((file-info (source-info-file-info info))
- (name (file-info-name file-info)))
+ (name (file-info-name file-info))
+ (external-format (file-info-external-format file-info)))
(setf sb!xc:*compile-file-truename* name
sb!xc:*compile-file-pathname* (file-info-untruename file-info)
- (source-info-stream info) (open name :direction :input)))))
+ (source-info-stream info)
+ (open name :direction :input
+ :external-format external-format)))))
;;; Close the stream in INFO if it is open.
(defun close-source-info (info)
;; whole FUNCTIONAL-KIND=:TOPLEVEL case could go away..)
(locall-analyze-clambdas-until-done (list fun))
-
+
(multiple-value-bind (components-from-dfo top-components hairy-top)
(find-initial-dfo (list fun))
+ (declare (ignore hairy-top))
(let ((*all-components* (append components-from-dfo top-components)))
- ;; FIXME: This is more monkey see monkey do based on CMU CL
- ;; code. If anyone figures out why to only prescan HAIRY-TOP
- ;; and TOP-COMPONENTS here, instead of *ALL-COMPONENTS* or
- ;; some other combination of results from FIND-INITIAL-VALUES,
- ;; it'd be good to explain it.
- (mapc #'preallocate-physenvs-for-toplevelish-lambdas hairy-top)
- (mapc #'preallocate-physenvs-for-toplevelish-lambdas top-components)
(dolist (component-from-dfo components-from-dfo)
(compile-component component-from-dfo)
(replace-toplevel-xeps component-from-dfo)))
#!+sb-doc
"Compile INPUT-FILE, producing a corresponding fasl file and returning
its filename. Besides the ANSI &KEY arguments :OUTPUT-FILE, :VERBOSE,
- :PRINT, and :EXTERNAL-FORMAT,the following extensions are supported:
+ :PRINT, and :EXTERNAL-FORMAT, the following extensions are supported:
:TRACE-FILE
If given, internal data structures are dumped to the specified
file, or if a value of T is given, to a file of *.trace type
optimization values, and the :BLOCK-COMPILE argument will probably
become deprecated."
- (unless (eq external-format :default)
- (error "Non-:DEFAULT EXTERNAL-FORMAT values are not supported."))
(let* ((fasl-output nil)
(output-file-name nil)
(compile-won nil)
(warnings-p nil)
(failure-p t) ; T in case error keeps this from being set later
(input-pathname (verify-source-file input-file))
- (source-info (make-file-source-info input-pathname))
+ (source-info (make-file-source-info input-pathname external-format))
(*compiler-trace-output* nil)) ; might be modified below
(unwind-protect
projects / sbcl.git / blobdiff