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