Rename a constructor CmmForeignCall to CmmCallee, and tidy Cmm code

This patch should have no effect; it's mainly comments, layout,
plus this contructor name change.

compiler/cmm/Cmm.hs

@@ -47,42 +47,49 @@ import Data.Word
 -- re-orderd during code generation.
 
 -- GenCmm is abstracted over
---   (a) the type of static data elements
---   (b) the contents of a basic block.
+--   d, the type of static data elements in CmmData
+--   h, the static info preceding the code of a CmmProc
+--   i, the contents of a basic block within a CmmProc
+--
 -- We expect there to be two main instances of this type:
---   (a) Plain C--, i.e. populated with CmmLit and CmmExpr respectively,
---   (b) Native code, populated with instructions
+--   (a) C--, i.e. populated with various C-- constructs
+--		(Cmm and RawCmm below)
+--   (b) Native code, populated with data/instructions
 --
 newtype GenCmm d h i = Cmm [GenCmmTop d h i]
 
--- | Cmm with the info table as a data type
-type Cmm = GenCmm CmmStatic CmmInfo CmmStmt
-
--- | Cmm with the info tables converted to a list of 'CmmStatic'
-type RawCmm = GenCmm CmmStatic [CmmStatic] CmmStmt
-
--- A top-level chunk, abstracted over the type of the contents of
+-- | A top-level chunk, abstracted over the type of the contents of
 -- the basic blocks (Cmm or instructions are the likely instantiations).
 data GenCmmTop d h i
-  = CmmProc
+  = CmmProc	-- A procedure
      h	               -- Extra header such as the info table
      CLabel            -- Used to generate both info & entry labels
      CmmFormals        -- Argument locals live on entry (C-- procedure params)
      [GenBasicBlock i] -- Code, may be empty.  The first block is
-                       -- the entry point.  The order is otherwise initially 
+                       -- the entry point, and should be labelled by the code gen
+		       -- with the CLabel.  The order is otherwise initially 
                        -- unimportant, but at some point the code gen will
                        -- fix the order.
 
-		       -- the BlockId of the first block does not give rise
+		       -- The BlockId of the first block does not give rise
 		       -- to a label.  To jump to the first block in a Proc,
 		       -- use the appropriate CLabel.
 
-  -- some static data.
-  | CmmData Section [d]	-- constant values only
+		       -- BlockIds are only unique within a procedure
+
+  | CmmData 	-- Static data
+	Section 
+	[d]
 
+-- | Cmm with the info table as a data type
+type Cmm    = GenCmm    CmmStatic CmmInfo CmmStmt
 type CmmTop = GenCmmTop CmmStatic CmmInfo CmmStmt
+
+-- | Cmm with the info tables converted to a list of 'CmmStatic'
+type RawCmm    = GenCmm    CmmStatic [CmmStatic] CmmStmt
 type RawCmmTop = GenCmmTop CmmStatic [CmmStatic] CmmStmt
 
+
 -- A basic block containing a single label, at the beginning.
 -- The list of basic blocks in a top-level code block may be re-ordered.
 -- Fall-through is not allowed: there must be an explicit jump at the
@@ -90,12 +97,7 @@ type RawCmmTop = GenCmmTop CmmStatic [CmmStatic] CmmStmt
 -- blocks in order to turn some jumps into fallthroughs.
 
 data GenBasicBlock i = BasicBlock BlockId [i]
-  -- ToDo: Julian suggests that we might need to annotate this type
-  -- with the out & in edges in the graph, i.e. two * [BlockId].  This
-  -- information can be derived from the contents, but it might be
-  -- helpful to cache it here.
-
-type CmmBasicBlock = GenBasicBlock CmmStmt
+type CmmBasicBlock   = GenBasicBlock CmmStmt
 
 blockId :: GenBasicBlock i -> BlockId
 -- The branch block id is that of the first block in 
@@ -113,9 +115,9 @@ mapBlockStmts f (BasicBlock id bs) = BasicBlock id (map f bs)
 
 data CmmInfo
   = CmmInfo
