%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1994
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[CgUpdate]{Manipulating update frames}
\begin{code}
-#include "HsVersions.h"
+module CgUpdate ( pushUpdateFrame, reserveSeqFrame, pushSeqFrame ) where
-module CgUpdate (
- pushUpdateFrame -- OLD: , evalPushRCCFrame
- ) where
+#include "HsVersions.h"
-import StgSyn
import CgMonad
import AbsCSyn
-import CgCompInfo ( sTD_UF_SIZE, cON_UF_SIZE,
- sCC_STD_UF_SIZE, sCC_CON_UF_SIZE,
- spARelToInt, spBRelToInt
- )
-import CgStackery ( allocUpdateFrame )
-import CgUsages
-import CmdLineOpts ( GlobalSwitch(..) )
-import Util
+import PrimRep ( PrimRep(..) )
+import CgStackery ( allocStackTop, updateFrameSize, seqFrameSize )
+import CgUsages ( getVirtSp, getSpRelOffset )
+import CmdLineOpts ( opt_SccProfilingOn )
+import Panic ( assertPanic )
\end{code}
to reflect the frame pushed.
\begin{code}
-pushUpdateFrame :: CAddrMode -> CAddrMode -> Code -> Code
-
-pushUpdateFrame updatee vector code
- = isSwitchSetC SccProfilingOn `thenFC` \ profiling_on ->
- let
- -- frame_size *includes* the return address
- frame_size = if profiling_on
- then sCC_STD_UF_SIZE
- else sTD_UF_SIZE
- in
+pushUpdateFrame :: CAddrMode -> Code -> Code
+
+pushUpdateFrame updatee code
+ =
+#ifdef DEBUG
getEndOfBlockInfo `thenFC` \ eob_info ->
- ASSERT(case eob_info of { EndOfBlockInfo _ _ InRetReg -> True; _ -> False})
- allocUpdateFrame frame_size vector (\ _ ->
+ ASSERT(case eob_info of { EndOfBlockInfo _ (OnStack _) -> True;
+ _ -> False})
+#endif
+
+ allocStackTop updateFrameSize `thenFC` \ _ ->
+ getVirtSp `thenFC` \ vsp ->
+
+ setEndOfBlockInfo (EndOfBlockInfo vsp UpdateCode) (
-- Emit the push macro
- absC (CMacroStmt PUSH_STD_UPD_FRAME [
+ absC (CMacroStmt PUSH_UPD_FRAME [
updatee,
- int_CLit0, -- Known to be zero because we have just
- int_CLit0 -- entered a thunk
+ int_CLit0 -- we just entered a closure, so must be zero
])
`thenC` code
)
int_CLit0 = mkIntCLit 0 -- out here to avoid pushUpdateFrame CAF (sigh)
-
-{- ---------------------
- What actually happens is something like this; but it got macro-ised
-
- = pushOnBStack (CReg CurCostCentre) `thenFC` \ _ ->
- pushOnBStack (CReg SuA) `thenFC` \ _ ->
- pushOnBStack (CReg SuB) `thenFC` \ _ ->
- pushOnBStack updatee `thenFC` \ _ ->
- pushOnBStack (CLabel sTD_UPD_RET_VEC_LABEL CodePtrKind) `thenFC` \ _ ->
-
- -- MAKE SuA, SuB POINT TO TOP OF A,B STACKS
- -- Remember, SpB hasn't yet been incremented to account for the
- -- 4-word update frame which has been pushed.
- -- This code seems crude, but effective...
- absC (AbsCStmts (CAssign (CReg SuA) (CReg SpA))
- (CAssign (CReg SuB) (CAddr (SpBRel 0 4))))
--------------------------- -}
\end{code}
-@evalPushRCCFrame@ pushes a frame to restore the cost centre, and
-deallocates stuff from the A and B stack if evaluation profiling. No
-actual update is required so no closure to update is passed.
-@evalPushRCCFrame@ is called for an @scc@ expression and on entry to a
-single-entry thunk: no update reqd but cost centre manipulation is.
+We push a SEQ frame just before evaluating the scrutinee of a case, if
+the scrutinee has a polymorphic or function type. The SEQ frame acts
+as a barrier in case the scrutinee evaluates to a partial application.
+
+reserveSeqFrame takes the EndOfBlockInfo for the case expression and
+updates the sequel to a SeqFrame, reserving room for the frame at
+args_sp. When the scrutinee comes around to pushing a return address,
+it will also push the SEQ frame, using pushSeqFrame.
\begin{code}
-{- OLD: WDP: 94/06
-
-evalPushRCCFrame :: Bool -> Code -> Code
-
-evalPushRCCFrame prim code
- = isSwitchSetC SccProfiling_Eval `thenFC` \ eval_profiling ->
-
- if (not eval_profiling) then
- code
- else
-
- -- Find out how many words of stack must will be
- -- deallocated at the end of the basic block
- -- As we push stuff onto the B stack we must make the
- -- RCC frame dealocate the B stack words
-
- -- We dont actually push things onto the A stack so we
- -- can treat the A stack as if these words were not there
- -- i.e. we subtract them from the A stack offset
- -- They will be popped by the current block of code
-
- -- Tell downstream code about the update frame on the B stack
- allocUpdateFrame
- sCC_RCC_UF_SIZE
- (panic "pushEvalRCCFrame: mkRestoreCostCentreLbl")
- (\ (old_args_spa, old_args_spb, upd_frame_offset) ->
-
- getSpARelOffset old_args_spa `thenFC` \ old_args_spa_rel ->
- getSpBRelOffset upd_frame_offset `thenFC` \ upd_frame_rel ->
-
- let b_wds_to_pop = upd_frame_offset - old_args_spb
- in
-
- -- Allocate enough space on the B stack for the frame
-
- evalCostCentreC
- (if prim then
- "PUSH_RCC_FRAME_RETURN"
- else
- "PUSH_RCC_FRAME_VECTOR")
- [
- mkIntCLit (spARelToInt old_args_spa_rel),
- {- Place on A stack to ``draw the line'' -}
- mkIntCLit (spBRelToInt upd_frame_rel),
- {- Ditto B stk. The update frame is pushed starting
- just above here -}
- mkIntCLit 0,
- {- Number of words of A below the line, which must be
- popped to get to the tail-call position -}
- mkIntCLit b_wds_to_pop
- {- Ditto B stk -}
- ] `thenC`
-
- code
-
-
- -- If we actually pushed things onto the A stack we have
- -- to arrange for the RCC frame to pop these as well
- -- Would need to tell downstream code about the update frame
- -- both the A and B stacks
- )
--}
+reserveSeqFrame :: EndOfBlockInfo -> EndOfBlockInfo
+reserveSeqFrame (EndOfBlockInfo args_sp (CaseAlts amode stuff))
+ = EndOfBlockInfo (args_sp + seqFrameSize) (SeqFrame amode stuff)
+
+pushSeqFrame :: VirtualSpOffset -> FCode VirtualSpOffset
+pushSeqFrame args_sp
+ = getSpRelOffset args_sp `thenFC` \ sp_rel ->
+ absC (CMacroStmt PUSH_SEQ_FRAME [CAddr sp_rel]) `thenC`
+ returnFC (args_sp - seqFrameSize)
\end{code}
projects / ghc-hetmet.git / blobdiff