(defvar *compile-object* nil)
(declaim (type object *compile-object*))
+(defvar *compile-toplevel-object* nil)
+
+(defvar *emit-cfasl* nil)
(defvar *fopcompile-label-counter*)
(defun %compile-component (component)
(let ((*code-segment* nil)
- (*elsewhere* nil))
+ (*elsewhere* nil)
+ #!+inline-constants
+ (*constant-segment* nil)
+ #!+inline-constants
+ (*constant-table* nil)
+ #!+inline-constants
+ (*constant-vector* nil))
(maybe-mumble "GTN ")
(gtn-analyze component)
(maybe-mumble "LTN ")
(print-unreadable-object (s stream :type t))))
(:copier nil))
;; the UT that compilation started at
- (start-time (get-internal-real) :type unsigned-byte)
+ (start-time (get-universal-time) :type unsigned-byte)
;; the IRT that compilation started at
(start-real-time (get-internal-real-time) :type unsigned-byte)
;; the FILE-INFO structure for this compilation
(t
*top-level-form-noted*))))
+;;; Handle the evaluation the a :COMPILE-TOPLEVEL body during
+;;; compilation. Normally just evaluate in the appropriate
+;;; environment, but also compile if outputting a CFASL.
+(defun eval-compile-toplevel (body path)
+ (eval-in-lexenv `(progn ,@body) *lexenv*)
+ (when *compile-toplevel-object*
+ (let ((*compile-object* *compile-toplevel-object*))
+ (convert-and-maybe-compile `(progn ,@body) path))))
+
;;; Process a top level FORM with the specified source PATH.
;;; * If this is a magic top level form, then do stuff.
;;; * If this is a macro, then expand it.
(let ((expanded (preprocessor-macroexpand-1 form)))
(cond ((eq expanded form)
(when compile-time-too
- (eval-in-lexenv form *lexenv*))
+ (eval-compile-toplevel (list form) path))
(convert-and-maybe-compile form path))
(t
(process-toplevel-form expanded
e))))
(cond (lt (process-toplevel-progn
body path new-compile-time-too))
- (new-compile-time-too (eval-in-lexenv
- `(progn ,@body)
- *lexenv*))))))
+ (new-compile-time-too
+ (eval-compile-toplevel body path))))))
((macrolet)
(funcall-in-macrolet-lexenv
magic
;; extensions
(trace-file nil)
- ((:block-compile *block-compile-arg*) nil))
+ ((:block-compile *block-compile-arg*) nil)
+ (emit-cfasl *emit-cfasl*))
#!+sb-doc
"Compile INPUT-FILE, producing a corresponding fasl file and
returning its filename.
: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
- derived from the input file name. (non-standard)"
+ derived from the input file name. (non-standard)
+
+ :EMIT-CFASL
+ (Experimental). If true, outputs the toplevel compile-time effects
+ of this file into a separate .cfasl file."
;;; Block compilation is currently broken.
#|
"Also, as a workaround for vaguely-non-ANSI behavior, the
:BLOCK-COMPILE argument will probably become deprecated."
|#
(let* ((fasl-output nil)
+ (cfasl-output nil)
(output-file-name nil)
+ (coutput-file-name nil)
(abort-p t)
(warnings-p nil)
(failure-p t) ; T in case error keeps this from being set later
(setq fasl-output
(open-fasl-output output-file-name
(namestring input-pathname))))
+ (when emit-cfasl
+ (setq coutput-file-name
+ (make-pathname :type "cfasl"
+ :defaults output-file-name))
+ (setq cfasl-output
+ (open-fasl-output coutput-file-name
+ (namestring input-pathname))))
(when trace-file
(let* ((default-trace-file-pathname
(make-pathname :type "trace" :defaults input-pathname))
(when sb!xc:*compile-verbose*
(print-compile-start-note source-info))
- (let ((*compile-object* fasl-output))
+ (let ((*compile-object* fasl-output)
+ (*compile-toplevel-object* cfasl-output))
(setf (values abort-p warnings-p failure-p)
(sub-compile-file source-info))))
(when (and (not abort-p) sb!xc:*compile-verbose*)
(compiler-mumble "~2&; ~A written~%" (namestring output-file-name))))
+ (when cfasl-output
+ (close-fasl-output cfasl-output abort-p)
+ (when (and (not abort-p) sb!xc:*compile-verbose*)
+ (compiler-mumble "; ~A written~%" (namestring coutput-file-name))))
+
(when sb!xc:*compile-verbose*
(print-compile-end-note source-info (not abort-p)))