From 513f06e6c91af7a52c8c037d71386845b1c21a0f Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Mon, 20 Jul 2009 04:26:31 +0000 Subject: [PATCH] 1.0.30.4: cfasl support Experimental support for compiling any toplevel compile-time effects to a separate cfasl file, in addition to evaluating them. * Open a second fasl output stream if :EMIT-CFASL is passed to COMPILE-FILE. In the places where we'd normally evaluate the body of a EVAL-WHEN :COMPILE-TOPLEVEL do both the evaluation and do a normal compilation of the form, with the output going to the second fasl stream. * Fix a couple of places where a %compiler-defun would assume it'd never be called outside the compiler (now it can be called during cfasl loading). * Remove the timestamps from the human-readable fasl header. They're not really useful for anything, and make the cfasls less deterministic and thus less useful. --- NEWS | 3 +++ src/compiler/dump.lisp | 6 ----- src/compiler/ir1tran-lambda.lisp | 50 +++++++++++++++++++------------------- src/compiler/main.lisp | 45 ++++++++++++++++++++++++++++------ version.lisp-expr | 2 +- 5 files changed, 67 insertions(+), 39 deletions(-) diff --git a/NEWS b/NEWS index 5085627..f7630ec 100644 --- a/NEWS +++ b/NEWS @@ -3,6 +3,9 @@ changes relative to sbcl-1.0.30: * improvement: stack allocation is should now be possible in all nested inlining cases: failure to stack allocate when equivalent code is manually open coded is now considered a bug. + * new feature: experimental :EMIT-CFASL parameter to COMPILE-FILE can + be used to output toplevel compile-time effects into a separate .CFASL + file. * bug fix: moderately complex combinations of inline expansions could be miscompiled if the result was declared to be dynamic extent. * bug fix: in some cases no compiler note about failure to stack allocate diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp index fa44379..55b48a1 100644 --- a/src/compiler/dump.lisp +++ b/src/compiler/dump.lisp @@ -318,14 +318,8 @@ (format nil "~% ~ compiled from ~S~% ~ - at ~A~% ~ - on ~A~% ~ using ~A version ~A~%" where - #+sb-xc-host "cross-compile time" - #-sb-xc-host (format-universal-time nil (get-universal-time)) - #+sb-xc-host "cross-compile host" - #-sb-xc-host (machine-instance) (sb!xc:lisp-implementation-type) (sb!xc:lisp-implementation-version)))) stream) diff --git a/src/compiler/ir1tran-lambda.lisp b/src/compiler/ir1tran-lambda.lisp index ab8bd8b..33fd5fd 100644 --- a/src/compiler/ir1tran-lambda.lisp +++ b/src/compiler/ir1tran-lambda.lisp @@ -1078,24 +1078,25 @@ ;;; previous references. (defun get-defined-fun (name) (proclaim-as-fun-name name) - (let ((found (find-free-fun name "shouldn't happen! (defined-fun)"))) - (note-name-defined name :function) - (cond ((not (defined-fun-p found)) - (aver (not (info :function :inlinep name))) - (let* ((where-from (leaf-where-from found)) - (res (make-defined-fun - :%source-name name - :where-from (if (eq where-from :declared) - :declared :defined) - :type (leaf-type found)))) - (substitute-leaf res found) - (setf (gethash name *free-funs*) res))) - ;; If *FREE-FUNS* has a previously converted definition - ;; for this name, then blow it away and try again. - ((defined-fun-functionals found) - (remhash name *free-funs*) - (get-defined-fun name)) - (t found)))) + (when (boundp '*free-funs*) + (let ((found (find-free-fun name "shouldn't happen! (defined-fun)"))) + (note-name-defined name :function) + (cond ((not (defined-fun-p found)) + (aver (not (info :function :inlinep name))) + (let* ((where-from (leaf-where-from found)) + (res (make-defined-fun + :%source-name name + :where-from (if (eq where-from :declared) + :declared :defined) + :type (leaf-type found)))) + (substitute-leaf res found) + (setf (gethash name *free-funs*) res))) + ;; If *FREE-FUNS* has a previously converted definition + ;; for this name, then blow it away and try again. + ((defined-fun-functionals found) + (remhash name *free-funs*) + (get-defined-fun name)) + (t found))))) ;;; Check a new global function definition for consistency with ;;; previous declaration or definition, and assert argument/result @@ -1162,14 +1163,13 @@ (defun %compiler-defun (name lambda-with-lexenv compile-toplevel) (let ((defined-fun nil)) ; will be set below if we're in the compiler (when compile-toplevel - ;; better be in the compiler - (aver (boundp '*lexenv*)) - (remhash name *free-funs*) (setf defined-fun (get-defined-fun name)) - (aver (fasl-output-p *compile-object*)) - (if (member name *fun-names-in-this-file* :test #'equal) - (warn 'duplicate-definition :name name) - (push name *fun-names-in-this-file*))) + (when (boundp '*lexenv*) + (remhash name *free-funs*) + (aver (fasl-output-p *compile-object*)) + (if (member name *fun-names-in-this-file* :test #'equal) + (warn 'duplicate-definition :name name) + (push name *fun-names-in-this-file*)))) (become-defined-fun-name name) diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index 12d9890..df17921 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -114,6 +114,9 @@ (defvar *compile-object* nil) (declaim (type object *compile-object*)) +(defvar *compile-toplevel-object* nil) + +(defvar *emit-cfasl* nil) (defvar *fopcompile-label-counter*) @@ -1199,6 +1202,15 @@ (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. @@ -1278,7 +1290,7 @@ (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 @@ -1324,9 +1336,8 @@ 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 @@ -1683,7 +1694,8 @@ ;; 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. @@ -1709,7 +1721,11 @@ 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 @@ -1726,7 +1742,9 @@ SPEED and COMPILATION-SPEED optimization values, and 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 @@ -1743,6 +1761,13 @@ SPEED and COMPILATION-SPEED optimization values, and the (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)) @@ -1759,7 +1784,8 @@ SPEED and COMPILATION-SPEED optimization values, and the (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)))) @@ -1772,6 +1798,11 @@ SPEED and COMPILATION-SPEED optimization values, and the (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))) diff --git a/version.lisp-expr b/version.lisp-expr index f1151b4..6e8e17b 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.30.3" +"1.0.30.4" -- 1.7.10.4