projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Comments only
[ghc-hetmet.git]
/
compiler
/
cmm
/
CmmParse.y
diff --git
a/compiler/cmm/CmmParse.y
b/compiler/cmm/CmmParse.y
index
e488a66
..
3cd6be9
100644
(file)
--- 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
-- 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"
}
#include "HsVersions.h"
}
+%expect 0
+
%token
':' { L _ (CmmT_SpecChar ':') }
';' { L _ (CmmT_SpecChar ';') }
%token
':' { L _ (CmmT_SpecChar ':') }
';' { L _ (CmmT_SpecChar ';') }
@@
-203,7
+205,7
@@
static :: { ExtFCode [CmmStatic] }
| 'CLOSURE' '(' NAME lits ')'
{ do lits <- sequence $4;
return $ map CmmStaticLit $
| '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) [] [] [] }
-- 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
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))
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))