X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fvop.lisp;h=457616bd0b6665d7055c2daee51e0f06518206ca;hb=0bca0cb1bf5ce5572ab5cd7ba59f87fed1f2edb0;hp=7fc2f6c581e3e512c9b74f70fbb4889c1f85455f;hpb=82e0a78df47685519b12683f495d7ae19e07d3cf;p=sbcl.git diff --git a/src/compiler/vop.lisp b/src/compiler/vop.lisp index 7fc2f6c..457616b 100644 --- a/src/compiler/vop.lisp +++ b/src/compiler/vop.lisp @@ -21,25 +21,25 @@ (deftype local-tn-vector () `(simple-vector ,local-tn-limit)) (deftype local-tn-bit-vector () `(simple-bit-vector ,local-tn-limit)) -;;; Type of an SC number. +;;; type of an SC number (deftype sc-number () `(integer 0 (,sc-number-limit))) -;;; Types for vectors indexed by SC numbers. +;;; types for vectors indexed by SC numbers (deftype sc-vector () `(simple-vector ,sc-number-limit)) (deftype sc-bit-vector () `(simple-bit-vector ,sc-number-limit)) -;;; The different policies we can use to determine the coding strategy. -(deftype policies () +;;; the different policies we can use to determine the coding strategy +(deftype ltn-policy () '(member :safe :small :fast :fast-safe)) ;;;; PRIMITIVE-TYPEs -;;; The primitive type is used to represent the aspects of type +;;; A PRIMITIVE-TYPE is used to represent the aspects of type ;;; interesting to the VM. Selection of IR2 translation templates is ;;; done on the basis of the primitive types of the operands, and the ;;; primitive type of a value is used to constrain the possible ;;; representations of that value. -(defstruct primitive-type +(defstruct (primitive-type (:copier nil)) ;; the name of this PRIMITIVE-TYPE (name nil :type symbol) ;; a list of the SC numbers for all the SCs that a TN of this type @@ -47,7 +47,7 @@ (scs nil :type list) ;; the Lisp type equivalent to this type. If this type could never be ;; returned by PRIMITIVE-TYPE, then this is the NIL (or empty) type - (type (required-argument) :type ctype) + (type (missing-arg) :type ctype) ;; the template used to check that an object is of this type. This is a ;; template of one argument and one result, both of primitive-type T. If ;; the argument is of the correct type, then it is delivered into the @@ -77,8 +77,8 @@ ;;; environment pointer should be saved after the binding is ;;; instantiated. ;;; -;;; Environment-Info -;;; Holds the IR2-Environment structure. +;;; Physenv-Info +;;; Holds the Ir2-Physenv structure. ;;; ;;; Tail-Set-Info ;;; Holds the Return-Info structure. @@ -106,8 +106,9 @@ ;;; and after IR2 conversion. It is stored in the BLOCK-INFO slot for ;;; the associated block. (defstruct (ir2-block (:include block-annotation) - (:constructor make-ir2-block (block))) - ;; the IR2-Block's number, which differs from Block's Block-Number + (:constructor make-ir2-block (block)) + (:copier nil)) + ;; the IR2-BLOCK's number, which differs from BLOCK's BLOCK-NUMBER ;; if any blocks are split. This is assigned by lifetime analysis. (number nil :type (or index null)) ;; information about unknown-values continuations that is used by @@ -168,7 +169,7 @@ ;; the assembler label that points to the beginning of the code for ;; this block, or NIL when we haven't assigned a label yet (%label nil) - ;; list of Location-Info structures describing all the interesting + ;; list of LOCATION-INFO structures describing all the interesting ;; (to the debugger) locations in this block (locations nil :type list)) @@ -180,10 +181,11 @@ (local-tn-count :test (not (zerop local-tn-count))) (%label :test %label)) -;;; An IR2-Continuation structure is used to annotate continuations +;;; An IR2-CONTINUATION structure is used to annotate continuations ;;; that are used as a function result continuation or that receive MVs. (defstruct (ir2-continuation - (:constructor make-ir2-continuation (primitive-type))) + (:constructor make-ir2-continuation (primitive-type)) + (:copier nil)) ;; If this is :DELAYED, then this is a single value continuation for ;; which the evaluation of the use is to be postponed until the ;; evaluation of destination. This can be done for ref nodes or @@ -222,9 +224,9 @@ primitive-type locs) -;;; The IR2-Component serves mostly to accumulate non-code information +;;; An IR2-COMPONENT serves mostly to accumulate non-code information ;;; about the component being compiled. -(defstruct ir2-component +(defstruct (ir2-component (:copier nil)) ;; the counter used to allocate global TN numbers (global-tn-counter 0 :type index) ;; NORMAL-TNS is the head of the list of all the normal TNs that @@ -309,8 +311,8 @@ ;;; structures are somtimes created before they are initialized, since ;;; IR2 conversion may need to compile a forward reference. In this ;;; case the slots aren't actually initialized until entry analysis runs. -(defstruct entry-info - ;; true if this function has a non-null closure environment +(defstruct (entry-info (:copier nil)) + ;; Does this function have a non-null closure environment? (closure-p nil :type boolean) ;; a label pointing to the entry vector for this function, or NIL ;; before ENTRY-ANALYZE runs @@ -319,32 +321,34 @@ ;; of the function, a symbol or (SETF ). Otherwise, this is ;; some string that is intended to be informative. (name "" :type (or simple-string list symbol)) - ;; a string representing the argument list that the function was - ;; defined with - (arguments nil :type (or simple-string null)) + ;; the argument list that the function was defined with. + (arguments nil :type list) ;; a function type specifier representing the arguments and results ;; of this function (type 'function :type (or list (member function)))) -;;; An IR2-ENVIRONMENT is used to annotate non-LET lambdas with their -;;; passing locations. It is stored in the Environment-Info. -(defstruct ir2-environment - ;; the TNs that hold the passed environment within the function. - ;; This is an alist translating from the NLX-Info or lambda-var to - ;; the TN that holds the corresponding value within this function. - ;; This list is in the same order as the ENVIRONMENT-CLOSURE. - (environment nil :type list) +;;; An IR2-PHYSENV is used to annotate non-LET LAMBDAs with their +;;; passing locations. It is stored in the PHYSENV-INFO. +(defstruct (ir2-physenv (:copier nil)) + ;; TN info for closed-over things within the function: an alist + ;; mapping from NLX-INFOs and LAMBDA-VARs to TNs holding the + ;; corresponding thing within this function + ;; + ;; Elements of this list have a one-to-one correspondence with + ;; elements of the PHYSENV-CLOSURE list of the PHYSENV object that + ;; links to us. + (closure (missing-arg) :type list :read-only t) ;; the TNs that hold the OLD-FP and RETURN-PC within the function. ;; We always save these so that the debugger can do a backtrace, ;; even if the function has no return (and thus never uses them). ;; Null only temporarily. (old-fp nil :type (or tn null)) (return-pc nil :type (or tn null)) - ;; The passing location for the Return-PC. The return PC is treated + ;; The passing location for the RETURN-PC. The return PC is treated ;; differently from the other arguments, since in some ;; implementations we may use a call instruction that requires the ;; return PC to be passed in a particular place. - (return-pc-pass (required-argument) :type tn) + (return-pc-pass (missing-arg) :type tn :read-only t) ;; True if this function has a frame on the number stack. This is ;; set by representation selection whenever it is possible that some ;; function in our tail set will make use of the number stack. @@ -353,8 +357,8 @@ (live-tns nil :type list) ;; a list of all the :DEBUG-ENVIRONMENT TNs live in this environment (debug-live-tns nil :type list) - ;; a label that marks the start of elsewhere code for this function. - ;; Null until this label is assigned by codegen. Used for + ;; a label that marks the start of elsewhere code for this function, + ;; or null until this label is assigned by codegen. Used for ;; maintaining the debug source map. (elsewhere-start nil :type (or label null)) ;; a label that marks the first location in this function at which @@ -362,8 +366,8 @@ ;; from their passing locations, etc. This is the start of the ;; function as far as the debugger is concerned. (environment-start nil :type (or label null))) -(defprinter (ir2-environment) - environment +(defprinter (ir2-physenv) + closure old-fp return-pc return-pc-pass) @@ -371,15 +375,15 @@ ;;; A RETURN-INFO is used by GTN to represent the return strategy and ;;; locations for all the functions in a given TAIL-SET. It is stored ;;; in the TAIL-SET-INFO. -(defstruct return-info +(defstruct (return-info (:copier nil)) ;; The return convention used: ;; -- If :UNKNOWN, we use the standard return convention. ;; -- If :FIXED, we use the known-values convention. - (kind (required-argument) :type (member :fixed :unknown)) + (kind (missing-arg) :type (member :fixed :unknown)) ;; the number of values returned, or :UNKNOWN if we don't know. ;; COUNT may be known when KIND is :UNKNOWN, since we may choose the ;; standard return convention for other reasons. - (count (required-argument) :type (or index (member :unknown))) + (count (missing-arg) :type (or index (member :unknown))) ;; If count isn't :UNKNOWN, then this is a list of the ;; primitive-types of each value. (types () :type list) @@ -392,95 +396,55 @@ types locations) -(defstruct ir2-nlx-info +(defstruct (ir2-nlx-info (:copier nil)) ;; If the kind is :ENTRY (a lexical exit), then in the home ;; environment, this holds a VALUE-CELL object containing the unwind ;; block pointer. In the other cases nobody directly references the ;; unwind-block, so we leave this slot null. (home nil :type (or tn null)) - ;; The saved control stack pointer. - (save-sp (required-argument) :type tn) - ;; The list of dynamic state save TNs. + ;; the saved control stack pointer + (save-sp (missing-arg) :type tn) + ;; the list of dynamic state save TNs (dynamic-state (list* (make-stack-pointer-tn) (make-dynamic-state-tns)) :type list) - ;; The target label for NLX entry. + ;; the target label for NLX entry (target (gen-label) :type label)) (defprinter (ir2-nlx-info) home save-sp dynamic-state) - -;;; FIXME: Delete? (was commented out in CMU CL) -#| -;;; The Loop structure holds information about a loop. -(defstruct (cloop (:conc-name loop-) - (:predicate loop-p) - (:constructor make-loop) - (:copier copy-loop)) - ;; The kind of loop that this is. These values are legal: - ;; - ;; :Outer - ;; This is the outermost loop structure, and represents all the - ;; code in a component. - ;; - ;; :Natural - ;; A normal loop with only one entry. - ;; - ;; :Strange - ;; A segment of a "strange loop" in a non-reducible flow graph. - (kind (required-argument) :type (member :outer :natural :strange)) - ;; The first and last blocks in the loop. There may be more than one tail, - ;; since there may be multiple back branches to the same head. - (head nil :type (or cblock null)) - (tail nil :type list) - ;; A list of all the blocks in this loop or its inferiors that have a - ;; successor outside of the loop. - (exits nil :type list) - ;; The loop that this loop is nested within. This is null in the outermost - ;; loop structure. - (superior nil :type (or cloop null)) - ;; A list of the loops nested directly within this one. - (inferiors nil :type list) - ;; The head of the list of blocks directly within this loop. We must recurse - ;; on Inferiors to find all the blocks. - (blocks nil :type (or null cblock))) -(defprinter (loop) - kind - head - tail - exits) -|# ;;;; VOPs and templates ;;; A VOP is a Virtual Operation. It represents an operation and the ;;; operands to the operation. -(defstruct (vop (:constructor make-vop (block node info args results))) - ;; VOP-Info structure containing static info about the operation. +(defstruct (vop (:constructor make-vop (block node info args results)) + (:copier nil)) + ;; VOP-Info structure containing static info about the operation (info nil :type (or vop-info null)) - ;; The IR2-Block this VOP is in. - (block (required-argument) :type ir2-block) + ;; the IR2-Block this VOP is in + (block (missing-arg) :type ir2-block) ;; VOPs evaluated after and before this one. Null at the ;; beginning/end of the block, and temporarily during IR2 ;; translation. (next nil :type (or vop null)) (prev nil :type (or vop null)) - ;; Heads of the TN-Ref lists for operand TNs, linked using the - ;; Across slot. + ;; heads of the TN-Ref lists for operand TNs, linked using the + ;; Across slot (args nil :type (or tn-ref null)) (results nil :type (or tn-ref null)) - ;; Head of the list of write refs for each explicitly allocated - ;; temporary, linked together using the Across slot. + ;; head of the list of write refs for each explicitly allocated + ;; temporary, linked together using the Across slot (temps nil :type (or tn-ref null)) - ;; Head of the list of all TN-refs for references in this VOP, + ;; head of the list of all TN-refs for references in this VOP, ;; linked by the Next-Ref slot. There will be one entry for each ;; operand and two (a read and a write) for each temporary. (refs nil :type (or tn-ref null)) - ;; Stuff that is passed uninterpreted from IR2 conversion to + ;; stuff that is passed uninterpreted from IR2 conversion to ;; codegen. The meaning of this slot is totally dependent on the VOP. codegen-info - ;; Node that generated this VOP, for keeping track of debug info. + ;; the node that generated this VOP, for keeping track of debug info (node nil :type (or node null)) ;; Local-TN bit vector representing the set of TNs live after args ;; are read and before results are written. This is only filled in @@ -495,9 +459,10 @@ ;;; A TN-REF object contains information about a particular reference ;;; to a TN. The information in TN-REFs largely determines how TNs are ;;; packed. -(defstruct (tn-ref (:constructor make-tn-ref (tn write-p))) +(defstruct (tn-ref (:constructor make-tn-ref (tn write-p)) + (:copier nil)) ;; the TN referenced - (tn (required-argument) :type tn) + (tn (missing-arg) :type tn) ;; Is this is a write reference? (as opposed to a read reference) (write-p nil :type boolean) ;; the link for a list running through all TN-Refs for this TN of @@ -527,16 +492,15 @@ ;;; a known function. (def!struct (template (:constructor nil) #-sb-xc-host (:pure t)) - ;; The symbol name of this VOP. This is used when printing the VOP + ;; the symbol name of this VOP. This is used when printing the VOP ;; and is also used to provide a handle for definition and ;; translation. (name nil :type symbol) - ;; A Function-Type describing the arg/result type restrictions. We - ;; compute this from the Primitive-Type restrictions to make life - ;; easier for IR1 phases that need to anticipate LTN's template - ;; selection. - (type (required-argument) :type function-type) - ;; Lists of restrictions on the argument and result types. A + ;; the arg/result type restrictions. We compute this from the + ;; PRIMITIVE-TYPE restrictions to make life easier for IR1 phases + ;; that need to anticipate LTN's template selection. + (type (missing-arg) :type fun-type) + ;; lists of restrictions on the argument and result types. A ;; restriction may take several forms: ;; -- The restriction * is no restriction at all. ;; -- A restriction (:OR *) means that the operand @@ -549,13 +513,13 @@ ;; the type tested by the predicate, used when we want to represent ;; the type constraint as a Lisp function type. ;; - ;; If Result-Types is :Conditional, then this is an IF-xxx style - ;; conditional that yeilds its result as a control transfer. The + ;; If RESULT-TYPES is :CONDITIONAL, then this is an IF-FOO style + ;; conditional that yields its result as a control transfer. The ;; emit function takes two info arguments: the target label and a ;; boolean flag indicating whether to negate the sense of the test. (arg-types nil :type list) (result-types nil :type (or list (member :conditional))) - ;; The primitive type restriction applied to each extra argument or + ;; the primitive type restriction applied to each extra argument or ;; result following the fixed operands. If NIL, no extra ;; args/results are allowed. Otherwise, either * or a (:OR ...) list ;; as described for the {ARG,RESULT}-TYPES. @@ -566,22 +530,22 @@ ;; conditionally compile for different target hardware ;; configuarations (e.g. FP hardware.) (guard nil :type (or function null)) - ;; The policy under which this template is the best translation. + ;; the policy under which this template is the best translation. ;; Note that LTN might use this template under other policies if it - ;; can't figure our anything better to do. - (policy (required-argument) :type policies) - ;; The base cost for this template, given optimistic assumptions + ;; can't figure out anything better to do. + (ltn-policy (missing-arg) :type ltn-policy) + ;; the base cost for this template, given optimistic assumptions ;; such as no operand loading, etc. - (cost (required-argument) :type index) - ;; If true, then a short noun-like phrase describing what this VOP - ;; "does", i.e. the implementation strategy. This is for use in - ;; efficiency notes. + (cost (missing-arg) :type index) + ;; If true, then this is a short noun-like phrase describing what + ;; this VOP "does", i.e. the implementation strategy. This is for + ;; use in efficiency notes. (note nil :type (or string null)) - ;; The number of trailing arguments to VOP or %PRIMITIVE that we + ;; the number of trailing arguments to VOP or %PRIMITIVE that we ;; bundle into a list and pass into the emit function. This provides ;; a way to pass uninterpreted stuff directly to the code generator. (info-arg-count 0 :type index) - ;; A function that emits the VOPs for this template. Arguments: + ;; a function that emits the VOPs for this template. Arguments: ;; 1] Node for source context. ;; 2] IR2-Block that we place the VOP in. ;; 3] This structure. @@ -593,14 +557,14 @@ ;; Two values are returned: the first and last VOP emitted. This vop ;; sequence must be linked into the VOP Next/Prev chain for the ;; block. At least one VOP is always emitted. - (emit-function (required-argument) :type function)) + (emit-function (missing-arg) :type function)) (defprinter (template) name arg-types result-types (more-args-type :test more-args-type :prin1 more-args-type) (more-results-type :test more-results-type :prin1 more-results-type) - policy + ltn-policy cost (note :test note) (info-arg-count :test (not (zerop info-arg-count)))) @@ -611,10 +575,10 @@ (def!struct (vop-info (:include template) (:make-load-form-fun ignore-it)) - ;; Side-effects of this VOP and side-effects that affect the value - ;; of this VOP. - (effects (required-argument) :type attributes) - (affected (required-argument) :type attributes) + ;; side-effects of this VOP and side-effects that affect the value + ;; of this VOP + (effects (missing-arg) :type attributes) + (affected (missing-arg) :type attributes) ;; If true, causes special casing of TNs live after this VOP that ;; aren't results: ;; -- If T, all such TNs that are allocated in a SC with a defined @@ -627,13 +591,13 @@ ;; -- If :Compute-Only, just compute the save set, don't do any saving. ;; This is used to get the live variables for debug info. (save-p nil :type (member t nil :force-to-stack :compute-only)) - ;; Info for automatic emission of move-arg VOPs by representation + ;; info for automatic emission of move-arg VOPs by representation ;; selection. If NIL, then do nothing special. If non-null, then ;; there must be a more arg. Each more arg is moved to its passing - ;; location using the appropriate representation-specific - ;; move-argument VOP. The first (fixed) argument must be the - ;; control-stack frame pointer for the frame to move into. The first - ;; info arg is the list of passing locations. + ;; location using the appropriate representation-specific MOVE-ARG + ;; VOP. The first (fixed) argument must be the control-stack frame + ;; pointer for the frame to move into. The first info arg is the + ;; list of passing locations. ;; ;; Additional constraints depend on the value: ;; @@ -647,15 +611,15 @@ ;; :KNOWN-RETURN ;; If needed, the old NFP is computed using COMPUTE-OLD-NFP. (move-args nil :type (member nil :full-call :local-call :known-return)) - ;; A list of sc-vectors representing the loading costs of each fixed - ;; argument and result. + ;; a list of sc-vectors representing the loading costs of each fixed + ;; argument and result (arg-costs nil :type list) (result-costs nil :type list) - ;; If true, sc-vectors representing the loading costs for any more - ;; args and results. + ;; if true, SC-VECTORs representing the loading costs for any more + ;; args and results (more-arg-costs nil :type (or sc-vector null)) (more-result-costs nil :type (or sc-vector null)) - ;; Lists of sc-vectors mapping each SC to the SCs that we can load + ;; lists of SC-VECTORs mapping each SC to the SCs that we can load ;; into. If a SC is directly acceptable to the VOP, then the entry ;; is T. Otherwise, it is a list of the SC numbers of all the SCs ;; that we can load into. This list will be empty if there is no @@ -663,42 +627,32 @@ ;; operand SC restriction. (arg-load-scs nil :type list) (result-load-scs nil :type list) - ;; If true, a function that is called with the VOP to do operand - ;; targeting. This is done by modifiying the TN-Ref-Target slots in - ;; the TN-Refs so that they point to other TN-Refs in the same VOP. - (target-function nil :type (or null function)) - ;; A function that emits assembly code for a use of this VOP when it - ;; is called with the VOP structure. Null if this VOP has no - ;; specified generator (i.e. it exists only to be inherited by other - ;; VOPs.) + ;; if true, a function that is called with the VOP to do operand + ;; targeting. This is done by modifying the TN-REF-TARGET slots in + ;; the TN-REFS so that they point to other TN-REFS in the same VOP. + (target-fun nil :type (or null function)) + ;; a function that emits assembly code for a use of this VOP when it + ;; is called with the VOP structure. This is null if this VOP has no + ;; specified generator (i.e. if it exists only to be inherited by + ;; other VOPs). (generator-function nil :type (or function null)) - ;; A list of things that are used to parameterize an inherited + ;; a list of things that are used to parameterize an inherited ;; generator. This allows the same generator function to be used for ;; a group of VOPs with similar implementations. (variant nil :type list) - ;; The number of arguments and results. Each regular arg/result + ;; the number of arguments and results. Each regular arg/result ;; counts as one, and all the more args/results together count as 1. (num-args 0 :type index) (num-results 0 :type index) - ;; Vector of the temporaries the vop needs. See emit-generic-vop in - ;; vmdef for information on how the temps are encoded. - ;; - ;; (The SB-XC-HOST conditionalization on the type is there because - ;; it's difficult to dump specialized arrays portably, so on the - ;; cross-compilation host we punt by using unspecialized arrays - ;; instead.) + ;; a vector of the temporaries the vop needs. See EMIT-GENERIC-VOP + ;; in vmdef for information on how the temps are encoded. (temps nil :type (or null (specializable-vector (unsigned-byte 16)))) - ;; The order all the refs for this vop should be put in. Each + ;; the order all the refs for this vop should be put in. Each ;; operand is assigned a number in the following ordering: args, ;; more-args, results, more-results, temps This vector represents ;; the order the operands should be put into in the next-ref link. - ;; - ;; (The SB-XC-HOST conditionalization on the type is there because - ;; it's difficult to dump specialized arrays portably, so on the - ;; cross-compilation host we punt by using unspecialized arrays - ;; instead.) (ref-ordering nil :type (or null (specializable-vector (unsigned-byte 8)))) - ;; Array of the various targets that should be done. Each element + ;; a vector of the various targets that should be done. Each element ;; encodes the source ref (shifted 8) and the dest ref index. (targets nil :type (or null (specializable-vector (unsigned-byte 16))))) @@ -744,77 +698,77 @@ ;;; The SB structure represents the global information associated with ;;; a storage base. (def!struct (sb (:make-load-form-fun just-dump-it-normally)) - ;; Name, for printing and reference. + ;; name, for printing and reference (name nil :type symbol) - ;; The kind of storage base (which determines the packing - ;; algorithm). + ;; the kind of storage base (which determines the packing + ;; algorithm) (kind :non-packed :type (member :finite :unbounded :non-packed)) - ;; The number of elements in the SB. If finite, this is the total + ;; the number of elements in the SB. If finite, this is the total ;; size. If unbounded, this is the size that the SB is initially ;; allocated at. (size 0 :type index)) (defprinter (sb) name) -;;; The Finite-SB structure holds information needed by the packing -;;; algorithm for finite SBs. +;;; A FINITE-SB holds information needed by the packing algorithm for +;;; finite SBs. (def!struct (finite-sb (:include sb)) - ;; The number of locations currently allocated in this SB. + ;; the number of locations currently allocated in this SB (current-size 0 :type index) - ;; The last location packed in, used by pack to scatter TNs to + ;; the last location packed in, used by pack to scatter TNs to ;; prevent a few locations from getting all the TNs, and thus - ;; getting overcrowded, reducing the possiblilities for targeting. + ;; getting overcrowded, reducing the possibilities for targeting. (last-offset 0 :type index) - ;; A vector containing, for each location in this SB, a vector + ;; a vector containing, for each location in this SB, a vector ;; indexed by IR2 block numbers, holding local conflict bit vectors. ;; A TN must not be packed in a given location within a particular ;; block if the LTN number for that TN in that block corresponds to ;; a set bit in the bit-vector. (conflicts '#() :type simple-vector) - ;; A vector containing, for each location in this SB, a bit-vector + ;; a vector containing, for each location in this SB, a bit-vector ;; indexed by IR2 block numbers. If the bit corresponding to a block ;; is set, then the location is in use somewhere in the block, and ;; thus has a conflict for always-live TNs. (always-live '#() :type simple-vector) - ;; A vector containing the TN currently live in each location in the + ;; a vector containing the TN currently live in each location in the ;; SB, or NIL if the location is unused. This is used during load-tn pack. (live-tns '#() :type simple-vector) - ;; The number of blocks for which the ALWAYS-LIVE and CONFLICTS + ;; the number of blocks for which the ALWAYS-LIVE and CONFLICTS ;; might not be virgin, and thus must be reinitialized when PACK ;; starts. Less then the length of those vectors when not all of the ;; length was used on the previously packed component. (last-block-count 0 :type index)) ;;; the SC structure holds the storage base that storage is allocated -;;; in and information used to select locations within the SB. -(defstruct sc - ;; Name, for printing and reference. +;;; in and information used to select locations within the SB +(defstruct (sc (:copier nil)) + ;; name, for printing and reference (name nil :type symbol) - ;; The number used to index SC cost vectors. + ;; the number used to index SC cost vectors (number 0 :type sc-number) - ;; The storage base that this SC allocates storage from. + ;; the storage base that this SC allocates storage from (sb nil :type (or sb null)) - ;; The size of elements in this SC, in units of locations in the SB. + ;; the size of elements in this SC, in units of locations in the SB (element-size 0 :type index) - ;; If our SB is finite, a list of the locations in this SC. + ;; if our SB is finite, a list of the locations in this SC (locations nil :type list) - ;; A list of the alternate (save) SCs for this SC. + ;; a list of the alternate (save) SCs for this SC (alternate-scs nil :type list) - ;; A list of the constant SCs that can me moved into this SC. + ;; a list of the constant SCs that can me moved into this SC (constant-scs nil :type list) - ;; True if this values in this SC needs to be saved across calls. + ;; true if the values in this SC needs to be saved across calls (save-p nil :type boolean) - ;; Vectors mapping from SC numbers to information about how to load - ;; from the index SC to this one. Move-Functions holds the names of - ;; the functions used to do loading, and Load-Costs holds the cost - ;; of the corresponding Move-Functions. If loading is impossible, - ;; then the entries are NIL. Load-Costs is initialized to have a 0 + ;; vectors mapping from SC numbers to information about how to load + ;; from the index SC to this one. MOVE-FUNS holds the names of + ;; the functions used to do loading, and LOAD-COSTS holds the cost + ;; of the corresponding move functions. If loading is impossible, + ;; then the entries are NIL. LOAD-COSTS is initialized to have a 0 ;; for this SC. - (move-functions (make-array sc-number-limit :initial-element nil) - :type sc-vector) + (move-funs (make-array sc-number-limit :initial-element nil) + :type sc-vector) (load-costs (make-array sc-number-limit :initial-element nil) :type sc-vector) - ;; A vector mapping from SC numbers to possibly + ;; a vector mapping from SC numbers to possibly ;; representation-specific move and coerce VOPs. Each entry is a ;; list of VOP-INFOs for VOPs that move/coerce an object in the ;; index SC's representation into this SC's representation. This @@ -834,22 +788,22 @@ ;; that we are setting up for unknown-values return. (move-vops (make-array sc-number-limit :initial-element nil) :type sc-vector) - ;; The costs corresponding to the MOVE-VOPS. Separate because this + ;; the costs corresponding to the MOVE-VOPS. Separate because this ;; info is needed at meta-compile time, while the MOVE-VOPs don't ;; exist till load time. If no move is defined, then the entry is ;; NIL. (move-costs (make-array sc-number-limit :initial-element nil) :type sc-vector) - ;; Similar to Move-VOPs, except that we only ever use the entries + ;; similar to Move-VOPs, except that we only ever use the entries ;; for this SC and its alternates, since we never combine complex ;; representation conversion with argument passing. (move-arg-vops (make-array sc-number-limit :initial-element nil) :type sc-vector) - ;; True if this SC or one of its alternates in in the NUMBER-STACK SB. + ;; true if this SC or one of its alternates in in the NUMBER-STACK SB. (number-stack-p nil :type boolean) - ;; Alignment restriction. The offset must be an even multiple of this. + ;; alignment restriction. The offset must be an even multiple of this. (alignment 1 :type (and index (integer 1))) - ;; A list of locations that we avoid packing in during normal + ;; a list of locations that we avoid packing in during normal ;; register allocation to ensure that these locations will be free ;; for operand loading. This prevents load-TN packing from thrashing ;; by spilling a lot. @@ -861,7 +815,8 @@ (defstruct (tn (:include sset-element) (:constructor make-random-tn) - (:constructor make-tn (number kind primitive-type sc))) + (:constructor make-tn (number kind primitive-type sc)) + (:copier nil)) ;; The kind of TN this is: ;; ;; :NORMAL @@ -884,10 +839,10 @@ ;; ;; :SAVE ;; :SAVE-ONCE - ;; A TN used for saving a :Normal TN across function calls. The + ;; A TN used for saving a :NORMAL TN across function calls. The ;; lifetime information slots are unitialized: get the original - ;; TN our of the SAVE-TN slot and use it for conflicts. Save-Once - ;; is like :Save, except that it is only save once at the single + ;; TN our of the SAVE-TN slot and use it for conflicts. SAVE-ONCE + ;; is like :SAVE, except that it is only save once at the single ;; writer of the original TN. ;; ;; :SPECIFIED-SAVE @@ -902,11 +857,11 @@ ;; determination method. ;; ;; :CONSTANT - ;; Represents a constant, with TN-Leaf a Constant leaf. Lifetime + ;; Represents a constant, with TN-LEAF a CONSTANT leaf. Lifetime ;; information isn't computed, since the value isn't allocated by ;; pack, but is instead generated as a load at each use. Since - ;; lifetime analysis isn't done on :Constant TNs, they don't have - ;; Local-Numbers and similar stuff. + ;; lifetime analysis isn't done on :CONSTANT TNs, they don't have + ;; LOCAL-NUMBERs and similar stuff. ;; ;; :ALIAS ;; A special kind of TN used to represent initialization of local @@ -916,24 +871,24 @@ ;; as :NORMAL, but then at the end merges the conflict info into ;; the original TN and replaces all uses of the alias with the ;; original TN. SAVE-TN holds the aliased TN. - (kind (required-argument) + (kind (missing-arg) :type (member :normal :environment :debug-environment :save :save-once :specified-save :load :constant :component :alias)) - ;; The primitive-type for this TN's value. Null in restricted or + ;; the primitive-type for this TN's value. Null in restricted or ;; wired TNs. (primitive-type nil :type (or primitive-type null)) ;; If this TN represents a variable or constant, then this is the ;; corresponding Leaf. (leaf nil :type (or leaf null)) - ;; Thread that links TNs together so that we can find them. + ;; thread that links TNs together so that we can find them (next nil :type (or tn null)) - ;; Head of TN-Ref lists for reads and writes of this TN. + ;; head of TN-Ref lists for reads and writes of this TN (reads nil :type (or tn-ref null)) (writes nil :type (or tn-ref null)) - ;; A link we use when building various temporary TN lists. + ;; a link we use when building various temporary TN lists (next* nil :type (or tn null)) - ;; Some block that contains a reference to this TN, or Nil if we + ;; some block that contains a reference to this TN, or Nil if we ;; haven't seen any reference yet. If the TN is local, then this is ;; the block it is local to. (local nil :type (or ir2-block null)) @@ -942,18 +897,18 @@ ;; number during the conflicts analysis of that block. If the TN has ;; no local number within the block, then this is Nil. (local-number nil :type (or local-tn-number null)) - ;; If a local TN, a bit-vector with 1 for the local-number of every - ;; TN that we conflict with. + ;; If this object is a local TN, this slot is a bit-vector with 1 + ;; for the local-number of every TN that we conflict with. (local-conflicts (make-array local-tn-limit :element-type 'bit :initial-element 0) :type local-tn-bit-vector) - ;; Head of the list of Global-Conflicts structures for a global TN. + ;; head of the list of GLOBAL-CONFLICTS structures for a global TN. ;; This list is sorted by block number (i.e. reverse DFO), allowing ;; the intersection between the lifetimes for two global TNs to be ;; easily found. If null, then this TN is a local TN. (global-conflicts nil :type (or global-conflicts null)) - ;; During lifetime analysis, this is used as a pointer into the - ;; conflicts chain, for scanning through blocks in reverse DFO. + ;; during lifetime analysis, this is used as a pointer into the + ;; conflicts chain, for scanning through blocks in reverse DFO (current-conflict nil) ;; In a :SAVE TN, this is the TN saved. In a :NORMAL or :ENVIRONMENT ;; TN, this is the associated save TN. In TNs with no save TN, this @@ -962,14 +917,14 @@ ;; After pack, the SC we packed into. Beforehand, the SC we want to ;; pack into, or null if we don't know. (sc nil :type (or sc null)) - ;; The offset within the SB that this TN is packed into. This is what - ;; indicates that the TN is packed. + ;; the offset within the SB that this TN is packed into. This is what + ;; indicates that the TN is packed (offset nil :type (or index null)) - ;; Some kind of info about how important this TN is. + ;; some kind of info about how important this TN is (cost 0 :type fixnum) - ;; If a :ENVIRONMENT or :DEBUG-ENVIRONMENT TN, this is the environment that - ;; the TN is live throughout. - (environment nil :type (or environment null))) + ;; If a :ENVIRONMENT or :DEBUG-ENVIRONMENT TN, this is the + ;; physical environment that the TN is live throughout. + (physenv nil :type (or physenv null))) (def!method print-object ((tn tn) stream) (print-unreadable-object (tn stream :type t) ;; KLUDGE: The distinction between PRINT-TN and PRINT-OBJECT on TN is @@ -983,13 +938,14 @@ ;;; lifetime analysis to represent the set of TNs live at the start of ;;; the IR2 block. (defstruct (global-conflicts - (:constructor make-global-conflicts (kind tn block number))) - ;; The IR2-Block that this structure represents the conflicts for. - (block (required-argument) :type ir2-block) - ;; Thread running through all the Global-Conflict for Block. This - ;; thread is sorted by TN number. + (:constructor make-global-conflicts (kind tn block number)) + (:copier nil)) + ;; the IR2-Block that this structure represents the conflicts for + (block (missing-arg) :type ir2-block) + ;; thread running through all the Global-Conflict for Block. This + ;; thread is sorted by TN number (next nil :type (or global-conflicts null)) - ;; The way that TN is used by Block: + ;; the way that TN is used by Block ;; ;; :READ ;; The TN is read before it is written. It starts the block live, @@ -1007,7 +963,7 @@ ;; :LIVE ;; The TN is not referenced. It is live everywhere in the block. (kind :read-only :type (member :read :write :read-only :live)) - ;; A local conflicts vector representing conflicts with TNs live in + ;; a local conflicts vector representing conflicts with TNs live in ;; Block. The index for the local TN number of each TN we conflict ;; with in this block is 1. To find the full conflict set, the :Live ;; TNs for Block must also be included. This slot is not meaningful @@ -1016,9 +972,9 @@ :element-type 'bit :initial-element 0) :type local-tn-bit-vector) - ;; The TN we are recording conflicts for. - (tn (required-argument) :type tn) - ;; Thread through all the Global-Conflicts for TN. + ;; the TN we are recording conflicts for. + (tn (missing-arg) :type tn) + ;; thread through all the Global-Conflicts for TN (tn-next nil :type (or global-conflicts null)) ;; TN's local TN number in Block. :Live TNs don't have local numbers. (number nil :type (or local-tn-number null)))