X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmParse.y;h=200ec38090f6eceb7542a18342beead9ca5c9534;hb=022fc24719ba4b98b8d9f19bfe7f75dd0f19d585;hp=c2dd22f8dc3e6784158a4202704c0b7cdce6681f;hpb=1c5499d4d5d506ce0cc971e98c09bfbf7bc290a1;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index c2dd22f..200ec38 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -103,8 +103,10 @@ import System.Exit
 	'if'		{ L _ (CmmT_if) }
 	'jump'		{ L _ (CmmT_jump) }
 	'foreign'	{ L _ (CmmT_foreign) }
+	'never'		{ L _ (CmmT_never) }
 	'prim'		{ L _ (CmmT_prim) }
 	'return'	{ L _ (CmmT_return) }
+	'returns'	{ L _ (CmmT_returns) }
 	'import'	{ L _ (CmmT_import) }
 	'switch'	{ L _ (CmmT_switch) }
 	'case'		{ L _ (CmmT_case) }
@@ -318,8 +320,8 @@ stmt	:: { ExtCode }
 	-- we tweak the syntax to avoid the conflict.  The later
 	-- option is taken here because the other way would require
 	-- multiple levels of expanding and get unwieldy.
-	| maybe_results 'foreign' STRING expr '(' hint_exprs0 ')' safety vols ';'
-		{% foreignCall $3 $1 $4 $6 $9 $8 }
+	| maybe_results 'foreign' STRING expr '(' hint_exprs0 ')' safety vols opt_never_returns ';'
+		{% foreignCall $3 $1 $4 $6 $9 $8 $10 }
 	| maybe_results 'prim' '%' NAME '(' hint_exprs0 ')' safety vols ';'
 		{% primCall $1 $4 $6 $9 $8 }
 	-- stmt-level macros, stealing syntax from ordinary C-- function calls.
@@ -337,6 +339,10 @@ stmt	:: { ExtCode }
 	| 'if' bool_expr '{' body '}' else 	
 		{ ifThenElse $2 $4 $6 }
 
+opt_never_returns :: { CmmReturnInfo }
+        :                               { CmmMayReturn }
+        | 'never' 'returns'             { CmmNeverReturns }
+
 bool_expr :: { ExtFCode BoolExpr }
 	: bool_op			{ $1 }
 	| expr				{ do e <- $1; return (BoolTest e) }
@@ -867,8 +873,9 @@ foreignCall
 	-> [ExtFCode (CmmExpr,MachHint)]
 	-> Maybe [GlobalReg]
         -> CmmSafety
+        -> CmmReturnInfo
         -> P ExtCode
-foreignCall conv_string results_code expr_code args_code vols safety
+foreignCall conv_string results_code expr_code args_code vols safety ret
   = do  convention <- case conv_string of
           "C" -> return CCallConv
           "C--" -> return CmmCallConv
@@ -880,14 +887,14 @@ foreignCall conv_string results_code expr_code args_code vols 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 (CmmCallee expr convention) results args safety))
+            CmmCallConv -> code (stmtC (CmmCall (CmmCallee expr convention) results args safety ret))
             _ -> case safety of
 	      CmmUnsafe ->
                 code (emitForeignCall' PlayRisky results 
-                   (CmmCallee expr convention) args vols NoC_SRT)
+                   (CmmCallee expr convention) args vols NoC_SRT ret)
               CmmSafe srt ->
                 code (emitForeignCall' (PlaySafe unused) results 
-                   (CmmCallee expr convention) args vols NoC_SRT) where
+                   (CmmCallee expr convention) args vols NoC_SRT ret) where
 	        unused = panic "not used by emitForeignCall'"
 
 primCall
@@ -906,10 +913,10 @@ primCall results_code name args_code vols safety
 		case safety of
 		  CmmUnsafe ->
 		    code (emitForeignCall' PlayRisky results
-		      (CmmPrim p) args vols NoC_SRT)
+		      (CmmPrim p) args vols NoC_SRT CmmMayReturn)
 		  CmmSafe srt ->
 		    code (emitForeignCall' (PlaySafe unused) results 
-		      (CmmPrim p) args vols NoC_SRT) where
+		      (CmmPrim p) args vols NoC_SRT CmmMayReturn) where
 		    unused = panic "not used by emitForeignCall'"
 
 doStore :: MachRep -> ExtFCode CmmExpr  -> ExtFCode CmmExpr -> ExtCode