X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmParse.y;h=4690f6989c9f8ba491814668498c44774578f213;hb=9c4b3b77b7c1e07031326ddfd6c60997d3397e6d;hp=b3f68a9b1ed9da2fad1d1be3ffc1202a80a7ef92;hpb=23e5985c3db852981d527d10d6a6271688049790;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index b3f68a9..4690f69 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) }
@@ -253,24 +254,16 @@ stmt	:: { ExtCode }
 	| NAME ':'
 		{ do l <- newLabel $1; code (labelC l) }
 
-	| lreg '=' expr ';'			
-		{ do reg <- $1; e <- $3; stmtEC (CmmAssign reg e) }
+-- HACK: this should just be lregs but that causes a shift/reduce conflict
+-- with foreign calls
+	| hint_lregs '=' expr ';'
+		{ do reg <- head $1; e <- $3; stmtEC (CmmAssign (fst reg) e) }
 	| type '[' expr ']' '=' expr ';'
 		{ doStore $1 $3 $6 }
-	| 'foreign' STRING expr '(' hint_exprs0 ')' vols ';'
-		{% foreignCall $2 [] $3 $5 $7 }
-	| lreg '=' 'foreign' STRING expr '(' hint_exprs0 ')' vols ';'
-		{% let result = do r <- $1; return (r,NoHint) in
-		   foreignCall $4 [result] $5 $7 $9 }
-	| 'prim' '%' NAME '(' hint_exprs0 ')' vols ';'
-		{% primCall [] $3 $5 $7 }
-	| lreg '=' 'prim' '%' NAME '(' hint_exprs0 ')' vols ';'
-		{% let result = do r <- $1; return (r,NoHint) in
-		   primCall [result] $5 $7 $9 }
-	| STRING lreg '=' 'foreign' STRING expr '(' hint_exprs0 ')' vols ';'
-		{% do h <- parseHint $1;
-		      let result = do r <- $2; return (r,h) in
-		      foreignCall $5 [result] $6 $8 $10 }
+	| maybe_results 'foreign' STRING expr '(' hint_exprs0 ')' vols ';'
+		{% foreignCall $3 $1 $4 $6 $8 }
+	| maybe_results 'prim' '%' NAME '(' hint_exprs0 ')' vols ';'
+		{% primCall $1 $4 $6 $8 }
 	-- stmt-level macros, stealing syntax from ordinary C-- function calls.
 	-- Perhaps we ought to use the %%-form?
 	| NAME '(' exprs0 ')' ';'
@@ -279,8 +272,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 +367,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 }
@@ -398,6 +397,21 @@ reg	:: { ExtFCode CmmExpr }
 	: NAME			{ lookupName $1 }
 	| GLOBALREG		{ return (CmmReg (CmmGlobal $1)) }
 
+maybe_results :: { [ExtFCode (CmmReg, MachHint)] }
+	: {- empty -}		{ [] }
+	| hint_lregs '='	{ $1 }
+
+hint_lregs :: { [ExtFCode (CmmReg, MachHint)] }
+	: hint_lreg ','			{ [$1] }
+	| hint_lreg			{ [$1] }
+	| hint_lreg ',' hint_lregs	{ $1 : $3 }
+
+hint_lreg :: { ExtFCode (CmmReg, MachHint) }
+	: lreg				{ do e <- $1; return (e, inferHint (CmmReg e)) }
+	| STRING lreg			{% do h <- parseHint $1;
+					      return $ do
+						e <- $2; return (e,h) }
+
 lreg	:: { ExtFCode CmmReg }
 	: NAME			{ do e <- lookupName $1;
 				     return $
@@ -760,15 +774,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)]