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