ghc/compiler/codeGen/CgCon.lhs

   1 %
   2 % (c) The GRASP Project, Glasgow University, 1992-1996
   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 #include "HsVersions.h"
  12
  13 module CgCon (
  14         cgTopRhsCon, buildDynCon,
  15         bindConArgs,
  16         cgReturnDataCon
  17     ) where
  18
  19 IMP_Ubiq(){-uitous-}
  20
  21 import CgMonad
  22 import AbsCSyn
  23 import StgSyn
  24
  25 import AbsCUtils        ( mkAbstractCs, getAmodeRep )
  26 import CgBindery        ( getArgAmodes, bindNewToNode,
  27                           bindArgsToRegs, newTempAmodeAndIdInfo,
  28                           idInfoToAmode, stableAmodeIdInfo,
  29                           heapIdInfo, CgIdInfo
  30                         )
  31 import CgClosure        ( cgTopRhsClosure )
  32 import CgCompInfo       ( mAX_INTLIKE, mIN_INTLIKE )
  33 import CgHeapery        ( allocDynClosure )
  34 import CgRetConv        ( dataReturnConvAlg, DataReturnConvention(..) )
  35 import CgTailCall       ( performReturn, mkStaticAlgReturnCode )
  36 import CLabel           ( mkClosureLabel, mkStaticClosureLabel,
  37                           mkConInfoTableLabel, mkPhantomInfoTableLabel
  38                         )
  39 import ClosureInfo      ( mkClosureLFInfo, mkConLFInfo, mkLFArgument,
  40                           layOutDynCon, layOutDynClosure,
  41                           layOutStaticClosure
  42                         )
  43 import CostCentre       ( currentOrSubsumedCosts, useCurrentCostCentre,
  44                           dontCareCostCentre
  45                         )
  46 import Id               ( idPrimRep, dataConTag, dataConTyCon,
  47                           isDataCon, SYN_IE(DataCon),
  48                           emptyIdSet
  49                         )
  50 import Literal          ( Literal(..) )
  51 import Maybes           ( maybeToBool )
  52 import PrelInfo         ( maybeCharLikeTyCon, maybeIntLikeTyCon )
  53 import PrimRep          ( isFloatingRep, PrimRep(..) )
  54 import TyCon            ( TyCon{-instance Uniquable-} )
  55 import Util             ( isIn, zipWithEqual, panic, assertPanic )
  56 \end{code}
  57
  58 %************************************************************************
  59 %*                                                                      *
  60 \subsection[toplevel-constructors]{Top-level constructors}
  61 %*                                                                      *
  62 %************************************************************************
  63
  64 \begin{code}
  65 cgTopRhsCon :: Id               -- Name of thing bound to this RHS
  66             -> DataCon          -- Id
  67             -> [StgArg]         -- Args
  68             -> Bool             -- All zero-size args (see buildDynCon)
  69             -> FCode (Id, CgIdInfo)
  70 \end{code}
  71
  72 Special Case:
  73 Constructors some of whose arguments are of \tr{Float#} or
  74 \tr{Double#} type, {\em or} which are ``lit lits'' (which are given
  75 \tr{Addr#} type).
  76
  77 These ones have to be compiled as re-entrant thunks rather than closures,
  78 because we can't figure out a way to persuade C to allow us to initialise a
  79 static closure with Floats and Doubles!
  80 Thus, for \tr{x = 2.0} (defaults to Double), we get:
  81
  82 \begin{verbatim}
  83 -- The STG syntax:
  84     Main.x = MkDouble [2.0##]
  85
  86 -- C Code:
  87
  88 -- closure:
  89     SET_STATIC_HDR(Main_x_closure,Main_x_static,CC_DATA,,EXTDATA_RO)
  90     };
  91 -- its *own* info table:
  92     STATIC_INFO_TABLE(Main_x,Main_x_entry,,,,EXTFUN,???,":MkDouble","Double");
  93 -- with its *own* entry code:
  94     STGFUN(Main_x_entry) {
  95         P_ u1701;
  96         RetDouble1=2.0;
  97         u1701=(P_)*SpB;
  98         SpB=SpB-1;
  99         JMP_(u1701[0]);
 100     }
 101 \end{verbatim}
 102
 103 The above has the down side that each floating-point constant will end
 104 up with its own info table (rather than sharing the MkFloat/MkDouble
 105 ones).  On the plus side, however, it does return a value (\tr{2.0})
 106 {\em straight away}.
 107
 108 Here, then is the implementation: just pretend it's a non-updatable
 109 thunk.  That is, instead of
 110
 111         x = F# 3.455#
 112
 113 pretend we've seen
 114
 115         x = [] \n [] -> F# 3.455#
 116
 117 \begin{code}
 118 top_cc  = dontCareCostCentre -- out here to avoid a cgTopRhsCon CAF (sigh)
 119 top_ccc = mkCCostCentre dontCareCostCentre -- because it's static data
 120
 121 cgTopRhsCon name con args all_zero_size_args
 122   |  any (isFloatingRep . getArgPrimRep) args
 123   || any isLitLitArg args
 124   = cgTopRhsClosure name top_cc NoStgBinderInfo [] body lf_info
 125   where
 126     body = StgCon con args emptyIdSet{-emptyLiveVarSet-}
 127     lf_info = mkClosureLFInfo True {- Top level -} [] ReEntrant [] body
 128 \end{code}
 129
 130 OK, so now we have the general case.
 131
 132 \begin{code}
 133 cgTopRhsCon name con args all_zero_size_args
 134   = (
 135     ASSERT(isDataCon con)
 136
 137         -- LAY IT OUT
 138     getArgAmodes args           `thenFC` \ amodes ->
 139
 140     let
 141         (closure_info, amodes_w_offsets)
 142           = layOutStaticClosure name getAmodeRep amodes lf_info
 143     in
 144         -- HWL: In 0.22 there was a heap check in here that had to be changed.
 145         --      CHECK if having no heap check is ok for GrAnSim here!!!
 146
 147         -- BUILD THE OBJECT
 148     absC (CStaticClosure
 149             closure_label                       -- Labelled with the name on lhs of defn
 150             closure_info                        -- Closure is static
 151             top_ccc
 152             (map fst amodes_w_offsets))         -- Sorted into ptrs first, then nonptrs
 153
 154     ) `thenC`
 155
 156         -- RETURN
 157     returnFC (name, stableAmodeIdInfo name (CLbl closure_label PtrRep) lf_info)
 158   where
 159     con_tycon       = dataConTyCon   con
 160     lf_info         = mkConLFInfo    con
 161     closure_label   = mkClosureLabel name
 162 \end{code}
 163
 164 The general case is:
 165 \begin{verbatim}
 166 -- code:
 167     data Foo = MkFoo
 168     x = MkFoo
 169
 170 -- STG code:
 171 STG syntax:
 172     Main.x = Main.MkFoo []
 173
 174 -- interesting parts of the C Code:
 175
 176 -- closure for "x":
 177     SET_STATIC_HDR(Main_x_closure,Main_MkFoo_static,CC_DATA,,EXTDATA_RO)
 178     };
 179 -- entry code for "x":
 180     STGFUN(Main_x_entry) {
 181         Node=(W_)(Main_x_closure);
 182         STGJUMP(Main_MkFoo_entry);
 183     }
 184 \end{verbatim}
 185
 186 Observe: (1)~We create a static closure for \tr{x}, {\em reusing} the
 187 regular \tr{MkFoo} info-table and entry code.  (2)~However: the
 188 \tr{MkFoo} code expects Node to be set, but the caller of \tr{x_entry}
 189 will not have set it.  Therefore, the whole point of \tr{x_entry} is
 190 to set node (and then call the shared \tr{MkFoo} entry code).
 191
 192 Special Case:
 193 For top-level Int/Char constants. We get entry-code fragments of the form:
 194
 195 \begin{verbatim}
 196 -- code:
 197     y = 1
 198
 199 -- entry code for "y":
 200     STGFUN(Main_y_entry) {
 201         Node=(W_)(Main_y_closure);
 202         STGJUMP(I#_entry);
 203     }
 204 \end{verbatim}
 205
 206 This is pretty tiresome: we {\em know} what the constant is---we'd
 207 rather just return it.  We end up with something that's a hybrid
 208 between the Float/Double and general cases: (a)~like Floats/Doubles,
 209 the entry-code returns the value immediately; (b)~like the general
 210 case, we share the data-constructor's std info table.  So, what we
 211 want is:
 212 \begin{verbatim}
 213 -- code:
 214     z = 1
 215
 216 -- STG code:
 217 STG syntax:
 218     Main.z = I# [1#]
 219
 220 -- interesting parts of the C Code:
 221
 222 -- closure for "z" (shares I# info table):
 223     SET_STATIC_HDR(Main_z_closure,I#_static,CC_DATA,,EXTDATA_RO)
 224     };
 225 -- entry code for "z" (do the business directly):
 226     STGFUN(Main_z_entry) {
 227         P_ u1702;
 228         Ret1=1;
 229         u1702=(P_)*SpB;
 230         SpB=SpB-1;
 231         JMP_(u1702[0]);
 232     }
 233 \end{verbatim}
 234
 235 This blob used to be in cgTopRhsCon, but I don't see how we can jump
 236 direct to the named code for a constructor; any external entries will
 237 be via Node.  Generating all this extra code is a real waste for big
 238 static data structures.  So I've nuked it.  SLPJ Sept 94
 239
 240 %************************************************************************
 241 %*                                                                      *
 242 %* non-top-level constructors                                           *
 243 %*                                                                      *
 244 %************************************************************************
 245 \subsection[code-for-constructors]{The code for constructors}
 246
 247 \begin{code}
 248 buildDynCon :: Id               -- Name of the thing to which this constr will
 249                                 -- be bound
 250             -> CostCentre       -- Where to grab cost centre from;
 251                                 -- current CC if currentOrSubsumedCosts
 252             -> DataCon          -- The data constructor
 253             -> [CAddrMode]      -- Its args
 254             -> Bool             -- True <=> all args (if any) are
 255                                 -- of "zero size" (i.e., VoidRep);
 256                                 -- The reason we don't just look at the
 257                                 -- args is that we may be in a "knot", and
 258                                 -- premature looking at the args will cause
 259                                 -- the compiler to black-hole!
 260             -> FCode CgIdInfo   -- Return details about how to find it
 261 \end{code}
 262
 263 First we deal with the case of zero-arity constructors.  Now, they
 264 will probably be unfolded, so we don't expect to see this case much,
 265 if at all, but it does no harm, and sets the scene for characters.
 266
 267 In the case of zero-arity constructors, or, more accurately, those
 268 which have exclusively size-zero (VoidRep) args, we generate no code
 269 at all.
 270
 271 \begin{code}
 272 buildDynCon binder cc con args all_zero_size_args@True
 273   = ASSERT(isDataCon con)
 274     returnFC (stableAmodeIdInfo binder
 275                                 (CLbl (mkStaticClosureLabel con) PtrRep)
 276                                 (mkConLFInfo con))
 277 \end{code}
 278
 279 Now for @Char@-like closures.  We generate an assignment of the
 280 address of the closure to a temporary.  It would be possible simply to
 281 generate no code, and record the addressing mode in the environment,
 282 but we'd have to be careful if the argument wasn't a constant --- so
 283 for simplicity we just always asssign to a temporary.
 284
 285 Last special case: @Int@-like closures.  We only special-case the
 286 situation in which the argument is a literal in the range
 287 @mIN_INTLIKE@..@mAX_INTLILKE@.  NB: for @Char@-like closures we can
 288 work with any old argument, but for @Int@-like ones the argument has
 289 to be a literal.  Reason: @Char@ like closures have an argument type
 290 which is guaranteed in range.
 291
 292 Because of this, we use can safely return an addressing mode.
 293
 294 \begin{code}
 295 buildDynCon binder cc con [arg_amode] all_zero_size_args@False
 296
 297   | maybeToBool (maybeCharLikeTyCon tycon)
 298   = ASSERT(isDataCon con)
 299     absC (CAssign temp_amode (CCharLike arg_amode))     `thenC`
 300     returnFC temp_id_info
 301
 302   | maybeToBool (maybeIntLikeTyCon tycon) && in_range_int_lit arg_amode
 303   = ASSERT(isDataCon con)
 304     returnFC (stableAmodeIdInfo binder (CIntLike arg_amode) (mkConLFInfo con))
 305   where
 306     tycon = dataConTyCon con
 307     (temp_amode, temp_id_info) = newTempAmodeAndIdInfo binder (mkConLFInfo con)
 308
 309     in_range_int_lit (CLit (MachInt val _)) = val <= mAX_INTLIKE && val >= mIN_INTLIKE
 310     in_range_int_lit other_amode            = False
 311 \end{code}
 312
 313 Now the general case.
 314
 315 \begin{code}
 316 buildDynCon binder cc con args all_zero_size_args@False
 317   = ASSERT(isDataCon con)
 318     allocDynClosure closure_info use_cc blame_cc amodes_w_offsets `thenFC` \ hp_off ->
 319     returnFC (heapIdInfo binder hp_off (mkConLFInfo con))
 320   where
 321     (closure_info, amodes_w_offsets)
 322       = layOutDynClosure binder getAmodeRep args (mkConLFInfo con)
 323
 324     use_cc      -- cost-centre to stick in the object
 325       = if currentOrSubsumedCosts cc
 326         then CReg CurCostCentre
 327         else mkCCostCentre cc
 328
 329     blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
 330 \end{code}
 331
 332
 333 %************************************************************************
 334 %*                                                                      *
 335 %* constructor-related utility function:                                *
 336 %*              bindConArgs is called from cgAlt of a case              *
 337 %*                                                                      *
 338 %************************************************************************
 339 \subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
 340
 341 @bindConArgs@ $con args$ augments the environment with bindings for the
 342 binders $args$, assuming that we have just returned from a @case@ which
 343 found a $con$.
 344
 345 \begin{code}
 346 bindConArgs :: DataCon -> [Id] -> Code
 347 bindConArgs con args
 348   = ASSERT(isDataCon con)
 349     case (dataReturnConvAlg con) of
 350       ReturnInRegs rs  -> bindArgsToRegs args rs
 351       ReturnInHeap     ->
 352           let
 353               (_, args_w_offsets) = layOutDynCon con idPrimRep args
 354           in
 355           mapCs bind_arg args_w_offsets
 356    where
 357      bind_arg (arg, offset) = bindNewToNode arg offset mkLFArgument
 358 \end{code}
 359
 360
 361 %************************************************************************
 362 %*                                                                      *
 363 \subsubsection[CgRetConv-cgReturnDataCon]{Actually generate code for a constructor return}
 364 %*                                                                      *
 365 %************************************************************************
 366
 367
 368 Note: it's the responsibility of the @cgReturnDataCon@ caller to be
 369 sure the @amodes@ passed don't conflict with each other.
 370 \begin{code}
 371 cgReturnDataCon :: DataCon -> [CAddrMode] -> Bool -> StgLiveVars -> Code
 372
 373 cgReturnDataCon con amodes all_zero_size_args live_vars
 374   = ASSERT(isDataCon con)
 375     getEndOfBlockInfo   `thenFC` \ (EndOfBlockInfo args_spa args_spb sequel) ->
 376
 377     case sequel of
 378
 379       CaseAlts _ (Just (alts, Just (maybe_deflt_binder, (_,deflt_lbl))))
 380         | not (dataConTag con `is_elem` map fst alts)
 381         ->
 382                 -- Special case!  We're returning a constructor to the default case
 383                 -- of an enclosing case.  For example:
 384                 --
 385                 --      case (case e of (a,b) -> C a b) of
 386                 --        D x -> ...
 387                 --        y   -> ...<returning here!>...
 388                 --
 389                 -- In this case,
 390                 --      if the default is a non-bind-default (ie does not use y),
 391                 --      then we should simply jump to the default join point;
 392                 --
 393                 --      if the default is a bind-default (ie does use y), we
 394                 --      should return the constructor IN THE HEAP, pointed to by Node,
 395                 --      **regardless** of the return convention of the constructor C.
 396
 397                 case maybe_deflt_binder of
 398                   Just binder ->
 399                         buildDynCon binder useCurrentCostCentre con amodes all_zero_size_args
 400                                                                 `thenFC` \ idinfo ->
 401                         idInfoToAmode PtrRep idinfo             `thenFC` \ amode ->
 402                         performReturn (move_to_reg amode node)  jump_to_join_point live_vars
 403
 404                   Nothing ->
 405                         performReturn AbsCNop {- No reg assts -} jump_to_join_point live_vars
 406         where
 407           is_elem = isIn "cgReturnDataCon"
 408           jump_to_join_point sequel = absC (CJump (CLbl deflt_lbl CodePtrRep))
 409                 -- Ignore the sequel: we've already looked at it above
 410
 411       other_sequel ->   -- The usual case
 412             case (dataReturnConvAlg con) of
 413
 414               ReturnInHeap          ->
 415                         -- BUILD THE OBJECT IN THE HEAP
 416                         -- The first "con" says that the name bound to this
 417                         -- closure is "con", which is a bit of a fudge, but it only
 418                         -- affects profiling (ToDo?)
 419                   buildDynCon con useCurrentCostCentre con amodes all_zero_size_args
 420                                                         `thenFC` \ idinfo ->
 421                   idInfoToAmode PtrRep idinfo           `thenFC` \ amode ->
 422
 423                         -- MAKE NODE POINT TO IT
 424                   let reg_assts = move_to_reg amode node
 425                       info_lbl  = mkConInfoTableLabel con
 426                   in
 427
 428                         -- RETURN
 429                   profCtrC SLIT("RET_NEW_IN_HEAP") [mkIntCLit (length amodes)] `thenC`
 430
 431                   performReturn reg_assts (mkStaticAlgReturnCode con (Just info_lbl)) live_vars
 432
 433               ReturnInRegs regs  ->
 434                   let
 435                       reg_assts = mkAbstractCs (zipWithEqual "move_to_reg" move_to_reg amodes regs)
 436                       info_lbl  = mkPhantomInfoTableLabel con
 437                   in
 438                   profCtrC SLIT("RET_NEW_IN_REGS") [mkIntCLit (length amodes)] `thenC`
 439
 440                   performReturn reg_assts (mkStaticAlgReturnCode con (Just info_lbl)) live_vars
 441   where
 442     move_to_reg :: CAddrMode -> MagicId -> AbstractC
 443     move_to_reg src_amode dest_reg = CAssign (CReg dest_reg) src_amode
 444 \end{code}