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