X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgStackery.lhs;h=6683de4c8b290c548a01233e27bba314ccf8af4e;hb=a8d8c534d5363c865ee2c4948ccd52a64a62c55f;hp=7cb310d521022f610b0ec644556d2119d6a61e3c;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git diff --git a/compiler/codeGen/CgStackery.lhs b/compiler/codeGen/CgStackery.lhs index 7cb310d..6683de4 100644 --- a/compiler/codeGen/CgStackery.lhs +++ b/compiler/codeGen/CgStackery.lhs @@ -1,8 +1,7 @@ % +% (c) The University of Glasgow 2006 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: CgStackery.lhs,v 1.27 2004/09/30 10:35:49 simonpj Exp $ -% \section[CgStackery]{Stack management functions} Stack-twiddling operations, which are pretty low-down and grimy. @@ -24,17 +23,18 @@ module CgStackery ( #include "HsVersions.h" import CgMonad -import CgUtils ( cmmOffsetB, cmmRegOffW ) -import CgProf ( initUpdFrameProf ) +import CgUtils +import CgProf import SMRep import Cmm -import CmmUtils ( CmmStmts, mkLblExpr ) -import CLabel ( mkUpdInfoLabel ) +import CmmUtils +import CLabel import Constants -import Util ( sortLe ) -import FastString ( LitString ) -import OrdList ( toOL ) +import Util +import OrdList import Outputable + +import Control.Monad \end{code} %************************************************************************ @@ -117,7 +117,7 @@ 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 + loop offset offs ((VoidArg,_):things) = loop offset offs things -- ignore Void arguments loop offset offs ((rep,t):things) = loop thing_slot ((t,thing_slot):offs) things @@ -198,25 +198,23 @@ allocPrimStack rep Allocate a chunk ON TOP OF the stack. \begin{code} -allocStackTop :: WordOff -> FCode VirtualSpOffset +allocStackTop :: WordOff -> FCode () 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 } + hwSp = hwSp stk_usg `max` push_virt_sp }) } \end{code} Pop some words from the current top of stack. This is used for de-allocating the return address in a case alternative. \begin{code} -deAllocStackTop :: WordOff -> FCode VirtualSpOffset +deAllocStackTop :: WordOff -> FCode () 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 } + ; setStkUsage (stk_usg { virtSp = pop_virt_sp }) } \end{code} \begin{code} @@ -231,7 +229,7 @@ A knot-tying beast. \begin{code} getFinalStackHW :: (VirtualSpOffset -> Code) -> Code getFinalStackHW fcode - = do { fixC (\hw_sp -> do + = do { fixC_ (\hw_sp -> do { fcode hw_sp ; stk_usg <- getStkUsage ; return (hwSp stk_usg) }) @@ -266,15 +264,12 @@ to reflect the frame pushed. \begin{code} pushUpdateFrame :: CmmExpr -> Code -> Code - pushUpdateFrame updatee code = do { -#ifdef DEBUG - EndOfBlockInfo _ sequel <- getEndOfBlockInfo ; - ASSERT(case sequel of { OnStack -> True; _ -> False}) -#endif - - allocStackTop (fixedHdrSize + + when debugIsOn $ do + { EndOfBlockInfo _ sequel <- getEndOfBlockInfo ; + ; MASSERT(case sequel of { OnStack -> True; _ -> False}) } + ; allocStackTop (fixedHdrSize + sIZEOF_StgUpdateFrame_NoHdr `quot` wORD_SIZE) ; vsp <- getVirtSp ; setStackFrame vsp @@ -297,7 +292,7 @@ emitPushUpdateFrame frame_addr updatee = do off_updatee :: ByteOff off_updatee = fixedHdrSize*wORD_SIZE + oFFSET_StgUpdateFrame_updatee -\end{code} +\end{code} %************************************************************************