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