compiler/codeGen/CgCon.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP Project, Glasgow University, 1992-1998
   4 %
   5 \section[CgCon]{Code generation for constructors}
   6
   7 This module provides the support code for @StgToAbstractC@ to deal
   8 with {\em constructors} on the RHSs of let(rec)s.  See also
   9 @CgClosure@, which deals with closures.
  10
  11 \begin{code}
  12 module CgCon (
  13         cgTopRhsCon, buildDynCon,
  14         bindConArgs, bindUnboxedTupleComponents,
  15         cgReturnDataCon,
  16         cgTyCon
  17     ) where
  18
  19 #include "HsVersions.h"
  20
  21 import CgMonad
  22 import StgSyn
  23
  24 import CgBindery
  25 import CgStackery
  26 import CgUtils
  27 import CgCallConv
  28 import CgHeapery
  29 import CgTailCall
  30 import CgProf
  31 import CgTicky
  32 import CgInfoTbls
  33 import CLabel
  34 import ClosureInfo
  35 import CmmUtils
  36 import Cmm
  37 import SMRep
  38 import CostCentre
  39 import Constants
  40 import TyCon
  41 import DataCon
  42 import Id
  43 import Type
  44 import PrelInfo
  45 import Outputable
  46 import ListSetOps
  47 #ifdef DEBUG
  48 import Util             ( lengthIs )
  49 #endif
  50 \end{code}
  51
  52
  53 %************************************************************************
  54 %*                                                                      *
  55 \subsection[toplevel-constructors]{Top-level constructors}
  56 %*                                                                      *
  57 %************************************************************************
  58
  59 \begin{code}
  60 cgTopRhsCon :: Id               -- Name of thing bound to this RHS
  61             -> DataCon          -- Id
  62             -> [StgArg]         -- Args
  63             -> FCode (Id, CgIdInfo)
  64 cgTopRhsCon id con args
  65   = do {
  66 #if mingw32_TARGET_OS
  67         -- Windows DLLs have a problem with static cross-DLL refs.
  68         ; this_pkg <- getThisPackage
  69         ; ASSERT( not (isDllConApp this_pkg con args) ) return ()
  70 #endif
  71         ; ASSERT( args `lengthIs` dataConRepArity con ) return ()
  72
  73         -- LAY IT OUT
  74         ; amodes <- getArgAmodes args
  75
  76         ; let
  77             name          = idName id
  78             lf_info       = mkConLFInfo con
  79             closure_label = mkClosureLabel name
  80             caffy         = any stgArgHasCafRefs args
  81             (closure_info, amodes_w_offsets) = layOutStaticConstr con amodes
  82             closure_rep = mkStaticClosureFields
  83                              closure_info
  84                              dontCareCCS                -- Because it's static data
  85                              caffy                      -- Has CAF refs
  86                              payload
  87
  88             payload = map get_lit amodes_w_offsets
  89             get_lit (CmmLit lit, _offset) = lit
  90             get_lit other = pprPanic "CgCon.get_lit" (ppr other)
  91                 -- NB1: amodes_w_offsets is sorted into ptrs first, then non-ptrs
  92                 -- NB2: all the amodes should be Lits!
  93
  94                 -- BUILD THE OBJECT
  95         ; emitDataLits closure_label closure_rep
  96
  97                 -- RETURN
  98         ; returnFC (id, taggedStableIdInfo id (mkLblExpr closure_label) lf_info con) }
  99 \end{code}
 100
 101 %************************************************************************
 102 %*                                                                      *
 103 %* non-top-level constructors                                           *
 104 %*                                                                      *
 105 %************************************************************************
 106 \subsection[code-for-constructors]{The code for constructors}
 107
 108 \begin{code}
 109 buildDynCon :: Id                 -- Name of the thing to which this constr will
 110                                   -- be bound
 111             -> CostCentreStack    -- Where to grab cost centre from;
 112                                   -- current CCS if currentOrSubsumedCCS
 113             -> DataCon            -- The data constructor
 114             -> [(CgRep,CmmExpr)] -- Its args
 115             -> FCode CgIdInfo     -- Return details about how to find it
 116
 117 -- We used to pass a boolean indicating whether all the
 118 -- args were of size zero, so we could use a static
 119 -- construtor; but I concluded that it just isn't worth it.
 120 -- Now I/O uses unboxed tuples there just aren't any constructors
 121 -- with all size-zero args.
 122 --
 123 -- The reason for having a separate argument, rather than looking at
 124 -- the addr modes of the args is that we may be in a "knot", and
 125 -- premature looking at the args will cause the compiler to black-hole!
 126 \end{code}
 127
 128 First we deal with the case of zero-arity constructors.  Now, they
 129 will probably be unfolded, so we don't expect to see this case much,
 130 if at all, but it does no harm, and sets the scene for characters.
 131
 132 In the case of zero-arity constructors, or, more accurately, those
 133 which have exclusively size-zero (VoidRep) args, we generate no code
 134 at all.
 135
 136 \begin{code}
 137 buildDynCon binder cc con []
 138   = returnFC (taggedStableIdInfo binder
 139                            (mkLblExpr (mkClosureLabel (dataConName con)))
 140                            (mkConLFInfo con)
 141                            con)
 142 \end{code}
 143
 144 The following three paragraphs about @Char@-like and @Int@-like
 145 closures are obsolete, but I don't understand the details well enough
 146 to properly word them, sorry. I've changed the treatment of @Char@s to
 147 be analogous to @Int@s: only a subset is preallocated, because @Char@
 148 has now 31 bits. Only literals are handled here. -- Qrczak
 149
 150 Now for @Char@-like closures.  We generate an assignment of the
 151 address of the closure to a temporary.  It would be possible simply to
 152 generate no code, and record the addressing mode in the environment,
 153 but we'd have to be careful if the argument wasn't a constant --- so
 154 for simplicity we just always asssign to a temporary.
 155
 156 Last special case: @Int@-like closures.  We only special-case the
 157 situation in which the argument is a literal in the range
 158 @mIN_INTLIKE@..@mAX_INTLILKE@.  NB: for @Char@-like closures we can
 159 work with any old argument, but for @Int@-like ones the argument has
 160 to be a literal.  Reason: @Char@ like closures have an argument type
 161 which is guaranteed in range.
 162
 163 Because of this, we use can safely return an addressing mode.
 164
 165 \begin{code}
 166 buildDynCon binder cc con [arg_amode]
 167   | maybeIntLikeCon con
 168   , (_, CmmLit (CmmInt val _)) <- arg_amode
 169   , let val_int = (fromIntegral val) :: Int
 170   , val_int <= mAX_INTLIKE && val_int >= mIN_INTLIKE
 171   = do  { let intlike_lbl   = mkRtsDataLabel SLIT("stg_INTLIKE_closure")
 172               offsetW = (val_int - mIN_INTLIKE) * (fixedHdrSize + 1)
 173                 -- INTLIKE closures consist of a header and one word payload
 174               intlike_amode = CmmLit (cmmLabelOffW intlike_lbl offsetW)
 175         ; returnFC (taggedStableIdInfo binder intlike_amode (mkConLFInfo con) con) }
 176
 177 buildDynCon binder cc con [arg_amode]
 178   | maybeCharLikeCon con
 179   , (_, CmmLit (CmmInt val _)) <- arg_amode
 180   , let val_int = (fromIntegral val) :: Int
 181   , val_int <= mAX_CHARLIKE && val_int >= mIN_CHARLIKE
 182   = do  { let charlike_lbl   = mkRtsDataLabel SLIT("stg_CHARLIKE_closure")
 183               offsetW = (val_int - mIN_CHARLIKE) * (fixedHdrSize + 1)
 184                 -- CHARLIKE closures consist of a header and one word payload
 185               charlike_amode = CmmLit (cmmLabelOffW charlike_lbl offsetW)
 186         ; returnFC (taggedStableIdInfo binder charlike_amode (mkConLFInfo con) con) }
 187 \end{code}
 188
 189 Now the general case.
 190
 191 \begin{code}
 192 buildDynCon binder ccs con args
 193   = do  {
 194         ; let
 195             (closure_info, amodes_w_offsets) = layOutDynConstr con args
 196
 197         ; hp_off <- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
 198         ; returnFC (taggedHeapIdInfo binder hp_off lf_info con) }
 199   where
 200     lf_info = mkConLFInfo con
 201
 202     use_cc      -- cost-centre to stick in the object
 203       | currentOrSubsumedCCS ccs = curCCS
 204       | otherwise                = CmmLit (mkCCostCentreStack ccs)
 205
 206     blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
 207 \end{code}
 208
 209
 210 %************************************************************************
 211 %*                                                                      *
 212 %* constructor-related utility function:                                *
 213 %*              bindConArgs is called from cgAlt of a case              *
 214 %*                                                                      *
 215 %************************************************************************
 216 \subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
 217
 218 @bindConArgs@ $con args$ augments the environment with bindings for the
 219 binders $args$, assuming that we have just returned from a @case@ which
 220 found a $con$.
 221
 222 \begin{code}
 223 bindConArgs :: DataCon -> [Id] -> Code
 224 bindConArgs con args
 225   = do
 226        let
 227           -- The binding below forces the masking out of the tag bits
 228           -- when accessing the constructor field.
 229           bind_arg (arg, offset) = bindNewToUntagNode arg offset (mkLFArgument arg) (tagForCon con)
 230           (_, args_w_offsets)    = layOutDynConstr con (addIdReps args)
 231         --
 232        ASSERT(not (isUnboxedTupleCon con)) return ()
 233        mapCs bind_arg args_w_offsets
 234 \end{code}
 235
 236 Unboxed tuples are handled slightly differently - the object is
 237 returned in registers and on the stack instead of the heap.
 238
 239 \begin{code}
 240 bindUnboxedTupleComponents
 241         :: [Id]                         -- Args
 242         -> FCode ([(Id,GlobalReg)],     -- Regs assigned
 243                   WordOff,              -- Number of pointer stack slots
 244                   WordOff,              -- Number of non-pointer stack slots
 245                   VirtualSpOffset)      -- Offset of return address slot
 246                                         -- (= realSP on entry)
 247
 248 bindUnboxedTupleComponents args
 249  =  do  {
 250           vsp <- getVirtSp
 251         ; rsp <- getRealSp
 252
 253            -- Assign as many components as possible to registers
 254         ; let (reg_args, stk_args) = assignReturnRegs (addIdReps args)
 255
 256                 -- Separate the rest of the args into pointers and non-pointers
 257               (ptr_args, nptr_args) = separateByPtrFollowness stk_args
 258
 259                 -- Allocate the rest on the stack
 260                 -- The real SP points to the return address, above which any
 261                 -- leftover unboxed-tuple components will be allocated
 262               (ptr_sp,  ptr_offsets)  = mkVirtStkOffsets rsp    ptr_args
 263               (nptr_sp, nptr_offsets) = mkVirtStkOffsets ptr_sp nptr_args
 264               ptrs  = ptr_sp  - rsp
 265               nptrs = nptr_sp - ptr_sp
 266
 267             -- The stack pointer points to the last stack-allocated component
 268         ; setRealAndVirtualSp nptr_sp
 269
 270             -- We have just allocated slots starting at real SP + 1, and set the new
 271             -- virtual SP to the topmost allocated slot.
 272             -- If the virtual SP started *below* the real SP, we've just jumped over
 273             -- some slots that won't be in the free-list, so put them there
 274             -- This commonly happens because we've freed the return-address slot
 275             -- (trimming back the virtual SP), but the real SP still points to that slot
 276         ; freeStackSlots [vsp+1,vsp+2 .. rsp]
 277
 278         ; bindArgsToRegs reg_args
 279         ; bindArgsToStack ptr_offsets
 280         ; bindArgsToStack nptr_offsets
 281
 282         ; returnFC (reg_args, ptrs, nptrs, rsp) }
 283 \end{code}
 284
 285 %************************************************************************
 286 %*                                                                      *
 287         Actually generate code for a constructor return
 288 %*                                                                      *
 289 %************************************************************************
 290
 291
 292 Note: it's the responsibility of the @cgReturnDataCon@ caller to be
 293 sure the @amodes@ passed don't conflict with each other.
 294 \begin{code}
 295 cgReturnDataCon :: DataCon -> [(CgRep, CmmExpr)] -> Code
 296
 297 cgReturnDataCon con amodes
 298   = ASSERT( amodes `lengthIs` dataConRepArity con )
 299     do  { EndOfBlockInfo _ sequel <- getEndOfBlockInfo
 300         ; case sequel of
 301             CaseAlts _ (Just (alts, deflt_lbl)) bndr
 302               ->    -- Ho! We know the constructor so we can
 303                     -- go straight to the right alternative
 304                  case assocMaybe alts (dataConTagZ con) of {
 305                     Just join_lbl -> build_it_then (jump_to join_lbl);
 306                     Nothing
 307                         -- Special case!  We're returning a constructor to the default case
 308                         -- of an enclosing case.  For example:
 309                         --
 310                         --      case (case e of (a,b) -> C a b) of
 311                         --        D x -> ...
 312                         --        y   -> ...<returning here!>...
 313                         --
 314                         -- In this case,
 315                         --      if the default is a non-bind-default (ie does not use y),
 316                         --      then we should simply jump to the default join point;
 317
 318                         | isDeadBinder bndr -> performReturn (jump_to deflt_lbl)
 319                         | otherwise         -> build_it_then (jump_to deflt_lbl) }
 320
 321             other_sequel        -- The usual case
 322               | isUnboxedTupleCon con -> returnUnboxedTuple amodes
 323               | otherwise -> build_it_then emitReturnInstr
 324         }
 325   where
 326     jump_to lbl = stmtC (CmmJump (CmmLit lbl) [])
 327     build_it_then return_code
 328       = do {    -- BUILD THE OBJECT IN THE HEAP
 329                 -- The first "con" says that the name bound to this
 330                 -- closure is "con", which is a bit of a fudge, but it only
 331                 -- affects profiling
 332
 333                 -- This Id is also used to get a unique for a
 334                 -- temporary variable, if the closure is a CHARLIKE.
 335                 -- funnily enough, this makes the unique always come
 336                 -- out as '54' :-)
 337              tickyReturnNewCon (length amodes)
 338            ; idinfo <- buildDynCon (dataConWorkId con) currentCCS con amodes
 339            ; amode <- idInfoToAmode idinfo
 340            ; checkedAbsC (CmmAssign nodeReg amode)
 341            ; performReturn return_code }
 342 \end{code}
 343
 344
 345 %************************************************************************
 346 %*                                                                      *
 347         Generating static stuff for algebraic data types
 348 %*                                                                      *
 349 %************************************************************************
 350
 351         [These comments are rather out of date]
 352
 353 \begin{tabular}{lll}
 354 Info tbls &      Macro  &            Kind of constructor \\
 355 \hline
 356 info & @CONST_INFO_TABLE@&    Zero arity (no info -- compiler uses static closure)\\
 357 info & @CHARLIKE_INFO_TABLE@& Charlike   (no info -- compiler indexes fixed array)\\
 358 info & @INTLIKE_INFO_TABLE@&  Intlike; the one macro generates both info tbls\\
 359 info & @SPEC_INFO_TABLE@&     SPECish, and bigger than or equal to @MIN_UPD_SIZE@\\
 360 info & @GEN_INFO_TABLE@&      GENish (hence bigger than or equal to @MIN_UPD_SIZE@)\\
 361 \end{tabular}
 362
 363 Possible info tables for constructor con:
 364
 365 \begin{description}
 366 \item[@_con_info@:]
 367 Used for dynamically let(rec)-bound occurrences of
 368 the constructor, and for updates.  For constructors
 369 which are int-like, char-like or nullary, when GC occurs,
 370 the closure tries to get rid of itself.
 371
 372 \item[@_static_info@:]
 373 Static occurrences of the constructor
 374 macro: @STATIC_INFO_TABLE@.
 375 \end{description}
 376
 377 For zero-arity constructors, \tr{con}, we NO LONGER generate a static closure;
 378 it's place is taken by the top level defn of the constructor.
 379
 380 For charlike and intlike closures there is a fixed array of static
 381 closures predeclared.
 382
 383 \begin{code}
 384 cgTyCon :: TyCon -> FCode [Cmm]  -- each constructor gets a separate Cmm
 385 cgTyCon tycon
 386   = do  { constrs <- mapM (getCmm . cgDataCon) (tyConDataCons tycon)
 387
 388             -- Generate a table of static closures for an enumeration type
 389             -- Put the table after the data constructor decls, because the
 390             -- datatype closure table (for enumeration types)
 391             -- to (say) PrelBase_$wTrue_closure, which is defined in code_stuff
 392             -- Note that the closure pointers are tagged.
 393         ; extra <-
 394            if isEnumerationTyCon tycon then do
 395                 tbl <- getCmm (emitRODataLits (mkLocalClosureTableLabel
 396                                                 (tyConName tycon))
 397                            [ CmmLabelOff (mkLocalClosureLabel (dataConName con)) (tagForCon con)
 398                            | con <- tyConDataCons tycon])
 399                 return [tbl]
 400            else
 401                 return []
 402
 403         ; return (extra ++ constrs)
 404     }
 405 \end{code}
 406
 407 Generate the entry code, info tables, and (for niladic constructor) the
 408 static closure, for a constructor.
 409
 410 \begin{code}
 411 cgDataCon :: DataCon -> Code
 412 cgDataCon data_con
 413   = do  {     -- Don't need any dynamic closure code for zero-arity constructors
 414
 415         ; let
 416             -- To allow the debuggers, interpreters, etc to cope with
 417             -- static data structures (ie those built at compile
 418             -- time), we take care that info-table contains the
 419             -- information we need.
 420             (static_cl_info, _) =
 421                 layOutStaticConstr data_con arg_reps
 422
 423             (dyn_cl_info, arg_things) =
 424                 layOutDynConstr    data_con arg_reps
 425
 426             emit_info cl_info ticky_code
 427                 = do { code_blks <- getCgStmts the_code
 428                      ; emitClosureCodeAndInfoTable cl_info [] code_blks }
 429                 where
 430                   the_code = do { ticky_code
 431                                 ; ldvEnter (CmmReg nodeReg)
 432                                 ; body_code }
 433
 434             arg_reps :: [(CgRep, Type)]
 435             arg_reps = [(typeCgRep ty, ty) | ty <- dataConRepArgTys data_con]
 436
 437             body_code = do {
 438                         -- NB: We don't set CC when entering data (WDP 94/06)
 439                              tickyReturnOldCon (length arg_things)
 440                            -- The case continuation code is expecting a tagged pointer
 441                            ; stmtC (CmmAssign nodeReg
 442                                               (tagCons data_con (CmmReg nodeReg)))
 443                            ; performReturn emitReturnInstr }
 444                                 -- noStmts: Ptr to thing already in Node
 445
 446         ; whenC (not (isNullaryRepDataCon data_con))
 447                 (emit_info dyn_cl_info tickyEnterDynCon)
 448
 449                 -- Dynamic-Closure first, to reduce forward references
 450         ; emit_info static_cl_info tickyEnterStaticCon }
 451 \end{code}