Replacing copyins and copyouts with data-movement instructions

[ghc-hetmet.git] / compiler / cmm / CmmCPSGen.hs

diff --git a/compiler/cmm/CmmCPSGen.hs b/compiler/cmm/CmmCPSGen.hs
index e08823e..dcbb0a5 100644 (file)
--- a/compiler/cmm/CmmCPSGen.hs
+++ b/compiler/cmm/CmmCPSGen.hs
@@ -13,8 +13,7 @@ module CmmCPSGen (
   ContinuationFormat(..),
 ) where
 
-#include "HsVersions.h"
-
+import BlockId
 import Cmm
 import CLabel
 import CmmBrokenBlock -- Data types only
@@ -33,6 +32,7 @@ import StaticFlags
 import Unique
 import Maybe
 import List
+import FastString
 
 import Panic
 
@@ -57,7 +57,7 @@ data Continuation info =
      info              -- Left <=> Continuation created by the CPS
                        -- Right <=> Function or Proc point
      CLabel            -- Used to generate both info & entry labels
-     CmmFormals        -- Argument locals live on entry (C-- procedure params)
+     CmmFormalsWithoutKinds        -- Argument locals live on entry (C-- procedure params)
      Bool              -- ^ True <=> GC block so ignore stack size
      [BrokenBlock]     -- Code, may be empty.  The first block is
                        -- the entry point.  The order is otherwise initially 
@@ -70,7 +70,7 @@ data Continuation info =
 
 data ContinuationFormat
     = ContinuationFormat {
-        continuation_formals :: CmmFormals,
+        continuation_formals :: CmmFormalsWithoutKinds,
         continuation_label :: Maybe CLabel,    -- The label occupying the top slot
         continuation_frame_size :: WordOff,    -- Total frame size in words (not including arguments)
         continuation_stack :: [Maybe LocalReg] -- local reg offsets from stack top
@@ -88,8 +88,10 @@ continuationToProc :: (WordOff, WordOff, [(CLabel, ContinuationFormat)])
                    -> CmmTop
 continuationToProc (max_stack, update_frame_size, formats) stack_use uniques
                    (Continuation info label formals _ blocks) =
-    CmmProc info label formals (concat $ zipWith3 continuationToProc' uniques blocks (True : repeat False))
+    CmmProc info label formals (ListGraph blocks')
     where
+      blocks' = concat $ zipWith3 continuationToProc' uniques blocks
+                         (True : repeat False)
       curr_format = maybe unknown_block id $ lookup label formats
       unknown_block = panic "unknown BlockId in continuationToProc"
       curr_stack = continuation_frame_size curr_format
@@ -226,22 +228,22 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques
                                 foreignCall call_uniques (CmmPrim target)
                                             results arguments
 
-formal_to_actual reg = (CmmReg (CmmLocal reg), NoHint)
+formal_to_actual reg = CmmKinded (CmmReg (CmmLocal reg)) NoHint
 
-foreignCall :: [Unique] -> CmmCallTarget -> CmmHintFormals -> CmmActuals -> [CmmStmt]
+foreignCall :: [Unique] -> CmmCallTarget -> CmmFormals -> CmmActuals -> [CmmStmt]
 foreignCall uniques call results arguments =
     arg_stmts ++
     saveThreadState ++
     caller_save ++
     [CmmCall (CmmCallee suspendThread CCallConv)
-                [ (id,PtrHint) ]
-                [ (CmmReg (CmmGlobal BaseReg), PtrHint) ]
+                [ CmmKinded id PtrHint ]
+                [ CmmKinded (CmmReg (CmmGlobal BaseReg)) PtrHint ]
                 CmmUnsafe
                  CmmMayReturn,
      CmmCall call results new_args CmmUnsafe CmmMayReturn,
      CmmCall (CmmCallee resumeThread CCallConv)
-                 [ (new_base, PtrHint) ]
-                [ (CmmReg (CmmLocal id), PtrHint) ]
+                 [ CmmKinded new_base PtrHint ]
+                [ CmmKinded (CmmReg (CmmLocal id)) PtrHint ]
                 CmmUnsafe
                  CmmMayReturn,
      -- Assign the result to BaseReg: we
@@ -249,21 +251,21 @@ foreignCall uniques call results arguments =
      CmmAssign (CmmGlobal BaseReg) (CmmReg (CmmLocal new_base))] ++
     caller_load ++
     loadThreadState tso_unique ++
-    [CmmJump (CmmReg spReg) (map (formal_to_actual . fst) results)]
+    [CmmJump (CmmReg spReg) (map (formal_to_actual . kindlessCmm) results)]
     where
       (_, arg_stmts, new_args) =
           loadArgsIntoTemps argument_uniques arguments
       (caller_save, caller_load) =
           callerSaveVolatileRegs (Just [{-only system regs-}])
-      new_base = LocalReg base_unique (cmmRegRep (CmmGlobal BaseReg)) KindNonPtr
-      id = LocalReg id_unique wordRep KindNonPtr
+      new_base = LocalReg base_unique (cmmRegRep (CmmGlobal BaseReg)) GCKindNonPtr
+      id = LocalReg id_unique wordRep GCKindNonPtr
       tso_unique : base_unique : id_unique : argument_uniques = uniques
 
 -- -----------------------------------------------------------------------------
 -- Save/restore the thread state in the TSO
 
-suspendThread = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("suspendThread")))
-resumeThread  = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("resumeThread")))
+suspendThread = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "suspendThread")))
+resumeThread  = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "resumeThread")))
 
 -- This stuff can't be done in suspendThread/resumeThread, because it
 -- refers to global registers which aren't available in the C world.
@@ -297,7 +299,7 @@ loadThreadState tso_unique =
   then [CmmStore curCCSAddr 
        (CmmLoad (cmmOffset (CmmReg (CmmLocal tso)) tso_CCCS) wordRep)]
   else []
-  where tso = LocalReg tso_unique wordRep KindNonPtr -- TODO FIXME NOW
+  where tso = LocalReg tso_unique wordRep GCKindNonPtr -- TODO FIXME NOW
 
 
 openNursery = [
@@ -361,12 +363,12 @@ tail_call spRel target arguments
   = store_arguments ++ adjust_sp_reg spRel ++ jump where
     store_arguments =
         [stack_put spRel expr offset
-         | ((expr, _), StackParam offset) <- argument_formats] ++
+         | ((CmmKinded expr _), StackParam offset) <- argument_formats] ++
         [global_put expr global
-         | ((expr, _), RegisterParam global) <- argument_formats]
+         | ((CmmKinded expr _), RegisterParam global) <- argument_formats]
     jump = [CmmJump target arguments]
 
-    argument_formats = assignArguments (cmmExprRep . fst) arguments
+    argument_formats = assignArguments (cmmExprRep . kindlessCmm) arguments
 
 adjust_sp_reg spRel =
     if spRel == 0