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