ghc/compiler/codeGen/CgCon.lhs

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