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