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