Added 'return' to C--, and made arguments to 'jump' into CmmExpr

4 files changed, 32 insertions, 10 deletions

diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index a6c3ec4b83..c2f8d48e73 100644
--- a/compiler/cmm/Cmm.hs
+++ b/compiler/cmm/Cmm.hs
@@ -130,8 +130,11 @@ data CmmStmt
 	--	one  -> second block etc
 	-- Undefined outside range, and when there's a Nothing
 
-  | CmmJump CmmExpr [LocalReg]    -- Jump to another function, with these 
-				  -- parameters.
+  | CmmJump CmmExpr               -- Jump to another function,
+    [(CmmExpr, MachHint)]         -- with these parameters.
+
+  | CmmReturn                     -- Return from a function,
+    [(CmmExpr, MachHint)]         -- with these return values.
 
 {-
 Discussion
diff --git a/compiler/cmm/CmmLex.x b/compiler/cmm/CmmLex.x
index a1aa2762a9..dffb3553f8 100644
--- a/compiler/cmm/CmmLex.x
+++ b/compiler/cmm/CmmLex.x
@@ -139,6 +139,7 @@ data CmmToken
   | CmmT_jump
   | CmmT_foreign
   | CmmT_prim
+  | CmmT_return
   | CmmT_import
   | CmmT_switch
   | CmmT_case
@@ -214,6 +215,7 @@ reservedWordsFM = listToUFM $
 	( "jump",		CmmT_jump ),
 	( "foreign",		CmmT_foreign ),
 	( "prim",		CmmT_prim ),
+	( "return",		CmmT_return ),
 	( "import",		CmmT_import ),
 	( "switch",		CmmT_switch ),
 	( "case",		CmmT_case ),
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index b3f68a9b1e..38c30b24f5 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -104,6 +104,7 @@ import System.Exit
 	'jump'		{ L _ (CmmT_jump) }
 	'foreign'	{ L _ (CmmT_foreign) }
 	'prim'		{ L _ (CmmT_prim) }
+	'return'	{ L _ (CmmT_return) }
 	'import'	{ L _ (CmmT_import) }
 	'switch'	{ L _ (CmmT_switch) }
 	'case'		{ L _ (CmmT_case) }
@@ -279,8 +280,10 @@ stmt	:: { ExtCode }
 		{ doSwitch $2 $3 $5 $6 }
 	| 'goto' NAME ';'
 		{ do l <- lookupLabel $2; stmtEC (CmmBranch l) }
-	| 'jump' expr {-maybe_actuals-} ';'
-		{ do e <- $2; stmtEC (CmmJump e []) }
+	| 'jump' expr maybe_actuals ';'
+		{ do e1 <- $2; e2 <- sequence $3; stmtEC (CmmJump e1 e2) }
+        | 'return' maybe_actuals ';'
+		{ do e <- sequence $2; stmtEC (CmmReturn e) }
 	| 'if' bool_expr '{' body '}' else 	
 		{ ifThenElse $2 $4 $6 }
 
@@ -372,6 +375,10 @@ maybe_ty :: { MachRep }
 	: {- empty -}			{ wordRep }
 	| '::' type			{ $2 }
 
+maybe_actuals :: { [ExtFCode (CmmExpr, MachHint)] }
+	: {- empty -}		{ [] }
+	| '(' hint_exprs0 ')'	{ $2 }
+
 hint_exprs0 :: { [ExtFCode (CmmExpr, MachHint)] }
 	: {- empty -}			{ [] }
 	| hint_exprs			{ $1 }
diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs
index e8176bae60..b718ec9f40 100644
--- a/compiler/cmm/PprCmm.hs
+++ b/compiler/cmm/PprCmm.hs
@@ -167,6 +167,7 @@ pprStmt stmt = case stmt of
     CmmBranch ident          -> genBranch ident
     CmmCondBranch expr ident -> genCondBranch expr ident
     CmmJump expr params      -> genJump expr params
+    CmmReturn params         -> genReturn params
     CmmSwitch arg ids        -> genSwitch arg ids
 
 -- --------------------------------------------------------------------------
@@ -195,8 +196,8 @@ genCondBranch expr ident =
 --
 --     jump foo(a, b, c);
 --
-genJump :: CmmExpr -> [LocalReg] -> SDoc
-genJump expr actuals = 
+genJump :: CmmExpr -> [(CmmExpr, MachHint)] -> SDoc
+genJump expr args = 
 
     hcat [ ptext SLIT("jump")
          , space
@@ -205,12 +206,21 @@ genJump expr actuals =
                 else case expr of
                     CmmLoad (CmmReg _) _ -> pprExpr expr 
                     _ -> parens (pprExpr expr)
-         , pprActuals actuals
+         , parens  ( commafy $ map ppr args )
          , semi ]
 
-  where
-    pprActuals [] = empty
-    pprActuals as = parens ( commafy $ map pprLocalReg as ) 
+-- --------------------------------------------------------------------------
+-- Return from a function. [1], Section 6.8.2 of version 1.128
+--
+--     return (a, b, c);
+--
+genReturn :: [(CmmExpr, MachHint)] -> SDoc
+genReturn args = 
+
+    hcat [ ptext SLIT("return")
+         , space
+         , parens  ( commafy $ map ppr args )
+         , semi ]
 
 -- --------------------------------------------------------------------------
 -- Tabled jump to local label