-      (Maybe BlockId) -- GC target. Nothing <=> CPS won't do stack check
+      (Maybe BlockId)     -- GC target. Nothing <=> CPS won't do stack check
       (Maybe UpdateFrame) -- Update frame
-      CmmInfoTable -- Info table
+      CmmInfoTable        -- Info table
 
 -- Info table as a haskell data type
 data CmmInfoTable
@@ -174,7 +176,7 @@ data CmmStmt
   | CmmStore CmmExpr CmmExpr     -- Assign to memory location.  Size is
                                  -- given by cmmExprRep of the rhs.
 
-  | CmmCall	 		 -- A foreign call, with 
+  | CmmCall	 		 -- A call (forign, native or primitive), with 
      CmmCallTarget
      CmmHintFormals		 -- zero or more results
      CmmActuals			 -- zero or more arguments
@@ -190,18 +192,18 @@ data CmmStmt
 	--	one  -> second block etc
 	-- Undefined outside range, and when there's a Nothing
 
-  | CmmJump CmmExpr               -- Jump to another function,
-      CmmActuals                  -- with these parameters.
+  | CmmJump CmmExpr      -- Jump to another C-- function,
+      CmmActuals         -- with these parameters.
 
-  | CmmReturn                     -- Return from a function,
-      CmmActuals                  -- with these return values.
+  | CmmReturn            -- Return from a native C-- function,
+      CmmActuals         -- with these return values.
 
-type CmmActual = CmmExpr
-type CmmActuals = [(CmmActual,MachHint)]
-type CmmFormal = LocalReg
+type CmmActual      = CmmExpr
+type CmmActuals     = [(CmmActual,MachHint)]
+type CmmFormal      = LocalReg
 type CmmHintFormals = [(CmmFormal,MachHint)]
-type CmmFormals = [CmmFormal]
-data CmmSafety = CmmUnsafe | CmmSafe C_SRT
+type CmmFormals     = [CmmFormal]
+data CmmSafety      = CmmUnsafe | CmmSafe C_SRT
 
 {-
 Discussion
@@ -246,12 +248,12 @@ So we'll stick with the way it is, and add the optimisation to the NCG.
 -----------------------------------------------------------------------------
 
 data CmmCallTarget
-  = CmmForeignCall		-- Call to a foreign function
+  = CmmCallee		-- Call a function (foreign or native)
 	CmmExpr 		-- literal label <=> static call
 				-- other expression <=> dynamic call
 	CCallConv		-- The calling convention
 
-  | CmmPrim			-- Call to a "primitive" (eg. sin, cos)
+  | CmmPrim		-- Call a "primitive" (eg. sin, cos)
 	CallishMachOp		-- These might be implemented as inline
 				-- code by the backend.
 
@@ -272,22 +274,11 @@ data CmmExpr
 	--	where rep = cmmRegRep reg
   deriving Eq
 
-cmmExprRep :: CmmExpr -> MachRep
-cmmExprRep (CmmLit lit)      = cmmLitRep lit
-cmmExprRep (CmmLoad _ rep)   = rep
-cmmExprRep (CmmReg reg)      = cmmRegRep reg
-cmmExprRep (CmmMachOp op _)  = resultRepOfMachOp op
-cmmExprRep (CmmRegOff reg _) = cmmRegRep reg
-
 data CmmReg 
   = CmmLocal  LocalReg
   | CmmGlobal GlobalReg
   deriving( Eq )
 
-cmmRegRep :: CmmReg -> MachRep
-cmmRegRep (CmmLocal  reg) 	= localRegRep reg
-cmmRegRep (CmmGlobal reg)	= globalRegRep reg
-
 -- | Whether a 'LocalReg' is a GC followable pointer
 data Kind = KindPtr | KindNonPtr deriving (Eq)
 
@@ -297,17 +288,6 @@ data LocalReg
       MachRep   -- ^ Type
       Kind      -- ^ Should the GC follow as a pointer
 
-instance Eq LocalReg where
-  (LocalReg u1 _ _) == (LocalReg u2 _ _) = u1 == u2
-
-instance Uniquable LocalReg where
-  getUnique (LocalReg uniq _ _) = uniq
-
-localRegRep :: LocalReg -> MachRep
-localRegRep (LocalReg _ rep _) = rep
-
-localRegGCFollow (LocalReg _ _ p) = p
-
 data CmmLit
   = CmmInt Integer  MachRep
 	-- Interpretation: the 2's complement representation of the value
@@ -329,6 +309,31 @@ data CmmLit
   | CmmLabelDiffOff CLabel CLabel Int   -- label1 - label2 + offset
   deriving Eq
 
+instance Eq LocalReg where
+  (LocalReg u1 _ _) == (LocalReg u2 _ _) = u1 == u2
+
+instance Uniquable LocalReg where
+  getUnique (LocalReg uniq _ _) = uniq
+
+-----------------------------------------------------------------------------
+--		MachRep
+-----------------------------------------------------------------------------
+cmmExprRep :: CmmExpr -> MachRep
+cmmExprRep (CmmLit lit)      = cmmLitRep lit
+cmmExprRep (CmmLoad _ rep)   = rep
+cmmExprRep (CmmReg reg)      = cmmRegRep reg
+cmmExprRep (CmmMachOp op _)  = resultRepOfMachOp op
+cmmExprRep (CmmRegOff reg _) = cmmRegRep reg
+
+cmmRegRep :: CmmReg -> MachRep
+cmmRegRep (CmmLocal  reg) 	= localRegRep reg
+cmmRegRep (CmmGlobal reg)	= globalRegRep reg
+
+localRegRep :: LocalReg -> MachRep
+localRegRep (LocalReg _ rep _) = rep
+
+localRegGCFollow (LocalReg _ _ p) = p
+
 cmmLitRep :: CmmLit -> MachRep
 cmmLitRep (CmmInt _ rep)    = rep
 cmmLitRep (CmmFloat _ rep)  = rep

compiler/cmm/CmmBrokenBlock.hs

@@ -59,16 +59,20 @@ data BrokenBlock
     }
 
 -- | How a block could be entered
