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