From 8e3b5645e0bab683444c81bbbac87e2df6799959 Mon Sep 17 00:00:00 2001
From: "Michael D. Adams" <t-madams@microsoft.com>
Date: Wed, 16 May 2007 15:57:58 +0000
Subject: [PATCH] Added "C--" foreign calling convention

---
 compiler/cmm/CmmParse.y          |   20 +++++++++++---------
 compiler/cmm/Dataflow.hs         |    4 +++-
 compiler/prelude/ForeignCall.lhs |    3 ++-
 3 files changed, 16 insertions(+), 11 deletions(-)

diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index 38c30b2..3842e65 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -767,15 +767,17 @@ foreignCall
 	-> ExtFCode CmmExpr
 	-> [ExtFCode (CmmExpr,MachHint)]
 	-> Maybe [GlobalReg] -> P ExtCode
-foreignCall "C" results_code expr_code args_code vols
-  = return $ do
-	results <- sequence results_code
-	expr <- expr_code
-	args <- sequence args_code
-        code (emitForeignCall' PlayRisky results 
-                 (CmmForeignCall expr CCallConv) args vols)
-foreignCall conv _ _ _ _
-  = fail ("unknown calling convention: " ++ conv)
+foreignCall conv_string results_code expr_code args_code vols
+  = do  convention <- case conv_string of
+          "C" -> return CCallConv
+          "C--" -> return CmmCallConv
+          _ -> fail ("unknown calling convention: " ++ conv_string)
+	return $ do
+	  results <- sequence results_code
+	  expr <- expr_code
+	  args <- sequence args_code
+          code (emitForeignCall' PlayRisky results 
+                 (CmmForeignCall expr convention) args vols) where
 
 primCall
 	:: [ExtFCode (CmmReg,MachHint)]
diff --git a/compiler/cmm/Dataflow.hs b/compiler/cmm/Dataflow.hs
index 5001cc8..939d67d 100644
--- a/compiler/cmm/Dataflow.hs
+++ b/compiler/cmm/Dataflow.hs
@@ -73,7 +73,9 @@ cmmStmtLive other_live (CmmSwitch expr targets) =
     cmmExprLive expr .
     (foldr ((.) . (addLive . lookupWithDefaultUFM other_live emptyUniqSet)) id (mapCatMaybes id targets))
 cmmStmtLive _ (CmmJump expr params) =
-    const (cmmExprLive expr (mkUniqSet params))
+    const (cmmExprLive expr $ foldr ((.) . cmmExprLive) id (map fst params) $ emptyUniqSet)
+cmmStmtLive _ (CmmReturn params) =
+    const (foldr ((.) . cmmExprLive) id (map fst params) $ emptyUniqSet)
 
 --------
 
diff --git a/compiler/prelude/ForeignCall.lhs b/compiler/prelude/ForeignCall.lhs
index 2c90a7d..2f44e05 100644
--- a/compiler/prelude/ForeignCall.lhs
+++ b/compiler/prelude/ForeignCall.lhs
@@ -128,13 +128,14 @@ so perhaps we should emit a warning if it's being used on other
 platforms.
 
 \begin{code}
-data CCallConv = CCallConv | StdCallConv
+data CCallConv = CCallConv | StdCallConv | CmmCallConv
   deriving (Eq)
   {-! derive: Binary !-}
 
 instance Outputable CCallConv where
   ppr StdCallConv = ptext SLIT("stdcall")
   ppr CCallConv   = ptext SLIT("ccall")
+  ppr CmmCallConv = ptext SLIT("C--")
 
 defaultCCallConv :: CCallConv
 defaultCCallConv = CCallConv
-- 
1.7.10.4