Small step toward call-conv improvement: separate out calls and returns

[ghc-hetmet.git] / compiler / codeGen / StgCmmMonad.hs

diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs
index 2249a46..fdaba95 100644 (file)
--- a/compiler/codeGen/StgCmmMonad.hs
+++ b/compiler/codeGen/StgCmmMonad.hs
@@ -209,12 +209,13 @@ data Sequel
   | AssignTo 
        [LocalReg]      -- Put result(s) in these regs and fall through
                        --      NB: no void arguments here
-       C_SRT           -- Here are the statics live in the continuation
-                       -- E.g.  case (case x# of 0# -> a; DEFAULT -> b) of {
-                       --          r -> <blah>
-                       -- When compiling the nested case, remember to put the
-                       -- result in r, and fall through  
-
+        Bool            -- Should we adjust the heap pointer back to recover
+                        -- space that's unused on this path?
+                        -- We need to do this only if the expression may
+                        -- allocate (e.g. it's a foreign call or allocating primOp)
+instance Show Sequel where
+  show (Return _) = "Sequel: Return"
+  show (AssignTo _ _) = "Sequel: Assign"
 
 initCgInfoDown :: DynFlags -> Module -> CgInfoDownwards
 initCgInfoDown dflags mod
@@ -506,7 +507,7 @@ forkProc body_code
   = do { info_down <- getInfoDown
        ; us    <- newUniqSupply
        ; state <- getState
-       ; let   info_down' = info_down { cgd_sequel = initSequel }
+       ; let   info_down' = info_down -- { cgd_sequel = initSequel }
                 fork_state_in = (initCgState us) { cgs_binds = cgs_binds state }
                (result, fork_state_out) = doFCode body_code info_down' fork_state_in
        ; setState $ state `addCodeBlocksFrom` fork_state_out
@@ -600,13 +601,13 @@ emitProcWithConvention :: Convention -> CmmInfo -> CLabel -> CmmFormals ->
 emitProcWithConvention conv info lbl args blocks
   = do  { us <- newUniqSupply
         ; let (offset, entry) = mkEntry (mkBlockId $ uniqFromSupply us) conv args
-              blks = initUs_ us $ lgraphOfAGraph offset $ entry <*> blocks
-        ; let proc_block = CmmProc info lbl args blks
+              blks = initUs_ us $ lgraphOfAGraph $ entry <*> blocks
+        ; let proc_block = CmmProc info lbl args ((offset, Just initUpdFrameOff), blks)
         ; state <- getState
         ; setState $ state { cgs_tops = cgs_tops state `snocOL` proc_block } }
 
 emitProc :: CmmInfo -> CLabel -> CmmFormals -> CmmAGraph -> FCode ()
-emitProc = emitProcWithConvention Native
+emitProc = emitProcWithConvention NativeCall
 
 emitSimpleProc :: CLabel -> CmmAGraph -> FCode ()
 emitSimpleProc lbl code = 
@@ -632,5 +633,5 @@ getCmm code
 cgStmtsToBlocks :: CmmAGraph -> FCode CmmGraph
 cgStmtsToBlocks stmts
   = do  { us <- newUniqSupply
-       ; return (initUs_ us (lgraphOfAGraph 0 stmts)) }        
+       ; return (initUs_ us (lgraphOfAGraph stmts)) }