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 &&
 307                                               val >= mIN_INTLIKE
 308     in_range_int_lit other_amode            = False
 309 \end{code}
 310
 311 Now the general case.
 312
 313 \begin{code}
 314 buildDynCon binder cc con args all_zero_size_args@False
 315   = ASSERT(isDataCon con)
 316     allocDynClosure closure_info use_cc blame_cc amodes_w_offsets `thenFC` \ hp_off ->
 317     returnFC (heapIdInfo binder hp_off (mkConLFInfo con))
 318   where
 319     (closure_info, amodes_w_offsets)
 320       = layOutDynClosure binder getAmodeRep args (mkConLFInfo con)
 321
 322     use_cc      -- cost-centre to stick in the object
 323       = if currentOrSubsumedCosts cc
 324         then CReg CurCostCentre
 325         else mkCCostCentre cc
 326
 327     blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
 328 \end{code}
 329
 330
 331 %************************************************************************
 332 %*                                                                      *
 333 %* constructor-related utility function:                                *
 334 %*              bindConArgs is called from cgAlt of a case              *
 335 %*                                                                      *
 336 %************************************************************************
 337 \subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
 338
 339 @bindConArgs@ $con args$ augments the environment with bindings for the
 340 binders $args$, assuming that we have just returned from a @case@ which
 341 found a $con$.
 342
 343 \begin{code}
 344 bindConArgs :: DataCon -> [Id] -> Code
 345 bindConArgs con args
 346   = ASSERT(isDataCon con)
 347     case (dataReturnConvAlg con) of
 348       ReturnInRegs rs  -> bindArgsToRegs args rs
 349       ReturnInHeap     ->
 350           let
 351               (_, args_w_offsets) = layOutDynCon con idPrimRep args
 352           in
 353           mapCs bind_arg args_w_offsets
 354    where
 355      bind_arg (arg, offset) = bindNewToNode arg offset mkLFArgument
 356 \end{code}
 357
 358
 359 %************************************************************************
 360 %*                                                                      *
 361 \subsubsection[CgRetConv-cgReturnDataCon]{Actually generate code for a constructor return}
 362 %*                                                                      *
 363 %************************************************************************
 364
 365
 366 Note: it's the responsibility of the @cgReturnDataCon@ caller to be
 367 sure the @amodes@ passed don't conflict with each other.
 368 \begin{code}
 369 cgReturnDataCon :: DataCon -> [CAddrMode] -> Bool -> StgLiveVars -> Code
 370
 371 cgReturnDataCon con amodes all_zero_size_args live_vars
 372   = ASSERT(isDataCon con)
 373     getEndOfBlockInfo   `thenFC` \ (EndOfBlockInfo args_spa args_spb sequel) ->
 374
 375     case sequel of
 376
 377       CaseAlts _ (Just (alts, Just (maybe_deflt_binder, (_,deflt_lbl))))
 378         | not (dataConTag con `is_elem` map fst alts)
 379         ->
 380                 -- Special case!  We're returning a constructor to the default case
 381                 -- of an enclosing case.  For example:
 382                 --
 383                 --      case (case e of (a,b) -> C a b) of
 384                 --        D x -> ...
 385                 --        y   -> ...<returning here!>...
 386                 --
 387                 -- In this case,
 388                 --      if the default is a non-bind-default (ie does not use y),
 389                 --      then we should simply jump to the default join point;
 390                 --
 391                 --      if the default is a bind-default (ie does use y), we
 392                 --      should return the constructor IN THE HEAP, pointed to by Node,
 393                 --      **regardless** of the return convention of the constructor C.
 394
 395                 case maybe_deflt_binder of
 396                   Just binder ->
 397                         buildDynCon binder useCurrentCostCentre con amodes all_zero_size_args
 398                                                                 `thenFC` \ idinfo ->
 399                         idInfoToAmode PtrRep idinfo             `thenFC` \ amode ->
 400                         performReturn (move_to_reg amode node)  jump_to_join_point live_vars
 401
 402                   Nothing ->
 403                         performReturn AbsCNop {- No reg assts -} jump_to_join_point live_vars
 404         where
 405           is_elem = isIn "cgReturnDataCon"
 406           jump_to_join_point sequel = absC (CJump (CLbl deflt_lbl CodePtrRep))
 407                 -- Ignore the sequel: we've already looked at it above
 408
 409       other_sequel ->   -- The usual case
 410             case (dataReturnConvAlg con) of
 411
 412               ReturnInHeap          ->
 413                         -- BUILD THE OBJECT IN THE HEAP
 414                         -- The first "con" says that the name bound to this
 415                         -- closure is "con", which is a bit of a fudge, but it only
 416                         -- affects profiling (ToDo?)
 417                   buildDynCon con useCurrentCostCentre con amodes all_zero_size_args
 418                                                         `thenFC` \ idinfo ->
 419                   idInfoToAmode PtrRep idinfo           `thenFC` \ amode ->
 420
 421                         -- MAKE NODE POINT TO IT
 422                   let reg_assts = move_to_reg amode node
 423                       info_lbl  = mkConInfoTableLabel con
 424                   in
 425
 426                         -- RETURN
 427                   profCtrC SLIT("RET_NEW_IN_HEAP") [mkIntCLit (length amodes)] `thenC`
 428
 429                   performReturn reg_assts (mkStaticAlgReturnCode con (Just info_lbl)) live_vars
 430
 431               ReturnInRegs regs  ->
 432                   let
 433                       reg_assts = mkAbstractCs (zipWithEqual "move_to_reg" move_to_reg amodes regs)
 434                       info_lbl  = mkPhantomInfoTableLabel con
 435                   in
 436                   profCtrC SLIT("RET_NEW_IN_REGS") [mkIntCLit (length amodes)] `thenC`
 437
 438                   performReturn reg_assts (mkStaticAlgReturnCode con (Just info_lbl)) live_vars
 439   where
 440     move_to_reg :: CAddrMode -> MagicId -> AbstractC
 441     move_to_reg src_amode dest_reg = CAssign (CReg dest_reg) src_amode
 442 \end{code}