import Cmm
import CLabel
+import MkZipCfgCmm (CmmAGraph, mkNop)
import SMRep
import CostCentre
import Constants
cgTopRhsCon :: Id -- Name of thing bound to this RHS
-> DataCon -- Id
-> [StgArg] -- Args
- -> FCode (Id, CgIdInfo)
+ -> FCode CgIdInfo
cgTopRhsCon id con args
= do {
#if mingw32_TARGET_OS
= layOutStaticConstr con (addArgReps args)
get_lit (arg, _offset) = do { CmmLit lit <- getArgAmode arg
- ; return lit }
+ ; return lit }
; payload <- mapM get_lit nv_args_w_offsets
-- NB1: nv_args_w_offsets is sorted into ptrs then non-ptrs
; emitDataLits closure_label closure_rep
-- RETURN
- ; return (id, litIdInfo id lf_info (CmmLabel closure_label)) }
+ ; return $ litIdInfo id lf_info (CmmLabel closure_label) }
---------------------------------------------------------------
-- current CCS if currentOrSubsumedCCS
-> DataCon -- The data constructor
-> [StgArg] -- Its args
- -> FCode CgIdInfo -- Return details about how to find it
+ -> FCode (CgIdInfo, CmmAGraph)
+ -- Return details about how to find it and initialization code
{- We used to pass a boolean indicating whether all the
args were of size zero, so we could use a static
buildDynCon binder _cc con []
= return (litIdInfo binder (mkConLFInfo con)
- (CmmLabel (mkClosureLabel (dataConName con) (idCafInfo binder))))
+ (CmmLabel (mkClosureLabel (dataConName con) (idCafInfo binder))),
+ mkNop)
-------- buildDynCon: Charlike and Intlike constructors -----------
{- The following three paragraphs about @Char@-like and @Int@-like
offsetW = (val_int - mIN_INTLIKE) * (fixedHdrSize + 1)
-- INTLIKE closures consist of a header and one word payload
intlike_amode = cmmLabelOffW intlike_lbl offsetW
- ; return (litIdInfo binder (mkConLFInfo con) intlike_amode) }
+ ; return (litIdInfo binder (mkConLFInfo con) intlike_amode, mkNop) }
buildDynCon binder _cc con [arg]
| maybeCharLikeCon con
offsetW = (val_int - mIN_CHARLIKE) * (fixedHdrSize + 1)
-- CHARLIKE closures consist of a header and one word payload
charlike_amode = cmmLabelOffW charlike_lbl offsetW
- ; return (litIdInfo binder (mkConLFInfo con) charlike_amode) }
+ ; return (litIdInfo binder (mkConLFInfo con) charlike_amode, mkNop) }
-------- buildDynCon: the general case -----------
buildDynCon binder ccs con args
= do { let (cl_info, args_w_offsets) = layOutDynConstr con (addArgReps args)
-- No void args in args_w_offsets
- ; tmp <- allocDynClosure cl_info use_cc blame_cc args_w_offsets
- ; return (regIdInfo binder lf_info tmp) }
+ ; (tmp, init) <- allocDynClosure cl_info use_cc blame_cc args_w_offsets
+ ; return (regIdInfo binder lf_info tmp, init) }
where
lf_info = mkConLFInfo con
-- The binding below forces the masking out of the tag bits
-- when accessing the constructor field.
- bind_arg :: (Id, VirtualHpOffset) -> FCode LocalReg
+ bind_arg :: (NonVoid Id, VirtualHpOffset) -> FCode LocalReg
bind_arg (arg, offset)
= do { emit $ mkTaggedObjectLoad (idToReg arg) base offset tag
; bindArgToReg arg }