[project @ 1999-06-24 13:04:13 by simonmar]

[ghc-hetmet.git] / ghc / compiler / codeGen / CgUpdate.lhs

diff --git a/ghc/compiler/codeGen/CgUpdate.lhs b/ghc/compiler/codeGen/CgUpdate.lhs
index 92ceaa4..82a0800 100644 (file)
--- a/ghc/compiler/codeGen/CgUpdate.lhs
+++ b/ghc/compiler/codeGen/CgUpdate.lhs
@@ -1,25 +1,21 @@
 %
-% (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 ) 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}
 
 
@@ -38,45 +34,49 @@ are guaranteed to be nicely aligned with the top of stack.
 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)
+\end{code}
+
+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}
+reserveSeqFrame :: EndOfBlockInfo -> EndOfBlockInfo
+reserveSeqFrame (EndOfBlockInfo args_sp (CaseAlts amode stuff)) 
+  = EndOfBlockInfo (args_sp + seqFrameSize) (SeqFrame amode stuff)
 
-{- ---------------------
-    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 CodePtrRep) `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))))
--------------------------- -}
+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}