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