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