X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgHeapery.lhs;h=b82cdfecc0c90e4a7dec76584239d00745d9dec7;hb=df6d4b9ae4f9b5e167aec723b70aa20a448c01d6;hp=3bba211aa19aa06ee3049b2c240d1a9e44c5c5c2;hpb=262c142b90c94ca1aa577c950a6ceae1f255e2d6;p=ghc-hetmet.git diff --git a/compiler/codeGen/CgHeapery.lhs b/compiler/codeGen/CgHeapery.lhs index 3bba211..b82cdfe 100644 --- a/compiler/codeGen/CgHeapery.lhs +++ b/compiler/codeGen/CgHeapery.lhs @@ -114,8 +114,7 @@ getHpRelOffset virtual_offset \begin{code} layOutDynConstr, layOutStaticConstr - :: PackageId - -> DataCon + :: DataCon -> [(CgRep,a)] -> (ClosureInfo, [(a,VirtualHpOffset)]) @@ -123,8 +122,8 @@ layOutDynConstr, layOutStaticConstr layOutDynConstr = layOutConstr False layOutStaticConstr = layOutConstr True -layOutConstr is_static this_pkg data_con args - = (mkConInfo this_pkg is_static data_con tot_wds ptr_wds, +layOutConstr is_static data_con args + = (mkConInfo is_static data_con tot_wds ptr_wds, things_w_offsets) where (tot_wds, -- #ptr_wds + #nonptr_wds @@ -288,6 +287,9 @@ hpStkCheck cl_info is_fun reg_save_code code = noStmts | otherwise = oneStmt (CmmAssign nodeReg (CmmLit (CmmLabel closure_lbl))) + -- Strictly speaking, we should tag node here. But if + -- node doesn't point to the closure, the code for the closure + -- cannot depend on the value of R1 anyway, so we're safe. closure_lbl = closureLabelFromCI cl_info full_save_code = node_asst `plusStmts` reg_save_code @@ -456,7 +458,7 @@ do_checks' stk_expr hp_expr stk_nonzero hp_nonzero reg_save_code rts_lbl [CmmMachOp mo_wordSub [CmmReg spReg, stk_expr], CmmReg (CmmGlobal SpLim)] - -- Hp overflow if (Hpp > HpLim) + -- Hp overflow if (Hp > HpLim) -- (Hp has been incremented by now) -- HpLim points to the LAST WORD of valid allocation space. hp_oflo = CmmMachOp mo_wordUGt