+-- See Note [An example of CPS conversion]
 data BlockEntryInfo
   = FunctionEntry		-- ^ Block is the beginning of a function
       CmmInfo                   -- ^ Function header info
       CLabel                    -- ^ The function name
       CmmFormals                -- ^ Aguments to function
+		-- Only the formal parameters are live 
 
   | ContinuationEntry 		-- ^ Return point of a function call
       CmmFormals                -- ^ return values (argument to continuation)
       C_SRT                     -- ^ SRT for the continuation's info table
       Bool                      -- ^ True <=> GC block so ignore stack size
+		-- Live variables, other than 
+		-- the return values, are on the stack
 
   | ControlEntry		-- ^ Any other kind of block.
                                 -- Only entered due to control flow.
@@ -77,6 +81,39 @@ data BlockEntryInfo
   -- no return values, but some live might end up as
   -- params or possibly in the frame
 
+{-	Note [An example of CPS conversion]
+
+This is NR's and SLPJ's guess about how things might work;
+it may not be consistent with the actual code (particularly
+in the matter of what's in parameters and what's on the stack).
+
+f(x,y) {
+   if x>2 then goto L
+   x = x+1
+L: if x>1 then y = g(y)
+        else x = x+1 ;
+   return( x+y )
+}
+	BECOMES
+
+f(x,y) {   // FunctionEntry
+   if x>2 then goto L
+   x = x+1
+L: 	   // ControlEntry
+   if x>1 then push x; push f1; jump g(y)
+        else x=x+1; jump f2(x, y)
+}
+
+f1(y) {    // ContinuationEntry
+  pop x; jump f2(x, y);
+}
+  
+f2(x, y) { // ProcPointEntry
+  return (z+y);
+}
+
+-}
+
 data ContFormat = ContFormat
       CmmHintFormals            -- ^ return values (argument to continuation)
       C_SRT                     -- ^ SRT for the continuation's info table
@@ -97,7 +134,7 @@ data FinalStmt
       CmmExpr                   -- ^ The function to call
       CmmActuals                -- ^ Arguments of the call
 
