Menu
▾
▴
Re: [Sbcl-devel] [Sbcl-commits] master: (Re)implement block compilation!
|
From: Stas B. <sta...@gm...> - 2020-01-22 20:22:09
|
And this is because it moves with-ir1-namespace.
On Wed, Jan 22, 2020 at 11:17 PM Stas Boukarev <sta...@gm...> wrote:
>
> This breaks compiling
> (progn
> (defmethod f (x) #1=#.(gensym))
> (defvar #1#)
> (defmethod x (x) (setq #1# 10)))
>
> it can't terminate because the free-var from the first method is
> leaking into the second, making the SETQ ir1-translator transform into
> SET, SET sees (info :variable :kind symbol) as being :special,
> transforms back into SETQ.
>
> On Tue, Jan 14, 2020 at 7:29 AM apache--- via Sbcl-commits
> <sbc...@li...> wrote:
> >
> > The branch "master" has been updated in SBCL:
> > via 766bdc97c04aab84bd440b8ac30dad7a37b46c49 (commit)
> > from d8e91b8c602217d98d39b898822793f04ce16d82 (commit)
> >
> > - Log -----------------------------------------------------------------
> > commit 766bdc97c04aab84bd440b8ac30dad7a37b46c49
> > Author: Charles Zhang <cha...@ya...>
> > Date: Mon Jan 13 20:18:56 2020 -0800
> >
> > (Re)implement block compilation!
> >
> > CMUCL-style block compilation, sans the BLOCK-START BLOCK-END
> > proclamation magic. Removed some asserted invariants along the lines
> > of components never having more than one toplevel lambda tree, that
> > is, ones which would be true if block compilation hadn't
> > existed. Ironic, given the entire compiler is structured around this
> > concept.
> >
> > Since the %defun translator went away, we devise a new method using
> > NAMED-LAMBDA to interface block compilation with IR1 conversion.
> >
> > Some subtleties remain, such as interaction with function
> > proclamations such as inlining and source information.
> > ---
> > package-data-list.lisp-expr | 3 +
> > src/code/defboot.lisp | 16 +++-
> > src/compiler/debug-dump.lisp | 3 +-
> > src/compiler/early-c.lisp | 12 ++-
> > src/compiler/fndb.lisp | 2 +
> > src/compiler/info-functions.lisp | 3 +-
> > src/compiler/ir1tran-lambda.lisp | 36 ++++++--
> > src/compiler/ir1tran.lisp | 11 +--
> > src/compiler/ir1util.lisp | 6 ++
> > src/compiler/locall.lisp | 43 +++-------
> > src/compiler/main.lisp | 181 +++++++++++++++++++++------------------
> > src/compiler/target-main.lisp | 3 +-
> > 12 files changed, 180 insertions(+), 139 deletions(-)
> >
> > diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
> > index 3c9a13eb6..1be8b3f29 100644
> > --- a/package-data-list.lisp-expr
> > +++ b/package-data-list.lisp-expr
> > @@ -740,6 +740,9 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*."
> > ;; hairy compiles.
> > "*COMPILE-PROGRESS*"
> >
> > + ;; The default behavior for block compilation.
> > + "*BLOCK-COMPILE-DEFAULT*"
> > +
> > ;; It can be handy to be able to evaluate expressions involving
> > ;; the thing under examination by CL:INSPECT.
> > "*INSPECTED*"
> > diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp
> > index 55ed748d2..1f1f5a29f 100644
> > --- a/src/code/defboot.lisp
> > +++ b/src/code/defboot.lisp
> > @@ -264,9 +264,13 @@ evaluated as a PROGN."
> > `(progn
> > (eval-when (:compile-toplevel)
> > (sb-c:%compiler-defun ',name t ,inline-thing ,extra-info))
> > - (%defun ',name ,named-lambda
> > - ,@(when (or inline-thing extra-info) `(,inline-thing))
> > - ,@(when extra-info `(,extra-info)))
> > + ,(if (sb-c::block-compilation-non-entry-point name)
> > + `(progn
> > + ,named-lambda
> > + ',name)
> > + `(%defun ',name ,named-lambda
> > + ,@(when (or inline-thing extra-info) `(,inline-thing))
> > + ,@(when extra-info `(,extra-info))))
> > ;; This warning, if produced, comes after the DEFUN happens.
> > ;; When compiling, there's no real difference, but when interpreting,
> > ;; if there is a handler for style-warning that nonlocally exits,
> > @@ -277,6 +281,12 @@ evaluated as a PROGN."
> > (sb-c::warn-if-setf-macro ',name))
> > ',name)))))))
> >
> > +;;; This is one of the major places where the semantics of block
> > +;;; compilation is handled. Substitution for global names is totally
> > +;;; inhibited if (block-compile *compilation*) is NIL. And if
> > +;;; (block-compile *compilation*) is true and entry points are
> > +;;; specified, then we don't install global definitions for non-entry
> > +;;; functions (effectively turning them into local lexical functions.)
> > (sb-xc:defmacro defun (&environment env name lambda-list &body body)
> > "Define a function at top level."
> > (check-designator name defun)
> > diff --git a/src/compiler/debug-dump.lisp b/src/compiler/debug-dump.lisp
> > index 8c52ac186..9ed12786f 100644
> > --- a/src/compiler/debug-dump.lisp
> > +++ b/src/compiler/debug-dump.lisp
> > @@ -739,7 +739,8 @@
> > (let ((tlf-num (source-path-tlf-number
> > (node-source-path (lambda-bind lambda)))))
> > (if component-tlf-num
> > - (aver (= component-tlf-num tlf-num))
> > + (aver (or (block-compile *compilation*)
> > + (= component-tlf-num tlf-num)))
> > (setf component-tlf-num tlf-num))
> > (push (compute-1-debug-fun lambda var-locs) dfuns)))
> > (let* ((sorted (sort dfuns #'< :key #'compiled-debug-fun-offset))
> > diff --git a/src/compiler/early-c.lisp b/src/compiler/early-c.lisp
> > index cbed36df8..56be0042b 100644
> > --- a/src/compiler/early-c.lisp
> > +++ b/src/compiler/early-c.lisp
> > @@ -359,11 +359,15 @@ the stack without triggering overflow protection.")
> > (sset-counter 1 :type fixnum)
> > ;; if emitting a cfasl, the fasl stream to that
> > (compile-toplevel-object nil :read-only t)
> > - ;; these are all historical baggage from here down,
> > - ;; unused unless we ever decide to fix block compilation
> > + ;; The current block compilation state. These are initialized to
> > + ;; the :Block-Compile and :Entry-Points arguments that COMPILE-FILE
> > + ;; was called with. Subsequent START-BLOCK or END-BLOCK
> > + ;; declarations alter the values.
> > (block-compile nil :type (member nil t :specified))
> > - ;; When block compiling, used by PROCESS-FORM to accumulate top level
> > - ;; lambdas resulting from compiling subforms. (In reverse order.)
> > + (entry-points nil :type list)
> > + ;; When block compiling, used by PROCESS-FORM to accumulate top
> > + ;; level lambdas resulting from compiling subforms. (In reverse
> > + ;; order.)
> > (toplevel-lambdas nil :type list)
> >
> > ;; Bidrectional map between IR1/IR2/assembler abstractions and a corresponding
> > diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
> > index 302ae42b0..0f65ab5f9 100644
> > --- a/src/compiler/fndb.lisp
> > +++ b/src/compiler/fndb.lisp
> > @@ -1662,10 +1662,12 @@
> > (:verbose t)
> > (:print t)
> > (:external-format external-format-designator)
> > + (:progress t)
> >
> > ;; extensions
> > (:trace-file t)
> > (:block-compile t)
> > + (:entry-points list)
> > (:emit-cfasl t))
> > (values (or pathname null) boolean boolean))
> >
> > diff --git a/src/compiler/info-functions.lisp b/src/compiler/info-functions.lisp
> > index 21afb0d7b..1c04d7cc4 100644
> > --- a/src/compiler/info-functions.lisp
> > +++ b/src/compiler/info-functions.lisp
> > @@ -89,7 +89,8 @@
> > ;; case it's reasonable style. Either way, NAME is no longer a free
> > ;; function.)
> > (when (boundp '*ir1-namespace*) ; when compiling
> > - (remhash name (free-funs *ir1-namespace*)))
> > + (unless (block-compile *compilation*)
> > + (remhash name (free-funs *ir1-namespace*))))
> >
> > (values))
> >
> > diff --git a/src/compiler/ir1tran-lambda.lisp b/src/compiler/ir1tran-lambda.lisp
> > index a0667a412..88b8dbade 100644
> > --- a/src/compiler/ir1tran-lambda.lisp
> > +++ b/src/compiler/ir1tran-lambda.lisp
> > @@ -1019,6 +1019,14 @@
> > ((typep expr '(or (cons (eql declare)) string))) ; DECL | DOCSTRING
> > (t (return nil)))))
> >
> > +(defun block-compilation-non-entry-point (name)
> > + (and (boundp 'sb-c::*compilation*)
> > + (let* ((compilation sb-c::*compilation*)
> > + (entry-points (sb-c::entry-points compilation)))
> > + (and (sb-c::block-compile compilation)
> > + entry-points
> > + (not (member name entry-points :test #'equal))))))
> > +
> > ;;; helper for LAMBDA-like things, to massage them into a form
> > ;;; suitable for IR1-CONVERT-LAMBDA.
> > (defun ir1-convert-lambdalike (thing
> > @@ -1044,6 +1052,8 @@
> > (info (info :function :info name)))
> > (when (has-toplevelness-decl lambda-expression)
> > (setf (functional-top-level-defun-p res) t))
> > + ;; FIXME: Should non-entry block compiled defuns have
> > + ;; this propagate?
> > (assert-global-function-definition-type name res)
> > (push res (defined-fun-functionals defined-fun-res))
> > (unless (or
> > @@ -1059,11 +1069,18 @@
> > (fun-info-ltn-annotate info)
> > (fun-info-ir2-convert info)
> > (fun-info-optimizer info))))
> > - (substitute-leaf-if
> > - (lambda (ref)
> > - (policy ref (> recognize-self-calls 0)))
> > - res defined-fun-res))
> > - res)
> > + (if (block-compile *compilation*)
> > + (substitute-leaf res defined-fun-res)
> > + (substitute-leaf-if
> > + (lambda (ref)
> > + (policy ref (> recognize-self-calls 0)))
> > + res defined-fun-res)))
> > + (if (and (functional-top-level-defun-p res)
> > + (block-compilation-non-entry-point name))
> > + ;; Insert an empty lambda to get flushed instead, so
> > + ;; we don't confuse locall with a stray ref.
> > + (ir1-convert-lambda '(lambda ()))
> > + res))
> > (ir1-convert-lambda lambda-expression
> > :maybe-add-debug-catch t
> > :debug-name
> > @@ -1167,7 +1184,8 @@
> > ;;; previous references.
> > (defun get-defined-fun (name &optional (lambda-list nil lp))
> > (proclaim-as-fun-name name)
> > - (when (boundp '*ir1-namespace*)
> > + (when #+sb-xc-host (not *compile-time-eval*)
> > + #-sb-xc-host (boundp '*ir1-namespace*)
> > (let ((found (find-free-fun name "shouldn't happen! (defined-fun)"))
> > (free-funs (free-funs *ir1-namespace*)))
> > (note-name-defined name :function)
> > @@ -1368,9 +1386,9 @@ is potentially harmful to any already-compiled callers using (SAFETY 0)."
> >
> > (become-defined-fun-name name)
> >
> > - ;; old CMU CL comment:
> > - ;; If there is a type from a previous definition, blast it,
> > - ;; since it is obsolete.
> > + ;;
> > + ;; If there is a type from a previous definition, blast it, since it is
> > + ;; obsolete.
> > (when (and defined-fun (neq :declared (leaf-where-from defined-fun)))
> > (setf (leaf-type defined-fun)
> > ;; FIXME: If this is a block compilation thing, shouldn't
> > diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
> > index 6bdc9e2e5..acc0e7958 100644
> > --- a/src/compiler/ir1tran.lisp
> > +++ b/src/compiler/ir1tran.lisp
> > @@ -597,26 +597,17 @@
> > (values)))
> >
> > ;;; Add FUNCTIONAL to the COMPONENT-REANALYZE-FUNCTIONALS, unless it's
> > -;;; some trivial type for which reanalysis is a trivial no-op, or
> > -;;; unless it doesn't belong in this component at all.
> > +;;; some trivial type for which reanalysis is a trivial no-op.
> > ;;;
> > ;;; FUNCTIONAL is returned.
> > (defun maybe-reanalyze-functional (functional)
> > -
> > (aver (not (eql (functional-kind functional) :deleted))) ; bug 148
> > (aver-live-component *current-component*)
> > -
> > ;; When FUNCTIONAL is of a type for which reanalysis isn't a trivial
> > ;; no-op
> > (when (typep functional '(or optional-dispatch clambda))
> > -
> > - ;; When FUNCTIONAL knows its component
> > - (when (lambda-p functional)
> > - (aver (eql (lambda-component functional) *current-component*)))
> > -
> > (pushnew functional
> > (component-reanalyze-functionals *current-component*)))
> > -
> > functional)
> >
> > ;;; Generate a REF node for LEAF, frobbing the LEAF structure as
> > diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
> > index 0b2c92813..329123148 100644
> > --- a/src/compiler/ir1util.lisp
> > +++ b/src/compiler/ir1util.lisp
> > @@ -1780,6 +1780,12 @@
> > ;;; environment and is in the current component.
> > (defun defined-fun-functional (defined-fun)
> > (let ((functionals (defined-fun-functionals defined-fun)))
> > + ;; FIXME: If we are block compiling, forget about finding the
> > + ;; right functional. Just pick the first one we see and hope
> > + ;; people don't mix inlined functions and policy with block
> > + ;; compiling. (For now)
> > + (when (block-compile *compilation*)
> > + (return-from defined-fun-functional (first functionals)))
> > (when functionals
> > (let* ((sample (car functionals))
> > (there (lambda-parent (if (lambda-p sample)
> > diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp
> > index 76beac273..b1323eabd 100644
> > --- a/src/compiler/locall.lisp
> > +++ b/src/compiler/locall.lisp
> > @@ -363,37 +363,22 @@
> > (declare (type component component))
> > (aver-live-component component)
> > (loop
> > - (let* ((new-functional (pop (component-new-functionals component)))
> > - (functional (or new-functional
> > - (pop (component-reanalyze-functionals component)))))
> > - (unless functional
> > + (let* ((new (pop (component-new-functionals component)))
> > + (fun (or new (pop (component-reanalyze-functionals component)))))
> > + (unless fun
> > (return))
> > - (let ((kind (functional-kind functional)))
> > - (cond ((or (functional-somewhat-letlike-p functional)
> > - (memq kind '(:deleted :zombie)))
> > - (values)) ; nothing to do
> > - ((and (null (leaf-refs functional)) (eq kind nil)
> > - (not (functional-entry-fun functional)))
> > - (delete-functional functional))
> > + (let ((kind (functional-kind fun)))
> > + (cond ((or (functional-somewhat-letlike-p fun)
> > + (memq kind '(:deleted :zombie))))
> > + ((and (null (leaf-refs fun)) (eq kind nil)
> > + (not (functional-entry-fun fun)))
> > + (delete-functional fun))
> > (t
> > - ;; Fix/check FUNCTIONAL's relationship to COMPONENT-LAMDBAS.
> > - (cond ((not (lambda-p functional))
> > - ;; Since FUNCTIONAL isn't a LAMBDA, this doesn't
> > - ;; apply: no-op.
> > - (values))
> > - (new-functional ; FUNCTIONAL came from
> > - ; NEW-FUNCTIONALS, hence is new.
> > - ;; FUNCTIONAL becomes part of COMPONENT-LAMBDAS now.
> > - (aver (not (member functional
> > - (component-lambdas component))))
> > - (push functional (component-lambdas component)))
> > - (t ; FUNCTIONAL is old.
> > - ;; FUNCTIONAL should be in COMPONENT-LAMBDAS already.
> > - (aver (member functional (component-lambdas
> > - component)))))
> > - (locall-analyze-fun-1 functional)
> > - (when (lambda-p functional)
> > - (maybe-let-convert functional component)))))))
> > + (when (and new (lambda-p fun))
> > + (push fun (component-lambdas component)))
> > + (locall-analyze-fun-1 fun)
> > + (when (lambda-p fun)
> > + (maybe-let-convert fun component)))))))
> > (values))
> >
> > (defun locall-analyze-clambdas-until-done (clambdas)
> > diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
> > index d2d752646..9f5ee9aac 100644
> > --- a/src/compiler/main.lisp
> > +++ b/src/compiler/main.lisp
> > @@ -13,15 +13,23 @@
> >
> > (in-package "SB-C")
> >
> > +(defvar *block-compile-default* nil
> > + "The default value for the :Block-Compile argument to COMPILE-FILE.")
> > +
> > +;;; *BLOCK-COMPILE-ARGUMENT* holds the original value of the :BLOCK-COMPILE
> > +;;; argument, which overrides any internal declarations.
> > +(defvar *block-compile-argument*)
> > +(declaim (type (member nil t :specified)
> > + *block-compile-default* *block-compile-argument*))
> > +;;; Ditto.
> > +(defvar *entry-points-argument*)
> > +(declaim (type list *entry-points-argument*))
> > +
> > (defvar *check-consistency* nil)
> >
> > ;;; Set to NIL to disable loop analysis for register allocation.
> > (defvar *loop-analyze* t)
> >
> > -;;; *BLOCK-COMPILE-ARG* holds the original value of the :BLOCK-COMPILE
> > -;;; argument, which overrides any internal declarations.
> > -(defvar *block-compile-arg*)
> > -
> > ;;; The current non-macroexpanded toplevel form as printed when
> > ;;; *compile-print* is true.
> > ;;; FIXME: should probably have no value outside the compiler.
> > @@ -395,7 +403,7 @@ necessary, since type inference may take arbitrarily long to converge.")
> > ;;; next optimization attempt from pounding on the same code.
> > (defun ir1-optimize-until-done (component)
> > (declare (type component component))
> > - (maybe-mumble "opt")
> > + (maybe-mumble "Opt")
> > (event ir1-optimize-until-done)
> > (let ((count 0)
> > (cleared-reanalyze nil)
> > @@ -1090,22 +1098,22 @@ necessary, since type inference may take arbitrarily long to converge.")
> > (when (and form (or (symbolp form) (consp form)))
> > (if (and #-sb-xc-host
> > (policy *policy*
> > - ;; FOP-compiled code is harder do debug.
> > + ;; FOP-compiled code is harder to debug.
> > (or (< debug 2)
> > (> space debug)))
> > + (not (block-compile *compilation*))
> > (fopcompilable-p form expand))
> > (let ((*fopcompile-label-counter* 0))
> > (fopcompile form path nil expand))
> > - (with-ir1-namespace
> > - (let ((*lexenv* (make-lexenv
> > - :policy *policy*
> > - :handled-conditions *handled-conditions*
> > - :disabled-package-locks *disabled-package-locks*))
> > - (tll (ir1-toplevel form path nil)))
> > - (if (eq (block-compile *compilation*) t)
> > - (push tll (toplevel-lambdas *compilation*))
> > - (compile-toplevel (list tll) nil))
> > - nil))))))
> > + (let ((*lexenv* (make-lexenv
> > + :policy *policy*
> > + :handled-conditions *handled-conditions*
> > + :disabled-package-locks *disabled-package-locks*))
> > + (tll (ir1-toplevel form path nil)))
> > + (if (eq (block-compile *compilation*) t)
> > + (push tll (toplevel-lambdas *compilation*))
> > + (compile-toplevel (list tll) nil))
> > + nil)))))
> >
> > ;;; Macroexpand FORM in the current environment with an error handler.
> > ;;; We only expand one level, so that we retain all the intervening
> > @@ -1142,37 +1150,36 @@ necessary, since type inference may take arbitrarily long to converge.")
> > (defun process-toplevel-locally (body path compile-time-too &key vars funs)
> > (declare (list path))
> > (multiple-value-bind (forms decls) (parse-body body nil t)
> > - (with-ir1-namespace
> > - (let* ((*lexenv* (process-decls decls vars funs))
> > - ;; FIXME: VALUES declaration
> > - ;;
> > - ;; Binding *POLICY* is pretty much of a hack, since it
> > - ;; causes LOCALLY to "capture" enclosed proclamations. It
> > - ;; is necessary because CONVERT-AND-MAYBE-COMPILE uses the
> > - ;; value of *POLICY* as the policy. The need for this hack
> > - ;; is due to the quirk that there is no way to represent in
> > - ;; a POLICY that an optimize quality came from the default.
> > - ;;
> > - ;; FIXME: Ideally, something should be done so that DECLAIM
> > - ;; inside LOCALLY works OK. Failing that, at least we could
> > - ;; issue a warning instead of silently screwing up.
> > - ;; Here's how to fix this: a POLICY object can in fact represent
> > - ;; absence of qualitities. Whenever we rebind *POLICY* (here and
> > - ;; elsewhere), it should be bound to a policy that expresses no
> > - ;; qualities. Proclamations should update SYMBOL-GLOBAL-VALUE of
> > - ;; *POLICY*, which can be seen irrespective of dynamic bindings,
> > - ;; and declarations should update the lexical policy.
> > - ;; The POLICY macro can be amended to merge the dynamic *POLICY*
> > - ;; (or whatever it came from, like a LEXENV) with the global
> > - ;; *POLICY*. COERCE-TO-POLICY can do the merge, employing a 1-line
> > - ;; cache so that repeated calls for any two fixed policy objects
> > - ;; return the identical value (since policies are immutable).
> > - (*policy* (lexenv-policy *lexenv*))
> > - ;; This is probably also a hack
> > - (*handled-conditions* (lexenv-handled-conditions *lexenv*))
> > - ;; ditto
> > - (*disabled-package-locks* (lexenv-disabled-package-locks *lexenv*)))
> > - (process-toplevel-progn forms path compile-time-too)))))
> > + (let* ((*lexenv* (process-decls decls vars funs))
> > + ;; FIXME: VALUES declaration
> > + ;;
> > + ;; Binding *POLICY* is pretty much of a hack, since it
> > + ;; causes LOCALLY to "capture" enclosed proclamations. It
> > + ;; is necessary because CONVERT-AND-MAYBE-COMPILE uses the
> > + ;; value of *POLICY* as the policy. The need for this hack
> > + ;; is due to the quirk that there is no way to represent in
> > + ;; a POLICY that an optimize quality came from the default.
> > + ;;
> > + ;; FIXME: Ideally, something should be done so that DECLAIM
> > + ;; inside LOCALLY works OK. Failing that, at least we could
> > + ;; issue a warning instead of silently screwing up.
> > + ;; Here's how to fix this: a POLICY object can in fact represent
> > + ;; absence of qualitities. Whenever we rebind *POLICY* (here and
> > + ;; elsewhere), it should be bound to a policy that expresses no
> > + ;; qualities. Proclamations should update SYMBOL-GLOBAL-VALUE of
> > + ;; *POLICY*, which can be seen irrespective of dynamic bindings,
> > + ;; and declarations should update the lexical policy.
> > + ;; The POLICY macro can be amended to merge the dynamic *POLICY*
> > + ;; (or whatever it came from, like a LEXENV) with the global
> > + ;; *POLICY*. COERCE-TO-POLICY can do the merge, employing a 1-line
> > + ;; cache so that repeated calls for any two fixed policy objects
> > + ;; return the identical value (since policies are immutable).
> > + (*policy* (lexenv-policy *lexenv*))
> > + ;; This is probably also a hack
> > + (*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,
> > ;;; (VALUES COMPILE-TOPLEVEL LOAD-TOPLEVEL EXECUTE), indicating
> > @@ -1319,8 +1326,8 @@ necessary, since type inference may take arbitrarily long to converge.")
> > #+sb-xc-host (error "Can't compile to core")
> > #-sb-xc-host
> > (let ((store-source
> > - (policy (lambda-bind fun)
> > - (> store-source-form 0))))
> > + (policy (lambda-bind fun)
> > + (> store-source-form 0))))
> > (fix-core-source-info *source-info* object
> > (and store-source result))))
> > (mapc #'clear-ir1-info components-from-dfo)
> > @@ -1614,9 +1621,15 @@ necessary, since type inference may take arbitrarily long to converge.")
> > (when sb-xc:*compile-print*
> > (compiler-mumble "~&; block compiling converted top level forms..."))
> > (when (toplevel-lambdas *compilation*)
> > - (compile-toplevel (nreverse (toplevel-lambdas *compilation*)) nil)
> > + ;; FIXME: Use the source information from the initial
> > + ;; conversion. CMUCL does this right.
> > + (with-source-paths
> > + (compile-toplevel (nreverse (toplevel-lambdas *compilation*)) nil))
> > (setf (toplevel-lambdas *compilation*) nil))
> > - (setf (block-compile *compilation*) nil)))
> > + ;; CMUCL always reverts this to :SPECIFIED. But we probably want
> > + ;; to restore it to the user default.
> > + (setf (block-compile *compilation*) *block-compile-default*)
> > + (setf (entry-points *compilation*) nil)))
> >
> > (declaim (ftype function handle-condition-p))
> > (flet ((get-handled-conditions ()
> > @@ -1690,7 +1703,8 @@ necessary, since type inference may take arbitrarily long to converge.")
> > ;; *or* code for another image which is sanitized.
> > ;; And we can also cross-compile assuming msan.
> > :msan-unpoison (member :msan sb-xc:*features*)
> > - :block-compile *block-compile-arg*
> > + :block-compile *block-compile-argument*
> > + :entry-points *entry-points-argument*
> > :compile-toplevel-object cfasl))
> >
> > (*handled-conditions* *handled-conditions*)
> > @@ -1710,15 +1724,17 @@ necessary, since type inference may take arbitrarily long to converge.")
> > (with-world-lock ()
> > (setf (sb-fasl::fasl-output-source-info *compile-object*)
> > (debug-source-for-info info))
> > - (do-forms-from-info ((form current-index) info
> > - 'input-error-in-compile-file)
> > - (with-source-paths
> > - (find-source-paths form current-index)
> > - (let ((sb-xc:*gensym-counter* 0))
> > - (process-toplevel-form
> > - form `(original-source-start 0 ,current-index) nil))))
> > - (let ((*source-info* info))
> > - (process-queued-tlfs))
> > + (with-ir1-namespace
> > + (do-forms-from-info ((form current-index) info
> > + 'input-error-in-compile-file)
> > + (with-source-paths
> > + (find-source-paths form current-index)
> > + (let ((sb-xc:*gensym-counter* 0))
> > + (process-toplevel-form
> > + form `(original-source-start 0 ,current-index) nil))))
> > + (let ((*source-info* info))
> > + (finish-block-compilation)
> > + (process-queued-tlfs)))
> > (let ((code-coverage-records
> > (code-coverage-records (coverage-metadata *compilation*))))
> > (unless (zerop (hash-table-count code-coverage-records))
> > @@ -1734,7 +1750,6 @@ necessary, since type inference may take arbitrarily long to converge.")
> > list))
> > nil
> > nil))))
> > - (finish-block-compilation)
> > nil))))
> > ;; Some errors are sufficiently bewildering that we just fail
> > ;; immediately, without trying to recover and compile more of
> > @@ -1815,11 +1830,14 @@ necessary, since type inference may take arbitrarily long to converge.")
> > ;; function..
> > ((:verbose sb-xc:*compile-verbose*) sb-xc:*compile-verbose*)
> > ((:print sb-xc:*compile-print*) sb-xc:*compile-print*)
> > + ((:progress *compile-progress*) *compile-progress*)
> > (external-format :default)
> >
> > ;; extensions
> > (trace-file nil)
> > - ((:block-compile *block-compile-arg*) nil)
> > + ((:block-compile *block-compile-argument*)
> > + *block-compile-default*)
> > + ((:entry-points *entry-points-argument*) nil)
> > (emit-cfasl *emit-cfasl*))
> > "Compile INPUT-FILE, producing a corresponding fasl file and
> > returning its filename.
> > @@ -1838,9 +1856,25 @@ returning its filename.
> >
> > Both forms of reporting obey the SB-EXT:*COMPILER-PRINT-VARIABLE-ALIST*.
> >
> > - :BLOCK-COMPILE
> > - Though COMPILE-FILE accepts an additional :BLOCK-COMPILE
> > - argument, it is not currently supported. (non-standard)
> > + :BLOCK-COMPILE {NIL | :SPECIFIED | T}
> > + Determines whether multiple functions are compiled together as a unit,
> > + resolving function references at compile time. NIL means that global
> > + function names are never resolved at compilation time. :SPECIFIED means
> > + that names are resolved at compile-time when convenient (as in a
> > + self-recursive call), but the compiler doesn't combine top-level DEFUNs.
> > + With :SPECIFIED, an explicit START-BLOCK declaration will enable block
> > + compilation. A value of T indicates that all forms in the file(s) should
> > + be compiled as a unit. The default is the value of
> > + SB-EXT:*BLOCK-COMPILE-DEFAULT*, which is initially NIL.
> > + (Note: We currently do not support START-BLOCK or END-BLOCK as the behavior
> > + of these proclamations are not ANSI.)
> > +
> > + :ENTRY-POINTS
> > + This specifies a list of function names for functions in the file(s) that
> > + must be given global definitions. This only applies to block
> > + compilation, and is useful mainly when :BLOCK-COMPILE T is specified on a
> > + file that lacks START-BLOCK declarations. If the value is NIL (the
> > + default) then all functions will be globally defined.
> >
> > :TRACE-FILE
> > If given, internal data structures are dumped to the specified
> > @@ -1850,21 +1884,6 @@ returning its filename.
> > :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 is quasi-supported, to determine whether
> > -multiple functions are compiled together as a unit, resolving function
> > -references at compile time. NIL means that global function names are
> > -never resolved at compilation time. Currently NIL is the default
> > -behavior, because although section 3.2.2.3, \"Semantic Constraints\",
> > -of the ANSI spec allows this behavior under all circumstances, the
> > -compiler's runtime scales badly when it tries to do this for large
> > -files. If/when this performance problem is fixed, the block
> > -compilation default behavior will probably be made dependent on the
> > -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)
> > diff --git a/src/compiler/target-main.lisp b/src/compiler/target-main.lisp
> > index 22c69b85d..3d0736274 100644
> > --- a/src/compiler/target-main.lisp
> > +++ b/src/compiler/target-main.lisp
> > @@ -47,7 +47,8 @@
> > (make-compilation
> > :msan-unpoison
> > (and (member :msan *features*)
> > - (find-dynamic-foreign-symbol-address "__msan_unpoison"))))
> > + (find-dynamic-foreign-symbol-address "__msan_unpoison"))
> > + :block-compile nil))
> > (*current-path* nil)
> > (*last-message-count* (list* 0 nil nil))
> > (*last-error-context* nil)
> >
> > -----------------------------------------------------------------------
> >
> >
> > hooks/post-receive
> > --
> > SBCL
> >
> >
> > _______________________________________________
> > Sbcl-commits mailing list
> > Sbc...@li...
> > https://lists.sourceforge.net/lists/listinfo/sbcl-commits
|
