diff options
Diffstat (limited to 'compiler/codeGen/StgCmmCon.hs')
| -rw-r--r-- | compiler/codeGen/StgCmmCon.hs | 21 |
1 files changed, 11 insertions, 10 deletions
diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs index 03a659b2cf..3efa63d770 100644 --- a/compiler/codeGen/StgCmmCon.hs +++ b/compiler/codeGen/StgCmmCon.hs @@ -71,14 +71,14 @@ cgTopRhsCon id con args (tot_wds, -- #ptr_wds + #nonptr_wds ptr_wds, -- #ptr_wds - nv_args_w_offsets) = mkVirtConstrOffsets (addArgReps args) + nv_args_w_offsets) = mkVirtConstrOffsets dflags (addArgReps args) nonptr_wds = tot_wds - ptr_wds -- we're not really going to emit an info table, so having -- to make a CmmInfoTable is a bit overkill, but mkStaticClosureFields -- needs to poke around inside it. - info_tbl = mkDataConInfoTable con True ptr_wds nonptr_wds + info_tbl = mkDataConInfoTable dflags con True ptr_wds nonptr_wds get_lit (arg, _offset) = do { CmmLit lit <- getArgAmode arg ; return lit } @@ -88,6 +88,7 @@ cgTopRhsCon id con args -- NB2: all the amodes should be Lits! ; let closure_rep = mkStaticClosureFields + dflags info_tbl dontCareCCS -- Because it's static data caffy -- Has CAF refs @@ -184,7 +185,7 @@ buildDynCon' dflags platform binder _cc con [arg] , val >= fromIntegral mIN_INTLIKE -- ...ditto... = do { let intlike_lbl = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_INTLIKE_closure") val_int = fromIntegral val :: Int - offsetW = (val_int - mIN_INTLIKE) * (fixedHdrSize + 1) + offsetW = (val_int - mIN_INTLIKE) * (fixedHdrSize dflags + 1) -- INTLIKE closures consist of a header and one word payload intlike_amode = cmmLabelOffW intlike_lbl offsetW ; return (litIdInfo binder (mkConLFInfo con) intlike_amode, mkNop) } @@ -197,18 +198,18 @@ buildDynCon' dflags platform binder _cc con [arg] , val_int <= mAX_CHARLIKE , val_int >= mIN_CHARLIKE = do { let charlike_lbl = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_CHARLIKE_closure") - offsetW = (val_int - mIN_CHARLIKE) * (fixedHdrSize + 1) + offsetW = (val_int - mIN_CHARLIKE) * (fixedHdrSize dflags + 1) -- CHARLIKE closures consist of a header and one word payload charlike_amode = cmmLabelOffW charlike_lbl offsetW ; return (litIdInfo binder (mkConLFInfo con) charlike_amode, mkNop) } -------- buildDynCon': the general case ----------- -buildDynCon' _ _ binder ccs con args +buildDynCon' dflags _ binder ccs con args = do { let (tot_wds, ptr_wds, args_w_offsets) - = mkVirtConstrOffsets (addArgReps args) + = mkVirtConstrOffsets dflags (addArgReps args) -- No void args in args_w_offsets nonptr_wds = tot_wds - ptr_wds - info_tbl = mkDataConInfoTable con False ptr_wds nonptr_wds + info_tbl = mkDataConInfoTable dflags con False ptr_wds nonptr_wds ; (tmp, init) <- allocDynClosure info_tbl lf_info use_cc blame_cc args_w_offsets ; regIdInfo binder lf_info tmp init } @@ -233,10 +234,10 @@ bindConArgs :: AltCon -> LocalReg -> [Id] -> FCode [LocalReg] -- found a con bindConArgs (DataAlt con) base args = ASSERT(not (isUnboxedTupleCon con)) - mapM bind_arg args_w_offsets + do dflags <- getDynFlags + let (_, _, args_w_offsets) = mkVirtConstrOffsets dflags (addIdReps args) + mapM bind_arg args_w_offsets where - (_, _, args_w_offsets) = mkVirtConstrOffsets (addIdReps args) - tag = tagForCon con -- The binding below forces the masking out of the tag bits |