-  | FinalCall                   -- ^ Same as 'CmmForeignCall'
+  | FinalCall                   -- ^ Same as 'CmmCallee'
                                 -- followed by 'CmmGoto'
       BlockId                   -- ^ Target of the 'CmmGoto'
                                 -- (must be a 'ContinuationEntry')
@@ -238,9 +275,13 @@ breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry =
                   next_id = BlockId $ head uniques
                   block = do_call current_id entry accum_stmts exits next_id
                                   target results arguments srt
-                  cont_info = (next_id,
+
+                  cont_info = (next_id,	-- Entry convention for the 
+					-- continuation of the call
                                ContFormat results srt
                                               (ident `elem` gc_block_idents))
+
+			-- Break up the part after the call
                   (cont_infos, blocks) = breakBlock' (tail uniques) next_id
                                          ControlEntry [] [] stmts
 

compiler/cmm/CmmCPS.hs

@@ -40,68 +40,63 @@ import Data.List
 -- |Top level driver for the CPS pass
 -----------------------------------------------------------------------------
 cmmCPS :: DynFlags -- ^ Dynamic flags: -dcmm-lint -ddump-cps-cmm
-       -> [GenCmm CmmStatic CmmInfo CmmStmt]    -- ^ Input C-- with Proceedures
-       -> IO [GenCmm CmmStatic CmmInfo CmmStmt] -- ^ Output CPS transformed C--
-cmmCPS dflags abstractC = do
-  when (dopt Opt_DoCmmLinting dflags) $
-       do showPass dflags "CmmLint"
-	  case firstJust $ map cmmLint abstractC of
-	    Just err -> do printDump err
-			   ghcExit dflags 1
-	    Nothing  -> return ()
-  showPass dflags "CPS"
+       -> [Cmm]    -- ^ Input C-- with Proceedures
+       -> IO [Cmm] -- ^ Output CPS transformed C--
+cmmCPS dflags cmm_with_calls
+  = do	{ when (dopt Opt_DoCmmLinting dflags) $
+	       do showPass dflags "CmmLint"
+		  case firstJust $ map cmmLint cmm_with_calls of
+		    Just err -> do printDump err
+				   ghcExit dflags 1
+		    Nothing  -> return ()
+	; showPass dflags "CPS"
 
   -- TODO: more lint checking
   --        check for use of branches to non-existant blocks
   --        check for use of Sp, SpLim, R1, R2, etc.
 
-  uniqSupply <- mkSplitUniqSupply 'p'
-  let supplies = listSplitUniqSupply uniqSupply
-  let doCpsProc s (Cmm c) =
-          Cmm $ concat $ zipWith cpsProc (listSplitUniqSupply s) c
-  let continuationC = zipWith doCpsProc supplies abstractC
+	; uniqSupply <- mkSplitUniqSupply 'p'
+	; let supplies = listSplitUniqSupply uniqSupply
+	; let cpsd_cmm = zipWith doCpsProc supplies cmm_with_calls
 
-  dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "CPS Cmm" (pprCmms continuationC)
+	; dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "CPS Cmm" (pprCmms cpsd_cmm)
 
   -- TODO: add option to dump Cmm to file
 
-  return continuationC
+	; return cpsd_cmm }
 
-make_stack_check stack_check_block_id info stack_use next_block_id =
-    BasicBlock stack_check_block_id $
-                   check_stmts ++ [CmmBranch next_block_id]
-    where
-      check_stmts =
-          case info of
-            -- If we are given a stack check handler,
-            -- then great, well check the stack.
-            CmmInfo (Just gc_block) _ _
-                -> [CmmCondBranch
-                    (CmmMachOp (MO_U_Lt $ cmmRegRep spReg)
-                     [CmmReg stack_use, CmmReg spLimReg])
-                    gc_block]
-            -- If we aren't given a stack check handler,
-            -- then humph! we just won't check the stack for them.
-            CmmInfo Nothing _ _
-                -> []
 
 -----------------------------------------------------------------------------
 -- |CPS a single CmmTop (proceedure)
 -- Only 'CmmProc' are transformed 'CmmData' will be left alone.
 -----------------------------------------------------------------------------
 
+doCpsProc :: UniqSupply -> Cmm -> Cmm
+doCpsProc s (Cmm c) 
+  = Cmm $ concat $ zipWith cpsProc (listSplitUniqSupply s) c
+
 cpsProc :: UniqSupply 
-        -> GenCmmTop CmmStatic CmmInfo CmmStmt     -- ^Input proceedure
-        -> [GenCmmTop CmmStatic CmmInfo CmmStmt]   -- ^Output proceedure and continuations
+        -> CmmTop     -- ^Input procedure
+        -> [CmmTop]   -- ^Output procedures; 
+		      --   a single input procedure is converted to
+		      --   multiple output procedures
 
 -- Data blocks don't need to be CPS transformed
 cpsProc uniqSupply proc@(CmmData _ _) = [proc]
 
 -- Empty functions just don't work with the CPS algorithm, but
 -- they don't need the transformation anyway so just output them directly
-cpsProc uniqSupply proc@(CmmProc _ _ _ []) = [proc]
+cpsProc uniqSupply proc@(CmmProc _ _ _ []) 
+  = pprTrace "cpsProc: unexpected empty proc" (ppr proc) [proc]
 
 -- CPS transform for those procs that actually need it
+-- The plan is this:
+--
+--   * Introduce a stack-check block as the first block
+--   * The first blocks gets a FunctionEntry; the rest are ControlEntry
+--   * Now break each block into a bunch of blocks (at call sites); 
+--	all but the first will be ContinuationEntry
+--
 cpsProc uniqSupply (CmmProc info ident params blocks) = cps_procs
     where
       -- We need to be generating uniques for several things.
@@ -187,6 +182,23 @@ cpsProc uniqSupply (CmmProc info ident params blocks) = cps_procs
       cps_procs :: [CmmTop]
       cps_procs = zipWith (continuationToProc formats' stack_use) proc_uniques continuations'
 
+make_stack_check stack_check_block_id info stack_use next_block_id =
+    BasicBlock stack_check_block_id $
+                   check_stmts ++ [CmmBranch next_block_id]
+    where
+      check_stmts =
+          case info of
+            -- If we are given a stack check handler,
+            -- then great, well check the stack.
+            CmmInfo (Just gc_block) _ _
+                -> [CmmCondBranch
+                    (CmmMachOp (MO_U_Lt $ cmmRegRep spReg)
+                     [CmmReg stack_use, CmmReg spLimReg])
+                    gc_block]
+            -- If we aren't given a stack check handler,
+            -- then humph! we just won't check the stack for them.
+            CmmInfo Nothing _ _
+                -> []
 -----------------------------------------------------------------------------
 
 collectNonProcPointTargets ::

compiler/cmm/CmmCPSGen.hs

@@ -193,7 +193,7 @@ 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)
+                        FinalCall next (CmmCallee target CmmCallConv)
                             results arguments _ _ ->
                                 pack_continuation curr_format cont_format ++
                                 tail_call (curr_stack - cont_stack)
@@ -204,10 +204,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)
+                        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) =
@@ -226,12 +226,12 @@ 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)
+     CmmCall (CmmCallee resumeThread CCallConv)
                  [ (new_base, PtrHint) ]
 		 [ (CmmReg (CmmLocal id), PtrHint) ]
 		 CmmUnsafe,

