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