-adjustRealSpA :: VirtualSpAOffset -- New offset for Arg stack ptr
- -> Code
-adjustRealSpA newRealSpA info_down (MkCgState absC binds
- ((vspA,fA,realSpA,hwspA),
- b_usage, h_usage))
- = MkCgState (mkAbsCStmts absC move_instrA) binds new_usage
- where
- move_instrA = if (newRealSpA == realSpA) then AbsCNop
- else (CAssign
- (CReg SpA)
- (CAddr (SpARel realSpA newRealSpA)))
- new_usage = ((vspA, fA, newRealSpA, hwspA),
- b_usage, h_usage)
-
-adjustRealSpB :: VirtualSpBOffset -- New offset for Basic/Control stack ptr
- -> Code
-adjustRealSpB newRealSpB info_down (MkCgState absC binds
- (a_usage,
- (vspB,fB,realSpB,hwspB),
- h_usage))
- = MkCgState (mkAbsCStmts absC move_instrB) binds new_usage
- where
- move_instrB = if (newRealSpB == realSpB) then AbsCNop
- else (CAssign {-PtrKind-}
- (CReg SpB)
- (CAddr (SpBRel realSpB newRealSpB)))
- new_usage = (a_usage,
- (vspB, fB, newRealSpB, hwspB),
- h_usage)
-
-adjustRealSps :: VirtualSpAOffset -- New offset for Arg stack ptr
- -> VirtualSpBOffset -- Ditto B stack
- -> Code
-adjustRealSps newRealSpA newRealSpB
- = adjustRealSpA newRealSpA `thenC` adjustRealSpB newRealSpB
+addFreeStackSlots :: [VirtualSpOffset] -> Slot -> Code
+addFreeStackSlots extra_free slot info_down
+ state@(MkCgState abs_c binds ((vsp, free, real, hw), heap_usage))
+ = MkCgState abs_c binds new_usage
+ where
+ new_usage = ((new_vsp, new_free, real, hw), heap_usage)
+ (new_vsp, new_free) = trim vsp all_free
+ all_free = addFreeSlots free (zip extra_free (repeat slot))
+
+freeStackSlots :: [VirtualSpOffset] -> Code
+freeStackSlots slots = addFreeStackSlots slots Free
+
+dataStackSlots :: [VirtualSpOffset] -> Code
+dataStackSlots slots = addFreeStackSlots slots NonPointer
+
+addFreeSlots :: [(Int,Slot)] -> [(Int,Slot)] -> [(Int,Slot)]
+addFreeSlots cs [] = cs
+addFreeSlots [] ns = ns
+addFreeSlots ((c,s):cs) ((n,s'):ns)
+ = if c < n then
+ (c,s) : addFreeSlots cs ((n,s'):ns)
+ else if c > n then
+ (n,s') : addFreeSlots ((c,s):cs) ns
+ else if s /= s' then -- c == n
+ (c,s') : addFreeSlots cs ns
+ else
+ panic ("addFreeSlots: equal slots: " ++ show (c:map fst cs)
+ ++ show (n:map fst ns))
+
+trim :: Int{-offset-} -> [(Int,Slot)] -> (Int{-offset-}, [(Int,Slot)])
+trim current_sp free_slots
+ = try current_sp free_slots
+ where
+ try csp [] = (csp,[])
+
+ try csp (slot@(off,state):slots) =
+ if state == Free && null slots' then
+ if csp' < off then
+ (csp', [])
+ else if csp' == off then
+ (csp'-1, [])
+ else
+ (csp',[slot])
+ else
+ (csp', slot:slots')
+ where
+ (csp',slots') = try csp slots