X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmParse.y;h=37e17ca55d7d750c5fd745bb673299961ea85a5d;hb=3220e36e51df973b2634cd800f9d6e761d4f01be;hp=7c55e196f17f62c3e75a6fb60bbc89bbe52a9e72;hpb=c9aa9bb5a8a1c5d80b4ec4a186bea3a3f00142cc;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index 7c55e19..37e17ca 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -54,6 +54,7 @@ import Constants
 import Outputable
 
 import Control.Monad
+import Data.Array
 import Data.Char	( ord )
 import System.Exit
 
@@ -199,7 +200,9 @@ static 	:: { ExtFCode [CmmStatic] }
 	| 'CLOSURE' '(' NAME lits ')'
 		{ do lits <- sequence $4;
 		     return $ map CmmStaticLit $
-		       mkStaticClosure (mkRtsInfoLabelFS $3) 
+                       mkStaticClosure (mkForeignLabel $3 Nothing True)
+                         -- mkForeignLabel because these are only used
+                         -- for CHARLIKE and INTLIKE closures in the RTS.
 			 dontCareCCS (map getLit lits) [] [] [] }
 	-- arrays of closures required for the CHARLIKE & INTLIKE arrays
 
@@ -469,10 +472,10 @@ cmm_kind_exprs :: { [ExtFCode CmmActual] }
 	| cmm_kind_expr ',' cmm_kind_exprs	{ $1 : $3 }
 
 cmm_kind_expr :: { ExtFCode CmmActual }
-	: expr				{ do e <- $1; return (e, inferCmmKind e) }
+	: expr				{ do e <- $1; return (CmmHinted e (inferCmmKind e)) }
 	| expr STRING			{% do h <- parseCmmKind $2;
 					      return $ do
-						e <- $1; return (e,h) }
+						e <- $1; return (CmmHinted e h) }
 
 exprs0  :: { [ExtFCode CmmExpr] }
 	: {- empty -}			{ [] }
@@ -496,10 +499,10 @@ cmm_formals :: { [ExtFCode CmmFormal] }
 	| cmm_formal ',' cmm_formals	{ $1 : $3 }
 
 cmm_formal :: { ExtFCode CmmFormal }
-	: local_lreg			{ do e <- $1; return (e, inferCmmKind (CmmReg (CmmLocal e))) }
+	: local_lreg			{ do e <- $1; return (CmmHinted e (inferCmmKind (CmmReg (CmmLocal e)))) }
 	| STRING local_lreg		{% do h <- parseCmmKind $1;
 					      return $ do
-						e <- $2; return (e,h) }
+						e <- $2; return (CmmHinted e h) }
 
 local_lreg :: { ExtFCode LocalReg }
 	: NAME			{ do e <- lookupName $1;
@@ -760,6 +763,7 @@ stmtMacros = listToUFM [
   ( FSLIT("RET_PPP"),	\[a,b,c] ->   emitRetUT [(PtrArg,a),(PtrArg,b),(PtrArg,c)]),
   ( FSLIT("RET_NPP"),	\[a,b,c] ->   emitRetUT [(NonPtrArg,a),(PtrArg,b),(PtrArg,c)]),
   ( FSLIT("RET_NNP"),	\[a,b,c] ->   emitRetUT [(NonPtrArg,a),(NonPtrArg,b),(PtrArg,c)]),
+  ( FSLIT("RET_NNN"),	\[a,b,c] -> emitRetUT [(NonPtrArg,a),(NonPtrArg,b),(NonPtrArg,c)]),
   ( FSLIT("RET_NNNP"),	\[a,b,c,d] -> emitRetUT [(NonPtrArg,a),(NonPtrArg,b),(NonPtrArg,c),(PtrArg,d)]),
   ( FSLIT("RET_NPNP"),	\[a,b,c,d] -> emitRetUT [(NonPtrArg,a),(PtrArg,b),(NonPtrArg,c),(PtrArg,d)])
 
@@ -920,13 +924,13 @@ foreignCall conv_string results_code expr_code args_code vols safety ret
                    (CmmCallee expr' convention) args vols NoC_SRT ret) where
 	        unused = panic "not used by emitForeignCall'"
 
-adjCallTarget :: CCallConv -> CmmExpr -> [(CmmExpr,MachHint)] -> CmmExpr
+adjCallTarget :: CCallConv -> CmmExpr -> [CmmHinted CmmExpr] -> CmmExpr
 #ifdef mingw32_TARGET_OS
 -- On Windows, we have to add the '@N' suffix to the label when making
 -- a call with the stdcall calling convention.
 adjCallTarget StdCallConv (CmmLit (CmmLabel lbl)) args
   = CmmLit (CmmLabel (addLabelSize lbl (sum (map size args))))
-  where size (e,_) = max wORD_SIZE (machRepByteWidth (cmmExprRep e))
+  where size (CmmHinted e _) = max wORD_SIZE (machRepByteWidth (cmmExprRep e))
                  -- c.f. CgForeignCall.emitForeignCall
 #endif
 adjCallTarget _ expr _