X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgStackery.lhs;h=7cb310d521022f610b0ec644556d2119d6a61e3c;hb=1120322bb5c72ac0f7e6b126240da8ebf14362c4;hp=41ec06a885effd064c585bb8c77f648666f0d081;hpb=7e602b0a11e567fcb035d1afd34015aebcf9a577;p=ghc-hetmet.git diff --git a/ghc/compiler/codeGen/CgStackery.lhs b/ghc/compiler/codeGen/CgStackery.lhs index 41ec06a..7cb310d 100644 --- a/ghc/compiler/codeGen/CgStackery.lhs +++ b/ghc/compiler/codeGen/CgStackery.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: CgStackery.lhs,v 1.10 1998/12/18 17:40:53 simonpj Exp $ +% $Id: CgStackery.lhs,v 1.27 2004/09/30 10:35:49 simonpj Exp $ % \section[CgStackery]{Stack management functions} @@ -10,117 +10,141 @@ Stack-twiddling operations, which are pretty low-down and grimy. \begin{code} module CgStackery ( - allocStack, allocPrimStack, allocStackTop, deAllocStackTop, - allocUpdateFrame, - adjustRealSp, adjustStackHW, getFinalStackHW, - mkTaggedVirtStkOffsets, mkTaggedStkAmodes, mkTagAssts, - freeStackSlots, addFreeSlots + spRel, getVirtSp, getRealSp, setRealSp, + setRealAndVirtualSp, getSpRelOffset, + + allocPrimStack, allocStackTop, deAllocStackTop, + adjustStackHW, getFinalStackHW, + setStackFrame, getStackFrame, + mkVirtStkOffsets, mkStkAmodes, + freeStackSlots, + pushUpdateFrame, emitPushUpdateFrame, ) where #include "HsVersions.h" import CgMonad -import AbsCSyn - -import CgUsages ( getRealSp ) -import AbsCUtils ( mkAbstractCs, mkAbsCStmts, getAmodeRep ) -import PrimRep ( getPrimRepSize, PrimRep(..), isFollowableRep ) -import Panic ( panic ) +import CgUtils ( cmmOffsetB, cmmRegOffW ) +import CgProf ( initUpdFrameProf ) +import SMRep +import Cmm +import CmmUtils ( CmmStmts, mkLblExpr ) +import CLabel ( mkUpdInfoLabel ) +import Constants +import Util ( sortLe ) +import FastString ( LitString ) +import OrdList ( toOL ) +import Outputable \end{code} %************************************************************************ %* * -\subsection[CgStackery-layout]{Laying out a stack frame} +\subsection[CgUsages-stackery]{Monad things for fiddling with stack usage} %* * %************************************************************************ -@mkTaggedVirtStkOffsets@ is given a list of arguments. The first -argument gets the {\em largest} virtual stack offset (remember, -virtual offsets increase towards the top of stack). This function -also computes the correct tagging arrangement for standard function -entry points. Each non-pointer on the stack is preceded by a tag word -indicating the number of non-pointer words above it on the stack. - - offset --> | | <---- last allocated stack word - --------- < - | | . - --------- . - | | total_nptrs (words) - --------- . - | | . - --------- < -offset + tot_nptrs + 1 --> | tag | - --------- +spRel is a little function that abstracts the stack direction. Note that most +of the code generator is dependent on the stack direction anyway, so +changing this on its own spells certain doom. ToDo: remove? + + THIS IS DIRECTION SENSITIVE! + +Stack grows down, positive virtual offsets correspond to negative +additions to the stack pointer. \begin{code} -mkTaggedVirtStkOffsets - :: VirtualSpOffset -- Offset of the last allocated thing - -> (a -> PrimRep) -- to be able to grab kinds - -> [a] -- things to make offsets for - -> (VirtualSpOffset, -- OUTPUTS: Topmost allocated word - [(a, VirtualSpOffset)], -- things with offsets - [(VirtualSpOffset,Int)]) -- offsets for tags +spRel :: VirtualSpOffset -- virtual offset of Sp + -> VirtualSpOffset -- virtual offset of The Thing + -> WordOff -- integer offset +spRel sp off = sp - off +\end{code} -mkTaggedVirtStkOffsets init_Sp_offset kind_fun things - = loop init_Sp_offset [] [] (reverse things) - where - loop offset tags offs [] = (offset,offs,tags) - loop offset tags offs (t:things) - | isFollowableRep (kind_fun t) = - loop (offset+1) tags ((t,offset+1):offs) things - | otherwise = - let - size = getPrimRepSize (kind_fun t) - tag_slot = offset+size+1 - in - loop tag_slot ((tag_slot,size):tags) ((t,offset+size):offs) things - -- offset of thing is offset+size, because we're growing the stack - -- *downwards* as the offsets increase. +@setRealAndVirtualSp@ sets into the environment the offsets of the +current position of the real and virtual stack pointers in the current +stack frame. The high-water mark is set too. It generates no code. +It is used to initialise things at the beginning of a closure body. + +\begin{code} +setRealAndVirtualSp :: VirtualSpOffset -- New real Sp + -> Code + +setRealAndVirtualSp new_sp + = do { stk_usg <- getStkUsage + ; setStkUsage (stk_usg {virtSp = new_sp, + realSp = new_sp, + hwSp = new_sp}) } + +getVirtSp :: FCode VirtualSpOffset +getVirtSp + = do { stk_usg <- getStkUsage + ; return (virtSp stk_usg) } + +getRealSp :: FCode VirtualSpOffset +getRealSp + = do { stk_usg <- getStkUsage + ; return (realSp stk_usg) } + +setRealSp :: VirtualSpOffset -> Code +setRealSp new_real_sp + = do { stk_usg <- getStkUsage + ; setStkUsage (stk_usg {realSp = new_real_sp}) } + +getSpRelOffset :: VirtualSpOffset -> FCode CmmExpr +getSpRelOffset virtual_offset + = do { real_sp <- getRealSp + ; return (cmmRegOffW spReg (spRel real_sp virtual_offset)) } \end{code} -@mkTaggedStkAmodes@ is a higher-level version of -@mkTaggedVirtStkOffsets@. It starts from the tail-call locations. It -returns a single list of addressing modes for the stack locations, and -therefore is in the monad. -It *doesn't* adjust the high water mark. +%************************************************************************ +%* * +\subsection[CgStackery-layout]{Laying out a stack frame} +%* * +%************************************************************************ + +'mkVirtStkOffsets' is given a list of arguments. The first argument +gets the /largest/ virtual stack offset (remember, virtual offsets +increase towards the top of stack). \begin{code} -mkTaggedStkAmodes +mkVirtStkOffsets + :: VirtualSpOffset -- Offset of the last allocated thing + -> [(CgRep,a)] -- things to make offsets for + -> (VirtualSpOffset, -- OUTPUTS: Topmost allocated word + [(a, VirtualSpOffset)]) -- things with offsets (voids filtered out) + +mkVirtStkOffsets init_Sp_offset things + = loop init_Sp_offset [] (reverse things) + where + loop offset offs [] = (offset,offs) + loop offset offs ((VoidArg,t):things) = loop offset offs things + -- ignore Void arguments + loop offset offs ((rep,t):things) + = loop thing_slot ((t,thing_slot):offs) things + where + thing_slot = offset + cgRepSizeW rep + -- offset of thing is offset+size, because we're + -- growing the stack *downwards* as the offsets increase. + +-- | 'mkStkAmodes' is a higher-level version of +-- 'mkVirtStkOffsets'. It starts from the tail-call locations. +-- It returns a single list of addressing modes for the stack +-- locations, and therefore is in the monad. It /doesn't/ adjust the +-- high water mark. + +mkStkAmodes :: VirtualSpOffset -- Tail call positions - -> [CAddrMode] -- things to make offsets for + -> [(CgRep,CmmExpr)] -- things to make offsets for -> FCode (VirtualSpOffset, -- OUTPUTS: Topmost allocated word - AbstractC, -- Assignments to appropriate stk slots - AbstractC) -- Assignments for tagging - -mkTaggedStkAmodes tail_Sp things - = getRealSp `thenFC` \ realSp -> - let - (last_Sp_offset, offsets, tags) - = mkTaggedVirtStkOffsets tail_Sp getAmodeRep things - - abs_cs = - [ CAssign (CVal (spRel realSp offset) (getAmodeRep thing)) thing - | (thing, offset) <- offsets - ] - - tag_cs = - [ CAssign (CVal (spRel realSp offset) WordRep) - (CMacroExpr WordRep ARG_TAG [mkIntCLit size]) - | (offset,size) <- tags - ] - in - returnFC (last_Sp_offset, mkAbstractCs abs_cs, mkAbstractCs tag_cs) - -mkTagAssts :: [(VirtualSpOffset,Int)] -> FCode AbstractC -mkTagAssts tags = - getRealSp `thenFC` \realSp -> - returnFC (mkAbstractCs - [ CAssign (CVal (spRel realSp offset) WordRep) - (CMacroExpr WordRep ARG_TAG [mkIntCLit size]) - | (offset,size) <- tags - ]) - + CmmStmts) -- Assignments to appropriate stk slots + +mkStkAmodes tail_Sp things + = do { rSp <- getRealSp + ; let (last_Sp_offset, offsets) = mkVirtStkOffsets tail_Sp things + abs_cs = [ CmmStore (cmmRegOffW spReg (spRel rSp offset)) amode + | (amode, offset) <- offsets + ] + ; returnFC (last_Sp_offset, toOL abs_cs) } \end{code} %************************************************************************ @@ -132,140 +156,149 @@ mkTagAssts tags = Allocate a virtual offset for something. \begin{code} -allocStack :: FCode VirtualSpOffset -allocStack = allocPrimStack 1 - -allocPrimStack :: Int -> FCode VirtualSpOffset -allocPrimStack size info_down (MkCgState absC binds - ((virt_sp, free_stk, real_sp, hw_sp), h_usage)) - = (chosen_slot, MkCgState absC binds (new_stk_usage, h_usage)) +allocPrimStack :: CgRep -> FCode VirtualSpOffset +allocPrimStack rep + = do { stk_usg <- getStkUsage + ; let free_stk = freeStk stk_usg + ; case find_block free_stk of + Nothing -> do + { let push_virt_sp = virtSp stk_usg + size + ; setStkUsage (stk_usg { virtSp = push_virt_sp, + hwSp = hwSp stk_usg `max` push_virt_sp }) + -- Adjust high water mark + ; return push_virt_sp } + Just slot -> do + { setStkUsage (stk_usg { freeStk = delete_block free_stk slot }) + ; return slot } + } where - push_virt_sp = virt_sp + size - - (chosen_slot, new_stk_usage) - = case find_block free_stk of - Nothing -> (push_virt_sp, (push_virt_sp, free_stk, real_sp, - hw_sp `max` push_virt_sp)) - -- Adjust high water mark + size :: WordOff + size = cgRepSizeW rep - Just slot -> (slot, (virt_sp, - delete_block free_stk slot, real_sp, hw_sp)) - - -- find_block looks for a contiguous chunk of free slots + -- Find_block looks for a contiguous chunk of free slots + -- returning the offset of its topmost word find_block :: [VirtualSpOffset] -> Maybe VirtualSpOffset find_block [] = Nothing find_block (slot:slots) - | take size (slot:slots) == [slot..top_slot] = Just top_slot - | otherwise = find_block slots - -- The stack grows downwards, with increasing virtual offsets. - -- Therefore, the address of a multi-word object is the *highest* - -- virtual offset it occupies (top_slot below). - where top_slot = slot+size-1 - - delete_block free_stk slot = [s | s <- free_stk, (s<=slot-size) || (s>slot)] - -- Retain slots which are not in the range - -- slot-size+1..slot - --- Allocate a chunk ON TOP OF the stack -allocStackTop :: Int -> FCode VirtualSpOffset -allocStackTop size info_down (MkCgState absC binds - ((virt_sp, free_stk, real_sp, hw_sp), h_usage)) - = (push_virt_sp, MkCgState absC binds (new_stk_usage, h_usage)) - where - push_virt_sp = virt_sp + size - new_stk_usage = (push_virt_sp, free_stk, real_sp, hw_sp `max` push_virt_sp) - -- Adjust high water mark + | take size (slot:slots) == [slot..top_slot] + = Just top_slot + | otherwise + = find_block slots + where -- The stack grows downwards, with increasing virtual offsets. + -- Therefore, the address of a multi-word object is the *highest* + -- virtual offset it occupies (top_slot below). + top_slot = slot+size-1 + + delete_block free_stk slot = [ s | s <- free_stk, + (s<=slot-size) || (s>slot) ] + -- Retain slots which are not in the range + -- slot-size+1..slot \end{code} -Pop some words from the current top of stack. This is used for -de-allocating the return address in a case alternative. +Allocate a chunk ON TOP OF the stack. \begin{code} -deAllocStackTop :: Int -> FCode VirtualSpOffset -deAllocStackTop size info_down (MkCgState absC binds - ((virt_sp, free_stk, real_sp, hw_sp), h_usage)) - = (pop_virt_sp, MkCgState absC binds (new_stk_usage, h_usage)) - where - pop_virt_sp = virt_sp - size - new_stk_usage = (pop_virt_sp, free_stk, real_sp, hw_sp) +allocStackTop :: WordOff -> FCode VirtualSpOffset +allocStackTop size + = do { stk_usg <- getStkUsage + ; let push_virt_sp = virtSp stk_usg + size + ; setStkUsage (stk_usg { virtSp = push_virt_sp, + hwSp = hwSp stk_usg `max` push_virt_sp }) + ; return push_virt_sp } \end{code} -@allocUpdateFrame@ allocates enough space for an update frame on the -stack, records the fact in the end-of-block info (in the ``args'' -fields), and passes on the old ``args'' fields to the enclosed code. - -This is all a bit disgusting. +Pop some words from the current top of stack. This is used for +de-allocating the return address in a case alternative. \begin{code} -allocUpdateFrame :: Int -- Size of frame - -> Code -- Scope of update - -> Code - -allocUpdateFrame size code - (MkCgInfoDown c_info statics srt (EndOfBlockInfo args_Sp sequel)) - (MkCgState absc binds ((vSp,rr,qq,hwSp),h_usage)) - = case sequel of - - OnStack _ -> code (MkCgInfoDown c_info statics srt new_eob_info) - (MkCgState absc binds new_usage) - - other -> panic "allocUpdateFrame" - - where - new_vSp = vSp + size - new_eob_info = EndOfBlockInfo new_vSp UpdateCode - new_usage = ((new_vSp,rr,qq,hwSp `max` new_vSp), h_usage) +deAllocStackTop :: WordOff -> FCode VirtualSpOffset +deAllocStackTop size + = do { stk_usg <- getStkUsage + ; let pop_virt_sp = virtSp stk_usg - size + ; setStkUsage (stk_usg { virtSp = pop_virt_sp }) + ; return pop_virt_sp } \end{code} \begin{code} adjustStackHW :: VirtualSpOffset -> Code -adjustStackHW offset info_down (MkCgState absC binds usage) - = MkCgState absC binds new_usage - where - ((vSp,fSp,realSp,hwSp), h_usage) = usage - new_usage = ((vSp, fSp, realSp, max offset hwSp), h_usage) - -- No need to fiddle with virtual Sp etc because this call is - -- only done just before the end of a block +adjustStackHW offset + = do { stk_usg <- getStkUsage + ; setStkUsage (stk_usg { hwSp = hwSp stk_usg `max` offset }) } \end{code} A knot-tying beast. \begin{code} getFinalStackHW :: (VirtualSpOffset -> Code) -> Code -getFinalStackHW fcode info_down (MkCgState absC binds usages) = state1 - where - state1 = fcode hwSp info_down (MkCgState absC binds usages) - (MkCgState _ _ ((_,_,_, hwSp), _)) = state1 +getFinalStackHW fcode + = do { fixC (\hw_sp -> do + { fcode hw_sp + ; stk_usg <- getStkUsage + ; return (hwSp stk_usg) }) + ; return () } \end{code} +\begin{code} +setStackFrame :: VirtualSpOffset -> Code +setStackFrame offset + = do { stk_usg <- getStkUsage + ; setStkUsage (stk_usg { frameSp = offset }) } + +getStackFrame :: FCode VirtualSpOffset +getStackFrame + = do { stk_usg <- getStkUsage + ; return (frameSp stk_usg) } +\end{code} -%************************************************************************ -%* * -\subsection[CgStackery-adjust]{Adjusting the stack pointers} -%* * -%************************************************************************ -@adjustRealSpX@ generates code to alter the actual stack pointer, and -adjusts the environment accordingly. We are careful to push the -conditional inside the abstract C code to avoid black holes. -ToDo: combine together? +%******************************************************** +%* * +%* Setting up update frames * +%* * +%******************************************************** -These functions {\em do not} deal with high-water-mark adjustment. -That's done by functions which allocate stack space. +@pushUpdateFrame@ $updatee$ pushes a general update frame which +points to $updatee$ as the thing to be updated. It is only used +when a thunk has just been entered, so the (real) stack pointers +are guaranteed to be nicely aligned with the top of stack. +@pushUpdateFrame@ adjusts the virtual and tail stack pointers +to reflect the frame pushed. \begin{code} -adjustRealSp :: VirtualSpOffset -- New offset for Arg stack ptr - -> Code -adjustRealSp newRealSp info_down (MkCgState absC binds - ((vSp,fSp,realSp,hwSp), h_usage)) - = MkCgState (mkAbsCStmts absC move_instr) binds new_usage - where - move_instr = if (newRealSp == realSp) then AbsCNop - else (CAssign - (CReg Sp) - (CAddr (spRel realSp newRealSp))) - new_usage = ((vSp, fSp, newRealSp, hwSp), h_usage) -\end{code} +pushUpdateFrame :: CmmExpr -> Code -> Code + +pushUpdateFrame updatee code + = do { +#ifdef DEBUG + EndOfBlockInfo _ sequel <- getEndOfBlockInfo ; + ASSERT(case sequel of { OnStack -> True; _ -> False}) +#endif + + allocStackTop (fixedHdrSize + + sIZEOF_StgUpdateFrame_NoHdr `quot` wORD_SIZE) + ; vsp <- getVirtSp + ; setStackFrame vsp + ; frame_addr <- getSpRelOffset vsp + -- The location of the lowest-address + -- word of the update frame itself + + ; setEndOfBlockInfo (EndOfBlockInfo vsp UpdateCode) $ + do { emitPushUpdateFrame frame_addr updatee + ; code } + } + +emitPushUpdateFrame :: CmmExpr -> CmmExpr -> Code +emitPushUpdateFrame frame_addr updatee = do + stmtsC [ -- Set the info word + CmmStore frame_addr (mkLblExpr mkUpdInfoLabel) + , -- And the updatee + CmmStore (cmmOffsetB frame_addr off_updatee) updatee ] + initUpdFrameProf frame_addr + +off_updatee :: ByteOff +off_updatee = fixedHdrSize*wORD_SIZE + oFFSET_StgUpdateFrame_updatee +\end{code} + %************************************************************************ %* * @@ -277,36 +310,30 @@ Explicitly free some stack space. \begin{code} freeStackSlots :: [VirtualSpOffset] -> Code -freeStackSlots extra_free info_down - state@(MkCgState abs_c binds ((vsp, free, real, hw), heap_usage)) - = MkCgState abs_c binds new_usage - where - new_usage = ((new_vsp, new_free, real, hw), heap_usage) - (new_vsp, new_free) = trim vsp (addFreeSlots free extra_free) - -addFreeSlots :: [Int] -> [Int] -> [Int] +freeStackSlots extra_free + = do { stk_usg <- getStkUsage + ; let all_free = addFreeSlots (freeStk stk_usg) (sortLe (<=) extra_free) + ; let (new_vsp, new_free) = trim (virtSp stk_usg) all_free + ; setStkUsage (stk_usg { virtSp = new_vsp, freeStk = new_free }) } + +addFreeSlots :: [VirtualSpOffset] -> [VirtualSpOffset] -> [VirtualSpOffset] +-- Merge the two, assuming both are in increasing order addFreeSlots cs [] = cs addFreeSlots [] ns = ns addFreeSlots (c:cs) (n:ns) - = if c < n then - c : addFreeSlots cs (n:ns) - else if c > n then - n : addFreeSlots (c:cs) ns - else - panic ("addFreeSlots: equal slots: " ++ show (c:cs) ++ show (n:ns)) - -trim :: Int{-offset-} -> [Int] -> (Int{-offset-}, [Int]) -trim current_sp free_slots - = try current_sp (reverse free_slots) - where - try csp [] = (csp, []) - try csp (slot:slots) - = if csp < slot then - try csp slots -- Free slot off top of stk; ignore - - else if csp == slot then - try (csp-1) slots -- Free slot at top of stk; trim - - else - (csp, reverse (slot:slots)) -- Otherwise gap; give up + | c < n = c : addFreeSlots cs (n:ns) + | otherwise = n : addFreeSlots (c:cs) ns + +trim :: VirtualSpOffset -> [VirtualSpOffset] -> (VirtualSpOffset, [VirtualSpOffset]) +-- Try to trim back the virtual stack pointer, where there is a +-- continuous bunch of free slots at the end of the free list +trim vsp [] = (vsp, []) +trim vsp (slot:slots) + = case trim vsp slots of + (vsp', []) + | vsp' < slot -> pprTrace "trim: strange" (ppr vsp <+> ppr (slot:slots)) + (vsp', []) + | vsp' == slot -> (vsp'-1, []) + | otherwise -> (vsp', [slot]) + (vsp', slots') -> (vsp', slot:slots') \end{code}