2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: CgStackery.lhs,v 1.20 2001/10/03 13:57:42 simonmar Exp $
6 \section[CgStackery]{Stack management functions}
8 Stack-twiddling operations, which are pretty low-down and grimy.
9 (This is the module that knows all about stack layouts, etc.)
13 allocStack, allocPrimStack, allocStackTop, deAllocStackTop,
14 adjustStackHW, getFinalStackHW,
15 mkTaggedVirtStkOffsets, mkTaggedStkAmodes, mkTagAssts,
16 freeStackSlots, dataStackSlots, addFreeSlots,
17 updateFrameSize, seqFrameSize
20 #include "HsVersions.h"
25 import CgUsages ( getRealSp )
26 import AbsCUtils ( mkAbstractCs, getAmodeRep )
27 import PrimRep ( getPrimRepSize, PrimRep(..), isFollowableRep )
28 import CmdLineOpts ( opt_SccProfilingOn, opt_GranMacros )
29 import Panic ( panic )
30 import Constants ( uF_SIZE, pROF_UF_SIZE, gRAN_UF_SIZE,
31 sEQ_FRAME_SIZE, pROF_SEQ_FRAME_SIZE,
34 import Util ( sortLt )
35 import IOExts ( trace )
38 %************************************************************************
40 \subsection[CgStackery-layout]{Laying out a stack frame}
42 %************************************************************************
44 @mkTaggedVirtStkOffsets@ is given a list of arguments. The first
45 argument gets the {\em largest} virtual stack offset (remember,
46 virtual offsets increase towards the top of stack). This function
47 also computes the correct tagging arrangement for standard function
48 entry points. Each non-pointer on the stack is preceded by a tag word
49 indicating the number of non-pointer words above it on the stack.
51 offset --> | | <---- last allocated stack word
55 | | total_nptrs (words)
59 offset + tot_nptrs + 1 --> | tag |
63 mkTaggedVirtStkOffsets
64 :: VirtualSpOffset -- Offset of the last allocated thing
65 -> (a -> PrimRep) -- to be able to grab kinds
66 -> [a] -- things to make offsets for
67 -> (VirtualSpOffset, -- OUTPUTS: Topmost allocated word
68 [(a, VirtualSpOffset)], -- things with offsets
69 [(VirtualSpOffset,Int)]) -- offsets for tags
71 mkTaggedVirtStkOffsets init_Sp_offset kind_fun things
72 = loop init_Sp_offset [] [] (reverse things)
74 loop offset tags offs [] = (offset,offs,tags)
75 loop offset tags offs (t:things)
76 | isFollowableRep (kind_fun t) =
77 loop (offset+1) tags ((t,offset+1):offs) things
80 size = getPrimRepSize (kind_fun t)
81 tag_slot = offset+size+1
83 loop tag_slot ((tag_slot,size):tags) ((t,offset+size):offs) things
84 -- offset of thing is offset+size, because we're growing the stack
85 -- *downwards* as the offsets increase.
88 @mkTaggedStkAmodes@ is a higher-level version of
89 @mkTaggedVirtStkOffsets@. It starts from the tail-call locations. It
90 returns a single list of addressing modes for the stack locations, and
91 therefore is in the monad.
93 It *doesn't* adjust the high water mark.
97 :: VirtualSpOffset -- Tail call positions
98 -> [CAddrMode] -- things to make offsets for
99 -> FCode (VirtualSpOffset, -- OUTPUTS: Topmost allocated word
100 AbstractC, -- Assignments to appropriate stk slots
101 AbstractC) -- Assignments for tagging
103 mkTaggedStkAmodes tail_Sp things
104 = getRealSp `thenFC` \ realSp ->
106 (last_Sp_offset, offsets, tags)
107 = mkTaggedVirtStkOffsets tail_Sp getAmodeRep things
110 [ CAssign (CVal (spRel realSp offset) (getAmodeRep thing)) thing
111 | (thing, offset) <- offsets
115 [ CAssign (CVal (spRel realSp offset) WordRep)
116 (CMacroExpr WordRep ARG_TAG [mkIntCLit size])
117 | (offset,size) <- tags
120 returnFC (last_Sp_offset, mkAbstractCs abs_cs, mkAbstractCs tag_cs)
122 mkTagAssts :: [(VirtualSpOffset,Int)] -> FCode AbstractC
124 getRealSp `thenFC` \realSp ->
125 returnFC (mkAbstractCs
126 [ CAssign (CVal (spRel realSp offset) WordRep)
127 (CMacroExpr WordRep ARG_TAG [mkIntCLit size])
128 | (offset,size) <- tags
133 %************************************************************************
135 \subsection[CgStackery-monadery]{Inside-monad functions for stack manipulation}
137 %************************************************************************
139 Allocate a virtual offset for something.
142 allocStack :: FCode VirtualSpOffset
143 allocStack = allocPrimStack 1
145 allocPrimStack :: Int -> FCode VirtualSpOffset
146 allocPrimStack size = do
147 ((virt_sp, free_stk, real_sp, hw_sp),h_usage) <- getUsage
148 let push_virt_sp = virt_sp + size
149 let (chosen_slot, new_stk_usage) =
150 case find_block free_stk of
151 Nothing -> (push_virt_sp, (push_virt_sp, free_stk, real_sp,
152 hw_sp `max` push_virt_sp))
153 -- Adjust high water mark
154 Just slot -> (slot, (virt_sp,
155 delete_block free_stk slot, real_sp, hw_sp))
156 setUsage (new_stk_usage, h_usage)
160 -- find_block looks for a contiguous chunk of free slots
161 find_block :: [(VirtualSpOffset,Slot)] -> Maybe VirtualSpOffset
162 find_block [] = Nothing
163 find_block ((off,free):slots)
164 | take size ((off,free):slots) ==
165 zip [off..top_slot] (repeat Free) = Just top_slot
166 | otherwise = find_block slots
167 -- The stack grows downwards, with increasing virtual offsets.
168 -- Therefore, the address of a multi-word object is the *highest*
169 -- virtual offset it occupies (top_slot below).
170 where top_slot = off+size-1
172 delete_block free_stk slot = [ (s,f) | (s,f) <- free_stk,
173 (s<=slot-size) || (s>slot) ]
174 -- Retain slots which are not in the range
178 Allocate a chunk ON TOP OF the stack.
180 ToDo: should really register this memory as NonPointer stuff in the
184 allocStackTop :: Int -> FCode VirtualSpOffset
185 allocStackTop size = do
186 ((virt_sp, free_stk, real_sp, hw_sp), h_usage) <- getUsage
187 let push_virt_sp = virt_sp + size
188 let new_stk_usage = (push_virt_sp, free_stk, real_sp, hw_sp `max` push_virt_sp)
189 setUsage (new_stk_usage, h_usage)
193 Pop some words from the current top of stack. This is used for
194 de-allocating the return address in a case alternative.
197 deAllocStackTop :: Int -> FCode VirtualSpOffset
198 deAllocStackTop size = do
199 ((virt_sp, free_stk, real_sp, hw_sp), h_usage) <- getUsage
200 let pop_virt_sp = virt_sp - size
201 let new_stk_usage = (pop_virt_sp, free_stk, real_sp, hw_sp)
202 setUsage (new_stk_usage, h_usage)
207 adjustStackHW :: VirtualSpOffset -> Code
208 adjustStackHW offset = do
209 ((vSp,fSp,realSp,hwSp), h_usage) <- getUsage
210 setUsage ((vSp, fSp, realSp, max offset hwSp), h_usage)
216 getFinalStackHW :: (VirtualSpOffset -> Code) -> Code
217 getFinalStackHW fcode = do
220 ((_,_,_, hwSp),_) <- getUsage
226 updateFrameSize | opt_SccProfilingOn = pROF_UF_SIZE
227 | opt_GranMacros = trace ("updateFrameSize = " ++ (show gRAN_UF_SIZE))gRAN_UF_SIZE
228 | otherwise = uF_SIZE
230 seqFrameSize | opt_SccProfilingOn = pROF_SEQ_FRAME_SIZE
231 | opt_GranMacros = gRAN_SEQ_FRAME_SIZE
232 | otherwise = sEQ_FRAME_SIZE
235 %************************************************************************
237 \subsection[CgStackery-free]{Free stack slots}
239 %************************************************************************
241 Explicitly free some stack space.
244 addFreeStackSlots :: [VirtualSpOffset] -> Slot -> Code
245 addFreeStackSlots extra_free slot = do
246 ((vsp, free, real, hw),heap_usage) <- getUsage
247 let all_free = addFreeSlots free (zip (sortLt (<) extra_free) (repeat slot))
248 let (new_vsp, new_free) = trim vsp all_free
249 let new_usage = ((new_vsp, new_free, real, hw), heap_usage)
252 freeStackSlots :: [VirtualSpOffset] -> Code
253 freeStackSlots slots = addFreeStackSlots slots Free
255 dataStackSlots :: [VirtualSpOffset] -> Code
256 dataStackSlots slots = addFreeStackSlots slots NonPointer
258 addFreeSlots :: [(Int,Slot)] -> [(Int,Slot)] -> [(Int,Slot)]
259 addFreeSlots cs [] = cs
260 addFreeSlots [] ns = ns
261 addFreeSlots ((c,s):cs) ((n,s'):ns)
263 (c,s) : addFreeSlots cs ((n,s'):ns)
265 (n,s') : addFreeSlots ((c,s):cs) ns
266 else if s /= s' then -- c == n
267 (c,s') : addFreeSlots cs ns
269 panic ("addFreeSlots: equal slots: " ++ show (c:map fst cs)
270 ++ show (n:map fst ns))
272 trim :: Int{-offset-} -> [(Int,Slot)] -> (Int{-offset-}, [(Int,Slot)])
273 trim current_sp free_slots
274 = try current_sp free_slots
276 try csp [] = (csp,[])
278 try csp (slot@(off,state):slots) =
279 if state == Free && null slots' then
282 else if csp' == off then
289 (csp',slots') = try csp slots