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"
48 %************************************************************************
50 \subsection[CgUsages-stackery]{Monad things for fiddling with stack usage}
52 %************************************************************************
54 spRel is a little function that abstracts the stack direction. Note that most
55 of the code generator is dependent on the stack direction anyway, so
56 changing this on its own spells certain doom. ToDo: remove?
58 THIS IS DIRECTION SENSITIVE!
60 Stack grows down, positive virtual offsets correspond to negative
61 additions to the stack pointer.
64 spRel :: VirtualSpOffset -- virtual offset of Sp
65 -> VirtualSpOffset -- virtual offset of The Thing
66 -> WordOff -- integer offset
67 spRel sp off = sp - off
70 @setRealAndVirtualSp@ sets into the environment the offsets of the
71 current position of the real and virtual stack pointers in the current
72 stack frame. The high-water mark is set too. It generates no code.
73 It is used to initialise things at the beginning of a closure body.
76 setRealAndVirtualSp :: VirtualSpOffset -- New real Sp
79 setRealAndVirtualSp new_sp
80 = do { stk_usg <- getStkUsage
81 ; setStkUsage (stk_usg {virtSp = new_sp,
85 getVirtSp :: FCode VirtualSpOffset
87 = do { stk_usg <- getStkUsage
88 ; return (virtSp stk_usg) }
90 getRealSp :: FCode VirtualSpOffset
92 = do { stk_usg <- getStkUsage
93 ; return (realSp stk_usg) }
95 setRealSp :: VirtualSpOffset -> Code
97 = do { stk_usg <- getStkUsage
98 ; setStkUsage (stk_usg {realSp = new_real_sp}) }
100 getSpRelOffset :: VirtualSpOffset -> FCode CmmExpr
101 getSpRelOffset virtual_offset
102 = do { real_sp <- getRealSp
103 ; return (cmmRegOffW spReg (spRel real_sp virtual_offset)) }
107 %************************************************************************
109 \subsection[CgStackery-layout]{Laying out a stack frame}
111 %************************************************************************
113 'mkVirtStkOffsets' is given a list of arguments. The first argument
114 gets the /largest/ virtual stack offset (remember, virtual offsets
115 increase towards the top of stack).
119 :: VirtualSpOffset -- Offset of the last allocated thing
120 -> [(CgRep,a)] -- things to make offsets for
121 -> (VirtualSpOffset, -- OUTPUTS: Topmost allocated word
122 [(a, VirtualSpOffset)]) -- things with offsets (voids filtered out)
124 mkVirtStkOffsets init_Sp_offset things
125 = loop init_Sp_offset [] (reverse things)
127 loop offset offs [] = (offset,offs)
128 loop offset offs ((VoidArg,t):things) = loop offset offs things
129 -- ignore Void arguments
130 loop offset offs ((rep,t):things)
131 = loop thing_slot ((t,thing_slot):offs) things
133 thing_slot = offset + cgRepSizeW rep
134 -- offset of thing is offset+size, because we're
135 -- growing the stack *downwards* as the offsets increase.
137 -- | 'mkStkAmodes' is a higher-level version of
138 -- 'mkVirtStkOffsets'. It starts from the tail-call locations.
139 -- It returns a single list of addressing modes for the stack
140 -- locations, and therefore is in the monad. It /doesn't/ adjust the
144 :: VirtualSpOffset -- Tail call positions
145 -> [(CgRep,CmmExpr)] -- things to make offsets for
146 -> FCode (VirtualSpOffset, -- OUTPUTS: Topmost allocated word
147 CmmStmts) -- Assignments to appropriate stk slots
149 mkStkAmodes tail_Sp things
150 = do { rSp <- getRealSp
151 ; let (last_Sp_offset, offsets) = mkVirtStkOffsets tail_Sp things
152 abs_cs = [ CmmStore (cmmRegOffW spReg (spRel rSp offset)) amode
153 | (amode, offset) <- offsets
155 ; returnFC (last_Sp_offset, toOL abs_cs) }
158 %************************************************************************
160 \subsection[CgStackery-monadery]{Inside-monad functions for stack manipulation}
162 %************************************************************************
164 Allocate a virtual offset for something.
167 allocPrimStack :: CgRep -> FCode VirtualSpOffset
169 = do { stk_usg <- getStkUsage
170 ; let free_stk = freeStk stk_usg
171 ; case find_block free_stk of
173 { let push_virt_sp = virtSp stk_usg + size
174 ; setStkUsage (stk_usg { virtSp = push_virt_sp,
175 hwSp = hwSp stk_usg `max` push_virt_sp })
176 -- Adjust high water mark
177 ; return push_virt_sp }
179 { setStkUsage (stk_usg { freeStk = delete_block free_stk slot })
184 size = cgRepSizeW rep
186 -- Find_block looks for a contiguous chunk of free slots
187 -- returning the offset of its topmost word
188 find_block :: [VirtualSpOffset] -> Maybe VirtualSpOffset
189 find_block [] = Nothing
190 find_block (slot:slots)
191 | take size (slot:slots) == [slot..top_slot]
195 where -- The stack grows downwards, with increasing virtual offsets.
196 -- Therefore, the address of a multi-word object is the *highest*
197 -- virtual offset it occupies (top_slot below).
198 top_slot = slot+size-1
200 delete_block free_stk slot = [ s | s <- free_stk,
201 (s<=slot-size) || (s>slot) ]
202 -- Retain slots which are not in the range
206 Allocate a chunk ON TOP OF the stack.
209 allocStackTop :: WordOff -> FCode VirtualSpOffset
211 = do { stk_usg <- getStkUsage
212 ; let push_virt_sp = virtSp stk_usg + size
213 ; setStkUsage (stk_usg { virtSp = push_virt_sp,
214 hwSp = hwSp stk_usg `max` push_virt_sp })
215 ; return push_virt_sp }
218 Pop some words from the current top of stack. This is used for
219 de-allocating the return address in a case alternative.
222 deAllocStackTop :: WordOff -> FCode VirtualSpOffset
224 = do { stk_usg <- getStkUsage
225 ; let pop_virt_sp = virtSp stk_usg - size
226 ; setStkUsage (stk_usg { virtSp = pop_virt_sp })
227 ; return pop_virt_sp }
231 adjustStackHW :: VirtualSpOffset -> Code
233 = do { stk_usg <- getStkUsage
234 ; setStkUsage (stk_usg { hwSp = hwSp stk_usg `max` offset }) }
240 getFinalStackHW :: (VirtualSpOffset -> Code) -> Code
241 getFinalStackHW fcode
242 = do { fixC (\hw_sp -> do
244 ; stk_usg <- getStkUsage
245 ; return (hwSp stk_usg) })
250 setStackFrame :: VirtualSpOffset -> Code
252 = do { stk_usg <- getStkUsage
253 ; setStkUsage (stk_usg { frameSp = offset }) }
255 getStackFrame :: FCode VirtualSpOffset
257 = do { stk_usg <- getStkUsage
258 ; return (frameSp stk_usg) }
262 %********************************************************
264 %* Setting up update frames *
266 %********************************************************
268 @pushUpdateFrame@ $updatee$ pushes a general update frame which
269 points to $updatee$ as the thing to be updated. It is only used
270 when a thunk has just been entered, so the (real) stack pointers
271 are guaranteed to be nicely aligned with the top of stack.
272 @pushUpdateFrame@ adjusts the virtual and tail stack pointers
273 to reflect the frame pushed.
276 pushUpdateFrame :: CmmExpr -> Code -> Code
278 pushUpdateFrame updatee code
281 { EndOfBlockInfo _ sequel <- getEndOfBlockInfo ;
282 ; MASSERT(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')