compiler/cmm/CmmLive.hs

@@ -176,7 +176,7 @@ cmmStmtLive _ (CmmCall target results arguments _) =
     addKilled (mkUniqSet $ cmmHintFormalsToLiveLocals results) where
         target_liveness =
             case target of
-              (CmmForeignCall target _) -> cmmExprLive target
+              (CmmCallee target _) -> cmmExprLive target
               (CmmPrim _) -> id
 cmmStmtLive other_live (CmmBranch target) =
     addLive (lookupWithDefaultUFM other_live emptyUniqSet target)

compiler/cmm/CmmOpt.hs

@@ -141,7 +141,7 @@ getStmtUses (CmmAssign _ e) = getExprUses e
 getStmtUses (CmmStore e1 e2) = plusUFM_C (+) (getExprUses e1) (getExprUses e2)
 getStmtUses (CmmCall target _ es _)
    = plusUFM_C (+) (uses target) (getExprsUses (map fst es))
-   where uses (CmmForeignCall e _) = getExprUses e
+   where uses (CmmCallee e _) = getExprUses e
 	 uses _ = emptyUFM
 getStmtUses (CmmCondBranch e _) = getExprUses e
 getStmtUses (CmmSwitch e _) = getExprUses e
@@ -162,7 +162,7 @@ inlineStmt u a (CmmAssign r e) = CmmAssign r (inlineExpr u a e)
 inlineStmt u a (CmmStore e1 e2) = CmmStore (inlineExpr u a e1) (inlineExpr u a e2)
 inlineStmt u a (CmmCall target regs es srt)
    = CmmCall (infn target) regs es' srt
