X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgStackery.lhs;h=6683de4c8b290c548a01233e27bba314ccf8af4e;hb=2662dbc5b2c30fc11ccb99e7f9b2dba794d680ba;hp=e0158959422b9b39a379f4b7e893e5ac7b47427d;hpb=ad94d40948668032189ad22a0ad741ac1f645f50;p=ghc-hetmet.git diff --git a/compiler/codeGen/CgStackery.lhs b/compiler/codeGen/CgStackery.lhs index e015895..6683de4 100644 --- a/compiler/codeGen/CgStackery.lhs +++ b/compiler/codeGen/CgStackery.lhs @@ -8,13 +8,6 @@ Stack-twiddling operations, which are pretty low-down and grimy. (This is the module that knows all about stack layouts, etc.) \begin{code} -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings --- for details - module CgStackery ( spRel, getVirtSp, getRealSp, setRealSp, setRealAndVirtualSp, getSpRelOffset, @@ -38,9 +31,10 @@ import CmmUtils import CLabel import Constants import Util -import FastString import OrdList import Outputable + +import Control.Monad \end{code} %************************************************************************ @@ -123,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 @@ -204,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} @@ -237,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) }) @@ -272,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 @@ -303,7 +292,7 @@ emitPushUpdateFrame frame_addr updatee = do off_updatee :: ByteOff off_updatee = fixedHdrSize*wORD_SIZE + oFFSET_StgUpdateFrame_updatee -\end{code} +\end{code} %************************************************************************