-allocAStack info_down (MkCgState absC binds
- ((virt_a, free_a, real_a, hw_a), b_usage, h_usage))
- = (chosen_slot, MkCgState absC binds (new_a_usage, b_usage, h_usage))
- where
- push_virt_a = virt_a + 1
-
- (chosen_slot, new_a_usage)
- = if null free_a then
- -- No free slots, so push a new one
- -- We need to adjust the high-water mark
- (push_virt_a, (push_virt_a, [], real_a, hw_a `max` push_virt_a))
- else
- -- Free slots available, so use one
- (free_slot, (virt_a, new_free_a, real_a, hw_a))
-
- (free_slot, _) = head ([f | f@(slot, st) <- free_a, not (isStubbed st)] ++ free_a)
- -- Try to find an un-stubbed location;
- -- if none, return the first in the free list
- -- We'll only try this if free_a is known to be non-empty
-
- -- Free list with the free_slot deleted
- new_free_a = [ f | f@(s,_) <- free_a, s /= free_slot ]
-
-allocBStack :: Int -> FCode VirtualSpBOffset
-allocBStack size info_down (MkCgState absC binds
- (a_usage, (virt_b, free_b, real_b, hw_b), h_usage))
- = (chosen_slot, MkCgState absC binds (a_usage, new_b_usage, h_usage))
- where
- push_virt_b = virt_b + size
-
- (chosen_slot, new_b_usage)
- = case find_block free_b of
- Nothing -> (virt_b+1, (push_virt_b, free_b, real_b,
- hw_b `max` push_virt_b))
- -- Adjust high water mark
-
- Just slot -> (slot, (virt_b, delete_block free_b slot, real_b, hw_b))
-
- -- find_block looks for a contiguous chunk of free slots
- find_block :: [VirtualSpBOffset] -> Maybe VirtualSpBOffset
- find_block [] = Nothing
- find_block (slot:slots)
- | take size (slot:slots) == take size (repeat slot)
- = Just slot
- | otherwise
- = find_block slots
-
- delete_block free_b slot = [s | s <- free_b, (s<slot) || (s>=slot+size)]
+\begin{code}
+allocStack :: FCode VirtualSpOffset
+allocStack = allocPrimStack 1
+
+allocPrimStack :: Int -> FCode VirtualSpOffset
+allocPrimStack size = do
+ ((virt_sp, free_stk, real_sp, hw_sp),h_usage) <- getUsage
+ let push_virt_sp = virt_sp + size
+ let (chosen_slot, new_stk_usage) =
+ case find_block free_stk of
+ Nothing -> (push_virt_sp, (push_virt_sp, free_stk, real_sp,
+ hw_sp `max` push_virt_sp))
+ -- Adjust high water mark
+ Just slot -> (slot, (virt_sp,
+ delete_block free_stk slot, real_sp, hw_sp))
+ setUsage (new_stk_usage, h_usage)
+ return chosen_slot
+
+ where
+ -- find_block looks for a contiguous chunk of free slots
+ find_block :: [(VirtualSpOffset,Slot)] -> Maybe VirtualSpOffset
+ find_block [] = Nothing
+ find_block ((off,free):slots)
+ | take size ((off,free):slots) ==
+ zip [off..top_slot] (repeat Free) = Just top_slot
+ | otherwise = find_block slots
+ -- The stack grows downwards, with increasing virtual offsets.
+ -- Therefore, the address of a multi-word object is the *highest*
+ -- virtual offset it occupies (top_slot below).
+ where top_slot = off+size-1
+
+ delete_block free_stk slot = [ (s,f) | (s,f) <- free_stk,
+ (s<=slot-size) || (s>slot) ]