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     ) where
  16
  17 #include "HsVersions.h"
  18
  19 import CgMonad
  20 import AbsCSyn
  21 import StgSyn
  22
  23 import AbsCUtils        ( getAmodeRep )
  24 import CgBindery        ( getArgAmodes, bindNewToNode,
  25                           bindArgsToRegs,
  26                           idInfoToAmode, stableAmodeIdInfo,
  27                           heapIdInfo, CgIdInfo, bindNewToStack
  28                         )
  29 import CgStackery       ( mkTaggedVirtStkOffsets, freeStackSlots,
  30                           updateFrameSize
  31                         )
  32 import CgUsages         ( getRealSp, getVirtSp, setRealAndVirtualSp,
  33                           getSpRelOffset )
  34 import CgRetConv        ( assignRegs )
  35 import Constants        ( mAX_INTLIKE, mIN_INTLIKE, mAX_CHARLIKE, mIN_CHARLIKE,
  36                           mIN_UPD_SIZE )
  37 import CgHeapery        ( allocDynClosure, inPlaceAllocDynClosure )
  38 import CgTailCall       ( performReturn, mkStaticAlgReturnCode, doTailCall,
  39                           mkUnboxedTupleReturnCode )
  40 import CLabel           ( mkClosureLabel )
  41 import ClosureInfo      ( mkConLFInfo, mkLFArgument,
  42                           layOutDynCon, layOutDynClosure,
  43                           layOutStaticClosure, closureSize
  44                         )
  45 import CostCentre       ( currentOrSubsumedCCS, dontCareCCS, CostCentreStack,
  46                           currentCCS )
  47 import DataCon          ( DataCon, dataConName, dataConTag,
  48                           isUnboxedTupleCon, isNullaryDataCon, dataConId, dataConWrapId
  49                         )
  50 import Id               ( Id, idName, idPrimRep )
  51 import Literal          ( Literal(..) )
  52 import PrelInfo         ( maybeCharLikeCon, maybeIntLikeCon )
  53 import PrimRep          ( PrimRep(..), isFollowableRep )
  54 import Unique           ( Uniquable(..) )
  55 import Util
  56 import Outputable
  57 \end{code}
  58
  59 %************************************************************************
  60 %*                                                                      *
  61 \subsection[toplevel-constructors]{Top-level constructors}
  62 %*                                                                      *
  63 %************************************************************************
  64
  65 \begin{code}
  66 cgTopRhsCon :: Id               -- Name of thing bound to this RHS
  67             -> DataCon          -- Id
  68             -> [StgArg]         -- Args
  69             -> FCode (Id, CgIdInfo)
  70 cgTopRhsCon id con args
  71   = ASSERT(not (isDllConApp con args))  -- checks for litlit args too
  72     let
  73         name          = idName id
  74         closure_label = mkClosureLabel name
  75         lf_info       = mkConLFInfo con
  76         cg_id_info    = stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info
  77     in
  78
  79     (
  80         -- LAY IT OUT
  81     getArgAmodes args           `thenFC` \ amodes ->
  82
  83     let
  84         (closure_info, amodes_w_offsets)
  85           = layOutStaticClosure name getAmodeRep amodes lf_info
  86     in
  87
  88         -- BUILD THE OBJECT
  89     absC (CStaticClosure
  90             closure_label               -- Labelled with the name on lhs of defn
  91             closure_info                -- Closure is static
  92             (mkCCostCentreStack dontCareCCS) -- because it's static data
  93             (map fst amodes_w_offsets)) -- Sorted into ptrs first, then nonptrs
  94
  95     ) `thenC`
  96
  97         -- RETURN
  98     returnFC (id, stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info)
  99 \end{code}
 100
 101 %************************************************************************
 102 %*                                                                      *
 103 %* non-top-level constructors                                           *
 104 %*                                                                      *
 105 %************************************************************************
 106 \subsection[code-for-constructors]{The code for constructors}
 107
 108 \begin{code}
 109 buildDynCon :: Id               -- Name of the thing to which this constr will
 110                                 -- be bound
 111             -> CostCentreStack  -- Where to grab cost centre from;
 112                                 -- current CCS if currentOrSubsumedCCS
 113             -> DataCon          -- The data constructor
 114             -> [CAddrMode]      -- Its args
 115             -> FCode CgIdInfo   -- Return details about how to find it
 116
 117 -- We used to pass a boolean indicating whether all the
 118 -- args were of size zero, so we could use a static
 119 -- construtor; but I concluded that it just isn't worth it.
 120 -- Now I/O uses unboxed tuples there just aren't any constructors
 121 -- with all size-zero args.
 122 --
 123 -- The reason for having a separate argument, rather than looking at
 124 -- the addr modes of the args is that we may be in a "knot", and
 125 -- premature looking at the args will cause the compiler to black-hole!
 126 \end{code}
 127
 128 First we deal with the case of zero-arity constructors.  Now, they
 129 will probably be unfolded, so we don't expect to see this case much,
 130 if at all, but it does no harm, and sets the scene for characters.
 131
 132 In the case of zero-arity constructors, or, more accurately, those
 133 which have exclusively size-zero (VoidRep) args, we generate no code
 134 at all.
 135
 136 \begin{code}
 137 buildDynCon binder cc con []
 138   = returnFC (stableAmodeIdInfo binder
 139                                 (CLbl (mkClosureLabel (idName (dataConWrapId con))) PtrRep)
 140                                 (mkConLFInfo con))
 141 \end{code}
 142
 143 The following three paragraphs about @Char@-like and @Int@-like
 144 closures are obsolete, but I don't understand the details well enough
 145 to properly word them, sorry. I've changed the treatment of @Char@s to
 146 be analogous to @Int@s: only a subset is preallocated, because @Char@
 147 has now 31 bits. Only literals are handled here. -- Qrczak
 148
 149 Now for @Char@-like closures.  We generate an assignment of the
 150 address of the closure to a temporary.  It would be possible simply to
 151 generate no code, and record the addressing mode in the environment,
 152 but we'd have to be careful if the argument wasn't a constant --- so
 153 for simplicity we just always asssign to a temporary.
 154
 155 Last special case: @Int@-like closures.  We only special-case the
 156 situation in which the argument is a literal in the range
 157 @mIN_INTLIKE@..@mAX_INTLILKE@.  NB: for @Char@-like closures we can
 158 work with any old argument, but for @Int@-like ones the argument has
 159 to be a literal.  Reason: @Char@ like closures have an argument type
 160 which is guaranteed in range.
 161
 162 Because of this, we use can safely return an addressing mode.
 163
 164 \begin{code}
 165 buildDynCon binder cc con [arg_amode]
 166   | maybeIntLikeCon con && in_range_int_lit arg_amode
 167   = returnFC (stableAmodeIdInfo binder (CIntLike arg_amode) (mkConLFInfo con))
 168   where
 169     in_range_int_lit (CLit (MachInt val)) = val <= mAX_INTLIKE && val >= mIN_INTLIKE
 170     in_range_int_lit _other_amode         = False
 171
 172 buildDynCon binder cc con [arg_amode]
 173   | maybeCharLikeCon con && in_range_char_lit arg_amode
 174   = returnFC (stableAmodeIdInfo binder (CCharLike arg_amode) (mkConLFInfo con))
 175   where
 176     in_range_char_lit (CLit (MachChar val)) = val <= mAX_CHARLIKE && val >= mIN_CHARLIKE
 177     in_range_char_lit _other_amode          = False
 178 \end{code}
 179
 180 Now the general case.
 181
 182 \begin{code}
 183 buildDynCon binder ccs con args
 184   = allocDynClosure closure_info use_cc blame_cc amodes_w_offsets `thenFC` \ hp_off ->
 185     returnFC (heapIdInfo binder hp_off lf_info)
 186   where
 187     (closure_info, amodes_w_offsets)
 188       = layOutDynClosure (idName binder) getAmodeRep args lf_info
 189     lf_info = mkConLFInfo con
 190
 191     use_cc      -- cost-centre to stick in the object
 192       = if currentOrSubsumedCCS ccs
 193         then CReg CurCostCentre
 194         else mkCCostCentreStack ccs
 195
 196     blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
 197 \end{code}
 198
 199
 200 %************************************************************************
 201 %*                                                                      *
 202 %* constructor-related utility function:                                *
 203 %*              bindConArgs is called from cgAlt of a case              *
 204 %*                                                                      *
 205 %************************************************************************
 206 \subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
 207
 208 @bindConArgs@ $con args$ augments the environment with bindings for the
 209 binders $args$, assuming that we have just returned from a @case@ which
 210 found a $con$.
 211
 212 \begin{code}
 213 bindConArgs
 214         :: DataCon -> [Id]              -- Constructor and args
 215         -> Code
 216
 217 bindConArgs con args
 218   = ASSERT(not (isUnboxedTupleCon con))
 219     mapCs bind_arg args_w_offsets
 220    where
 221      bind_arg (arg, offset) = bindNewToNode arg offset mkLFArgument
 222      (_, args_w_offsets) = layOutDynCon con idPrimRep args
 223 \end{code}
 224
 225 Unboxed tuples are handled slightly differently - the object is
 226 returned in registers and on the stack instead of the heap.
 227
 228 \begin{code}
 229 bindUnboxedTupleComponents
 230         :: [Id]                                 -- args
 231         -> FCode ([MagicId],                    -- regs assigned
 232                   [(VirtualSpOffset,Int)],      -- tag slots
 233                   Bool)                         -- any components on stack?
 234
 235 bindUnboxedTupleComponents args
 236  =  -- Assign as many components as possible to registers
 237     let (arg_regs, leftovers) = assignRegs [] (map idPrimRep args)
 238         (reg_args, stk_args) = splitAt (length arg_regs) args
 239     in
 240
 241     -- Allocate the rest on the stack (ToDo: separate out pointers)
 242     getVirtSp `thenFC` \ vsp ->
 243     getRealSp `thenFC` \ rsp ->
 244     let (top_sp, stk_offsets, tags) =
 245                 mkTaggedVirtStkOffsets rsp idPrimRep stk_args
 246     in
 247
 248     -- The stack pointer points to the last stack-allocated component
 249     setRealAndVirtualSp top_sp                  `thenC`
 250
 251     -- need to explicitly free any empty slots we just jumped over
 252     (if vsp < rsp then freeStackSlots [vsp+1 .. rsp] else nopC) `thenC`
 253
 254     bindArgsToRegs reg_args arg_regs            `thenC`
 255     mapCs bindNewToStack stk_offsets            `thenC`
 256     returnFC (arg_regs,tags, not (null stk_offsets))
 257 \end{code}
 258
 259 %************************************************************************
 260 %*                                                                      *
 261 \subsubsection[CgRetConv-cgReturnDataCon]{Actually generate code for a constructor return}
 262 %*                                                                      *
 263 %************************************************************************
 264
 265
 266 Note: it's the responsibility of the @cgReturnDataCon@ caller to be
 267 sure the @amodes@ passed don't conflict with each other.
 268 \begin{code}
 269 cgReturnDataCon :: DataCon -> [CAddrMode] -> Code
 270
 271 cgReturnDataCon con amodes
 272   = getEndOfBlockInfo   `thenFC` \ (EndOfBlockInfo args_sp sequel) ->
 273
 274     case sequel of
 275
 276       CaseAlts _ (Just (alts, Just (maybe_deflt, (_,deflt_lbl))))
 277         | not (dataConTag con `is_elem` map fst alts)
 278         ->
 279                 -- Special case!  We're returning a constructor to the default case
 280                 -- of an enclosing case.  For example:
 281                 --
 282                 --      case (case e of (a,b) -> C a b) of
 283                 --        D x -> ...
 284                 --        y   -> ...<returning here!>...
 285                 --
 286                 -- In this case,
 287                 --      if the default is a non-bind-default (ie does not use y),
 288                 --      then we should simply jump to the default join point;
 289
 290                 case maybe_deflt of
 291                     Nothing -> performReturn AbsCNop {- No reg assts -} jump_to_join_point
 292                     Just _  -> build_it_then jump_to_join_point
 293         where
 294           is_elem = isIn "cgReturnDataCon"
 295           jump_to_join_point sequel = absC (CJump (CLbl deflt_lbl CodePtrRep))
 296                 -- Ignore the sequel: we've already looked at it above
 297
 298         -- If the sequel is an update frame, we might be able to
 299         -- do update in place...
 300       UpdateCode
 301         |  not (isNullaryDataCon con)  -- no nullary constructors, please
 302         && not (any isFollowableRep (map getAmodeRep amodes))
 303                                         -- no ptrs please (generational gc...)
 304         && closureSize closure_info <= mIN_UPD_SIZE
 305                                         -- don't know the real size of the
 306                                         -- thunk, so assume mIN_UPD_SIZE
 307
 308         ->      -- get a new temporary and make it point to the updatee
 309            let
 310                 uniq = getUnique con
 311                 temp = CTemp uniq PtrRep
 312            in
 313
 314            profCtrC SLIT("TICK_UPD_CON_IN_PLACE")
 315                         [mkIntCLit (length amodes)] `thenC`
 316
 317            getSpRelOffset args_sp                       `thenFC` \ sp_rel ->
 318            absC (CAssign temp
 319                     (CMacroExpr PtrRep UPD_FRAME_UPDATEE [CAddr sp_rel]))
 320                 `thenC`
 321
 322                 -- stomp all over it with the new constructor
 323            inPlaceAllocDynClosure closure_info temp (CReg CurCostCentre) stuff
 324                 `thenC`
 325
 326                 -- don't forget to update Su from the update frame
 327            absC (CMacroStmt UPDATE_SU_FROM_UPD_FRAME [CAddr sp_rel])  `thenC`
 328
 329                 -- set Node to point to the closure being returned
 330                 -- (can't be done earlier: node might conflict with amodes)
 331            absC (CAssign (CReg node) temp) `thenC`
 332
 333                 -- pop the update frame off the stack, and do the proper
 334                 -- return.
 335            let new_sp = args_sp - updateFrameSize in
 336            setEndOfBlockInfo (EndOfBlockInfo new_sp (OnStack new_sp)) $
 337            performReturn (AbsCNop) (mkStaticAlgReturnCode con)
 338
 339         where (closure_info, stuff)
 340                   = layOutDynClosure (dataConName con)
 341                         getAmodeRep amodes lf_info
 342
 343               lf_info = mkConLFInfo con
 344
 345       other_sequel      -- The usual case
 346
 347           | isUnboxedTupleCon con ->
 348                         -- Return unboxed tuple in registers
 349                   let (ret_regs, leftovers) =
 350                          assignRegs [] (map getAmodeRep amodes)
 351                   in
 352                   profCtrC SLIT("TICK_RET_UNBOXED_TUP")
 353                                 [mkIntCLit (length amodes)] `thenC`
 354
 355                   doTailCall amodes ret_regs
 356                         mkUnboxedTupleReturnCode
 357                         (length leftovers)  {- fast args arity -}
 358                         AbsCNop {-no pending assigments-}
 359                         Nothing {-not a let-no-escape-}
 360                         False   {-node doesn't point-}
 361
 362           | otherwise ->
 363                 build_it_then (mkStaticAlgReturnCode con)
 364
 365   where
 366     move_to_reg :: CAddrMode -> MagicId -> AbstractC
 367     move_to_reg src_amode dest_reg = CAssign (CReg dest_reg) src_amode
 368
 369     build_it_then return =
 370                 -- BUILD THE OBJECT IN THE HEAP
 371                 -- The first "con" says that the name bound to this
 372                 -- closure is "con", which is a bit of a fudge, but it only
 373                 -- affects profiling
 374
 375                 -- This Id is also used to get a unique for a
 376                 -- temporary variable, if the closure is a CHARLIKE.
 377                 -- funnily enough, this makes the unique always come
 378                 -- out as '54' :-)
 379           buildDynCon (dataConId con) currentCCS con amodes     `thenFC` \ idinfo ->
 380           idInfoToAmode PtrRep idinfo                           `thenFC` \ amode ->
 381
 382
 383                 -- RETURN
 384           profCtrC SLIT("TICK_RET_NEW") [mkIntCLit (length amodes)] `thenC`
 385           -- could use doTailCall here.
 386           performReturn (move_to_reg amode node) return
 387 \end{code}