X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmParse.y;h=3cd6be97a28325a5ba6e63676feb619b4428e7c6;hb=016f155090557cd63f377b3ced95453bffd87d60;hp=e488a669b0f410a16717c16d95df4768ebc2ea42;hpb=497302c44ad08c6c27d0e15d94a787f332c0cfec;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index e488a66..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
@@ -63,6 +63,8 @@ import System.Exit
 #include "HsVersions.h"
 }
 
+%expect 0
+
 %token
 	':'	{ L _ (CmmT_SpecChar ':') }
 	';'	{ L _ (CmmT_SpecChar ';') }
@@ -203,7 +205,7 @@ static 	:: { ExtFCode [CmmStatic] }
 	| 'CLOSURE' '(' NAME lits ')'
 		{ do lits <- sequence $4;
 		     return $ map CmmStaticLit $
-                       mkStaticClosure (mkForeignLabel $3 Nothing True IsFunction)
+                       mkStaticClosure (mkForeignLabel $3 Nothing True IsData)
                          -- mkForeignLabel because these are only used
                          -- for CHARLIKE and INTLIKE closures in the RTS.
 			 dontCareCCS (map getLit lits) [] [] [] }
@@ -976,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))