X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgHeapery.lhs;h=2329dcb6d23b77b294cd7d9fef5daae0f10a74a7;hb=6e6b6f2c929ee59c0ab961f108406a332bda1dee;hp=cf10655414fe91d47632466d33de38060da00bee;hpb=0bffc410964e1688ad80d277d53400659e697ab5;p=ghc-hetmet.git diff --git a/ghc/compiler/codeGen/CgHeapery.lhs b/ghc/compiler/codeGen/CgHeapery.lhs index cf10655..2329dcb 100644 --- a/ghc/compiler/codeGen/CgHeapery.lhs +++ b/ghc/compiler/codeGen/CgHeapery.lhs @@ -1,14 +1,14 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: CgHeapery.lhs,v 1.35 2002/12/11 15:36:26 simonmar Exp $ +% $Id: CgHeapery.lhs,v 1.39 2003/07/28 16:05:35 simonmar Exp $ % \section[CgHeapery]{Heap management functions} \begin{code} module CgHeapery ( funEntryChecks, altHeapCheck, unbxTupleHeapCheck, thunkChecks, - allocDynClosure, inPlaceAllocDynClosure + allocDynClosure, -- new functions, basically inserting macro calls into Code -- HWL ,fetchAndReschedule, yield @@ -17,23 +17,24 @@ module CgHeapery ( #include "HsVersions.h" import AbsCSyn +import StgSyn ( AltType(..) ) import CLabel import CgMonad - import CgStackery ( getFinalStackHW ) import AbsCUtils ( mkAbstractCs, getAmodeRep ) import CgUsages ( getVirtAndRealHp, getRealSp, setVirtHp, setRealHp, initHeapUsage ) +import CgRetConv ( dataReturnConvPrim ) import ClosureInfo ( closureSize, closureGoodStuffSize, slopSize, allocProfilingMsg, ClosureInfo ) +import TyCon ( tyConPrimRep ) import PrimRep ( PrimRep(..), isFollowableRep ) import CmdLineOpts ( opt_GranMacros ) import Outputable - #ifdef DEBUG -import PprAbsC ( pprMagicId ) -- tmp +import PprAbsC ( pprMagicId ) #endif import GLAEXTS @@ -154,81 +155,63 @@ heap-check code for these cases. For unboxed tuple returns, there are an arbitrary number of possibly unboxed return values, some of which will be in registers, and the -others will be on the stack, with gaps left for tagging the unboxed -objects. If a heap check is required, we need to fill in these tags. - -The code below will cover all cases for the x86 architecture (where R1 -is the only VanillaReg ever used). For other architectures, we'll -have to do something about saving and restoring the other registers. +others will be on the stack. We always organise the stack-resident +fields into pointers & non-pointers, and pass the number of each to +the heap check code. \begin{code} altHeapCheck - :: Bool -- do not enter node on return - -> [MagicId] -- live registers - -> Code -- continuation - -> Code - - --- normal algebraic and primitive case alternatives: - -altHeapCheck no_enter regs code - = initHeapUsage (\ hHw -> do_heap_chk hHw `thenC` code) + :: AltType -- PolyAlt, PrimAlt, AlgAlt, but *not* UbxTupAlt + -- (Unboxed tuples are dealt with by ubxTupleHeapCheck) + -> Code -- Continuation + -> Code +altHeapCheck alt_type code + = initHeapUsage (\ hHw -> + do_heap_chk hHw `thenC` + setRealHp hHw `thenC` + code) where do_heap_chk :: HeapOffset -> Code do_heap_chk words_required - = getTickyCtrLabel `thenFC` \ ctr -> - absC ( if words_required == 0 - then AbsCNop - else mkAbstractCs - [ checking_code, + = getTickyCtrLabel `thenFC` \ ctr -> + absC ( -- NB The conditional is inside the absC, + -- so the monadic stuff doesn't depend on + -- the value of words_required! + if words_required == 0 + then AbsCNop + else mkAbstractCs + [ CCheck (checking_code alt_type) + [mkIntCLit words_required] AbsCNop, profCtrAbsC FSLIT("TICK_ALLOC_HEAP") [ mkIntCLit words_required, CLbl ctr DataPtrRep ] - ] - ) `thenC` - setRealHp words_required - - where - non_void_regs = filter (/= VoidReg) regs - - checking_code = - case non_void_regs of - - -- No regs live: probably a Void return - [] -> - CCheck HP_CHK_NOREGS [mkIntCLit words_required] AbsCNop - - [VanillaReg rep 1#] - -- R1 is boxed, but unlifted: DO NOT enter R1 when we return. - | isFollowableRep rep && no_enter -> - CCheck HP_CHK_UNPT_R1 [mkIntCLit words_required] AbsCNop - - -- R1 is lifted (the common case) - | isFollowableRep rep -> - CCheck HP_CHK_NP - [mkIntCLit words_required] - AbsCNop - - -- R1 is unboxed - | otherwise -> - CCheck HP_CHK_UNBX_R1 [mkIntCLit words_required] AbsCNop - - -- FloatReg1 - [FloatReg 1#] -> - CCheck HP_CHK_F1 [mkIntCLit words_required] AbsCNop - - -- DblReg1 - [DoubleReg 1#] -> - CCheck HP_CHK_D1 [mkIntCLit words_required] AbsCNop - - -- LngReg1 - [LongReg _ 1#] -> - CCheck HP_CHK_L1 [mkIntCLit words_required] AbsCNop - + ]) + + checking_code PolyAlt + = HP_CHK_UNPT_R1 -- Do *not* enter R1 after a heap check in + -- a polymorphic case. It might be a function + -- and the entry code for a function (currently) + -- applies it + -- + -- However R1 is guaranteed to be a pointer + + checking_code (AlgAlt tc) + = HP_CHK_NP -- Enter R1 after the heap check; it's a pointer + -- The "NP" is short for "Node (R1) Points to it" + + checking_code (PrimAlt tc) + = case dataReturnConvPrim (tyConPrimRep tc) of + VoidReg -> HP_CHK_NOREGS + FloatReg 1# -> HP_CHK_F1 + DoubleReg 1# -> HP_CHK_D1 + LongReg _ 1# -> HP_CHK_L1 + VanillaReg rep 1# + | isFollowableRep rep -> HP_CHK_UNPT_R1 -- R1 is boxed but unlifted: + | otherwise -> HP_CHK_UNBX_R1 -- R1 is unboxed #ifdef DEBUG - _ -> panic ("CgHeapery.altHeapCheck: unimplemented heap-check, live regs = " ++ showSDoc (sep (map pprMagicId non_void_regs))) + other_reg -> pprPanic "CgHeapery.altHeapCheck" (ppr tc <+> pprMagicId other_reg) #endif --- unboxed tuple alternatives and let-no-escapes (the two most annoying +-- Unboxed tuple alternatives and let-no-escapes (the two most annoying -- constructs to generate code for!): unbxTupleHeapCheck @@ -250,21 +233,18 @@ unbxTupleHeapCheck regs ptrs nptrs fail_code code absC ( if words_required == 0 then AbsCNop else mkAbstractCs - [ checking_code, + [ checking_code words_required, profCtrAbsC FSLIT("TICK_ALLOC_HEAP") [ mkIntCLit words_required, CLbl ctr DataPtrRep ] ] ) `thenC` setRealHp words_required - where - checking_code = - let liveness = mkRegLiveness regs ptrs nptrs - in - CCheck HP_CHK_UNBX_TUPLE - [mkIntCLit words_required, - mkIntCLit (I# (word2Int# liveness))] - fail_code + liveness = I# (word2Int# (mkRegLiveness regs ptrs nptrs)) + checking_code words_required = CCheck HP_CHK_UNBX_TUPLE + [mkIntCLit words_required, + mkIntCLit liveness] + fail_code -- build up a bitmap of the live pointer registers @@ -388,34 +368,3 @@ allocDynClosure closure_info use_cc blame_cc amodes_with_offsets closure_size = closureSize closure_info slop_size = slopSize closure_info \end{code} - -Occasionally we can update a closure in place instead of allocating -new space for it. This is the function that does the business, assuming: - - - node points to the closure to be overwritten - - - the new closure doesn't contain any pointers if we're - using a generational collector. - -\begin{code} -inPlaceAllocDynClosure - :: ClosureInfo - -> CAddrMode -- Pointer to beginning of closure - -> CAddrMode -- Cost Centre to stick in the object - - -> [(CAddrMode, VirtualHeapOffset)] -- Offsets from start of the object - -- ie Info ptr has offset zero. - -> Code - -inPlaceAllocDynClosure closure_info head use_cc amodes_with_offsets - = let -- do_move IS THE ASSIGNMENT FUNCTION - do_move (amode, offset_from_start) - = CAssign (CVal (CIndex head (mkIntCLit offset_from_start) WordRep) - (getAmodeRep amode)) - amode - in - -- GENERATE THE CODE - absC ( mkAbstractCs ( - [ CInitHdr closure_info head use_cc 0{-no alloc-} ] - ++ (map do_move amodes_with_offsets))) -\end{code}