X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmCPSGen.hs;h=e08823e5618d10e8a3b97bd5026b8d4e6820a89d;hb=7fc749a43b4b6b85d234fa95d4928648259584f4;hp=01b9eb15e146e98c53049ff825d6a9b08fbdf89b;hpb=be0113bd76ee19c9c03b4b601e1861f1d40ff04c;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmCPSGen.hs b/compiler/cmm/CmmCPSGen.hs
index 01b9eb1..e08823e 100644
--- a/compiler/cmm/CmmCPSGen.hs
+++ b/compiler/cmm/CmmCPSGen.hs
@@ -1,3 +1,10 @@
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 module CmmCPSGen (
   -- | Converts continuations into full proceedures.
   -- The main work of the CPS transform that everything else is setting-up.
@@ -15,9 +22,9 @@ import MachOp
 import CmmUtils
 import CmmCallConv
 
-import CgProf (curCCS, curCCSAddr)
-import CgUtils (cmmOffsetW)
-import CgInfoTbls (entryCode)
+import CgProf
+import CgUtils
+import CgInfoTbls
 import SMRep
 import ForeignCall
 
@@ -29,12 +36,6 @@ import List
 
 import Panic
 
-import MachRegs (callerSaveVolatileRegs)
-  -- HACK: this is part of the NCG so we shouldn't use this, but we need
-  -- it for now to eliminate the need for saved regs to be in CmmCall.
-  -- The long term solution is to factor callerSaveVolatileRegs
-  -- from nativeGen into CPS
-
 -- The format for the call to a continuation
 -- The fst is the arguments that must be passed to the continuation
 -- by the continuation's caller.
@@ -140,7 +141,7 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques
                     arguments = map formal_to_actual (continuation_formals cont_format)
                   in (new_next,
                      [BasicBlock new_next $
-                      pack_continuation False curr_format cont_format ++
+                      pack_continuation curr_format cont_format ++
                       tail_call (curr_stack - cont_stack)
                               (CmmLit $ CmmLabel $ toCLabel next)
                               arguments])
@@ -199,9 +200,9 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques
                             tail_call curr_stack target arguments
 
                         -- A regular Cmm function call
-                        FinalCall next (CmmForeignCall target CmmCallConv)
-                            results arguments _ _ ->
-                                pack_continuation True curr_format cont_format ++
+                        FinalCall next (CmmCallee target CmmCallConv)
+                            results arguments _ _ _ ->
+                                pack_continuation curr_format cont_format ++
                                 tail_call (curr_stack - cont_stack)
                                               target arguments
                             where
@@ -210,10 +211,10 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques
                               cont_stack = continuation_frame_size cont_format
 
                         -- A safe foreign call
-                        FinalCall next (CmmForeignCall target conv)
-                            results arguments _ _ ->
+                        FinalCall next (CmmCallee target conv)
+                            results arguments _ _ _ ->
                                 target_stmts ++
-                                foreignCall call_uniques' (CmmForeignCall new_target conv)
+                                foreignCall call_uniques' (CmmCallee new_target conv)
                                             results arguments
                             where
                               (call_uniques', target_stmts, new_target) =
@@ -221,7 +222,7 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques
 
                         -- A safe prim call
                         FinalCall next (CmmPrim target)
-                            results arguments _ _ ->
+                            results arguments _ _ _ ->
                                 foreignCall call_uniques (CmmPrim target)
                                             results arguments
 
@@ -232,15 +233,17 @@ foreignCall uniques call results arguments =
     arg_stmts ++
     saveThreadState ++
     caller_save ++
-    [CmmCall (CmmForeignCall suspendThread CCallConv)
+    [CmmCall (CmmCallee suspendThread CCallConv)
 		 [ (id,PtrHint) ]
 		 [ (CmmReg (CmmGlobal BaseReg), PtrHint) ]
-		 CmmUnsafe,
-     CmmCall call results new_args CmmUnsafe,
-     CmmCall (CmmForeignCall resumeThread CCallConv)
+		 CmmUnsafe
+                 CmmMayReturn,
+     CmmCall call results new_args CmmUnsafe CmmMayReturn,
+     CmmCall (CmmCallee resumeThread CCallConv)
                  [ (new_base, PtrHint) ]
 		 [ (CmmReg (CmmLocal id), PtrHint) ]
-		 CmmUnsafe,
+		 CmmUnsafe
+                 CmmMayReturn,
      -- Assign the result to BaseReg: we
      -- might now have a different Capability!
      CmmAssign (CmmGlobal BaseReg) (CmmReg (CmmLocal new_base))] ++
@@ -387,17 +390,11 @@ gc_stack_check gc_block max_frame_size
      gc_block]
 
 
-pack_continuation :: Bool               -- ^ Whether to set the top/header
-                                        -- of the stack.  We only need to
-                                        -- set it if we are calling down
-                                        -- as opposed to continuation
-                                        -- adaptors.
-                  -> ContinuationFormat -- ^ The current format
+pack_continuation :: ContinuationFormat -- ^ The current format
                   -> ContinuationFormat -- ^ The return point format
                   -> [CmmStmt]
-pack_continuation allow_header_set
-                      (ContinuationFormat _ curr_id curr_frame_size _)
-                      (ContinuationFormat _ cont_id cont_frame_size live_regs)
+pack_continuation (ContinuationFormat _ curr_id curr_frame_size _)
+                  (ContinuationFormat _ cont_id cont_frame_size live_regs)
   = pack_frame curr_frame_size cont_frame_size maybe_header continuation_args
   where
     continuation_args = map (maybe Nothing (Just . CmmReg . CmmLocal))
@@ -407,7 +404,7 @@ pack_continuation allow_header_set
           (Just x, Just y) -> x /= y
           _ -> isJust cont_id
 
-    maybe_header = if allow_header_set && needs_header_set
+    maybe_header = if needs_header_set
                    then maybe Nothing (Just . CmmLit . CmmLabel . entryLblToInfoLbl) cont_id
                    else Nothing