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