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