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 FastString
  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 $ idCafInfo id
  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 _ con []
 138   = returnFC (taggedStableIdInfo binder
 139                            (mkLblExpr (mkClosureLabel (dataConName con)
 140                                       (idCafInfo binder)))
 141                            (mkConLFInfo con)
 142                            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 _ 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   = mkRtsGcPtrLabel (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 (taggedStableIdInfo binder intlike_amode (mkConLFInfo con) con) }
 177
 178 buildDynCon binder _ 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   = mkRtsGcPtrLabel (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 (taggedStableIdInfo binder charlike_amode (mkConLFInfo con) con) }
 188 \end{code}
 189
 190 Now the general case.
 191
 192 \begin{code}
 193 buildDynCon binder ccs con args
 194   = do  {
 195         ; let
 196             (closure_info, amodes_w_offsets) = layOutDynConstr con args
 197
 198         ; hp_off <- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
 199         ; returnFC (taggedHeapIdInfo binder hp_off lf_info con) }
 200   where
 201     lf_info = mkConLFInfo con
 202
 203     use_cc      -- cost-centre to stick in the object
 204       | currentOrSubsumedCCS ccs = curCCS
 205       | otherwise                = CmmLit (mkCCostCentreStack ccs)
 206
 207     blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
 208 \end{code}
 209
 210
 211 %************************************************************************
 212 %*                                                                      *
 213 %* constructor-related utility function:                                *
 214 %*              bindConArgs is called from cgAlt of a case              *
 215 %*                                                                      *
 216 %************************************************************************
 217 \subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
 218
 219 @bindConArgs@ $con args$ augments the environment with bindings for the
 220 binders $args$, assuming that we have just returned from a @case@ which
 221 found a $con$.
 222
 223 \begin{code}
 224 bindConArgs :: DataCon -> [Id] -> Code
 225 bindConArgs con args
 226   = do
 227        let
 228           -- The binding below forces the masking out of the tag bits
 229           -- when accessing the constructor field.
 230           bind_arg (arg, offset) = bindNewToUntagNode arg offset (mkLFArgument arg) (tagForCon con)
 231           (_, args_w_offsets)    = layOutDynConstr con (addIdReps args)
 232         --
 233        ASSERT(not (isUnboxedTupleCon con)) return ()
 234        mapCs bind_arg args_w_offsets
 235 \end{code}
 236
 237 Unboxed tuples are handled slightly differently - the object is
 238 returned in registers and on the stack instead of the heap.
 239
 240 \begin{code}
 241 bindUnboxedTupleComponents
 242         :: [Id]                         -- Args
 243         -> FCode ([(Id,GlobalReg)],     -- Regs assigned
 244                   WordOff,              -- Number of pointer stack slots
 245                   WordOff,              -- Number of non-pointer stack slots
 246                   VirtualSpOffset)      -- Offset of return address slot
 247                                         -- (= realSP on entry)
 248
 249 bindUnboxedTupleComponents args
 250  =  do  {
 251           vsp <- getVirtSp
 252         ; rsp <- getRealSp
 253
 254            -- Assign as many components as possible to registers
 255         ; let (reg_args, stk_args) = assignReturnRegs (addIdReps args)
 256
 257                 -- Separate the rest of the args into pointers and non-pointers
 258               (ptr_args, nptr_args) = separateByPtrFollowness stk_args
 259
 260                 -- Allocate the rest on the stack
 261                 -- The real SP points to the return address, above which any
 262                 -- leftover unboxed-tuple components will be allocated
 263               (ptr_sp,  ptr_offsets)  = mkVirtStkOffsets rsp    ptr_args
 264               (nptr_sp, nptr_offsets) = mkVirtStkOffsets ptr_sp nptr_args
 265               ptrs  = ptr_sp  - rsp
 266               nptrs = nptr_sp - ptr_sp
 267
 268             -- The stack pointer points to the last stack-allocated component
 269         ; setRealAndVirtualSp nptr_sp
 270
 271             -- We have just allocated slots starting at real SP + 1, and set the new
 272             -- virtual SP to the topmost allocated slot.
 273             -- If the virtual SP started *below* the real SP, we've just jumped over
 274             -- some slots that won't be in the free-list, so put them there
 275             -- This commonly happens because we've freed the return-address slot
 276             -- (trimming back the virtual SP), but the real SP still points to that slot
 277         ; freeStackSlots [vsp+1,vsp+2 .. rsp]
 278
 279         ; bindArgsToRegs reg_args
 280         ; bindArgsToStack ptr_offsets
 281         ; bindArgsToStack nptr_offsets
 282
 283         ; returnFC (reg_args, ptrs, nptrs, rsp) }
 284 \end{code}
 285
 286 %************************************************************************
 287 %*                                                                      *
 288         Actually generate code for a constructor return
 289 %*                                                                      *
 290 %************************************************************************
 291
 292
 293 Note: it's the responsibility of the @cgReturnDataCon@ caller to be
 294 sure the @amodes@ passed don't conflict with each other.
 295 \begin{code}
 296 cgReturnDataCon :: DataCon -> [(CgRep, CmmExpr)] -> Code
 297
 298 cgReturnDataCon con amodes
 299   = ASSERT( amodes `lengthIs` dataConRepArity con )
 300     do  { EndOfBlockInfo _ sequel <- getEndOfBlockInfo
 301         ; case sequel of
 302             CaseAlts _ (Just (alts, deflt_lbl)) bndr
 303               ->    -- Ho! We know the constructor so we can
 304                     -- go straight to the right alternative
 305                  case assocMaybe alts (dataConTagZ con) of {
 306                     Just join_lbl -> build_it_then (jump_to join_lbl);
 307                     Nothing
 308                         -- Special case!  We're returning a constructor to the default case
 309                         -- of an enclosing case.  For example:
 310                         --
 311                         --      case (case e of (a,b) -> C a b) of
 312                         --        D x -> ...
 313                         --        y   -> ...<returning here!>...
 314                         --
 315                         -- In this case,
 316                         --      if the default is a non-bind-default (ie does not use y),
 317                         --      then we should simply jump to the default join point;
 318
 319                         | isDeadBinder bndr -> performReturn (jump_to deflt_lbl)
 320                         | otherwise         -> build_it_then (jump_to deflt_lbl) }
 321
 322             _   -- The usual case
 323               | isUnboxedTupleCon con -> returnUnboxedTuple amodes
 324               | otherwise -> build_it_then emitReturnInstr
 325         }
 326   where
 327     jump_to lbl = stmtC (CmmJump (CmmLit lbl) [])
 328     build_it_then return_code
 329       = do {    -- BUILD THE OBJECT IN THE HEAP
 330                 -- The first "con" says that the name bound to this
 331                 -- closure is "con", which is a bit of a fudge, but it only
 332                 -- affects profiling
 333
 334                 -- This Id is also used to get a unique for a
 335                 -- temporary variable, if the closure is a CHARLIKE.
 336                 -- funnily enough, this makes the unique always come
 337                 -- out as '54' :-)
 338              tickyReturnNewCon (length amodes)
 339            ; idinfo <- buildDynCon (dataConWorkId con) currentCCS con amodes
 340            ; amode <- idInfoToAmode idinfo
 341            ; checkedAbsC (CmmAssign nodeReg amode)
 342            ; performReturn return_code }
 343 \end{code}
 344
 345
 346 %************************************************************************
 347 %*                                                                      *
 348         Generating static stuff for algebraic data types
 349 %*                                                                      *
 350 %************************************************************************
 351
 352         [These comments are rather out of date]
 353
 354 \begin{tabular}{lll}
 355 Info tbls &      Macro  &            Kind of constructor \\
 356 \hline
 357 info & @CONST_INFO_TABLE@&    Zero arity (no info -- compiler uses static closure)\\
 358 info & @CHARLIKE_INFO_TABLE@& Charlike   (no info -- compiler indexes fixed array)\\
 359 info & @INTLIKE_INFO_TABLE@&  Intlike; the one macro generates both info tbls\\
 360 info & @SPEC_INFO_TABLE@&     SPECish, and bigger than or equal to @MIN_UPD_SIZE@\\
 361 info & @GEN_INFO_TABLE@&      GENish (hence bigger than or equal to @MIN_UPD_SIZE@)\\
 362 \end{tabular}
 363
 364 Possible info tables for constructor con:
 365
 366 \begin{description}
 367 \item[@_con_info@:]
 368 Used for dynamically let(rec)-bound occurrences of
 369 the constructor, and for updates.  For constructors
 370 which are int-like, char-like or nullary, when GC occurs,
 371 the closure tries to get rid of itself.
 372
 373 \item[@_static_info@:]
 374 Static occurrences of the constructor
 375 macro: @STATIC_INFO_TABLE@.
 376 \end{description}
 377
 378 For zero-arity constructors, \tr{con}, we NO LONGER generate a static closure;
 379 it's place is taken by the top level defn of the constructor.
 380
 381 For charlike and intlike closures there is a fixed array of static
 382 closures predeclared.
 383
 384 \begin{code}
 385 cgTyCon :: TyCon -> FCode [Cmm]  -- each constructor gets a separate Cmm
 386 cgTyCon tycon
 387   = do  { constrs <- mapM (getCmm . cgDataCon) (tyConDataCons tycon)
 388
 389             -- Generate a table of static closures for an enumeration type
 390             -- Put the table after the data constructor decls, because the
 391             -- datatype closure table (for enumeration types)
 392             -- to (say) PrelBase_$wTrue_closure, which is defined in code_stuff
 393             -- Note that the closure pointers are tagged.
 394
 395             -- XXX comment says to put table after constructor decls, but
 396             -- code appears to put it before --- NR 16 Aug 2007
 397         ; extra <-
 398            if isEnumerationTyCon tycon then do
 399                 tbl <- getCmm (emitRODataLits "cgTyCon" (mkLocalClosureTableLabel (tyConName tycon) NoCafRefs)
 400                            [ CmmLabelOff (mkLocalClosureLabel (dataConName con) NoCafRefs) (tagForCon con)
 401                            | con <- tyConDataCons tycon])
 402                 return [tbl]
 403            else
 404                 return []
 405
 406         ; return (extra ++ constrs)
 407     }
 408 \end{code}
 409
 410 Generate the entry code, info tables, and (for niladic constructor) the
 411 static closure, for a constructor.
 412
 413 \begin{code}
 414 cgDataCon :: DataCon -> Code
 415 cgDataCon data_con
 416   = do  {     -- Don't need any dynamic closure code for zero-arity constructors
 417
 418         ; let
 419             -- To allow the debuggers, interpreters, etc to cope with
 420             -- static data structures (ie those built at compile
 421             -- time), we take care that info-table contains the
 422             -- information we need.
 423             (static_cl_info, _) =
 424                 layOutStaticConstr data_con arg_reps
 425
 426             (dyn_cl_info, arg_things) =
 427                 layOutDynConstr    data_con arg_reps
 428
 429             emit_info cl_info ticky_code
 430                 = do { code_blks <- getCgStmts the_code
 431                      ; emitClosureCodeAndInfoTable cl_info [] code_blks }
 432                 where
 433                   the_code = do { ticky_code
 434                                 ; ldvEnter (CmmReg nodeReg)
 435                                 ; body_code }
 436
 437             arg_reps :: [(CgRep, Type)]
 438             arg_reps = [(typeCgRep ty, ty) | ty <- dataConRepArgTys data_con]
 439
 440             body_code = do {
 441                         -- NB: We don't set CC when entering data (WDP 94/06)
 442                              tickyReturnOldCon (length arg_things)
 443                            -- The case continuation code is expecting a tagged pointer
 444                            ; stmtC (CmmAssign nodeReg
 445                                               (tagCons data_con (CmmReg nodeReg)))
 446                            ; performReturn emitReturnInstr }
 447                                 -- noStmts: Ptr to thing already in Node
 448
 449         ; whenC (not (isNullaryRepDataCon data_con))
 450                 (emit_info dyn_cl_info tickyEnterDynCon)
 451
 452                 -- Dynamic-Closure first, to reduce forward references
 453         ; emit_info static_cl_info tickyEnterStaticCon }
 454 \end{code}