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