X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgHeapery.lhs;h=7cf05ca65e14850daabe32d836fb92cacdcb2f66;hb=715184e20183fbdc71383cbc0b1e07598c91b165;hp=798c6ba16ee1afe805923ff8c405111b7f93ea92;hpb=7d61cb61daa5e433a0cb85b34b7f0c58b2f961ff;p=ghc-hetmet.git diff --git a/ghc/compiler/codeGen/CgHeapery.lhs b/ghc/compiler/codeGen/CgHeapery.lhs index 798c6ba..7cf05ca 100644 --- a/ghc/compiler/codeGen/CgHeapery.lhs +++ b/ghc/compiler/codeGen/CgHeapery.lhs @@ -1,38 +1,43 @@ % -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996 +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 +% +% $Id: CgHeapery.lhs,v 1.38 2003/07/18 14:39:06 simonmar Exp $ % \section[CgHeapery]{Heap management functions} \begin{code} -#include "HsVersions.h" - module CgHeapery ( - heapCheck, - allocHeap, allocDynClosure + funEntryChecks, altHeapCheck, unbxTupleHeapCheck, thunkChecks, + allocDynClosure, inPlaceAllocDynClosure -#ifdef GRAN - -- new for GrAnSim HWL - , heapCheckOnly, fetchAndReschedule -#endif {- GRAN -} + -- new functions, basically inserting macro calls into Code -- HWL + ,fetchAndReschedule, yield ) where -import Ubiq{-uitous-} +#include "HsVersions.h" import AbsCSyn +import StgSyn ( AltType(..) ) +import CLabel import CgMonad - +import CgStackery ( getFinalStackHW ) import AbsCUtils ( mkAbstractCs, getAmodeRep ) -import CgRetConv ( mkLiveRegsMask ) -import CgUsages ( getVirtAndRealHp, setVirtHp, setRealHp, +import CgUsages ( getVirtAndRealHp, getRealSp, setVirtHp, setRealHp, initHeapUsage ) -import ClosureInfo ( closureSize, closureHdrSize, closureGoodStuffSize, - slopSize, allocProfilingMsg, closureKind - ) -import HeapOffs ( isZeroOff, addOff, intOff, - VirtualHeapOffset(..) +import CgRetConv ( dataReturnConvPrim ) +import ClosureInfo ( closureSize, closureGoodStuffSize, + slopSize, allocProfilingMsg, ClosureInfo ) -import PrimRep ( PrimRep(..) ) +import TyCon ( tyConPrimRep ) +import PrimRep ( PrimRep(..), isFollowableRep ) +import CmdLineOpts ( opt_GranMacros ) +import Outputable +#ifdef DEBUG +import PprAbsC ( pprMagicId ) +#endif + +import GLAEXTS \end{code} %************************************************************************ @@ -41,154 +46,270 @@ import PrimRep ( PrimRep(..) ) %* * %************************************************************************ -This is std code we replaced by the bits below for GrAnSim. -- HWL +The new code for heapChecks. For GrAnSim the code for doing a heap check +and doing a context switch has been separated. Especially, the HEAP_CHK +macro only performs a heap check. THREAD_CONTEXT_SWITCH should be used for +doing a context switch. GRAN_FETCH_AND_RESCHEDULE must be put at the +beginning of every slow entry code in order to simulate the fetching of +closures. If fetching is necessary (i.e. current closure is not local) then +an automatic context switch is done. -\begin{code} -#ifndef GRAN +----------------------------------------------------------------------------- +A heap/stack check at a function or thunk entry point. -heapCheck :: [MagicId] -- Live registers - -> Bool -- Node reqd after GC? - -> Code - -> Code - -heapCheck regs node_reqd code - = initHeapUsage (\ hHw -> do_heap_chk hHw `thenC` code) - where +\begin{code} +funEntryChecks :: Maybe CLabel -> AbstractC -> Code -> Code +funEntryChecks closure_lbl reg_save_code code + = hpStkCheck closure_lbl True reg_save_code code - do_heap_chk :: HeapOffset -> Code - do_heap_chk words_required - = absC (if isZeroOff(words_required) then AbsCNop else checking_code) `thenC` - -- The test is *inside* the absC, to avoid black holes! +thunkChecks :: Maybe CLabel -> Code -> Code +thunkChecks closure_lbl code + = hpStkCheck closure_lbl False AbsCNop code - -- Now we have set up the real heap pointer and checked there is - -- enough space. It remains only to reflect this in the environment +hpStkCheck + :: Maybe CLabel -- function closure + -> Bool -- is a function? (not a thunk) + -> AbstractC -- register saves + -> Code + -> Code - setRealHp words_required +hpStkCheck closure_lbl is_fun reg_save_code code + = getFinalStackHW (\ spHw -> + getRealSp `thenFC` \ sp -> + let stk_words = spHw - sp in + initHeapUsage (\ hHw -> - -- The "word_required" here is a fudge. - -- *** IT DEPENDS ON THE DIRECTION ***, and on - -- whether the Hp is moved the whole way all - -- at once or not. - where - all_regs = if node_reqd then node:regs else regs - liveness_mask = mkLiveRegsMask all_regs - - checking_code = CMacroStmt HEAP_CHK [ - mkIntCLit liveness_mask, - COffset words_required, - mkIntCLit (if node_reqd then 1 else 0)] -#endif {- GRAN -} -\end{code} + getTickyCtrLabel `thenFC` \ ticky_ctr -> -The GrAnSim code for heapChecks. The code for doing a heap check and -doing a context switch has been separated. Especially, the HEAP_CHK -macro only performs a heap check. THREAD_CONTEXT_SWITCH should be used -for doing a context switch. GRAN_FETCH_AND_RESCHEDULE must be put at -the beginning of every slow entry code in order to simulate the -fetching of closures. If fetching is necessary (i.e. current closure -is not local) then an automatic context switch is done. + absC (checking_code stk_words hHw ticky_ctr) `thenC` -\begin{code} -#ifdef GRAN + setRealHp hHw `thenC` + code)) -heapCheck :: [MagicId] -- Live registers - -> Bool -- Node reqd after GC? - -> Code - -> Code + where + node_asst + | Just lbl <- closure_lbl = CAssign nodeReg (CLbl lbl PtrRep) + | otherwise = AbsCNop + + save_code = mkAbstractCs [node_asst, reg_save_code] + + checking_code stk hp ctr + = mkAbstractCs + [ if is_fun + then do_checks_fun stk hp save_code + else do_checks_np stk hp save_code, + if hp == 0 + then AbsCNop + else profCtrAbsC FSLIT("TICK_ALLOC_HEAP") + [ mkIntCLit hp, CLbl ctr DataPtrRep ] + ] + + +-- For functions: + +do_checks_fun + :: Int -- stack headroom + -> Int -- heap headroom + -> AbstractC -- assignments to perform on failure + -> AbstractC +do_checks_fun 0 0 _ = AbsCNop +do_checks_fun 0 hp_words assts = + CCheck HP_CHK_FUN [ mkIntCLit hp_words ] assts +do_checks_fun stk_words 0 assts = + CCheck STK_CHK_FUN [ mkIntCLit stk_words ] assts +do_checks_fun stk_words hp_words assts = + CCheck HP_STK_CHK_FUN [ mkIntCLit stk_words, mkIntCLit hp_words ] assts + +-- For thunks: + +do_checks_np + :: Int -- stack headroom + -> Int -- heap headroom + -> AbstractC -- assignments to perform on failure + -> AbstractC +do_checks_np 0 0 _ = AbsCNop +do_checks_np 0 hp_words assts = + CCheck HP_CHK_NP [ mkIntCLit hp_words ] assts +do_checks_np stk_words 0 assts = + CCheck STK_CHK_NP [ mkIntCLit stk_words ] assts +do_checks_np stk_words hp_words assts = + CCheck HP_STK_CHK_NP [ mkIntCLit stk_words, mkIntCLit hp_words ] assts +\end{code} -heapCheck = heapCheck' False +Heap checks in a case alternative are nice and easy, provided this is +a bog-standard algebraic case. We have in our hand: -heapCheckOnly :: [MagicId] -- Live registers - -> Bool -- Node reqd after GC? - -> Code - -> Code + * one return address, on the stack, + * one return value, in Node. -heapCheckOnly = heapCheck' False +the canned code for this heap check failure just pushes Node on the +stack, saying 'EnterGHC' to return. The scheduler will return by +entering the top value on the stack, which in turn will return through +the return address, getting us back to where we were. This is +therefore only valid if the return value is *lifted* (just being +boxed isn't good enough). --- May be emit context switch and emit heap check macro +For primitive returns, we have an unlifted value in some register +(either R1 or FloatReg1 or DblReg1). This means using specialised +heap-check code for these cases. -heapCheck' :: Bool -- context switch here? - -> [MagicId] -- Live registers - -> Bool -- Node reqd after GC? - -> Code - -> Code +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. We always organise the stack-resident +fields into pointers & non-pointers, and pass the number of each to +the heap check code. -heapCheck' do_context_switch regs node_reqd code - = initHeapUsage (\ hHw -> do_heap_chk hHw `thenC` code) +\begin{code} +altHeapCheck + :: 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 - = - -- HWL:: absC (CComment "Forced heap check --- HWL") `thenC` - --absC (if do_context_switch - -- then context_switch_code - -- else AbsCNop) `thenC` - - absC (if do_context_switch && not (isZeroOff words_required) - then context_switch_code - else AbsCNop) `thenC` - absC (if isZeroOff(words_required) - then AbsCNop - else checking_code) `thenC` - - -- HWL was here: - -- For GrAnSim we want heap checks even if no heap is allocated in - -- the basic block to make context switches possible. - -- So, the if construct has been replaced by its else branch. - - -- The test is *inside* the absC, to avoid black holes! - - -- Now we have set up the real heap pointer and checked there is - -- enough space. It remains only to reflect this in the environment - + = 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 ] + ]) + + 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 + other_reg -> pprPanic "CgHeapery.altHeapCheck" (ppr tc <+> pprMagicId other_reg) +#endif + +-- Unboxed tuple alternatives and let-no-escapes (the two most annoying +-- constructs to generate code for!): + +unbxTupleHeapCheck + :: [MagicId] -- live registers + -> Int -- no. of stack slots containing ptrs + -> Int -- no. of stack slots containing nonptrs + -> AbstractC -- code to insert in the failure path + -> Code + -> Code + +unbxTupleHeapCheck regs ptrs nptrs fail_code code + -- we can't manage more than 255 pointers/non-pointers in a generic + -- heap check. + | ptrs > 255 || nptrs > 255 = panic "altHeapCheck" + | otherwise = initHeapUsage (\ hHw -> do_heap_chk hHw `thenC` code) + where + do_heap_chk words_required + = getTickyCtrLabel `thenFC` \ ctr -> + absC ( if words_required == 0 + then AbsCNop + else mkAbstractCs + [ checking_code words_required, + profCtrAbsC FSLIT("TICK_ALLOC_HEAP") + [ mkIntCLit words_required, CLbl ctr DataPtrRep ] + ] + ) `thenC` setRealHp words_required - -- The "word_required" here is a fudge. - -- *** IT DEPENDS ON THE DIRECTION ***, and on - -- whether the Hp is moved the whole way all - -- at once or not. - where - all_regs = if node_reqd then node:regs else regs - liveness_mask = mkLiveRegsMask all_regs + liveness = I# (word2Int# (mkRegLiveness regs ptrs nptrs)) + checking_code words_required = CCheck HP_CHK_UNBX_TUPLE + [mkIntCLit words_required, + mkIntCLit liveness] + fail_code - maybe_context_switch = if do_context_switch - then context_switch_code - else AbsCNop +-- build up a bitmap of the live pointer registers - context_switch_code = CMacroStmt THREAD_CONTEXT_SWITCH [ - mkIntCLit liveness_mask, - mkIntCLit (if node_reqd then 1 else 0)] +#if __GLASGOW_HASKELL__ >= 503 +shiftL = uncheckedShiftL# +#else +shiftL = shiftL# +#endif - -- Good old heap check (excluding context switch) - checking_code = CMacroStmt HEAP_CHK [ - mkIntCLit liveness_mask, - COffset words_required, - mkIntCLit (if node_reqd then 1 else 0)] +mkRegLiveness :: [MagicId] -> Int -> Int -> Word# +mkRegLiveness [] (I# ptrs) (I# nptrs) = + (int2Word# nptrs `shiftL` 16#) `or#` (int2Word# ptrs `shiftL` 24#) +mkRegLiveness (VanillaReg rep i : regs) ptrs nptrs | isFollowableRep rep + = ((int2Word# 1#) `shiftL` (i -# 1#)) `or#` mkRegLiveness regs ptrs nptrs +mkRegLiveness (_ : regs) ptrs nptrs = mkRegLiveness regs ptrs nptrs +-- The two functions below are only used in a GranSim setup -- Emit macro for simulating a fetch and then reschedule fetchAndReschedule :: [MagicId] -- Live registers - -> Bool -- Node reqd + -> Bool -- Node reqd? -> Code -fetchAndReschedule regs node_reqd = +fetchAndReschedule regs node_reqd = if (node `elem` regs || node_reqd) then fetch_code `thenC` reschedule_code else absC AbsCNop where - all_regs = if node_reqd then node:regs else regs - liveness_mask = mkLiveRegsMask all_regs - + liveness_mask = mkRegLiveness regs 0 0 reschedule_code = absC (CMacroStmt GRAN_RESCHEDULE [ - mkIntCLit liveness_mask, + mkIntCLit (I# (word2Int# liveness_mask)), mkIntCLit (if node_reqd then 1 else 0)]) --HWL: generate GRAN_FETCH macro for GrAnSim -- currently GRAN_FETCH and GRAN_FETCH_AND_RESCHEDULE are miai fetch_code = absC (CMacroStmt GRAN_FETCH []) +\end{code} + +The @GRAN_YIELD@ macro is taken from JSM's code for Concurrent Haskell. It +allows to context-switch at places where @node@ is not alive (it uses the +@Continue@ rather than the @EnterNodeCode@ function in the RTS). We emit +this kind of macro at the beginning of the following kinds of basic bocks: +\begin{itemize} + \item Slow entry code where node is not alive (see @CgClosure.lhs@). Normally + we use @fetchAndReschedule@ at a slow entry code. + \item Fast entry code (see @CgClosure.lhs@). + \item Alternatives in case expressions (@CLabelledCode@ structures), provided + that they are not inlined (see @CgCases.lhs@). These alternatives will + be turned into separate functions. +\end{itemize} -#endif {- GRAN -} +\begin{code} +yield :: [MagicId] -- Live registers + -> Bool -- Node reqd? + -> Code + +yield regs node_reqd = + if opt_GranMacros && node_reqd + then yield_code + else absC AbsCNop + where + liveness_mask = mkRegLiveness regs 0 0 + yield_code = + absC (CMacroStmt GRAN_YIELD + [mkIntCLit (I# (word2Int# liveness_mask))]) \end{code} %************************************************************************ @@ -217,35 +338,29 @@ allocDynClosure closure_info use_cc blame_cc amodes_with_offsets -- FIND THE OFFSET OF THE INFO-PTR WORD -- virtHp points to last allocated word, ie 1 *before* the -- info-ptr word of new object. - let info_offset = addOff virtHp (intOff 1) + let info_offset = virtHp + 1 -- do_move IS THE ASSIGNMENT FUNCTION do_move (amode, offset_from_start) - = CAssign (CVal (HpRel realHp - (info_offset `addOff` offset_from_start)) + = CAssign (CVal (hpRel realHp + (info_offset + offset_from_start)) (getAmodeRep amode)) amode in -- SAY WHAT WE ARE ABOUT TO DO profCtrC (allocProfilingMsg closure_info) - [COffset (closureHdrSize closure_info), - mkIntCLit (closureGoodStuffSize closure_info), - mkIntCLit slop_size, - COffset closure_size] `thenC` + [mkIntCLit (closureGoodStuffSize closure_info), + mkIntCLit slop_size] `thenC` -- GENERATE THE CODE absC ( mkAbstractCs ( - [ CInitHdr closure_info (HpRel realHp info_offset) use_cc False ] + [ CInitHdr closure_info + (CAddr (hpRel realHp info_offset)) + use_cc closure_size ] ++ (map do_move amodes_with_offsets))) `thenC` - -- GENERATE CC PROFILING MESSAGES - costCentresC SLIT("CC_ALLOC") [blame_cc, - COffset closure_size, - CLitLit (_PK_ (closureKind closure_info)) IntRep] - `thenC` - -- BUMP THE VIRTUAL HEAP POINTER - setVirtHp (virtHp `addOff` closure_size) `thenC` + setVirtHp (virtHp + closure_size) `thenC` -- RETURN PTR TO START OF OBJECT returnFC info_offset @@ -254,26 +369,37 @@ allocDynClosure closure_info use_cc blame_cc amodes_with_offsets slop_size = slopSize closure_info \end{code} -%************************************************************************ -%* * -\subsection{Allocate uninitialized heap space} -%* * -%************************************************************************ +Occasionally we can update a closure in place instead of allocating +new space for it. This is the function that does the business, assuming: -\begin{code} -allocHeap :: HeapOffset -- Size of the space required - -> FCode CAddrMode -- Addr mode for first word of object + - the new closure doesn't contain any pointers if we're + using a generational collector. -allocHeap space - = getVirtAndRealHp `thenFC` \ (virtHp, realHp) -> - let block_start = addOff virtHp (intOff 1) - in - -- We charge the allocation to "PRIM" (which is probably right) - profCtrC SLIT("ALLOC_PRIM2") [COffset space] `thenC` +\begin{code} +inPlaceAllocDynClosure + :: ClosureInfo + -> CAddrMode -- Pointer to beginning of closure + -> CAddrMode -- Cost Centre to stick in the object - -- BUMP THE VIRTUAL HEAP POINTER - setVirtHp (virtHp `addOff` space) `thenC` + -> [(CAddrMode, VirtualHeapOffset)] -- Offsets from start of the object + -- ie Info ptr has offset zero. + -> Code - -- RETURN PTR TO START OF OBJECT - returnFC (CAddr (HpRel realHp block_start)) +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 ( + [ + -- don't forget to AWAKEN_BQ_CLOSURE: even though we're + -- doing update-in-place, the thunk might still have been + -- blackholed and another thread might be waiting on it. + CMacroStmt AWAKEN_BQ_CLOSURE [head], + CInitHdr closure_info head use_cc 0{-no alloc-} + ] + ++ (map do_move amodes_with_offsets))) \end{code}