2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
5 \section[CgStackery]{Stack management functions}
7 Stack-twiddling operations, which are pretty low-down and grimy.
8 (This is the module that knows all about stack layouts, etc.)
12 -- The above warning supression flag is a temporary kludge.
13 -- While working on this module you are encouraged to remove it and fix
14 -- any warnings in the module. See
15 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
19 spRel, getVirtSp, getRealSp, setRealSp,
20 setRealAndVirtualSp, getSpRelOffset,
22 allocPrimStack, allocStackTop, deAllocStackTop,
23 adjustStackHW, getFinalStackHW,
24 setStackFrame, getStackFrame,
25 mkVirtStkOffsets, mkStkAmodes,
27 pushUpdateFrame, emitPushUpdateFrame,
30 #include "HsVersions.h"
46 %************************************************************************
48 \subsection[CgUsages-stackery]{Monad things for fiddling with stack usage}
50 %************************************************************************
52 spRel is a little function that abstracts the stack direction. Note that most
53 of the code generator is dependent on the stack direction anyway, so
54 changing this on its own spells certain doom. ToDo: remove?
56 THIS IS DIRECTION SENSITIVE!
58 Stack grows down, positive virtual offsets correspond to negative
59 additions to the stack pointer.
62 spRel :: VirtualSpOffset -- virtual offset of Sp
63 -> VirtualSpOffset -- virtual offset of The Thing
64 -> WordOff -- integer offset
65 spRel sp off = sp - off
68 @setRealAndVirtualSp@ sets into the environment the offsets of the
69 current position of the real and virtual stack pointers in the current
70 stack frame. The high-water mark is set too. It generates no code.
71 It is used to initialise things at the beginning of a closure body.
74 setRealAndVirtualSp :: VirtualSpOffset -- New real Sp
77 setRealAndVirtualSp new_sp
78 = do { stk_usg <- getStkUsage
79 ; setStkUsage (stk_usg {virtSp = new_sp,
83 getVirtSp :: FCode VirtualSpOffset
85 = do { stk_usg <- getStkUsage
86 ; return (virtSp stk_usg) }
88 getRealSp :: FCode VirtualSpOffset
90 = do { stk_usg <- getStkUsage
91 ; return (realSp stk_usg) }
93 setRealSp :: VirtualSpOffset -> Code
95 = do { stk_usg <- getStkUsage
96 ; setStkUsage (stk_usg {realSp = new_real_sp}) }
98 getSpRelOffset :: VirtualSpOffset -> FCode CmmExpr
99 getSpRelOffset virtual_offset
100 = do { real_sp <- getRealSp
101 ; return (cmmRegOffW spReg (spRel real_sp virtual_offset)) }
105 %************************************************************************
107 \subsection[CgStackery-layout]{Laying out a stack frame}
109 %************************************************************************
111 'mkVirtStkOffsets' is given a list of arguments. The first argument
112 gets the /largest/ virtual stack offset (remember, virtual offsets
113 increase towards the top of stack).
117 :: VirtualSpOffset -- Offset of the last allocated thing
118 -> [(CgRep,a)] -- things to make offsets for
119 -> (VirtualSpOffset, -- OUTPUTS: Topmost allocated word
120 [(a, VirtualSpOffset)]) -- things with offsets (voids filtered out)
122 mkVirtStkOffsets init_Sp_offset things
123 = loop init_Sp_offset [] (reverse things)
125 loop offset offs [] = (offset,offs)
126 loop offset offs ((VoidArg,t):things) = loop offset offs things
127 -- ignore Void arguments
128 loop offset offs ((rep,t):things)
129 = loop thing_slot ((t,thing_slot):offs) things
131 thing_slot = offset + cgRepSizeW rep
132 -- offset of thing is offset+size, because we're
133 -- growing the stack *downwards* as the offsets increase.
135 -- | 'mkStkAmodes' is a higher-level version of
136 -- 'mkVirtStkOffsets'. It starts from the tail-call locations.
137 -- It returns a single list of addressing modes for the stack
138 -- locations, and therefore is in the monad. It /doesn't/ adjust the
142 :: VirtualSpOffset -- Tail call positions
143 -> [(CgRep,CmmExpr)] -- things to make offsets for
144 -> FCode (VirtualSpOffset, -- OUTPUTS: Topmost allocated word
145 CmmStmts) -- Assignments to appropriate stk slots
147 mkStkAmodes tail_Sp things
148 = do { rSp <- getRealSp
149 ; let (last_Sp_offset, offsets) = mkVirtStkOffsets tail_Sp things
150 abs_cs = [ CmmStore (cmmRegOffW spReg (spRel rSp offset)) amode
151 | (amode, offset) <- offsets
153 ; returnFC (last_Sp_offset, toOL abs_cs) }
156 %************************************************************************
158 \subsection[CgStackery-monadery]{Inside-monad functions for stack manipulation}
160 %************************************************************************
162 Allocate a virtual offset for something.
165 allocPrimStack :: CgRep -> FCode VirtualSpOffset
167 = do { stk_usg <- getStkUsage
168 ; let free_stk = freeStk stk_usg
169 ; case find_block free_stk of
171 { let push_virt_sp = virtSp stk_usg + size
172 ; setStkUsage (stk_usg { virtSp = push_virt_sp,
173 hwSp = hwSp stk_usg `max` push_virt_sp })
174 -- Adjust high water mark
175 ; return push_virt_sp }
177 { setStkUsage (stk_usg { freeStk = delete_block free_stk slot })
182 size = cgRepSizeW rep
184 -- Find_block looks for a contiguous chunk of free slots
185 -- returning the offset of its topmost word
186 find_block :: [VirtualSpOffset] -> Maybe VirtualSpOffset
187 find_block [] = Nothing
188 find_block (slot:slots)
189 | take size (slot:slots) == [slot..top_slot]
193 where -- The stack grows downwards, with increasing virtual offsets.
194 -- Therefore, the address of a multi-word object is the *highest*
195 -- virtual offset it occupies (top_slot below).
196 top_slot = slot+size-1
198 delete_block free_stk slot = [ s | s <- free_stk,
199 (s<=slot-size) || (s>slot) ]
200 -- Retain slots which are not in the range
204 Allocate a chunk ON TOP OF the stack.
207 allocStackTop :: WordOff -> FCode VirtualSpOffset
209 = do { stk_usg <- getStkUsage
210 ; let push_virt_sp = virtSp stk_usg + size
211 ; setStkUsage (stk_usg { virtSp = push_virt_sp,
212 hwSp = hwSp stk_usg `max` push_virt_sp })
213 ; return push_virt_sp }
216 Pop some words from the current top of stack. This is used for
217 de-allocating the return address in a case alternative.
220 deAllocStackTop :: WordOff -> FCode VirtualSpOffset
222 = do { stk_usg <- getStkUsage
223 ; let pop_virt_sp = virtSp stk_usg - size
224 ; setStkUsage (stk_usg { virtSp = pop_virt_sp })
225 ; return pop_virt_sp }
229 adjustStackHW :: VirtualSpOffset -> Code
231 = do { stk_usg <- getStkUsage
232 ; setStkUsage (stk_usg { hwSp = hwSp stk_usg `max` offset }) }
238 getFinalStackHW :: (VirtualSpOffset -> Code) -> Code
239 getFinalStackHW fcode
240 = do { fixC (\hw_sp -> do
242 ; stk_usg <- getStkUsage
243 ; return (hwSp stk_usg) })
248 setStackFrame :: VirtualSpOffset -> Code
250 = do { stk_usg <- getStkUsage
251 ; setStkUsage (stk_usg { frameSp = offset }) }
253 getStackFrame :: FCode VirtualSpOffset
255 = do { stk_usg <- getStkUsage
256 ; return (frameSp stk_usg) }
260 %********************************************************
262 %* Setting up update frames *
264 %********************************************************
266 @pushUpdateFrame@ $updatee$ pushes a general update frame which
267 points to $updatee$ as the thing to be updated. It is only used
268 when a thunk has just been entered, so the (real) stack pointers
269 are guaranteed to be nicely aligned with the top of stack.
270 @pushUpdateFrame@ adjusts the virtual and tail stack pointers
271 to reflect the frame pushed.
274 pushUpdateFrame :: CmmExpr -> Code -> Code
276 pushUpdateFrame updatee code
279 EndOfBlockInfo _ sequel <- getEndOfBlockInfo ;
280 ASSERT(case sequel of { OnStack -> True; _ -> False})
283 allocStackTop (fixedHdrSize +
284 sIZEOF_StgUpdateFrame_NoHdr `quot` wORD_SIZE)
287 ; frame_addr <- getSpRelOffset vsp
288 -- The location of the lowest-address
289 -- word of the update frame itself
291 ; setEndOfBlockInfo (EndOfBlockInfo vsp UpdateCode) $
292 do { emitPushUpdateFrame frame_addr updatee
296 emitPushUpdateFrame :: CmmExpr -> CmmExpr -> Code
297 emitPushUpdateFrame frame_addr updatee = do
298 stmtsC [ -- Set the info word
299 CmmStore frame_addr (mkLblExpr mkUpdInfoLabel)
301 CmmStore (cmmOffsetB frame_addr off_updatee) updatee ]
302 initUpdFrameProf frame_addr
304 off_updatee :: ByteOff
305 off_updatee = fixedHdrSize*wORD_SIZE + oFFSET_StgUpdateFrame_updatee
309 %************************************************************************
311 \subsection[CgStackery-free]{Free stack slots}
313 %************************************************************************
315 Explicitly free some stack space.
318 freeStackSlots :: [VirtualSpOffset] -> Code
319 freeStackSlots extra_free
320 = do { stk_usg <- getStkUsage
321 ; let all_free = addFreeSlots (freeStk stk_usg) (sortLe (<=) extra_free)
322 ; let (new_vsp, new_free) = trim (virtSp stk_usg) all_free
323 ; setStkUsage (stk_usg { virtSp = new_vsp, freeStk = new_free }) }
325 addFreeSlots :: [VirtualSpOffset] -> [VirtualSpOffset] -> [VirtualSpOffset]
326 -- Merge the two, assuming both are in increasing order
327 addFreeSlots cs [] = cs
328 addFreeSlots [] ns = ns
329 addFreeSlots (c:cs) (n:ns)
330 | c < n = c : addFreeSlots cs (n:ns)
331 | otherwise = n : addFreeSlots (c:cs) ns
333 trim :: VirtualSpOffset -> [VirtualSpOffset] -> (VirtualSpOffset, [VirtualSpOffset])
334 -- Try to trim back the virtual stack pointer, where there is a
335 -- continuous bunch of free slots at the end of the free list
336 trim vsp [] = (vsp, [])
337 trim vsp (slot:slots)
338 = case trim vsp slots of
340 | vsp' < slot -> pprTrace "trim: strange" (ppr vsp <+> ppr (slot:slots))
342 | vsp' == slot -> (vsp'-1, [])
343 | otherwise -> (vsp', [slot])
344 (vsp', slots') -> (vsp', slot:slots')