ghc/compiler/codeGen/CgCon.lhs

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