2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
4 \section[CgStackery]{Stack management functions}
6 Stack-twiddling operations, which are pretty low-down and grimy.
7 (This is the module that knows all about stack layouts, etc.)
10 #include "HsVersions.h"
13 allocAStack, allocBStack, allocUpdateFrame,
14 adjustRealSps, getFinalStackHW,
15 mkVirtStkOffsets, mkStkAmodes
17 -- and to make the interface self-sufficient...
24 import CgUsages ( getSpBRelOffset )
25 import Maybes ( Maybe(..) )
26 import PrimRep ( getPrimRepSize, retPrimRepSize, separateByPtrFollowness )
30 %************************************************************************
32 \subsection[CgStackery-layout]{Laying out a stack frame}
34 %************************************************************************
36 @mkVirtStkOffsets@ is given a list of arguments. The first argument
37 gets the {\em largest} virtual stack offset (remember, virtual offsets
38 increase towards the top of stack).
41 mkVirtStkOffsets :: VirtualSpAOffset -- Offset of the last allocated thing
42 -> VirtualSpBOffset -- ditto
43 -> (a -> PrimRep) -- to be able to grab kinds
44 -> [a] -- things to make offsets for
45 -> (VirtualSpAOffset, -- OUTPUTS: Topmost allocated word
46 VirtualSpBOffset, -- ditto
47 [(a, VirtualSpAOffset)], -- boxed things with offsets
48 [(a, VirtualSpBOffset)]) -- unboxed things with offsets
50 mkVirtStkOffsets init_SpA_offset init_SpB_offset kind_fun things
51 = let (boxeds, unboxeds)
52 = separateByPtrFollowness kind_fun things
53 (last_SpA_offset, boxd_w_offsets)
54 = mapAccumR computeOffset init_SpA_offset boxeds
55 (last_SpB_offset, ubxd_w_offsets)
56 = mapAccumR computeOffset init_SpB_offset unboxeds
58 (last_SpA_offset, last_SpB_offset, boxd_w_offsets, ubxd_w_offsets)
60 computeOffset offset thing
61 = (offset + (getPrimRepSize . kind_fun) thing, (thing, offset+(1::Int)))
64 @mkStackAmodes@ is a higher-level version of @mkStackOffsets@.
65 It starts from the tail-call locations.
66 It returns a single list of addressing modes for the stack locations,
67 and therefore is in the monad.
69 It also adjusts the high water mark if necessary.
72 mkStkAmodes :: VirtualSpAOffset -- Tail call positions
74 -> [CAddrMode] -- things to make offsets for
75 -> FCode (VirtualSpAOffset, -- OUTPUTS: Topmost allocated word
76 VirtualSpBOffset, -- ditto
77 AbstractC) -- Assignments to appropriate stk slots
79 mkStkAmodes tail_spa tail_spb things
80 info_down (MkCgState absC binds usage)
81 = (result, MkCgState absC binds new_usage)
83 result = (last_SpA_offset, last_SpB_offset, mkAbstractCs abs_cs)
85 (last_SpA_offset, last_SpB_offset, ptrs_w_offsets, non_ptrs_w_offsets)
86 = mkVirtStkOffsets tail_spa tail_spb getAmodeRep things
89 = [ CAssign (CVal (SpARel realSpA offset) PtrRep) thing
90 | (thing, offset) <- ptrs_w_offsets
93 [ CAssign (CVal (SpBRel realSpB offset) (getAmodeRep thing)) thing
94 | (thing, offset) <- non_ptrs_w_offsets
97 ((vspA,fspA,realSpA,hwSpA), (vspB,fspB,realSpB,hwSpB), h_usage) = usage
99 new_usage = ((vspA,fspA,realSpA,max last_SpA_offset hwSpA),
100 (vspB,fspB,realSpB,max last_SpB_offset hwSpB),
102 -- No need to fiddle with virtual SpA etc because this call is
103 -- only done just before the end of a block
108 %************************************************************************
110 \subsection[CgStackery-monadery]{Inside-monad functions for stack manipulation}
112 %************************************************************************
114 Allocate a virtual offset for something.
116 allocAStack :: FCode VirtualSpAOffset
118 allocAStack info_down (MkCgState absC binds
119 ((virt_a, free_a, real_a, hw_a), b_usage, h_usage))
120 = (chosen_slot, MkCgState absC binds (new_a_usage, b_usage, h_usage))
122 push_virt_a = virt_a + 1
124 (chosen_slot, new_a_usage)
125 = if null free_a then
126 -- No free slots, so push a new one
127 -- We need to adjust the high-water mark
128 (push_virt_a, (push_virt_a, [], real_a, hw_a `max` push_virt_a))
130 -- Free slots available, so use one
131 (free_slot, (virt_a, new_free_a, real_a, hw_a))
133 (free_slot, _) = head ([f | f@(slot, st) <- free_a, not (isStubbed st)] ++ free_a)
134 -- Try to find an un-stubbed location;
135 -- if none, return the first in the free list
136 -- We'll only try this if free_a is known to be non-empty
138 -- Free list with the free_slot deleted
139 new_free_a = [ f | f@(s,_) <- free_a, s /= free_slot ]
141 allocBStack :: Int -> FCode VirtualSpBOffset
142 allocBStack size info_down (MkCgState absC binds
143 (a_usage, (virt_b, free_b, real_b, hw_b), h_usage))
144 = (chosen_slot, MkCgState absC binds (a_usage, new_b_usage, h_usage))
146 push_virt_b = virt_b + size
148 (chosen_slot, new_b_usage)
149 = case find_block free_b of
150 Nothing -> (virt_b+1, (push_virt_b, free_b, real_b,
151 hw_b `max` push_virt_b))
152 -- Adjust high water mark
154 Just slot -> (slot, (virt_b, delete_block free_b slot, real_b, hw_b))
156 -- find_block looks for a contiguous chunk of free slots
157 find_block :: [VirtualSpBOffset] -> Maybe VirtualSpBOffset
158 find_block [] = Nothing
159 find_block (slot:slots)
160 | take size (slot:slots) == [slot..slot+size-1]
165 delete_block free_b slot = [s | s <- free_b, (s<slot) || (s>=slot+size)]
166 -- Retain slots which are not in the range
170 @allocUpdateFrame@ allocates enough space for an update frame
171 on the B stack, records the fact in the end-of-block info (in the ``args''
172 fields), and passes on the old ``args'' fields to the enclosed code.
174 This is all a bit disgusting.
177 allocUpdateFrame :: Int -- Size of frame
178 -> CAddrMode -- Return address which is to be the
180 -> ((VirtualSpAOffset, VirtualSpBOffset, VirtualSpBOffset) -> Code)
184 allocUpdateFrame size update_amode code
185 (MkCgInfoDown c_info statics (EndOfBlockInfo args_spa args_spb sequel))
186 (MkCgState absc binds (a_usage, (vB,rr,qq,hwB),h_usage))
189 InRetReg -> code (args_spa, args_spb, vB)
190 (MkCgInfoDown c_info statics new_eob_info)
191 (MkCgState absc binds new_usage)
193 other -> panic "allocUpdateFrame"
197 new_eob_info = EndOfBlockInfo args_spa new_vB (UpdateCode update_amode)
198 new_usage = (a_usage, (new_vB,rr,qq,hwB `max` new_vB), h_usage)
205 getFinalStackHW :: (VirtualSpAOffset -> VirtualSpBOffset -> Code) -> Code
206 getFinalStackHW fcode info_down (MkCgState absC binds usages) = state1
208 state1 = fcode hwSpA hwSpB info_down (MkCgState absC binds usages)
209 (MkCgState _ _ ((_,_,_, hwSpA), (_,_,_, hwSpB), _)) = state1
213 %************************************************************************
215 \subsection[CgStackery-adjust]{Adjusting the stack pointers}
217 %************************************************************************
219 @adjustRealSpX@ generates code to alter the actual stack pointer, and
220 adjusts the environment accordingly. We are careful to push the
221 conditional inside the abstract C code to avoid black holes.
222 ToDo: combine together?
224 These functions {\em do not} deal with high-water-mark adjustment.
225 That's done by functions which allocate stack space.
228 adjustRealSpA :: VirtualSpAOffset -- New offset for Arg stack ptr
230 adjustRealSpA newRealSpA info_down (MkCgState absC binds
231 ((vspA,fA,realSpA,hwspA),
233 = MkCgState (mkAbsCStmts absC move_instrA) binds new_usage
235 move_instrA = if (newRealSpA == realSpA) then AbsCNop
238 (CAddr (SpARel realSpA newRealSpA)))
239 new_usage = ((vspA, fA, newRealSpA, hwspA),
242 adjustRealSpB :: VirtualSpBOffset -- New offset for Basic/Control stack ptr
244 adjustRealSpB newRealSpB info_down (MkCgState absC binds
246 (vspB,fB,realSpB,hwspB),
248 = MkCgState (mkAbsCStmts absC move_instrB) binds new_usage
250 move_instrB = if (newRealSpB == realSpB) then AbsCNop
251 else (CAssign {-PtrRep-}
253 (CAddr (SpBRel realSpB newRealSpB)))
254 new_usage = (a_usage,
255 (vspB, fB, newRealSpB, hwspB),
258 adjustRealSps :: VirtualSpAOffset -- New offset for Arg stack ptr
259 -> VirtualSpBOffset -- Ditto B stack
261 adjustRealSps newRealSpA newRealSpB
262 = adjustRealSpA newRealSpA `thenC` adjustRealSpB newRealSpB