%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
%
\section[CgStackery]{Stack management functions}
#include "HsVersions.h"
module CgStackery (
- allocAStack, allocBStack, allocUpdateFrame,
+ allocAStack, allocBStack, allocAStackTop, allocBStackTop,
+ allocUpdateFrame,
adjustRealSps, getFinalStackHW,
- mkVirtStkOffsets, mkStkAmodes,
-
- -- and to make the interface self-sufficient...
- AbstractC, CAddrMode, CgState, PrimKind
+ mkVirtStkOffsets, mkStkAmodes
) where
-import StgSyn
+IMP_Ubiq(){-uitous-}
+
import CgMonad
import AbsCSyn
-import CgUsages ( getSpBRelOffset )
-import Maybes ( Maybe(..) )
-import PrimKind ( getKindSize, retKindSize, separateByPtrFollowness )
-import Util
+import AbsCUtils ( mkAbstractCs, mkAbsCStmts, getAmodeRep )
+import HeapOffs ( VirtualSpAOffset(..), VirtualSpBOffset(..) )
+import PrimRep ( getPrimRepSize, separateByPtrFollowness,
+ PrimRep(..)
+ )
+import Util ( mapAccumR, panic )
\end{code}
%************************************************************************
\begin{code}
mkVirtStkOffsets :: VirtualSpAOffset -- Offset of the last allocated thing
-> VirtualSpBOffset -- ditto
- -> (a -> PrimKind) -- to be able to grab kinds
+ -> (a -> PrimRep) -- to be able to grab kinds
-> [a] -- things to make offsets for
-> (VirtualSpAOffset, -- OUTPUTS: Topmost allocated word
VirtualSpBOffset, -- ditto
(last_SpA_offset, last_SpB_offset, boxd_w_offsets, ubxd_w_offsets)
where
computeOffset offset thing
- = (offset + (getKindSize . kind_fun) thing, (thing, offset+(1::Int)))
+ = (offset + (max 1 . getPrimRepSize . kind_fun) thing, (thing, offset+(1::Int)))
+ -- The "max 1" bit is ULTRA important
+ -- Why? mkVirtStkOffsets is the unique function that lays out function
+ -- arguments on the stack. The "max 1" ensures that every argument takes
+ -- at least one stack slot, even if it's of kind VoidKind that actually
+ -- takes no space at all.
+ -- This is important to make sure that argument satisfaction checks work
+ -- properly. Consider
+ -- f a b s# = (a,b)
+ -- where s# is a VoidKind. f's argument satisfaction check will check
+ -- that s# is on the B stack above SuB; but if s# takes zero space, the
+ -- check will be ARGS_B_CHK(0), which always succeeds. As a result, even
+ -- if a,b aren't available either, the PAP update won't trigger and
+ -- we are throughly hosed. (SLPJ 96/05)
\end{code}
@mkStackAmodes@ is a higher-level version of @mkStackOffsets@.
-> [CAddrMode] -- things to make offsets for
-> FCode (VirtualSpAOffset, -- OUTPUTS: Topmost allocated word
VirtualSpBOffset, -- ditto
- AbstractC) -- Assignments to appropriate stk slots
+ AbstractC) -- Assignments to appropriate stk slots
mkStkAmodes tail_spa tail_spb things
info_down (MkCgState absC binds usage)
result = (last_SpA_offset, last_SpB_offset, mkAbstractCs abs_cs)
(last_SpA_offset, last_SpB_offset, ptrs_w_offsets, non_ptrs_w_offsets)
- = mkVirtStkOffsets tail_spa tail_spb getAmodeKind things
+ = mkVirtStkOffsets tail_spa tail_spb getAmodeRep things
abs_cs
- = [ CAssign (CVal (SpARel realSpA offset) PtrKind) thing
+ = [ CAssign (CVal (SpARel realSpA offset) PtrRep) thing
| (thing, offset) <- ptrs_w_offsets
]
++
- [ CAssign (CVal (SpBRel realSpB offset) (getAmodeKind thing)) thing
+ [ CAssign (CVal (SpBRel realSpB offset) (getAmodeRep thing)) thing
| (thing, offset) <- non_ptrs_w_offsets
]
delete_block free_b slot = [s | s <- free_b, (s<slot) || (s>=slot+size)]
-- Retain slots which are not in the range
-- slot..slot+size-1
+
+-- Allocate a chunk ON TOP OF the stack
+allocAStackTop :: Int -> FCode VirtualSpAOffset
+allocAStackTop size 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 + size
+ chosen_slot = virt_a + 1
+ new_a_usage = (push_virt_a, free_a, real_a, hw_a `max` push_virt_a)
+ -- Adjust high water mark
+
+-- Allocate a chunk ON TOP OF the stack
+allocBStackTop :: Int -> FCode VirtualSpBOffset
+allocBStackTop 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 = virt_b+1
+ new_b_usage = (push_virt_b, free_b, real_b, hw_b `max` push_virt_b)
+ -- Adjust high water mark
\end{code}
@allocUpdateFrame@ allocates enough space for an update frame
allocUpdateFrame :: Int -- Size of frame
-> CAddrMode -- Return address which is to be the
-- top word of frame
- -> ((VirtualSpAOffset, VirtualSpBOffset, VirtualSpBOffset) -> Code)
+ -> ((VirtualSpAOffset, VirtualSpBOffset, VirtualSpBOffset) -> Code)
-- Scope of update
-> Code
= MkCgState (mkAbsCStmts absC move_instrB) binds new_usage
where
move_instrB = if (newRealSpB == realSpB) then AbsCNop
- else (CAssign {-PtrKind-}
+ else (CAssign {-PtrRep-}
(CReg SpB)
(CAddr (SpBRel realSpB newRealSpB)))
new_usage = (a_usage,
projects / ghc-hetmet.git / blobdiff