X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fnode.lisp;h=2e5fd521046174c98b15c91e433dbddcc32df32a;hb=a189a69454ef7635149319ae213b337f17c50d20;hp=6319c5b3325c5fc0a674b45beb23c0a8d8467fbe;hpb=b66385e2031fc2cac17dd129df0af400beb48a22;p=sbcl.git diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp index 6319c5b..2e5fd52 100644 --- a/src/compiler/node.lisp +++ b/src/compiler/node.lisp @@ -86,6 +86,7 @@ (format stream "~D" (cont-num x)))) (def!struct (node (:constructor nil) + (:include sset-element (number (incf *compiler-sset-counter*))) (:copier nil)) ;; unique ID for debugging #!+sb-show (id (new-object-id) :read-only t) @@ -172,17 +173,17 @@ (!def-boolean-attribute block reoptimize flush-p type-check delete-p type-asserted test-modified) -;;; FIXME: Tweak so that definitions of e.g. BLOCK-DELETE-P is -;;; findable by grep for 'def.*block-delete-p'. -(macrolet ((frob (slot) - `(defmacro ,(symbolicate "BLOCK-" slot) (block) - `(block-attributep (block-flags ,block) ,',slot)))) - (frob reoptimize) - (frob flush-p) - (frob type-check) - (frob delete-p) - (frob type-asserted) - (frob test-modified)) +(macrolet ((defattr (block-slot) + `(defmacro ,block-slot (block) + `(block-attributep + (block-flags ,block) + ,(symbolicate (subseq (string ',block-slot) 6)))))) + (defattr block-reoptimize) + (defattr block-flush-p) + (defattr block-type-check) + (defattr block-delete-p) + (defattr block-type-asserted) + (defattr block-test-modified)) ;;; The CBLOCK structure represents a basic block. We include ;;; SSET-ELEMENT so that we can have sets of blocks. Initially the @@ -246,7 +247,13 @@ ;; entire initial component just to clear the flags. (flag nil) ;; some kind of info used by the back end - (info nil)) + (info nil) + ;; what macroexpansions and source transforms happened "in" this block, used + ;; for xref + (xrefs nil :type list) + ;; Cache the physenv of a block during lifetime analysis. :NONE if + ;; no cached value has been stored yet. + (physenv-cache :none :type (or null physenv (member :none)))) (def!method print-object ((cblock cblock) stream) (print-unreadable-object (cblock stream :type t :identity t) (format stream "~W :START c~W" @@ -365,9 +372,6 @@ ;; on me (e.g. by using me as *CURRENT-COMPONENT*, or by pushing ;; LAMBDAs onto my NEW-FUNCTIONALS, as in sbcl-0.pre7.115). (info :no-ir2-yet :type (or ir2-component (member :no-ir2-yet :dead))) - ;; the SOURCE-INFO structure describing where this component was - ;; compiled from - (source-info *source-info* :type source-info) ;; count of the number of inline expansions we have done while ;; compiling this component, to detect infinite or exponential ;; blowups @@ -389,7 +393,9 @@ ;; this is filled by physical environment analysis (dx-lvars nil :type list) ;; The default LOOP in the component. - (outer-loop (missing-arg) :type cloop)) + (outer-loop (missing-arg) :type cloop) + ;; The current sset index + (sset-number 0 :type fixnum)) (defprinter (component :identity t) name #!+sb-show id @@ -460,8 +466,6 @@ kind mess-up (info :test info)) -(defmacro cleanup-nlx-info (cleanup) - `(cleanup-info ,cleanup)) ;;; A PHYSENV represents the result of physical environment analysis. ;;; @@ -583,6 +587,7 @@ ;;; allows us to easily substitute one for the other without actually ;;; hacking the flow graph. (def!struct (leaf (:make-load-form-fun ignore-it) + (:include sset-element (number (incf *compiler-sset-counter*))) (:constructor nil)) ;; unique ID for debugging #!+sb-show (id (new-object-id) :read-only t) @@ -611,25 +616,31 @@ :read-only t) ;; the type which values of this leaf must have (type *universal-type* :type ctype) - ;; where the TYPE information came from: + ;; the type which values of this leaf have last been defined to have + ;; (but maybe won't have in future, in case of redefinition) + (defined-type *universal-type* :type ctype) + ;; where the TYPE information came from (in order, from strongest to weakest): ;; :DECLARED, from a declaration. + ;; :DEFINED-HERE, from examination of the definition in the same file. + ;; :DEFINED, from examination of the definition elsewhere. + ;; :DEFINED-METHOD, implicit, piecemeal declarations from CLOS. ;; :ASSUMED, from uses of the object. - ;; :DEFINED, from examination of the definition. - ;; FIXME: This should be a named type. (LEAF-WHERE-FROM? Or - ;; perhaps just WHERE-FROM, since it's not just used in LEAF, - ;; but also in various DEFINE-INFO-TYPEs in globaldb.lisp, - ;; and very likely elsewhere too.) - (where-from :assumed :type (member :declared :assumed :defined)) + (where-from :assumed :type (member :declared :assumed :defined-here :defined :defined-method)) ;; list of the REF nodes for this leaf (refs () :type list) ;; true if there was ever a REF or SET node for this leaf. This may ;; be true when REFS and SETS are null, since code can be deleted. (ever-used nil :type boolean) - ;; is it declared dynamic-extent? - (dynamic-extent nil :type boolean) + ;; is it declared dynamic-extent, or truly-dynamic-extent? + (extent nil :type (member nil :maybe-dynamic :always-dynamic :indefinite)) ;; some kind of info used by the back end (info nil)) +(defun leaf-dynamic-extent (leaf) + (let ((extent (leaf-extent leaf))) + (unless (member extent '(nil :indefinite)) + extent))) + ;;; LEAF name operations ;;; ;;; KLUDGE: wants CLOS.. @@ -651,16 +662,24 @@ ;; it looks as though it's never interesting to get debug names ;; from them, so it's moot. -- WHN) (leaf-source-name leaf))) +(defun leaf-%debug-name (leaf) + (when (functional-p leaf) + (functional-%debug-name leaf))) ;;; The CONSTANT structure is used to represent known constant values. -;;; If NAME is not null, then it is the name of the named constant -;;; which this leaf corresponds to, otherwise this is an anonymous -;;; constant. -(def!struct (constant (:include leaf)) +;;; Since the same constant leaf may be shared between named and anonymous +;;; constants, %SOURCE-NAME is never used. +(def!struct (constant (:constructor make-constant (value + &aux + (type (ctype-of value)) + (%source-name '.anonymous.) + (where-from :defined))) + (:include leaf)) ;; the value of the constant - (value nil :type t)) + (value (missing-arg) :type t) + ;; Boxed TN for this constant, if any. + (boxed-tn nil :type (or null tn))) (defprinter (constant :identity t) - (%source-name :test %source-name) value) ;;; The BASIC-VAR structure represents information common to all @@ -675,11 +694,12 @@ (def!struct (global-var (:include basic-var)) ;; kind of variable described (kind (missing-arg) - :type (member :special :global-function :global))) + :type (member :special :global-function :global :unknown))) (defprinter (global-var :identity t) %source-name #!+sb-show id (type :test (not (eq type *universal-type*))) + (defined-type :test (not (eq defined-type *universal-type*))) (where-from :test (not (eq where-from :assumed))) kind) @@ -695,16 +715,16 @@ ;; global environment. (inlinep nil :type inlinep) (inline-expansion nil :type (or cons null)) - ;; the block-local definition of this function (either because it - ;; was semi-inline, or because it was defined in this block). If - ;; this function is not an entry point, then this may be deleted or - ;; LET-converted. Null if we haven't converted the expansion yet. - (functional nil :type (or functional null))) + ;; List of functionals corresponding to this DEFINED-FUN: either from the + ;; conversion of a NAMED-LAMBDA, or from inline-expansion (see + ;; RECOGNIZE-KNOWN-CALL) - we need separate functionals for each policy in + ;; which the function is used. + (functionals nil :type list)) (defprinter (defined-fun :identity t) %source-name #!+sb-show id inlinep - (functional :test functional)) + (functionals :test functionals)) ;;;; function stuff @@ -847,11 +867,19 @@ ;; the original function or macro lambda list, or :UNSPECIFIED if ;; this is a compiler created function (arg-documentation nil :type (or list (member :unspecified))) + ;; the documentation string for the lambda + (documentation nil :type (or null string)) ;; Node, allocating closure for this lambda. May be NIL when we are ;; sure that no closure is needed. (allocator nil :type (or null combination)) ;; various rare miscellaneous info that drives code generation & stuff - (plist () :type list)) + (plist () :type list) + ;; xref information for this functional (only used for functions with an + ;; XEP) + (xref () :type list) + ;; True if this functional was created from an inline expansion. This + ;; is either T, or the GLOBAL-VAR for which it is an expansion. + (inline-expanded nil)) (defprinter (functional :identity t) %source-name %debug-name @@ -927,7 +955,7 @@ ;; objects (closed-over LAMBDA-VARs and XEPs) which this lambda ;; depends on in such a way that DFO shouldn't put them in separate ;; components. - (calls-or-closes nil :type list) + (calls-or-closes (make-sset) :type (or null sset)) ;; the TAIL-SET that this LAMBDA is in. This is null during creation. ;; ;; In CMU CL, and old SBCL, this was also NILed out when LET @@ -950,7 +978,12 @@ (call-lexenv nil :type (or lexenv null)) ;; list of embedded lambdas (children nil :type list) - (parent nil :type (or clambda null))) + (parent nil :type (or clambda null)) + (allow-instrumenting *allow-instrumenting* :type boolean) + ;; True if this is a system introduced lambda: it may contain user code, but + ;; the lambda itself is not, and the bindings introduced by it are considered + ;; transparent by the nested DX analysis. + (system-lambda-p nil :type boolean)) (defprinter (clambda :conc-name lambda- :identity t) %source-name %debug-name @@ -1047,6 +1080,9 @@ ;; the default for a keyword or optional, represented as the ;; original Lisp code. This is set to NIL in &KEY arguments that are ;; defaulted using the SUPPLIED-P arg. + ;; + ;; For &REST arguments this may contain information about more context + ;; the rest list comes from. (default nil :type t) ;; the actual key for a &KEY argument. Note that in ANSI CL this is ;; not necessarily a keyword: (DEFUN FOO (&KEY ((BAR BAR))) ...). @@ -1074,7 +1110,17 @@ ;; This is set by physical environment analysis if it chooses an ;; indirect (value cell) representation for this variable because it ;; is both set and closed over. - indirect) + indirect + ;; true if the last reference has been deleted (and new references + ;; should not be made) + deleted + ;; This is set by physical environment analysis if, should it be an + ;; indirect lambda-var, an actual value cell object must be + ;; allocated for this variable because one or more of the closures + ;; that refer to it are not dynamic-extent. Note that both + ;; attributes must be set for the value-cell object to be created. + explicit-value-cell + ) (def!struct (lambda-var (:include basic-var)) (flags (lambda-var-attributes) @@ -1095,7 +1141,20 @@ ;; propagation. This is left null by the lambda pre-pass if it ;; determine that this is a set closure variable, and is thus not a ;; good subject for flow analysis. - (constraints nil :type (or sset null))) + (constraints nil :type (or null t #| FIXME: conset |#)) + ;; Content-addressed indices for the CONSTRAINTs on this variable. + ;; These are solely used by FIND-CONSTRAINT + (ctype-constraints nil :type (or null hash-table)) + (eq-constraints nil :type (or null hash-table)) + ;; sorted sets of constraints we like to iterate over + (eql-var-constraints nil :type (or null (array t 1))) + (inheritable-constraints nil :type (or null (array t 1))) + (private-constraints nil :type (or null (array t 1))) + ;; Initial type of a LET variable as last seen by PROPAGATE-FROM-SETS. + (last-initial-type *universal-type* :type ctype) + ;; The FOP handle of the lexical variable represented by LAMBDA-VAR + ;; in the fopcompiler. + (fop-value nil)) (defprinter (lambda-var :identity t) %source-name #!+sb-show id @@ -1110,6 +1169,10 @@ `(lambda-var-attributep (lambda-var-flags ,var) ignore)) (defmacro lambda-var-indirect (var) `(lambda-var-attributep (lambda-var-flags ,var) indirect)) +(defmacro lambda-var-deleted (var) + `(lambda-var-attributep (lambda-var-flags ,var) deleted)) +(defmacro lambda-var-explicit-value-cell (var) + `(lambda-var-attributep (lambda-var-flags ,var) explicit-value-cell)) ;;;; basic node types @@ -1119,14 +1182,20 @@ (def!struct (ref (:include valued-node (reoptimize nil)) (:constructor make-ref (leaf + &optional (%source-name '.anonymous.) &aux (leaf-type (leaf-type leaf)) (derived-type (make-single-value-type leaf-type)))) (:copier nil)) ;; The leaf referenced. - (leaf nil :type leaf)) + (leaf nil :type leaf) + ;; CONSTANT nodes are always anonymous, since we wish to coalesce named and + ;; unnamed constants that are equivalent, we need to keep track of the + ;; reference name for XREF. + (%source-name (missing-arg) :type symbol :read-only t)) (defprinter (ref :identity t) #!+sb-show id + (%source-name :test (neq %source-name '.anonymous.)) leaf) ;;; Naturally, the IF node always appears at the end of a block. @@ -1140,9 +1209,9 @@ ;; the blocks that we execute next in true and false case, ;; respectively (may be the same) (consequent (missing-arg) :type cblock) - (consequent-constraints nil :type (or null sset)) + (consequent-constraints nil :type (or null t #| FIXME: conset |#)) (alternative (missing-arg) :type cblock) - (alternative-constraints nil :type (or null sset))) + (alternative-constraints nil :type (or null t #| FIXME: conset |#))) (defprinter (cif :conc-name if- :identity t) (test :prin1 (lvar-uses test)) consequent @@ -1188,6 +1257,8 @@ (kind :full :type (member :local :full :error :known)) ;; if a call to a known global function, contains the FUN-INFO. (fun-info nil :type (or fun-info null)) + ;; Untrusted type we have asserted for this combination. + (type-validated-for-leaf nil) ;; some kind of information attached to this node by the back end (info nil) (step-info))