X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgStackery.lhs;h=caf38104dd59915a634a6265e096e585a2eb38a5;hb=e7498a3ee1d0484d02a9e86633cc179c76ebf36e;hp=cb1a4ece2a98423dc9808560219322e2f03d3948;hpb=10521d8418fd3a1cf32882718b5bd28992db36fd;p=ghc-hetmet.git diff --git a/ghc/compiler/codeGen/CgStackery.lhs b/ghc/compiler/codeGen/CgStackery.lhs index cb1a4ec..caf3810 100644 --- a/ghc/compiler/codeGen/CgStackery.lhs +++ b/ghc/compiler/codeGen/CgStackery.lhs @@ -1,5 +1,5 @@ % -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995 +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996 % \section[CgStackery]{Stack management functions} @@ -10,22 +10,23 @@ Stack-twiddling operations, which are pretty low-down and grimy. #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} %************************************************************************ @@ -41,7 +42,7 @@ increase towards the top of stack). \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 @@ -59,7 +60,20 @@ mkVirtStkOffsets init_SpA_offset init_SpB_offset kind_fun things (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@. @@ -75,7 +89,7 @@ mkStkAmodes :: VirtualSpAOffset -- Tail call positions -> [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) @@ -84,14 +98,14 @@ mkStkAmodes tail_spa tail_spb things 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 ] @@ -166,6 +180,28 @@ allocBStack size info_down (MkCgState absC binds delete_block free_b slot = [s | s <- free_b, (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 @@ -178,7 +214,7 @@ This is all a bit disgusting. 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 @@ -249,7 +285,7 @@ adjustRealSpB newRealSpB info_down (MkCgState absC binds = 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,