X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmParse.y;h=3cd6be97a28325a5ba6e63676feb619b4428e7c6;hb=fb6d198f498d4e325a540f28aaa6e1d1530839c3;hp=9382994ae1d72abe1ec7c7e096c0f5142bfb84b2;hpb=176fa33f17dd78355cc572e006d2ab26898e2c69;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index 9382994..3cd6be9 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -7,7 +7,7 @@
 -----------------------------------------------------------------------------
 
 {
-{-# OPTIONS -w #-}
+{-# OPTIONS -Wwarn -w #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and fix
 -- any warnings in the module. See
@@ -52,6 +52,7 @@ import FastString
 import Panic
 import Constants
 import Outputable
+import BasicTypes
 import Bag              ( emptyBag, unitBag )
 
 import Control.Monad
@@ -62,6 +63,8 @@ import System.Exit
 #include "HsVersions.h"
 }
 
+%expect 0
+
 %token
 	':'	{ L _ (CmmT_SpecChar ':') }
 	';'	{ L _ (CmmT_SpecChar ';') }
@@ -202,7 +205,7 @@ static 	:: { ExtFCode [CmmStatic] }
 	| 'CLOSURE' '(' NAME lits ')'
 		{ do lits <- sequence $4;
 		     return $ map CmmStaticLit $
-                       mkStaticClosure (mkForeignLabel $3 Nothing True)
+                       mkStaticClosure (mkForeignLabel $3 Nothing True IsData)
                          -- mkForeignLabel because these are only used
                          -- for CHARLIKE and INTLIKE closures in the RTS.
 			 dontCareCCS (map getLit lits) [] [] [] }
@@ -247,7 +250,7 @@ info	:: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
 		-- ptrs, nptrs, closure type, description, type
 		{ do prof <- profilingInfo $11 $13
 		     return (mkRtsEntryLabelFS $3,
-			CmmInfoTable prof (fromIntegral $9)
+			CmmInfoTable False prof (fromIntegral $9)
 				     (ThunkInfo (fromIntegral $5, fromIntegral $7) NoC_SRT),
 			[]) }
 	
@@ -255,7 +258,7 @@ info	:: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
 		-- ptrs, nptrs, closure type, description, type, fun type
 		{ do prof <- profilingInfo $11 $13
 		     return (mkRtsEntryLabelFS $3,
-			CmmInfoTable prof (fromIntegral $9)
+			CmmInfoTable False prof (fromIntegral $9)
 				     (FunInfo (fromIntegral $5, fromIntegral $7) NoC_SRT
 				      0  -- Arity zero
 				      (ArgSpec (fromIntegral $15))
@@ -269,7 +272,7 @@ info	:: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
 		-- ptrs, nptrs, closure type, description, type, fun type, arity
 		{ do prof <- profilingInfo $11 $13
 		     return (mkRtsEntryLabelFS $3,
-			CmmInfoTable prof (fromIntegral $9)
+			CmmInfoTable False prof (fromIntegral $9)
 				     (FunInfo (fromIntegral $5, fromIntegral $7) NoC_SRT (fromIntegral $17)
 				      (ArgSpec (fromIntegral $15))
 				      zeroCLit),
@@ -284,7 +287,7 @@ info	:: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
 		     -- but that's the way the old code did it we can fix it some other time.
 		     desc_lit <- code $ mkStringCLit $13
 		     return (mkRtsEntryLabelFS $3,
-			CmmInfoTable prof (fromIntegral $11)
+			CmmInfoTable False prof (fromIntegral $11)
 				     (ConstrInfo (fromIntegral $5, fromIntegral $7) (fromIntegral $9) desc_lit),
 			[]) }
 	
@@ -292,7 +295,7 @@ info	:: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
 		-- selector, closure type, description, type
 		{ do prof <- profilingInfo $9 $11
 		     return (mkRtsEntryLabelFS $3,
-			CmmInfoTable prof (fromIntegral $7)
+			CmmInfoTable False prof (fromIntegral $7)
 				     (ThunkSelectorInfo (fromIntegral $5) NoC_SRT),
 			[]) }
 
@@ -300,7 +303,7 @@ info	:: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
 		-- closure type (no live regs)
 		{ do let infoLabel = mkRtsInfoLabelFS $3
 		     return (mkRtsRetLabelFS $3,
-			CmmInfoTable (ProfilingInfo zeroCLit zeroCLit) (fromIntegral $5)
+			CmmInfoTable False (ProfilingInfo zeroCLit zeroCLit) (fromIntegral $5)
 				     (ContInfo [] NoC_SRT),
 			[]) }
 
@@ -308,7 +311,7 @@ info	:: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
 		-- closure type, live regs
 		{ do live <- sequence (map (liftM Just) $7)
 		     return (mkRtsRetLabelFS $3,
-			CmmInfoTable (ProfilingInfo zeroCLit zeroCLit) (fromIntegral $5)
+			CmmInfoTable False (ProfilingInfo zeroCLit zeroCLit) (fromIntegral $5)
 			             (ContInfo live NoC_SRT),
 			live) }
 
@@ -824,7 +827,7 @@ newLocal ty name = do
 -- PIC code for them.
 newImport :: FastString -> ExtFCode ()
 newImport name
-   = addVarDecl name (CmmLit (CmmLabel (mkForeignLabel name Nothing True)))
+   = addVarDecl name (CmmLit (CmmLabel (mkForeignLabel name Nothing True IsFunction)))
 
 newLabel :: FastString -> ExtFCode BlockId
 newLabel name = do
@@ -975,7 +978,9 @@ emitRetUT :: [(CgRep,CmmExpr)] -> Code
 emitRetUT args = do
   tickyUnboxedTupleReturn (length args)  -- TICK
   (sp, stmts) <- pushUnboxedTuple 0 args
-  emitStmts stmts
+  emitSimultaneously stmts -- NB. the args might overlap with the stack slots
+                           -- or regs that we assign to, so better use
+                           -- simultaneous assignments here (#3546)
   when (sp /= 0) $ stmtC (CmmAssign spReg (cmmRegOffW spReg (-sp)))
   stmtC (CmmJump (entryCode (CmmLoad (cmmRegOffW spReg sp) bWord)) [])
   -- TODO (when using CPS): emitStmt (CmmReturn (map snd args))