-   where infn (CmmForeignCall fn cconv) = CmmForeignCall fn cconv
+   where infn (CmmCallee fn cconv) = CmmCallee fn cconv
 	 infn (CmmPrim p) = CmmPrim p
 	 es' = [ (inlineExpr u a e, hint) | (e,hint) <- es ]
 inlineStmt u a (CmmCondBranch e d) = CmmCondBranch (inlineExpr u a e) d

compiler/cmm/CmmParse.y

@@ -877,17 +877,17 @@ foreignCall conv_string results_code expr_code args_code vols safety
 	  results <- sequence results_code
 	  expr <- expr_code
 	  args <- sequence args_code
-	  --code (stmtC (CmmCall (CmmForeignCall expr convention) results args safety))
+	  --code (stmtC (CmmCall (CmmCallee expr convention) results args safety))
           case convention of
             -- Temporary hack so at least some functions are CmmSafe
-            CmmCallConv -> code (stmtC (CmmCall (CmmForeignCall expr convention) results args safety))
+            CmmCallConv -> code (stmtC (CmmCall (CmmCallee expr convention) results args safety))
             _ -> case safety of
 	      CmmUnsafe ->
                 code (emitForeignCall' PlayRisky results 
-                   (CmmForeignCall expr convention) args vols NoC_SRT)
+                   (CmmCallee expr convention) args vols NoC_SRT)
               CmmSafe srt ->
                 code (emitForeignCall' (PlaySafe unused) results 
-                   (CmmForeignCall expr convention) args vols NoC_SRT) where
+                   (CmmCallee expr convention) args vols NoC_SRT) where
 	        unused = panic "not used by emitForeignCall'"
 
 primCall

compiler/cmm/PprC.hs

@@ -199,7 +199,7 @@ pprStmt stmt = case stmt of
 	where
 	  rep = cmmExprRep src
 
-    CmmCall (CmmForeignCall fn cconv) results args safety ->
+    CmmCall (CmmCallee fn cconv) results args safety ->
 	-- Controversial: leave this out for now.
 	-- pprUndef fn $$
 

compiler/cmm/PprCmm.hs

@@ -212,7 +212,7 @@ pprStmt stmt = case stmt of
 
     -- call "ccall" foo(x, y)[r1, r2];
     -- ToDo ppr volatile
-    CmmCall (CmmForeignCall fn cconv) results args safety ->
+    CmmCall (CmmCallee fn cconv) results args safety ->
         hcat [ if null results
                   then empty
                   else parens (commafy $ map ppr results) <>
@@ -226,7 +226,7 @@ pprStmt stmt = case stmt of
             target fn'          = parens (ppr fn')
 
     CmmCall (CmmPrim op) results args safety ->
-        pprStmt (CmmCall (CmmForeignCall (CmmLit lbl) CCallConv)
+        pprStmt (CmmCall (CmmCallee (CmmLit lbl) CCallConv)
                         results args safety)
         where
           lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False)

compiler/codeGen/CgForeignCall.hs

