ghc/compiler/codeGen/CgCon.lhs

   1 %
   2 % (c) The GRASP Project, Glasgow University, 1992-1998
   3 %
   4 \section[CgCon]{Code generation for constructors}
   5
   6 This module provides the support code for @StgToAbstractC@ to deal
   7 with {\em constructors} on the RHSs of let(rec)s.  See also
   8 @CgClosure@, which deals with closures.
   9
  10 \begin{code}
  11 module CgCon (
  12         cgTopRhsCon, buildDynCon,
  13         bindConArgs, bindUnboxedTupleComponents,
  14         cgReturnDataCon,
  15         cgTyCon
  16     ) where
  17
  18 #include "HsVersions.h"
  19
  20 import CgMonad
  21 import StgSyn
  22
  23 import CgBindery        ( getArgAmodes, bindNewToNode,
  24                           bindArgsToRegs, idInfoToAmode, stableIdInfo,
  25                           heapIdInfo, CgIdInfo, bindArgsToStack
  26                         )
  27 import CgStackery       ( mkVirtStkOffsets, freeStackSlots,
  28                           getRealSp, getVirtSp, setRealAndVirtualSp )
  29 import CgUtils          ( addIdReps, cmmLabelOffW, emitRODataLits, emitDataLits )
  30 import CgCallConv       ( assignReturnRegs )
  31 import Constants        ( mAX_INTLIKE, mIN_INTLIKE, mAX_CHARLIKE, mIN_CHARLIKE )
  32 import CgHeapery        ( allocDynClosure, layOutDynConstr,
  33                           layOutStaticConstr, mkStaticClosureFields )
  34 import CgTailCall       ( performReturn, emitKnownConReturnCode, returnUnboxedTuple )
  35 import CgProf           ( mkCCostCentreStack, ldvEnter, curCCS )
  36 import CgTicky
  37 import CgInfoTbls       ( emitClosureCodeAndInfoTable, dataConTagZ )
  38 import CLabel
  39 import ClosureInfo      ( mkConLFInfo, mkLFArgument )
  40 import CmmUtils         ( mkLblExpr )
  41 import Cmm
  42 import SMRep            ( WordOff, CgRep, separateByPtrFollowness,
  43                           fixedHdrSize, typeCgRep )
  44 import CostCentre       ( currentOrSubsumedCCS, dontCareCCS, CostCentreStack,
  45                           currentCCS )
  46 import Constants        ( mIN_INTLIKE, mAX_INTLIKE, mIN_CHARLIKE, mAX_CHARLIKE )
  47 import TyCon            ( TyCon, tyConDataCons, isEnumerationTyCon, tyConName )
  48 import DataCon          ( DataCon, dataConRepArgTys, isNullaryRepDataCon,
  49                           isUnboxedTupleCon, dataConWorkId,
  50                           dataConName, dataConRepArity
  51                         )
  52 import Id               ( Id, idName, isDeadBinder )
  53 import Type             ( Type )
  54 import PrelInfo         ( maybeCharLikeCon, maybeIntLikeCon )
  55 import Outputable
  56 import Util             ( lengthIs )
  57 import ListSetOps       ( assocMaybe )
  58 \end{code}
  59
  60
  61 %************************************************************************
  62 %*                                                                      *
  63 \subsection[toplevel-constructors]{Top-level constructors}
  64 %*                                                                      *
  65 %************************************************************************
  66
  67 \begin{code}
  68 cgTopRhsCon :: Id               -- Name of thing bound to this RHS
  69             -> DataCon          -- Id
  70             -> [StgArg]         -- Args
  71             -> FCode (Id, CgIdInfo)
  72 cgTopRhsCon id con args
  73   = do {
  74         ; dflags <- getDynFlags
  75         ; ASSERT( not (isDllConApp dflags con args) ) return ()
  76         ; ASSERT( args `lengthIs` dataConRepArity con ) return ()
  77
  78         -- LAY IT OUT
  79         ; amodes <- getArgAmodes args
  80
  81         ; let
  82             name          = idName id
  83             lf_info       = mkConLFInfo con
  84             closure_label = mkClosureLabel dflags name
  85             caffy         = any stgArgHasCafRefs args
  86             (closure_info, amodes_w_offsets) = layOutStaticConstr dflags con amodes
  87             closure_rep = mkStaticClosureFields
  88                              closure_info
  89                              dontCareCCS                -- Because it's static data
  90                              caffy                      -- Has CAF refs
  91                              payload
  92
  93             payload = map get_lit amodes_w_offsets
  94             get_lit (CmmLit lit, _offset) = lit
  95             get_lit other = pprPanic "CgCon.get_lit" (ppr other)
  96                 -- NB1: amodes_w_offsets is sorted into ptrs first, then non-ptrs
  97                 -- NB2: all the amodes should be Lits!
  98
  99                 -- BUILD THE OBJECT
 100         ; emitDataLits closure_label closure_rep
 101
 102                 -- RETURN
 103         ; returnFC (id, stableIdInfo id (mkLblExpr closure_label) lf_info) }
 104 \end{code}
 105
 106 %************************************************************************
 107 %*                                                                      *
 108 %* non-top-level constructors                                           *
 109 %*                                                                      *
 110 %************************************************************************
 111 \subsection[code-for-constructors]{The code for constructors}
 112
 113 \begin{code}
 114 buildDynCon :: Id                 -- Name of the thing to which this constr will
 115                                   -- be bound
 116             -> CostCentreStack    -- Where to grab cost centre from;
 117                                   -- current CCS if currentOrSubsumedCCS
 118             -> DataCon            -- The data constructor
 119             -> [(CgRep,CmmExpr)] -- Its args
 120             -> FCode CgIdInfo     -- Return details about how to find it
 121
 122 -- We used to pass a boolean indicating whether all the
 123 -- args were of size zero, so we could use a static
 124 -- construtor; but I concluded that it just isn't worth it.
 125 -- Now I/O uses unboxed tuples there just aren't any constructors
 126 -- with all size-zero args.
 127 --
 128 -- The reason for having a separate argument, rather than looking at
 129 -- the addr modes of the args is that we may be in a "knot", and
 130 -- premature looking at the args will cause the compiler to black-hole!
 131 \end{code}
 132
 133 First we deal with the case of zero-arity constructors.  Now, they
 134 will probably be unfolded, so we don't expect to see this case much,
 135 if at all, but it does no harm, and sets the scene for characters.
 136
 137 In the case of zero-arity constructors, or, more accurately, those
 138 which have exclusively size-zero (VoidRep) args, we generate no code
 139 at all.
 140
 141 \begin{code}
 142 buildDynCon binder cc con []
 143   = do dflags <- getDynFlags
 144        returnFC (stableIdInfo binder
 145                            (mkLblExpr (mkClosureLabel dflags (dataConName con)))
 146                            (mkConLFInfo con))
 147 \end{code}
 148
 149 The following three paragraphs about @Char@-like and @Int@-like
 150 closures are obsolete, but I don't understand the details well enough
 151 to properly word them, sorry. I've changed the treatment of @Char@s to
 152 be analogous to @Int@s: only a subset is preallocated, because @Char@
 153 has now 31 bits. Only literals are handled here. -- Qrczak
 154
 155 Now for @Char@-like closures.  We generate an assignment of the
 156 address of the closure to a temporary.  It would be possible simply to
 157 generate no code, and record the addressing mode in the environment,
 158 but we'd have to be careful if the argument wasn't a constant --- so
 159 for simplicity we just always asssign to a temporary.
 160
 161 Last special case: @Int@-like closures.  We only special-case the
 162 situation in which the argument is a literal in the range
 163 @mIN_INTLIKE@..@mAX_INTLILKE@.  NB: for @Char@-like closures we can
 164 work with any old argument, but for @Int@-like ones the argument has
 165 to be a literal.  Reason: @Char@ like closures have an argument type
 166 which is guaranteed in range.
 167
 168 Because of this, we use can safely return an addressing mode.
 169
 170 \begin{code}
 171 buildDynCon binder cc con [arg_amode]
 172   | maybeIntLikeCon con
 173   , (_, CmmLit (CmmInt val _)) <- arg_amode
 174   , let val_int = (fromIntegral val) :: Int
 175   , val_int <= mAX_INTLIKE && val_int >= mIN_INTLIKE
 176   = do  { let intlike_lbl   = mkRtsDataLabel SLIT("stg_INTLIKE_closure")
 177               offsetW = (val_int - mIN_INTLIKE) * (fixedHdrSize + 1)
 178                 -- INTLIKE closures consist of a header and one word payload
 179               intlike_amode = CmmLit (cmmLabelOffW intlike_lbl offsetW)
 180         ; returnFC (stableIdInfo binder intlike_amode (mkConLFInfo con)) }
 181
 182 buildDynCon binder cc con [arg_amode]
 183   | maybeCharLikeCon con
 184   , (_, CmmLit (CmmInt val _)) <- arg_amode
 185   , let val_int = (fromIntegral val) :: Int
 186   , val_int <= mAX_CHARLIKE && val_int >= mIN_CHARLIKE
 187   = do  { let charlike_lbl   = mkRtsDataLabel SLIT("stg_CHARLIKE_closure")
 188               offsetW = (val_int - mIN_CHARLIKE) * (fixedHdrSize + 1)
 189                 -- CHARLIKE closures consist of a header and one word payload
 190               charlike_amode = CmmLit (cmmLabelOffW charlike_lbl offsetW)
 191         ; returnFC (stableIdInfo binder charlike_amode (mkConLFInfo con)) }
 192 \end{code}
 193
 194 Now the general case.
 195
 196 \begin{code}
 197 buildDynCon binder ccs con args
 198   = do  {
 199         ; dflags <- getDynFlags
 200         ; let
 201             (closure_info, amodes_w_offsets) = layOutDynConstr dflags con args
 202
 203         ; hp_off <- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
 204         ; returnFC (heapIdInfo binder hp_off lf_info) }
 205   where
 206     lf_info = mkConLFInfo con
 207
 208     use_cc      -- cost-centre to stick in the object
 209       | currentOrSubsumedCCS ccs = curCCS
 210       | otherwise                = CmmLit (mkCCostCentreStack ccs)
 211
 212     blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
 213 \end{code}
 214
 215
 216 %************************************************************************
 217 %*                                                                      *
 218 %* constructor-related utility function:                                *
 219 %*              bindConArgs is called from cgAlt of a case              *
 220 %*                                                                      *
 221 %************************************************************************
 222 \subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
 223
 224 @bindConArgs@ $con args$ augments the environment with bindings for the
 225 binders $args$, assuming that we have just returned from a @case@ which
 226 found a $con$.
 227
 228 \begin{code}
 229 bindConArgs :: DataCon -> [Id] -> Code
 230 bindConArgs con args
 231   = do dflags <- getDynFlags
 232        let
 233           bind_arg (arg, offset) = bindNewToNode arg offset (mkLFArgument arg)
 234           (_, args_w_offsets)    = layOutDynConstr dflags 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   = ASSERT( amodes `lengthIs` dataConRepArity con )
 303     do  { EndOfBlockInfo _ sequel <- getEndOfBlockInfo
 304         ; case sequel of
 305             CaseAlts _ (Just (alts, deflt_lbl)) bndr _
 306               ->    -- Ho! We know the constructor so we can
 307                     -- go straight to the right alternative
 308                  case assocMaybe alts (dataConTagZ con) of {
 309                     Just join_lbl -> build_it_then (jump_to join_lbl);
 310                     Nothing
 311                         -- Special case!  We're returning a constructor to the default case
 312                         -- of an enclosing case.  For example:
 313                         --
 314                         --      case (case e of (a,b) -> C a b) of
 315                         --        D x -> ...
 316                         --        y   -> ...<returning here!>...
 317                         --
 318                         -- In this case,
 319                         --      if the default is a non-bind-default (ie does not use y),
 320                         --      then we should simply jump to the default join point;
 321
 322                         | isDeadBinder bndr -> performReturn (jump_to deflt_lbl)
 323                         | otherwise         -> build_it_then (jump_to deflt_lbl) }
 324
 325             other_sequel        -- The usual case
 326               | isUnboxedTupleCon con -> returnUnboxedTuple amodes
 327               | otherwise -> build_it_then (emitKnownConReturnCode con)
 328         }
 329   where
 330     jump_to lbl = stmtC (CmmJump (CmmLit lbl) [])
 331     build_it_then return_code
 332       = do {    -- BUILD THE OBJECT IN THE HEAP
 333                 -- The first "con" says that the name bound to this
 334                 -- closure is "con", which is a bit of a fudge, but it only
 335                 -- affects profiling
 336
 337                 -- This Id is also used to get a unique for a
 338                 -- temporary variable, if the closure is a CHARLIKE.
 339                 -- funnily enough, this makes the unique always come
 340                 -- out as '54' :-)
 341              tickyReturnNewCon (length amodes)
 342            ; idinfo <- buildDynCon (dataConWorkId con) currentCCS con amodes
 343            ; amode <- idInfoToAmode idinfo
 344            ; checkedAbsC (CmmAssign nodeReg amode)
 345            ; performReturn return_code }
 346 \end{code}
 347
 348
 349 %************************************************************************
 350 %*                                                                      *
 351         Generating static stuff for algebraic data types
 352 %*                                                                      *
 353 %************************************************************************
 354
 355         [These comments are rather out of date]
 356
 357 \begin{tabular}{lll}
 358 Info tbls &      Macro  &            Kind of constructor \\
 359 \hline
 360 info & @CONST_INFO_TABLE@&    Zero arity (no info -- compiler uses static closure)\\
 361 info & @CHARLIKE_INFO_TABLE@& Charlike   (no info -- compiler indexes fixed array)\\
 362 info & @INTLIKE_INFO_TABLE@&  Intlike; the one macro generates both info tbls\\
 363 info & @SPEC_INFO_TABLE@&     SPECish, and bigger than or equal to @MIN_UPD_SIZE@\\
 364 info & @GEN_INFO_TABLE@&      GENish (hence bigger than or equal to @MIN_UPD_SIZE@)\\
 365 \end{tabular}
 366
 367 Possible info tables for constructor con:
 368
 369 \begin{description}
 370 \item[@_con_info@:]
 371 Used for dynamically let(rec)-bound occurrences of
 372 the constructor, and for updates.  For constructors
 373 which are int-like, char-like or nullary, when GC occurs,
 374 the closure tries to get rid of itself.
 375
 376 \item[@_static_info@:]
 377 Static occurrences of the constructor
 378 macro: @STATIC_INFO_TABLE@.
 379 \end{description}
 380
 381 For zero-arity constructors, \tr{con}, we NO LONGER generate a static closure;
 382 it's place is taken by the top level defn of the constructor.
 383
 384 For charlike and intlike closures there is a fixed array of static
 385 closures predeclared.
 386
 387 \begin{code}
 388 cgTyCon :: TyCon -> FCode [Cmm]  -- each constructor gets a separate Cmm
 389 cgTyCon tycon
 390   = do  { constrs <- mapM (getCmm . cgDataCon) (tyConDataCons tycon)
 391
 392             -- Generate a table of static closures for an enumeration type
 393             -- Put the table after the data constructor decls, because the
 394             -- datatype closure table (for enumeration types)
 395             -- to (say) PrelBase_$wTrue_closure, which is defined in code_stuff
 396         ; extra <-
 397            if isEnumerationTyCon tycon then do
 398                 tbl <- getCmm (emitRODataLits (mkLocalClosureTableLabel
 399                                                 (tyConName tycon))
 400                            [ CmmLabel (mkLocalClosureLabel (dataConName 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           dflags <- getDynFlags
 418
 419         ; let
 420             -- To allow the debuggers, interpreters, etc to cope with
 421             -- static data structures (ie those built at compile
 422             -- time), we take care that info-table contains the
 423             -- information we need.
 424             (static_cl_info, _) =
 425                 layOutStaticConstr dflags data_con arg_reps
 426
 427             (dyn_cl_info, arg_things) =
 428                 layOutDynConstr    dflags data_con arg_reps
 429
 430             emit_info cl_info ticky_code
 431                 = do { code_blks <- getCgStmts the_code
 432                      ; emitClosureCodeAndInfoTable cl_info [] code_blks }
 433                 where
 434                   the_code = do { ticky_code
 435                                 ; ldvEnter (CmmReg nodeReg)
 436                                 ; body_code }
 437
 438             arg_reps :: [(CgRep, Type)]
 439             arg_reps = [(typeCgRep ty, ty) | ty <- dataConRepArgTys data_con]
 440
 441             body_code = do {
 442                         -- NB: We don't set CC when entering data (WDP 94/06)
 443                              tickyReturnOldCon (length arg_things)
 444                            ; performReturn (emitKnownConReturnCode data_con) }
 445                                 -- noStmts: Ptr to thing already in Node
 446
 447         ; whenC (not (isNullaryRepDataCon data_con))
 448                 (emit_info dyn_cl_info tickyEnterDynCon)
 449
 450                 -- Dynamic-Closure first, to reduce forward references
 451         ; emit_info static_cl_info tickyEnterStaticCon }
 452
 453   where
 454 \end{code}