X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgHeapery.lhs;h=b82cdfecc0c90e4a7dec76584239d00745d9dec7;hb=3a6c9110a310fdd2ae40b7706e732c5b94a85bb3;hp=ae6c892b5d360668cd38c6ad9927ea6161417382;hpb=61d2625ae2e6a4cdae2ffc92df828905e81c24cc;p=ghc-hetmet.git diff --git a/compiler/codeGen/CgHeapery.lhs b/compiler/codeGen/CgHeapery.lhs index ae6c892..b82cdfe 100644 --- a/compiler/codeGen/CgHeapery.lhs +++ b/compiler/codeGen/CgHeapery.lhs @@ -1,8 +1,7 @@ % +% (c) The University of Glasgow 2006 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: CgHeapery.lhs,v 1.47 2005/06/21 10:44:41 simonmar Exp $ -% \section[CgHeapery]{Heap management functions} \begin{code} @@ -23,39 +22,31 @@ module CgHeapery ( #include "HsVersions.h" -import StgSyn ( AltType(..) ) -import CLabel ( CLabel, mkRtsCodeLabel ) -import CgUtils ( mkWordCLit, cmmRegOffW, cmmOffsetW, - cmmOffsetExprB ) +import StgSyn +import CLabel +import CgUtils import CgMonad -import CgProf ( staticProfHdr, profDynAlloc, dynProfHdr ) -import CgTicky ( staticTickyHdr, tickyDynAlloc, tickyAllocHeap ) -import CgParallel ( staticGranHdr, staticParHdr, doGranAllocate ) -import CgStackery ( getFinalStackHW, getRealSp ) -import CgCallConv ( mkRegLiveness ) -import ClosureInfo ( closureSize, staticClosureNeedsLink, - mkConInfo, closureNeedsUpdSpace, - infoTableLabelFromCI, closureLabelFromCI, - nodeMustPointToIt, closureLFInfo, - ClosureInfo ) -import SMRep ( CgRep(..), cgRepSizeW, separateByPtrFollowness, - WordOff, fixedHdrSize, thunkHdrSize, - isVoidArg, primRepToCgRep ) - -import Cmm ( CmmLit(..), CmmStmt(..), CmmExpr(..), GlobalReg(..), - CmmReg(..), hpReg, nodeReg, spReg ) -import MachOp ( mo_wordULt, mo_wordUGt, mo_wordSub ) -import CmmUtils ( mkIntCLit, CmmStmts, noStmts, oneStmt, plusStmts, - mkStmts ) -import Id ( Id ) -import DataCon ( DataCon ) -import TyCon ( tyConPrimRep ) -import CostCentre ( CostCentreStack ) -import Util ( mapAccumL, filterOut ) -import Constants ( wORD_SIZE ) -import PackageConfig ( PackageId ) +import CgProf +import CgTicky +import CgParallel +import CgStackery +import CgCallConv +import ClosureInfo +import SMRep + +import Cmm +import MachOp +import CmmUtils +import Id +import DataCon +import TyCon +import CostCentre +import Util +import Constants +import PackageConfig import Outputable +import Data.List \end{code} @@ -123,8 +114,7 @@ getHpRelOffset virtual_offset \begin{code} layOutDynConstr, layOutStaticConstr - :: PackageId - -> DataCon + :: DataCon -> [(CgRep,a)] -> (ClosureInfo, [(a,VirtualHpOffset)]) @@ -132,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 @@ -297,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 @@ -465,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