@@ -73,7 +73,7 @@ emitForeignCall results (CCall (CCallSpec target cconv safety)) args live
   = do vols <- getVolatileRegs live
        srt <- getSRTInfo
        emitForeignCall' safety results
-		(CmmForeignCall cmm_target cconv) call_args (Just vols) srt
+		(CmmCallee cmm_target cconv) call_args (Just vols) srt
   where
       (call_args, cmm_target)
 	= case target of
@@ -128,12 +128,12 @@ emitForeignCall' safety results target args vols srt
     -- Once that happens, this function will just emit a (CmmSafe srt) call,
     -- and the CPS will will be the one to convert that
     -- to this sequence of three CmmUnsafe calls.
-    stmtC (CmmCall (CmmForeignCall suspendThread CCallConv) 
+    stmtC (CmmCall (CmmCallee suspendThread CCallConv) 
 			[ (id,PtrHint) ]
 			[ (CmmReg (CmmGlobal BaseReg), PtrHint) ] 
 			CmmUnsafe)
     stmtC (CmmCall temp_target results temp_args CmmUnsafe)
-    stmtC (CmmCall (CmmForeignCall resumeThread CCallConv) 
+    stmtC (CmmCall (CmmCallee resumeThread CCallConv) 
 			[ (new_base, PtrHint) ]
 			[ (CmmReg (CmmLocal id), PtrHint) ]
 			CmmUnsafe)
@@ -159,9 +159,9 @@ load_args_into_temps = mapM arg_assign_temp
 	   tmp <- maybe_assign_temp e
 	   return (tmp,hint)
 	
-load_target_into_temp (CmmForeignCall expr conv) = do 
+load_target_into_temp (CmmCallee expr conv) = do 
   tmp <- maybe_assign_temp expr
-  return (CmmForeignCall tmp conv)
+  return (CmmCallee tmp conv)
 load_target_into_temp other_target =
   return other_target
 

compiler/codeGen/CgHpc.hs

@@ -65,7 +65,7 @@ initHpc this_mod (HpcInfo tickCount hashNo)
        ; emitForeignCall'
                PlayRisky
                [(id,NoHint)]
-               (CmmForeignCall
+               (CmmCallee
                  (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing False)
                   CCallConv
                )

compiler/codeGen/CgPrimOp.hs

@@ -117,7 +117,7 @@ emitPrimOp [res] ParOp [arg] live
     vols <- getVolatileRegs live
     emitForeignCall' PlayRisky
 	[(res,NoHint)]
-    	(CmmForeignCall newspark CCallConv) 
+    	(CmmCallee newspark CCallConv) 
 	[(CmmReg (CmmGlobal BaseReg), PtrHint), (arg,PtrHint)] 
 	(Just vols)
         NoC_SRT -- No SRT b/c we do PlayRisky
@@ -133,7 +133,7 @@ emitPrimOp [] WriteMutVarOp [mutv,var] live
 	vols <- getVolatileRegs live
 	emitForeignCall' PlayRisky
 		[{-no results-}]
-		(CmmForeignCall (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
+		(CmmCallee (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
 			 CCallConv)
 		[(CmmReg (CmmGlobal BaseReg), PtrHint), (mutv,PtrHint)]
 		(Just vols)

compiler/codeGen/CgUtils.hs

@@ -358,7 +358,7 @@ emitRtsCall' res fun args vols safe = do
   stmtsC caller_load
   where
     (caller_save, caller_load) = callerSaveVolatileRegs vols
-    target   = CmmForeignCall fun_expr CCallConv
+    target   = CmmCallee fun_expr CCallConv
     fun_expr = mkLblExpr (mkRtsCodeLabel fun)
 
 -----------------------------------------------------------------------------

compiler/nativeGen/AsmCodeGen.lhs

@@ -519,9 +519,9 @@ cmmStmtConFold stmt
 
 	CmmCall target regs args srt
 	   -> do target' <- case target of
-			      CmmForeignCall e conv -> do
+			      CmmCallee e conv -> do
 			        e' <- cmmExprConFold CallReference e
-			        return $ CmmForeignCall e' conv