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 import CgUsages         ( getRealSp, getVirtSp, setRealAndVirtualSp )
  31 import CgClosure        ( cgTopRhsClosure )
  32 import CgRetConv        ( assignRegs )
  33 import Constants        ( mAX_INTLIKE, mIN_INTLIKE )
  34 import CgHeapery        ( allocDynClosure )
  35 import CgTailCall       ( performReturn, mkStaticAlgReturnCode, doTailCall,
  36                           mkUnboxedTupleReturnCode )
  37 import CLabel           ( mkClosureLabel, mkStaticClosureLabel )
  38 import ClosureInfo      ( mkClosureLFInfo, mkConLFInfo, mkLFArgument,
  39                           layOutDynCon, layOutDynClosure,
  40                           layOutStaticClosure
  41                         )
  42 import CostCentre       ( currentOrSubsumedCCS, dontCareCCS, CostCentreStack,
  43                           currentCCS )
  44 import DataCon          ( DataCon, dataConName, dataConTag, dataConTyCon,
  45                           isUnboxedTupleCon )
  46 import MkId             ( mkDataConId )
  47 import Id               ( Id, idName, idType, idPrimRep )
  48 import Const            ( Con(..), Literal(..) )
  49 import PrelInfo         ( maybeCharLikeCon, maybeIntLikeCon )
  50 import PrimRep          ( PrimRep(..) )
  51 import BasicTypes       ( TopLevelFlag(..) )
  52 import Util
  53 import Panic            ( assertPanic )
  54 \end{code}
  55
  56 %************************************************************************
  57 %*                                                                      *
  58 \subsection[toplevel-constructors]{Top-level constructors}
  59 %*                                                                      *
  60 %************************************************************************
  61
  62 \begin{code}
  63 cgTopRhsCon :: Id               -- Name of thing bound to this RHS
  64             -> DataCon          -- Id
  65             -> [StgArg]         -- Args
  66             -> Bool             -- All zero-size args (see buildDynCon)
  67             -> FCode (Id, CgIdInfo)
  68 \end{code}
  69
  70 Special Case: Constructors some of whose arguments are of \tr{Double#}
  71 type, {\em or} which are ``lit lits'' (which are given \tr{Addr#}
  72 type).
  73
  74 These ones have to be compiled as re-entrant thunks rather than
  75 closures, because we can't figure out a way to persuade C to allow us
  76 to initialise a static closure with Doubles!  Thus, for \tr{x = 2.0}
  77 (defaults to Double), we get:
  78
  79 \begin{verbatim}
  80 -- The STG syntax:
  81     Main.x = MkDouble [2.0##]
  82
  83 -- C Code:
  84
  85 -- closure:
  86     SET_STATIC_HDR(Main_x_closure,Main_x_static,CC_DATA,,EXTDATA_RO)
  87     };
  88 -- its *own* info table:
  89     STATIC_INFO_TABLE(Main_x,Main_x_entry,,,,EXTFUN,???,":MkDouble","Double");
  90 -- with its *own* entry code:
  91     STGFUN(Main_x_entry) {
  92         P_ u1701;
  93         RetDouble1=2.0;
  94         u1701=(P_)*SpB;
  95         SpB=SpB-1;
  96         JMP_(u1701[0]);
  97     }
  98 \end{verbatim}
  99
 100 The above has the down side that each floating-point constant will end
 101 up with its own info table (rather than sharing the MkFloat/MkDouble
 102 ones).  On the plus side, however, it does return a value (\tr{2.0})
 103 {\em straight away}.
 104
 105 Here, then is the implementation: just pretend it's a non-updatable
 106 thunk.  That is, instead of
 107
 108         x = D# 3.455#
 109
 110 pretend we've seen
 111
 112         x = [] \n [] -> D# 3.455#
 113
 114 \begin{code}
 115 top_ccc = mkCCostCentreStack dontCareCCS -- because it's static data
 116
 117 cgTopRhsCon bndr con args all_zero_size_args
 118   | any isLitLitArg args
 119   = cgTopRhsClosure bndr dontCareCCS NoStgBinderInfo NoSRT [] body lf_info
 120   where
 121     body    = StgCon (DataCon con) args rhs_ty
 122     lf_info = mkClosureLFInfo bndr TopLevel [] ReEntrant []
 123     rhs_ty  = idType bndr
 124 \end{code}
 125
 126 OK, so now we have the general case.
 127
 128 \begin{code}
 129 cgTopRhsCon id con args all_zero_size_args
 130   = (
 131         -- LAY IT OUT
 132     getArgAmodes args           `thenFC` \ amodes ->
 133
 134     let
 135         (closure_info, amodes_w_offsets)
 136           = layOutStaticClosure name getAmodeRep amodes lf_info
 137     in
 138
 139         -- BUILD THE OBJECT
 140     absC (CStaticClosure
 141             closure_label               -- Labelled with the name on lhs of defn
 142             closure_info                -- Closure is static
 143             top_ccc
 144             (map fst amodes_w_offsets)) -- Sorted into ptrs first, then nonptrs
 145
 146     ) `thenC`
 147
 148         -- RETURN
 149     returnFC (id, stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info)
 150   where
 151     con_tycon       = dataConTyCon   con
 152     lf_info         = mkConLFInfo    con
 153     closure_label   = mkClosureLabel name
 154     name            = idName id
 155 \end{code}
 156
 157 %************************************************************************
 158 %*                                                                      *
 159 %* non-top-level constructors                                           *
 160 %*                                                                      *
 161 %************************************************************************
 162 \subsection[code-for-constructors]{The code for constructors}
 163
 164 \begin{code}
 165 buildDynCon :: Id               -- Name of the thing to which this constr will
 166                                 -- be bound
 167             -> CostCentreStack  -- Where to grab cost centre from;
 168                                 -- current CCS if currentOrSubsumedCCS
 169             -> DataCon          -- The data constructor
 170             -> [CAddrMode]      -- Its args
 171             -> Bool             -- True <=> all args (if any) are
 172                                 -- of "zero size" (i.e., VoidRep);
 173                                 -- The reason we don't just look at the
 174                                 -- args is that we may be in a "knot", and
 175                                 -- premature looking at the args will cause
 176                                 -- the compiler to black-hole!
 177             -> FCode CgIdInfo   -- Return details about how to find it
 178 \end{code}
 179
 180 First we deal with the case of zero-arity constructors.  Now, they
 181 will probably be unfolded, so we don't expect to see this case much,
 182 if at all, but it does no harm, and sets the scene for characters.
 183
 184 In the case of zero-arity constructors, or, more accurately, those
 185 which have exclusively size-zero (VoidRep) args, we generate no code
 186 at all.
 187
 188 \begin{code}
 189 buildDynCon binder cc con args all_zero_size_args@True
 190   = returnFC (stableAmodeIdInfo binder
 191                                 (CLbl (mkStaticClosureLabel (dataConName con)) PtrRep)
 192                                 (mkConLFInfo con))
 193 \end{code}
 194
 195 Now for @Char@-like closures.  We generate an assignment of the
 196 address of the closure to a temporary.  It would be possible simply to
 197 generate no code, and record the addressing mode in the environment,
 198 but we'd have to be careful if the argument wasn't a constant --- so
 199 for simplicity we just always asssign to a temporary.
 200
 201 Last special case: @Int@-like closures.  We only special-case the
 202 situation in which the argument is a literal in the range
 203 @mIN_INTLIKE@..@mAX_INTLILKE@.  NB: for @Char@-like closures we can
 204 work with any old argument, but for @Int@-like ones the argument has
 205 to be a literal.  Reason: @Char@ like closures have an argument type
 206 which is guaranteed in range.
 207
 208 Because of this, we use can safely return an addressing mode.
 209
 210 \begin{code}
 211 buildDynCon binder cc con [arg_amode] all_zero_size_args@False
 212
 213   | maybeCharLikeCon con
 214   = absC (CAssign temp_amode (CCharLike arg_amode))     `thenC`
 215     returnFC temp_id_info
 216
 217   | maybeIntLikeCon con && in_range_int_lit arg_amode
 218   = returnFC (stableAmodeIdInfo binder (CIntLike arg_amode) (mkConLFInfo con))
 219   where
 220     (temp_amode, temp_id_info) = newTempAmodeAndIdInfo binder (mkConLFInfo con)
 221
 222     in_range_int_lit (CLit (MachInt val _)) = val <= mAX_INTLIKE && val >= mIN_INTLIKE
 223     in_range_int_lit other_amode            = False
 224
 225     tycon = dataConTyCon con
 226 \end{code}
 227
 228 Now the general case.
 229
 230 \begin{code}
 231 buildDynCon binder ccs con args all_zero_size_args@False
 232   = allocDynClosure closure_info use_cc blame_cc amodes_w_offsets `thenFC` \ hp_off ->
 233     returnFC (heapIdInfo binder hp_off lf_info)
 234   where
 235     (closure_info, amodes_w_offsets)
 236       = layOutDynClosure (idName binder) getAmodeRep args lf_info
 237     lf_info = mkConLFInfo con
 238
 239     use_cc      -- cost-centre to stick in the object
 240       = if currentOrSubsumedCCS ccs
 241         then CReg CurCostCentre
 242         else mkCCostCentreStack ccs
 243
 244     blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
 245 \end{code}
 246
 247
 248 %************************************************************************
 249 %*                                                                      *
 250 %* constructor-related utility function:                                *
 251 %*              bindConArgs is called from cgAlt of a case              *
 252 %*                                                                      *
 253 %************************************************************************
 254 \subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
 255
 256 @bindConArgs@ $con args$ augments the environment with bindings for the
 257 binders $args$, assuming that we have just returned from a @case@ which
 258 found a $con$.
 259
 260 \begin{code}
 261 bindConArgs
 262         :: DataCon -> [Id]              -- Constructor and args
 263         -> Code
 264
 265 bindConArgs con args
 266   = ASSERT(not (isUnboxedTupleCon con))
 267     mapCs bind_arg args_w_offsets
 268    where
 269      bind_arg (arg, offset) = bindNewToNode arg offset mkLFArgument
 270      (_, args_w_offsets) = layOutDynCon con idPrimRep args
 271 \end{code}
 272
 273 Unboxed tuples are handled slightly differently - the object is
 274 returned in registers and on the stack instead of the heap.
 275
 276 \begin{code}
 277 bindUnboxedTupleComponents
 278         :: [Id]                                 -- args
 279         -> FCode ([MagicId],                    -- regs assigned
 280                   [(VirtualSpOffset,Int)],      -- tag slots
 281                   Bool)                         -- any components on stack?
 282
 283 bindUnboxedTupleComponents args
 284  =  -- Assign as many components as possible to registers
 285     let (arg_regs, leftovers) = assignRegs [] (map idPrimRep args)
 286         (reg_args, stk_args) = splitAt (length arg_regs) args
 287     in
 288
 289     -- Allocate the rest on the stack (ToDo: separate out pointers)
 290     getVirtSp `thenFC` \ vsp ->
 291     getRealSp `thenFC` \ rsp ->
 292     let (top_sp, stk_offsets, tags) =
 293                 mkTaggedVirtStkOffsets rsp idPrimRep stk_args
 294     in
 295
 296     -- The stack pointer points to the last stack-allocated component
 297     setRealAndVirtualSp top_sp                  `thenC`
 298
 299     -- need to explicitly free any empty slots we just jumped over
 300     (if vsp < rsp then freeStackSlots [vsp+1 .. rsp] else nopC) `thenC`
 301
 302     bindArgsToRegs reg_args arg_regs            `thenC`
 303     mapCs bindNewToStack stk_offsets            `thenC`
 304     returnFC (arg_regs,tags, not (null stk_offsets))
 305 \end{code}
 306
 307 %************************************************************************
 308 %*                                                                      *
 309 \subsubsection[CgRetConv-cgReturnDataCon]{Actually generate code for a constructor return}
 310 %*                                                                      *
 311 %************************************************************************
 312
 313
 314 Note: it's the responsibility of the @cgReturnDataCon@ caller to be
 315 sure the @amodes@ passed don't conflict with each other.
 316 \begin{code}
 317 cgReturnDataCon :: DataCon -> [CAddrMode] -> Bool -> Code
 318
 319 cgReturnDataCon con amodes all_zero_size_args
 320   = getEndOfBlockInfo   `thenFC` \ (EndOfBlockInfo args_sp sequel) ->
 321
 322     case sequel of
 323
 324       CaseAlts _ (Just (alts, Just (maybe_deflt_binder, (_,deflt_lbl))))
 325         | not (dataConTag con `is_elem` map fst alts)
 326         ->
 327                 -- Special case!  We're returning a constructor to the default case
 328                 -- of an enclosing case.  For example:
 329                 --
 330                 --      case (case e of (a,b) -> C a b) of
 331                 --        D x -> ...
 332                 --        y   -> ...<returning here!>...
 333                 --
 334                 -- In this case,
 335                 --      if the default is a non-bind-default (ie does not use y),
 336                 --      then we should simply jump to the default join point;
 337                 --
 338                 --      if the default is a bind-default (ie does use y), we
 339                 --      should return the constructor in the heap,
 340                 --      pointed to by Node.
 341
 342                 case maybe_deflt_binder of
 343                   Just binder ->
 344                         ASSERT(not (isUnboxedTupleCon con))
 345                         buildDynCon binder currentCCS con amodes all_zero_size_args
 346                                                                 `thenFC` \ idinfo ->
 347                         idInfoToAmode PtrRep idinfo             `thenFC` \ amode ->
 348                         performReturn (move_to_reg amode node)  jump_to_join_point
 349
 350                   Nothing ->
 351                         performReturn AbsCNop {- No reg assts -} jump_to_join_point
 352         where
 353           is_elem = isIn "cgReturnDataCon"
 354           jump_to_join_point sequel = absC (CJump (CLbl deflt_lbl CodePtrRep))
 355                 -- Ignore the sequel: we've already looked at it above
 356
 357       other_sequel      -- The usual case
 358
 359           | isUnboxedTupleCon con ->
 360                         -- Return unboxed tuple in registers
 361                   let (ret_regs, leftovers) =
 362                          assignRegs [] (map getAmodeRep amodes)
 363                   in
 364                   doTailCall amodes ret_regs
 365                         mkUnboxedTupleReturnCode
 366                         (length leftovers)  {- fast args arity -}
 367                         AbsCNop {-no pending assigments-}
 368                         Nothing {-not a let-no-escape-}
 369                         False   {-node doesn't point-}
 370
 371           | otherwise ->
 372                         -- BUILD THE OBJECT IN THE HEAP
 373                         -- The first "con" says that the name bound to this
 374                         -- closure is "con", which is a bit of a fudge, but it only
 375                         -- affects profiling
 376
 377                         -- This Id is also used to get a unique for a
 378                         -- temporary variable, if the closure is a CHARLIKE.
 379                         -- funilly enough, this makes the unique always come
 380                         -- out as '54' :-)
 381                   buildDynCon (mkDataConId con) currentCCS
 382                         con amodes all_zero_size_args
 383                                                         `thenFC` \ idinfo ->
 384                   idInfoToAmode PtrRep idinfo           `thenFC` \ amode ->
 385
 386
 387                         -- RETURN
 388                   profCtrC SLIT("TICK_RET_CON") [mkIntCLit (length amodes)] `thenC`
 389                   -- could use doTailCall here.
 390                   performReturn (move_to_reg amode node)
 391                         (mkStaticAlgReturnCode con)
 392
 393   where
 394     con_name = dataConName con
 395
 396     move_to_reg :: CAddrMode -> MagicId -> AbstractC
 397     move_to_reg src_amode dest_reg = CAssign (CReg dest_reg) src_amode
 398 \end{code}