2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: CgStackery.lhs,v 1.11 1999/06/08 15:56:47 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
19 #include "HsVersions.h"
24 import CgUsages ( getRealSp )
25 import AbsCUtils ( mkAbstractCs, mkAbsCStmts, getAmodeRep )
26 import PrimRep ( getPrimRepSize, PrimRep(..), isFollowableRep )
27 import Panic ( panic )
28 import IOExts ( trace )
31 %************************************************************************
33 \subsection[CgStackery-layout]{Laying out a stack frame}
35 %************************************************************************
37 @mkTaggedVirtStkOffsets@ is given a list of arguments. The first
38 argument gets the {\em largest} virtual stack offset (remember,
39 virtual offsets increase towards the top of stack). This function
40 also computes the correct tagging arrangement for standard function
41 entry points. Each non-pointer on the stack is preceded by a tag word
42 indicating the number of non-pointer words above it on the stack.
44 offset --> | | <---- last allocated stack word
48 | | total_nptrs (words)
52 offset + tot_nptrs + 1 --> | tag |
56 mkTaggedVirtStkOffsets
57 :: VirtualSpOffset -- Offset of the last allocated thing
58 -> (a -> PrimRep) -- to be able to grab kinds
59 -> [a] -- things to make offsets for
60 -> (VirtualSpOffset, -- OUTPUTS: Topmost allocated word
61 [(a, VirtualSpOffset)], -- things with offsets
62 [(VirtualSpOffset,Int)]) -- offsets for tags
64 mkTaggedVirtStkOffsets init_Sp_offset kind_fun things
65 = loop init_Sp_offset [] [] (reverse things)
67 loop offset tags offs [] = (offset,offs,tags)
68 loop offset tags offs (t:things)
69 | isFollowableRep (kind_fun t) =
70 loop (offset+1) tags ((t,offset+1):offs) things
73 size = getPrimRepSize (kind_fun t)
74 tag_slot = offset+size+1
76 loop tag_slot ((tag_slot,size):tags) ((t,offset+size):offs) things
77 -- offset of thing is offset+size, because we're growing the stack
78 -- *downwards* as the offsets increase.
81 @mkTaggedStkAmodes@ is a higher-level version of
82 @mkTaggedVirtStkOffsets@. It starts from the tail-call locations. It
83 returns a single list of addressing modes for the stack locations, and
84 therefore is in the monad.
86 It *doesn't* adjust the high water mark.
90 :: VirtualSpOffset -- Tail call positions
91 -> [CAddrMode] -- things to make offsets for
92 -> FCode (VirtualSpOffset, -- OUTPUTS: Topmost allocated word
93 AbstractC, -- Assignments to appropriate stk slots
94 AbstractC) -- Assignments for tagging
96 mkTaggedStkAmodes tail_Sp things
97 = getRealSp `thenFC` \ realSp ->
99 (last_Sp_offset, offsets, tags)
100 = mkTaggedVirtStkOffsets tail_Sp getAmodeRep things
103 [ CAssign (CVal (spRel realSp offset) (getAmodeRep thing)) thing
104 | (thing, offset) <- offsets
108 [ CAssign (CVal (spRel realSp offset) WordRep)
109 (CMacroExpr WordRep ARG_TAG [mkIntCLit size])
110 | (offset,size) <- tags
113 returnFC (last_Sp_offset, mkAbstractCs abs_cs, mkAbstractCs tag_cs)
115 mkTagAssts :: [(VirtualSpOffset,Int)] -> FCode AbstractC
117 getRealSp `thenFC` \realSp ->
118 returnFC (mkAbstractCs
119 [ CAssign (CVal (spRel realSp offset) WordRep)
120 (CMacroExpr WordRep ARG_TAG [mkIntCLit size])
121 | (offset,size) <- tags
126 %************************************************************************
128 \subsection[CgStackery-monadery]{Inside-monad functions for stack manipulation}
130 %************************************************************************
132 Allocate a virtual offset for something.
135 allocStack :: FCode VirtualSpOffset
136 allocStack = allocPrimStack 1
138 allocPrimStack :: Int -> FCode VirtualSpOffset
139 allocPrimStack size info_down (MkCgState absC binds
140 ((virt_sp, free_stk, real_sp, hw_sp), h_usage))
141 = (chosen_slot, MkCgState absC binds (new_stk_usage, h_usage))
143 push_virt_sp = virt_sp + size
145 (chosen_slot, new_stk_usage)
146 = case find_block free_stk of
147 Nothing -> (push_virt_sp, (push_virt_sp, free_stk, real_sp,
148 hw_sp `max` push_virt_sp))
149 -- Adjust high water mark
151 Just slot -> (slot, (virt_sp,
152 delete_block free_stk slot, real_sp, hw_sp))
154 -- find_block looks for a contiguous chunk of free slots
155 find_block :: [(VirtualSpOffset,Slot)] -> Maybe VirtualSpOffset
156 find_block [] = Nothing
157 find_block ((off,free):slots)
158 | take size ((off,free):slots) ==
159 zip [off..top_slot] (repeat Free) = Just top_slot
160 | otherwise = find_block slots
161 -- The stack grows downwards, with increasing virtual offsets.
162 -- Therefore, the address of a multi-word object is the *highest*
163 -- virtual offset it occupies (top_slot below).
164 where top_slot = off+size-1
166 delete_block free_stk slot = [ (s,f) | (s,f) <- free_stk,
167 (s<=slot-size) || (s>slot) ]
168 -- Retain slots which are not in the range
172 Allocate a chunk ON TOP OF the stack.
174 ToDo: should really register this memory as NonPointer stuff in the
178 allocStackTop :: Int -> FCode VirtualSpOffset
179 allocStackTop size info_down (MkCgState absC binds
180 ((virt_sp, free_stk, real_sp, hw_sp), h_usage))
181 = (push_virt_sp, MkCgState absC binds (new_stk_usage, h_usage))
183 push_virt_sp = virt_sp + size
184 new_stk_usage = (push_virt_sp, free_stk, real_sp, hw_sp `max` push_virt_sp)
185 -- Adjust high water mark
188 Pop some words from the current top of stack. This is used for
189 de-allocating the return address in a case alternative.
192 deAllocStackTop :: Int -> FCode VirtualSpOffset
193 deAllocStackTop size info_down (MkCgState absC binds
194 ((virt_sp, free_stk, real_sp, hw_sp), h_usage))
195 = (pop_virt_sp, MkCgState absC binds (new_stk_usage, h_usage))
197 pop_virt_sp = virt_sp - size
198 new_stk_usage = (pop_virt_sp, free_stk, real_sp, hw_sp)
202 adjustStackHW :: VirtualSpOffset -> Code
203 adjustStackHW offset info_down (MkCgState absC binds usage)
204 = MkCgState absC binds new_usage
206 ((vSp,fSp,realSp,hwSp), h_usage) = usage
207 new_usage = ((vSp, fSp, realSp, max offset hwSp), h_usage)
208 -- No need to fiddle with virtual Sp etc because this call is
209 -- only done just before the end of a block
215 getFinalStackHW :: (VirtualSpOffset -> Code) -> Code
216 getFinalStackHW fcode info_down (MkCgState absC binds usages) = state1
218 state1 = fcode hwSp info_down (MkCgState absC binds usages)
219 (MkCgState _ _ ((_,_,_, hwSp), _)) = state1
223 %************************************************************************
225 \subsection[CgStackery-free]{Free stack slots}
227 %************************************************************************
229 Explicitly free some stack space.
232 addFreeStackSlots :: [VirtualSpOffset] -> Slot -> Code
233 addFreeStackSlots extra_free slot info_down
234 state@(MkCgState abs_c binds ((vsp, free, real, hw), heap_usage))
235 = MkCgState abs_c binds new_usage
237 new_usage = ((new_vsp, new_free, real, hw), heap_usage)
238 (new_vsp, new_free) = trim vsp all_free
239 all_free = addFreeSlots free (zip extra_free (repeat slot))
241 freeStackSlots :: [VirtualSpOffset] -> Code
242 freeStackSlots slots = addFreeStackSlots slots Free
244 dataStackSlots :: [VirtualSpOffset] -> Code
245 dataStackSlots slots = addFreeStackSlots slots NonPointer
247 addFreeSlots :: [(Int,Slot)] -> [(Int,Slot)] -> [(Int,Slot)]
248 addFreeSlots cs [] = cs
249 addFreeSlots [] ns = ns
250 addFreeSlots ((c,s):cs) ((n,s'):ns)
252 (c,s) : addFreeSlots cs ((n,s'):ns)
254 (n,s') : addFreeSlots ((c,s):cs) ns
255 else if s /= s' then -- c == n
256 (c,s') : addFreeSlots cs ns
258 panic ("addFreeSlots: equal slots: " ++ show (c:map fst cs)
259 ++ show (n:map fst ns))
261 trim :: Int{-offset-} -> [(Int,Slot)] -> (Int{-offset-}, [(Int,Slot)])
262 trim current_sp free_slots
263 = try current_sp free_slots
265 try csp [] = (csp,[])
267 try csp (slot@(off,state):slots) =
268 if state == Free && null slots' then
271 else if csp' == off then
278 (csp',slots') = try csp slots