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